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

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

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

trunk/filtrez/filtreg.f revision 107 by guez, Thu Sep 11 15:09:15 2014 UTC trunk/Sources/filtrez/filtreg.f revision 135 by guez, Thu Apr 30 14:22:32 2015 UTC
# Line 8  contains Line 8  contains
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\'ecalcul\'ees
12      ! pour l'opérateur filtre.      ! pour l'op\'erateur filtre.
13    
14      USE coefils, ONLY: sddu, sddv, unsddu, unsddv      USE coefils, ONLY: sddu, sddv, unsddu, unsddv
15      USE dimens_m, ONLY: iim, jjm      USE dimens_m, ONLY: iim, jjm
# Line 18  contains Line 18  contains
18      use nr_util, only: assert      use nr_util, only: assert
19    
20      REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv)      REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv)
21      ! en entrée : champ à filtrer, en sortie : champ filtré      ! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e
22    
23      logical, intent(in):: direct ! filtre direct ou inverse      logical, intent(in):: direct ! filtre direct ou inverse
24    
25      logical, intent(in):: intensive      logical, intent(in):: intensive
26      ! champ intensif ou extensif (pondéré par les aires)      ! champ intensif ou extensif (pond\'er\'e par les aires)
27    
28      ! Local:      ! Local:
29      LOGICAL griscal      LOGICAL griscal
30      INTEGER nlat ! nombre de latitudes à filtrer      INTEGER nlat ! nombre de latitudes \`a filtrer
31      integer nbniv ! nombre de niveaux verticaux à 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 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      end DO
122    
123    END SUBROUTINE filtreg    END SUBROUTINE filtreg
Legend:
Removed from v.107  
changed lines
  Added in v.135
  ViewVC Help
Powered by ViewVC 1.1.21