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

Diff of /trunk/Sources/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/Sources/dyn3d/comgeom.f revision 134 by guez, Wed Apr 29 15:47:56 2015 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 124  contains Line 124  contains
124      ! Calcul des élongations cuij1, ..., cuij4, cvij1, ..., cvij4 aux mêmes      ! Calcul des élongations cuij1, ..., cuij4, cvij1, ..., cvij4 aux mêmes
125      ! endroits que les aires aireij1_2d, ..., aireij4_2d.      ! endroits que les aires aireij1_2d, ..., aireij4_2d.
126    
127      ! Choix entre une fonction "f(y)" à dérivée sinusoïdale ou à      ! Fonction "f(y)" à dérivée tangente hyperbolique. Calcul des
128      ! dérivée tangente hyperbolique. Calcul des coefficients cu_2d,      ! coefficients cu_2d, cv_2d, 1. / cu_2d**2, 1. / cv_2d**2. Les
129      ! cv_2d, 1. / cu_2d**2, 1. / cv_2d**2. Les coefficients cu_2d et cv_2d      ! coefficients cu_2d et cv_2d permettent de passer des vitesses
130      ! permettent de passer des vitesses naturelles aux vitesses      ! naturelles aux vitesses covariantes et contravariantes, ou
131      ! covariantes et contravariantes, ou vice-versa.      ! vice-versa.
132    
133      ! On a :      ! On a :
134      ! u(covariant) = cu_2d * u(naturel), u(contravariant) = u(naturel) / cu_2d      ! u(covariant) = cu_2d * u(naturel), u(contravariant) = u(naturel) / cu_2d
# Line 163  contains Line 163  contains
163    
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 fxhyp_m, only: fxhyp
167      USE dimens_m, ONLY : iim, jjm      use fyhyp_m, only: fyhyp
     use fxy_m, only: fxy  
     use fxyhyper_m, only: fxyhyper  
168      use jumble, only: new_unit      use jumble, only: new_unit
169      use nr_util, only: pi      use nr_util, only: pi
170      USE paramet_m, ONLY : iip1, jjp1      USE paramet_m, ONLY : iip1, jjp1
     USE serre, ONLY : alphax, alphay, clat, clon, dzoomx, dzoomy, grossismx, &  
          grossismy, pxo, pyo, taux, tauy, transx, transy  
     ! Modifies pxo, pyo, transx, transy  
   
     ! Variables locales  
171    
172      INTEGER i, j, itmax, itmay, iter, unit      ! Local:
173        INTEGER i, j, unit
174      REAL cvu(iip1, jjp1), cuv(iip1, jjm)      REAL cvu(iip1, jjp1), cuv(iip1, jjm)
175      REAL ai14, ai23, airez, un4rad2      REAL ai14, ai23, airez, un4rad2
     REAL eps, x1, xo1, f, df, xdm, y1, yo1, ydm  
176      REAL coslatm, coslatp, radclatm, radclatp      REAL coslatm, coslatp, radclatm, radclatp
177      REAL, dimension(iip1, jjp1):: cuij1, cuij2, cuij3, cuij4 ! in m      REAL, dimension(iip1, jjp1):: cuij1, cuij2, cuij3, cuij4 ! in m
178      REAL, dimension(iip1, jjp1):: cvij1, cvij2, cvij3, cvij4 ! in m      REAL, dimension(iip1, jjp1):: cvij1, cvij2, cvij3, cvij4 ! in m
179      REAL rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)      REAL rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
180      real yprimv(jjm), yprimu(jjp1)      real yprimu(jjp1)
181      REAL gamdi_gdiv, gamdi_grot, gamdi_h      REAL gamdi_gdiv, gamdi_grot, gamdi_h
182      REAL rlonm025(iip1), xprimm025(iip1), rlonp025(iip1), xprimp025(iip1)      REAL xprimm025(iip1), xprimp025(iip1)
183      real, dimension(iim + 1, jjm + 1):: aireij1_2d, aireij2_2d, aireij3_2d, &      real, dimension(iim + 1, jjm + 1):: aireij1_2d, aireij2_2d, aireij3_2d, &
184           aireij4_2d ! in m2           aireij4_2d ! in m2
185      real airuscv2_2d(iim + 1, jjm)      real airuscv2_2d(iim + 1, jjm)
# Line 197  contains Line 190  contains
190    
191      PRINT *, 'Call sequence information: inigeom'      PRINT *, 'Call sequence information: inigeom'
192    
193      IF (nitergdiv/=2) THEN      IF (nitergdiv /= 2) THEN
194         gamdi_gdiv = coefdis / (real(nitergdiv)-2.)         gamdi_gdiv = coefdis / (nitergdiv - 2)
195      ELSE      ELSE
196         gamdi_gdiv = 0.         gamdi_gdiv = 0.
197      END IF      END IF
198      IF (nitergrot/=2) THEN  
199         gamdi_grot = coefdis / (real(nitergrot)-2.)      IF (nitergrot /= 2) THEN
200           gamdi_grot = coefdis / (nitergrot - 2)
201      ELSE      ELSE
202         gamdi_grot = 0.         gamdi_grot = 0.
203      END IF      END IF
204      IF (niterh/=2) THEN  
205         gamdi_h = coefdis / (real(niterh)-2.)      IF (niterh /= 2) THEN
206           gamdi_h = coefdis / (niterh - 2)
207      ELSE      ELSE
208         gamdi_h = 0.         gamdi_h = 0.
209      END IF      END IF
# Line 217  contains Line 212  contains
212      print *, "gamdi_grot = ", gamdi_grot      print *, "gamdi_grot = ", gamdi_grot
213      print *, "gamdi_h = ", gamdi_h      print *, "gamdi_h = ", gamdi_h
214    
215      IF (.NOT. fxyhypb) THEN      CALL fyhyp(rlatu, yprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
216         IF (ysinus) THEN      CALL fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
           print *, ' Inigeom, Y = Sinus (Latitude) '  
           ! utilisation de f(x, y) avec y = sinus de la latitude  
           CALL fxysinus(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, &  
                rlatu2, yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, &  
                xprimm025, rlonp025, xprimp025)  
        ELSE  
           print *, 'Inigeom, Y = Latitude, der. sinusoid .'  
           ! utilisation de f(x, y) a tangente sinusoidale, y etant la latit  
   
           pxo = clon * pi / 180.  
           pyo = 2. * clat * pi / 180.  
   
           ! determination de transx (pour le zoom) par Newton-Raphson  
   
           itmax = 10  
           eps = .1E-7  
   
           xo1 = 0.  
           DO iter = 1, itmax  
              x1 = xo1  
              f = x1 + alphax * sin(x1-pxo)  
              df = 1. + alphax * cos(x1-pxo)  
              x1 = x1 - f / df  
              xdm = abs(x1-xo1)  
              IF (xdm<=eps) EXIT  
              xo1 = x1  
           END DO  
   
           transx = xo1  
   
           itmay = 10  
           eps = .1E-7  
   
           yo1 = 0.  
           DO iter = 1, itmay  
              y1 = yo1  
              f = y1 + alphay * sin(y1-pyo)  
              df = 1. + alphay * cos(y1-pyo)  
              y1 = y1 - f / df  
              ydm = abs(y1-yo1)  
              IF (ydm<=eps) EXIT  
              yo1 = y1  
           END DO  
   
           transy = yo1  
   
           CALL fxy(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &  
                yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, &  
                rlonp025, xprimp025)  
        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)  
     END IF  
217    
218      rlatu(1) = pi / 2.      rlatu(1) = pi / 2.
219      rlatu(jjp1) = -rlatu(1)      rlatu(jjp1) = -rlatu(1)
# Line 532  contains Line 469  contains
469      END DO      END DO
470    
471      ! Périodicité en longitude      ! Périodicité en longitude
   
     DO j = 1, jjm  
        fext_2d(iip1, j) = fext_2d(1, j)  
     END DO  
472      DO j = 1, jjp1      DO j = 1, jjp1
473         constang_2d(iip1, j) = constang_2d(1, j)         constang_2d(iip1, j) = constang_2d(1, j)
474      END DO      END DO
Legend:
Removed from v.78  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21