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

Contents of /trunk/Sources/dyn3d/PPM3d/ytp.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: 1335 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 ytp(imr, jnp, j1, j2, acosp, rcap, dq, p, vc, dc2, ymass, fx, a6, &
2 ar, al, jord)
3 DIMENSION p(imr, jnp), vc(imr, jnp), ymass(imr, jnp), dc2(imr, jnp), &
4 dq(imr, jnp), acosp(jnp)
5 ! Work array
6 DIMENSION fx(imr, jnp), ar(imr, jnp), al(imr, jnp), a6(imr, jnp)
7
8 jmr = jnp - 1
9 len = imr*(j2-j1+2)
10
11 IF (jord==1) THEN
12 DO i = 1, len
13 jt = float(j1) - vc(i, j1)
14 fx(i, j1) = p(i, jt)
15 END DO
16 ELSE
17
18 CALL ymist(imr, jnp, j1, p, dc2, 4)
19
20 IF (jord<=0 .OR. jord>=3) THEN
21
22 CALL fyppm(vc, p, dc2, fx, imr, jnp, j1, j2, a6, ar, al, jord)
23
24 ELSE
25 DO i = 1, len
26 jt = float(j1) - vc(i, j1)
27 fx(i, j1) = p(i, jt) + (sign(1.,vc(i,j1))-vc(i,j1))*dc2(i, jt)
28 END DO
29 END IF
30 END IF
31
32 DO i = 1, len
33 fx(i, j1) = fx(i, j1)*ymass(i, j1)
34 END DO
35
36 DO j = j1, j2
37 DO i = 1, imr
38 dq(i, j) = dq(i, j) + (fx(i,j)-fx(i,j+1))*acosp(j)
39 END DO
40 END DO
41
42 ! Poles
43 sum1 = fx(imr, j1)
44 sum2 = fx(imr, j2+1)
45 DO i = 1, imr - 1
46 sum1 = sum1 + fx(i, j1)
47 sum2 = sum2 + fx(i, j2+1)
48 END DO
49
50 sum1 = dq(1, 1) - sum1*rcap
51 sum2 = dq(1, jnp) + sum2*rcap
52 DO i = 1, imr
53 dq(i, 1) = sum1
54 dq(i, jnp) = sum2
55 END DO
56
57 IF (j1/=2) THEN
58 DO i = 1, imr
59 dq(i, 2) = sum1
60 dq(i, jmr) = sum2
61 END DO
62 END IF
63
64 RETURN
65 END SUBROUTINE ytp
66
  ViewVC Help
Powered by ViewVC 1.1.21