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

Diff of /trunk/dyn3d/fyhyp.f

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

revision 118 by guez, Thu Dec 18 17:30:24 2014 UTC revision 121 by guez, Wed Jan 28 16:10:02 2015 UTC
# Line 4  module fyhyp_m Line 4  module fyhyp_m
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 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)
     REAL, intent(in):: grossism  
     ! 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, intent(out):: rrlatu(jjm + 1), yyprimu(jjm + 1)  
     REAL, intent(out):: rrlatv(jjm), yyprimv(jjm)  
24      real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)      real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
     DOUBLE PRECISION, intent(out):: 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(jjm + 1), yprim(jjm + 1)      DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1)
# 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 280  contains Line 260  contains
260    
261         IF (ik==1) THEN         IF (ik==1) THEN
262            DO j = 1, jjm + 1            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, jjm            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, jjm            DO j = 1, jjm
# 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.118  
changed lines
  Added in v.121
  ViewVC Help
Powered by ViewVC 1.1.21