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

Contents of /trunk/Sources/dyn3d/PPM3d/ymist.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: 2440 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 ymist(imr, jnp, j1, p, dc, id)
2 PARAMETER (r24=1./24.)
3 DIMENSION p(imr, jnp), dc(imr, jnp)
4
5 imh = imr/2
6 jmr = jnp - 1
7 ijm3 = imr*(jmr-3)
8
9 IF (id==2) THEN
10 DO i = 1, imr*(jmr-1)
11 tmp = 0.25*(p(i,3)-p(i,1))
12 pmax = max(p(i,1), p(i,2), p(i,3)) - p(i, 2)
13 pmin = p(i, 2) - min(p(i,1), p(i,2), p(i,3))
14 dc(i, 2) = sign(min(abs(tmp),pmin,pmax), tmp)
15 END DO
16 ELSE
17 DO i = 1, imh
18 ! J=2
19 tmp = (8.*(p(i,3)-p(i,1))+p(i+imh,2)-p(i,4))*r24
20 pmax = max(p(i,1), p(i,2), p(i,3)) - p(i, 2)
21 pmin = p(i, 2) - min(p(i,1), p(i,2), p(i,3))
22 dc(i, 2) = sign(min(abs(tmp),pmin,pmax), tmp)
23 ! J=JMR
24 tmp = (8.*(p(i,jnp)-p(i,jmr-1))+p(i,jmr-2)-p(i+imh,jmr))*r24
25 pmax = max(p(i,jmr-1), p(i,jmr), p(i,jnp)) - p(i, jmr)
26 pmin = p(i, jmr) - min(p(i,jmr-1), p(i,jmr), p(i,jnp))
27 dc(i, jmr) = sign(min(abs(tmp),pmin,pmax), tmp)
28 END DO
29 DO i = imh + 1, imr
30 ! J=2
31 tmp = (8.*(p(i,3)-p(i,1))+p(i-imh,2)-p(i,4))*r24
32 pmax = max(p(i,1), p(i,2), p(i,3)) - p(i, 2)
33 pmin = p(i, 2) - min(p(i,1), p(i,2), p(i,3))
34 dc(i, 2) = sign(min(abs(tmp),pmin,pmax), tmp)
35 ! J=JMR
36 tmp = (8.*(p(i,jnp)-p(i,jmr-1))+p(i,jmr-2)-p(i-imh,jmr))*r24
37 pmax = max(p(i,jmr-1), p(i,jmr), p(i,jnp)) - p(i, jmr)
38 pmin = p(i, jmr) - min(p(i,jmr-1), p(i,jmr), p(i,jnp))
39 dc(i, jmr) = sign(min(abs(tmp),pmin,pmax), tmp)
40 END DO
41
42 DO i = 1, ijm3
43 tmp = (8.*(p(i,4)-p(i,2))+p(i,1)-p(i,5))*r24
44 pmax = max(p(i,2), p(i,3), p(i,4)) - p(i, 3)
45 pmin = p(i, 3) - min(p(i,2), p(i,3), p(i,4))
46 dc(i, 3) = sign(min(abs(tmp),pmin,pmax), tmp)
47 END DO
48 END IF
49
50 IF (j1/=2) THEN
51 DO i = 1, imr
52 dc(i, 1) = 0.
53 dc(i, jnp) = 0.
54 END DO
55 ELSE
56 ! Determine slopes in polar caps for scalars!
57
58 DO i = 1, imh
59 ! South
60 tmp = 0.25*(p(i,2)-p(i+imh,2))
61 pmax = max(p(i,2), p(i,1), p(i+imh,2)) - p(i, 1)
62 pmin = p(i, 1) - min(p(i,2), p(i,1), p(i+imh,2))
63 dc(i, 1) = sign(min(abs(tmp),pmax,pmin), tmp)
64 ! North.
65 tmp = 0.25*(p(i+imh,jmr)-p(i,jmr))
66 pmax = max(p(i+imh,jmr), p(i,jnp), p(i,jmr)) - p(i, jnp)
67 pmin = p(i, jnp) - min(p(i+imh,jmr), p(i,jnp), p(i,jmr))
68 dc(i, jnp) = sign(min(abs(tmp),pmax,pmin), tmp)
69 END DO
70
71 DO i = imh + 1, imr
72 dc(i, 1) = -dc(i-imh, 1)
73 dc(i, jnp) = -dc(i-imh, jnp)
74 END DO
75 END IF
76 RETURN
77 END SUBROUTINE ymist
78

  ViewVC Help
Powered by ViewVC 1.1.21