/[lmdze]/trunk/dyn3d/comgeom.f
ViewVC logotype

Diff of /trunk/dyn3d/comgeom.f

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

trunk/dyn3d/comgeom.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC trunk/dyn3d/comgeom.f revision 97 by guez, Fri Apr 25 14:58:31 2014 UTC
# Line 1  Line 1 
1  module comgeom  module comgeom
2    
3    use dimens_m, only: iim, jjm    use dimens_m, only: iim, jjm
   use paramet_m, only: ip1jmp1, ip1jm  
4    
5    implicit none    implicit none
6    
7    private iim, jjm, ip1jmp1, ip1jm    private iim, jjm
8    
9    real cu_2d(iim + 1, jjm + 1), cv_2d(iim + 1, jjm) ! in m    real cu_2d(iim + 1, jjm + 1), cv_2d(iim + 1, jjm) ! in m
10    real cu(ip1jmp1), cv(ip1jm) ! in m    real cu((iim + 1) * (jjm + 1)), cv((iim + 1) * jjm) ! in m
11    equivalence (cu, cu_2d), (cv, cv_2d)    equivalence (cu, cu_2d), (cv, cv_2d)
12    
13    real unscu2_2d(iim + 1, jjm + 1) ! in m-2    real unscu2_2d(iim + 1, jjm + 1) ! in m-2
14    real unscu2(ip1jmp1) ! in m-2    real unscu2((iim + 1) * (jjm + 1)) ! in m-2
15    equivalence (unscu2, unscu2_2d)    equivalence (unscu2, unscu2_2d)
16    
17    real unscv2_2d(iim + 1, jjm) ! in m-2    real unscv2_2d(iim + 1, jjm) ! in m-2
18    real unscv2(ip1jm) ! in m-2    real unscv2((iim + 1) * jjm) ! in m-2
19    equivalence (unscv2, unscv2_2d)    equivalence (unscv2, unscv2_2d)
20    
21    real aire(ip1jmp1), aire_2d(iim + 1, jjm + 1) ! in m2    real aire((iim + 1) * (jjm + 1)), aire_2d(iim + 1, jjm + 1) ! in m2
22    real airesurg_2d(iim + 1, jjm + 1), airesurg(ip1jmp1)    real airesurg_2d(iim + 1, jjm + 1), airesurg((iim + 1) * (jjm + 1))
23    equivalence (aire, aire_2d), (airesurg, airesurg_2d)    equivalence (aire, aire_2d), (airesurg, airesurg_2d)
24    
25    real aireu_2d(iim + 1, jjm + 1) ! in m2    real aireu_2d(iim + 1, jjm + 1) ! in m2
26    real aireu(ip1jmp1) ! in m2    real aireu((iim + 1) * (jjm + 1)) ! in m2
27    equivalence (aireu, aireu_2d)    equivalence (aireu, aireu_2d)
28    
29    real airev(ip1jm), airev_2d(iim + 1, jjm) ! in m2    real airev((iim + 1) * jjm), airev_2d(iim + 1, jjm) ! in m2
30    real unsaire(ip1jmp1), unsaire_2d(iim + 1, jjm + 1) ! in m-2    real unsaire((iim + 1) * (jjm + 1)), unsaire_2d(iim + 1, jjm + 1) ! in m-2
31    equivalence (airev, airev_2d), (unsaire, unsaire_2d)    equivalence (airev, airev_2d), (unsaire, unsaire_2d)
32    
33    real apoln, apols ! in m2    real apoln, apols ! in m2
34    
35    real unsairez_2d(iim + 1, jjm)    real unsairez_2d(iim + 1, jjm)
36    real unsairez(ip1jm)    real unsairez((iim + 1) * jjm)
37    equivalence (unsairez, unsairez_2d)    equivalence (unsairez, unsairez_2d)
38    
39    real alpha1_2d(iim + 1, jjm + 1)    real alpha1_2d(iim + 1, jjm + 1)
40    real alpha1(ip1jmp1)    real alpha1((iim + 1) * (jjm + 1))
41    equivalence (alpha1, alpha1_2d)    equivalence (alpha1, alpha1_2d)
42    
43    real alpha2_2d(iim + 1, jjm + 1)            real alpha2_2d(iim + 1, jjm + 1)        
44    real alpha2(ip1jmp1)    real alpha2((iim + 1) * (jjm + 1))
45    equivalence (alpha2, alpha2_2d)    equivalence (alpha2, alpha2_2d)
46    
47    real alpha3_2d(iim + 1, jjm + 1), alpha4_2d(iim + 1, jjm + 1)    real alpha3_2d(iim + 1, jjm + 1), alpha4_2d(iim + 1, jjm + 1)
48    real alpha3(ip1jmp1), alpha4(ip1jmp1)    real alpha3((iim + 1) * (jjm + 1)), alpha4((iim + 1) * (jjm + 1))
49    equivalence (alpha3, alpha3_2d), (alpha4, alpha4_2d)    equivalence (alpha3, alpha3_2d), (alpha4, alpha4_2d)
50    
51    real alpha1p2_2d(iim + 1, jjm + 1)            real alpha1p2_2d(iim + 1, jjm + 1)        
52    real alpha1p2(ip1jmp1)    real alpha1p2((iim + 1) * (jjm + 1))
53    equivalence (alpha1p2, alpha1p2_2d)    equivalence (alpha1p2, alpha1p2_2d)
54    
55    real alpha1p4_2d(iim + 1, jjm + 1), alpha2p3_2d(iim + 1, jjm + 1)    real alpha1p4_2d(iim + 1, jjm + 1), alpha2p3_2d(iim + 1, jjm + 1)
56    real alpha1p4(ip1jmp1), alpha2p3(ip1jmp1)    real alpha1p4((iim + 1) * (jjm + 1)), alpha2p3((iim + 1) * (jjm + 1))
57    equivalence (alpha1p4, alpha1p4_2d), (alpha2p3, alpha2p3_2d)    equivalence (alpha1p4, alpha1p4_2d), (alpha2p3, alpha2p3_2d)
58    
59    real alpha3p4(ip1jmp1)    real alpha3p4((iim + 1) * (jjm + 1))
60    real alpha3p4_2d(iim + 1, jjm + 1)        real alpha3p4_2d(iim + 1, jjm + 1)    
61    equivalence (alpha3p4, alpha3p4_2d)    equivalence (alpha3p4, alpha3p4_2d)
62    
63    real fext_2d(iim + 1, jjm), constang_2d(iim + 1, jjm + 1)    real fext_2d(iim + 1, jjm), constang_2d(iim + 1, jjm + 1)
64    real fext(ip1jm), constang(ip1jmp1)    real fext((iim + 1) * jjm), constang((iim + 1) * (jjm + 1))
65    equivalence (fext, fext_2d), (constang, constang_2d)    equivalence (fext, fext_2d), (constang, constang_2d)
66    
67    real rlatu(jjm + 1)    real rlatu(jjm + 1)
# Line 77  module comgeom Line 76  module comgeom
76    ! (longitudes of points of the "scalar" and "v" grid, in rad)    ! (longitudes of points of the "scalar" and "v" grid, in rad)
77    
78    real cuvsurcv_2d(iim + 1, jjm), cvsurcuv_2d(iim + 1, jjm) ! no dimension    real cuvsurcv_2d(iim + 1, jjm), cvsurcuv_2d(iim + 1, jjm) ! no dimension
79    real cuvsurcv(ip1jm), cvsurcuv(ip1jm) ! no dimension    real cuvsurcv((iim + 1) * jjm), cvsurcuv((iim + 1) * jjm) ! no dimension
80    equivalence (cuvsurcv, cuvsurcv_2d), (cvsurcuv, cvsurcuv_2d)    equivalence (cuvsurcv, cuvsurcv_2d), (cvsurcuv, cvsurcuv_2d)
81    
82    real cvusurcu_2d(iim + 1, jjm + 1), cusurcvu_2d(iim + 1, jjm + 1)    real cvusurcu_2d(iim + 1, jjm + 1), cusurcvu_2d(iim + 1, jjm + 1)
83    ! no dimension    ! no dimension
84    real cvusurcu(ip1jmp1), cusurcvu(ip1jmp1) ! no dimension    real cvusurcu((iim + 1) * (jjm + 1)), cusurcvu((iim + 1) * (jjm + 1))
85      ! no dimension
86    equivalence (cvusurcu, cvusurcu_2d), (cusurcvu, cusurcvu_2d)    equivalence (cvusurcu, cvusurcu_2d), (cusurcvu, cusurcvu_2d)
87    
88    real cuvscvgam1_2d(iim + 1, jjm)    real cuvscvgam1_2d(iim + 1, jjm)
89    real cuvscvgam1(ip1jm)    real cuvscvgam1((iim + 1) * jjm)
90    equivalence (cuvscvgam1, cuvscvgam1_2d)    equivalence (cuvscvgam1, cuvscvgam1_2d)
91    
92    real cuvscvgam2_2d(iim + 1, jjm), cvuscugam1_2d(iim + 1, jjm + 1)    real cuvscvgam2_2d(iim + 1, jjm), cvuscugam1_2d(iim + 1, jjm + 1)
93    real cuvscvgam2(ip1jm), cvuscugam1(ip1jmp1)    real cuvscvgam2((iim + 1) * jjm), cvuscugam1((iim + 1) * (jjm + 1))
94    equivalence (cuvscvgam2, cuvscvgam2_2d), (cvuscugam1, cvuscugam1_2d)    equivalence (cuvscvgam2, cuvscvgam2_2d), (cvuscugam1, cvuscugam1_2d)
95    
96    real cvuscugam2_2d(iim + 1, jjm + 1), cvscuvgam_2d(iim + 1, jjm)    real cvuscugam2_2d(iim + 1, jjm + 1), cvscuvgam_2d(iim + 1, jjm)
97    real cvuscugam2(ip1jmp1), cvscuvgam(ip1jm)    real cvuscugam2((iim + 1) * (jjm + 1)), cvscuvgam((iim + 1) * jjm)
98    equivalence (cvuscugam2, cvuscugam2_2d), (cvscuvgam, cvscuvgam_2d)    equivalence (cvuscugam2, cvuscugam2_2d), (cvscuvgam, cvscuvgam_2d)
99    
100    real cuscvugam(ip1jmp1)    real cuscvugam((iim + 1) * (jjm + 1))
101    real cuscvugam_2d(iim + 1, jjm + 1)    real cuscvugam_2d(iim + 1, jjm + 1)
102    equivalence (cuscvugam, cuscvugam_2d)    equivalence (cuscvugam, cuscvugam_2d)
103    
104    real unsapolnga1, unsapolnga2, unsapolsga1, unsapolsga2                    real unsapolnga1, unsapolnga2, unsapolsga1, unsapolsga2                
105    
106    real unsair_gam1_2d(iim + 1, jjm + 1), unsair_gam2_2d(iim + 1, jjm + 1)    real unsair_gam1_2d(iim + 1, jjm + 1), unsair_gam2_2d(iim + 1, jjm + 1)
107    real unsair_gam1(ip1jmp1), unsair_gam2(ip1jmp1)    real unsair_gam1((iim + 1) * (jjm + 1)), unsair_gam2((iim + 1) * (jjm + 1))
108    equivalence (unsair_gam1, unsair_gam1_2d), (unsair_gam2, unsair_gam2_2d)    equivalence (unsair_gam1, unsair_gam1_2d), (unsair_gam2, unsair_gam2_2d)
109    
110    real unsairz_gam_2d(iim + 1, jjm)    real unsairz_gam_2d(iim + 1, jjm)
111    real unsairz_gam(ip1jm)    real unsairz_gam((iim + 1) * jjm)
112    equivalence (unsairz_gam, unsairz_gam_2d)    equivalence (unsairz_gam, unsairz_gam_2d)
113    
114    real xprimu(iim + 1), xprimv(iim + 1)    real xprimu(iim + 1), xprimv(iim + 1)
# Line 164  contains Line 164  contains
164      USE comconst, ONLY : g, omeg, rad      USE comconst, ONLY : g, omeg, rad
165      USE comdissnew, ONLY : coefdis, nitergdiv, nitergrot, niterh      USE comdissnew, ONLY : coefdis, nitergdiv, nitergrot, niterh
166      use conf_gcm_m, ONLY : fxyhypb, ysinus      use conf_gcm_m, ONLY : fxyhypb, ysinus
     USE dimens_m, ONLY : iim, jjm  
167      use fxy_m, only: fxy      use fxy_m, only: fxy
168      use fxyhyper_m, only: fxyhyper      use fxyhyper_m, only: fxyhyper
169        use fxysinus_m, only: fxysinus
170      use jumble, only: new_unit      use jumble, only: new_unit
171      use nr_util, only: pi      use nr_util, only: pi
172      USE paramet_m, ONLY : iip1, jjp1      USE paramet_m, ONLY : iip1, jjp1
173      USE serre, ONLY : alphax, alphay, clat, clon, dzoomx, dzoomy, grossismx, &      USE serre, ONLY : alphax, alphay, clat, clon, dzoomx, dzoomy, grossismx, &
174           grossismy, pxo, pyo, taux, tauy, transx, transy           grossismy, pxo, pyo, taux, tauy, transx, transy
175      ! Modifies pxo, pyo, transx, transy      ! Modifiés pxo, pyo, transx, transy
   
     ! Variables locales  
176    
177        ! Local:
178      INTEGER i, j, itmax, itmay, iter, unit      INTEGER i, j, itmax, itmay, iter, unit
179      REAL cvu(iip1, jjp1), cuv(iip1, jjm)      REAL cvu(iip1, jjp1), cuv(iip1, jjm)
180      REAL ai14, ai23, airez, un4rad2      REAL ai14, ai23, airez, un4rad2
# Line 217  contains Line 216  contains
216      print *, "gamdi_grot = ", gamdi_grot      print *, "gamdi_grot = ", gamdi_grot
217      print *, "gamdi_h = ", gamdi_h      print *, "gamdi_h = ", gamdi_h
218    
219      IF (.NOT. fxyhypb) THEN      IF (fxyhypb) THEN
220           ! Utilisation de fxyhyper, f(x, y) à dérivée tangente hyperbolique
221           print *, 'inigeom: Y = latitude, dérivée tangente hyperbolique'
222           CALL fxyhyper(clat, grossismy, dzoomy, tauy, clon, grossismx, dzoomx, &
223                taux, rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
224                yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, &
225                rlonp025, xprimp025)
226        ELSE
227         IF (ysinus) THEN         IF (ysinus) THEN
228            print *, ' Inigeom, Y = Sinus (Latitude) '            print *, 'inigeom: Y = sin(latitude)'
229            ! utilisation de f(x, y) avec y = sinus de la latitude            ! Utilisation de f(x, y) avec y = sinus de la latitude
230            CALL fxysinus(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, &            CALL fxysinus(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, &
231                 rlatu2, yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, &                 rlatu2, yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, &
232                 xprimm025, rlonp025, xprimp025)                 xprimm025, rlonp025, xprimp025)
# Line 269  contains Line 275  contains
275                 yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, &                 yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, &
276                 rlonp025, xprimp025)                 rlonp025, xprimp025)
277         END IF         END IF
     ELSE  
        ! Utilisation de fxyhyper, f(x, y) à dérivée tangente hyperbolique  
        print *, 'Inigeom, Y = Latitude, dérivée tangente hyperbolique'  
        CALL fxyhyper(clat, grossismy, dzoomy, tauy, clon, grossismx, dzoomx, &  
             taux, rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &  
             yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, &  
             rlonp025, xprimp025)  
278      END IF      END IF
279    
280      rlatu(1) = pi / 2.      rlatu(1) = pi / 2.
# Line 532  contains Line 531  contains
531      END DO      END DO
532    
533      ! Périodicité en longitude      ! Périodicité en longitude
   
     DO j = 1, jjm  
        fext_2d(iip1, j) = fext_2d(1, j)  
     END DO  
534      DO j = 1, jjp1      DO j = 1, jjp1
535         constang_2d(iip1, j) = constang_2d(1, j)         constang_2d(iip1, j) = constang_2d(1, j)
536      END DO      END DO

Legend:
Removed from v.78  
changed lines
  Added in v.97

  ViewVC Help
Powered by ViewVC 1.1.21