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

revision 135 by guez, Thu Apr 30 14:22:32 2015 UTC revision 136 by guez, Thu Apr 30 18:35:49 2015 UTC
# Line 13  contains Line 13  contains
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
16        use filtreg_hemisph_m, only: filtreg_hemisph
17      use inifilr_m, only: jfiltnu, jfiltnv, jfiltsu, jfiltsv, matriceun, &      use inifilr_m, only: jfiltnu, jfiltnv, jfiltsu, jfiltsv, matriceun, &
18           matriceus, matricevn, matricevs, matrinvn, matrinvs           matriceus, matricevn, matricevs, matrinvn, matrinvs
19      use nr_util, only: assert      use nr_util, only: assert
20    
21      REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, nbniv)      REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, :)
22      ! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e      ! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e
23    
24      logical, intent(in):: direct ! filtre direct ou inverse      logical, intent(in):: direct ! filtre direct ou inverse
# Line 26  contains Line 27  contains
27      ! champ intensif ou extensif (pond\'er\'e par les aires)      ! champ intensif ou extensif (pond\'er\'e par les aires)
28    
29      ! Local:      ! Local:
     LOGICAL griscal  
30      INTEGER nlat ! nombre de latitudes \`a filtrer      INTEGER nlat ! nombre de latitudes \`a filtrer
31      integer nbniv ! nombre de niveaux verticaux \`a filtrer      REAL sdd1(iim), sdd2(iim)
     INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil  
     INTEGER j, l  
     REAL eignq(iim), sdd1(iim), sdd2(iim)  
     INTEGER hemisph  
32    
33      !-----------------------------------------------------------      !-----------------------------------------------------------
34    
35      call assert(size(champ, 1) == iim + 1, "filtreg iim + 1")      call assert(size(champ, 1) == iim + 1, "filtreg iim + 1")
36      nlat = size(champ, 2)      nlat = size(champ, 2)
     nbniv = size(champ, 3)  
37      call assert(nlat == jjm .or. nlat == jjm + 1, "filtreg nlat")      call assert(nlat == jjm .or. nlat == jjm + 1, "filtreg nlat")
     griscal = nlat == jjm + 1  
38    
39      IF (.not. direct .AND. nlat == jjm) THEN      if (nlat == jjm + 1) then
        PRINT *, 'filtreg: inverse filter on scalar grid only'  
        STOP 1  
     END IF  
   
     IF (griscal) THEN  
40         IF (intensive) THEN         IF (intensive) THEN
41            sdd1 = sddv            sdd1 = sddv
42            sdd2 = unsddv            sdd2 = unsddv
# Line 55  contains Line 44  contains
44            sdd1 = unsddv            sdd1 = unsddv
45            sdd2 = sddv            sdd2 = sddv
46         END IF         END IF
47           if (direct) then
48         jdfil1 = 2            call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd1, sdd2, matriceun)
49         jffil1 = jfiltnu            call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd1, sdd2, matriceus)
50         jdfil2 = jfiltsu         else
51         jffil2 = jjm            call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd1, sdd2, - matrinvn)
52      ELSE            call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd1, sdd2, - matrinvs)
53           end if
54        else
55         IF (intensive) THEN         IF (intensive) THEN
56            sdd1 = sddu            sdd1 = sddu
57            sdd2 = unsddu            sdd2 = unsddu
# Line 68  contains Line 59  contains
59            sdd1 = unsddu            sdd1 = unsddu
60            sdd2 = sddu            sdd2 = sddu
61         END IF         END IF
62           if (direct) then
63         jdfil1 = 1            call filtreg_hemisph(champ(:, :jfiltnv, :), sdd1, sdd2, matricevn)
64         jffil1 = jfiltnv            call filtreg_hemisph(champ(:, jfiltsv:jjm, :), sdd1, sdd2, matricevs)
65         jdfil2 = jfiltsv         else
66         jffil2 = jjm            PRINT *, 'filtreg: inverse filter on scalar grid only'
67      END IF            STOP 1
   
     DO hemisph = 1, 2  
        IF (hemisph==1) THEN  
           jdfil = jdfil1  
           jffil = jffil1  
        ELSE  
           jdfil = jdfil2  
           jffil = jffil2  
68         END IF         END IF
69        end if
        DO l = 1, nbniv  
           DO j = jdfil, jffil  
              champ(:iim, j, l) = champ(:iim, j, l) * sdd1  
   
              IF (hemisph==1) THEN  
                 IF (.not. direct) THEN  
                    eignq = matmul(matrinvn(:, :, j), champ(:iim, j, l))  
                 ELSE IF (griscal) THEN  
                    eignq = matmul(matriceun(:, :, j), champ(:iim, j, l))  
                 ELSE  
                    eignq = matmul(matricevn(:, :, j), champ(:iim, j, l))  
                 END IF  
              ELSE  
                 IF (.not. direct) THEN  
                    eignq = matmul(matrinvs(:, :, j - jfiltsu + 1), &  
                         champ(:iim, j, l))  
                 ELSE IF (griscal) THEN  
                    eignq = matmul(matriceus(:, :, j - jfiltsu + 1), &  
                         champ(:iim, j, l))  
                 ELSE  
                    eignq = matmul(matricevs(:, :, j - jfiltsv + 1), &  
                         champ(:iim, j, l))  
                 END IF  
              END IF  
   
              IF (direct) THEN  
                 champ(:iim, j, l) = (champ(:iim, j, l) + eignq) * sdd2  
              ELSE  
                 champ(:iim, j, l) = (champ(:iim, j, l) - eignq) * sdd2  
              END IF  
   
              champ(iim + 1, j, l) = champ(1, j, l)  
           END DO  
        END DO  
     end DO  
70    
71    END SUBROUTINE filtreg    END SUBROUTINE filtreg
72    
Legend:
Removed from v.135  
changed lines
  Added in v.136
  ViewVC Help
Powered by ViewVC 1.1.21