/[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 113 by guez, Thu Sep 18 19:56:46 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      ! South:
14      real, allocatable:: matriceus(:, :, :), matrinvs(:, :, :)
15      ! (iim, iim, jfiltsu:jjm)
16    
17    private iim, nfilun, nfilus, nfilvn, nfilvs    real, allocatable:: matricevs(:, :, :) ! (iim, iim, jfiltsv:jjm)
18    
19  contains  contains
20    
# Line 36  contains Line 39  contains
39    
40      USE coefils, ONLY : coefilu, coefilu2, coefilv, coefilv2, eignfnu, &      USE coefils, ONLY : coefilu, coefilu2, coefilv, coefilv2, eignfnu, &
41           eignfnv, modfrstu, modfrstv           eignfnv, modfrstu, modfrstv
     USE comgeom, ONLY : rlatu, rlatv, xprimu  
42      USE dimens_m, ONLY : iim, jjm      USE dimens_m, ONLY : iim, jjm
43        USE dynetat0_m, ONLY : rlatu, rlatv, xprimu, grossismx
44      use inifgn_m, only: inifgn      use inifgn_m, only: inifgn
45      use nr_util, only: pi      use nr_util, only: pi
     USE serre, ONLY : grossismx  
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
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 78  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)))
85    
86      PRINT *, 'colat0 = ', colat0      PRINT *, 'colat0 = ', colat0
87    
# Line 242  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 339  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 366  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 393  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.113  
changed lines
  Added in v.139
  ViewVC Help
Powered by ViewVC 1.1.21