/[lmdze]/trunk/Sources/misc/coefpoly.f
ViewVC logotype

Contents of /trunk/Sources/misc/coefpoly.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 120 - (show annotations)
Tue Jan 13 14:56:15 2015 UTC (9 years, 4 months ago) by guez
Original Path: trunk/dyn3d/coefpoly.f
File size: 1386 byte(s)
In procedure fxhyp, removed the possibility to set scal180 to
false. The useful lower bound of fhyp and xxpr is not 0. It does not
make sense to give the save attribute to is2 since fxhyp is only
called one per run. Bug fix: is2 could be used without being
defined. The bug did not appear because is2 had the save attribute so
it was initialized at 0.

1 module coefpoly_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3)
8
9 ! From LMDZ4/libf/dyn3d/coefpoly.F,v 1.1.1.1 2004/05/19 12:53:05
10
11 ! ... Auteur : P. Le Van ...
12
13 ! Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
14 ! satisfait aux 4 equations suivantes :
15
16 ! a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
17 ! a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
18 ! a1 + 2.*a2*xtild1 + 3.*a3*xtild1*xtild1 = Xprim1
19 ! a1 + 2.*a2*xtild2 + 3.*a3*xtild2*xtild2 = Xprim2
20
21 ! On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
22
23 DOUBLE PRECISION, intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2
24 DOUBLE PRECISION, intent(out):: a0, a1, a2, a3
25
26 ! Local:
27 DOUBLE PRECISION xtil1car, xtil2car, derr, x1x2car
28
29 !------------------------------------------------------------
30
31 xtil1car = xtild1*xtild1
32 xtil2car = xtild2*xtild2
33
34 derr = 2.*(xf2-xf1)/(xtild1-xtild2)
35
36 x1x2car = (xtild1-xtild2)*(xtild1-xtild2)
37
38 a3 = (derr+xprim1+xprim2)/x1x2car
39 a2 = (xprim1-xprim2+3.*a3*(xtil2car-xtil1car))/(2.*(xtild1-xtild2))
40
41 a1 = xprim1 - 3.*a3*xtil1car - 2.*a2*xtild1
42 a0 = xf1 - a3*xtild1*xtil1car - a2*xtil1car - a1*xtild1
43
44 END SUBROUTINE coefpoly
45
46 end module coefpoly_m

  ViewVC Help
Powered by ViewVC 1.1.21