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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 166 - (show annotations)
Wed Jul 29 14:32:55 2015 UTC (8 years, 11 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 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