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

Contents of /trunk/Sources/dyn3d/PPM3d/fyppm.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 166 - (show annotations)
Wed Jul 29 14:32:55 2015 UTC (8 years, 10 months ago) by guez
File size: 1726 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 SUBROUTINE fyppm(vc, p, dc, flux, imr, jnp, j1, j2, a6, ar, al, jord)
2 PARAMETER (r3=1./3., r23=2./3.)
3 REAL vc(imr, *), flux(imr, *), p(imr, *), dc(imr, *)
4 ! Local work arrays.
5 REAL ar(imr, jnp), al(imr, jnp), a6(imr, jnp)
6 INTEGER lmt
7 ! logical first
8 ! data first /.true./
9 ! SAVE LMT
10
11 imh = imr/2
12 jmr = jnp - 1
13 j11 = j1 - 1
14 imjm1 = imr*(j2-j1+2)
15 len = imr*(j2-j1+3)
16 ! if(first) then
17 ! IF(JORD.LE.0) then
18 ! if(JMR.GE.90) then
19 ! LMT = 0
20 ! elseif(JMR.GE.45) then
21 ! LMT = 1
22 ! else
23 ! LMT = 2
24 ! endif
25 ! else
26 ! LMT = JORD - 3
27 ! endif
28
29 ! first = .false.
30 ! endif
31
32 ! modifs pour pouvoir choisir plusieurs schemas PPM
33 lmt = jord - 3
34
35 DO i = 1, imr*jmr
36 al(i, 2) = 0.5*(p(i,1)+p(i,2)) + (dc(i,1)-dc(i,2))*r3
37 ar(i, 1) = al(i, 2)
38 END DO
39
40 ! Poles:
41
42 DO i = 1, imh
43 al(i, 1) = al(i+imh, 2)
44 al(i+imh, 1) = al(i, 2)
45
46 ar(i, jnp) = ar(i+imh, jmr)
47 ar(i+imh, jnp) = ar(i, jmr)
48 END DO
49
50 ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
51 ! Rajout pour LMDZ.3.3
52 ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
53 ar(imr, 1) = al(1, 1)
54 ar(imr, jnp) = al(1, jnp)
55 ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
56
57
58 DO i = 1, len
59 a6(i, j11) = 3.*(p(i,j11)+p(i,j11)-(al(i,j11)+ar(i,j11)))
60 END DO
61
62 IF (lmt<=2) CALL lmtppm(dc(1,j11), a6(1,j11), ar(1,j11), al(1,j11), &
63 p(1,j11), len, lmt)
64
65
66 DO i = 1, imjm1
67 IF (vc(i,j1)>0.) THEN
68 flux(i, j1) = ar(i, j11) + 0.5*vc(i, j1)*(al(i,j11)-ar(i,j11)+a6(i,j11) &
69 *(1.-r23*vc(i,j1)))
70 ELSE
71 flux(i, j1) = al(i, j1) - 0.5*vc(i, j1)*(ar(i,j1)-al(i,j1)+a6(i,j1)*(1. &
72 +r23*vc(i,j1)))
73 END IF
74 END DO
75 RETURN
76 END SUBROUTINE fyppm
77
  ViewVC Help
Powered by ViewVC 1.1.21