5 INTEGER,
PARAMETER::
nmax = 30000
14 include
"dimensions.h"
20 REAL(K8),
intent(in):: Xf(0:), xtild(0:), Xprimt(0:)
21 real,
intent(out):: xlon(:), xprimm(:)
23 REAL(K8),
intent(in):: xuv
28 REAL(K8) xo1, Xfi, a0, a1, a2, a3, Xf1, Xprimin
30 REAL(K8),
parameter:: my_eps = 1e-6_k8
32 REAL(K8) xxprim(
iim), xvrai(
iim)
41 do while (xfi < xf(it) .and. it >= 1)
49 IF (it == 2 *
nmax)
THEN
53 CALL coefpoly(xf(it), xf(it + 1), xprimt(it), xprimt(it + 1), &
54 xtild(it), xtild(it + 1), a0, a1, a2, a3)
56 xprimin = a1 + xvrai(i) * (2._k8 * a2 + xvrai(i) * 3._k8 * a3)
61 xvrai(i) = xvrai(i) - (xf1 - xfi) / xprimin
62 IF (abs(xvrai(i) - xo1) <= my_eps .or. iter == 300)
exit
64 xf1 = a0 + xvrai(i) * (a1 + xvrai(i) * (a2 + xvrai(i) * a3))
65 xprimin = a1 + xvrai(i) * (2._k8 * a2 + xvrai(i) * 3._k8 * a3)
68 if (abs(xvrai(i) - xo1) > my_eps)
then
70 print *,
'Pas de solution.'
79 IF (xvrai(i + 1) < xvrai(i))
THEN
80 print *,
'xvrai(', i + 1,
') < xvrai(', i,
')'
85 xlon = xvrai +
clon / 180. *
pi
subroutine coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3)
!$Header!c!c!c include serre h!c REAL clon
real(k8), parameter twopi_d
!$Id mode_top_bound COMMON comconstr && pi
subroutine invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
c c zjulian c cym CALL iim cym klev iim