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

Diff of /trunk/filtrez/filtreg.f

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

trunk/libf/filtrez/filtreg.f90 revision 27 by guez, Thu Mar 25 14:29:07 2010 UTC trunk/filtrez/filtreg.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 4  module filtreg_m Line 4  module filtreg_m
4    
5  contains  contains
6    
7    SUBROUTINE filtreg(champ, nlat, nbniv, ifiltre, iaire, griscal, iter)    SUBROUTINE filtreg(champ, nlat, nbniv, ifiltre, iaire, griscal)
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 coefils, ONLY: sddu, sddv, unsddu, unsddv
15      USE parafilt, ONLY : nfilun, nfilus, nfilvn, nfilvs      USE dimens_m, ONLY: iim, jjm
16      USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, &      use inifilr_m, only: jfiltnu, jfiltnv, jfiltsu, jfiltsv, matriceun, &
17           unsddu, unsddv           matriceus, matricevn, matricevs, matrinvn, matrinvs
18    
19      INTEGER, intent(in):: nlat ! nombre de latitudes a filtrer      INTEGER, intent(in):: nlat ! nombre de latitudes a filtrer
20      integer, intent(in):: nbniv ! nombre de niveaux verticaux a filtrer      integer, intent(in):: nbniv ! nombre de niveaux verticaux a filtrer
# Line 39  contains Line 38  contains
38      !  1 si champ intensif      !  1 si champ intensif
39      ! 2 si champ extensif (pondere par les aires)      ! 2 si champ extensif (pondere par les aires)
40    
     integer, intent(in):: iter  
     !  1 filtre simple  
   
41      LOGICAL, intent(in):: griscal      LOGICAL, intent(in):: griscal
42    
43      ! Variables local to the procedure:      ! Variables local to the procedure:
44    
45      INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil      INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil
46      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)  
47      REAL eignq(iim), sdd1(iim), sdd2(iim)      REAL eignq(iim), sdd1(iim), sdd2(iim)
48      INTEGER hemisph      INTEGER hemisph
49    
50      !-----------------------------------------------------------      !-----------------------------------------------------------
51    
52      IF (ifiltre==1 .OR. ifiltre==-1) STOP &      IF (ifiltre==1 .OR. ifiltre==-1) then
53           'Pas de transformee simple dans cette version'         print *, 'Pas de transformee simple dans cette version'
54           STOP 1
55      IF (iter==2) THEN      end IF
        PRINT *, ' Pas d iteration du filtre dans cette version !', &  
             ' Utiliser old_filtreg et repasser !'  
        STOP  
     END IF  
56    
57      IF (ifiltre==-2 .AND. .NOT. griscal) THEN      IF (ifiltre==-2 .AND. .NOT. griscal) THEN
58         PRINT *, ' Cette routine ne calcule le filtre inverse que ', &         PRINT *, ' Cette routine ne calcule le filtre inverse que ', &
59              ' sur la grille des scalaires !'              ' sur la grille des scalaires !'
60         STOP         STOP 1
61      END IF      END IF
62    
63      IF (ifiltre/=2 .AND. ifiltre/=-2) THEN      IF (ifiltre/=2 .AND. ifiltre/=-2) THEN
64         PRINT *, ' Probleme dans filtreg car ifiltre NE 2 et NE -2', &         PRINT *, ' Probleme dans filtreg car ifiltre NE 2 et NE -2', &
65              ' corriger et repasser !'              ' corriger et repasser !'
66         STOP         STOP 1
67      END IF      END IF
68    
69      IF (griscal) THEN      IF (griscal) THEN
70         IF (nlat /= jjm + 1) THEN         IF (nlat /= jjm + 1) THEN
71            PRINT 1111            PRINT *, 'Erreur dans le dimensionnement du tableau CHAMP a ' &
72            STOP                 // 'filtrer, sur la grille des scalaires'
73              STOP 1
74         ELSE         ELSE
   
75            IF (iaire==1) THEN            IF (iaire==1) THEN
76               CALL scopy(iim, sddv, 1, sdd1, 1)               sdd1 = sddv
77               CALL scopy(iim, unsddv, 1, sdd2, 1)               sdd2 = unsddv
78            ELSE            ELSE
79               CALL scopy(iim, unsddv, 1, sdd1, 1)               sdd1 = unsddv
80               CALL scopy(iim, sddv, 1, sdd2, 1)               sdd2 = sddv
81            END IF            END IF
82    
83            jdfil1 = 2            jdfil1 = 2
# Line 98  contains Line 86  contains
86            jffil2 = jjm            jffil2 = jjm
87         END IF         END IF
88      ELSE      ELSE
89         IF (nlat/=jjm) THEN         IF (nlat /= jjm) THEN
90            PRINT 2222            PRINT *, 'Erreur dans le dimensionnement du tableau CHAMP a ' &
91            STOP                 // 'filtrer, sur la grille de V ou de Z'
92              STOP 1
93         ELSE         ELSE
   
94            IF (iaire==1) THEN            IF (iaire==1) THEN
95               CALL scopy(iim, sddu, 1, sdd1, 1)               sdd1 = sddu
96               CALL scopy(iim, unsddu, 1, sdd2, 1)               sdd2 = unsddu
97            ELSE            ELSE
98               CALL scopy(iim, unsddu, 1, sdd1, 1)               sdd1 = unsddu
99               CALL scopy(iim, sddu, 1, sdd2, 1)               sdd2 = sddu
100            END IF            END IF
101    
102            jdfil1 = 1            jdfil1 = 1
# Line 118  contains Line 106  contains
106         END IF         END IF
107      END IF      END IF
108    
   
109      DO hemisph = 1, 2      DO hemisph = 1, 2
   
110         IF (hemisph==1) THEN         IF (hemisph==1) THEN
111            jdfil = jdfil1            jdfil = jdfil1
112            jffil = jffil1            jffil = jffil1
# Line 129  contains Line 115  contains
115            jffil = jffil2            jffil = jffil2
116         END IF         END IF
117    
118           loop_vertical: DO l = 1, nbniv
119         DO l = 1, nbniv            loop_latitude: DO j = jdfil, jffil
           DO j = jdfil, jffil  
   
   
120               DO i = 1, iim               DO i = 1, iim
121                  champ(i, j, l) = champ(i, j, l)*sdd1(i)                  champ(i, j, l) = champ(i, j, l)*sdd1(i)
122               END DO               END DO
123    
   
124               IF (hemisph==1) THEN               IF (hemisph==1) THEN
   
125                  IF (ifiltre==-2) THEN                  IF (ifiltre==-2) THEN
126                     DO k = 1, iim                     DO k = 1, iim
127                        eignq(k) = 0.0                        eignq(k) = 0.
128                     END DO                     END DO
129                     DO k = 1, iim                     DO k = 1, iim
130                        DO i = 1, iim                        DO i = 1, iim
# Line 152  contains Line 133  contains
133                     END DO                     END DO
134                  ELSE IF (griscal) THEN                  ELSE IF (griscal) THEN
135                     DO k = 1, iim                     DO k = 1, iim
136                        eignq(k) = 0.0                        eignq(k) = 0.
137                     END DO                     END DO
138                     DO i = 1, iim                     DO i = 1, iim
139                        DO k = 1, iim                        DO k = 1, iim
140                           eignq(k) = eignq(k) + matriceun(k, i, j)*champ(i, j, l)                           eignq(k) = eignq(k) + matriceun(k, i, j) &
141                                  * champ(i, j, l)
142                        END DO                        END DO
143                     END DO                     END DO
144                  ELSE                  ELSE
145                     DO k = 1, iim                     DO k = 1, iim
146                        eignq(k) = 0.0                        eignq(k) = 0.
147                     END DO                     END DO
148                     DO i = 1, iim                     DO i = 1, iim
149                        DO k = 1, iim                        DO k = 1, iim
150                           eignq(k) = eignq(k) + matricevn(k, i, j)*champ(i, j, l)                           eignq(k) = eignq(k) + matricevn(k, i, j) &
151                                  * champ(i, j, l)
152                        END DO                        END DO
153                     END DO                     END DO
154                  END IF                  END IF
   
155               ELSE               ELSE
   
156                  IF (ifiltre==-2) THEN                  IF (ifiltre==-2) THEN
157                     DO k = 1, iim                     DO k = 1, iim
158                        eignq(k) = 0.0                        eignq(k) = 0.
159                     END DO                     END DO
160                     DO i = 1, iim                     DO i = 1, iim
161                        DO k = 1, iim                        DO k = 1, iim
# Line 184  contains Line 165  contains
165                     END DO                     END DO
166                  ELSE IF (griscal) THEN                  ELSE IF (griscal) THEN
167                     DO k = 1, iim                     DO k = 1, iim
168                        eignq(k) = 0.0                        eignq(k) = 0.
169                     END DO                     END DO
170                     DO i = 1, iim                     DO i = 1, iim
171                        DO k = 1, iim                        DO k = 1, iim
# Line 194  contains Line 175  contains
175                     END DO                     END DO
176                  ELSE                  ELSE
177                     DO k = 1, iim                     DO k = 1, iim
178                        eignq(k) = 0.0                        eignq(k) = 0.
179                     END DO                     END DO
180                     DO i = 1, iim                     DO i = 1, iim
181                        DO k = 1, iim                        DO k = 1, iim
# Line 203  contains Line 184  contains
184                        END DO                        END DO
185                     END DO                     END DO
186                  END IF                  END IF
   
187               END IF               END IF
188    
189               IF (ifiltre==2) THEN               IF (ifiltre==2) THEN
# Line 217  contains Line 197  contains
197               END IF               END IF
198    
199               champ(iim + 1, j, l) = champ(1, j, l)               champ(iim + 1, j, l) = champ(1, j, l)
200              END DO loop_latitude
201            END DO         END DO loop_vertical
   
        END DO  
   
202      end DO      end DO
203    
 1111 FORMAT (//20X, 'ERREUR dans le dimensionnement du tableau &  
          & CHAMP a filtrer, sur la grille des scalaires'/)  
 2222 FORMAT (//20X, 'ERREUR dans le dimensionnement du tableau &  
          &CHAMP a filtrer, sur la grille de V ou de Z'/)  
   
204    END SUBROUTINE filtreg    END SUBROUTINE filtreg
205    
206  end module filtreg_m  end module filtreg_m
Legend:
Removed from v.27  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21