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

Contents of /trunk/Sources/dyn3d/PPM3d/yadv.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: 1624 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 yadv(imr, jnp, j1, j2, p, va, ady, wk, iad)
2 REAL p(imr, jnp), ady(imr, jnp), va(imr, jnp)
3 REAL wk(imr, -1:jnp+2)
4
5 jmr = jnp - 1
6 imh = imr/2
7 DO j = 1, jnp
8 DO i = 1, imr
9 wk(i, j) = p(i, j)
10 END DO
11 END DO
12 ! Poles:
13 DO i = 1, imh
14 wk(i, -1) = p(i+imh, 3)
15 wk(i+imh, -1) = p(i, 3)
16 wk(i, 0) = p(i+imh, 2)
17 wk(i+imh, 0) = p(i, 2)
18 wk(i, jnp+1) = p(i+imh, jmr)
19 wk(i+imh, jnp+1) = p(i, jmr)
20 wk(i, jnp+2) = p(i+imh, jnp-2)
21 wk(i+imh, jnp+2) = p(i, jnp-2)
22 END DO
23
24 IF (iad==2) THEN
25 DO j = j1 - 1, j2 + 1
26 DO i = 1, imr
27 jp = nint(va(i,j))
28 rv = jp - va(i, j)
29 jp = j - jp
30 a1 = 0.5*(wk(i,jp+1)+wk(i,jp-1)) - wk(i, jp)
31 b1 = 0.5*(wk(i,jp+1)-wk(i,jp-1))
32 ady(i, j) = wk(i, jp) + rv*(a1*rv+b1) - wk(i, j)
33 END DO
34 END DO
35
36 ELSE IF (iad==1) THEN
37 DO j = j1 - 1, j2 + 1
38 DO i = 1, imr
39 jp = float(j) - va(i, j)
40 ady(i, j) = va(i, j)*(wk(i,jp)-wk(i,jp+1))
41 END DO
42 END DO
43 END IF
44
45 IF (j1/=2) THEN
46 sum1 = 0.
47 sum2 = 0.
48 DO i = 1, imr
49 sum1 = sum1 + ady(i, 2)
50 sum2 = sum2 + ady(i, jmr)
51 END DO
52 sum1 = sum1/imr
53 sum2 = sum2/imr
54
55 DO i = 1, imr
56 ady(i, 2) = sum1
57 ady(i, jmr) = sum2
58 ady(i, 1) = sum1
59 ady(i, jnp) = sum2
60 END DO
61 ELSE
62 ! Poles:
63 sum1 = 0.
64 sum2 = 0.
65 DO i = 1, imr
66 sum1 = sum1 + ady(i, 1)
67 sum2 = sum2 + ady(i, jnp)
68 END DO
69 sum1 = sum1/imr
70 sum2 = sum2/imr
71
72 DO i = 1, imr
73 ady(i, 1) = sum1
74 ady(i, jnp) = sum2
75 END DO
76 END IF
77
78 RETURN
79 END SUBROUTINE yadv
80
  ViewVC Help
Powered by ViewVC 1.1.21