/[lmdze]/trunk/Sources/dyn3d/PPM3d/fxppm.f
ViewVC logotype

Annotation of /trunk/Sources/dyn3d/PPM3d/fxppm.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 166 - (hide annotations)
Wed Jul 29 14:32:55 2015 UTC (8 years, 11 months ago) by guez
File size: 1171 byte(s) 
Split ppm3d.f into files containing a single procedure.

Factorized computations of filtering matrices into a procedure
inifilr_hemisph. Had then to change the matrices from allocatable to
pointer and from customized lower bound to lower bound 1. The change
in lower bounds does not matter because the matrices are only used as
a whole as actual arguments.

Also, in infilr, instead of finding jfilt[ns][uv] from approximately
jjm /2, start at index j1 that corresponds to the equator. This is not
the same if there is a zoom in latitude.

Also, the test (rlamda(modfrst[ns][uv](j)) * cos(rlat[uv](j)) < 1) in
the loops on filtered latitudes is not useful now that we start from
j1: it is necessarily true. See notes.

Just encapsulated lwvn into a module and removed unused argument ktraer.
1 guez 166 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    
  ViewVC Help
Powered by ViewVC 1.1.21