/[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

trunk/libf/filtrez/filtreg.f90 revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC trunk/Sources/filtrez/filtreg.f revision 134 by guez, Wed Apr 29 15:47:56 2015 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, direct, intensive)
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.
   
     USE dimens_m, ONLY : iim, jjm  
     USE parafilt, ONLY: matriceun, matriceus, matricevn, matricevs, matrinvn, &  
          matrinvs  
     USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, &  
          unsddu, unsddv  
   
     INTEGER, intent(in):: nlat ! nombre de latitudes a filtrer  
     integer, intent(in):: nbniv ! nombre de niveaux verticaux a filtrer  
   
     REAL, intent(inout):: champ(iim + 1, nlat, nbniv)  
     ! en entrée : champ à filtrer, en sortie : champ filtré  
   
     integer, intent(in):: ifiltre  
     !  +1 Transformee directe  
     ! -1 Transformee inverse  
     ! +2 Filtre directe  
     ! -2 Filtre inverse  
     ! Variable Intensive  
     ! ifiltre = 1 filtre directe  
     ! ifiltre =-1 filtre inverse  
     ! Variable Extensive  
     ! ifiltre = 2 filtre directe  
     ! ifiltre =-2 filtre inverse  
   
     integer, intent(in):: iaire  
     !  1 si champ intensif  
     ! 2 si champ extensif (pondere par les aires)  
   
     integer, intent(in):: iter  
     !  1 filtre simple  
   
     LOGICAL, intent(in):: griscal  
   
     ! Variables local to the procedure:  
13    
14        USE coefils, ONLY: sddu, sddv, unsddu, unsddv
15        USE dimens_m, ONLY: iim, jjm
16        use inifilr_m, only: jfiltnu, jfiltnv, jfiltsu, jfiltsv, matriceun, &
17             matriceus, matricevn, matricevs, matrinvn, matrinvs
18        use nr_util, only: assert
19    
20        REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv)
21        ! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e
22    
23        logical, intent(in):: direct ! filtre direct ou inverse
24    
25        logical, intent(in):: intensive
26        ! champ intensif ou extensif (pond\'er\'e par les aires)
27    
28        ! Local:
29        LOGICAL griscal
30        INTEGER nlat ! nombre de latitudes \`a filtrer
31        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 i, j, l, k
34      REAL eignq(iim), sdd1(iim), sdd2(iim)      REAL eignq(iim), sdd1(iim), sdd2(iim)
# Line 54  contains Line 36  contains
36    
37      !-----------------------------------------------------------      !-----------------------------------------------------------
38    
39      IF (ifiltre==1 .OR. ifiltre==-1) STOP &      call assert(size(champ, 1) == iim + 1, "filtreg iim + 1")
40           'Pas de transformee simple dans cette version'      nlat = size(champ, 2)
41        nbniv = size(champ, 3)
42      IF (iter==2) THEN      call assert(nlat == jjm .or. nlat == jjm + 1, "filtreg nlat")
43         PRINT *, ' Pas d iteration du filtre dans cette version !', &      griscal = nlat == jjm + 1
44              ' Utiliser old_filtreg et repasser !'  
45         STOP      IF (.not. direct .AND. nlat == jjm) THEN
46      END IF         PRINT *, 'filtreg: inverse filter on scalar grid only'
47           STOP 1
     IF (ifiltre==-2 .AND. .NOT. griscal) THEN  
        PRINT *, ' Cette routine ne calcule le filtre inverse que ', &  
             ' sur la grille des scalaires !'  
        STOP  
     END IF  
   
     IF (ifiltre/=2 .AND. ifiltre/=-2) THEN  
        PRINT *, ' Probleme dans filtreg car ifiltre NE 2 et NE -2', &  
             ' corriger et repasser !'  
        STOP  
48      END IF      END IF
49    
50      IF (griscal) THEN      IF (griscal) THEN
51         IF (nlat /= jjm + 1) THEN         IF (intensive) THEN
52            PRINT 1111            sdd1 = sddv
53            STOP            sdd2 = unsddv
54         ELSE         ELSE
55              sdd1 = unsddv
56            IF (iaire==1) THEN            sdd2 = sddv
              sdd1 = sddv  
              sdd2 = unsddv  
           ELSE  
              sdd1 = unsddv  
              sdd2 = sddv  
           END IF  
   
           jdfil1 = 2  
           jffil1 = jfiltnu  
           jdfil2 = jfiltsu  
           jffil2 = jjm  
57         END IF         END IF
58    
59           jdfil1 = 2
60           jffil1 = jfiltnu
61           jdfil2 = jfiltsu
62           jffil2 = jjm
63      ELSE      ELSE
64         IF (nlat/=jjm) THEN         IF (intensive) THEN
65            PRINT 2222            sdd1 = sddu
66            STOP            sdd2 = unsddu
67         ELSE         ELSE
68              sdd1 = unsddu
69            IF (iaire==1) THEN            sdd2 = sddu
              sdd1 = sddu  
              sdd2 = unsddu  
           ELSE  
              sdd1 = unsddu  
              sdd2 = sddu  
           END IF  
   
           jdfil1 = 1  
           jffil1 = jfiltnv  
           jdfil2 = jfiltsv  
           jffil2 = jjm  
70         END IF         END IF
     END IF  
71    
72           jdfil1 = 1
73           jffil1 = jfiltnv
74           jdfil2 = jfiltsv
75           jffil2 = jjm
76        END IF
77    
78      DO hemisph = 1, 2      loop_hemisph: DO hemisph = 1, 2
   
79         IF (hemisph==1) THEN         IF (hemisph==1) THEN
80            jdfil = jdfil1            jdfil = jdfil1
81            jffil = jffil1            jffil = jffil1
# Line 126  contains Line 84  contains
84            jffil = jffil2            jffil = jffil2
85         END IF         END IF
86    
87           loop_vertical: DO l = 1, nbniv
88         DO l = 1, nbniv            loop_latitude: DO j = jdfil, jffil
           DO j = jdfil, jffil  
   
   
89               DO i = 1, iim               DO i = 1, iim
90                  champ(i, j, l) = champ(i, j, l)*sdd1(i)                  champ(i, j, l) = champ(i, j, l)*sdd1(i)
91               END DO               END DO
92    
   
93               IF (hemisph==1) THEN               IF (hemisph==1) THEN
94                    IF (.not. direct) THEN
                 IF (ifiltre==-2) THEN  
95                     DO k = 1, iim                     DO k = 1, iim
96                        eignq(k) = 0.0                        eignq(k) = 0.
97                     END DO                     END DO
98                     DO k = 1, iim                     DO k = 1, iim
99                        DO i = 1, iim                        DO i = 1, iim
# Line 149  contains Line 102  contains
102                     END DO                     END DO
103                  ELSE IF (griscal) THEN                  ELSE IF (griscal) THEN
104                     DO k = 1, iim                     DO k = 1, iim
105                        eignq(k) = 0.0                        eignq(k) = 0.
106                     END DO                     END DO
107                     DO i = 1, iim                     DO i = 1, iim
108                        DO k = 1, iim                        DO k = 1, iim
# Line 159  contains Line 112  contains
112                     END DO                     END DO
113                  ELSE                  ELSE
114                     DO k = 1, iim                     DO k = 1, iim
115                        eignq(k) = 0.0                        eignq(k) = 0.
116                     END DO                     END DO
117                     DO i = 1, iim                     DO i = 1, iim
118                        DO k = 1, iim                        DO k = 1, iim
# Line 168  contains Line 121  contains
121                        END DO                        END DO
122                     END DO                     END DO
123                  END IF                  END IF
   
124               ELSE               ELSE
125                    IF (.not. direct) 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 i = 1, iim                     DO i = 1, iim
130                        DO k = 1, iim                        DO k = 1, iim
# Line 183  contains Line 134  contains
134                     END DO                     END DO
135                  ELSE IF (griscal) THEN                  ELSE IF (griscal) THEN
136                     DO k = 1, iim                     DO k = 1, iim
137                        eignq(k) = 0.0                        eignq(k) = 0.
138                     END DO                     END DO
139                     DO i = 1, iim                     DO i = 1, iim
140                        DO k = 1, iim                        DO k = 1, iim
# Line 193  contains Line 144  contains
144                     END DO                     END DO
145                  ELSE                  ELSE
146                     DO k = 1, iim                     DO k = 1, iim
147                        eignq(k) = 0.0                        eignq(k) = 0.
148                     END DO                     END DO
149                     DO i = 1, iim                     DO i = 1, iim
150                        DO k = 1, iim                        DO k = 1, iim
# Line 202  contains Line 153  contains
153                        END DO                        END DO
154                     END DO                     END DO
155                  END IF                  END IF
   
156               END IF               END IF
157    
158               IF (ifiltre==2) THEN               IF (direct) THEN
159                  DO i = 1, iim                  DO i = 1, iim
160                     champ(i, j, l) = (champ(i, j, l)+eignq(i))*sdd2(i)                     champ(i, j, l) = (champ(i, j, l)+eignq(i))*sdd2(i)
161                  end DO                  end DO
# Line 216  contains Line 166  contains
166               END IF               END IF
167    
168               champ(iim + 1, j, l) = champ(1, j, l)               champ(iim + 1, j, l) = champ(1, j, l)
169              END DO loop_latitude
170            END DO         END DO loop_vertical
171        end DO loop_hemisph
        END DO  
   
     end DO  
   
 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'/)  
172    
173    END SUBROUTINE filtreg    END SUBROUTINE filtreg
174    
Legend:
Removed from v.32  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21