/[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.f90 revision 81 by guez, Wed Mar 5 14:38:41 2014 UTC trunk/dyn3d/fyhyp.f revision 121 by guez, Wed Jan 28 16:10:02 2015 UTC
# Line 1  Line 1 
1    module fyhyp_m
2    
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/fyhyp.F,v 1.2 2005/06/03 09:11:32  
 ! fairhead Exp $  
   
   
   
 SUBROUTINE fyhyp(yzoomdeg, grossism, dzooma, tau, rrlatu, yyprimu, rrlatv, &  
     yyprimv, rlatu2, yprimu2, rlatu1, yprimu1, champmin, champmax)  
   
   ! c    ...  Version du 01/04/2001 ....  
   
   USE dimens_m  
   USE paramet_m  
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! ...   Auteur :  P. Le Van  ...  contains
   
   ! .......    d'apres  formulations  de R. Sadourny  .......  
   
   ! Calcule les latitudes et derivees dans la grille du GCM pour une  
   ! fonction f(y) a tangente  hyperbolique  .  
   
   ! grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois , etc)  
   ! dzoom  etant  la distance totale de la zone du zoom ( en radians )  
   ! tau  la raideur de la transition de l'interieur a l'exterieur du zoom  
   
   
   ! N.B : Il vaut mieux avoir : grossism * dzoom  <  pi/2  (radians) ,en  
   ! lati.  
   ! ********************************************************************  
   
   
   
   INTEGER nmax, nmax2  
   PARAMETER (nmax=30000, nmax2=2*nmax)  
   
   
   ! .......  arguments  d'entree    .......  
   
   REAL yzoomdeg, grossism, dzooma, tau  
   ! ( rentres  par  run.def )  
   
   ! .......  arguments  de sortie   .......  
   
   REAL rrlatu(jjp1), yyprimu(jjp1), rrlatv(jjm), yyprimv(jjm), rlatu1(jjm), &  
     yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)  
   
   
   ! .....     champs  locaux    .....  
   
   
   REAL dzoom  
   DOUBLE PRECISION ylat(jjp1), yprim(jjp1)  
   DOUBLE PRECISION yuv  
   DOUBLE PRECISION yt(0:nmax2)  
   DOUBLE PRECISION fhyp(0:nmax2), beta, ytprim(0:nmax2), fxm(0:nmax2)  
   SAVE ytprim, yt, yf  
   DOUBLE PRECISION yf(0:nmax2), yypr(0:nmax2)  
   DOUBLE PRECISION yvrai(jjp1), yprimm(jjp1), ylatt(jjp1)  
   DOUBLE PRECISION pi, depi, pis2, epsilon, y0, pisjm  
   DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin, champmin, champmax  
   DOUBLE PRECISION yfi, yf1, ffdy  
   DOUBLE PRECISION ypn, deply, y00  
   SAVE y00, deply  
   
   INTEGER i, j, it, ik, iter, jlat  
   INTEGER jpn, jjpn  
   SAVE jpn  
   DOUBLE PRECISION a0, a1, a2, a3, yi2, heavyy0, heavyy0m  
   DOUBLE PRECISION fa(0:nmax2), fb(0:nmax2)  
   REAL y0min, y0max  
   
   DOUBLE PRECISION heavyside  
   
   pi = 2.*asin(1.)  
   depi = 2.*pi  
   pis2 = pi/2.  
   pisjm = pi/float(jjm)  
   epsilon = 1.E-3  
   y0 = yzoomdeg*pi/180.  
   
   IF (dzooma<1.) THEN  
     dzoom = dzooma*pi  
   ELSE IF (dzooma<12.) THEN  
     WRITE (6, *) ' Le param. dzoomy pour fyhyp est trop petit &  
       &! L aug                                                &  
       &            menter et relancer'  
     STOP 1  
   ELSE  
     dzoom = dzooma*pi/180.  
   END IF  
   
   WRITE (6, 18)  
   WRITE (6, *) ' yzoom( rad.),grossism,tau,dzoom (radians)'  
   WRITE (6, 24) y0, grossism, tau, dzoom  
   
   DO i = 0, nmax2  
     yt(i) = -pis2 + float(i)*pi/nmax2  
   END DO  
   
   heavyy0m = heavyside(-y0)  
   heavyy0 = heavyside(y0)  
   y0min = 2.*y0*heavyy0m - pis2  
   y0max = 2.*y0*heavyy0 + pis2  
   
   fa = 999.999  
   fb = 999.999  
6    
7    DO i = 0, nmax2    SUBROUTINE fyhyp(rlatu, yyprimu, rlatv, rlatu2, yprimu2, rlatu1, yprimu1)
     IF (yt(i)<y0) THEN  
       fa(i) = tau*(yt(i)-y0+dzoom/2.)  
       fb(i) = (yt(i)-2.*y0*heavyy0m+pis2)*(y0-yt(i))  
     ELSE IF (yt(i)>y0) THEN  
       fa(i) = tau*(y0-yt(i)+dzoom/2.)  
       fb(i) = (2.*y0*heavyy0-yt(i)+pis2)*(yt(i)-y0)  
     END IF  
   
     IF (200.*fb(i)<-fa(i)) THEN  
       fhyp(i) = -1.  
     ELSE IF (200.*fb(i)<fa(i)) THEN  
       fhyp(i) = 1.  
     ELSE  
       fhyp(i) = tanh(fa(i)/fb(i))  
     END IF  
   
     IF (yt(i)==y0) fhyp(i) = 1.  
     IF (yt(i)==y0min .OR. yt(i)==y0max) fhyp(i) = -1.  
   
   END DO  
   
   ! c  ....  Calcul  de  beta  ....  
   
   ffdy = 0.  
   
   DO i = 1, nmax2  
     ymoy = 0.5*(yt(i-1)+yt(i))  
     IF (ymoy<y0) THEN  
       fa(i) = tau*(ymoy-y0+dzoom/2.)  
       fb(i) = (ymoy-2.*y0*heavyy0m+pis2)*(y0-ymoy)  
     ELSE IF (ymoy>y0) THEN  
       fa(i) = tau*(y0-ymoy+dzoom/2.)  
       fb(i) = (2.*y0*heavyy0-ymoy+pis2)*(ymoy-y0)  
     END IF  
   
     IF (200.*fb(i)<-fa(i)) THEN  
       fxm(i) = -1.  
     ELSE IF (200.*fb(i)<fa(i)) THEN  
       fxm(i) = 1.  
     ELSE  
       fxm(i) = tanh(fa(i)/fb(i))  
     END IF  
     IF (ymoy==y0) fxm(i) = 1.  
     IF (ymoy==y0min .OR. yt(i)==y0max) fxm(i) = -1.  
     ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))  
   
   END DO  
   
   beta = (grossism*ffdy-pi)/(ffdy-pi)  
   
   IF (2.*beta-grossism<=0.) THEN  
   
     WRITE (6, *) ' **  Attention ! La valeur beta calculee dans &  
       &la rou                                                 &  
       &           tine fyhyp est mauvaise'  
     WRITE (6, *) 'Modifier les valeurs de  grossismy ,tauy ou dzoomy', &  
       ' et relancer ! ***  '  
     STOP 1  
8    
9    END IF      ! From LMDZ4/libf/dyn3d/fyhyp.F, version 1.2, 2005/06/03 09:11:32
10    
11    ! .....  calcul  de  Ytprim   .....      ! 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
14        ! fonction f(y) à dérivée tangente hyperbolique.
15    
16        ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
17    
18        use coefpoly_m, only: coefpoly
19        USE dimens_m, only: jjm
20        use serre, only: clat, grossismy, dzoomy, tauy
21    
22        REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)
23        REAL, intent(out):: rlatv(jjm)
24        real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
25    
26        ! Local:
27    
28        DOUBLE PRECISION champmin, champmax
29        INTEGER, PARAMETER:: nmax=30000, nmax2=2*nmax
30        REAL dzoom ! distance totale de la zone du zoom (en radians)
31        DOUBLE PRECISION ylat(jjm + 1), yprim(jjm + 1)
32        DOUBLE PRECISION yuv
33        DOUBLE PRECISION, save:: yt(0:nmax2)
34        DOUBLE PRECISION fhyp(0:nmax2), beta
35        DOUBLE PRECISION, save:: ytprim(0:nmax2)
36        DOUBLE PRECISION fxm(0:nmax2)
37        DOUBLE PRECISION, save:: yf(0:nmax2)
38        DOUBLE PRECISION yypr(0:nmax2)
39        DOUBLE PRECISION yvrai(jjm + 1), yprimm(jjm + 1), ylatt(jjm + 1)
40        DOUBLE PRECISION pi, pis2, epsilon, y0, pisjm
41        DOUBLE PRECISION yo1, yi, ylon2, ymoy, yprimin
42        DOUBLE PRECISION yfi, yf1, ffdy
43        DOUBLE PRECISION ypn, deply, y00
44        SAVE y00, deply
45    
46        INTEGER i, j, it, ik, iter, jlat
47        INTEGER jpn, jjpn
48        SAVE jpn
49        DOUBLE PRECISION a0, a1, a2, a3, yi2, heavyy0, heavyy0m
50        DOUBLE PRECISION fa(0:nmax2), fb(0:nmax2)
51        REAL y0min, y0max
52    
53        DOUBLE PRECISION heavyside
54    
55        !-------------------------------------------------------------------
56    
57        print *, "Call sequence information: fyhyp"
58    
59        pi = 2.*asin(1.)
60        pis2 = pi/2.
61        pisjm = pi/real(jjm)
62        epsilon = 1e-3
63        y0 = clat*pi/180.
64        dzoom = dzoomy*pi
65        print *, 'yzoom(rad), grossismy, tauy, dzoom (rad):'
66        print *, y0, grossismy, tauy, dzoom
67    
68    DO i = 0, nmax2      DO i = 0, nmax2
69      ytprim(i) = beta + (grossism-beta)*fhyp(i)         yt(i) = -pis2 + real(i)*pi/nmax2
70    END DO      END DO
   
   ! .....  Calcul  de  Yf     ........  
71    
72    yf(0) = -pis2      heavyy0m = heavyside(-y0)
73    DO i = 1, nmax2      heavyy0 = heavyside(y0)
74      yypr(i) = beta + (grossism-beta)*fxm(i)      y0min = 2.*y0*heavyy0m - pis2
75    END DO      y0max = 2.*y0*heavyy0 + pis2
76    
77        fa = 999.999
78        fb = 999.999
79    
80        DO i = 0, nmax2
81           IF (yt(i)<y0) THEN
82              fa(i) = tauy*(yt(i)-y0 + dzoom/2.)
83              fb(i) = (yt(i)-2.*y0*heavyy0m + pis2)*(y0-yt(i))
84           ELSE IF (yt(i)>y0) THEN
85              fa(i) = tauy*(y0-yt(i) + dzoom/2.)
86              fb(i) = (2.*y0*heavyy0-yt(i) + pis2)*(yt(i)-y0)
87           END IF
88    
89           IF (200.*fb(i)<-fa(i)) THEN
90              fhyp(i) = -1.
91           ELSE IF (200.*fb(i)<fa(i)) THEN
92              fhyp(i) = 1.
93           ELSE
94              fhyp(i) = tanh(fa(i)/fb(i))
95           END IF
96    
97    DO i = 1, nmax2         IF (yt(i)==y0) fhyp(i) = 1.
98      yf(i) = yf(i-1) + yypr(i)*(yt(i)-yt(i-1))         IF (yt(i)==y0min .OR. yt(i)==y0max) fhyp(i) = -1.
99    END DO      END DO
100    
101    ! ****************************************************************      ! Calcul de beta
102    
103    ! .....   yuv  = 0.   si calcul des latitudes  aux pts.  U  .....      ffdy = 0.
   ! .....   yuv  = 0.5  si calcul des latitudes  aux pts.  V  .....  
104    
105    WRITE (6, 18)      DO i = 1, nmax2
106           ymoy = 0.5*(yt(i-1) + yt(i))
107           IF (ymoy<y0) THEN
108              fa(i) = tauy*(ymoy-y0 + dzoom/2.)
109              fb(i) = (ymoy-2.*y0*heavyy0m + pis2)*(y0-ymoy)
110           ELSE IF (ymoy>y0) THEN
111              fa(i) = tauy*(y0-ymoy + dzoom/2.)
112              fb(i) = (2.*y0*heavyy0-ymoy + pis2)*(ymoy-y0)
113           END IF
114    
115           IF (200.*fb(i)<-fa(i)) THEN
116              fxm(i) = -1.
117           ELSE IF (200.*fb(i)<fa(i)) THEN
118              fxm(i) = 1.
119           ELSE
120              fxm(i) = tanh(fa(i)/fb(i))
121           END IF
122           IF (ymoy==y0) fxm(i) = 1.
123           IF (ymoy==y0min .OR. yt(i)==y0max) fxm(i) = -1.
124           ffdy = ffdy + fxm(i)*(yt(i)-yt(i-1))
125        END DO
126    
127    DO ik = 1, 4      beta = (grossismy*ffdy-pi)/(ffdy-pi)
128    
129      IF (ik==1) THEN      IF (2. * beta - grossismy <= 0.) THEN
130        yuv = 0.         print *, 'Attention ! La valeur beta calculee dans la routine fyhyp ' &
131        jlat = jjm + 1              // 'est mauvaise. Modifier les valeurs de grossismy, tauy ou ' &
132      ELSE IF (ik==2) THEN              // 'dzoomy et relancer.'
133        yuv = 0.5         STOP 1
       jlat = jjm  
     ELSE IF (ik==3) THEN  
       yuv = 0.25  
       jlat = jjm  
     ELSE IF (ik==4) THEN  
       yuv = 0.75  
       jlat = jjm  
134      END IF      END IF
135    
136      yo1 = 0.      ! calcul de Ytprim
     DO j = 1, jlat  
       yo1 = 0.  
       ylon2 = -pis2 + pisjm*(float(j)+yuv-1.)  
       yfi = ylon2  
   
       DO it = nmax2, 0, -1  
         IF (yfi>=yf(it)) GO TO 350  
       END DO  
       it = 0  
 350   CONTINUE  
   
       yi = yt(it)  
       IF (it==nmax2) THEN  
         it = nmax2 - 1  
         yf(it+1) = pis2  
       END IF  
       ! .................................................................  
       ! ....  Interpolation entre  yi(it) et yi(it+1)   pour avoir Y(yi)  
       ! .....           et   Y'(yi)                             .....  
       ! .................................................................  
   
       CALL coefpoly(yf(it), yf(it+1), ytprim(it), ytprim(it+1), yt(it), &  
         yt(it+1), a0, a1, a2, a3)  
   
       yf1 = yf(it)  
       yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi  
   
       DO iter = 1, 300  
         yi = yi - (yf1-yfi)/yprimin  
   
         IF (abs(yi-yo1)<=epsilon) GO TO 550  
         yo1 = yi  
         yi2 = yi*yi  
         yf1 = a0 + a1*yi + a2*yi2 + a3*yi2*yi  
         yprimin = a1 + 2.*a2*yi + 3.*a3*yi2  
       END DO  
       WRITE (6, *) ' Pas de solution ***** ', j, ylon2, iter  
       STOP 2  
 550   CONTINUE  
   
       yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi  
       yprim(j) = pi/(jjm*yprimin)  
       yvrai(j) = yi  
137    
138        DO i = 0, nmax2
139           ytprim(i) = beta + (grossismy-beta)*fhyp(i)
140      END DO      END DO
141    
142      DO j = 1, jlat - 1      ! Calcul de Yf
       IF (yvrai(j+1)<yvrai(j)) THEN  
         WRITE (6, *) ' PBS. avec  rlat(', j + 1, ') plus petit que rlat(', j, &  
           ')'  
         STOP 3  
       END IF  
     END DO  
   
     WRITE (6, *) 'Reorganisation des latitudes pour avoir entre - pi/2', &  
       ' et  pi/2 '  
   
     IF (ik==1) THEN  
       ypn = pis2  
       DO j = jlat, 1, -1  
         IF (yvrai(j)<=ypn) GO TO 1502  
       END DO  
 1502  CONTINUE  
   
       jpn = j  
       y00 = yvrai(jpn)  
       deply = pis2 - y00  
     END IF  
143    
144      DO j = 1, jjm + 1 - jpn      yf(0) = -pis2
145        ylatt(j) = -pis2 - y00 + yvrai(jpn+j-1)      DO i = 1, nmax2
146        yprimm(j) = yprim(jpn+j-1)         yypr(i) = beta + (grossismy-beta)*fxm(i)
147      END DO      END DO
148    
149      jjpn = jpn      DO i = 1, nmax2
150      IF (jlat==jjm) jjpn = jpn - 1         yf(i) = yf(i-1) + yypr(i)*(yt(i)-yt(i-1))
   
     DO j = 1, jjpn  
       ylatt(j+jjm+1-jpn) = yvrai(j) + deply  
       yprimm(j+jjm+1-jpn) = yprim(j)  
151      END DO      END DO
152    
153      ! ***********   Fin de la reorganisation     *************      ! yuv = 0. si calcul des latitudes aux pts. U
154        ! yuv = 0.5 si calcul des latitudes aux pts. V
155    
156        loop_ik: DO ik = 1, 4
157           IF (ik==1) THEN
158              yuv = 0.
159              jlat = jjm + 1
160           ELSE IF (ik==2) THEN
161              yuv = 0.5
162              jlat = jjm
163           ELSE IF (ik==3) THEN
164              yuv = 0.25
165              jlat = jjm
166           ELSE IF (ik==4) THEN
167              yuv = 0.75
168              jlat = jjm
169           END IF
170    
171           yo1 = 0.
172           DO j = 1, jlat
173              yo1 = 0.
174              ylon2 = -pis2 + pisjm*(real(j) + yuv-1.)
175              yfi = ylon2
176    
177              it = nmax2
178              DO while (it >= 1 .and. yfi < yf(it))
179                 it = it - 1
180              END DO
181    
182              yi = yt(it)
183              IF (it==nmax2) THEN
184                 it = nmax2 - 1
185                 yf(it + 1) = pis2
186              END IF
187    
188              ! Interpolation entre yi(it) et yi(it + 1) pour avoir Y(yi)
189              ! et Y'(yi)
190    
191              CALL coefpoly(yf(it), yf(it + 1), ytprim(it), ytprim(it + 1), &
192                   yt(it), yt(it + 1), a0, a1, a2, a3)
193    
194              yf1 = yf(it)
195              yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi
196    
197              iter = 1
198              DO
199                 yi = yi - (yf1-yfi)/yprimin
200                 IF (abs(yi-yo1)<=epsilon .or. iter == 300) exit
201                 yo1 = yi
202                 yi2 = yi*yi
203                 yf1 = a0 + a1*yi + a2*yi2 + a3*yi2*yi
204                 yprimin = a1 + 2.*a2*yi + 3.*a3*yi2
205              END DO
206              if (abs(yi-yo1) > epsilon) then
207                 print *, 'Pas de solution.', j, ylon2
208                 STOP 1
209              end if
210    
211              yprimin = a1 + 2.*a2*yi + 3.*a3*yi*yi
212              yprim(j) = pi/(jjm*yprimin)
213              yvrai(j) = yi
214           END DO
215    
216           DO j = 1, jlat - 1
217              IF (yvrai(j + 1)<yvrai(j)) THEN
218                 print *, 'Problème avec rlat(', j + 1, ') plus petit que rlat(', &
219                      j, ')'
220                 STOP 1
221              END IF
222           END DO
223    
224           print *, 'Reorganisation des latitudes pour avoir entre - pi/2 et pi/2'
225    
226           IF (ik==1) THEN
227              ypn = pis2
228              DO j = jjm + 1, 1, -1
229                 IF (yvrai(j)<=ypn) exit
230              END DO
231    
232              jpn = j
233              y00 = yvrai(jpn)
234              deply = pis2 - y00
235           END IF
236    
237           DO j = 1, jjm + 1 - jpn
238              ylatt(j) = -pis2 - y00 + yvrai(jpn + j-1)
239              yprimm(j) = yprim(jpn + j-1)
240           END DO
241    
242           jjpn = jpn
243           IF (jlat==jjm) jjpn = jpn - 1
244    
245           DO j = 1, jjpn
246              ylatt(j + jjm + 1-jpn) = yvrai(j) + deply
247              yprimm(j + jjm + 1-jpn) = yprim(j)
248           END DO
249    
250           ! Fin de la reorganisation
251    
252           DO j = 1, jlat
253              ylat(j) = ylatt(jlat + 1-j)
254              yprim(j) = yprimm(jlat + 1-j)
255           END DO
256    
257           DO j = 1, jlat
258              yvrai(j) = ylat(j)*180./pi
259           END DO
260    
261           IF (ik==1) THEN
262              DO j = 1, jjm + 1
263                 rlatu(j) = ylat(j)
264                 yyprimu(j) = yprim(j)
265              END DO
266           ELSE IF (ik==2) THEN
267              DO j = 1, jjm
268                 rlatv(j) = ylat(j)
269              END DO
270           ELSE IF (ik==3) THEN
271              DO j = 1, jjm
272                 rlatu2(j) = ylat(j)
273                 yprimu2(j) = yprim(j)
274              END DO
275           ELSE IF (ik==4) THEN
276              DO j = 1, jjm
277                 rlatu1(j) = ylat(j)
278                 yprimu1(j) = yprim(j)
279              END DO
280           END IF
281        END DO loop_ik
282    
283      DO j = 1, jlat      DO j = 1, jjm
284        ylat(j) = ylatt(jlat+1-j)         ylat(j) = rlatu(j) - rlatu(j + 1)
       yprim(j) = yprimm(jlat+1-j)  
285      END DO      END DO
286        champmin = 1e12
287      DO j = 1, jlat      champmax = -1e12
288        yvrai(j) = ylat(j)*180./pi      DO j = 1, jjm
289           champmin = min(champmin, ylat(j))
290           champmax = max(champmax, ylat(j))
291      END DO      END DO
292        champmin = champmin*180./pi
293        champmax = champmax*180./pi
294    
295      IF (ik==1) THEN      DO j = 1, jjm
296        ! WRITE(6,18)         IF (rlatu1(j) <= rlatu2(j)) THEN
297        ! WRITE(6,*)  ' YLAT  en U   apres ( en  deg. ) '            print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j
298        ! WRITE(6,68) (yvrai(j),j=1,jlat)            STOP 13
299        ! c         WRITE(6,*) ' YPRIM '         ENDIF
300        ! c         WRITE(6,445) ( yprim(j),j=1,jlat)  
301           IF (rlatu2(j) <= rlatu(j+1)) THEN
302        DO j = 1, jlat            print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j
303          rrlatu(j) = ylat(j)            STOP 14
304          yyprimu(j) = yprim(j)         ENDIF
305        END DO  
306           IF (rlatu(j) <= rlatu1(j)) THEN
307      ELSE IF (ik==2) THEN            print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
308        ! WRITE(6,18)            STOP 15
309        ! WRITE(6,*) ' YLAT   en V  apres ( en  deg. ) '         ENDIF
310        ! WRITE(6,68) (yvrai(j),j=1,jlat)  
311        ! c         WRITE(6,*)' YPRIM '         IF (rlatv(j) <= rlatu2(j)) THEN
312        ! c         WRITE(6,445) ( yprim(j),j=1,jlat)            print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
313              STOP 16
314        DO j = 1, jlat         ENDIF
315          rrlatv(j) = ylat(j)  
316          yyprimv(j) = yprim(j)         IF (rlatv(j) >= rlatu1(j)) THEN
317        END DO            print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
318              STOP 17
319      ELSE IF (ik==3) THEN         ENDIF
320        ! WRITE(6,18)  
321        ! WRITE(6,*)  ' YLAT  en U + 0.75  apres ( en  deg. ) '         IF (rlatv(j) >= rlatu(j)) THEN
322        ! WRITE(6,68) (yvrai(j),j=1,jlat)            print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j
323        ! c         WRITE(6,*) ' YPRIM '            STOP 18
324        ! c         WRITE(6,445) ( yprim(j),j=1,jlat)         ENDIF
325        ENDDO
326        DO j = 1, jlat  
327          rlatu2(j) = ylat(j)      print *, 'Latitudes'
328          yprimu2(j) = yprim(j)      print 3, champmin, champmax
329        END DO  
330    3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
331      ELSE IF (ik==4) THEN           ' d environ ', f0.2, ' degres ', /, &
332        ! WRITE(6,18)           ' alors que la maille en dehors de la zone du zoom est ', &
333        ! WRITE(6,*)  ' YLAT en U + 0.25  apres ( en  deg. ) '           "d'environ ", f0.2, ' degres ')
       ! WRITE(6,68)(yvrai(j),j=1,jlat)  
       ! c         WRITE(6,*) ' YPRIM '  
       ! c         WRITE(6,68) ( yprim(j),j=1,jlat)  
   
       DO j = 1, jlat  
         rlatu1(j) = ylat(j)  
         yprimu1(j) = yprim(j)  
       END DO  
   
     END IF  
   
   END DO  
   
   WRITE (6, 18)  
   
   ! .....     fin de la boucle  do 5000 .....  
334    
335    DO j = 1, jjm    END SUBROUTINE fyhyp
     ylat(j) = rrlatu(j) - rrlatu(j+1)  
   END DO  
   champmin = 1.E12  
   champmax = -1.E12  
   DO j = 1, jjm  
     champmin = min(champmin, ylat(j))  
     champmax = max(champmax, ylat(j))  
   END DO  
   champmin = champmin*180./pi  
   champmax = champmax*180./pi  
   
 24 FORMAT (2X, 'Parametres yzoom,gross,tau ,dzoom pour fyhyp ', 4F8.3)  
 18 FORMAT (/)  
 68 FORMAT (1X, 7F9.2)  
336    
337    RETURN  end module fyhyp_m
 END SUBROUTINE fyhyp  
Legend:
Removed from v.81  
changed lines
  Added in v.121
  ViewVC Help
Powered by ViewVC 1.1.21