/[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 119 by guez, Wed Jan 7 14:34:57 2015 UTC
# 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 216  contains Line 210  contains
210      print *, "gamdi_grot = ", gamdi_grot      print *, "gamdi_grot = ", gamdi_grot
211      print *, "gamdi_h = ", gamdi_h      print *, "gamdi_h = ", gamdi_h
212    
213      IF (.NOT. fxyhypb) THEN      print *, 'inigeom: Y = latitude, dérivée tangente hyperbolique'
214         IF (ysinus) THEN      CALL fyhyp(rlatu, yprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
215            print *, ' Inigeom, Y = Sinus (Latitude) '      CALL fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
           ! 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  
216    
217      rlatu(1) = pi / 2.      rlatu(1) = pi / 2.
218      rlatu(jjp1) = -rlatu(1)      rlatu(jjp1) = -rlatu(1)

Legend:
Removed from v.82  
changed lines
  Added in v.119

  ViewVC Help
Powered by ViewVC 1.1.21