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