trunk/dyn3d/fxhyp.f

module fxhyp_m

  IMPLICIT NONE

contains

  SUBROUTINE fxhyp(xzoomdeg, grossism, dzooma, tau, rlonm025, xprimm025, &
       rlonv, xprimv, rlonu, xprimu, rlonp025, xprimp025, champmin, champmax)

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

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

    ! On doit avoir grossism \times dzoom < pi (radians), en longitude.

    USE dimens_m, ONLY: iim
    USE paramet_m, ONLY: iip1

    REAL, intent(in):: xzoomdeg

    REAL, intent(in):: grossism
    ! grossissement (= 2 si 2 fois, = 3 si 3 fois, etc.)

    REAL, intent(in):: dzooma ! distance totale de la zone du zoom

    REAL, intent(in):: tau 
    ! raideur de la transition de l'intérieur à l'extérieur du zoom

    ! arguments de sortie 

    REAL, dimension(iip1):: rlonm025, xprimm025, rlonv, xprimv
    real, dimension(iip1):: rlonu, xprimu, rlonp025, xprimp025

    DOUBLE PRECISION, intent(out):: champmin, champmax

    ! Local:

    INTEGER, PARAMETER:: nmax = 30000, nmax2 = 2*nmax

    LOGICAL, PARAMETER:: scal180 = .TRUE.
    ! scal180 = .TRUE. si on veut avoir le premier point scalaire pour
    ! une grille reguliere (grossism = 1., tau=0., clon=0.) a
    ! -180. degres. sinon scal180 = .FALSE.

    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 decalx
    INTEGER is2
    SAVE is2

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

    pi = 2. * ASIN(1.)
    depi = 2. * pi
    epsilon = 1.e-3
    xzoom = xzoomdeg * pi/180. 

    decalx = .75
    IF (grossism == 1. .AND. scal180) THEN
       decalx = 1.
    ENDIF

    print *, 'FXHYP scal180, decalx', scal180, decalx

    IF (dzooma.LT.1.) THEN
       dzoom = dzooma * depi
    ELSEIF (dzooma.LT. 25.) THEN
       print *, "Le paramètre dzoomx pour fxhyp est trop petit. " &
            // "L'augmenter et relancer."
       STOP 1
    ELSE
       dzoom = dzooma * pi/180.
    ENDIF

    print *, ' xzoom(rad), grossism, tau, dzoom (rad):'
    print *, xzoom, grossism, tau, dzoom

    DO i = 0, nmax2 
       xtild(i) = - pi + FLOAT(i) * depi /nmax2
    ENDDO

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

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

       IF (xtild(i) == 0.) fhyp(i) = 1.
       IF (xtild(i) == pi) fhyp(i) = -1.
    ENDDO

    ! 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.
       ELSE
          IF (ABS(fa).LT.1.e-13.AND.ABS(fb).LT.1.e-13) THEN
             IF (200.*fb + fa.LT.1.e-10) THEN
                fxm = - 1.
             ELSEIF (200.*fb - fa.LT.1.e-10) THEN
                fxm = 1.
             ENDIF
          ELSE
             fxm = TANH (fa/fb)
          ENDIF
       ENDIF

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

       ffdx = ffdx + fxm * (xtild(i) - xtild(i-1))
    ENDDO

    beta = (grossism * ffdx - pi) / (ffdx - pi)

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

    ! calcul de Xprimt 

    DO i = nmax, nmax2
       Xprimt(i) = beta + (grossism - beta) * fhyp(i)
    ENDDO

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

    ! 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.
       ELSE
          fxm = TANH (fa/fb)
       ENDIF

       IF (xmoy == 0.) fxm = 1.
       IF (xmoy == 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

    ! xuv = 0. si calcul aux pts scalaires 
    ! xuv = 0.5 si calcul aux pts U 

    print *

    DO ik = 1, 4
       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
       ENDIF

       xo1 = 0.

       ii1=1
       ii2=iim
       IF (ik == 1.and.grossism == 1.) THEN
          ii1 = 2 
          ii2 = iim + 1
       ENDIF

       DO i = ii1, ii2
          xlon2 = - pi + (FLOAT(i) + xuv - decalx) * depi / FLOAT(iim) 
          Xfi = xlon2

          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
          ENDIF

          ! 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) <= epsilon .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) > epsilon) then
             ! iter == 300
             print *, 'Pas de solution.'
             print *, i, xlon2
             STOP 1
          end if


          xxprim(i) = depi/ (FLOAT(iim) * Xprimin)
          xvrai(i) = xi + xzoom
       end DO

       IF (ik == 1.and.grossism == 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
             print *, 'Problème avec rlonu(', i + 1, &
                  ') plus petit que rlonu(', i, ')'
             STOP 1
          ENDIF
       ENDDO

       ! Reorganisation des longitudes pour les avoir entre - pi et pi 

       champmin = 1.e12
       champmax = -1.e12
       DO i = 1, iim
          champmin = MIN(champmin, xvrai(i))
          champmax = MAX(champmax, xvrai(i))
       ENDDO

       IF (.not. (champmin >= -pi-0.10.and.champmax <= pi + 0.10)) THEN
          print *, 'Reorganisation des longitudes pour avoir entre - pi', &
               ' et pi '

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

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

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

                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 == 1) THEN
                i = iim

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

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

                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

       ! Fin de la reorganisation 

       xlon (iip1) = xlon(1) + depi
       xprimm(iip1) = xprimm (1)

       DO i = 1, iim + 1
          xvrai(i) = xlon(i)*180./pi
       ENDDO

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

    print *

    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

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