/[lmdze]/trunk/Sources/filtrez/filtreg.f
ViewVC logotype

Diff of /trunk/Sources/filtrez/filtreg.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 27 by guez, Thu Mar 25 14:29:07 2010 UTC revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC
# Line 7  contains Line 7  contains
7    SUBROUTINE filtreg(champ, nlat, nbniv, ifiltre, iaire, griscal, iter)    SUBROUTINE filtreg(champ, nlat, nbniv, ifiltre, iaire, griscal, iter)
8    
9      ! From filtrez/filtreg.F, version 1.1.1.1, 2004/05/19 12:53:09      ! From filtrez/filtreg.F, version 1.1.1.1, 2004/05/19 12:53:09
   
10      ! Author: P. Le Van      ! Author: P. Le Van
11      ! Objet : filtre matriciel longitudinal, avec les matrices précalculées      ! Objet : filtre matriciel longitudinal, avec les matrices précalculées
12      ! pour l'opérateur filtre.      ! pour l'opérateur filtre.
13    
14      USE dimens_m, ONLY : iim, jjm      USE dimens_m, ONLY : iim, jjm
15      USE parafilt, ONLY : nfilun, nfilus, nfilvn, nfilvs      USE parafilt, ONLY: matriceun, matriceus, matricevn, matricevs, matrinvn, &
16             matrinvs
17      USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, &      USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, &
18           unsddu, unsddv           unsddu, unsddv
19    
# Line 48  contains Line 48  contains
48    
49      INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil      INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil
50      INTEGER i, j, l, k      INTEGER i, j, l, k
     REAL matriceun, matriceus, matricevn, matricevs, matrinvn, matrinvs  
     COMMON /matrfil/matriceun(iim, iim, nfilun), matriceus(iim, iim, nfilus), &  
          matricevn(iim, iim, nfilvn), matricevs(iim, iim, nfilvs), &  
          matrinvn(iim, iim, nfilun), matrinvs(iim, iim, nfilus)  
51      REAL eignq(iim), sdd1(iim), sdd2(iim)      REAL eignq(iim), sdd1(iim), sdd2(iim)
52      INTEGER hemisph      INTEGER hemisph
53    
# Line 85  contains Line 81  contains
81         ELSE         ELSE
82    
83            IF (iaire==1) THEN            IF (iaire==1) THEN
84               CALL scopy(iim, sddv, 1, sdd1, 1)               sdd1 = sddv
85               CALL scopy(iim, unsddv, 1, sdd2, 1)               sdd2 = unsddv
86            ELSE            ELSE
87               CALL scopy(iim, unsddv, 1, sdd1, 1)               sdd1 = unsddv
88               CALL scopy(iim, sddv, 1, sdd2, 1)               sdd2 = sddv
89            END IF            END IF
90    
91            jdfil1 = 2            jdfil1 = 2
# Line 104  contains Line 100  contains
100         ELSE         ELSE
101    
102            IF (iaire==1) THEN            IF (iaire==1) THEN
103               CALL scopy(iim, sddu, 1, sdd1, 1)               sdd1 = sddu
104               CALL scopy(iim, unsddu, 1, sdd2, 1)               sdd2 = unsddu
105            ELSE            ELSE
106               CALL scopy(iim, unsddu, 1, sdd1, 1)               sdd1 = unsddu
107               CALL scopy(iim, sddu, 1, sdd2, 1)               sdd2 = sddu
108            END IF            END IF
109    
110            jdfil1 = 1            jdfil1 = 1
# Line 156  contains Line 152  contains
152                     END DO                     END DO
153                     DO i = 1, iim                     DO i = 1, iim
154                        DO k = 1, iim                        DO k = 1, iim
155                           eignq(k) = eignq(k) + matriceun(k, i, j)*champ(i, j, l)                           eignq(k) = eignq(k) + matriceun(k, i, j) &
156                                  * champ(i, j, l)
157                        END DO                        END DO
158                     END DO                     END DO
159                  ELSE                  ELSE
# Line 165  contains Line 162  contains
162                     END DO                     END DO
163                     DO i = 1, iim                     DO i = 1, iim
164                        DO k = 1, iim                        DO k = 1, iim
165                           eignq(k) = eignq(k) + matricevn(k, i, j)*champ(i, j, l)                           eignq(k) = eignq(k) + matricevn(k, i, j) &
166                                  * champ(i, j, l)
167                        END DO                        END DO
168                     END DO                     END DO
169                  END IF                  END IF
Legend:
Removed from v.27  
changed lines
  Added in v.37
  ViewVC Help
Powered by ViewVC 1.1.21