trunk/dyn3d/fxhyp.f

module fxhyp_m

  IMPLICIT NONE

contains

  SUBROUTINE fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)

    ! From LMDZ4/libf/dyn3d/fxhyp.F, version 1.2, 2005/06/03 09:11:32
    ! Author: P. Le Van, from formulas by R. Sadourny

    ! Calcule les longitudes et dérivées dans la grille du GCM pour
    ! une fonction f(x) à dérivée tangente hyperbolique.

    ! On doit avoir grossismx \times dzoomx < pi (radians)

    ! Le premier point scalaire pour une grille regulière (grossismx =
    ! 1., taux=0., clon=0.) est à - 180 degrés.

    use coefpoly_m, only: coefpoly
    USE dimens_m, ONLY: iim
    use nr_util, only: pi_d, twopi_d, arth
    use serre, only: clon, grossismx, dzoomx, taux

    REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
    real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)

    ! Local:

    DOUBLE PRECISION champmin, champmax
    real rlonm025(iim + 1), rlonp025(iim + 1)
    INTEGER, PARAMETER:: nmax = 30000, nmax2 = 2 * nmax
    REAL dzoom
    DOUBLE PRECISION xlon(iim + 1), xprimm(iim + 1), xuv
    DOUBLE PRECISION xtild(0:nmax2)
    DOUBLE PRECISION fhyp(nmax:nmax2), ffdx, beta, Xprimt(0:nmax2)
    DOUBLE PRECISION Xf(0:nmax2), xxpr(nmax2)
    DOUBLE PRECISION xvrai(iim + 1), xxprim(iim + 1) 
    DOUBLE PRECISION my_eps, 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, fxm, Xprimin
    DOUBLE PRECISION decalx
    INTEGER is2

    !----------------------------------------------------------------------

    print *, "Call sequence information: fxhyp"

    my_eps = 1e-3
    xzoom = clon * pi_d / 180. 

    IF (grossismx == 1.) THEN
       decalx = 1.
    else
       decalx = 0.75
    END IF

    IF (dzoomx < 1.) THEN
       dzoom = dzoomx * twopi_d
    ELSE IF (dzoomx < 25.) THEN
       print *, "dzoomx pour fxhyp est trop petit."
       STOP 1
    ELSE
       dzoom = dzoomx * pi_d / 180.
    END IF

    print *, 'dzoom (rad):', dzoom

    xtild = arth(- pi_d, twopi_d / nmax2, nmax2 + 1)

    DO i = nmax, nmax2
       fa = taux * (dzoom / 2. - xtild(i))
       fb = xtild(i) * (pi_d - xtild(i))

       IF (200. * fb < - fa) THEN
          fhyp(i) = - 1.
       ELSE IF (200. * fb < fa) THEN
          fhyp(i) = 1.
       ELSE
          IF (ABS(fa) < 1e-13.AND.ABS(fb) < 1e-13) THEN
             IF (200. * fb + fa < 1e-10) THEN
                fhyp(i) = - 1.
             ELSE IF (200. * fb - fa < 1e-10) THEN
                fhyp(i) = 1.
             END IF
          ELSE
             fhyp(i) = TANH(fa / fb)
          END IF
       END IF

       IF (xtild(i) == 0.) fhyp(i) = 1.
       IF (xtild(i) == pi_d) fhyp(i) = -1.
    END DO

    ! Calcul de beta 

    ffdx = 0.

    DO i = nmax + 1, nmax2
       xmoy = 0.5 * (xtild(i-1) + xtild(i))
       fa = taux * (dzoom / 2. - xmoy)
       fb = xmoy * (pi_d - xmoy)

       IF (200. * fb < - fa) THEN
          fxm = - 1.
       ELSE IF (200. * fb < fa) THEN
          fxm = 1.
       ELSE
          IF (ABS(fa) < 1e-13.AND.ABS(fb) < 1e-13) THEN
             IF (200. * fb + fa < 1e-10) THEN
                fxm = - 1.
             ELSE IF (200. * fb - fa < 1e-10) THEN
                fxm = 1.
             END IF
          ELSE
             fxm = TANH(fa / fb)
          END IF
       END IF

       IF (xmoy == 0.) fxm = 1.
       IF (xmoy == pi_d) fxm = -1.

       ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
    END DO

    beta = (grossismx * ffdx - pi_d) / (ffdx - pi_d)

    IF (2. * beta - grossismx <= 0.) THEN
       print *, 'Attention ! La valeur beta calculée dans fxhyp est mauvaise.'
       print *, 'Modifier les valeurs de grossismx, taux ou dzoomx et relancer.'
       STOP 1
    END IF

    ! calcul de Xprimt 

    DO i = nmax, nmax2
       Xprimt(i) = beta + (grossismx - beta) * fhyp(i)
    END DO

    DO i = nmax + 1, nmax2
       Xprimt(nmax2 - i) = Xprimt(i)
    END DO

    ! Calcul de Xf 

    Xf(0) = - pi_d

    DO i = nmax + 1, nmax2
       xmoy = 0.5 * (xtild(i-1) + xtild(i))
       fa = taux * (dzoom / 2. - xmoy)
       fb = xmoy * (pi_d - xmoy)

       IF (200. * fb < - fa) THEN
          fxm = - 1.
       ELSE IF (200. * fb < fa) THEN
          fxm = 1.
       ELSE
          fxm = TANH(fa / fb)
       END IF

       IF (xmoy == 0.) fxm = 1.
       IF (xmoy == pi_d) fxm = -1.
       xxpr(i) = beta + (grossismx - beta) * fxm
    END DO

    xxpr(:nmax) = xxpr(nmax2:nmax + 1:- 1)

    DO i=1, nmax2
       Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))
    END DO

    is2 = 0

    loop_ik: DO ik = 1, 4
       ! xuv = 0. si calcul aux points scalaires 
       ! xuv = 0.5 si calcul aux points U 

       IF (ik == 1) THEN
          xuv = -0.25
       ELSE IF (ik == 2) THEN
          xuv = 0.
       ELSE IF (ik == 3) THEN
          xuv = 0.50
       ELSE IF (ik == 4) THEN
          xuv = 0.25
       END IF

       xo1 = 0.

       IF (ik == 1 .and. grossismx == 1.) THEN
          ii1 = 2 
          ii2 = iim + 1
       else
          ii1=1
          ii2=iim
       END IF

       DO i = ii1, ii2
          Xfi = - pi_d + (REAL(i) + xuv - decalx) * twopi_d / REAL(iim)

          it = nmax2
          do while (xfi < xf(it) .and. it >= 1)
             it = it - 1
          end do

          ! Calcul de Xf(xi) 

          xi = xtild(it)

          IF (it == nmax2) THEN
             it = nmax2 -1
             Xf(it + 1) = pi_d
          END IF

          ! Appel de la routine qui calcule les coefficients a0, a1,
          ! a2, a3 d'un polynome de degre 3 qui passe par les points
          ! (Xf(it), xtild(it)) 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

          iter = 1

          do
             xi = xi - (Xf1 - Xfi) / Xprimin
             IF (ABS(xi - xo1) <= my_eps .or. iter == 300) exit
             xo1 = xi
             xi2 = xi * xi
             Xf1 = a0 + a1 * xi + a2 * xi2 + a3 * xi2 * xi
             Xprimin = a1 + 2. * a2 * xi + 3. * a3 * xi2
          end DO

          if (ABS(xi - xo1) > my_eps) then
             ! iter == 300
             print *, 'Pas de solution.'
             print *, i, xfi
             STOP 1
          end if

          xxprim(i) = twopi_d / (REAL(iim) * Xprimin)
          xvrai(i) = xi + xzoom
       end DO

       IF (ik == 1 .and. grossismx == 1.) THEN
          xvrai(1) = xvrai(iim + 1)-twopi_d
          xxprim(1) = xxprim(iim + 1)
       END IF

       DO i = 1, iim
          xlon(i) = xvrai(i)
          xprimm(i) = xxprim(i)
       END DO

       DO i = 1, iim -1
          IF (xvrai(i + 1) < xvrai(i)) THEN
             print *, 'rlonu(', i + 1, ') < rlonu(', i, ')'
             STOP 1
          END IF
       END DO

       IF (.not. (MINval(xvrai(:iim)) >= - pi_d - 0.1 &
            .and. MAXval(xvrai(:iim)) <= pi_d + 0.1)) THEN
          print *, &
               'Réorganisation des longitudes pour les avoir entre - pi et pi'

          IF (xzoom <= 0.) THEN
             IF (ik == 1) THEN
                i = 1

                do while (xvrai(i) < - pi_d .and. i < iim)
                   i = i + 1
                end do

                if (xvrai(i) < - pi_d) then
                   print *, 'Xvrai plus petit que - pi !'
                   STOP 1
                end if

                is2 = i
             END IF

             IF (is2 /= 1) THEN
                DO ii = is2, iim
                   xlon(ii-is2 + 1) = xvrai(ii)
                   xprimm(ii-is2 + 1) = xxprim(ii)
                END DO
                DO ii = 1, is2 -1
                   xlon(ii + iim-is2 + 1) = xvrai(ii) + twopi_d
                   xprimm(ii + iim-is2 + 1) = xxprim(ii) 
                END DO
             END IF
          ELSE 
             IF (ik == 1) THEN
                i = iim

                do while (xvrai(i) > pi_d .and. i > 1)
                   i = i - 1
                end do

                if (xvrai(i) > pi_d) then
                   print *, 'Xvrai plus grand que pi !'
                   STOP 1
                end if

                is2 = i
             END IF

             idif = iim -is2

             DO ii = 1, is2
                xlon(ii + idif) = xvrai(ii)
                xprimm(ii + idif) = xxprim(ii)
             END DO

             DO ii = 1, idif
                xlon(ii) = xvrai(ii + is2) - twopi_d
                xprimm(ii) = xxprim(ii + is2) 
             END DO
          END IF
       END IF

       xlon(iim + 1) = xlon(1) + twopi_d
       xprimm(iim + 1) = xprimm(1)

       DO i = 1, iim + 1
          xvrai(i) = xlon(i) * 180. / pi_d
       END DO

       IF (ik == 1) THEN
          DO i = 1, iim + 1
             rlonm025(i) = xlon(i)
             xprimm025(i) = xprimm(i)
          END DO
       ELSE IF (ik == 2) THEN
          rlonv = xlon
          xprimv = xprimm
       ELSE IF (ik == 3) THEN
          DO i = 1, iim + 1
             rlonu(i) = xlon(i)
             xprimu(i) = xprimm(i)
          END DO
       ELSE IF (ik == 4) THEN
          rlonp025 = xlon
          xprimp025 = xprimm
       END IF
    end DO loop_ik

    print *

    DO i = 1, iim
       xlon(i) = rlonv(i + 1) - rlonv(i)
    END DO
    champmin = 1e12
    champmax = -1e12
    DO i = 1, iim
       champmin = MIN(champmin, xlon(i))
       champmax = MAX(champmax, xlon(i))
    END DO
    champmin = champmin * 180. / pi_d
    champmax = champmax * 180. / pi_d

    DO i = 1, iim + 1
       IF (rlonp025(i) < rlonv(i)) THEN
          print *, ' Attention ! rlonp025 < rlonv', i
          STOP 1
       END IF

       IF (rlonv(i) < rlonm025(i)) THEN 
          print *, ' Attention ! rlonm025 > rlonv', i
          STOP 1
       END IF

       IF (rlonp025(i) > rlonu(i)) THEN
          print *, 'rlonp025(', i, ') = ', rlonp025(i)
          print *, "> rlonu(", i, ") = ", rlonu(i)
          STOP 1
       END IF
    END DO

    print *, ' Longitudes '
    print 3, champmin, champmax

3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
         ' d environ ', f0.2, ' degres ', /, &
         ' alors que la maille en dehors de la zone du zoom est ', &
         "d'environ ", f0.2, ' degres ')

  END SUBROUTINE fxhyp

end module fxhyp_m
1	guez	78	module fxhyp_m
2	guez	3
3	guez	78	IMPLICIT NONE
4	guez	3
5	guez	78	contains
6	guez	3
7	guez	119	SUBROUTINE fxhyp(xprimm025, rlonv, xprimv, rlonu, xprimu, xprimp025)
8	guez	3
9	guez	91	! From LMDZ4/libf/dyn3d/fxhyp.F, version 1.2, 2005/06/03 09:11:32
10	guez	119	! Author: P. Le Van, from formulas by R. Sadourny
11	guez	3
12	guez	78	! Calcule les longitudes et dérivées dans la grille du GCM pour
13	guez	119	! une fonction f(x) à dérivée tangente hyperbolique.
14	guez	3
15	guez	119	! On doit avoir grossismx \times dzoomx < pi (radians)
16	guez	3
17	guez	120	! Le premier point scalaire pour une grille regulière (grossismx =
18			! 1., taux=0., clon=0.) est à - 180 degrés.
19
20			use coefpoly_m, only: coefpoly
21	guez	78	USE dimens_m, ONLY: iim
22	guez	120	use nr_util, only: pi_d, twopi_d, arth
23	guez	119	use serre, only: clon, grossismx, dzoomx, taux
24	guez	3
25	guez	119	REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
26			real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
27	guez	3
28	guez	91	! Local:
29	guez	3
30	guez	119	DOUBLE PRECISION champmin, champmax
31			real rlonm025(iim + 1), rlonp025(iim + 1)
32	guez	120	INTEGER, PARAMETER:: nmax = 30000, nmax2 = 2 * nmax
33	guez	78	REAL dzoom
34	guez	119	DOUBLE PRECISION xlon(iim + 1), xprimm(iim + 1), xuv
35	guez	78	DOUBLE PRECISION xtild(0:nmax2)
36	guez	120	DOUBLE PRECISION fhyp(nmax:nmax2), ffdx, beta, Xprimt(0:nmax2)
37			DOUBLE PRECISION Xf(0:nmax2), xxpr(nmax2)
38	guez	119	DOUBLE PRECISION xvrai(iim + 1), xxprim(iim + 1)
39			DOUBLE PRECISION my_eps, xzoom, fa, fb
40	guez	78	DOUBLE PRECISION Xf1, Xfi, a0, a1, a2, a3, xi2
41			INTEGER i, it, ik, iter, ii, idif, ii1, ii2
42	guez	120	DOUBLE PRECISION xi, xo1, xmoy, fxm, Xprimin
43	guez	91	DOUBLE PRECISION decalx
44	guez	120	INTEGER is2
45	guez	3
46	guez	91	!----------------------------------------------------------------------
47
48	guez	120	print *, "Call sequence information: fxhyp"
49
50	guez	119	my_eps = 1e-3
51			xzoom = clon * pi_d / 180.
52	guez	3
53	guez	120	IF (grossismx == 1.) THEN
54	guez	78	decalx = 1.
55	guez	119	else
56			decalx = 0.75
57			END IF
58	guez	3
59	guez	119	IF (dzoomx < 1.) THEN
60			dzoom = dzoomx * twopi_d
61			ELSE IF (dzoomx < 25.) THEN
62	guez	120	print *, "dzoomx pour fxhyp est trop petit."
63	guez	78	STOP 1
64			ELSE
65	guez	119	dzoom = dzoomx * pi_d / 180.
66	guez	112	END IF
67	guez	3
68	guez	119	print *, 'dzoom (rad):', dzoom
69	guez	3
70	guez	120	xtild = arth(- pi_d, twopi_d / nmax2, nmax2 + 1)
71	guez	78
72			DO i = nmax, nmax2
73	guez	120	fa = taux * (dzoom / 2. - xtild(i))
74	guez	119	fb = xtild(i) * (pi_d - xtild(i))
75	guez	78
76	guez	120	IF (200. * fb < - fa) THEN
77	guez	119	fhyp(i) = - 1.
78			ELSE IF (200. * fb < fa) THEN
79			fhyp(i) = 1.
80	guez	3	ELSE
81	guez	119	IF (ABS(fa) < 1e-13.AND.ABS(fb) < 1e-13) THEN
82	guez	120	IF (200. * fb + fa < 1e-10) THEN
83	guez	119	fhyp(i) = - 1.
84	guez	120	ELSE IF (200. * fb - fa < 1e-10) THEN
85	guez	119	fhyp(i) = 1.
86			END IF
87	guez	78	ELSE
88	guez	119	fhyp(i) = TANH(fa / fb)
89			END IF
90	guez	112	END IF
91	guez	3
92	guez	91	IF (xtild(i) == 0.) fhyp(i) = 1.
93	guez	119	IF (xtild(i) == pi_d) fhyp(i) = -1.
94	guez	112	END DO
95	guez	3
96	guez	91	! Calcul de beta
97	guez	3
98	guez	78	ffdx = 0.
99	guez	3
100	guez	91	DO i = nmax + 1, nmax2
101	guez	78	xmoy = 0.5 * (xtild(i-1) + xtild(i))
102	guez	120	fa = taux * (dzoom / 2. - xmoy)
103	guez	119	fb = xmoy * (pi_d - xmoy)
104	guez	78
105	guez	120	IF (200. * fb < - fa) THEN
106	guez	78	fxm = - 1.
107	guez	119	ELSE IF (200. * fb < fa) THEN
108	guez	78	fxm = 1.
109			ELSE
110	guez	119	IF (ABS(fa) < 1e-13.AND.ABS(fb) < 1e-13) THEN
111	guez	120	IF (200. * fb + fa < 1e-10) THEN
112	guez	78	fxm = - 1.
113	guez	120	ELSE IF (200. * fb - fa < 1e-10) THEN
114	guez	78	fxm = 1.
115	guez	119	END IF
116	guez	78	ELSE
117	guez	119	fxm = TANH(fa / fb)
118			END IF
119			END IF
120	guez	3
121	guez	91	IF (xmoy == 0.) fxm = 1.
122	guez	119	IF (xmoy == pi_d) fxm = -1.
123	guez	3
124	guez	78	ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
125	guez	119	END DO
126	guez	3
127	guez	119	beta = (grossismx * ffdx - pi_d) / (ffdx - pi_d)
128	guez	3
129	guez	119	IF (2. * beta - grossismx <= 0.) THEN
130	guez	91	print *, 'Attention ! La valeur beta calculée dans fxhyp est mauvaise.'
131	guez	119	print *, 'Modifier les valeurs de grossismx, taux ou dzoomx et relancer.'
132	guez	78	STOP 1
133	guez	112	END IF
134	guez	78
135	guez	91	! calcul de Xprimt
136	guez	78
137			DO i = nmax, nmax2
138	guez	119	Xprimt(i) = beta + (grossismx - beta) * fhyp(i)
139	guez	112	END DO
140	guez	78
141	guez	91	DO i = nmax + 1, nmax2
142	guez	78	Xprimt(nmax2 - i) = Xprimt(i)
143	guez	112	END DO
144	guez	78
145	guez	91	! Calcul de Xf
146	guez	78
147	guez	119	Xf(0) = - pi_d
148	guez	78
149	guez	91	DO i = nmax + 1, nmax2
150	guez	78	xmoy = 0.5 * (xtild(i-1) + xtild(i))
151	guez	120	fa = taux * (dzoom / 2. - xmoy)
152	guez	119	fb = xmoy * (pi_d - xmoy)
153	guez	78
154	guez	120	IF (200. * fb < - fa) THEN
155	guez	78	fxm = - 1.
156	guez	119	ELSE IF (200. * fb < fa) THEN
157	guez	78	fxm = 1.
158	guez	3	ELSE
159	guez	119	fxm = TANH(fa / fb)
160			END IF
161	guez	3
162	guez	91	IF (xmoy == 0.) fxm = 1.
163	guez	119	IF (xmoy == pi_d) fxm = -1.
164			xxpr(i) = beta + (grossismx - beta) * fxm
165			END DO
166	guez	3
167	guez	120	xxpr(:nmax) = xxpr(nmax2:nmax + 1:- 1)
168	guez	3
169	guez	78	DO i=1, nmax2
170			Xf(i) = Xf(i-1) + xxpr(i) * (xtild(i) - xtild(i-1))
171	guez	119	END DO
172	guez	3
173	guez	120	is2 = 0
174	guez	3
175	guez	119	loop_ik: DO ik = 1, 4
176	guez	120	! xuv = 0. si calcul aux points scalaires
177			! xuv = 0.5 si calcul aux points U
178
179	guez	91	IF (ik == 1) THEN
180	guez	78	xuv = -0.25
181	guez	91	ELSE IF (ik == 2) THEN
182	guez	78	xuv = 0.
183	guez	91	ELSE IF (ik == 3) THEN
184	guez	78	xuv = 0.50
185	guez	91	ELSE IF (ik == 4) THEN
186	guez	78	xuv = 0.25
187	guez	119	END IF
188	guez	3
189	guez	78	xo1 = 0.
190	guez	3
191	guez	120	IF (ik == 1 .and. grossismx == 1.) THEN
192	guez	78	ii1 = 2
193	guez	91	ii2 = iim + 1
194	guez	120	else
195			ii1=1
196			ii2=iim
197	guez	119	END IF
198	guez	91
199	guez	78	DO i = ii1, ii2
200	guez	120	Xfi = - pi_d + (REAL(i) + xuv - decalx) * twopi_d / REAL(iim)
201	guez	3
202	guez	91	it = nmax2
203			do while (xfi < xf(it) .and. it >= 1)
204			it = it - 1
205			end do
206	guez	3
207	guez	91	! Calcul de Xf(xi)
208	guez	3
209	guez	78	xi = xtild(it)
210	guez	3
211	guez	91	IF (it == nmax2) THEN
212	guez	78	it = nmax2 -1
213	guez	119	Xf(it + 1) = pi_d
214			END IF
215	guez	3
216	guez	91	! Appel de la routine qui calcule les coefficients a0, a1,
217			! a2, a3 d'un polynome de degre 3 qui passe par les points
218			! (Xf(it), xtild(it)) et (Xf(it + 1), xtild(it + 1))
219	guez	3
220	guez	91	CALL coefpoly(Xf(it), Xf(it + 1), Xprimt(it), Xprimt(it + 1), &
221			xtild(it), xtild(it + 1), a0, a1, a2, a3)
222	guez	78
223			Xf1 = Xf(it)
224	guez	120	Xprimin = a1 + 2. * a2 * xi + 3. * a3 * xi * xi
225	guez	78
226	guez	91	iter = 1
227
228			do
229	guez	119	xi = xi - (Xf1 - Xfi) / Xprimin
230			IF (ABS(xi - xo1) <= my_eps .or. iter == 300) exit
231	guez	78	xo1 = xi
232			xi2 = xi * xi
233			Xf1 = a0 + a1 * xi + a2 * xi2 + a3 * xi2 * xi
234	guez	120	Xprimin = a1 + 2. * a2 * xi + 3. * a3 * xi2
235	guez	78	end DO
236	guez	3
237	guez	119	if (ABS(xi - xo1) > my_eps) then
238	guez	91	! iter == 300
239			print *, 'Pas de solution.'
240	guez	120	print *, i, xfi
241	guez	91	STOP 1
242			end if
243
244	guez	119	xxprim(i) = twopi_d / (REAL(iim) * Xprimin)
245	guez	78	xvrai(i) = xi + xzoom
246			end DO
247	guez	3
248	guez	119	IF (ik == 1 .and. grossismx == 1.) THEN
249			xvrai(1) = xvrai(iim + 1)-twopi_d
250			xxprim(1) = xxprim(iim + 1)
251			END IF
252
253	guez	78	DO i = 1, iim
254			xlon(i) = xvrai(i)
255			xprimm(i) = xxprim(i)
256	guez	119	END DO
257
258	guez	3	DO i = 1, iim -1
259	guez	119	IF (xvrai(i + 1) < xvrai(i)) THEN
260	guez	120	print *, 'rlonu(', i + 1, ') < rlonu(', i, ')'
261	guez	91	STOP 1
262	guez	119	END IF
263			END DO
264	guez	3
265	guez	120	IF (.not. (MINval(xvrai(:iim)) >= - pi_d - 0.1 &
266			.and. MAXval(xvrai(:iim)) <= pi_d + 0.1)) THEN
267			print *, &
268			'Réorganisation des longitudes pour les avoir entre - pi et pi'
269	guez	78
270	guez	91	IF (xzoom <= 0.) THEN
271			IF (ik == 1) THEN
272			i = 1
273
274	guez	119	do while (xvrai(i) < - pi_d .and. i < iim)
275	guez	91	i = i + 1
276			end do
277
278	guez	119	if (xvrai(i) < - pi_d) then
279			print *, 'Xvrai plus petit que - pi !'
280	guez	91	STOP 1
281			end if
282
283	guez	78	is2 = i
284	guez	119	END IF
285	guez	78
286	guez	120	IF (is2 /= 1) THEN
287	guez	78	DO ii = is2, iim
288	guez	119	xlon(ii-is2 + 1) = xvrai(ii)
289	guez	91	xprimm(ii-is2 + 1) = xxprim(ii)
290	guez	119	END DO
291	guez	78	DO ii = 1, is2 -1
292	guez	119	xlon(ii + iim-is2 + 1) = xvrai(ii) + twopi_d
293	guez	91	xprimm(ii + iim-is2 + 1) = xxprim(ii)
294	guez	119	END DO
295			END IF
296	guez	78	ELSE
297	guez	91	IF (ik == 1) THEN
298			i = iim
299
300	guez	119	do while (xvrai(i) > pi_d .and. i > 1)
301	guez	91	i = i - 1
302			end do
303
304	guez	119	if (xvrai(i) > pi_d) then
305			print *, 'Xvrai plus grand que pi !'
306	guez	91	STOP 1
307			end if
308
309	guez	78	is2 = i
310	guez	119	END IF
311
312	guez	78	idif = iim -is2
313	guez	119
314	guez	78	DO ii = 1, is2
315	guez	119	xlon(ii + idif) = xvrai(ii)
316	guez	91	xprimm(ii + idif) = xxprim(ii)
317	guez	119	END DO
318
319	guez	78	DO ii = 1, idif
320	guez	119	xlon(ii) = xvrai(ii + is2) - twopi_d
321	guez	91	xprimm(ii) = xxprim(ii + is2)
322	guez	119	END DO
323			END IF
324			END IF
325	guez	3
326	guez	119	xlon(iim + 1) = xlon(1) + twopi_d
327			xprimm(iim + 1) = xprimm(1)
328	guez	3
329	guez	91	DO i = 1, iim + 1
330	guez	120	xvrai(i) = xlon(i) * 180. / pi_d
331	guez	119	END DO
332	guez	3
333	guez	91	IF (ik == 1) THEN
334			DO i = 1, iim + 1
335	guez	78	rlonm025(i) = xlon(i)
336			xprimm025(i) = xprimm(i)
337	guez	119	END DO
338	guez	91	ELSE IF (ik == 2) THEN
339	guez	119	rlonv = xlon
340			xprimv = xprimm
341	guez	91	ELSE IF (ik == 3) THEN
342	guez	78	DO i = 1, iim + 1
343			rlonu(i) = xlon(i)
344			xprimu(i) = xprimm(i)
345	guez	119	END DO
346	guez	91	ELSE IF (ik == 4) THEN
347	guez	120	rlonp025 = xlon
348			xprimp025 = xprimm
349	guez	119	END IF
350			end DO loop_ik
351	guez	3
352	guez	91	print *
353	guez	3
354	guez	78	DO i = 1, iim
355	guez	91	xlon(i) = rlonv(i + 1) - rlonv(i)
356	guez	119	END DO
357			champmin = 1e12
358			champmax = -1e12
359	guez	78	DO i = 1, iim
360			champmin = MIN(champmin, xlon(i))
361			champmax = MAX(champmax, xlon(i))
362	guez	119	END DO
363			champmin = champmin * 180. / pi_d
364			champmax = champmax * 180. / pi_d
365	guez	3
366	guez	119	DO i = 1, iim + 1
367			IF (rlonp025(i) < rlonv(i)) THEN
368			print *, ' Attention ! rlonp025 < rlonv', i
369			STOP 1
370			END IF
371
372			IF (rlonv(i) < rlonm025(i)) THEN
373			print *, ' Attention ! rlonm025 > rlonv', i
374			STOP 1
375			END IF
376
377			IF (rlonp025(i) > rlonu(i)) THEN
378	guez	120	print *, 'rlonp025(', i, ') = ', rlonp025(i)
379			print *, "> rlonu(", i, ") = ", rlonu(i)
380	guez	119	STOP 1
381			END IF
382			END DO
383
384			print *, ' Longitudes '
385			print 3, champmin, champmax
386
387			3 Format(1x, ' Au centre du zoom, la longueur de la maille est', &
388			' d environ ', f0.2, ' degres ', /, &
389			' alors que la maille en dehors de la zone du zoom est ', &
390	guez	120	"d'environ ", f0.2, ' degres ')
391	guez	119
392	guez	78	END SUBROUTINE fxhyp
393
394			end module fxhyp_m