/[lmdze]/trunk/Sources/filtrez/filtreg_scal.f
ViewVC logotype

Diff of /trunk/Sources/filtrez/filtreg_scal.f

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

trunk/libf/filtrez/filtreg.f90 revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC trunk/Sources/filtrez/filtreg_scal.f revision 141 by guez, Fri Jun 5 19:21:08 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, nlat, nbniv, ifiltre, iaire, griscal, iter)    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écalculées      ! Objet : filtre matriciel longitudinal, avec les matrices pr\'ecalcul\'ees
12      ! pour l'opérateur filtre.      ! pour l'op\'erateur filtre.
13    
14      USE dimens_m, ONLY : iim, jjm      USE dimens_m, ONLY: iim, jjm
15      USE parafilt, ONLY : nfilun, nfilus, nfilvn, nfilvs      use filtreg_hemisph_m, only: filtreg_hemisph
16      USE coefils, ONLY : jfiltnu, jfiltnv, jfiltsu, jfiltsv, sddu, sddv, &      USE inifgn_m, ONLY: sddv, unsddv
17           unsddu, unsddv      use inifilr_m, only: jfiltnu, jfiltsu, matriceun, matriceus, matrinvn, &
18             matrinvs
19      INTEGER, intent(in):: nlat ! nombre de latitudes a filtrer      use nr_util, only: assert
20      integer, intent(in):: nbniv ! nombre de niveaux verticaux a filtrer  
21        REAL, intent(inout):: champ(:, :, :) ! (iim + 1, jjm + 1, :)
22      REAL, intent(inout):: champ(iim + 1, nlat, nbniv)      ! en entr\'ee : champ \`a filtrer, en sortie : champ filtr\'e
     ! 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:  
   
     INTEGER jdfil1, jdfil2, jffil1, jffil2, jdfil, jffil  
     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)  
     REAL eignq(iim), sdd1(iim), sdd2(iim)  
     INTEGER hemisph  
23    
24      !-----------------------------------------------------------      logical, intent(in):: direct ! filtre direct ou inverse
25    
26      IF (ifiltre==1 .OR. ifiltre==-1) STOP &      logical, intent(in):: intensive
27           'Pas de transformee simple dans cette version'      ! champ intensif ou extensif (pond\'er\'e par les aires)
28    
29      IF (iter==2) THEN      ! Local:
30         PRINT *, ' Pas d iteration du filtre dans cette version !', &      REAL sdd(iim)
             ' Utiliser old_filtreg et repasser !'  
        STOP  
     END IF  
31    
32      IF (ifiltre==-2 .AND. .NOT. griscal) THEN      !-----------------------------------------------------------
        PRINT *, ' Cette routine ne calcule le filtre inverse que ', &  
             ' sur la grille des scalaires !'  
        STOP  
     END IF  
33    
34      IF (ifiltre/=2 .AND. ifiltre/=-2) THEN      call assert(size(champ, 1) == iim + 1, "filtreg_scal iim + 1")
35         PRINT *, ' Probleme dans filtreg car ifiltre NE 2 et NE -2', &      call assert(size(champ, 2) == jjm + 1, "filtreg_scal jjm + 1")
             ' corriger et repasser !'  
        STOP  
     END IF  
36    
37      IF (griscal) THEN      IF (intensive) THEN
38         IF (nlat /= jjm + 1) THEN         sdd = sddv
           PRINT 1111  
           STOP  
        ELSE  
   
           IF (iaire==1) THEN  
              sdd1 = sddv  
              sdd2 = unsddv  
           ELSE  
              sdd1 = unsddv  
              sdd2 = sddv  
           END IF  
   
           jdfil1 = 2  
           jffil1 = jfiltnu  
           jdfil2 = jfiltsu  
           jffil2 = jjm  
        END IF  
39      ELSE      ELSE
40         IF (nlat/=jjm) THEN         sdd = unsddv
           PRINT 2222  
           STOP  
        ELSE  
   
           IF (iaire==1) THEN  
              sdd1 = sddu  
              sdd2 = unsddu  
           ELSE  
              sdd1 = unsddu  
              sdd2 = sddu  
           END IF  
   
           jdfil1 = 1  
           jffil1 = jfiltnv  
           jdfil2 = jfiltsv  
           jffil2 = jjm  
        END IF  
41      END IF      END IF
42    
43        if (direct) then
44           call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd, matriceun)
45           call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd, matriceus)
46        else
47           call filtreg_hemisph(champ(:, 2:jfiltnu, :), sdd, - matrinvn)
48           call filtreg_hemisph(champ(:, jfiltsu:jjm, :), sdd, - matrinvs)
49        end if
50    
51      DO hemisph = 1, 2    END SUBROUTINE filtreg_scal
   
        IF (hemisph==1) THEN  
           jdfil = jdfil1  
           jffil = jffil1  
        ELSE  
           jdfil = jdfil2  
           jffil = jffil2  
        END IF  
   
   
        DO l = 1, nbniv  
           DO j = jdfil, jffil  
   
   
              DO i = 1, iim  
                 champ(i, j, l) = champ(i, j, l)*sdd1(i)  
              END DO  
   
   
              IF (hemisph==1) THEN  
   
                 IF (ifiltre==-2) THEN  
                    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  
                 ELSE IF (griscal) THEN  
                    DO k = 1, iim  
                       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  
                 ELSE  
                    DO k = 1, iim  
                       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  
                 END IF  
   
              ELSE  
   
                 IF (ifiltre==-2) THEN  
                    DO k = 1, iim  
                       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  
                 ELSE IF (griscal) THEN  
                    DO k = 1, iim  
                       eignq(k) = 0.0  
                    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  
                 ELSE  
                    DO k = 1, iim  
                       eignq(k) = 0.0  
                    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  
                 END IF  
   
              END IF  
   
              IF (ifiltre==2) THEN  
                 DO i = 1, iim  
                    champ(i, j, l) = (champ(i, j, l)+eignq(i))*sdd2(i)  
                 end DO  
              ELSE  
                 DO i = 1, iim  
                    champ(i, j, l) = (champ(i, j, l)-eignq(i))*sdd2(i)  
                 end DO  
              END IF  
   
              champ(iim + 1, j, l) = champ(1, j, l)  
   
           END DO  
   
        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'/)  
   
   END SUBROUTINE filtreg  
52    
53  end module filtreg_m  end module filtreg_scal_m
Legend:
Removed from v.30  
changed lines
  Added in v.141
  ViewVC Help
Powered by ViewVC 1.1.21