1 |
SUBROUTINE ymist(imr, jnp, j1, p, dc, id) |
2 |
PARAMETER (r24=1./24.) |
3 |
DIMENSION p(imr, jnp), dc(imr, jnp) |
4 |
|
5 |
imh = imr/2 |
6 |
jmr = jnp - 1 |
7 |
ijm3 = imr*(jmr-3) |
8 |
|
9 |
IF (id==2) THEN |
10 |
DO i = 1, imr*(jmr-1) |
11 |
tmp = 0.25*(p(i,3)-p(i,1)) |
12 |
pmax = max(p(i,1), p(i,2), p(i,3)) - p(i, 2) |
13 |
pmin = p(i, 2) - min(p(i,1), p(i,2), p(i,3)) |
14 |
dc(i, 2) = sign(min(abs(tmp),pmin,pmax), tmp) |
15 |
END DO |
16 |
ELSE |
17 |
DO i = 1, imh |
18 |
! J=2 |
19 |
tmp = (8.*(p(i,3)-p(i,1))+p(i+imh,2)-p(i,4))*r24 |
20 |
pmax = max(p(i,1), p(i,2), p(i,3)) - p(i, 2) |
21 |
pmin = p(i, 2) - min(p(i,1), p(i,2), p(i,3)) |
22 |
dc(i, 2) = sign(min(abs(tmp),pmin,pmax), tmp) |
23 |
! J=JMR |
24 |
tmp = (8.*(p(i,jnp)-p(i,jmr-1))+p(i,jmr-2)-p(i+imh,jmr))*r24 |
25 |
pmax = max(p(i,jmr-1), p(i,jmr), p(i,jnp)) - p(i, jmr) |
26 |
pmin = p(i, jmr) - min(p(i,jmr-1), p(i,jmr), p(i,jnp)) |
27 |
dc(i, jmr) = sign(min(abs(tmp),pmin,pmax), tmp) |
28 |
END DO |
29 |
DO i = imh + 1, imr |
30 |
! J=2 |
31 |
tmp = (8.*(p(i,3)-p(i,1))+p(i-imh,2)-p(i,4))*r24 |
32 |
pmax = max(p(i,1), p(i,2), p(i,3)) - p(i, 2) |
33 |
pmin = p(i, 2) - min(p(i,1), p(i,2), p(i,3)) |
34 |
dc(i, 2) = sign(min(abs(tmp),pmin,pmax), tmp) |
35 |
! J=JMR |
36 |
tmp = (8.*(p(i,jnp)-p(i,jmr-1))+p(i,jmr-2)-p(i-imh,jmr))*r24 |
37 |
pmax = max(p(i,jmr-1), p(i,jmr), p(i,jnp)) - p(i, jmr) |
38 |
pmin = p(i, jmr) - min(p(i,jmr-1), p(i,jmr), p(i,jnp)) |
39 |
dc(i, jmr) = sign(min(abs(tmp),pmin,pmax), tmp) |
40 |
END DO |
41 |
|
42 |
DO i = 1, ijm3 |
43 |
tmp = (8.*(p(i,4)-p(i,2))+p(i,1)-p(i,5))*r24 |
44 |
pmax = max(p(i,2), p(i,3), p(i,4)) - p(i, 3) |
45 |
pmin = p(i, 3) - min(p(i,2), p(i,3), p(i,4)) |
46 |
dc(i, 3) = sign(min(abs(tmp),pmin,pmax), tmp) |
47 |
END DO |
48 |
END IF |
49 |
|
50 |
IF (j1/=2) THEN |
51 |
DO i = 1, imr |
52 |
dc(i, 1) = 0. |
53 |
dc(i, jnp) = 0. |
54 |
END DO |
55 |
ELSE |
56 |
! Determine slopes in polar caps for scalars! |
57 |
|
58 |
DO i = 1, imh |
59 |
! South |
60 |
tmp = 0.25*(p(i,2)-p(i+imh,2)) |
61 |
pmax = max(p(i,2), p(i,1), p(i+imh,2)) - p(i, 1) |
62 |
pmin = p(i, 1) - min(p(i,2), p(i,1), p(i+imh,2)) |
63 |
dc(i, 1) = sign(min(abs(tmp),pmax,pmin), tmp) |
64 |
! North. |
65 |
tmp = 0.25*(p(i+imh,jmr)-p(i,jmr)) |
66 |
pmax = max(p(i+imh,jmr), p(i,jnp), p(i,jmr)) - p(i, jnp) |
67 |
pmin = p(i, jnp) - min(p(i+imh,jmr), p(i,jnp), p(i,jmr)) |
68 |
dc(i, jnp) = sign(min(abs(tmp),pmax,pmin), tmp) |
69 |
END DO |
70 |
|
71 |
DO i = imh + 1, imr |
72 |
dc(i, 1) = -dc(i-imh, 1) |
73 |
dc(i, jnp) = -dc(i-imh, jnp) |
74 |
END DO |
75 |
END IF |
76 |
RETURN |
77 |
END SUBROUTINE ymist |
78 |
|