/[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 119 by guez, Wed Jan 7 14:34:57 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),      ! 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 paramet_m, only: JJP1      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)
23      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  
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(jjp1), yprim(jjp1)      DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1)
31      DOUBLE PRECISION yuv      DOUBLE PRECISION yuv
32      DOUBLE PRECISION, save:: yt(0:nmax2)      DOUBLE PRECISION, save:: yt(0:nmax2)
33      DOUBLE PRECISION fhyp(0:nmax2), beta      DOUBLE PRECISION fhyp(0:nmax2), beta
# Line 48  contains Line 35  contains
35      DOUBLE PRECISION fxm(0:nmax2)      DOUBLE PRECISION fxm(0:nmax2)
36      DOUBLE PRECISION, save:: yf(0:nmax2)      DOUBLE PRECISION, save:: yf(0:nmax2)
37      DOUBLE PRECISION yypr(0:nmax2)      DOUBLE PRECISION yypr(0:nmax2)
38      DOUBLE PRECISION yvrai(jjp1), yprimm(jjp1), ylatt(jjp1)      DOUBLE PRECISION yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1)
39      DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm      DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm
40      DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin      DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin
41      DOUBLE PRECISION yfi, yf1, ffdy      DOUBLE PRECISION yfi, yf1, ffdy
# 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 245  contains Line 232  contains
232    
233         IF (ik==1) THEN         IF (ik==1) THEN
234            ypn = pis2            ypn = pis2
235            DO j = jlat, 1, -1            DO j = jjm + 1, 1, -1
236               IF (yvrai(j)<=ypn) exit               IF (yvrai(j)<=ypn) exit
237            END DO            END DO
238    
# Line 279  contains Line 266  contains
266         END DO         END DO
267    
268         IF (ik==1) THEN         IF (ik==1) THEN
269            DO j = 1, jlat            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, jlat            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, jlat            DO j = 1, jjm
279               rlatu2(j) = ylat(j)               rlatu2(j) = ylat(j)
280               yprimu2(j) = yprim(j)               yprimu2(j) = yprim(j)
281            END DO            END DO
282         ELSE IF (ik==4) THEN         ELSE IF (ik==4) THEN
283            DO j = 1, jlat            DO j = 1, jjm
284               rlatu1(j) = ylat(j)               rlatu1(j) = ylat(j)
285               yprimu1(j) = yprim(j)               yprimu1(j) = yprim(j)
286            END DO            END DO
# 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.97  
changed lines
  Added in v.119
  ViewVC Help
Powered by ViewVC 1.1.21