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

revision 97 by guez, Fri Apr 25 14:58:31 2014 UTC revision 121 by guez, Wed Jan 28 16:10:02 2015 UTC
# Line 1  Line 1 
1  module fyhyp_m  module fyhyp_m
2    
3   IMPLICIT NONE    IMPLICIT NONE
4    
5  contains  contains
6    
7    SUBROUTINE fyhyp(yzoomdeg, grossism, dzooma, tau, rrlatu, yyprimu, rrlatv, &    SUBROUTINE fyhyp(rlatu, yyprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
        yyprimv, rlatu2, yprimu2, rlatu1, yprimu1, champmin, champmax)  
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    
11      ! Author: P. Le Van, from analysis by R. Sadourny      ! Author: P. Le Van, from analysis by R. Sadourny
12    
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) à tangente hyperbolique.      ! fonction f(y) à dérivée tangente hyperbolique.
15    
16      ! Nota bene : il vaut mieux avoir grossism * dzoom < pi / 2 (rad),      ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
     ! en latitude.  
17    
18        use coefpoly_m, only: coefpoly
19      USE dimens_m, only: jjm      USE dimens_m, only: jjm
20      USE paramet_m, only: JJP1      use serre, only: clat, grossismy, dzoomy, tauy
21    
22      REAL, intent(in):: yzoomdeg      REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)
23        REAL, intent(out):: rlatv(jjm)
24      REAL, intent(in):: grossism      real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
     ! grossissement (= 2 si 2 fois, = 3 si 3 fois, etc.)  
   
     REAL, intent(in):: dzooma  
   
     REAL, intent(in):: tau  
     ! raideur de la transition de l'intérieur à l'extérieur du zoom  
   
     ! arguments de sortie  
   
     REAL rrlatu(jjp1), yyprimu(jjp1), rrlatv(jjm), yyprimv(jjm)  
     real rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)  
     DOUBLE PRECISION champmin, champmax  
25    
26      ! Local:      ! Local:
27    
28        DOUBLE PRECISION champmin, champmax
29      INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax      INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax
30      REAL dzoom ! distance totale de la zone du zoom (en radians)      REAL dzoom ! distance totale de la zone du zoom (en radians)
31      DOUBLE PRECISION ylat(jjp1), yprim(jjp1)      DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1)
32      DOUBLE PRECISION yuv      DOUBLE PRECISION yuv
33      DOUBLE PRECISION, save:: yt(0:nmax2)      DOUBLE PRECISION, save:: yt(0:nmax2)
34      DOUBLE PRECISION fhyp(0:nmax2), beta      DOUBLE PRECISION fhyp(0:nmax2), beta
# Line 48  contains Line 36  contains
36      DOUBLE PRECISION fxm(0:nmax2)      DOUBLE PRECISION fxm(0:nmax2)
37      DOUBLE PRECISION, save:: yf(0:nmax2)      DOUBLE PRECISION, save:: yf(0:nmax2)
38      DOUBLE PRECISION yypr(0:nmax2)      DOUBLE PRECISION yypr(0:nmax2)
39      DOUBLE PRECISION yvrai(jjp1), yprimm(jjp1), ylatt(jjp1)      DOUBLE PRECISION yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1)
40      DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm      DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm
41      DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin      DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin
42      DOUBLE PRECISION yfi, yf1, ffdy      DOUBLE PRECISION yfi, yf1, ffdy
# Line 66  contains Line 54  contains
54    
55      !-------------------------------------------------------------------      !-------------------------------------------------------------------
56    
57        print *, "Call sequence information: fyhyp"
58    
59      pi = 2.*asin(1.)      pi = 2.*asin(1.)
60      pis2 = pi/2.      pis2 = pi/2.
61      pisjm = pi/real(jjm)      pisjm = pi/real(jjm)
62      epsilon = 1e-3      epsilon = 1e-3
63      y0 = yzoomdeg*pi/180.      y0 = clat*pi/180.
64        dzoom = dzoomy*pi
65      IF (dzooma<1.) THEN      print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):'
66         dzoom = dzooma*pi      print *, y0, grossismy, tauy, dzoom
     ELSE IF (dzooma<12.) THEN  
        print *, "Le paramètre dzoomy pour fyhyp est trop petit. L'augmenter " &  
             // "et relancer."  
        STOP 1  
     ELSE  
        dzoom = dzooma*pi/180.  
     END IF  
   
     print *, 'yzoom(rad), grossism, tau, dzoom (rad):'  
     print *, y0, grossism, tau, dzoom  
67    
68      DO i = 0, nmax2      DO i = 0, nmax2
69         yt(i) = -pis2 + real(i)*pi/nmax2         yt(i) = -pis2 + real(i)*pi/nmax2
# Line 99  contains Line 79  contains
79    
80      DO i = 0, nmax2      DO i = 0, nmax2
81         IF (yt(i)<y0) THEN         IF (yt(i)<y0) THEN
82            fa(i) = tau*(yt(i)-y0 + dzoom/2.)            fa(i) = tauy*(yt(i)-y0 + dzoom/2.)
83            fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))            fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))
84         ELSE IF (yt(i)>y0) THEN         ELSE IF (yt(i)>y0) THEN
85            fa(i) = tau*(y0-yt(i) + dzoom/2.)            fa(i) = tauy*(y0-yt(i) + dzoom/2.)
86            fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)            fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)
87         END IF         END IF
88    
# Line 125  contains Line 105  contains
105      DO i = 1, nmax2      DO i = 1, nmax2
106         ymoy = 0.5*(yt(i-1) + yt(i))         ymoy = 0.5*(yt(i-1) + yt(i))
107         IF (ymoy<y0) THEN         IF (ymoy<y0) THEN
108            fa(i) = tau*(ymoy-y0 + dzoom/2.)            fa(i) = tauy*(ymoy-y0 + dzoom/2.)
109            fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)            fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)
110         ELSE IF (ymoy>y0) THEN         ELSE IF (ymoy>y0) THEN
111            fa(i) = tau*(y0-ymoy + dzoom/2.)            fa(i) = tauy*(y0-ymoy + dzoom/2.)
112            fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)            fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)
113         END IF         END IF
114    
# Line 144  contains Line 124  contains
124         ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))         ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))
125      END DO      END DO
126    
127      beta = (grossism*ffdy-pi)/(ffdy-pi)      beta = (grossismy*ffdy-pi)/(ffdy-pi)
128    
129      IF (2. * beta - grossism <= 0.) THEN      IF (2. * beta - grossismy <= 0.) THEN
130         print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' &         print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' &
131              // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' &              // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' &
132              // 'dzoomy et relancer.'              // 'dzoomy et relancer.'
# Line 156  contains Line 136  contains
136      ! calcul de Ytprim      ! calcul de Ytprim
137    
138      DO i = 0, nmax2      DO i = 0, nmax2
139         ytprim(i) = beta + (grossism-beta)*fhyp(i)         ytprim(i) = beta + (grossismy-beta)*fhyp(i)
140      END DO      END DO
141    
142      ! Calcul de Yf      ! Calcul de Yf
143    
144      yf(0) = -pis2      yf(0) = -pis2
145      DO i = 1, nmax2      DO i = 1, nmax2
146         yypr(i) = beta + (grossism-beta)*fxm(i)         yypr(i) = beta + (grossismy-beta)*fxm(i)
147      END DO      END DO
148    
149      DO i = 1, nmax2      DO i = 1, nmax2
# Line 245  contains Line 225  contains
225    
226         IF (ik==1) THEN         IF (ik==1) THEN
227            ypn = pis2            ypn = pis2
228            DO j = jlat, 1, -1            DO j = jjm + 1, 1, -1
229               IF (yvrai(j)<=ypn) exit               IF (yvrai(j)<=ypn) exit
230            END DO            END DO
231    
# Line 279  contains Line 259  contains
259         END DO         END DO
260    
261         IF (ik==1) THEN         IF (ik==1) THEN
262            DO j = 1, jlat            DO j = 1, jjm + 1
263               rrlatu(j) = ylat(j)               rlatu(j) = ylat(j)
264               yyprimu(j) = yprim(j)               yyprimu(j) = yprim(j)
265            END DO            END DO
266         ELSE IF (ik==2) THEN         ELSE IF (ik==2) THEN
267            DO j = 1, jlat            DO j = 1, jjm
268               rrlatv(j) = ylat(j)               rlatv(j) = ylat(j)
              yyprimv(j) = yprim(j)  
269            END DO            END DO
270         ELSE IF (ik==3) THEN         ELSE IF (ik==3) THEN
271            DO j = 1, jlat            DO j = 1, jjm
272               rlatu2(j) = ylat(j)               rlatu2(j) = ylat(j)
273               yprimu2(j) = yprim(j)               yprimu2(j) = yprim(j)
274            END DO            END DO
275         ELSE IF (ik==4) THEN         ELSE IF (ik==4) THEN
276            DO j = 1, jlat            DO j = 1, jjm
277               rlatu1(j) = ylat(j)               rlatu1(j) = ylat(j)
278               yprimu1(j) = yprim(j)               yprimu1(j) = yprim(j)
279            END DO            END DO
# Line 302  contains Line 281  contains
281      END DO loop_ik      END DO loop_ik
282    
283      DO j = 1, jjm      DO j = 1, jjm
284         ylat(j) = rrlatu(j) - rrlatu(j + 1)         ylat(j) = rlatu(j) - rlatu(j + 1)
285      END DO      END DO
286      champmin = 1e12      champmin = 1e12
287      champmax = -1e12      champmax = -1e12
# Line 313  contains Line 292  contains
292      champmin = champmin*180./pi      champmin = champmin*180./pi
293      champmax = champmax*180./pi      champmax = champmax*180./pi
294    
295        DO j = 1, jjm
296           IF (rlatu1(j) <= rlatu2(j)) THEN
297              print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j
298              STOP 13
299           ENDIF
300    
301           IF (rlatu2(j) <= rlatu(j+1)) THEN
302              print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j
303              STOP 14
304           ENDIF
305    
306           IF (rlatu(j) <= rlatu1(j)) THEN
307              print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
308              STOP 15
309           ENDIF
310    
311           IF (rlatv(j) <= rlatu2(j)) THEN
312              print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
313              STOP 16
314           ENDIF
315    
316           IF (rlatv(j) >= rlatu1(j)) THEN
317              print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
318              STOP 17
319           ENDIF
320    
321           IF (rlatv(j) >= rlatu(j)) THEN
322              print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j
323              STOP 18
324           ENDIF
325        ENDDO
326    
327        print *, 'Latitudes'
328        print 3, champmin, champmax
329    
330    3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
331             ' d environ ', f0.2, ' degres ', /, &
332             ' alors que la maille en dehors de la zone du zoom est ', &
333             "d'environ ", f0.2, ' degres ')
334    
335    END SUBROUTINE fyhyp    END SUBROUTINE fyhyp
336    
337  end module fyhyp_m  end module fyhyp_m
Legend:
Removed from v.97  
changed lines
  Added in v.121
  ViewVC Help
Powered by ViewVC 1.1.21