1 |
C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_tendency_apply.F,v 1.13 2014/07/09 17:00:49 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "AIM_OPTIONS.h" |
5 |
|
6 |
C-- File aim_tendency_apply.F: Routines to Add AIM tendency contributions |
7 |
C-- Contents |
8 |
C-- o AIM_TENDENCY_APPLY_U |
9 |
C-- o AIM_TENDENCY_APPLY_V |
10 |
C-- o AIM_TENDENCY_APPLY_T |
11 |
C-- o AIM_TENDENCY_APPLY_S |
12 |
|
13 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
14 |
CBOP |
15 |
C !ROUTINE: AIM_TENDENCY_APPLY_U |
16 |
C !INTERFACE: |
17 |
SUBROUTINE AIM_TENDENCY_APPLY_U( |
18 |
U gU_arr, |
19 |
I iMin,iMax,jMin,jMax, k, bi, bj, |
20 |
I myTime, myIter, myThid ) |
21 |
C !DESCRIPTION: \bv |
22 |
C *==========================================================* |
23 |
C | S/R AIM_TENDENCY_APPLY_U |
24 |
C | o Add AIM tendency terms to U tendency. |
25 |
C *==========================================================* |
26 |
C \ev |
27 |
|
28 |
C !USES: |
29 |
IMPLICIT NONE |
30 |
|
31 |
C == Global data == |
32 |
#include "SIZE.h" |
33 |
#include "EEPARAMS.h" |
34 |
#include "PARAMS.h" |
35 |
#include "GRID.h" |
36 |
#include "DYNVARS.h" |
37 |
#ifdef ALLOW_FRICTION_HEATING |
38 |
# include "FFIELDS.h" |
39 |
#endif |
40 |
|
41 |
#include "AIM_PARAMS.h" |
42 |
#include "AIM2DYN.h" |
43 |
#include "AIM_TAVE.h" |
44 |
|
45 |
C !INPUT/OUTPUT PARAMETERS: |
46 |
C gU_arr :: the tendency array |
47 |
C iMin,iMax :: Working range of x-index for applying forcing. |
48 |
C jMin,jMax :: Working range of y-index for applying forcing. |
49 |
C k :: Current vertical level index |
50 |
C bi,bj :: Current tile indices |
51 |
C myTime :: Current time in simulation |
52 |
C myIter :: Current iteration number |
53 |
C myThid :: my Thread Id number |
54 |
_RL gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
55 |
INTEGER iMin, iMax, jMin, jMax |
56 |
INTEGER k, bi, bj |
57 |
_RL myTime |
58 |
INTEGER myIter |
59 |
INTEGER myThid |
60 |
CEOP |
61 |
|
62 |
#ifdef ALLOW_AIM |
63 |
C == Local variables in common block == |
64 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
65 |
C aim_uStress :: surface stress applied to zonal wind |
66 |
COMMON /LOCAL_AIM_TENDENCY_APPLY_U/ aim_uStress,aim_KEuStr |
67 |
_RL aim_uStress(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
68 |
_RL aim_KEuStr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
69 |
#endif |
70 |
|
71 |
C == Local variables == |
72 |
C i,j :: Loop counters |
73 |
INTEGER i, j |
74 |
_RL uStr_tmp |
75 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
76 |
_RL aim_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
77 |
#endif |
78 |
|
79 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
80 |
IF ( myTime.EQ.startTime .AND. k.EQ.1 ) THEN |
81 |
C- Initialise diagnostic array aim_uStress |
82 |
DO j=1-OLy,sNy+OLy |
83 |
DO i=1-OLx,sNx+OLx |
84 |
aim_uStress(i,j,bi,bj) = 0. |
85 |
aim_KEuStr(i,j,bi,bj) = 0. |
86 |
ENDDO |
87 |
ENDDO |
88 |
ENDIF |
89 |
#endif |
90 |
|
91 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
92 |
IF ( k.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN |
93 |
C- Note: exclusive IF / ELSE is legitimate here since surface drag |
94 |
C is not supposed to be applied in stratosphere |
95 |
DO j=jMin,jMax |
96 |
DO i=iMin,iMax |
97 |
gU_arr(i,j) = gU_arr(i,j) |
98 |
& -maskW(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)/aim_dragStrato |
99 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
100 |
aim_dKE(i,j) = |
101 |
& -uVel(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)/aim_dragStrato |
102 |
& *hFacW(i,j,k,bi,bj)*drF(k)*rUnit2mass |
103 |
#endif |
104 |
ENDDO |
105 |
ENDDO |
106 |
ELSEIF ( k.EQ.1 ) THEN |
107 |
DO j=jMin,jMax |
108 |
DO i=iMin,iMax |
109 |
IF ( maskW(i,j,k,bi,bj) .NE. 0. ) THEN |
110 |
uStr_tmp = |
111 |
& -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) ) |
112 |
& * 0.5 _d 0 * uVel(i,j,k,bi,bj) |
113 |
gU_arr(i,j) = gU_arr(i,j) |
114 |
& + uStr_tmp*gravity*recip_drF(k) |
115 |
& * recip_hFacW(i,j,k,bi,bj) |
116 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
117 |
aim_uStress(i,j,bi,bj) = uStr_tmp |
118 |
#endif |
119 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
120 |
aim_dKE(i,j) = uStr_tmp * uVel(i,j,k,bi,bj) |
121 |
ELSE |
122 |
aim_dKE(i,j) = 0. |
123 |
#endif |
124 |
ENDIF |
125 |
ENDDO |
126 |
ENDDO |
127 |
ELSE |
128 |
DO j=jMin,jMax |
129 |
DO i=iMin,iMax |
130 |
IF ( maskW(i,j,k-1,bi,bj) .EQ. 0. |
131 |
& .AND. maskW(i,j,k,bi,bj) .NE. 0. ) THEN |
132 |
uStr_tmp = |
133 |
& -( (1.-maskC(i-1,j,k-1,bi,bj))*aim_drag(i-1,j,bi,bj) |
134 |
& +(1.-maskC( i ,j,k-1,bi,bj))*aim_drag( i ,j,bi,bj) |
135 |
& )* 0.5 _d 0 * uVel(i,j,k,bi,bj) |
136 |
gU_arr(i,j) = gU_arr(i,j) |
137 |
& + uStr_tmp*gravity*recip_drF(k) |
138 |
& * recip_hFacW(i,j,k,bi,bj) |
139 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
140 |
aim_uStress(i,j,bi,bj) = uStr_tmp |
141 |
#endif |
142 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
143 |
aim_dKE(i,j) = uStr_tmp * uVel(i,j,k,bi,bj) |
144 |
ELSE |
145 |
aim_dKE(i,j) = 0. |
146 |
#endif |
147 |
ENDIF |
148 |
ENDDO |
149 |
ENDDO |
150 |
ENDIF |
151 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
152 |
|
153 |
#ifdef ALLOW_FRICTION_HEATING |
154 |
IF ( addFrictionHeating ) THEN |
155 |
DO j=1,sNy |
156 |
DO i=1,sNx |
157 |
frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj) |
158 |
& - halfRL * ( aim_dKE( i, j)*rAw( i, j,bi,bj) |
159 |
& + aim_dKE(i+1,j)*rAw(i+1,j,bi,bj) |
160 |
& )*recip_rA(i,j,bi,bj) |
161 |
ENDDO |
162 |
ENDDO |
163 |
ENDIF |
164 |
#endif /* ALLOW_FRICTION_HEATING */ |
165 |
#ifdef ALLOW_AIM_TAVE |
166 |
IF ( aim_taveFreq.NE.0 .AND. k.EQ.Nr ) THEN |
167 |
CALL TIMEAVE_CUMULATE( USTRtave, aim_uStress, 1, |
168 |
& deltaTClock, bi, bj, myThid ) |
169 |
ENDIF |
170 |
#endif |
171 |
#ifdef ALLOW_DIAGNOSTICS |
172 |
IF ( usediagnostics ) THEN |
173 |
IF ( k.EQ.1 ) THEN |
174 |
DO j=jMin,jMax |
175 |
DO i=iMin,iMax |
176 |
aim_KEuStr(i,j,bi,bj) = aim_dKE(i,j) |
177 |
ENDDO |
178 |
ENDDO |
179 |
ELSE |
180 |
DO j=jMin,jMax |
181 |
DO i=iMin,iMax |
182 |
aim_KEuStr(i,j,bi,bj) = aim_KEuStr(i,j,bi,bj) |
183 |
& + aim_dKE(i,j) |
184 |
ENDDO |
185 |
ENDDO |
186 |
ENDIF |
187 |
IF ( k.EQ.Nr ) THEN |
188 |
CALL DIAGNOSTICS_FILL( aim_uStress, 'UFLUX ', |
189 |
& 0,1,1,bi,bj,myThid) |
190 |
CALL DIAGNOSTICS_FILL( aim_KEuStr, 'dKE_Ustr', |
191 |
& 0,1,1,bi,bj,myThid) |
192 |
ENDIF |
193 |
ENDIF |
194 |
#endif /* ALLOW_DIAGNOSTICS */ |
195 |
|
196 |
#endif /* ALLOW_AIM */ |
197 |
|
198 |
RETURN |
199 |
END |
200 |
|
201 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
202 |
CBOP |
203 |
C !ROUTINE: AIM_TENDENCY_APPLY_V |
204 |
C !INTERFACE: |
205 |
SUBROUTINE AIM_TENDENCY_APPLY_V( |
206 |
U gV_arr, |
207 |
I iMin,iMax,jMin,jMax, k, bi, bj, |
208 |
I myTime, myIter, myThid ) |
209 |
C !DESCRIPTION: \bv |
210 |
C *==========================================================* |
211 |
C | S/R TENDENCY_APPLY_V |
212 |
C | o Add AIM tendency terms to V tendency. |
213 |
C *==========================================================* |
214 |
C \ev |
215 |
|
216 |
C !USES: |
217 |
IMPLICIT NONE |
218 |
|
219 |
C == Global data == |
220 |
#include "SIZE.h" |
221 |
#include "EEPARAMS.h" |
222 |
#include "PARAMS.h" |
223 |
#include "GRID.h" |
224 |
#include "DYNVARS.h" |
225 |
#ifdef ALLOW_FRICTION_HEATING |
226 |
# include "FFIELDS.h" |
227 |
#endif |
228 |
|
229 |
#include "AIM_PARAMS.h" |
230 |
#include "AIM2DYN.h" |
231 |
#include "AIM_TAVE.h" |
232 |
|
233 |
C !INPUT/OUTPUT PARAMETERS: |
234 |
C gV_arr :: the tendency array |
235 |
C iMin,iMax :: Working range of x-index for applying forcing. |
236 |
C jMin,jMax :: Working range of y-index for applying forcing. |
237 |
C k :: Current vertical level index |
238 |
C bi,bj :: Current tile indices |
239 |
C myTime :: Current time in simulation |
240 |
C myIter :: Current iteration number |
241 |
C myThid :: my Thread Id number |
242 |
_RL gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
243 |
INTEGER iMin, iMax, jMin, jMax |
244 |
INTEGER k, bi, bj |
245 |
_RL myTime |
246 |
INTEGER myIter |
247 |
INTEGER myThid |
248 |
CEOP |
249 |
|
250 |
#ifdef ALLOW_AIM |
251 |
C == Local variables in common block == |
252 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
253 |
C aim_vStress :: surface stress applied to meridional wind |
254 |
COMMON /LOCAL_AIM_TENDENCY_APPLY_V/ aim_vStress,aim_KEvStr |
255 |
_RL aim_vStress(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
256 |
_RL aim_KEvStr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
257 |
#endif |
258 |
|
259 |
C == Local variables == |
260 |
C i,j :: Loop counters |
261 |
INTEGER i, j |
262 |
_RL vStr_tmp |
263 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
264 |
_RL aim_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
265 |
#endif |
266 |
|
267 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
268 |
IF ( myTime.EQ.startTime .AND. k.EQ.1 ) THEN |
269 |
C- Initialise diagnostic array aim_uStress |
270 |
DO j=1-OLy,sNy+OLy |
271 |
DO i=1-OLx,sNx+OLx |
272 |
aim_vStress(i,j,bi,bj) = 0. |
273 |
aim_KEvStr(i,j,bi,bj) = 0. |
274 |
ENDDO |
275 |
ENDDO |
276 |
ENDIF |
277 |
#endif |
278 |
|
279 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
280 |
IF ( k.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN |
281 |
C- Note: exclusive IF / ELSE is legitimate here since surface drag |
282 |
C is not supposed to be applied in the stratosphere |
283 |
DO j=jMin,jMax |
284 |
DO i=iMin,iMax |
285 |
gV_arr(i,j) = gV_arr(i,j) |
286 |
& -maskS(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)/aim_dragStrato |
287 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
288 |
aim_dKE(i,j) = |
289 |
& -vVel(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)/aim_dragStrato |
290 |
& *hFacS(i,j,k,bi,bj)*drF(k)*rUnit2mass |
291 |
#endif |
292 |
ENDDO |
293 |
ENDDO |
294 |
ELSEIF ( k.EQ.1 ) THEN |
295 |
DO j=jMin,jMax |
296 |
DO i=iMin,iMax |
297 |
IF ( maskS(i,j,k,bi,bj) .NE. 0. ) THEN |
298 |
vStr_tmp = |
299 |
& -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) ) |
300 |
& * 0.5 _d 0 * vVel(i,j,k,bi,bj) |
301 |
gV_arr(i,j) = gV_arr(i,j) |
302 |
& + vStr_tmp*gravity*recip_drF(k) |
303 |
& * recip_hFacS(i,j,k,bi,bj) |
304 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
305 |
aim_vStress(i,j,bi,bj) = vStr_tmp |
306 |
#endif |
307 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
308 |
aim_dKE(i,j) = vStr_tmp * vVel(i,j,k,bi,bj) |
309 |
ELSE |
310 |
aim_dKE(i,j) = 0. |
311 |
#endif |
312 |
ENDIF |
313 |
ENDDO |
314 |
ENDDO |
315 |
ELSE |
316 |
DO j=jMin,jMax |
317 |
DO i=iMin,iMax |
318 |
IF ( maskS(i,j,k-1,bi,bj) .EQ. 0. |
319 |
& .AND. maskS(i,j,k,bi,bj) .NE. 0. ) THEN |
320 |
vStr_tmp = |
321 |
& -( (1.-maskC(i,j-1,k-1,bi,bj))*aim_drag(i,j-1,bi,bj) |
322 |
& +(1.-maskC(i, j ,k-1,bi,bj))*aim_drag(i, j ,bi,bj) |
323 |
& )* 0.5 _d 0 * vVel(i,j,k,bi,bj) |
324 |
gV_arr(i,j) = gV_arr(i,j) |
325 |
& + vStr_tmp*gravity*recip_drF(k) |
326 |
& * recip_hFacS(i,j,k,bi,bj) |
327 |
#if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS ) |
328 |
aim_vStress(i,j,bi,bj) = vStr_tmp |
329 |
#endif |
330 |
#if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS ) |
331 |
aim_dKE(i,j) = vStr_tmp * vVel(i,j,k,bi,bj) |
332 |
ELSE |
333 |
aim_dKE(i,j) = 0. |
334 |
#endif |
335 |
ENDIF |
336 |
ENDDO |
337 |
ENDDO |
338 |
ENDIF |
339 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
340 |
|
341 |
#ifdef ALLOW_FRICTION_HEATING |
342 |
IF ( addFrictionHeating ) THEN |
343 |
DO j=1,sNy |
344 |
DO i=1,sNx |
345 |
frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj) |
346 |
& - halfRL * ( aim_dKE(i, j )*rAs(i, j, bi,bj) |
347 |
& + aim_dKE(i,j+1)*rAs(i,j+1,bi,bj) |
348 |
& )*recip_rA(i,j,bi,bj) |
349 |
ENDDO |
350 |
ENDDO |
351 |
ENDIF |
352 |
#endif /* ALLOW_FRICTION_HEATING */ |
353 |
#ifdef ALLOW_AIM_TAVE |
354 |
IF ( aim_taveFreq.NE.0 .AND. k.EQ.Nr ) THEN |
355 |
CALL TIMEAVE_CUMULATE( VSTRtave, aim_vStress, 1, |
356 |
& deltaTClock, bi, bj, myThid ) |
357 |
ENDIF |
358 |
#endif |
359 |
#ifdef ALLOW_DIAGNOSTICS |
360 |
IF ( usediagnostics ) THEN |
361 |
IF ( k.EQ.1 ) THEN |
362 |
DO j=jMin,jMax |
363 |
DO i=iMin,iMax |
364 |
aim_KEvStr(i,j,bi,bj) = aim_dKE(i,j) |
365 |
ENDDO |
366 |
ENDDO |
367 |
ELSE |
368 |
DO j=jMin,jMax |
369 |
DO i=iMin,iMax |
370 |
aim_KEvStr(i,j,bi,bj) = aim_KEvStr(i,j,bi,bj) |
371 |
& + aim_dKE(i,j) |
372 |
ENDDO |
373 |
ENDDO |
374 |
ENDIF |
375 |
IF ( k.EQ.Nr ) THEN |
376 |
CALL DIAGNOSTICS_FILL( aim_vStress, 'VFLUX ', |
377 |
& 0,1,1,bi,bj,myThid) |
378 |
CALL DIAGNOSTICS_FILL( aim_KEvStr, 'dKE_Vstr', |
379 |
& 0,1,1,bi,bj,myThid) |
380 |
ENDIF |
381 |
ENDIF |
382 |
#endif /* ALLOW_DIAGNOSTICS */ |
383 |
|
384 |
#endif /* ALLOW_AIM */ |
385 |
|
386 |
RETURN |
387 |
END |
388 |
|
389 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
390 |
CBOP |
391 |
C !ROUTINE: AIM_TENDENCY_APPLY_T |
392 |
C !INTERFACE: |
393 |
SUBROUTINE AIM_TENDENCY_APPLY_T( |
394 |
U gT_arr, |
395 |
I iMin,iMax,jMin,jMax, k, bi, bj, |
396 |
I myTime, myIter, myThid ) |
397 |
C !DESCRIPTION: \bv |
398 |
C *==========================================================* |
399 |
C | S/R AIM_TENDENCY_APPLY_T |
400 |
C | o Add AIM tendency to potential Temp tendency. |
401 |
C *==========================================================* |
402 |
C \ev |
403 |
|
404 |
C !USES: |
405 |
IMPLICIT NONE |
406 |
|
407 |
C == Global data == |
408 |
#include "SIZE.h" |
409 |
#include "EEPARAMS.h" |
410 |
#include "PARAMS.h" |
411 |
#include "GRID.h" |
412 |
c#include "DYNVARS.h" |
413 |
|
414 |
#include "AIM2DYN.h" |
415 |
|
416 |
C !INPUT/OUTPUT PARAMETERS: |
417 |
C gT_arr :: the tendency array |
418 |
C iMin,iMax :: Working range of x-index for applying forcing. |
419 |
C jMin,jMax :: Working range of y-index for applying forcing. |
420 |
C k :: Current vertical level index |
421 |
C bi,bj :: Current tile indices |
422 |
C myTime :: Current time in simulation |
423 |
C myIter :: Current iteration number |
424 |
C myThid :: my Thread Id number |
425 |
_RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
426 |
INTEGER iMin, iMax, jMin, jMax |
427 |
INTEGER k, bi, bj |
428 |
_RL myTime |
429 |
INTEGER myIter |
430 |
INTEGER myThid |
431 |
CEOP |
432 |
|
433 |
#ifdef ALLOW_AIM |
434 |
C == Local variables == |
435 |
C i,j :: Loop counters |
436 |
INTEGER I, J |
437 |
|
438 |
C-- Forcing: add AIM heating/cooling tendency to gT: |
439 |
DO J=1,sNy |
440 |
DO I=1,sNx |
441 |
gT_arr(i,j) = maskC(i,j,k,bi,bj) |
442 |
& *( gT_arr(i,j) + aim_dTdt(i,j,k,bi,bj) ) |
443 |
ENDDO |
444 |
ENDDO |
445 |
|
446 |
#endif /* ALLOW_AIM */ |
447 |
|
448 |
RETURN |
449 |
END |
450 |
|
451 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
452 |
CBOP |
453 |
C !ROUTINE: AIM_TENDENCY_APPLY_S |
454 |
C !INTERFACE: |
455 |
SUBROUTINE AIM_TENDENCY_APPLY_S( |
456 |
U gS_arr, |
457 |
I iMin,iMax,jMin,jMax, k, bi, bj, |
458 |
I myTime, myIter, myThid ) |
459 |
C !DESCRIPTION: \bv |
460 |
C *==========================================================* |
461 |
C | S/R AIM_TENDENCY_APPLY_S |
462 |
C | o Add AIM tendency to Specific Humidity tendency. |
463 |
C *==========================================================* |
464 |
C \ev |
465 |
|
466 |
C !USES: |
467 |
IMPLICIT NONE |
468 |
|
469 |
C == Global data == |
470 |
#include "SIZE.h" |
471 |
#include "EEPARAMS.h" |
472 |
#include "PARAMS.h" |
473 |
#include "GRID.h" |
474 |
c#include "DYNVARS.h" |
475 |
|
476 |
#include "AIM2DYN.h" |
477 |
|
478 |
C !INPUT/OUTPUT PARAMETERS: |
479 |
C gS_arr :: the tendency array |
480 |
C iMin,iMax :: Working range of x-index for applying forcing. |
481 |
C jMin,jMax :: Working range of y-index for applying forcing. |
482 |
C k :: Current vertical level index |
483 |
C bi,bj :: Current tile indices |
484 |
C myTime :: Current time in simulation |
485 |
C myIter :: Current iteration number |
486 |
C myThid :: my Thread Id number |
487 |
_RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
488 |
INTEGER iMin, iMax, jMin, jMax |
489 |
INTEGER k, bi, bj |
490 |
_RL myTime |
491 |
INTEGER myIter |
492 |
INTEGER myThid |
493 |
CEOP |
494 |
|
495 |
#ifdef ALLOW_AIM |
496 |
C == Local variables == |
497 |
C i,j :: Loop counters |
498 |
INTEGER I, J |
499 |
|
500 |
C-- Forcing: add AIM dq/dt tendency to gS: |
501 |
DO J=1,sNy |
502 |
DO I=1,sNx |
503 |
gS_arr(i,j) = maskC(i,j,k,bi,bj) |
504 |
& *( gS_arr(i,j) + aim_dSdt(i,j,k,bi,bj) ) |
505 |
ENDDO |
506 |
ENDDO |
507 |
|
508 |
#endif /* ALLOW_AIM */ |
509 |
|
510 |
RETURN |
511 |
END |