1 |
SUBROUTINE fxppm(imr, iml, ut, p, dc, flux, iord) |
2 |
PARAMETER (r3=1./3., r23=2./3.) |
3 |
DIMENSION ut(*), flux(*), p(-iml:imr+iml+1), dc(-iml:imr+iml+1) |
4 |
DIMENSION ar(0:imr), al(0:imr), a6(0:imr) |
5 |
INTEGER lmt |
6 |
! logical first |
7 |
! data first /.true./ |
8 |
! SAVE LMT |
9 |
! if(first) then |
10 |
|
11 |
! correction calcul de LMT a chaque passage pour pouvoir choisir |
12 |
! plusieurs schemas PPM pour differents traceurs |
13 |
! IF (IORD.LE.0) then |
14 |
! if(IMR.GE.144) then |
15 |
! LMT = 0 |
16 |
! elseif(IMR.GE.72) then |
17 |
! LMT = 1 |
18 |
! else |
19 |
! LMT = 2 |
20 |
! endif |
21 |
! else |
22 |
! LMT = IORD - 3 |
23 |
! endif |
24 |
|
25 |
lmt = iord - 3 |
26 |
|
27 |
DO i = 1, imr |
28 |
al(i) = 0.5*(p(i-1)+p(i)) + (dc(i-1)-dc(i))*r3 |
29 |
END DO |
30 |
|
31 |
DO i = 1, imr - 1 |
32 |
ar(i) = al(i+1) |
33 |
END DO |
34 |
ar(imr) = al(1) |
35 |
|
36 |
DO i = 1, imr |
37 |
a6(i) = 3.*(p(i)+p(i)-(al(i)+ar(i))) |
38 |
END DO |
39 |
|
40 |
IF (lmt<=2) CALL lmtppm(dc(1), a6(1), ar(1), al(1), p(1), imr, lmt) |
41 |
|
42 |
al(0) = al(imr) |
43 |
ar(0) = ar(imr) |
44 |
a6(0) = a6(imr) |
45 |
|
46 |
DO i = 1, imr |
47 |
IF (ut(i)>0.) THEN |
48 |
flux(i) = ar(i-1) + 0.5*ut(i)*(al(i-1)-ar(i-1)+a6(i-1)*(1.-r23*ut(i))) |
49 |
ELSE |
50 |
flux(i) = al(i) - 0.5*ut(i)*(ar(i)-al(i)+a6(i)*(1.+r23*ut(i))) |
51 |
END IF |
52 |
END DO |
53 |
RETURN |
54 |
END SUBROUTINE fxppm |
55 |
|