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

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