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

Diff of /trunk/dyn3d/fxhyp.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/dyn3d/fxhyp.f90 revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC trunk/dyn3d/fxhyp.f revision 105 by guez, Thu Sep 4 10:40:24 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      !----------------------------------------------------------------------
62    
63      pi = 2. * ASIN(1.)      pi = 2. * ASIN(1.)
64      depi = 2. * pi      depi = 2. * pi
# Line 65  contains Line 66  contains
66      xzoom = xzoomdeg * pi/180.      xzoom = xzoomdeg * pi/180.
67    
68      decalx = .75      decalx = .75
69      IF(grossism.EQ.1..AND.scal180) THEN      IF (grossism == 1. .AND. scal180) THEN
70         decalx = 1.         decalx = 1.
71      ENDIF      ENDIF
72    
73      WRITE(6, *) 'FXHYP scal180, decalx', scal180, decalx      print *, 'FXHYP scal180, decalx', scal180, decalx
74    
75      IF(dzooma.LT.1.) THEN      IF (dzooma.LT.1.) THEN
76         dzoom = dzooma * depi         dzoom = dzooma * depi
77      ELSEIF(dzooma.LT. 25.) THEN      ELSEIF (dzooma.LT. 25.) THEN
78         WRITE(6, *) ' Le param. dzoomx pour fxhyp est trop petit ! L augmenter et relancer ! '         print *, "Le paramètre dzoomx pour fxhyp est trop petit. " &
79                // "L'augmenter et relancer."
80         STOP 1         STOP 1
81      ELSE      ELSE
82         dzoom = dzooma * pi/180.         dzoom = dzooma * pi/180.
83      ENDIF      ENDIF
84    
85      WRITE(6, *) ' xzoom(rad.), grossism, tau, dzoom (radians)'      print *, ' xzoom(rad), grossism, tau, dzoom (rad):'
86      WRITE(6, 24) xzoom, grossism, tau, dzoom      print *, xzoom, grossism, tau, dzoom
87    
88      DO i = 0, nmax2      DO i = 0, nmax2
89         xtild(i) = - pi + FLOAT(i) * depi /nmax2         xtild(i) = - pi + FLOAT(i) * depi /nmax2
90      ENDDO      ENDDO
91    
92      DO i = nmax, nmax2      DO i = nmax, nmax2
   
93         fa = tau* (dzoom/2. - xtild(i))         fa = tau* (dzoom/2. - xtild(i))
94         fb = xtild(i) * (pi - xtild(i))         fb = xtild(i) * (pi - xtild(i))
95    
96         IF(200.* fb .LT. - fa) THEN         IF (200.* fb .LT. - fa) THEN
97            fhyp (i) = - 1.            fhyp (i) = - 1.
98         ELSEIF(200. * fb .LT. fa) THEN         ELSEIF (200. * fb .LT. fa) THEN
99            fhyp (i) = 1.            fhyp (i) = 1.
100         ELSE         ELSE
101            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
102               IF(200.*fb + fa.LT.1.e-10) THEN               IF (200.*fb + fa.LT.1.e-10) THEN
103                  fhyp (i) = - 1.                  fhyp (i) = - 1.
104               ELSEIF(200.*fb - fa.LT.1.e-10) THEN               ELSEIF (200.*fb - fa.LT.1.e-10) THEN
105                  fhyp (i) = 1.                  fhyp (i) = 1.
106               ENDIF               ENDIF
107            ELSE            ELSE
108               fhyp (i) = TANH (fa/fb)               fhyp (i) = TANH (fa/fb)
109            ENDIF            ENDIF
110         ENDIF         ENDIF
        IF (xtild(i).EQ. 0.) fhyp(i) = 1.  
        IF (xtild(i).EQ. pi) fhyp(i) = -1.  
111    
112           IF (xtild(i) == 0.) fhyp(i) = 1.
113           IF (xtild(i) == pi) fhyp(i) = -1.
114      ENDDO      ENDDO
115    
116      !c .... Calcul de beta ....      ! Calcul de beta
117    
118      ffdx = 0.      ffdx = 0.
119    
120      DO i = nmax +1, nmax2      DO i = nmax + 1, nmax2
   
121         xmoy = 0.5 * (xtild(i-1) + xtild(i))         xmoy = 0.5 * (xtild(i-1) + xtild(i))
122         fa = tau* (dzoom/2. - xmoy)         fa = tau* (dzoom/2. - xmoy)
123         fb = xmoy * (pi - xmoy)         fb = xmoy * (pi - xmoy)
124    
125         IF(200.* fb .LT. - fa) THEN         IF (200.* fb .LT. - fa) THEN
126            fxm = - 1.            fxm = - 1.
127         ELSEIF(200. * fb .LT. fa) THEN         ELSEIF (200. * fb .LT. fa) THEN
128            fxm = 1.            fxm = 1.
129         ELSE         ELSE
130            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
131               IF(200.*fb + fa.LT.1.e-10) THEN               IF (200.*fb + fa.LT.1.e-10) THEN
132                  fxm = - 1.                  fxm = - 1.
133               ELSEIF(200.*fb - fa.LT.1.e-10) THEN               ELSEIF (200.*fb - fa.LT.1.e-10) THEN
134                  fxm = 1.                  fxm = 1.
135               ENDIF               ENDIF
136            ELSE            ELSE
# Line 138  contains Line 138  contains
138            ENDIF            ENDIF
139         ENDIF         ENDIF
140    
141         IF (xmoy.EQ. 0.) fxm = 1.         IF (xmoy == 0.) fxm = 1.
142         IF (xmoy.EQ. pi) fxm = -1.         IF (xmoy == pi) fxm = -1.
143    
144         ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))         ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
   
145      ENDDO      ENDDO
146    
147      beta = (grossism * ffdx - pi) / (ffdx - pi)      beta = (grossism * ffdx - pi) / (ffdx - pi)
148    
149      IF(2.*beta - grossism.LE. 0.) THEN      IF (2.*beta - grossism <= 0.) THEN
150         WRITE(6, *) ' ** Attention ! La valeur beta calculee dans la routine fxhyp est mauvaise ! '         print *, 'Attention ! La valeur beta calculée dans fxhyp est mauvaise.'
151         WRITE(6, *)'Modifier les valeurs de grossismx, tau ou dzoomx ', &         print *, 'Modifier les valeurs de grossismx, tau ou dzoomx et relancer.'
             ' et relancer ! *** '  
152         STOP 1         STOP 1
153      ENDIF      ENDIF
154    
155      ! ..... calcul de Xprimt .....      ! calcul de Xprimt
   
156    
157      DO i = nmax, nmax2      DO i = nmax, nmax2
158         Xprimt(i) = beta + (grossism - beta) * fhyp(i)         Xprimt(i) = beta + (grossism - beta) * fhyp(i)
159      ENDDO      ENDDO
160    
161      DO i = nmax+1, nmax2      DO i = nmax + 1, nmax2
162         Xprimt(nmax2 - i) = Xprimt(i)         Xprimt(nmax2 - i) = Xprimt(i)
163      ENDDO      ENDDO
164    
165        ! Calcul de Xf
     ! ..... Calcul de Xf ........  
166    
167      Xf(0) = - pi      Xf(0) = - pi
168    
169      DO i = nmax +1, nmax2      DO i = nmax + 1, nmax2
   
170         xmoy = 0.5 * (xtild(i-1) + xtild(i))         xmoy = 0.5 * (xtild(i-1) + xtild(i))
171         fa = tau* (dzoom/2. - xmoy)         fa = tau* (dzoom/2. - xmoy)
172         fb = xmoy * (pi - xmoy)         fb = xmoy * (pi - xmoy)
173    
174         IF(200.* fb .LT. - fa) THEN         IF (200.* fb .LT. - fa) THEN
175            fxm = - 1.            fxm = - 1.
176         ELSEIF(200. * fb .LT. fa) THEN         ELSEIF (200. * fb .LT. fa) THEN
177            fxm = 1.            fxm = 1.
178         ELSE         ELSE
179            fxm = TANH (fa/fb)            fxm = TANH (fa/fb)
180         ENDIF         ENDIF
181    
182         IF (xmoy.EQ. 0.) fxm = 1.         IF (xmoy == 0.) fxm = 1.
183         IF (xmoy.EQ. pi) fxm = -1.         IF (xmoy == pi) fxm = -1.
184         xxpr(i) = beta + (grossism - beta) * fxm         xxpr(i) = beta + (grossism - beta) * fxm
   
185      ENDDO      ENDDO
186    
187      DO i = nmax+1, nmax2      DO i = nmax + 1, nmax2
188         xxpr(nmax2-i+1) = xxpr(i)         xxpr(nmax2-i + 1) = xxpr(i)
189      ENDDO      ENDDO
190    
191      DO i=1, nmax2      DO i=1, nmax2
192         Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))         Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))
193      ENDDO      ENDDO
194    
195      ! *****************************************************************      ! xuv = 0. si calcul aux pts scalaires
196        ! xuv = 0.5 si calcul aux pts U
197    
198        print *
     ! ..... xuv = 0. si calcul aux pts scalaires ........  
     ! ..... xuv = 0.5 si calcul aux pts U ........  
   
     WRITE(6, 18)  
199    
200      DO ik = 1, 4      DO ik = 1, 4
201           IF (ik == 1) THEN
        IF(ik.EQ.1) THEN  
202            xuv = -0.25            xuv = -0.25
203         ELSE IF (ik.EQ.2) THEN         ELSE IF (ik == 2) THEN
204            xuv = 0.            xuv = 0.
205         ELSE IF (ik.EQ.3) THEN         ELSE IF (ik == 3) THEN
206            xuv = 0.50            xuv = 0.50
207         ELSE IF (ik.EQ.4) THEN         ELSE IF (ik == 4) THEN
208            xuv = 0.25            xuv = 0.25
209         ENDIF         ENDIF
210    
# Line 222  contains Line 212  contains
212    
213         ii1=1         ii1=1
214         ii2=iim         ii2=iim
215         IF(ik.EQ.1.and.grossism.EQ.1.) THEN         IF (ik == 1.and.grossism == 1.) THEN
216            ii1 = 2            ii1 = 2
217            ii2 = iim+1            ii2 = iim + 1
218         ENDIF         ENDIF
        DO i = ii1, ii2  
219    
220           DO i = ii1, ii2
221            xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim)            xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim)
   
222            Xfi = xlon2            Xfi = xlon2
223    
224            DO it = nmax2, 0, -1            it = nmax2
225               IF(Xfi.GE.Xf(it)) GO TO 350            do while (xfi < xf(it) .and. it >= 1)
226            end DO               it = it - 1
227              end do
           it = 0  
228    
229  350       CONTINUE            ! Calcul de Xf(xi)
   
           ! ...... Calcul de Xf(xi) ......  
230    
231            xi = xtild(it)            xi = xtild(it)
232    
233            IF(it.EQ.nmax2) THEN            IF (it == nmax2) THEN
234               it = nmax2 -1               it = nmax2 -1
235               Xf(it+1) = pi               Xf(it + 1) = pi
236            ENDIF            ENDIF
           ! .....................................................................  
237    
238            ! Appel de la routine qui calcule les coefficients a0, a1, a2, a3 d'un            ! Appel de la routine qui calcule les coefficients a0, a1,
239            ! 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
240            ! et (Xf(it+1), xtild(it+1))            ! (Xf(it), xtild(it)) et (Xf(it + 1), xtild(it + 1))
241    
242            CALL coefpoly (Xf(it), Xf(it+1), Xprimt(it), Xprimt(it+1), &            CALL coefpoly(Xf(it), Xf(it + 1), Xprimt(it), Xprimt(it + 1), &
243                 xtild(it), xtild(it+1), a0, a1, a2, a3)                 xtild(it), xtild(it + 1), a0, a1, a2, a3)
244    
245            Xf1 = Xf(it)            Xf1 = Xf(it)
246            Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi            Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi
247    
248            DO iter = 1, 300            iter = 1
              xi = xi - (Xf1 - Xfi)/ Xprimin  
249    
250               IF(ABS(xi-xo1).LE.epsilon) GO TO 550            do
251                 xi = xi - (Xf1 - Xfi)/ Xprimin
252                 IF (ABS(xi - xo1) <= epsilon .or. iter == 300) exit
253               xo1 = xi               xo1 = xi
254               xi2 = xi * xi               xi2 = xi * xi
255               Xf1 = a0 + a1 * xi + a2 * xi2 + a3 * xi2 * xi               Xf1 = a0 + a1 * xi + a2 * xi2 + a3 * xi2 * xi
256               Xprimin = a1 + 2.* a2 * xi + 3.* a3 * xi2               Xprimin = a1 + 2.* a2 * xi + 3.* a3 * xi2
257            end DO            end DO
258            WRITE(6, *) ' Pas de solution ***** ', i, xlon2, iter  
259            STOP 6            if (ABS(xi - xo1) > epsilon) then
260  550       CONTINUE               ! iter == 300
261                 print *, 'Pas de solution.'
262                 print *, i, xlon2
263                 STOP 1
264              end if
265    
266    
267            xxprim(i) = depi/ (FLOAT(iim) * Xprimin)            xxprim(i) = depi/ (FLOAT(iim) * Xprimin)
268            xvrai(i) = xi + xzoom            xvrai(i) = xi + xzoom
   
269         end DO         end DO
270    
271         IF(ik.EQ.1.and.grossism.EQ.1.) THEN         IF (ik == 1.and.grossism == 1.) THEN
272            xvrai(1) = xvrai(iip1)-depi            xvrai(1) = xvrai(iip1)-depi
273            xxprim(1) = xxprim(iip1)            xxprim(1) = xxprim(iip1)
274         ENDIF         ENDIF
# Line 287  contains Line 277  contains
277            xprimm(i) = xxprim(i)            xprimm(i) = xxprim(i)
278         ENDDO         ENDDO
279         DO i = 1, iim -1         DO i = 1, iim -1
280            IF(xvrai(i+1).LT. xvrai(i)) THEN            IF (xvrai(i + 1).LT. xvrai(i)) THEN
281               WRITE(6, *) ' PBS. avec rlonu(', i+1, ') plus petit que rlonu(', i, &               print *, 'Problème avec rlonu(', i + 1, &
282                    ')'                    ') plus petit que rlonu(', i, ')'
283               STOP 7               STOP 1
284            ENDIF            ENDIF
285         ENDDO         ENDDO
286    
287         ! ... Reorganisation des longitudes pour les avoir entre - pi et pi ..         ! Reorganisation des longitudes pour les avoir entre - pi et pi
        ! ........................................................................  
288    
289         champmin = 1.e12         champmin = 1.e12
290         champmax = -1.e12         champmax = -1.e12
# Line 304  contains Line 293  contains
293            champmax = MAX(champmax, xvrai(i))            champmax = MAX(champmax, xvrai(i))
294         ENDDO         ENDDO
295    
296         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
297            WRITE(6, *) 'Reorganisation des longitudes pour avoir entre - pi', &            print *, 'Reorganisation des longitudes pour avoir entre - pi', &
298                 ' et pi '                 ' et pi '
299    
300            IF(xzoom.LE.0.) THEN            IF (xzoom <= 0.) THEN
301               IF(ik.EQ. 1) THEN               IF (ik == 1) THEN
302                  DO i = 1, iim                  i = 1
303                     IF(xvrai(i).GE. - pi) GO TO 80  
304                  ENDDO                  do while (xvrai(i) < - pi .and. i < iim)
305                  WRITE(6, *) ' PBS. 1 ! Xvrai plus petit que - pi ! '                     i = i + 1
306                  STOP 8                  end do
307  80              CONTINUE  
308                    if (xvrai(i) < - pi) then
309                       print *, ' PBS. 1 ! Xvrai plus petit que - pi ! '
310                       STOP 1
311                    end if
312    
313                  is2 = i                  is2 = i
314               ENDIF               ENDIF
315    
316               IF(is2.NE. 1) THEN               IF (is2.NE. 1) THEN
317                  DO ii = is2, iim                  DO ii = is2, iim
318                     xlon (ii-is2+1) = xvrai(ii)                     xlon (ii-is2 + 1) = xvrai(ii)
319                     xprimm(ii-is2+1) = xxprim(ii)                     xprimm(ii-is2 + 1) = xxprim(ii)
320                  ENDDO                  ENDDO
321                  DO ii = 1, is2 -1                  DO ii = 1, is2 -1
322                     xlon (ii+iim-is2+1) = xvrai(ii) + depi                     xlon (ii + iim-is2 + 1) = xvrai(ii) + depi
323                     xprimm(ii+iim-is2+1) = xxprim(ii)                     xprimm(ii + iim-is2 + 1) = xxprim(ii)
324                  ENDDO                  ENDDO
325               ENDIF               ENDIF
326            ELSE            ELSE
327               IF(ik.EQ.1) THEN               IF (ik == 1) THEN
328                  DO i = iim, 1, -1                  i = iim
329                     IF(xvrai(i).LE. pi) GO TO 90  
330                  ENDDO                  do while (xvrai(i) > pi .and. i > 1)
331                  WRITE(6, *) ' PBS. 2 ! Xvrai plus grand que pi ! '                     i = i - 1
332                  STOP 9                  end do
333  90              CONTINUE  
334                    if (xvrai(i) > pi) then
335                       print *, ' PBS. 2 ! Xvrai plus grand que pi ! '
336                       STOP 1
337                    end if
338    
339                  is2 = i                  is2 = i
340               ENDIF               ENDIF
341               idif = iim -is2               idif = iim -is2
342               DO ii = 1, is2               DO ii = 1, is2
343                  xlon (ii+idif) = xvrai(ii)                  xlon (ii + idif) = xvrai(ii)
344                  xprimm(ii+idif) = xxprim(ii)                  xprimm(ii + idif) = xxprim(ii)
345               ENDDO               ENDDO
346               DO ii = 1, idif               DO ii = 1, idif
347                  xlon (ii) = xvrai (ii+is2) - depi                  xlon (ii) = xvrai (ii + is2) - depi
348                  xprimm(ii) = xxprim(ii+is2)                  xprimm(ii) = xxprim(ii + is2)
349               ENDDO               ENDDO
350            ENDIF            ENDIF
351         ENDIF         ENDIF
352    
353         ! ......... Fin de la reorganisation ............................         ! Fin de la reorganisation
354    
355         xlon (iip1) = xlon(1) + depi         xlon (iip1) = xlon(1) + depi
356         xprimm(iip1) = xprimm (1)         xprimm(iip1) = xprimm (1)
357    
358         DO i = 1, iim+1         DO i = 1, iim + 1
359            xvrai(i) = xlon(i)*180./pi            xvrai(i) = xlon(i)*180./pi
360         ENDDO         ENDDO
361    
362         IF(ik.EQ.1) THEN         IF (ik == 1) THEN
363            ! 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  
364               rlonm025(i) = xlon(i)               rlonm025(i) = xlon(i)
365               xprimm025(i) = xprimm(i)               xprimm025(i) = xprimm(i)
366            ENDDO            ENDDO
367         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  
   
368            DO i = 1, iim + 1            DO i = 1, iim + 1
369               rlonv(i) = xlon(i)               rlonv(i) = xlon(i)
370               xprimv(i) = xprimm(i)               xprimv(i) = xprimm(i)
371            ENDDO            ENDDO
372           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  
   
373            DO i = 1, iim + 1            DO i = 1, iim + 1
374               rlonu(i) = xlon(i)               rlonu(i) = xlon(i)
375               xprimu(i) = xprimm(i)               xprimu(i) = xprimm(i)
376            ENDDO            ENDDO
377           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  
   
378            DO i = 1, iim + 1            DO i = 1, iim + 1
379               rlonp025(i) = xlon(i)               rlonp025(i) = xlon(i)
380               xprimp025(i) = xprimm(i)               xprimp025(i) = xprimm(i)
381            ENDDO            ENDDO
   
382         ENDIF         ENDIF
   
383      end DO      end DO
384    
385      WRITE(6, 18)      print *
386    
387      DO i = 1, iim      DO i = 1, iim
388         xlon(i) = rlonv(i+1) - rlonv(i)         xlon(i) = rlonv(i + 1) - rlonv(i)
389      ENDDO      ENDDO
390      champmin = 1.e12      champmin = 1.e12
391      champmax = -1.e12      champmax = -1.e12
# Line 425  contains Line 396  contains
396      champmin = champmin * 180./pi      champmin = champmin * 180./pi
397      champmax = champmax * 180./pi      champmax = champmax * 180./pi
398    
 18  FORMAT(/)  
 24  FORMAT(2x, 'Parametres xzoom, gross, tau, dzoom pour fxhyp ', 4f8.3)  
 68  FORMAT(1x, 7f9.2)  
 566 FORMAT(1x, 7f9.4)  
   
399    END SUBROUTINE fxhyp    END SUBROUTINE fxhyp
400    
401  end module fxhyp_m  end module fxhyp_m
Legend:
Removed from v.78  
changed lines
  Added in v.105
  ViewVC Help
Powered by ViewVC 1.1.21