/[MITgcm]/MITgcm/pkg/aim_v23/aim_tendency_apply.F
ViewVC logotype

Annotation of /MITgcm/pkg/aim_v23/aim_tendency_apply.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (hide annotations) (download)
Thu Jul 31 18:40:57 2003 UTC (20 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint51k_post, checkpoint52d_pre, checkpoint51o_pre, checkpoint51l_post, checkpoint52, checkpoint51f_post, checkpoint51t_post, checkpoint51n_post, checkpoint51s_post, checkpoint51j_post, checkpoint51n_pre, checkpoint52b_pre, checkpoint51l_pre, checkpoint51q_post, checkpoint52b_post, checkpoint52c_post, checkpoint51h_pre, branchpoint-genmake2, checkpoint51r_post, checkpoint51i_post, checkpoint52a_pre, checkpoint51i_pre, branch-netcdf, checkpoint51e_post, checkpoint51o_post, checkpoint51f_pre, checkpoint52a_post, checkpoint51g_post, ecco_c52_e35, checkpoint51m_post, checkpoint51p_post, checkpoint51u_post
Branch point for: branch-genmake2, branch-nonh, tg2-branch, netcdf-sm0, checkpoint51n_branch
Changes since 1.2: +27 -7 lines 
add stratospheric drag in the upper level (new parameter: aim_dragStrato)
1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_tendency_apply.F,v 1.2 2003/01/03 03:51:27 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "AIM_OPTIONS.h"
5    
6     CStartOfInterface
7     SUBROUTINE AIM_TENDENCY_APPLY_U(
8     I iMin, iMax, jMin, jMax,bi,bj,kLev,
9     I myTime,myThid)
10     C *==========================================================*
11     C | S/R AIM_TENDENCY_APPLY_U
12     C | o Add AIM tendency terms to U tendency.
13     C *==========================================================*
14     IMPLICIT NONE
15    
16     C == Global data ==
17     #include "SIZE.h"
18     #include "EEPARAMS.h"
19     #include "PARAMS.h"
20     #include "GRID.h"
21     #include "DYNVARS.h"
22    
23 jmc 1.3 #include "AIM_PARAMS.h"
24 jmc 1.1 #include "AIM2DYN.h"
25     #include "AIM_DIAGS.h"
26    
27     C == Routine arguments ==
28     C iMin - Working range of tile for applying forcing.
29     C iMax
30     C jMin
31     C jMax
32     C kLev
33     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
34     _RL myTime
35     INTEGER myThid
36     CEndOfInterface
37    
38     #ifdef ALLOW_AIM
39     C == Local variables ==
40     C i,j - Loop counters
41     INTEGER i, j
42     _RL DDTT, uStr_tmp
43    
44     DDTT = deltaTclock
45    
46     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
47 jmc 1.3 IF ( kLev.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN
48     C- Note: exclusive IF / ELSE is legitimate here since surface drag
49     C is not supposed to be applied in stratosphere
50 jmc 1.1 DO j=jMin,jMax
51     DO i=iMin,iMax
52 jmc 1.3 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
53     & -maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)/aim_dragStrato
54     ENDDO
55     ENDDO
56     ELSEIF (kLev.eq.1) THEN
57     DO j=jMin,jMax
58     DO i=iMin,iMax
59     IF ( maskW(i,j,kLev,bi,bj) .NE. 0. ) THEN
60 jmc 1.1 uStr_tmp =
61     & -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
62     & * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
63     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
64     & + uStr_tmp*gravity*recip_drF(kLev)
65     & * recip_hFacW(i,j,kLev,bi,bj)
66 jmc 1.2 #ifdef ALLOW_AIM_TAVE
67 jmc 1.1 USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
68     #endif
69     ENDIF
70     ENDDO
71     ENDDO
72     ELSE
73     DO j=jMin,jMax
74     DO i=iMin,iMax
75 jmc 1.3 IF ( maskW(i,j,kLev,bi,bj) .NE. 0. ) THEN
76 jmc 1.1 uStr_tmp =
77     & -( (1.-maskC(i-1,j,kLev-1,bi,bj))*aim_drag(i-1,j,bi,bj)
78     & +(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
79     & )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
80     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
81     & + uStr_tmp*gravity*recip_drF(kLev)
82     & * recip_hFacW(i,j,kLev,bi,bj)
83 jmc 1.2 #ifdef ALLOW_AIM_TAVE
84 jmc 1.1 USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
85     #endif
86     ENDIF
87     ENDDO
88     ENDDO
89     ENDIF
90     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
91    
92     #endif /* ALLOW_AIM */
93    
94     RETURN
95     END
96     CStartOfInterface
97     SUBROUTINE AIM_TENDENCY_APPLY_V(
98     I iMin, iMax, jMin, jMax,bi,bj,kLev,
99     I myTime,myThid)
100     C *==========================================================*
101     C | S/R TENDENCY_APPLY_V
102     C | o Add AIM tendency terms to V tendency.
103     C *==========================================================*
104     IMPLICIT NONE
105    
106     C == Global data ==
107     #include "SIZE.h"
108     #include "EEPARAMS.h"
109     #include "PARAMS.h"
110     #include "GRID.h"
111     #include "DYNVARS.h"
112    
113 jmc 1.3 #include "AIM_PARAMS.h"
114 jmc 1.1 #include "AIM2DYN.h"
115     #include "AIM_DIAGS.h"
116    
117     C == Routine arguments ==
118     C iMin - Working range of tile for applying forcing.
119     C iMax
120     C jMin
121     C jMax
122     C kLev
123     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
124     _RL myTime
125     INTEGER myThid
126     CEndOfInterface
127    
128     #ifdef ALLOW_AIM
129     C == Local variables ==
130     C Loop counters
131     INTEGER i, j
132     _RL DDTT, vStr_tmp
133    
134     DDTT = deltaTclock
135    
136     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
137 jmc 1.3 IF ( kLev.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN
138     C- Note: exclusive IF / ELSE is legitimate here since surface drag
139     C is not supposed to be applied in the stratosphere
140     DO j=jMin,jMax
141     DO i=iMin,iMax
142     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
143     & -maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)/aim_dragStrato
144     ENDDO
145     ENDDO
146     ELSEIF (kLev.eq.1) THEN
147 jmc 1.1 DO j=jMin,jMax
148     DO i=iMin,iMax
149 jmc 1.3 IF ( maskS(i,j,kLev,bi,bj) .NE. 0. ) THEN
150 jmc 1.1 vStr_tmp =
151     & -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
152     & * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
153     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
154     & + vStr_tmp*gravity*recip_drF(kLev)
155     & * recip_hFacS(i,j,kLev,bi,bj)
156 jmc 1.2 #ifdef ALLOW_AIM_TAVE
157 jmc 1.1 VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
158     #endif
159     ENDIF
160     ENDDO
161     ENDDO
162     ELSE
163     DO j=jMin,jMax
164     DO i=iMin,iMax
165 jmc 1.3 IF ( maskS(i,j,kLev,bi,bj) .NE. 0. ) THEN
166 jmc 1.1 vStr_tmp =
167     & -( (1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
168     & +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
169     & )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
170     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
171     & + vStr_tmp*gravity*recip_drF(kLev)
172     & * recip_hFacS(i,j,kLev,bi,bj)
173 jmc 1.2 #ifdef ALLOW_AIM_TAVE
174 jmc 1.1 VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
175     #endif
176     ENDIF
177     ENDDO
178     ENDDO
179     ENDIF
180     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
181    
182     #endif /* ALLOW_AIM */
183    
184     RETURN
185     END
186     CStartOfInterface
187     SUBROUTINE AIM_TENDENCY_APPLY_T(
188     I iMin, iMax, jMin, jMax,bi,bj,kLev,
189     I myTime,myThid)
190     C *==========================================================*
191     C | S/R AIM_TENDENCY_APPLY_T
192     C | o Add AIM tendency to gT
193     C *==========================================================*
194     IMPLICIT NONE
195    
196     C == Global data ==
197     #include "SIZE.h"
198     #include "EEPARAMS.h"
199     #include "PARAMS.h"
200     #include "GRID.h"
201     #include "DYNVARS.h"
202    
203     #include "AIM2DYN.h"
204    
205     C == Routine arguments ==
206     C iMin - Working range of tile for applying forcing.
207     C iMax
208     C jMin
209     C jMax
210     C kLev
211     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
212     _RL myTime
213     INTEGER myThid
214     CEndOfInterface
215    
216     #ifdef ALLOW_AIM
217     C == Local variables ==
218     C Loop counters
219     INTEGER I, J
220    
221     C-- Forcing: add AIM heating/cooling tendency to gT:
222     DO J=1,sNy
223     DO I=1,sNx
224     gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
225     & *( gT(i,j,kLev,bi,bj) + aim_dTdt(i,j,kLev,bi,bj) )
226     ENDDO
227     ENDDO
228    
229     #endif /* ALLOW_AIM */
230    
231     RETURN
232     END
233     CStartOfInterface
234     SUBROUTINE AIM_TENDENCY_APPLY_S(
235     I iMin, iMax, jMin, jMax,bi,bj,kLev,
236     I myTime,myThid)
237     C *==========================================================*
238     C | S/R AIM_TENDENCY_APPLY_S
239     C | o Add AIM tendency to gS.
240     C *==========================================================*
241     IMPLICIT NONE
242    
243     C == Global data ==
244     #include "SIZE.h"
245     #include "EEPARAMS.h"
246     #include "PARAMS.h"
247     #include "GRID.h"
248     #include "DYNVARS.h"
249    
250     #include "AIM2DYN.h"
251    
252     C == Routine arguments ==
253     C iMin - Working range of tile for applying forcing.
254     C iMax
255     C jMin
256     C jMax
257     C kLev
258     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
259     _RL myTime
260     INTEGER myThid
261     CEndOfInterface
262    
263    
264     #ifdef ALLOW_AIM
265     C == Local variables ==
266     C Loop counters
267     INTEGER I, J
268    
269     C-- Forcing: add AIM dq/dt tendency to gS:
270     DO J=1,sNy
271     DO I=1,sNx
272     gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
273     & *( gS(i,j,kLev,bi,bj) + aim_dSdt(i,j,kLev,bi,bj) )
274     ENDDO
275     ENDDO
276    
277     #endif /* ALLOW_AIM */
278    
279     RETURN
280     END
  ViewVC Help
Powered by ViewVC 1.1.22