/[lmdze]/trunk/Sources/dyn3d/fxhyp.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/fxhyp.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 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 7  contains Line 7  contains
7    SUBROUTINE fxhyp(xzoomdeg, grossism, dzooma, tau, rlonm025, xprimm025, &    SUBROUTINE fxhyp(xzoomdeg, grossism, dzooma, tau, rlonm025, xprimm025, &
8         rlonv, xprimv, rlonu, xprimu, rlonp025, xprimp025, champmin, champmax)         rlonv, xprimv, rlonu, xprimu, rlonp025, xprimp025, champmin, champmax)
9    
10      ! From LMDZ4/libf/dyn3d/fxhyp.F, v 1.2 2005/06/03 09:11:32 fairhead      ! From LMDZ4/libf/dyn3d/fxhyp.F, version 1.2, 2005/06/03 09:11:32
11        ! Author: P. Le Van
     ! Auteur : P. Le Van  
12    
13      ! Calcule les longitudes et dérivées dans la grille du GCM pour      ! Calcule les longitudes et dérivées dans la grille du GCM pour
14      ! une fonction f(x) à tangente hyperbolique.      ! une fonction f(x) à tangente hyperbolique.
# Line 19  contains Line 18  contains
18      USE dimens_m, ONLY: iim      USE dimens_m, ONLY: iim
19      USE paramet_m, ONLY: iip1      USE paramet_m, ONLY: iip1
20    
21      INTEGER nmax, nmax2      REAL, intent(in):: xzoomdeg
22      PARAMETER (nmax = 30000, nmax2 = 2*nmax)  
23        REAL, intent(in):: grossism
24        ! grossissement (= 2 si 2 fois, = 3 si 3 fois, etc.)
25    
26        REAL, intent(in):: dzooma ! distance totale de la zone du zoom
27    
28      LOGICAL scal180      REAL, intent(in):: tau
29      PARAMETER (scal180 = .TRUE.)      ! raideur de la transition de l'intérieur à l'extérieur du zoom
30    
31      ! scal180 = .TRUE. si on veut avoir le premier point scalaire pour      ! arguments de sortie
     ! une grille reguliere (grossism = 1., tau=0., clon=0.) a -180. degres.  
     ! sinon scal180 = .FALSE.  
32    
33      ! ...... arguments d'entree .......      REAL, dimension(iip1):: rlonm025, xprimm025, rlonv, xprimv
34        real, dimension(iip1):: rlonu, xprimu, rlonp025, xprimp025
35    
36      REAL xzoomdeg, dzooma, tau, grossism      DOUBLE PRECISION, intent(out):: champmin, champmax
     ! grossism etant le grossissement (= 2 si 2 fois, = 3 si 3 fois, etc.)  
     ! dzooma etant la distance totale de la zone du zoom  
     ! tau la raideur de la transition de l'interieur a l'exterieur du zoom  
37    
38      ! ...... arguments de sortie ......      ! Local:
39    
40      REAL rlonm025(iip1), xprimm025(iip1), rlonv(iip1), xprimv(iip1), &      INTEGER, PARAMETER:: nmax = 30000, nmax2 = 2*nmax
          rlonu(iip1), xprimu(iip1), rlonp025(iip1), xprimp025(iip1)  
41    
42      ! .... variables locales ....      LOGICAL, PARAMETER:: scal180 = .TRUE.
43        ! scal180 = .TRUE. si on veut avoir le premier point scalaire pour
44        ! une grille reguliere (grossism = 1., tau=0., clon=0.) a
45        ! -180. degres. sinon scal180 = .FALSE.
46    
47      REAL dzoom      REAL dzoom
48      DOUBLE PRECISION xlon(iip1), xprimm(iip1), xuv      DOUBLE PRECISION xlon(iip1), xprimm(iip1), xuv
# Line 53  contains Line 54  contains
54      DOUBLE PRECISION Xf1, Xfi, a0, a1, a2, a3, xi2      DOUBLE PRECISION Xf1, Xfi, a0, a1, a2, a3, xi2
55      INTEGER i, it, ik, iter, ii, idif, ii1, ii2      INTEGER i, it, ik, iter, ii, idif, ii1, ii2
56      DOUBLE PRECISION xi, xo1, xmoy, xlon2, fxm, Xprimin      DOUBLE PRECISION xi, xo1, xmoy, xlon2, fxm, Xprimin
57      DOUBLE PRECISION champmin, champmax, decalx      DOUBLE PRECISION decalx
58      INTEGER is2      INTEGER is2
59      SAVE is2      SAVE is2
60    
61      DOUBLE PRECISION heavyside      DOUBLE PRECISION heavyside
62    
63        !----------------------------------------------------------------------
64    
65      pi = 2. * ASIN(1.)      pi = 2. * ASIN(1.)
66      depi = 2. * pi      depi = 2. * pi
67      epsilon = 1.e-3      epsilon = 1.e-3
68      xzoom = xzoomdeg * pi/180.      xzoom = xzoomdeg * pi/180.
69    
70      decalx = .75      decalx = .75
71      IF(grossism.EQ.1..AND.scal180) THEN      IF (grossism == 1. .AND. scal180) THEN
72         decalx = 1.         decalx = 1.
73      ENDIF      ENDIF
74    
75      WRITE(6, *) 'FXHYP scal180, decalx', scal180, decalx      print *, 'FXHYP scal180, decalx', scal180, decalx
76    
77      IF(dzooma.LT.1.) THEN      IF (dzooma.LT.1.) THEN
78         dzoom = dzooma * depi         dzoom = dzooma * depi
79      ELSEIF(dzooma.LT. 25.) THEN      ELSEIF (dzooma.LT. 25.) THEN
80         WRITE(6, *) ' Le param. dzoomx pour fxhyp est trop petit ! L augmenter et relancer ! '         print *, "Le paramètre dzoomx pour fxhyp est trop petit. " &
81                // "L'augmenter et relancer."
82         STOP 1         STOP 1
83      ELSE      ELSE
84         dzoom = dzooma * pi/180.         dzoom = dzooma * pi/180.
85      ENDIF      ENDIF
86    
87      WRITE(6, *) ' xzoom(rad.), grossism, tau, dzoom (radians)'      print *, ' xzoom(rad), grossism, tau, dzoom (rad):'
88      WRITE(6, 24) xzoom, grossism, tau, dzoom      print *, xzoom, grossism, tau, dzoom
89    
90      DO i = 0, nmax2      DO i = 0, nmax2
91         xtild(i) = - pi + FLOAT(i) * depi /nmax2         xtild(i) = - pi + FLOAT(i) * depi /nmax2
92      ENDDO      ENDDO
93    
94      DO i = nmax, nmax2      DO i = nmax, nmax2
   
95         fa = tau* (dzoom/2. - xtild(i))         fa = tau* (dzoom/2. - xtild(i))
96         fb = xtild(i) * (pi - xtild(i))         fb = xtild(i) * (pi - xtild(i))
97    
98         IF(200.* fb .LT. - fa) THEN         IF (200.* fb .LT. - fa) THEN
99            fhyp (i) = - 1.            fhyp (i) = - 1.
100         ELSEIF(200. * fb .LT. fa) THEN         ELSEIF (200. * fb .LT. fa) THEN
101            fhyp (i) = 1.            fhyp (i) = 1.
102         ELSE         ELSE
103            IF(ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13) THEN            IF (ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13) THEN
104               IF(200.*fb + fa.LT.1.e-10) THEN               IF (200.*fb + fa.LT.1.e-10) THEN
105                  fhyp (i) = - 1.                  fhyp (i) = - 1.
106               ELSEIF(200.*fb - fa.LT.1.e-10) THEN               ELSEIF (200.*fb - fa.LT.1.e-10) THEN
107                  fhyp (i) = 1.                  fhyp (i) = 1.
108               ENDIF               ENDIF
109            ELSE            ELSE
110               fhyp (i) = TANH (fa/fb)               fhyp (i) = TANH (fa/fb)
111            ENDIF            ENDIF
112         ENDIF         ENDIF
        IF (xtild(i).EQ. 0.) fhyp(i) = 1.  
        IF (xtild(i).EQ. pi) fhyp(i) = -1.  
113    
114           IF (xtild(i) == 0.) fhyp(i) = 1.
115           IF (xtild(i) == pi) fhyp(i) = -1.
116      ENDDO      ENDDO
117    
118      !c .... Calcul de beta ....      ! Calcul de beta
119    
120      ffdx = 0.      ffdx = 0.
121    
122      DO i = nmax +1, nmax2      DO i = nmax + 1, nmax2
   
123         xmoy = 0.5 * (xtild(i-1) + xtild(i))         xmoy = 0.5 * (xtild(i-1) + xtild(i))
124         fa = tau* (dzoom/2. - xmoy)         fa = tau* (dzoom/2. - xmoy)
125         fb = xmoy * (pi - xmoy)         fb = xmoy * (pi - xmoy)
126    
127         IF(200.* fb .LT. - fa) THEN         IF (200.* fb .LT. - fa) THEN
128            fxm = - 1.            fxm = - 1.
129         ELSEIF(200. * fb .LT. fa) THEN         ELSEIF (200. * fb .LT. fa) THEN
130            fxm = 1.            fxm = 1.
131         ELSE         ELSE
132            IF(ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13) THEN            IF (ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13) THEN
133               IF(200.*fb + fa.LT.1.e-10) THEN               IF (200.*fb + fa.LT.1.e-10) THEN
134                  fxm = - 1.                  fxm = - 1.
135               ELSEIF(200.*fb - fa.LT.1.e-10) THEN               ELSEIF (200.*fb - fa.LT.1.e-10) THEN
136                  fxm = 1.                  fxm = 1.
137               ENDIF               ENDIF
138            ELSE            ELSE
# Line 138  contains Line 140  contains
140            ENDIF            ENDIF
141         ENDIF         ENDIF
142    
143         IF (xmoy.EQ. 0.) fxm = 1.         IF (xmoy == 0.) fxm = 1.
144         IF (xmoy.EQ. pi) fxm = -1.         IF (xmoy == pi) fxm = -1.
145    
146         ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))         ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
   
147      ENDDO      ENDDO
148    
149      beta = (grossism * ffdx - pi) / (ffdx - pi)      beta = (grossism * ffdx - pi) / (ffdx - pi)
150    
151      IF(2.*beta - grossism.LE. 0.) THEN      IF (2.*beta - grossism <= 0.) THEN
152         WRITE(6, *) ' ** Attention ! La valeur beta calculee dans la routine fxhyp est mauvaise ! '         print *, 'Attention ! La valeur beta calculée dans fxhyp est mauvaise.'
153         WRITE(6, *)'Modifier les valeurs de grossismx, tau ou dzoomx ', &         print *, 'Modifier les valeurs de grossismx, tau ou dzoomx et relancer.'
             ' et relancer ! *** '  
154         STOP 1         STOP 1
155      ENDIF      ENDIF
156    
157      ! ..... calcul de Xprimt .....      ! calcul de Xprimt
   
158    
159      DO i = nmax, nmax2      DO i = nmax, nmax2
160         Xprimt(i) = beta + (grossism - beta) * fhyp(i)         Xprimt(i) = beta + (grossism - beta) * fhyp(i)
161      ENDDO      ENDDO
162    
163      DO i = nmax+1, nmax2      DO i = nmax + 1, nmax2
164         Xprimt(nmax2 - i) = Xprimt(i)         Xprimt(nmax2 - i) = Xprimt(i)
165      ENDDO      ENDDO
166    
167        ! Calcul de Xf
     ! ..... Calcul de Xf ........  
168    
169      Xf(0) = - pi      Xf(0) = - pi
170    
171      DO i = nmax +1, nmax2      DO i = nmax + 1, nmax2
   
172         xmoy = 0.5 * (xtild(i-1) + xtild(i))         xmoy = 0.5 * (xtild(i-1) + xtild(i))
173         fa = tau* (dzoom/2. - xmoy)         fa = tau* (dzoom/2. - xmoy)
174         fb = xmoy * (pi - xmoy)         fb = xmoy * (pi - xmoy)
175    
176         IF(200.* fb .LT. - fa) THEN         IF (200.* fb .LT. - fa) THEN
177            fxm = - 1.            fxm = - 1.
178         ELSEIF(200. * fb .LT. fa) THEN         ELSEIF (200. * fb .LT. fa) THEN
179            fxm = 1.            fxm = 1.
180         ELSE         ELSE
181            fxm = TANH (fa/fb)            fxm = TANH (fa/fb)
182         ENDIF         ENDIF
183    
184         IF (xmoy.EQ. 0.) fxm = 1.         IF (xmoy == 0.) fxm = 1.
185         IF (xmoy.EQ. pi) fxm = -1.         IF (xmoy == pi) fxm = -1.
186         xxpr(i) = beta + (grossism - beta) * fxm         xxpr(i) = beta + (grossism - beta) * fxm
   
187      ENDDO      ENDDO
188    
189      DO i = nmax+1, nmax2      DO i = nmax + 1, nmax2
190         xxpr(nmax2-i+1) = xxpr(i)         xxpr(nmax2-i + 1) = xxpr(i)
191      ENDDO      ENDDO
192    
193      DO i=1, nmax2      DO i=1, nmax2
194         Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))         Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))
195      ENDDO      ENDDO
196    
197      ! *****************************************************************      ! xuv = 0. si calcul aux pts scalaires
198        ! xuv = 0.5 si calcul aux pts U
   
     ! ..... xuv = 0. si calcul aux pts scalaires ........  
     ! ..... xuv = 0.5 si calcul aux pts U ........  
199    
200      WRITE(6, 18)      print *
201    
202      DO ik = 1, 4      DO ik = 1, 4
203           IF (ik == 1) THEN
        IF(ik.EQ.1) THEN  
204            xuv = -0.25            xuv = -0.25
205         ELSE IF (ik.EQ.2) THEN         ELSE IF (ik == 2) THEN
206            xuv = 0.            xuv = 0.
207         ELSE IF (ik.EQ.3) THEN         ELSE IF (ik == 3) THEN
208            xuv = 0.50            xuv = 0.50
209         ELSE IF (ik.EQ.4) THEN         ELSE IF (ik == 4) THEN
210            xuv = 0.25            xuv = 0.25
211         ENDIF         ENDIF
212    
# Line 222  contains Line 214  contains
214    
215         ii1=1         ii1=1
216         ii2=iim         ii2=iim
217         IF(ik.EQ.1.and.grossism.EQ.1.) THEN         IF (ik == 1.and.grossism == 1.) THEN
218            ii1 = 2            ii1 = 2
219            ii2 = iim+1            ii2 = iim + 1
220         ENDIF         ENDIF
        DO i = ii1, ii2  
221    
222           DO i = ii1, ii2
223            xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim)            xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim)
   
224            Xfi = xlon2            Xfi = xlon2
225    
226            DO it = nmax2, 0, -1            it = nmax2
227               IF(Xfi.GE.Xf(it)) GO TO 350            do while (xfi < xf(it) .and. it >= 1)
228            end DO               it = it - 1
229              end do
           it = 0  
   
 350       CONTINUE  
230    
231            ! ...... Calcul de Xf(xi) ......            ! Calcul de Xf(xi)
232    
233            xi = xtild(it)            xi = xtild(it)
234    
235            IF(it.EQ.nmax2) THEN            IF (it == nmax2) THEN
236               it = nmax2 -1               it = nmax2 -1
237               Xf(it+1) = pi               Xf(it + 1) = pi
238            ENDIF            ENDIF
           ! .....................................................................  
239    
240            ! Appel de la routine qui calcule les coefficients a0, a1, a2, a3 d'un            ! Appel de la routine qui calcule les coefficients a0, a1,
241            ! polynome de degre 3 qui passe par les points (Xf(it), xtild(it))            ! a2, a3 d'un polynome de degre 3 qui passe par les points
242            ! et (Xf(it+1), xtild(it+1))            ! (Xf(it), xtild(it)) et (Xf(it + 1), xtild(it + 1))
243    
244            CALL coefpoly (Xf(it), Xf(it+1), Xprimt(it), Xprimt(it+1), &            CALL coefpoly(Xf(it), Xf(it + 1), Xprimt(it), Xprimt(it + 1), &
245                 xtild(it), xtild(it+1), a0, a1, a2, a3)                 xtild(it), xtild(it + 1), a0, a1, a2, a3)
246    
247            Xf1 = Xf(it)            Xf1 = Xf(it)
248            Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi            Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
249    
250            DO iter = 1, 300            iter = 1
              xi = xi - (Xf1 - Xfi)/ Xprimin  
251    
252               IF(ABS(xi-xo1).LE.epsilon) GO TO 550            do
253                 xi = xi - (Xf1 - Xfi)/ Xprimin
254                 IF (ABS(xi - xo1) <= epsilon .or. iter == 300) exit
255               xo1 = xi               xo1 = xi
256               xi2 = xi * xi               xi2 = xi * xi
257               Xf1 = a0 + a1 * xi + a2 * xi2 + a3 * xi2 * xi               Xf1 = a0 + a1 * xi + a2 * xi2 + a3 * xi2 * xi
258               Xprimin = a1 + 2.* a2 * xi + 3.* a3 * xi2               Xprimin = a1 + 2.* a2 * xi + 3.* a3 * xi2
259            end DO            end DO
260            WRITE(6, *) ' Pas de solution ***** ', i, xlon2, iter  
261            STOP 6            if (ABS(xi - xo1) > epsilon) then
262  550       CONTINUE               ! iter == 300
263                 print *, 'Pas de solution.'
264                 print *, i, xlon2
265                 STOP 1
266              end if
267    
268    
269            xxprim(i) = depi/ (FLOAT(iim) * Xprimin)            xxprim(i) = depi/ (FLOAT(iim) * Xprimin)
270            xvrai(i) = xi + xzoom            xvrai(i) = xi + xzoom
   
271         end DO         end DO
272    
273         IF(ik.EQ.1.and.grossism.EQ.1.) THEN         IF (ik == 1.and.grossism == 1.) THEN
274            xvrai(1) = xvrai(iip1)-depi            xvrai(1) = xvrai(iip1)-depi
275            xxprim(1) = xxprim(iip1)            xxprim(1) = xxprim(iip1)
276         ENDIF         ENDIF
# Line 287  contains Line 279  contains
279            xprimm(i) = xxprim(i)            xprimm(i) = xxprim(i)
280         ENDDO         ENDDO
281         DO i = 1, iim -1         DO i = 1, iim -1
282            IF(xvrai(i+1).LT. xvrai(i)) THEN            IF (xvrai(i + 1).LT. xvrai(i)) THEN
283               WRITE(6, *) ' PBS. avec rlonu(', i+1, ') plus petit que rlonu(', i, &               print *, 'Problème avec rlonu(', i + 1, &
284                    ')'                    ') plus petit que rlonu(', i, ')'
285               STOP 7               STOP 1
286            ENDIF            ENDIF
287         ENDDO         ENDDO
288    
289         ! ... Reorganisation des longitudes pour les avoir entre - pi et pi ..         ! Reorganisation des longitudes pour les avoir entre - pi et pi
        ! ........................................................................  
290    
291         champmin = 1.e12         champmin = 1.e12
292         champmax = -1.e12         champmax = -1.e12
# Line 304  contains Line 295  contains
295            champmax = MAX(champmax, xvrai(i))            champmax = MAX(champmax, xvrai(i))
296         ENDDO         ENDDO
297    
298         IF(.not. (champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10)) THEN         IF (.not. (champmin >= -pi-0.10.and.champmax <= pi + 0.10)) THEN
299            WRITE(6, *) 'Reorganisation des longitudes pour avoir entre - pi', &            print *, 'Reorganisation des longitudes pour avoir entre - pi', &
300                 ' et pi '                 ' et pi '
301    
302            IF(xzoom.LE.0.) THEN            IF (xzoom <= 0.) THEN
303               IF(ik.EQ. 1) THEN               IF (ik == 1) THEN
304                  DO i = 1, iim                  i = 1
305                     IF(xvrai(i).GE. - pi) GO TO 80  
306                  ENDDO                  do while (xvrai(i) < - pi .and. i < iim)
307                  WRITE(6, *) ' PBS. 1 ! Xvrai plus petit que - pi ! '                     i = i + 1
308                  STOP 8                  end do
309  80              CONTINUE  
310                    if (xvrai(i) < - pi) then
311                       print *, ' PBS. 1 ! Xvrai plus petit que - pi ! '
312                       STOP 1
313                    end if
314    
315                  is2 = i                  is2 = i
316               ENDIF               ENDIF
317    
318               IF(is2.NE. 1) THEN               IF (is2.NE. 1) THEN
319                  DO ii = is2, iim                  DO ii = is2, iim
320                     xlon (ii-is2+1) = xvrai(ii)                     xlon (ii-is2 + 1) = xvrai(ii)
321                     xprimm(ii-is2+1) = xxprim(ii)                     xprimm(ii-is2 + 1) = xxprim(ii)
322                  ENDDO                  ENDDO
323                  DO ii = 1, is2 -1                  DO ii = 1, is2 -1
324                     xlon (ii+iim-is2+1) = xvrai(ii) + depi                     xlon (ii + iim-is2 + 1) = xvrai(ii) + depi
325                     xprimm(ii+iim-is2+1) = xxprim(ii)                     xprimm(ii + iim-is2 + 1) = xxprim(ii)
326                  ENDDO                  ENDDO
327               ENDIF               ENDIF
328            ELSE            ELSE
329               IF(ik.EQ.1) THEN               IF (ik == 1) THEN
330                  DO i = iim, 1, -1                  i = iim
331                     IF(xvrai(i).LE. pi) GO TO 90  
332                  ENDDO                  do while (xvrai(i) > pi .and. i > 1)
333                  WRITE(6, *) ' PBS. 2 ! Xvrai plus grand que pi ! '                     i = i - 1
334                  STOP 9                  end do
335  90              CONTINUE  
336                    if (xvrai(i) > pi) then
337                       print *, ' PBS. 2 ! Xvrai plus grand que pi ! '
338                       STOP 1
339                    end if
340    
341                  is2 = i                  is2 = i
342               ENDIF               ENDIF
343               idif = iim -is2               idif = iim -is2
344               DO ii = 1, is2               DO ii = 1, is2
345                  xlon (ii+idif) = xvrai(ii)                  xlon (ii + idif) = xvrai(ii)
346                  xprimm(ii+idif) = xxprim(ii)                  xprimm(ii + idif) = xxprim(ii)
347               ENDDO               ENDDO
348               DO ii = 1, idif               DO ii = 1, idif
349                  xlon (ii) = xvrai (ii+is2) - depi                  xlon (ii) = xvrai (ii + is2) - depi
350                  xprimm(ii) = xxprim(ii+is2)                  xprimm(ii) = xxprim(ii + is2)
351               ENDDO               ENDDO
352            ENDIF            ENDIF
353         ENDIF         ENDIF
354    
355         ! ......... Fin de la reorganisation ............................         ! Fin de la reorganisation
356    
357         xlon (iip1) = xlon(1) + depi         xlon (iip1) = xlon(1) + depi
358         xprimm(iip1) = xprimm (1)         xprimm(iip1) = xprimm (1)
359    
360         DO i = 1, iim+1         DO i = 1, iim + 1
361            xvrai(i) = xlon(i)*180./pi            xvrai(i) = xlon(i)*180./pi
362         ENDDO         ENDDO
363    
364         IF(ik.EQ.1) THEN         IF (ik == 1) THEN
365            ! WRITE(6, *) ' XLON aux pts. V-0.25 apres (en deg.) '            DO i = 1, iim + 1
           ! WRITE(6, 18)  
           ! WRITE(6, 68) xvrai  
           ! WRITE(6, *) ' XPRIM k ', ik  
           ! WRITE(6, 566) xprimm  
   
           DO i = 1, iim +1  
366               rlonm025(i) = xlon(i)               rlonm025(i) = xlon(i)
367               xprimm025(i) = xprimm(i)               xprimm025(i) = xprimm(i)
368            ENDDO            ENDDO
369         ELSE IF(ik.EQ.2) THEN         ELSE IF (ik == 2) THEN
           ! WRITE(6, 18)  
           ! WRITE(6, *) ' XLON aux pts. V apres (en deg.) '  
           ! WRITE(6, 68) xvrai  
           ! WRITE(6, *) ' XPRIM k ', ik  
           ! WRITE(6, 566) xprimm  
   
370            DO i = 1, iim + 1            DO i = 1, iim + 1
371               rlonv(i) = xlon(i)               rlonv(i) = xlon(i)
372               xprimv(i) = xprimm(i)               xprimv(i) = xprimm(i)
373            ENDDO            ENDDO
374           ELSE IF (ik == 3) THEN
        ELSE IF(ik.EQ.3) THEN  
           ! WRITE(6, 18)  
           ! WRITE(6, *) ' XLON aux pts. U apres (en deg.) '  
           ! WRITE(6, 68) xvrai  
           ! WRITE(6, *) ' XPRIM ik ', ik  
           ! WRITE(6, 566) xprimm  
   
375            DO i = 1, iim + 1            DO i = 1, iim + 1
376               rlonu(i) = xlon(i)               rlonu(i) = xlon(i)
377               xprimu(i) = xprimm(i)               xprimu(i) = xprimm(i)
378            ENDDO            ENDDO
379           ELSE IF (ik == 4) THEN
        ELSE IF(ik.EQ.4) THEN  
           ! WRITE(6, 18)  
           ! WRITE(6, *) ' XLON aux pts. V+0.25 apres (en deg.) '  
           ! WRITE(6, 68) xvrai  
           ! WRITE(6, *) ' XPRIM ik ', ik  
           ! WRITE(6, 566) xprimm  
   
380            DO i = 1, iim + 1            DO i = 1, iim + 1
381               rlonp025(i) = xlon(i)               rlonp025(i) = xlon(i)
382               xprimp025(i) = xprimm(i)               xprimp025(i) = xprimm(i)
383            ENDDO            ENDDO
   
384         ENDIF         ENDIF
   
385      end DO      end DO
386    
387      WRITE(6, 18)      print *
388    
389      DO i = 1, iim      DO i = 1, iim
390         xlon(i) = rlonv(i+1) - rlonv(i)         xlon(i) = rlonv(i + 1) - rlonv(i)
391      ENDDO      ENDDO
392      champmin = 1.e12      champmin = 1.e12
393      champmax = -1.e12      champmax = -1.e12
# Line 425  contains Line 398  contains
398      champmin = champmin * 180./pi      champmin = champmin * 180./pi
399      champmax = champmax * 180./pi      champmax = champmax * 180./pi
400    
 18  FORMAT(/)  
 24  FORMAT(2x, 'Parametres xzoom, gross, tau, dzoom pour fxhyp ', 4f8.3)  
 68  FORMAT(1x, 7f9.2)  
 566 FORMAT(1x, 7f9.4)  
   
401    END SUBROUTINE fxhyp    END SUBROUTINE fxhyp
402    
403  end module fxhyp_m  end module fxhyp_m
Legend:
Removed from v.82  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21