1 |
C $Header: /u/u3/gcmpack/MITgcm/pkg/timeave/timeave_cumul_2v.F,v 1.4.2.1 2003/10/02 18:30:08 adcroft 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, deltaT, |
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 deltaT |
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 |
|
45 |
IF ( dir.eq.0 ) THEN |
46 |
c- both fields at the same location : |
47 |
|
48 |
C DO bj = myByLo(myThid), myByHi(myThid) |
49 |
C DO bi = myBxLo(myThid), myBxHi(myThid) |
50 |
DO k=1,Ksize |
51 |
DO j=1,sNy |
52 |
DO i=1,sNx |
53 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
54 |
& + fld1(i,j,k,bi,bj)*fld2(i,j,k,bi,bj)*deltaT |
55 |
ENDDO |
56 |
ENDDO |
57 |
ENDDO |
58 |
C ENDDO |
59 |
C ENDDO |
60 |
|
61 |
ELSEIF ( dir.eq.1 ) THEN |
62 |
c- 2nd field shifted by -dX/2 (e.g.: 1=T, 2=U) : |
63 |
|
64 |
DO k=1,Ksize |
65 |
DO j=1,sNy |
66 |
DO i=1,sNx |
67 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
68 |
& + .5 * ( fld1(i-1,j,k,bi,bj) + fld1(i,j,k,bi,bj) ) |
69 |
& * fld2(i,j,k,bi,bj) |
70 |
& * deltaT |
71 |
ENDDO |
72 |
ENDDO |
73 |
ENDDO |
74 |
|
75 |
ELSEIF ( dir.eq.2 ) THEN |
76 |
c- 2nd field shifted by -dY/2 (e.g.: 1=T, 2=V) : |
77 |
|
78 |
DO k=1,Ksize |
79 |
DO j=1,sNy |
80 |
DO i=1,sNx |
81 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
82 |
& + .5 * ( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) ) |
83 |
& * fld2(i,j,k,bi,bj) |
84 |
& * deltaT |
85 |
ENDDO |
86 |
ENDDO |
87 |
ENDDO |
88 |
|
89 |
ELSEIF ( dir.eq.3 ) THEN |
90 |
c- 2nd field shifted by -dR/2 (e.g.: 1=T, 2=W) : |
91 |
|
92 |
DO k=2,Ksize |
93 |
DO j=1,sNy |
94 |
DO i=1,sNx |
95 |
fldtave(i,j,k,bi,bj)= fldtave(i,j,k,bi,bj) |
96 |
& + .5 * ( fld1(i,j,k-1,bi,bj) + fld1(i,j,k,bi,bj) ) |
97 |
& * fld2(i,j,k,bi,bj) |
98 |
& * deltaT |
99 |
ENDDO |
100 |
ENDDO |
101 |
ENDDO |
102 |
|
103 |
ELSEIF ( dir.eq.12 ) THEN |
104 |
c- 1rst & 2nd fields shifted by -dY/2 & -dX/2 |
105 |
c (e.g.: 1=U, 2=V, product at the corner) : |
106 |
|
107 |
DO k=1,Ksize |
108 |
DO j=1,sNy |
109 |
DO i=1,sNx |
110 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
111 |
& + .25 _d 0*( fld1(i,j-1,k,bi,bj) + fld1(i,j,k,bi,bj) ) |
112 |
& *( fld2(i-1,j,k,bi,bj) + fld2(i,j,k,bi,bj) ) |
113 |
& * deltaT |
114 |
ENDDO |
115 |
ENDDO |
116 |
ENDDO |
117 |
|
118 |
ELSEIF ( dir.eq.13 ) THEN |
119 |
c- 1rst & 2nd fields shifted by -dR/2 & -dX/2 (e.g.: 1=U, 2=W): |
120 |
|
121 |
DO k=2,Ksize |
122 |
DO j=1,sNy |
123 |
DO i=1,sNx |
124 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
125 |
& + .25 _d 0*( fld1(i,j,k-1,bi,bj) + fld1(i,j,k,bi,bj) ) |
126 |
& *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj) |
127 |
& +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj) |
128 |
& )*recip_rAw(i,j,bi,bj) |
129 |
& * deltaT |
130 |
ENDDO |
131 |
ENDDO |
132 |
ENDDO |
133 |
|
134 |
ELSEIF ( dir.eq.23 ) THEN |
135 |
c- 1rst & 2nd fields shifted by -dR/2 & -dY/2 (e.g.: 1=V, 2=W): |
136 |
|
137 |
DO k=2,Ksize |
138 |
DO j=1,sNy |
139 |
DO i=1,sNx |
140 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
141 |
& + .25 _d 0*( fld1(i,j,k-1,bi,bj) + fld1(i,j,k,bi,bj) ) |
142 |
& *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj) |
143 |
& +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj) |
144 |
& )*recip_rAs(i,j,bi,bj) |
145 |
& * deltaT |
146 |
ENDDO |
147 |
ENDDO |
148 |
ENDDO |
149 |
|
150 |
ELSEIF ( dir.eq.-13 ) THEN |
151 |
c- gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dX/2 resp. |
152 |
c- (e.g.: used for advective form of vertical advection: w.du/dr) |
153 |
|
154 |
DO k=2,Ksize |
155 |
DO j=1,sNy |
156 |
DO i=1,sNx |
157 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
158 |
& + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) ) |
159 |
& *( fld2(i-1,j,k,bi,bj)*rA(i-1,j,bi,bj) |
160 |
& +fld2( i ,j,k,bi,bj)*rA( i ,j,bi,bj) |
161 |
& )*recip_rAw(i,j,bi,bj) |
162 |
& * deltaT |
163 |
ENDDO |
164 |
ENDDO |
165 |
ENDDO |
166 |
|
167 |
ELSEIF ( dir.eq.-23 ) THEN |
168 |
c- gradient of the 1rst field * 2nd fields, shifted by -dR/2 & -dY/2 resp. |
169 |
c- (e.g.: used for advective form of vertical advection: w.dv/dr) |
170 |
|
171 |
DO k=2,Ksize |
172 |
DO j=1,sNy |
173 |
DO i=1,sNx |
174 |
fldtave(i,j,k,bi,bj) = fldtave(i,j,k,bi,bj) |
175 |
& + .5 _d 0*( fld1(i,j,k-1,bi,bj) - fld1(i,j,k,bi,bj) ) |
176 |
& *( fld2(i,j-1,k,bi,bj)*rA(i,j-1,bi,bj) |
177 |
& +fld2(i, j ,k,bi,bj)*rA(i, j ,bi,bj) |
178 |
& )*recip_rAs(i,j,bi,bj) |
179 |
& * deltaT |
180 |
ENDDO |
181 |
ENDDO |
182 |
ENDDO |
183 |
|
184 |
ENDIF |
185 |
|
186 |
#endif /* ALLOW_TIMEAVE */ |
187 |
|
188 |
RETURN |
189 |
END |