/[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.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/Sources/filtrez/inifilr.f revision 136 by guez, Thu Apr 30 18:35:49 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 comgeom, ONLY : rlatu, rlatv, xprimu
43        USE dimens_m, ONLY : iim, jjm
44        use inifgn_m, only: inifgn
45        use nr_util, only: pi
46        USE serre, ONLY : grossismx
47    
48      ! Local:      ! Local:
49      REAL dlonu(iim), dlatu(jjm)      REAL dlatu(jjm)
50      REAL rlamda(2: iim), eignvl(iim)      REAL rlamda(2: iim), eignvl(iim)
51    
52      REAL lamdamax, cof      REAL lamdamax, cof
53      INTEGER i, j, modemax, imx, k, kf      INTEGER i, j, modemax, imx, k, kf
54      REAL dymin, dxmin, colat0      REAL dymin, colat0
55      REAL eignft(iim, iim), coff      REAL eignft(iim, iim), coff
     EXTERNAL inifgn  
56    
57      !-----------------------------------------------------------      !-----------------------------------------------------------
58    
59      print *, "Call sequence information: inifilr"      print *, "Call sequence information: inifilr"
60    
     DO i = 1, iim  
        dlonu(i) = xprimu(i)  
     END DO  
   
61      CALL inifgn(eignvl)      CALL inifgn(eignvl)
62    
63      PRINT *, 'EIGNVL '      PRINT *, 'EIGNVL '
# Line 79  contains Line 77  contains
77         dlatu(j) = rlatu(j) - rlatu(j+1)         dlatu(j) = rlatu(j) - rlatu(j+1)
78      END DO      END DO
79    
     dxmin = dlonu(1)  
     DO i = 2, iim  
        dxmin = min(dxmin, dlonu(i))  
     END DO  
80      dymin = dlatu(1)      dymin = dlatu(1)
81      DO j = 2, jjm      DO j = 2, jjm
82         dymin = min(dymin, dlatu(j))         dymin = min(dymin, dlatu(j))
83      END DO      END DO
84    
85      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  
86    
87      PRINT *, 'colat0 = ', colat0      PRINT *, 'colat0 = ', colat0
     PRINT *, 'alphax = ', alphax  
88    
89      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))  
90      rlamda = lamdamax / sqrt(abs(eignvl(2: iim)))      rlamda = lamdamax / sqrt(abs(eignvl(2: iim)))
91    
92      DO j = 1, jjm      DO j = 1, jjm
# Line 255  contains Line 237  contains
237      PRINT *, 'Modes premiers u '      PRINT *, 'Modes premiers u '
238      PRINT 334, modfrstu      PRINT 334, modfrstu
239    
240      IF (nfilun < jfiltnu) THEN      allocate(matriceun(iim, iim, 2:jfiltnu), matrinvn(iim, iim, 2:jfiltnu))
241         PRINT *, 'le parametre nfilun utilise pour la matrice ', &      allocate(matricevn(iim, iim, jfiltnv))
242              'matriceun est trop petit ! '      allocate(matricevs(iim, iim, jfiltsv:jjm))
243         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  
244    
245      ! Calcul de la matrice filtre 'matriceu' pour les champs situes      ! Calcul de la matrice filtre 'matriceu' pour les champs situes
246      ! sur la grille scalaire      ! sur la grille scalaire
# Line 352  contains Line 266  contains
266            end IF            end IF
267            eignft(i, :) = eignfnv(:, i) * coff            eignft(i, :) = eignfnv(:, i) * coff
268         END DO         END DO
269         matriceus(:, :, j - jfiltsu + 1) = matmul(eignfnv, eignft)         matriceus(:, :, j) = matmul(eignfnv, eignft)
270      END DO      END DO
271    
272      ! Calcul de la matrice filtre 'matricev' pour les champs situes      ! Calcul de la matrice filtre 'matricev' pour les champs situes
# Line 379  contains Line 293  contains
293            end IF            end IF
294            eignft(i, :) = eignfnu(:, i)*coff            eignft(i, :) = eignfnu(:, i)*coff
295         END DO         END DO
296         matricevs(:, :, j-jfiltsv+1) = matmul(eignfnu, eignft)         matricevs(:, :, j) = matmul(eignfnu, eignft)
297      END DO      END DO
298    
299      ! Calcul de la matrice filtre 'matrinv' pour les champs situes      ! Calcul de la matrice filtre 'matrinv' pour les champs situes
# Line 406  contains Line 320  contains
320            end IF            end IF
321            eignft(i, :) = eignfnv(:, i)*coff            eignft(i, :) = eignfnv(:, i)*coff
322         END DO         END DO
323         matrinvs(:, :, j-jfiltsu+1) = matmul(eignfnv, eignft)         matrinvs(:, :, j) = matmul(eignfnv, eignft)
324      END DO      END DO
325    
326  334 FORMAT (1X, 24I3)  334 FORMAT (1X, 24I3)
Legend:
Removed from v.76  
changed lines
  Added in v.136
  ViewVC Help
Powered by ViewVC 1.1.21