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

Annotation of /trunk/Sources/dyn3d/PPM3d/fyppm.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: 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 guez 166 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