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

Diff of /trunk/dyn3d/fxhyp.f

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

revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC revision 124 by guez, Thu Feb 5 15:19:37 2015 UTC
# Line 1  Line 1 
1  !  module fxhyp_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/fxhyp.F,v 1.2 2005/06/03 09:11:32 fairhead Exp $  
3  !    IMPLICIT NONE
4  c  
5  c  contains
6         SUBROUTINE fxhyp ( xzoomdeg,grossism,dzooma,tau ,  
7       , rlonm025,xprimm025,rlonv,xprimv,rlonu,xprimu,rlonp025,xprimp025,    SUBROUTINE fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
8       , champmin,champmax                                               )  
9        ! From LMDZ4/libf/dyn3d/fxhyp.F, version 1.2, 2005/06/03 09:11:32
10  c      Auteur :  P. Le Van      ! Author: P. Le Van, from formulas by R. Sadourny
11    
12         use dimens_m      ! Calcule les longitudes et dérivées dans la grille du GCM pour
13        use paramet_m      ! une fonction f(x) à dérivée tangente hyperbolique.
14         IMPLICIT NONE  
15        ! Il vaut mieux avoir : grossismx \times dzoom < pi
16  c    Calcule les longitudes et derivees dans la grille du GCM pour une  
17  c     fonction f(x) a tangente  hyperbolique  .      ! Le premier point scalaire pour une grille regulière (grossismx =
18  c      ! 1., taux=0., clon=0.) est à - 180 degrés.
19  c     grossism etant le grossissement ( = 2 si 2 fois, = 3 si 3 fois,etc.)  
20  c     dzoom  etant  la distance totale de la zone du zoom      USE dimens_m, ONLY: iim
21  c     tau  la raideur de la transition de l'interieur a l'exterieur du zoom      use fxhyp_loop_ik_m, only: fxhyp_loop_ik, nmax
22  c      use nr_util, only: pi, pi_d, twopi_d, arth
23  c    On doit avoir grossism x dzoom <  pi ( radians )   , en longitude.      use principal_cshift_m, only: principal_cshift
24  c   ********************************************************************      use serre, only: clon, grossismx, dzoomx, taux
   
   
        INTEGER nmax, nmax2  
        PARAMETER (  nmax = 30000, nmax2 = 2*nmax )  
 c  
        LOGICAL scal180  
        PARAMETER ( scal180 = .TRUE. )  
   
 c      scal180 = .TRUE.  si on veut avoir le premier point scalaire pour    
 c      une grille reguliere ( grossism = 1.,tau=0.,clon=0. ) a -180. degres.  
 c      sinon scal180 = .FALSE.  
   
         
 c     ......  arguments  d'entree   .......  
 c  
        REAL xzoomdeg,dzooma,tau,grossism  
   
 c    ......   arguments  de  sortie  ......  
   
        REAL rlonm025(iip1),xprimm025(iip1),rlonv(iip1),xprimv(iip1),  
      ,  rlonu(iip1),xprimu(iip1),rlonp025(iip1),xprimp025(iip1)  
   
 c     .... variables locales  ....  
 c  
        REAL   dzoom  
        DOUBLE PRECISION xlon(iip1),xprimm(iip1),xuv  
        DOUBLE PRECISION xtild(0:nmax2)  
        DOUBLE PRECISION fhyp(0:nmax2),ffdx,beta,Xprimt(0:nmax2)  
        DOUBLE PRECISION Xf(0:nmax2),xxpr(0:nmax2)  
        DOUBLE PRECISION xvrai(iip1),xxprim(iip1)  
        DOUBLE PRECISION pi,depi,epsilon,xzoom,fa,fb  
        DOUBLE PRECISION Xf1, Xfi , a0,a1,a2,a3,xi2  
        INTEGER i,it,ik,iter,ii,idif,ii1,ii2  
        DOUBLE PRECISION xi,xo1,xmoy,xlon2,fxm,Xprimin  
        DOUBLE PRECISION champmin,champmax,decalx  
        INTEGER is2  
        SAVE is2  
   
        DOUBLE PRECISION heavyside  
   
        pi       = 2. * ASIN(1.)  
        depi     = 2. * pi  
        epsilon  = 1.e-3  
        xzoom    = xzoomdeg * pi/180.  
 c  
            decalx   = .75  
        IF( grossism.EQ.1..AND.scal180 )  THEN  
            decalx   = 1.  
        ENDIF  
   
        WRITE(6,*) 'FXHYP scal180,decalx', scal180,decalx  
 c  
        IF( dzooma.LT.1.)  THEN  
          dzoom = dzooma * depi  
        ELSEIF( dzooma.LT. 25. ) THEN  
          WRITE(6,*) ' Le param. dzoomx pour fxhyp est trop petit ! L aug  
      ,menter et relancer ! '  
          STOP 1  
        ELSE  
          dzoom = dzooma * pi/180.  
        ENDIF  
25    
26         WRITE(6,*) ' xzoom( rad.),grossism,tau,dzoom (radians)'      REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
27         WRITE(6,24) xzoom,grossism,tau,dzoom      real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
28    
29         DO i = 0, nmax2      ! Local:
30          xtild(i) = - pi + FLOAT(i) * depi /nmax2      real rlonm025(iim + 1), rlonp025(iim + 1)
31         ENDDO      REAL dzoom
32        real d_rlonv(iim)
33         DO i = nmax, nmax2      DOUBLE PRECISION xtild(0:2 * nmax)
34        DOUBLE PRECISION fhyp(nmax:2 * nmax), ffdx, beta, Xprimt(0:2 * nmax)
35         fa  = tau*  ( dzoom/2.  - xtild(i) )      DOUBLE PRECISION Xf(0:2 * nmax), xxpr(2 * nmax)
36         fb  = xtild(i) *  ( pi - xtild(i) )      DOUBLE PRECISION xzoom, fa, fb
37        INTEGER i, is2
38           IF( 200.* fb .LT. - fa )   THEN      DOUBLE PRECISION xmoy, fxm
39             fhyp ( i) = - 1.      DOUBLE PRECISION decalx
40           ELSEIF( 200. * fb .LT. fa ) THEN  
41             fhyp ( i) =   1.      !----------------------------------------------------------------------
42           ELSE  
43              IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN      print *, "Call sequence information: fxhyp"
44                  IF(   200.*fb + fa.LT.1.e-10 )  THEN  
45                      fhyp ( i ) = - 1.      dzoom = dzoomx * twopi_d
46                  ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN      xtild = arth(- pi_d, pi_d / nmax, 2 * nmax + 1)
47                      fhyp ( i )  =   1.  
48                  ENDIF      ! Compute fhyp:
49              ELSE      DO i = nmax, 2 * nmax
50                      fhyp ( i )  =  TANH ( fa/fb )         fa = taux * (dzoom / 2. - xtild(i))
51              ENDIF         fb = xtild(i) * (pi_d - xtild(i))
52           ENDIF  
53          IF ( xtild(i).EQ. 0. )  fhyp(i) =  1.         IF (200. * fb < - fa) THEN
54          IF ( xtild(i).EQ. pi )  fhyp(i) = -1.            fhyp(i) = - 1.
55           ELSE IF (200. * fb < fa) THEN
56         ENDDO            fhyp(i) = 1.
   
 cc  ....  Calcul  de  beta  ....  
   
        ffdx = 0.  
   
        DO i = nmax +1,nmax2  
   
        xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )  
        fa  = tau*  ( dzoom/2.  - xmoy )  
        fb  = xmoy *  ( pi - xmoy )  
   
        IF( 200.* fb .LT. - fa )   THEN  
          fxm = - 1.  
        ELSEIF( 200. * fb .LT. fa ) THEN  
          fxm =   1.  
57         ELSE         ELSE
58              IF( ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13)  THEN            IF (ABS(fa) < 1e-13 .AND. ABS(fb) < 1e-13) THEN
59                  IF(   200.*fb + fa.LT.1.e-10 )  THEN               IF (200. * fb + fa < 1e-10) THEN
60                      fxm   = - 1.                  fhyp(i) = - 1.
61                  ELSEIF( 200.*fb - fa.LT.1.e-10 )  THEN               ELSE IF (200. * fb - fa < 1e-10) THEN
62                      fxm   =   1.                  fhyp(i) = 1.
63                  ENDIF               END IF
64              ELSE            ELSE
65                      fxm   =  TANH ( fa/fb )               fhyp(i) = TANH(fa / fb)
66              ENDIF            END IF
67         ENDIF         END IF
68    
69         IF ( xmoy.EQ. 0. )  fxm  =  1.         IF (xtild(i) == 0.) fhyp(i) = 1.
70         IF ( xmoy.EQ. pi )  fxm  = -1.         IF (xtild(i) == pi_d) fhyp(i) = -1.
71        END DO
72         ffdx = ffdx + fxm * ( xtild(i) - xtild(i-1) )  
73        ! Calcul de beta
74         ENDDO  
75        ffdx = 0.
76          beta  = ( grossism * ffdx - pi ) / ( ffdx - pi )  
77        DO i = nmax + 1, 2 * nmax
78         IF( 2.*beta - grossism.LE. 0.)  THEN         xmoy = 0.5 * (xtild(i-1) + xtild(i))
79          WRITE(6,*) ' **  Attention ! La valeur beta calculee dans la rou         fa = taux * (dzoom / 2. - xmoy)
80       ,tine fxhyp est mauvaise ! '         fb = xmoy * (pi_d - xmoy)
81          WRITE(6,*)'Modifier les valeurs de  grossismx ,tau ou dzoomx ',  
82       , ' et relancer ! ***  '         IF (200. * fb < - fa) THEN
83          STOP 1            fxm = - 1.
84         ENDIF         ELSE IF (200. * fb < fa) THEN
85  c            fxm = 1.
 c   .....  calcul  de  Xprimt   .....  
 c  
         
        DO i = nmax, nmax2  
         Xprimt(i) = beta  + ( grossism - beta ) * fhyp(i)  
        ENDDO  
 c    
        DO i =  nmax+1, nmax2  
         Xprimt( nmax2 - i ) = Xprimt( i )  
        ENDDO  
 c  
   
 c   .....  Calcul  de  Xf     ........  
   
        Xf(0) = - pi  
   
        DO i =  nmax +1, nmax2  
   
        xmoy    = 0.5 * ( xtild(i-1) + xtild( i ) )  
        fa  = tau*  ( dzoom/2.  - xmoy )  
        fb  = xmoy *  ( pi - xmoy )  
   
        IF( 200.* fb .LT. - fa )   THEN  
          fxm = - 1.  
        ELSEIF( 200. * fb .LT. fa ) THEN  
          fxm =   1.  
86         ELSE         ELSE
87           fxm =  TANH ( fa/fb )            IF (ABS(fa) < 1e-13 .AND. ABS(fb) < 1e-13) THEN
88         ENDIF               IF (200. * fb + fa < 1e-10) THEN
89                    fxm = - 1.
90                 ELSE IF (200. * fb - fa < 1e-10) THEN
91                    fxm = 1.
92                 END IF
93              ELSE
94                 fxm = TANH(fa / fb)
95              END IF
96           END IF
97    
98           IF (xmoy == 0.) fxm = 1.
99           IF (xmoy == pi_d) fxm = -1.
100    
101           ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
102        END DO
103    
104        print *, "ffdx = ", ffdx
105        beta = (grossismx * ffdx - pi_d) / (ffdx - pi_d)
106        print *, "beta = ", beta
107    
108        IF (2. * beta - grossismx <= 0.) THEN
109           print *, 'Bad choice of grossismx, taux, dzoomx.'
110           print *, 'Decrease dzoomx or grossismx.'
111           STOP 1
112        END IF
113    
114        ! calcul de Xprimt
115        Xprimt(nmax:2 * nmax) = beta + (grossismx - beta) * fhyp
116        xprimt(:nmax - 1) = xprimt(2 * nmax:nmax + 1:- 1)
117    
118        ! Calcul de Xf
119    
120        DO i = nmax + 1, 2 * nmax
121           xmoy = 0.5 * (xtild(i-1) + xtild(i))
122           fa = taux * (dzoom / 2. - xmoy)
123           fb = xmoy * (pi_d - xmoy)
124    
125           IF (200. * fb < - fa) THEN
126              fxm = - 1.
127           ELSE IF (200. * fb < fa) THEN
128              fxm = 1.
129           ELSE
130              fxm = TANH(fa / fb)
131           END IF
132    
133           IF (xmoy == 0.) fxm = 1.
134           IF (xmoy == pi_d) fxm = -1.
135           xxpr(i) = beta + (grossismx - beta) * fxm
136        END DO
137    
138        xxpr(:nmax) = xxpr(2 * nmax:nmax + 1:- 1)
139    
140        Xf(0) = - pi_d
141    
142        DO i=1, 2 * nmax - 1
143           Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))
144        END DO
145    
146        Xf(2 * nmax) = pi_d
147    
148        IF (grossismx == 1.) THEN
149           decalx = 1d0
150        else
151           decalx = 0.75d0
152        END IF
153    
154        xzoom = clon * pi_d / 180d0
155        call fxhyp_loop_ik(1, decalx, xf, xtild, Xprimt, xzoom, rlonm025(:iim), &
156             xprimm025(:iim), xuv = - 0.25d0)
157        call fxhyp_loop_ik(2, decalx, xf, xtild, Xprimt, xzoom, rlonv(:iim), &
158             xprimv(:iim), xuv = 0d0)
159        call fxhyp_loop_ik(3, decalx, xf, xtild, Xprimt, xzoom, rlonu(:iim), &
160             xprimu(:iim), xuv = 0.5d0)
161        call fxhyp_loop_ik(4, decalx, xf, xtild, Xprimt, xzoom, rlonp025(:iim), &
162             xprimp025(:iim), xuv = 0.25d0)
163    
164        is2 = 0
165    
166        IF (MINval(rlonm025(:iim)) < - pi - 0.1 &
167             .or. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
168           IF (clon <= 0.) THEN
169              is2 = 1
170    
171              do while (rlonm025(is2) < - pi .and. is2 < iim)
172                 is2 = is2 + 1
173              end do
174    
175              if (rlonm025(is2) < - pi) then
176                 print *, 'Rlonm025 plus petit que - pi !'
177                 STOP 1
178              end if
179           ELSE
180              is2 = iim
181    
182              do while (rlonm025(is2) > pi .and. is2 > 1)
183                 is2 = is2 - 1
184              end do
185    
186              if (rlonm025(is2) > pi) then
187                 print *, 'Rlonm025 plus grand que pi !'
188                 STOP 1
189              end if
190           END IF
191        END IF
192    
193        call principal_cshift(is2, rlonm025, xprimm025)
194        call principal_cshift(is2, rlonv, xprimv)
195        call principal_cshift(is2, rlonu, xprimu)
196        call principal_cshift(is2, rlonp025, xprimp025)
197    
198        forall (i = 1: iim) d_rlonv(i) = rlonv(i + 1) - rlonv(i)
199        print *, "Minimum longitude step:", MINval(d_rlonv) * 180. / pi, "degrees"
200        print *, "Maximum longitude step:", MAXval(d_rlonv) * 180. / pi, "degrees"
201    
202        DO i = 1, iim + 1
203           IF (rlonp025(i) < rlonv(i)) THEN
204              print *, 'rlonp025(', i, ') = ', rlonp025(i)
205              print *, "< rlonv(", i, ") = ", rlonv(i)
206              STOP 1
207           END IF
208    
209           IF (rlonv(i) < rlonm025(i)) THEN
210              print *, 'rlonv(', i, ') = ', rlonv(i)
211              print *, "< rlonm025(", i, ") = ", rlonm025(i)
212              STOP 1
213           END IF
214    
215           IF (rlonp025(i) > rlonu(i)) THEN
216              print *, 'rlonp025(', i, ') = ', rlonp025(i)
217              print *, "> rlonu(", i, ") = ", rlonu(i)
218              STOP 1
219           END IF
220        END DO
221    
222         IF ( xmoy.EQ. 0. )  fxm =  1.    END SUBROUTINE fxhyp
        IF ( xmoy.EQ. pi )  fxm = -1.  
        xxpr(i)    = beta + ( grossism - beta ) * fxm  
   
        ENDDO  
   
        DO i = nmax+1, nmax2  
         xxpr(nmax2-i+1) = xxpr(i)  
        ENDDO  
   
         DO i=1,nmax2  
          Xf(i)   = Xf(i-1) + xxpr(i) * ( xtild(i) - xtild(i-1) )  
         ENDDO  
   
   
 c    *****************************************************************  
 c  
   
 c     .....  xuv = 0.   si  calcul  aux pts   scalaires   ........  
 c     .....  xuv = 0.5  si  calcul  aux pts      U        ........  
 c  
       WRITE(6,18)  
 c  
       DO 5000  ik = 1, 4  
   
        IF( ik.EQ.1 )        THEN  
          xuv =  -0.25  
        ELSE IF ( ik.EQ.2 )  THEN  
          xuv =   0.  
        ELSE IF ( ik.EQ.3 )  THEN  
          xuv =   0.50  
        ELSE IF ( ik.EQ.4 )  THEN  
          xuv =   0.25  
        ENDIF  
   
       xo1   = 0.  
   
       ii1=1  
       ii2=iim  
       IF(ik.EQ.1.and.grossism.EQ.1.) THEN  
         ii1 = 2  
         ii2 = iim+1  
       ENDIF  
       DO 1500 i = ii1, ii2  
   
       xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim)  
   
       Xfi    = xlon2  
 c  
       DO 250 it =  nmax2,0,-1  
       IF( Xfi.GE.Xf(it))  GO TO 350  
 250   CONTINUE  
   
       it = 0  
   
 350   CONTINUE  
   
 c    ......  Calcul de   Xf(xi)    ......  
 c  
       xi  = xtild(it)  
   
       IF(it.EQ.nmax2)  THEN  
        it       = nmax2 -1  
        Xf(it+1) = pi  
       ENDIF  
 c  .....................................................................  
 c  
 c   Appel de la routine qui calcule les coefficients a0,a1,a2,a3 d'un  
 c   polynome de degre 3  qui passe  par les points (Xf(it),xtild(it) )  
 c          et (Xf(it+1),xtild(it+1) )  
   
        CALL coefpoly ( Xf(it),Xf(it+1),Xprimt(it),Xprimt(it+1),  
      ,                xtild(it),xtild(it+1),  a0, a1, a2, a3  )  
   
        Xf1     = Xf(it)  
        Xprimin = a1 + 2.* a2 * xi + 3.*a3 * xi *xi  
   
        DO 500 iter = 1,300  
         xi = xi - ( Xf1 - Xfi )/ Xprimin  
   
         IF( ABS(xi-xo1).LE.epsilon)  GO TO 550  
          xo1      = xi  
          xi2      = xi * xi  
          Xf1      = a0 +  a1 * xi +     a2 * xi2  +     a3 * xi2 * xi  
          Xprimin  =       a1      + 2.* a2 *  xi  + 3.* a3 * xi2  
 500   CONTINUE  
         WRITE(6,*) ' Pas de solution ***** ',i,xlon2,iter  
           STOP 6  
 550   CONTINUE  
   
        xxprim(i) = depi/ ( FLOAT(iim) * Xprimin )  
        xvrai(i)  =  xi + xzoom  
   
 1500   CONTINUE  
   
   
        IF(ik.EQ.1.and.grossism.EQ.1.)  THEN  
          xvrai(1)    = xvrai(iip1)-depi  
          xxprim(1)   = xxprim(iip1)  
        ENDIF  
        DO i = 1 , iim  
         xlon(i)     = xvrai(i)  
         xprimm(i)   = xxprim(i)  
        ENDDO  
        DO i = 1, iim -1  
         IF( xvrai(i+1). LT. xvrai(i) )  THEN  
          WRITE(6,*) ' PBS. avec rlonu(',i+1,') plus petit que rlonu(',i,  
      ,  ')'  
         STOP 7  
         ENDIF  
        ENDDO  
 c  
 c   ... Reorganisation  des  longitudes  pour les avoir  entre - pi et pi ..  
 c   ........................................................................  
   
        champmin =  1.e12  
        champmax = -1.e12  
        DO i = 1, iim  
         champmin = MIN( champmin,xvrai(i) )  
         champmax = MAX( champmax,xvrai(i) )  
        ENDDO  
   
       IF(champmin .GE.-pi-0.10.and.champmax.LE.pi+0.10 )  THEN  
                 GO TO 1600  
       ELSE  
        WRITE(6,*) 'Reorganisation des longitudes pour avoir entre - pi',  
      ,  ' et pi '  
 c  
         IF( xzoom.LE.0.)  THEN  
           IF( ik.EQ. 1 )  THEN  
           DO i = 1, iim  
            IF( xvrai(i).GE. - pi )  GO TO 80  
           ENDDO  
             WRITE(6,*)  ' PBS. 1 !  Xvrai plus petit que  - pi ! '  
             STOP 8  
  80       CONTINUE  
           is2 = i  
           ENDIF  
   
           IF( is2.NE. 1 )  THEN  
             DO ii = is2 , iim  
              xlon  (ii-is2+1) = xvrai(ii)  
              xprimm(ii-is2+1) = xxprim(ii)  
             ENDDO  
             DO ii = 1 , is2 -1  
              xlon  (ii+iim-is2+1) = xvrai(ii) + depi  
              xprimm(ii+iim-is2+1) = xxprim(ii)  
             ENDDO  
           ENDIF  
         ELSE  
           IF( ik.EQ.1 )  THEN  
            DO i = iim,1,-1  
              IF( xvrai(i).LE. pi ) GO TO 90  
            ENDDO  
              WRITE(6,*) ' PBS.  2 ! Xvrai plus grand  que   pi ! '  
               STOP 9  
  90        CONTINUE  
             is2 = i  
           ENDIF  
            idif = iim -is2  
            DO ii = 1, is2  
             xlon  (ii+idif) = xvrai(ii)  
             xprimm(ii+idif) = xxprim(ii)  
            ENDDO  
            DO ii = 1, idif  
             xlon (ii)  = xvrai (ii+is2) - depi  
             xprimm(ii) = xxprim(ii+is2)  
            ENDDO  
          ENDIF  
       ENDIF  
 c  
 c     .........   Fin  de la reorganisation   ............................  
   
  1600    CONTINUE  
   
   
          xlon  ( iip1)  = xlon(1) + depi  
          xprimm( iip1 ) = xprimm (1 )  
         
          DO i = 1, iim+1  
          xvrai(i) = xlon(i)*180./pi  
          ENDDO  
   
          IF( ik.EQ.1 )  THEN  
 c          WRITE(6,*)  ' XLON aux pts. V-0.25   apres ( en  deg. ) '  
 c          WRITE(6,18)  
 c          WRITE(6,68) xvrai  
 c          WRITE(6,*) ' XPRIM k ',ik  
 c          WRITE(6,566)  xprimm  
   
            DO i = 1,iim +1  
              rlonm025(i) = xlon( i )  
             xprimm025(i) = xprimm(i)  
            ENDDO  
          ELSE IF( ik.EQ.2 )  THEN  
 c          WRITE(6,18)  
 c          WRITE(6,*)  ' XLON aux pts. V   apres ( en  deg. ) '  
 c          WRITE(6,68) xvrai  
 c          WRITE(6,*) ' XPRIM k ',ik  
 c          WRITE(6,566)  xprimm  
   
            DO i = 1,iim + 1  
              rlonv(i) = xlon( i )  
             xprimv(i) = xprimm(i)  
            ENDDO  
   
          ELSE IF( ik.EQ.3)   THEN  
 c          WRITE(6,18)  
 c          WRITE(6,*)  ' XLON aux pts. U   apres ( en  deg. ) '  
 c          WRITE(6,68) xvrai  
 c          WRITE(6,*) ' XPRIM ik ',ik  
 c          WRITE(6,566)  xprimm  
   
            DO i = 1,iim + 1  
              rlonu(i) = xlon( i )  
             xprimu(i) = xprimm(i)  
            ENDDO  
   
          ELSE IF( ik.EQ.4 )  THEN  
 c          WRITE(6,18)  
 c          WRITE(6,*)  ' XLON aux pts. V+0.25   apres ( en  deg. ) '  
 c          WRITE(6,68) xvrai  
 c          WRITE(6,*) ' XPRIM ik ',ik  
 c          WRITE(6,566)  xprimm  
   
            DO i = 1,iim + 1  
              rlonp025(i) = xlon( i )  
             xprimp025(i) = xprimm(i)  
            ENDDO  
   
          ENDIF  
   
 5000    CONTINUE  
 c  
        WRITE(6,18)  
 c  
 c    ...........  fin  de la boucle  do 5000      ............  
   
         DO i = 1, iim  
          xlon(i) = rlonv(i+1) - rlonv(i)  
         ENDDO  
         champmin =  1.e12  
         champmax = -1.e12  
         DO i = 1, iim  
          champmin = MIN( champmin, xlon(i) )  
          champmax = MAX( champmax, xlon(i) )  
         ENDDO  
          champmin = champmin * 180./pi  
          champmax = champmax * 180./pi  
   
 18     FORMAT(/)  
 24     FORMAT(2x,'Parametres xzoom,gross,tau ,dzoom pour fxhyp ',4f8.3)  
 68     FORMAT(1x,7f9.2)  
 566    FORMAT(1x,7f9.4)  
223    
224         RETURN  end module fxhyp_m
        END  
Legend:
Removed from v.76  
changed lines
  Added in v.124
  ViewVC Help
Powered by ViewVC 1.1.21