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

trunk/libf/filtrez/filtreg.f90 revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC trunk/Sources/filtrez/filtreg.f revision 135 by guez, Thu Apr 30 14:22:32 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 j, l
34      REAL eignq(iim), sdd1(iim), sdd2(iim)      REAL eignq(iim), sdd1(iim), sdd2(iim)
35      INTEGER hemisph      INTEGER hemisph
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      DO hemisph = 1, 2
   
79         IF (hemisph==1) THEN         IF (hemisph==1) THEN
80            jdfil = jdfil1            jdfil = jdfil1
81            jffil = jffil1            jffil = jffil1
# Line 125  contains Line 84  contains
84            jffil = jffil2            jffil = jffil2
85         END IF         END IF
86    
   
87         DO l = 1, nbniv         DO l = 1, nbniv
88            DO j = jdfil, jffil            DO j = jdfil, jffil
89                 champ(:iim, j, l) = champ(:iim, j, l) * sdd1
   
              DO i = 1, iim  
                 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
93                  IF (ifiltre==-2) THEN                     eignq = matmul(matrinvn(:, :, j), champ(:iim, j, l))
                    DO k = 1, iim  
                       eignq(k) = 0.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.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.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
101                  IF (ifiltre==-2) THEN                     eignq = matmul(matrinvs(:, :, j - jfiltsu + 1), &
102                     DO k = 1, iim                          champ(:iim, j, l))
                       eignq(k) = 0.0  
                    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.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.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 (ifiltre==2) 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            END DO
   
120         END DO         END DO
   
121      end DO      end DO
122    
 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'/)  
   
123    END SUBROUTINE filtreg    END SUBROUTINE filtreg
124    
125  end module filtreg_m  end module filtreg_m
Legend:
Removed from v.37  
changed lines
  Added in v.135
  ViewVC Help
Powered by ViewVC 1.1.21