/[lmdze]/trunk/filtrez/filtreg_scal.f
ViewVC logotype

Diff of /trunk/filtrez/filtreg_scal.f

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

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 135 by guez, Thu Apr 30 14:22:32 2015 UTC
# Line 30  contains Line 30  contains
30      INTEGER nlat ! nombre de latitudes \`a filtrer      INTEGER nlat ! nombre de latitudes \`a filtrer
31      integer nbniv ! nombre de niveaux verticaux \`a filtrer      integer nbniv ! nombre de niveaux verticaux \`a filtrer
32      INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil      INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil
33      INTEGER i, j, l, k      INTEGER j, l
34      REAL eignq(iim), sdd1(iim), sdd2(iim)      REAL eignq(iim), sdd1(iim), sdd2(iim)
35      INTEGER hemisph      INTEGER hemisph
36    
# Line 75  contains Line 75  contains
75         jffil2 = jjm         jffil2 = jjm
76      END IF      END IF
77    
78      loop_hemisph: DO hemisph = 1, 2      DO hemisph = 1, 2
79         IF (hemisph==1) THEN         IF (hemisph==1) THEN
80            jdfil = jdfil1            jdfil = jdfil1
81            jffil = jffil1            jffil = jffil1
# Line 84  contains Line 84  contains
84            jffil = jffil2            jffil = jffil2
85         END IF         END IF
86    
87         loop_vertical: DO l = 1, nbniv         DO l = 1, nbniv
88            loop_latitude: DO j = jdfil, jffil            DO j = jdfil, jffil
89               DO i = 1, iim               champ(:iim, j, l) = champ(:iim, j, l) * sdd1
                 champ(i, j, l) = champ(i, j, l)*sdd1(i)  
              END DO  
90    
91               IF (hemisph==1) THEN               IF (hemisph==1) THEN
92                  IF (.not. direct) THEN                  IF (.not. direct) THEN
93                     DO k = 1, iim                     eignq = matmul(matrinvn(:, :, j), champ(:iim, j, l))
                       eignq(k) = 0.  
                    END DO  
                    DO k = 1, iim  
                       DO i = 1, iim  
                          eignq(k) = eignq(k) + matrinvn(k, i, j)*champ(i, j, l)  
                       END DO  
                    END DO  
94                  ELSE IF (griscal) THEN                  ELSE IF (griscal) THEN
95                     DO k = 1, iim                     eignq = matmul(matriceun(:, :, j), champ(:iim, j, l))
                       eignq(k) = 0.  
                    END DO  
                    DO i = 1, iim  
                       DO k = 1, iim  
                          eignq(k) = eignq(k) + matriceun(k, i, j) &  
                               * champ(i, j, l)  
                       END DO  
                    END DO  
96                  ELSE                  ELSE
97                     DO k = 1, iim                     eignq = matmul(matricevn(:, :, j), champ(:iim, j, l))
                       eignq(k) = 0.  
                    END DO  
                    DO i = 1, iim  
                       DO k = 1, iim  
                          eignq(k) = eignq(k) + matricevn(k, i, j) &  
                               * champ(i, j, l)  
                       END DO  
                    END DO  
98                  END IF                  END IF
99               ELSE               ELSE
100                  IF (.not. direct) THEN                  IF (.not. direct) THEN
101                     DO k = 1, iim                     eignq = matmul(matrinvs(:, :, j - jfiltsu + 1), &
102                        eignq(k) = 0.                          champ(:iim, j, l))
                    END DO  
                    DO i = 1, iim  
                       DO k = 1, iim  
                          eignq(k) = eignq(k) + matrinvs(k, i, j-jfiltsu+1) &  
                               *champ(i, j, l)  
                       END DO  
                    END DO  
103                  ELSE IF (griscal) THEN                  ELSE IF (griscal) THEN
104                     DO k = 1, iim                     eignq = matmul(matriceus(:, :, j - jfiltsu + 1), &
105                        eignq(k) = 0.                          champ(:iim, j, l))
                    END DO  
                    DO i = 1, iim  
                       DO k = 1, iim  
                          eignq(k) = eignq(k) + matriceus(k, i, j-jfiltsu+1) &  
                               *champ(i, j , l)  
                       END DO  
                    END DO  
106                  ELSE                  ELSE
107                     DO k = 1, iim                     eignq = matmul(matricevs(:, :, j - jfiltsv + 1), &
108                        eignq(k) = 0.                          champ(:iim, j, l))
                    END DO  
                    DO i = 1, iim  
                       DO k = 1, iim  
                          eignq(k) = eignq(k) + matricevs(k, i, j-jfiltsv+1) &  
                               *champ(i, j , l)  
                       END DO  
                    END DO  
109                  END IF                  END IF
110               END IF               END IF
111    
112               IF (direct) THEN               IF (direct) THEN
113                  DO i = 1, iim                  champ(:iim, j, l) = (champ(:iim, j, l) + eignq) * sdd2
                    champ(i, j, l) = (champ(i, j, l)+eignq(i))*sdd2(i)  
                 end DO  
114               ELSE               ELSE
115                  DO i = 1, iim                  champ(:iim, j, l) = (champ(:iim, j, l) - eignq) * sdd2
                    champ(i, j, l) = (champ(i, j, l)-eignq(i))*sdd2(i)  
                 end DO  
116               END IF               END IF
117    
118               champ(iim + 1, j, l) = champ(1, j, l)               champ(iim + 1, j, l) = champ(1, j, l)
119            END DO loop_latitude            END DO
120         END DO loop_vertical         END DO
121      end DO loop_hemisph      end DO
122    
123    END SUBROUTINE filtreg    END SUBROUTINE filtreg
124    
Legend:
Removed from v.134  
changed lines
  Added in v.135
  ViewVC Help
Powered by ViewVC 1.1.21