Sources/misc/coefpoly.f

module coefpoly_m

  IMPLICIT NONE

contains

  SUBROUTINE coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3)

    ! From LMDZ4/libf/dyn3d/coefpoly.F, version 1.1.1.1 2004/05/19 12:53:05

    ! Author: P. Le Van

    ! Calcul des coefficients a0, a1, a2, a3 du polynôme de degré 3
    ! qui passe par les points (xtild1, Xf1) et (xtild2, Xf2) avec les
    ! dérivées xprim1 et xprim2. Système linéaire de 4 équations à 4
    ! inconnues :

    ! a0 + a1 * xtild1 + a2 * xtild1**2 + a3 * xtild1**3 = Xf1
    ! a0 + a1 * xtild2 + a2 * xtild2**2 + a3 * xtild2**3 = Xf2
    ! a1 + 2 * a2 * xtild1 + 3 * a3 * xtild1**2 = Xprim1
    ! a1 + 2 * a2 * xtild2 + 3 * a3 * xtild2**2 = Xprim2

    DOUBLE PRECISION, intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2
    DOUBLE PRECISION, intent(out):: a0, a1, a2, a3

    ! Local:
    DOUBLE PRECISION xtil1car, xtil2car, derr, x1x2car

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

    xtil1car = xtild1 * xtild1
    xtil2car = xtild2 * xtild2

    derr = 2d0 * (xf2-xf1)/(xtild1-xtild2)

    x1x2car = (xtild1-xtild2) * (xtild1-xtild2)

    a3 = (derr+xprim1+xprim2)/x1x2car
    a2 = (xprim1-xprim2+3d0 * a3 * (xtil2car-xtil1car))/(2d0 * (xtild1-xtild2))

    a1 = xprim1 - 3d0 * a3 * xtil1car - 2d0 * a2 * xtild1
    a0 = xf1 - a3 * xtild1 * xtil1car - a2 * xtil1car - a1 * xtild1

  END SUBROUTINE coefpoly

end module coefpoly_m
1	guez	120	module coefpoly_m
2	guez	3
3	guez	81	IMPLICIT NONE
4	guez	3
5	guez	120	contains
6	guez	3
7	guez	120	SUBROUTINE coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3)
8	guez	3
9	guez	121	! From LMDZ4/libf/dyn3d/coefpoly.F, version 1.1.1.1 2004/05/19 12:53:05
10	guez	3
11	guez	121	! Author: P. Le Van
12	guez	3
13	guez	145	! Calcul des coefficients a0, a1, a2, a3 du polynôme de degré 3
14			! qui passe par les points (xtild1, Xf1) et (xtild2, Xf2) avec les
15			! dérivées xprim1 et xprim2. Système linéaire de 4 équations à 4
16			! inconnues :
17	guez	3
18	guez	121	! a0 + a1 * xtild1 + a2 * xtild1*2 + a3 xtild1**3 = Xf1
19			! a0 + a1 * xtild2 + a2 * xtild2*2 + a3 xtild2**3 = Xf2
20	guez	145	! a1 + 2 * a2 * xtild1 + 3 * a3 * xtild1**2 = Xprim1
21			! a1 + 2 * a2 * xtild2 + 3 * a3 * xtild2**2 = Xprim2
22	guez	3
23	guez	120	DOUBLE PRECISION, intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2
24			DOUBLE PRECISION, intent(out):: a0, a1, a2, a3
25	guez	81
26	guez	120	! Local:
27			DOUBLE PRECISION xtil1car, xtil2car, derr, x1x2car
28	guez	81
29	guez	120	!------------------------------------------------------------
30	guez	81
31	guez	121	xtil1car = xtild1 * xtild1
32			xtil2car = xtild2 * xtild2
33	guez	81
34	guez	145	derr = 2d0 * (xf2-xf1)/(xtild1-xtild2)
35	guez	120
36	guez	121	x1x2car = (xtild1-xtild2) * (xtild1-xtild2)
37	guez	120
38			a3 = (derr+xprim1+xprim2)/x1x2car
39	guez	145	a2 = (xprim1-xprim2+3d0 * a3 * (xtil2car-xtil1car))/(2d0 * (xtild1-xtild2))
40	guez	120
41	guez	145	a1 = xprim1 - 3d0 * a3 * xtil1car - 2d0 * a2 * xtild1
42	guez	121	a0 = xf1 - a3 * xtild1 * xtil1car - a2 * xtil1car - a1 * xtild1
43	guez	120
44			END SUBROUTINE coefpoly
45
46			end module coefpoly_m