/[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/Sources/filtrez/filtreg.f revision 136 by guez, Thu Apr 30 18:35:49 2015 UTC trunk/Sources/filtrez/filtreg_scal.f revision 137 by guez, Wed May 6 15:51:03 2015 UTC
# Line 1  Line 1 
1  module filtreg_m  module filtreg_scal_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5  contains  contains
6    
7    SUBROUTINE filtreg(champ, direct, intensive)    SUBROUTINE filtreg_scal(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\'ecalcul\'ees      ! Objet : filtre matriciel longitudinal, avec les matrices pr\'ecalcul\'ees
12      ! pour l'op\'erateur filtre.      ! pour l'op\'erateur filtre.
13    
14      USE coefils, ONLY: sddu, sddv, unsddu, unsddv      USE coefils, ONLY: sddv, unsddv
15      USE dimens_m, ONLY: iim, jjm      USE dimens_m, ONLY: iim, jjm
16      use filtreg_hemisph_m, only: filtreg_hemisph      use filtreg_hemisph_m, only: filtreg_hemisph
17      use inifilr_m, only: jfiltnu, jfiltnv, jfiltsu, jfiltsv, matriceun, &      use inifilr_m, only: jfiltnu, jfiltsu, matriceun, matriceus, matrinvn, &
18           matriceus, matricevn, matricevs, matrinvn, matrinvs           matrinvs
19      use nr_util, only: assert      use nr_util, only: assert
20    
21      REAL, intent(inout):: champ(:, :, :) ! (iim + 1, nlat, :)      REAL, intent(inout):: champ(:, :, :) ! (iim + 1, jjm + 1, :)
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 27  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:
     INTEGER nlat ! nombre de latitudes \`a filtrer  
30      REAL sdd1(iim), sdd2(iim)      REAL sdd1(iim), sdd2(iim)
31    
32      !-----------------------------------------------------------      !-----------------------------------------------------------
33    
34      call assert(size(champ, 1) == iim + 1, "filtreg iim + 1")      call assert(size(champ, 1) == iim + 1, "filtreg_scal iim + 1")
35      nlat = size(champ, 2)      call assert(size(champ, 2) == jjm + 1, "filtreg_scal jjm + 1")
36      call assert(nlat == jjm .or. nlat == jjm + 1, "filtreg nlat")  
37        IF (intensive) THEN
38      if (nlat == jjm + 1) then         sdd1 = sddv
39         IF (intensive) THEN         sdd2 = unsddv
40            sdd1 = sddv      ELSE
41            sdd2 = unsddv         sdd1 = unsddv
42         ELSE         sdd2 = sddv
43            sdd1 = unsddv      END IF
44            sdd2 = sddv  
45         END IF      if (direct) then
46         if (direct) then         call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd1, sdd2, matriceun)
47            call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd1, sdd2, matriceun)         call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd1, sdd2, matriceus)
           call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd1, sdd2, matriceus)  
        else  
           call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd1, sdd2, - matrinvn)  
           call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd1, sdd2, - matrinvs)  
        end if  
48      else      else
49         IF (intensive) THEN         call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd1, sdd2, - matrinvn)
50            sdd1 = sddu         call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd1, sdd2, - matrinvs)
           sdd2 = unsddu  
        ELSE  
           sdd1 = unsddu  
           sdd2 = sddu  
        END IF  
        if (direct) then  
           call filtreg_hemisph(champ(:, :jfiltnv, :), sdd1, sdd2, matricevn)  
           call filtreg_hemisph(champ(:, jfiltsv:jjm, :), sdd1, sdd2, matricevs)  
        else  
           PRINT *, 'filtreg: inverse filter on scalar grid only'  
           STOP 1  
        END IF  
51      end if      end if
52    
53    END SUBROUTINE filtreg    END SUBROUTINE filtreg_scal
54    
55  end module filtreg_m  end module filtreg_scal_m
Legend:
Removed from v.136  
changed lines
  Added in v.137
  ViewVC Help
Powered by ViewVC 1.1.21