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

Diff of /trunk/Sources/dyn3d/fyhyp.f

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

trunk/dyn3d/fyhyp.f revision 120 by guez, Tue Jan 13 14:56:15 2015 UTC trunk/Sources/dyn3d/fyhyp.f revision 149 by guez, Thu Jun 18 12:23:44 2015 UTC
# Line 4  module fyhyp_m Line 4  module fyhyp_m
4    
5  contains  contains
6    
7    SUBROUTINE fyhyp(rlatu, yyprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)    SUBROUTINE fyhyp(rlatu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
8    
9      ! From LMDZ4/libf/dyn3d/fyhyp.F, version 1.2, 2005/06/03 09:11:32      ! From LMDZ4/libf/dyn3d/fyhyp.F, version 1.2, 2005/06/03 09:11:32
10    
# Line 13  contains Line 13  contains
13      ! Calcule les latitudes et dérivées dans la grille du GCM pour une      ! Calcule les latitudes et dérivées dans la grille du GCM pour une
14      ! fonction f(y) à dérivée tangente hyperbolique.      ! fonction f(y) à dérivée tangente hyperbolique.
15    
16      ! Nota bene : il vaut mieux avoir grossismy * dzoomy < pi / 2 (radians).      ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
17    
18      use coefpoly_m, only: coefpoly      use coefpoly_m, only: coefpoly, a0, a1, a2, a3
19      USE dimens_m, only: jjm      USE dimens_m, only: jjm
20      use serre, only: clat, grossismy, dzoomy, tauy      use dynetat0_m, only: clat, grossismy, dzoomy, tauy
21        use heavyside_m, only: heavyside
22    
23      REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)      REAL, intent(out):: rlatu(jjm + 1)
24      REAL, intent(out):: rlatv(jjm)      REAL, intent(out):: rlatv(jjm)
25      real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)      real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
26    
# Line 37  contains Line 38  contains
38      DOUBLE PRECISION, save:: yf(0:nmax2)      DOUBLE PRECISION, save:: yf(0:nmax2)
39      DOUBLE PRECISION yypr(0:nmax2)      DOUBLE PRECISION yypr(0:nmax2)
40      DOUBLE PRECISION yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1)      DOUBLE PRECISION yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1)
41      DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm      DOUBLE PRECISION pi, pis2, epsilon, pisjm
42      DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin      DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin
43      DOUBLE PRECISION yfi, yf1, ffdy      DOUBLE PRECISION yfi, yf1, ffdy
44      DOUBLE PRECISION ypn, deply, y00      DOUBLE PRECISION ypn, deply, y00
# Line 46  contains Line 47  contains
47      INTEGER i, j, it, ik, iter, jlat      INTEGER i, j, it, ik, iter, jlat
48      INTEGER jpn, jjpn      INTEGER jpn, jjpn
49      SAVE jpn      SAVE jpn
50      DOUBLE PRECISION a0, a1, a2, a3, yi2, heavyy0, heavyy0m      DOUBLE PRECISION yi2, heavyy0, heavyy0m
51      DOUBLE PRECISION fa(0:nmax2), fb(0:nmax2)      DOUBLE PRECISION fa(0:nmax2), fb(0:nmax2)
52      REAL y0min, y0max      REAL y0min, y0max
53    
     DOUBLE PRECISION heavyside  
   
54      !-------------------------------------------------------------------      !-------------------------------------------------------------------
55    
56      print *, "Call sequence information: fyhyp"      print *, "Call sequence information: fyhyp"
# Line 60  contains Line 59  contains
59      pis2 = pi/2.      pis2 = pi/2.
60      pisjm = pi/real(jjm)      pisjm = pi/real(jjm)
61      epsilon = 1e-3      epsilon = 1e-3
62      y0 = clat*pi/180.      dzoom = dzoomy*pi
   
     IF (dzoomy<1.) THEN  
        dzoom = dzoomy*pi  
     ELSE IF (dzoomy<12.) THEN  
        print *, "Le paramètre dzoomy pour fyhyp est trop petit. L'augmenter " &  
             // "et relancer."  
        STOP 1  
     ELSE  
        dzoom = dzoomy * pi/180.  
     END IF  
   
63      print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):'      print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):'
64      print *, y0, grossismy, tauy, dzoom      print *, clat, grossismy, tauy, dzoom
65    
66      DO i = 0, nmax2      DO i = 0, nmax2
67         yt(i) = -pis2 + real(i)*pi/nmax2         yt(i) = -pis2 + real(i)*pi/nmax2
68      END DO      END DO
69    
70      heavyy0m = heavyside(-y0)      heavyy0m = heavyside(-clat)
71      heavyy0 = heavyside(y0)      heavyy0 = heavyside(clat)
72      y0min = 2.*y0*heavyy0m - pis2      y0min = 2.*clat*heavyy0m - pis2
73      y0max = 2.*y0*heavyy0 + pis2      y0max = 2.*clat*heavyy0 + pis2
74    
75      fa = 999.999      fa = 999.999
76      fb = 999.999      fb = 999.999
77    
78      DO i = 0, nmax2      DO i = 0, nmax2
79         IF (yt(i)<y0) THEN         IF (yt(i)<clat) THEN
80            fa(i) = tauy*(yt(i)-y0 + dzoom/2.)            fa(i) = tauy*(yt(i)-clat + dzoom/2.)
81            fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))            fb(i) = (yt(i)-2.*clat*heavyy0m + pis2)*(clat-yt(i))
82         ELSE IF (yt(i)>y0) THEN         ELSE IF (yt(i)>clat) THEN
83            fa(i) = tauy*(y0-yt(i) + dzoom/2.)            fa(i) = tauy*(clat-yt(i) + dzoom/2.)
84            fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)            fb(i) = (2.*clat*heavyy0-yt(i) + pis2)*(yt(i)-clat)
85         END IF         END IF
86    
87         IF (200.*fb(i)<-fa(i)) THEN         IF (200.*fb(i)<-fa(i)) THEN
# Line 104  contains Line 92  contains
92            fhyp(i) = tanh(fa(i)/fb(i))            fhyp(i) = tanh(fa(i)/fb(i))
93         END IF         END IF
94    
95         IF (yt(i)==y0) fhyp(i) = 1.         IF (yt(i)==clat) fhyp(i) = 1.
96         IF (yt(i)==y0min .OR. yt(i)==y0max) fhyp(i) = -1.         IF (yt(i)==y0min .OR. yt(i)==y0max) fhyp(i) = -1.
97      END DO      END DO
98    
# Line 114  contains Line 102  contains
102    
103      DO i = 1, nmax2      DO i = 1, nmax2
104         ymoy = 0.5*(yt(i-1) + yt(i))         ymoy = 0.5*(yt(i-1) + yt(i))
105         IF (ymoy<y0) THEN         IF (ymoy<clat) THEN
106            fa(i) = tauy*(ymoy-y0 + dzoom/2.)            fa(i) = tauy*(ymoy-clat + dzoom/2.)
107            fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)            fb(i) = (ymoy-2.*clat*heavyy0m + pis2)*(clat-ymoy)
108         ELSE IF (ymoy>y0) THEN         ELSE IF (ymoy>clat) THEN
109            fa(i) = tauy*(y0-ymoy + dzoom/2.)            fa(i) = tauy*(clat-ymoy + dzoom/2.)
110            fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)            fb(i) = (2.*clat*heavyy0-ymoy + pis2)*(ymoy-clat)
111         END IF         END IF
112    
113         IF (200.*fb(i)<-fa(i)) THEN         IF (200.*fb(i)<-fa(i)) THEN
# Line 129  contains Line 117  contains
117         ELSE         ELSE
118            fxm(i) = tanh(fa(i)/fb(i))            fxm(i) = tanh(fa(i)/fb(i))
119         END IF         END IF
120         IF (ymoy==y0) fxm(i) = 1.         IF (ymoy==clat) fxm(i) = 1.
121         IF (ymoy==y0min .OR. yt(i)==y0max) fxm(i) = -1.         IF (ymoy==y0min .OR. yt(i)==y0max) fxm(i) = -1.
122         ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))         ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))
123      END DO      END DO
# Line 199  contains Line 187  contains
187            ! et Y'(yi)            ! et Y'(yi)
188    
189            CALL coefpoly(yf(it), yf(it + 1), ytprim(it), ytprim(it + 1), &            CALL coefpoly(yf(it), yf(it + 1), ytprim(it), ytprim(it + 1), &
190                 yt(it), yt(it + 1), a0, a1, a2, a3)                 yt(it), yt(it + 1))
191    
192            yf1 = yf(it)            yf1 = yf(it)
193            yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi            yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi
# Line 271  contains Line 259  contains
259         IF (ik==1) THEN         IF (ik==1) THEN
260            DO j = 1, jjm + 1            DO j = 1, jjm + 1
261               rlatu(j) = ylat(j)               rlatu(j) = ylat(j)
              yyprimu(j) = yprim(j)  
262            END DO            END DO
263         ELSE IF (ik==2) THEN         ELSE IF (ik==2) THEN
264            DO j = 1, jjm            DO j = 1, jjm
Legend:
Removed from v.120  
changed lines
  Added in v.149
  ViewVC Help
Powered by ViewVC 1.1.21