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

Annotation of /trunk/Sources/dyn3d/PPM3d/filew.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 166 - (hide annotations)
Wed Jul 29 14:32:55 2015 UTC (8 years, 9 months ago) by guez
File size: 1671 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 filew(q, qtmp, imr, jnp, j1, j2, ipx, tiny)
2     DIMENSION q(imr, *), qtmp(jnp, imr)
3    
4     ipx = 0
5     ! Copy & swap direction for vectorization.
6     DO i = 1, imr
7     DO j = j1, j2
8     qtmp(j, i) = q(i, j)
9     END DO
10     END DO
11    
12     DO i = 2, imr - 1
13     DO j = j1, j2
14     IF (qtmp(j,i)<0.) THEN
15     ipx = 1
16     ! west
17     d0 = max(0., qtmp(j,i-1))
18     d1 = min(-qtmp(j,i), d0)
19     qtmp(j, i-1) = qtmp(j, i-1) - d1
20     qtmp(j, i) = qtmp(j, i) + d1
21     ! east
22     d0 = max(0., qtmp(j,i+1))
23     d2 = min(-qtmp(j,i), d0)
24     qtmp(j, i+1) = qtmp(j, i+1) - d2
25     qtmp(j, i) = qtmp(j, i) + d2 + tiny
26     END IF
27     END DO
28     END DO
29    
30     i = 1
31     DO j = j1, j2
32     IF (qtmp(j,i)<0.) THEN
33     ipx = 1
34     ! west
35     d0 = max(0., qtmp(j,imr))
36     d1 = min(-qtmp(j,i), d0)
37     qtmp(j, imr) = qtmp(j, imr) - d1
38     qtmp(j, i) = qtmp(j, i) + d1
39     ! east
40     d0 = max(0., qtmp(j,i+1))
41     d2 = min(-qtmp(j,i), d0)
42     qtmp(j, i+1) = qtmp(j, i+1) - d2
43    
44     qtmp(j, i) = qtmp(j, i) + d2 + tiny
45     END IF
46     END DO
47     i = imr
48     DO j = j1, j2
49     IF (qtmp(j,i)<0.) THEN
50     ipx = 1
51     ! west
52     d0 = max(0., qtmp(j,i-1))
53     d1 = min(-qtmp(j,i), d0)
54     qtmp(j, i-1) = qtmp(j, i-1) - d1
55     qtmp(j, i) = qtmp(j, i) + d1
56     ! east
57     d0 = max(0., qtmp(j,1))
58     d2 = min(-qtmp(j,i), d0)
59     qtmp(j, 1) = qtmp(j, 1) - d2
60    
61     qtmp(j, i) = qtmp(j, i) + d2 + tiny
62     END IF
63     END DO
64    
65     IF (ipx/=0) THEN
66     DO j = j1, j2
67     DO i = 1, imr
68     q(i, j) = qtmp(j, i)
69     END DO
70     END DO
71     ELSE
72    
73     ! Poles.
74     IF (q(1,1)<0 .OR. q(1,jnp)<0.) ipx = 1
75     END IF
76     RETURN
77     END SUBROUTINE filew
  ViewVC Help
Powered by ViewVC 1.1.21