/[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.f revision 119 by guez, Wed Jan 7 14:34:57 2015 UTC trunk/Sources/dyn3d/comgeom.f revision 140 by guez, Fri Jun 5 18:58:06 2015 UTC
# Line 64  module comgeom Line 64  module comgeom
64    real fext((iim + 1) * jjm), constang((iim + 1) * (jjm + 1))    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    
   real rlatu(jjm + 1)  
   ! (latitudes of points of the "scalar" and "u" grid, in rad)  
   
   real rlatv(jjm)  
   ! (latitudes of points of the "v" grid, in rad, in decreasing order)  
   
   real rlonu(iim + 1) ! longitudes of points of the "u" grid, in rad  
   
   real rlonv(iim + 1)  
   ! (longitudes of points of the "scalar" and "v" grid, in rad)  
   
67    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
68    real cuvsurcv((iim + 1) * jjm), cvsurcuv((iim + 1) * jjm) ! no dimension    real cuvsurcv((iim + 1) * jjm), cvsurcuv((iim + 1) * jjm) ! no dimension
69    equivalence (cuvsurcv, cuvsurcv_2d), (cvsurcuv, cvsurcuv_2d)    equivalence (cuvsurcv, cuvsurcv_2d), (cvsurcuv, cvsurcuv_2d)
# Line 111  module comgeom Line 100  module comgeom
100    real unsairz_gam((iim + 1) * jjm)    real unsairz_gam((iim + 1) * jjm)
101    equivalence (unsairz_gam, unsairz_gam_2d)    equivalence (unsairz_gam, unsairz_gam_2d)
102    
   real xprimu(iim + 1), xprimv(iim + 1)  
   
103    save    save
104    
105  contains  contains
# Line 124  contains Line 111  contains
111      ! Calcul des élongations cuij1, ..., cuij4, cvij1, ..., cvij4 aux mêmes      ! Calcul des élongations cuij1, ..., cuij4, cvij1, ..., cvij4 aux mêmes
112      ! endroits que les aires aireij1_2d, ..., aireij4_2d.      ! endroits que les aires aireij1_2d, ..., aireij4_2d.
113    
114      ! Choix entre une fonction "f(y)" à dérivée sinusoïdale ou à      ! Fonction "f(y)" à dérivée tangente hyperbolique. Calcul des
115      ! dérivée tangente hyperbolique. Calcul des coefficients cu_2d,      ! coefficients cu_2d, cv_2d, 1. / cu_2d**2, 1. / cv_2d**2. Les
116      ! 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
117      ! permettent de passer des vitesses naturelles aux vitesses      ! naturelles aux vitesses covariantes et contravariantes, ou
118      ! covariantes et contravariantes, ou vice-versa.      ! vice-versa.
119    
120      ! On a :      ! On a :
121      ! 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 152  contains Line 139  contains
139      ! dépendant de j uniquement, sera ici indicé aussi en i pour un      ! dépendant de j uniquement, sera ici indicé aussi en i pour un
140      ! adressage plus facile en ij.      ! adressage plus facile en ij.
141    
142      ! xprimu et xprimv sont respectivement les valeurs de dx / dX aux      ! cv_2d est aux points v. cu_2d est aux points
143      ! points u et v. yprimu et yprimv sont respectivement les valeurs      ! u. Cf. "inigeom.txt".
     ! de dy / dY aux points u et v. rlatu et rlatv sont respectivement  
     ! les valeurs de la latitude aux points u et v. cvu et cv_2d sont  
     ! respectivement les valeurs de cv_2d aux points u et v.  
   
     ! cu_2d, cuv, cuscal, cuz sont respectivement les valeurs de cu_2d  
     ! aux points u, v, scalaires, et z. Cf. "inigeom.txt".  
144    
145      USE comconst, ONLY : g, omeg, rad      USE comconst, ONLY : g, omeg, rad
146      USE comdissnew, ONLY : coefdis, nitergdiv, nitergrot, niterh      USE comdissnew, ONLY : coefdis, nitergdiv, nitergrot, niterh
147      use fxhyp_m, only: fxhyp      use dynetat0_m, only: xprimp025, xprimm025, rlatu1, rlatu2, rlatu, rlatv, &
148      use fyhyp_m, only: fyhyp           yprimu1, yprimu2, rlonu, rlonv
149      use jumble, only: new_unit      use jumble, only: new_unit
150      use nr_util, only: pi      use nr_util, only: pi
151      USE paramet_m, ONLY : iip1, jjp1      USE paramet_m, ONLY : iip1, jjp1
152    
153      ! Local:      ! Local:
154      INTEGER i, j, unit      INTEGER i, j, unit
     REAL cvu(iip1, jjp1), cuv(iip1, jjm)  
155      REAL ai14, ai23, airez, un4rad2      REAL ai14, ai23, airez, un4rad2
156      REAL coslatm, coslatp, radclatm, radclatp      REAL coslatm, coslatp, radclatm, radclatp
157      REAL, dimension(iip1, jjp1):: cuij1, cuij2, cuij3, cuij4 ! in m      REAL, dimension(iip1, jjp1):: cuij1, cuij2, cuij3, cuij4 ! in m
158      REAL, dimension(iip1, jjp1):: cvij1, cvij2, cvij3, cvij4 ! in m      REAL, dimension(iip1, jjp1):: cvij1, cvij2, cvij3, cvij4 ! in m
     REAL rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)  
     real yprimu(jjp1)  
159      REAL gamdi_gdiv, gamdi_grot, gamdi_h      REAL gamdi_gdiv, gamdi_grot, gamdi_h
     REAL xprimm025(iip1), xprimp025(iip1)  
160      real, dimension(iim + 1, jjm + 1):: aireij1_2d, aireij2_2d, aireij3_2d, &      real, dimension(iim + 1, jjm + 1):: aireij1_2d, aireij2_2d, aireij3_2d, &
161           aireij4_2d ! in m2           aireij4_2d ! in m2
     real airuscv2_2d(iim + 1, jjm)  
     real airvscu2_2d(iim + 1, jjm), aiuscv2gam_2d(iim + 1, jjm)  
     real aivscu2gam_2d(iim + 1, jjm)  
162    
163      !------------------------------------------------------------------      !------------------------------------------------------------------
164    
165      PRINT *, 'Call sequence information: inigeom'      PRINT *, 'Call sequence information: inigeom'
166    
167      IF (nitergdiv/=2) THEN      IF (nitergdiv /= 2) THEN
168         gamdi_gdiv = coefdis / (real(nitergdiv)-2.)         gamdi_gdiv = coefdis / (nitergdiv - 2)
169      ELSE      ELSE
170         gamdi_gdiv = 0.         gamdi_gdiv = 0.
171      END IF      END IF
172      IF (nitergrot/=2) THEN  
173         gamdi_grot = coefdis / (real(nitergrot)-2.)      IF (nitergrot /= 2) THEN
174           gamdi_grot = coefdis / (nitergrot - 2)
175      ELSE      ELSE
176         gamdi_grot = 0.         gamdi_grot = 0.
177      END IF      END IF
178      IF (niterh/=2) THEN  
179         gamdi_h = coefdis / (real(niterh)-2.)      IF (niterh /= 2) THEN
180           gamdi_h = coefdis / (niterh - 2)
181      ELSE      ELSE
182         gamdi_h = 0.         gamdi_h = 0.
183      END IF      END IF
# Line 210  contains Line 186  contains
186      print *, "gamdi_grot = ", gamdi_grot      print *, "gamdi_grot = ", gamdi_grot
187      print *, "gamdi_h = ", gamdi_h      print *, "gamdi_h = ", gamdi_h
188    
     print *, 'inigeom: Y = latitude, dérivée tangente hyperbolique'  
     CALL fyhyp(rlatu, yprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)  
     CALL fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)  
   
     rlatu(1) = pi / 2.  
     rlatu(jjp1) = -rlatu(1)  
   
     ! Calcul aux pôles  
   
     yprimu(1) = 0.  
     yprimu(jjp1) = 0.  
   
189      un4rad2 = 0.25 * rad * rad      un4rad2 = 0.25 * rad * rad
190    
191      ! Cf. "inigeom.txt". Calcul des quatre aires élémentaires      ! Cf. "inigeom.txt". Calcul des quatre aires élémentaires
# Line 364  contains Line 328  contains
328         unsairz_gam_2d(iip1, j) = unsairz_gam_2d(1, j)         unsairz_gam_2d(iip1, j) = unsairz_gam_2d(1, j)
329      END DO      END DO
330    
331      ! Calcul des élongations cu_2d, cv_2d, cvu      ! Calcul des élongations cu_2d, cv_2d
332    
333      DO j = 1, jjm      DO j = 1, jjm
334         DO i = 1, iim         DO i = 1, iim
335            cv_2d(i, j) = 0.5 * &            cv_2d(i, j) = 0.5 * &
336                 (cvij2(i, j) + cvij3(i, j) + cvij1(i, j + 1) + cvij4(i, j + 1))                 (cvij2(i, j) + cvij3(i, j) + cvij1(i, j + 1) + cvij4(i, j + 1))
           cvu(i, j) = 0.5 * (cvij1(i, j) + cvij4(i, j) + cvij2(i, j) &  
                + cvij3(i, j))  
           cuv(i, j) = 0.5 * (cuij2(i, j) + cuij3(i, j) + cuij1(i, j + 1) &  
                + cuij4(i, j + 1))  
337            unscv2_2d(i, j) = 1. / cv_2d(i, j)**2            unscv2_2d(i, j) = 1. / cv_2d(i, j)**2
338         END DO         END DO
339         DO i = 1, iim         DO i = 1, iim
# Line 384  contains Line 344  contains
344            cvscuvgam_2d(i, j) = cvsurcuv_2d(i, j)**(-gamdi_grot)            cvscuvgam_2d(i, j) = cvsurcuv_2d(i, j)**(-gamdi_grot)
345         END DO         END DO
346         cv_2d(iip1, j) = cv_2d(1, j)         cv_2d(iip1, j) = cv_2d(1, j)
        cvu(iip1, j) = cvu(1, j)  
347         unscv2_2d(iip1, j) = unscv2_2d(1, j)         unscv2_2d(iip1, j) = unscv2_2d(1, j)
        cuv(iip1, j) = cuv(1, j)  
348         cuvsurcv_2d(iip1, j) = cuvsurcv_2d(1, j)         cuvsurcv_2d(iip1, j) = cuvsurcv_2d(1, j)
349         cvsurcuv_2d(iip1, j) = cvsurcuv_2d(1, j)         cvsurcuv_2d(iip1, j) = cvsurcuv_2d(1, j)
350         cuvscvgam1_2d(iip1, j) = cuvscvgam1_2d(1, j)         cuvscvgam1_2d(iip1, j) = cuvscvgam1_2d(1, j)
# Line 418  contains Line 376  contains
376    
377      cu_2d(:, 1) = 0.      cu_2d(:, 1) = 0.
378      unscu2_2d(:, 1) = 0.      unscu2_2d(:, 1) = 0.
     cvu(:, 1) = 0.  
379    
380      cu_2d(:, jjp1) = 0.      cu_2d(:, jjp1) = 0.
381      unscu2_2d(:, jjp1) = 0.      unscu2_2d(:, jjp1) = 0.
     cvu(:, jjp1) = 0.  
   
     DO j = 1, jjm  
        DO i = 1, iim  
           airvscu2_2d(i, j) = airev_2d(i, j) / (cuv(i, j) * cuv(i, j))  
           aivscu2gam_2d(i, j) = airvscu2_2d(i, j)**(-gamdi_grot)  
        END DO  
        airvscu2_2d(iip1, j) = airvscu2_2d(1, j)  
        aivscu2gam_2d(iip1, j) = aivscu2gam_2d(1, j)  
     END DO  
   
     DO j = 2, jjm  
        DO i = 1, iim  
           airuscv2_2d(i, j) = aireu_2d(i, j) / (cvu(i, j) * cvu(i, j))  
           aiuscv2gam_2d(i, j) = airuscv2_2d(i, j)**(-gamdi_grot)  
        END DO  
        airuscv2_2d(iip1, j) = airuscv2_2d(1, j)  
        aiuscv2gam_2d(iip1, j) = aiuscv2gam_2d(1, j)  
     END DO  
382    
383      ! Calcul des aires aux pôles :      ! Calcul des aires aux pôles :
384    
Legend:
Removed from v.119  
changed lines
  Added in v.140
  ViewVC Help
Powered by ViewVC 1.1.21