1 |
C $Header: /u/gcmpack/MITgcm/pkg/timeave/timeave_cumul_2v.F,v 1.6 2004/07/26 16:57:29 jmc Exp $ |
2 |
C $Name: $ |
3 |
#include "TIMEAVE_OPTIONS.h" |
4 |
|
5 |
CStartofinterface |
6 |
SUBROUTINE TIMEAVE_CUMUL_2V( |
7 |
O fldtave, |
8 |
I fld1, fld2, Ksize, dir, deltaTloc, |
9 |
I bi, bj, myThid ) |
10 |
C /==========================================================* |
11 |
C | SUBROUTINE TIMEAVE_CUMUL_2V |
12 |
C | o Sum over time a product of two arrays depending on the |
13 |
C | relative position of the 2 fields. |
14 |
C | (tracer point, u, v, w ...) |
15 |
C \==========================================================* |
16 |
IMPLICIT NONE |
17 |
|
18 |
C == Global variables === |
19 |
#include "SIZE.h" |
20 |
#include "EEPARAMS.h" |
21 |
#include "GRID.h" |
22 |
|
23 |
C == Routine arguments == |
24 |
C myThid - Thread number for this instance of the routine. |
25 |
C fldtave - time averaged Field |
26 |
C fld1,fld2 - Input Field |
27 |
C dir - type of grid for 2nd array relatively to the 1rst array |
28 |
C 0: same grid ; 1: dX/2 shift ; 2: dY/2 shift ; 3: dr/2 shift |
29 |
C (2 digits => also shift the 1rst array) |
30 |
C Ksize - 3rd dimension of local arrays (Input and Output fields) |
31 |
INTEGER Ksize, dir |
32 |
_RL fld1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy) |
33 |
_RL fld2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy) |
34 |
_RL fldtave(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Ksize,nSx,nSy) |
35 |
_RL deltaTloc |
36 |
INTEGER bi, bj, myThid |
37 |
|
38 |
CEndofinterface |
39 |
|
40 |
#ifdef ALLOW_TIMEAVE |
41 |
C == Local variables == |
42 |
C i,j,k,bi,bj - Loop counters |
43 |
INTEGER i, j, k |
44 |
INTEGER km1 |
45 |
|
46 |
IF ( dir.eq.0 ) THEN |
47 |
c- both fields at the same location : |
48 |
|
49 |
C DO bj = myByLo(myThid), myByHi(myThid) |
50 |
C DO bi = myBxLo(myThid), myBxHi(myThid) |
51 |
DO k=1,Ksize |
52 |
DO j=1,sNy |
53 |
DO i=1,sNx |
54 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
55 |
& + fld1(i,j,k,bi,bj)*fld2(i,j,k,bi,bj)*deltaTloc |
56 |
ENDDO |
57 |
ENDDO |
58 |
ENDDO |
59 |
C ENDDO |
60 |
C ENDDO |
61 |
|
62 |
ELSEIF ( dir.eq.1 ) THEN |
63 |
c- 2nd field shifted by -dX/2 (e.g.: 1=T, 2=U) : |
64 |
|
65 |
DO k=1,Ksize |
66 |
DO j=1,sNy |
67 |
DO i=1,sNx |
68 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
69 |
& + .5 * ( fld1(i-1,j,k,bi,bj) + fld1(i,j,k,bi,bj) ) |
70 |
& * fld2(i,j,k,bi,bj) |
71 |
& * deltaTloc |
72 |
ENDDO |
73 |
ENDDO |
74 |
ENDDO |
75 |
|
76 |
ELSEIF ( dir.eq.2 ) THEN |
77 |
c- 2nd field shifted by -dY/2 (e.g.: 1=T, 2=V) : |
78 |
|
79 |
DO k=1,Ksize |
80 |
DO j=1,sNy |
81 |
DO i=1,sNx |
82 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
83 |
& + .5 * ( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) ) |
84 |
& * fld2(i,j,k,bi,bj) |
85 |
& * deltaTloc |
86 |
ENDDO |
87 |
ENDDO |
88 |
ENDDO |
89 |
|
90 |
ELSEIF ( dir.eq.3 ) THEN |
91 |
c- 2nd field shifted by -dR/2 (e.g.: 1=T, 2=W) : |
92 |
|
93 |
DO k=1,Ksize |
94 |
km1 = MAX(k-1,1) |
95 |
DO j=1,sNy |
96 |
DO i=1,sNx |
97 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
98 |
& + .5 * ( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) ) |
99 |
& * fld2(i,j,k,bi,bj) |
100 |
& * deltaTloc |
101 |
ENDDO |
102 |
ENDDO |
103 |
ENDDO |
104 |
|
105 |
ELSEIF ( dir.eq.12 ) THEN |
106 |
c- 1rst & 2nd fields shifted by -dY/2 & -dX/2 |
107 |
c (e.g.: 1=U, 2=V, product at the corner) : |
108 |
|
109 |
DO k=1,Ksize |
110 |
DO j=1,sNy |
111 |
DO i=1,sNx |
112 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
113 |
& + .25 _d 0*( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) ) |
114 |
& *( fld2(i-1,j,k,bi,bj) + fld2(i,j,k,bi,bj) ) |
115 |
& * deltaTloc |
116 |
ENDDO |
117 |
ENDDO |
118 |
ENDDO |
119 |
|
120 |
ELSEIF ( dir.eq.13 ) THEN |
121 |
c- 1rst & 2nd fields shifted by -dR/2 & -dX/2 (e.g.: 1=U, 2=W): |
122 |
|
123 |
DO k=1,Ksize |
124 |
km1 = MAX(k-1,1) |
125 |
DO j=1,sNy |
126 |
DO i=1,sNx |
127 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
128 |
& + .25 _d 0*( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) ) |
129 |
& *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj) |
130 |
& +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj) |
131 |
& )*recip_rAw(i,j,bi,bj) |
132 |
& * deltaTloc |
133 |
ENDDO |
134 |
ENDDO |
135 |
ENDDO |
136 |
|
137 |
ELSEIF ( dir.eq.23 ) THEN |
138 |
c- 1rst & 2nd fields shifted by -dR/2 & -dY/2 (e.g.: 1=V, 2=W): |
139 |
|
140 |
DO k=1,Ksize |
141 |
km1 = MAX(k-1,1) |
142 |
DO j=1,sNy |
143 |
DO i=1,sNx |
144 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
145 |
& + .25 _d 0*( fld1(i,j,km1,bi,bj) + fld1(i,j,k,bi,bj) ) |
146 |
& *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj) |
147 |
& +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj) |
148 |
& )*recip_rAs(i,j,bi,bj) |
149 |
& * deltaTloc |
150 |
ENDDO |
151 |
ENDDO |
152 |
ENDDO |
153 |
|
154 |
ELSEIF ( dir.eq.-13 ) THEN |
155 |
c- gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dX/2 resp. |
156 |
c- (e.g.: used for advective form of vertical advection: w.du/dr) |
157 |
|
158 |
DO k=2,Ksize |
159 |
DO j=1,sNy |
160 |
DO i=1,sNx |
161 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
162 |
& + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) ) |
163 |
& *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj) |
164 |
& +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj) |
165 |
& )*recip_rAw(i,j,bi,bj) |
166 |
& * deltaTloc |
167 |
ENDDO |
168 |
ENDDO |
169 |
ENDDO |
170 |
|
171 |
ELSEIF ( dir.eq.-23 ) THEN |
172 |
c- gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dY/2 resp. |
173 |
c- (e.g.: used for advective form of vertical advection: w.dv/dr) |
174 |
|
175 |
DO k=2,Ksize |
176 |
DO j=1,sNy |
177 |
DO i=1,sNx |
178 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
179 |
& + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) ) |
180 |
& *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj) |
181 |
& +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj) |
182 |
& )*recip_rAs(i,j,bi,bj) |
183 |
& * deltaTloc |
184 |
ENDDO |
185 |
ENDDO |
186 |
ENDDO |
187 |
|
188 |
ENDIF |
189 |
|
190 |
#endif /* ALLOW_TIMEAVE */ |
191 |
|
192 |
RETURN |
193 |
END |