/[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

revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC revision 125 by guez, Fri Feb 6 15:00:28 2015 UTC
# 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 fxy_m, only: fxy      use fyhyp_m, only: fyhyp
     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  
171    
172      ! Variables locales      ! Local:
173        INTEGER i, j, unit
     INTEGER i, j, itmax, itmay, iter, 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 196  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 216  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)
Legend:
Removed from v.82  
changed lines
  Added in v.125
  ViewVC Help
Powered by ViewVC 1.1.21