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

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

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

trunk/filtrez/inifilr.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/filtrez/inifilr.f revision 139 by guez, Tue May 26 17:46:03 2015 UTC
# Line 1  Line 1 
1  module inifilr_m  module inifilr_m
2    
   use dimens_m, only: iim  
   
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    INTEGER jfiltnu, jfiltsu, jfiltnv, jfiltsv    INTEGER jfiltnu, jfiltsu, jfiltnv, jfiltsv
   INTEGER, PARAMETER:: nfilun=3, nfilus=2, nfilvn=2, nfilvs=2  
6    
7    real matriceun(iim,iim,nfilun), matriceus(iim,iim,nfilus)    ! North:
8    real matricevn(iim,iim,nfilvn), matricevs(iim,iim,nfilvs)    real, allocatable:: matriceun(:, :, :), matrinvn(:, :, :)
9    real matrinvn(iim,iim,nfilun), matrinvs(iim,iim,nfilus)    ! (iim, iim, 2:jfiltnu)
10    
11      real, allocatable:: matricevn(:, :, :) ! (iim, iim, jfiltnv)
12    
13    private iim, nfilun, nfilus, nfilvn, nfilvs    ! South:
14      real, allocatable:: matriceus(:, :, :), matrinvs(:, :, :)
15      ! (iim, iim, jfiltsu:jjm)
16    
17      real, allocatable:: matricevs(:, :, :) ! (iim, iim, jfiltsv:jjm)
18    
19  contains  contains
20    
# Line 34  contains Line 37  contains
37    
38      ! The modes are filtered from modfrst to modemax.      ! The modes are filtered from modfrst to modemax.
39    
     USE dimens_m, ONLY : iim, jjm  
     use conf_gcm_m, ONLY : fxyhypb, ysinus  
     USE comgeom, ONLY : rlatu, rlatv, xprimu  
     use nr_util, only: pi  
     USE serre, ONLY : alphax  
40      USE coefils, ONLY : coefilu, coefilu2, coefilv, coefilv2, eignfnu, &      USE coefils, ONLY : coefilu, coefilu2, coefilv, coefilv2, eignfnu, &
41           eignfnv, modfrstu, modfrstv           eignfnv, modfrstu, modfrstv
42        USE dimens_m, ONLY : iim, jjm
43        USE dynetat0_m, ONLY : rlatu, rlatv, xprimu, grossismx
44        use inifgn_m, only: inifgn
45        use nr_util, only: pi
46    
47      ! Local:      ! Local:
48      REAL dlonu(iim), dlatu(jjm)      REAL dlatu(jjm)
49      REAL rlamda(2: iim), eignvl(iim)      REAL rlamda(2: iim), eignvl(iim)
50    
51      REAL lamdamax, cof      REAL lamdamax, cof
52      INTEGER i, j, modemax, imx, k, kf      INTEGER i, j, modemax, imx, k, kf
53      REAL dymin, dxmin, colat0      REAL dymin, colat0
54      REAL eignft(iim, iim), coff      REAL eignft(iim, iim), coff
     EXTERNAL inifgn  
55    
56      !-----------------------------------------------------------      !-----------------------------------------------------------
57    
58      print *, "Call sequence information: inifilr"      print *, "Call sequence information: inifilr"
59    
     DO i = 1, iim  
        dlonu(i) = xprimu(i)  
     END DO  
   
60      CALL inifgn(eignvl)      CALL inifgn(eignvl)
61    
62      PRINT *, 'EIGNVL '      PRINT *, 'EIGNVL '
# Line 79  contains Line 76  contains
76         dlatu(j) = rlatu(j) - rlatu(j+1)         dlatu(j) = rlatu(j) - rlatu(j+1)
77      END DO      END DO
78    
     dxmin = dlonu(1)  
     DO i = 2, iim  
        dxmin = min(dxmin, dlonu(i))  
     END DO  
79      dymin = dlatu(1)      dymin = dlatu(1)
80      DO j = 2, jjm      DO j = 2, jjm
81         dymin = min(dymin, dlatu(j))         dymin = min(dymin, dlatu(j))
82      END DO      END DO
83    
84      colat0 = min(0.5, dymin/dxmin)      colat0 = min(0.5, dymin / minval(xprimu(:iim)))
   
     IF (.NOT. fxyhypb .AND. ysinus) THEN  
        colat0 = 0.6  
        ! À revoir pour ysinus  
        alphax = 0.  
     END IF  
85    
86      PRINT *, 'colat0 = ', colat0      PRINT *, 'colat0 = ', colat0
     PRINT *, 'alphax = ', alphax  
87    
88      IF (alphax == 1.) THEN      lamdamax = iim / (pi * colat0 / grossismx)
        PRINT *, 'alphax doit etre < a 1. Corriger '  
        STOP 1  
     END IF  
   
     lamdamax = iim / (pi * colat0 * (1. - alphax))  
89      rlamda = lamdamax / sqrt(abs(eignvl(2: iim)))      rlamda = lamdamax / sqrt(abs(eignvl(2: iim)))
90    
91      DO j = 1, jjm      DO j = 1, jjm
# Line 255  contains Line 236  contains
236      PRINT *, 'Modes premiers u '      PRINT *, 'Modes premiers u '
237      PRINT 334, modfrstu      PRINT 334, modfrstu
238    
239      IF (nfilun < jfiltnu) THEN      allocate(matriceun(iim, iim, 2:jfiltnu), matrinvn(iim, iim, 2:jfiltnu))
240         PRINT *, 'le parametre nfilun utilise pour la matrice ', &      allocate(matricevn(iim, iim, jfiltnv))
241              'matriceun est trop petit ! '      allocate(matricevs(iim, iim, jfiltsv:jjm))
242         PRINT *, 'Le changer dans parafilt.h et le mettre a ', jfiltnu      allocate(matriceus(iim, iim, jfiltsu:jjm), matrinvs(iim, iim, jfiltsu:jjm))
        PRINT *, 'Pour information, nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', jfiltnu, &  
             jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
        STOP 1  
     END IF  
     IF (nfilun > jfiltnu+2) THEN  
        PRINT *, 'le parametre nfilun utilise pour la matrice ', &  
             'matriceun est trop grand ! Gachis de memoire ! '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', jfiltnu  
        PRINT *, 'Pour information, nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
     END IF  
     IF (nfilus < jjm-jfiltsu+1) THEN  
        PRINT *, 'le parametre nfilus utilise pour la matrice ', &  
             'matriceus est trop petit ! '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', &  
             jjm - jfiltsu + 1  
        PRINT *, 'Pour information , nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
        STOP 1  
     END IF  
     IF (nfilus > jjm-jfiltsu+3) THEN  
        PRINT *, 'le parametre nfilus utilise pour la matrice ', &  
             'matriceus est trop grand ! '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', &  
             jjm - jfiltsu + 1  
        PRINT *, 'Pour information , nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
     END IF  
     IF (nfilvn < jfiltnv) THEN  
        PRINT *, 'le parametre nfilvn utilise pour la matrice ', &  
             'matricevn est trop petit ! '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', jfiltnv  
        PRINT *, 'Pour information , nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
        STOP 1  
     END IF  
     IF (nfilvn > jfiltnv+2) THEN  
        PRINT *, 'le parametre nfilvn utilise pour la matrice ', &  
             'matricevn est trop grand ! Gachis de memoire ! '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', jfiltnv  
        PRINT *, 'Pour information , nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
     END IF  
     IF (nfilvs < jjm-jfiltsv+1) THEN  
        PRINT *, 'le parametre nfilvs utilise pour la matrice ', &  
             'matricevs est trop petit ! Le changer dans parafilt.h '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', &  
             jjm - jfiltsv + 1  
        PRINT *, 'Pour information , nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
        STOP 1  
     END IF  
     IF (nfilvs > jjm-jfiltsv+3) THEN  
        PRINT *, 'le parametre nfilvs utilise pour la matrice ', &  
             'matricevs est trop grand ! Gachis de memoire ! '  
        PRINT *, 'Le changer dans parafilt.h et le mettre a ', &  
             jjm - jfiltsv + 1  
        PRINT *, 'Pour information , nfilun, nfilus, nfilvn, nfilvs ', &  
             'doivent etre egaux successivement a ', &  
             jfiltnu, jjm - jfiltsu + 1, jfiltnv, jjm - jfiltsv + 1  
     END IF  
243    
244      ! Calcul de la matrice filtre 'matriceu' pour les champs situes      ! Calcul de la matrice filtre 'matriceu' pour les champs situes
245      ! sur la grille scalaire      ! sur la grille scalaire
# Line 352  contains Line 265  contains
265            end IF            end IF
266            eignft(i, :) = eignfnv(:, i) * coff            eignft(i, :) = eignfnv(:, i) * coff
267         END DO         END DO
268         matriceus(:, :, j - jfiltsu + 1) = matmul(eignfnv, eignft)         matriceus(:, :, j) = matmul(eignfnv, eignft)
269      END DO      END DO
270    
271      ! Calcul de la matrice filtre 'matricev' pour les champs situes      ! Calcul de la matrice filtre 'matricev' pour les champs situes
# Line 379  contains Line 292  contains
292            end IF            end IF
293            eignft(i, :) = eignfnu(:, i)*coff            eignft(i, :) = eignfnu(:, i)*coff
294         END DO         END DO
295         matricevs(:, :, j-jfiltsv+1) = matmul(eignfnu, eignft)         matricevs(:, :, j) = matmul(eignfnu, eignft)
296      END DO      END DO
297    
298      ! Calcul de la matrice filtre 'matrinv' pour les champs situes      ! Calcul de la matrice filtre 'matrinv' pour les champs situes
# Line 406  contains Line 319  contains
319            end IF            end IF
320            eignft(i, :) = eignfnv(:, i)*coff            eignft(i, :) = eignfnv(:, i)*coff
321         END DO         END DO
322         matrinvs(:, :, j-jfiltsu+1) = matmul(eignfnv, eignft)         matrinvs(:, :, j) = matmul(eignfnv, eignft)
323      END DO      END DO
324    
325  334 FORMAT (1X, 24I3)  334 FORMAT (1X, 24I3)
Legend:
Removed from v.82  
changed lines
  Added in v.139
  ViewVC Help
Powered by ViewVC 1.1.21