/[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 119 by guez, Wed Jan 7 14:34:57 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),      ! Nota bene : il vaut mieux avoir grossismy * dzoomy < pi / 2 (radians).
     ! en latitude.  
17    
18      USE dimens_m, only: jjm      USE dimens_m, only: jjm
19        use serre, only: clat, grossismy, dzoomy, tauy
20    
21      REAL, intent(in):: yzoomdeg      REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)
22        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)  
23      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  
24    
25      ! Local:      ! Local:
26    
27        DOUBLE PRECISION champmin, champmax
28      INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax      INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax
29      REAL dzoom ! distance totale de la zone du zoom (en radians)      REAL dzoom ! distance totale de la zone du zoom (en radians)
30      DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1)      DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1)
# Line 70  contains Line 57  contains
57      pis2 = pi/2.      pis2 = pi/2.
58      pisjm = pi/real(jjm)      pisjm = pi/real(jjm)
59      epsilon = 1e-3      epsilon = 1e-3
60      y0 = yzoomdeg*pi/180.      y0 = clat*pi/180.
61    
62      IF (dzooma<1.) THEN      IF (dzoomy<1.) THEN
63         dzoom = dzooma*pi         dzoom = dzoomy*pi
64      ELSE IF (dzooma<12.) THEN      ELSE IF (dzoomy<12.) THEN
65         print *, "Le paramètre dzoomy pour fyhyp est trop petit. L'augmenter " &         print *, "Le paramètre dzoomy pour fyhyp est trop petit. L'augmenter " &
66              // "et relancer."              // "et relancer."
67         STOP 1         STOP 1
68      ELSE      ELSE
69         dzoom = dzooma * pi/180.         dzoom = dzoomy * pi/180.
70      END IF      END IF
71    
72      print *, 'yzoom(rad), grossism, tau, dzoom (rad):'      print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):'
73      print *, y0, grossism, tau, dzoom      print *, y0, grossismy, tauy, dzoom
74    
75      DO i = 0, nmax2      DO i = 0, nmax2
76         yt(i) = -pis2 + real(i)*pi/nmax2         yt(i) = -pis2 + real(i)*pi/nmax2
# Line 99  contains Line 86  contains
86    
87      DO i = 0, nmax2      DO i = 0, nmax2
88         IF (yt(i)<y0) THEN         IF (yt(i)<y0) THEN
89            fa(i) = tau*(yt(i)-y0 + dzoom/2.)            fa(i) = tauy*(yt(i)-y0 + dzoom/2.)
90            fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))            fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))
91         ELSE IF (yt(i)>y0) THEN         ELSE IF (yt(i)>y0) THEN
92            fa(i) = tau*(y0-yt(i) + dzoom/2.)            fa(i) = tauy*(y0-yt(i) + dzoom/2.)
93            fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)            fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)
94         END IF         END IF
95    
# Line 125  contains Line 112  contains
112      DO i = 1, nmax2      DO i = 1, nmax2
113         ymoy = 0.5*(yt(i-1) + yt(i))         ymoy = 0.5*(yt(i-1) + yt(i))
114         IF (ymoy<y0) THEN         IF (ymoy<y0) THEN
115            fa(i) = tau*(ymoy-y0 + dzoom/2.)            fa(i) = tauy*(ymoy-y0 + dzoom/2.)
116            fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)            fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)
117         ELSE IF (ymoy>y0) THEN         ELSE IF (ymoy>y0) THEN
118            fa(i) = tau*(y0-ymoy + dzoom/2.)            fa(i) = tauy*(y0-ymoy + dzoom/2.)
119            fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)            fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)
120         END IF         END IF
121    
# Line 144  contains Line 131  contains
131         ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))         ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))
132      END DO      END DO
133    
134      beta = (grossism*ffdy-pi)/(ffdy-pi)      beta = (grossismy*ffdy-pi)/(ffdy-pi)
135    
136      IF (2. * beta - grossism <= 0.) THEN      IF (2. * beta - grossismy <= 0.) THEN
137         print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' &         print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' &
138              // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' &              // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' &
139              // 'dzoomy et relancer.'              // 'dzoomy et relancer.'
# Line 156  contains Line 143  contains
143      ! calcul de Ytprim      ! calcul de Ytprim
144    
145      DO i = 0, nmax2      DO i = 0, nmax2
146         ytprim(i) = beta + (grossism-beta)*fhyp(i)         ytprim(i) = beta + (grossismy-beta)*fhyp(i)
147      END DO      END DO
148    
149      ! Calcul de Yf      ! Calcul de Yf
150    
151      yf(0) = -pis2      yf(0) = -pis2
152      DO i = 1, nmax2      DO i = 1, nmax2
153         yypr(i) = beta + (grossism-beta)*fxm(i)         yypr(i) = beta + (grossismy-beta)*fxm(i)
154      END DO      END DO
155    
156      DO i = 1, nmax2      DO i = 1, nmax2
# Line 280  contains Line 267  contains
267    
268         IF (ik==1) THEN         IF (ik==1) THEN
269            DO j = 1, jjm + 1            DO j = 1, jjm + 1
270               rrlatu(j) = ylat(j)               rlatu(j) = ylat(j)
271               yyprimu(j) = yprim(j)               yyprimu(j) = yprim(j)
272            END DO            END DO
273         ELSE IF (ik==2) THEN         ELSE IF (ik==2) THEN
274            DO j = 1, jjm            DO j = 1, jjm
275               rrlatv(j) = ylat(j)               rlatv(j) = ylat(j)
              yyprimv(j) = yprim(j)  
276            END DO            END DO
277         ELSE IF (ik==3) THEN         ELSE IF (ik==3) THEN
278            DO j = 1, jjm            DO j = 1, jjm
# Line 302  contains Line 288  contains
288      END DO loop_ik      END DO loop_ik
289    
290      DO j = 1, jjm      DO j = 1, jjm
291         ylat(j) = rrlatu(j) - rrlatu(j + 1)         ylat(j) = rlatu(j) - rlatu(j + 1)
292      END DO      END DO
293      champmin = 1e12      champmin = 1e12
294      champmax = -1e12      champmax = -1e12
# Line 313  contains Line 299  contains
299      champmin = champmin*180./pi      champmin = champmin*180./pi
300      champmax = champmax*180./pi      champmax = champmax*180./pi
301    
302        DO j = 1, jjm
303           IF (rlatu1(j) <= rlatu2(j)) THEN
304              print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j
305              STOP 13
306           ENDIF
307    
308           IF (rlatu2(j) <= rlatu(j+1)) THEN
309              print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j
310              STOP 14
311           ENDIF
312    
313           IF (rlatu(j) <= rlatu1(j)) THEN
314              print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
315              STOP 15
316           ENDIF
317    
318           IF (rlatv(j) <= rlatu2(j)) THEN
319              print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
320              STOP 16
321           ENDIF
322    
323           IF (rlatv(j) >= rlatu1(j)) THEN
324              print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
325              STOP 17
326           ENDIF
327    
328           IF (rlatv(j) >= rlatu(j)) THEN
329              print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j
330              STOP 18
331           ENDIF
332        ENDDO
333    
334        print *, 'Latitudes'
335        print 3, champmin, champmax
336        print *, 'Si cette derniere est trop lache, modifiez les parametres'
337        print *, 'grossismy, tauy, dzoom pour Y et repasser ! '
338    
339    3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
340             ' d environ ', f0.2, ' degres ', /, &
341             ' alors que la maille en dehors de la zone du zoom est ', &
342             "d'environ", f0.2, ' degres ')
343    
344    END SUBROUTINE fyhyp    END SUBROUTINE fyhyp
345    
346  end module fyhyp_m  end module fyhyp_m
Legend:
Removed from v.118  
changed lines
  Added in v.119
  ViewVC Help
Powered by ViewVC 1.1.21