/[MITgcm]/MITgcm/pkg/aim/aim_external_forcing.F
ViewVC logotype

Annotation of /MITgcm/pkg/aim/aim_external_forcing.F

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


Revision 1.6 - (hide annotations) (download)
Fri Sep 27 20:05:11 2002 UTC (21 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint48f_post, checkpoint51k_post, checkpoint53f_post, checkpoint47j_post, checkpoint54a_pre, checkpoint55c_post, checkpoint53b_pre, checkpoint48d_pre, checkpoint51l_post, checkpoint51j_post, branch-exfmods-tag, checkpoint47e_post, checkpoint57m_post, checkpoint52l_pre, checkpoint48i_post, checkpoint52e_pre, hrcube4, hrcube5, checkpoint57g_pre, checkpoint52j_post, checkpoint47f_post, checkpoint48d_post, checkpoint51o_pre, checkpoint57f_post, checkpoint46j_post, checkpoint47c_post, checkpoint50e_post, checkpoint52e_post, checkpoint50c_post, checkpoint46i_post, checkpoint51n_pre, checkpoint47d_post, checkpoint57j_post, checkpoint47a_post, checkpoint57b_post, checkpoint52d_pre, checkpoint53c_post, checkpoint53d_post, checkpoint57f_pre, checkpoint48a_post, checkpoint55d_pre, checkpoint51f_pre, checkpoint57g_post, checkpoint48e_post, checkpoint57c_pre, checkpoint48h_post, checkpoint55j_post, checkpoint56b_post, checkpoint50c_pre, checkpoint57h_pre, branchpoint-genmake2, checkpoint46k_post, checkpoint52j_pre, checkpoint54a_post, branch-netcdf, checkpoint50d_pre, checkpoint55h_post, checkpoint51r_post, checkpoint47i_post, checkpoint52b_pre, checkpoint52n_post, checkpoint54b_post, checkpoint46l_pre, checkpoint46j_pre, checkpoint51i_post, checkpoint57e_post, checkpoint54d_post, checkpoint47h_post, checkpoint48c_post, checkpoint46l_post, checkpoint56c_post, checkpoint54e_post, checkpoint55b_post, checkpoint51e_post, checkpoint51b_post, checkpoint51l_pre, checkpoint52m_post, checkpoint51c_post, checkpoint55, checkpoint53a_post, checkpoint55a_post, checkpoint57a_post, checkpoint48, checkpoint49, checkpoint47b_post, checkpoint56, checkpoint57o_post, checkpoint55g_post, checkpoint57h_done, checkpoint51o_post, checkpoint48g_post, checkpoint57k_post, checkpoint57d_post, checkpoint55f_post, checkpoint57i_post, checkpoint51q_post, checkpoint52l_post, checkpoint52k_post, checkpoint57h_post, checkpoint57a_pre, checkpoint54, checkpoint57, checkpoint53b_post, checkpoint51, checkpoint50, checkpoint53, checkpoint52, checkpoint50d_post, checkpoint52d_post, checkpoint51b_pre, checkpoint52a_post, checkpoint47g_post, checkpoint52b_post, checkpoint53g_post, checkpoint52f_post, checkpoint57n_post, checkpoint52c_post, checkpoint46m_post, checkpoint57p_post, checkpoint51h_pre, checkpoint50g_post, checkpoint50b_pre, checkpoint51g_post, ecco_c52_e35, checkpoint54f_post, checkpoint51f_post, checkpoint48b_post, checkpoint50b_post, eckpoint57e_pre, checkpoint57c_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint52a_pre, checkpoint47d_pre, checkpoint51d_post, checkpoint48c_pre, checkpoint51m_post, checkpoint51t_post, checkpoint53d_pre, checkpoint47, checkpoint55e_post, checkpoint54c_post, checkpoint50h_post, checkpoint52i_post, checkpoint51a_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51p_post, checkpoint51n_post, checkpoint55i_post, checkpoint51i_pre, checkpoint57l_post, checkpoint52i_pre, checkpoint51u_post, checkpoint52h_pre, checkpoint52f_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint56a_post, checkpoint51s_post, checkpoint55d_post
Branch point for: netcdf-sm0, branch-genmake2, branch-nonh, tg2-branch, checkpoint51n_branch, branch-exfmods-curt
Changes since 1.5: +29 -96 lines
Clean up AIM package (and keep the results unchanged):
a) include CPP_OPTION and use IMPLICT NONE in all routines ;
  declare all the variables _RL ;
b) use _d 0 for all numerical constants in Physics package,
  so that the code works with g77 (and give the right answer)
c) use ifdef ALLOW_AIM everywhere so that the package can be
 compiled without increasing the memory size.
d) clean-up the AIM interface (remove commented lines, unused
  variables ...)

1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/aim/aim_external_forcing.F,v 1.5 2001/09/25 19:53:57 jmc Exp $
2 cnh 1.3 C $Name: $
3 adcroft 1.2
4     #include "AIM_OPTIONS.h"
5    
6     CStartOfInterface
7     SUBROUTINE AIM_EXTERNAL_FORCING_U(
8     I iMin, iMax, jMin, jMax,bi,bj,kLev,
9     I myCurrentTime,myThid)
10     C /==========================================================\
11     C | S/R AIM_EXTERNAL_FORCING_U |
12     C | o Add AIM tendency terms to U tendency. |
13     C \==========================================================/
14 jmc 1.6 IMPLICIT NONE
15 adcroft 1.2
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 cnh 1.3 #include "AIM2DYN.h"
24 jmc 1.5 #include "AIM_DIAGS.h"
25 adcroft 1.2
26     C == Routine arguments ==
27     C iMin - Working range of tile for applying forcing.
28     C iMax
29     C jMin
30     C jMax
31     C kLev
32     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
33     _RL myCurrentTime
34     INTEGER myThid
35     CEndOfInterface
36    
37     #ifdef ALLOW_AIM
38     C == Local variables ==
39 jmc 1.5 C i,j - Loop counters
40 cnh 1.3 INTEGER i, j
41 jmc 1.5 _RL DDTT, uStr_tmp
42 adcroft 1.2
43 jmc 1.5 DDTT = deltaTclock
44 cnh 1.3
45 jmc 1.5 #ifdef OLD_AIM_INTERFACE
46 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
47 jmc 1.5 C - to reproduce old results (coupled run, summer 2000) :
48 cnh 1.3 IF (kLev.eq.1) THEN
49 jmc 1.5 DO j=jMin,jMax
50     DO i=iMin,iMax
51     uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
52     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
53 jmc 1.6 & + uStr_tmp*gravity*recip_drF(kLev)
54 jmc 1.5 #ifdef ALLOW_TIMEAVE
55     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
56     #endif
57 cnh 1.3 ENDDO
58 jmc 1.5 ENDDO
59 cnh 1.3 ELSE
60 jmc 1.5 DO j=jMin,jMax
61     DO i=iMin,iMax
62     IF ( maskW(i,j,kLev-1,bi,bj) .EQ. 0. ) THEN
63     uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
64     #ifdef ALLOW_TIMEAVE
65     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
66     #endif
67     C - put the same bug as in the old setup :
68     IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) uStr_tmp = 0.
69     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
70 jmc 1.6 & + uStr_tmp*gravity*recip_drF(kLev)
71 jmc 1.5 ENDIF
72 cnh 1.3 ENDDO
73 jmc 1.5 ENDDO
74 cnh 1.3 ENDIF
75 jmc 1.5 #else /* OLD_AIM_INTERFACE */
76 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
77     IF (kLev.eq.1) THEN
78     DO j=jMin,jMax
79     DO i=iMin,iMax
80     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
81 jmc 1.5 uStr_tmp =
82 cnh 1.3 & -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
83     & * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
84 jmc 1.5 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
85 jmc 1.6 & + uStr_tmp*gravity*recip_drF(kLev)
86     c & * recip_hFacW(i,j,kLev,bi,bj)
87 jmc 1.5 #ifdef ALLOW_TIMEAVE
88     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
89     #endif
90 cnh 1.3 ENDIF
91     ENDDO
92     ENDDO
93     ELSE
94     DO j=jMin,jMax
95     DO i=iMin,iMax
96     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
97 jmc 1.5 uStr_tmp =
98 jmc 1.4 & -( (1.-maskC(i-1,j,kLev-1,bi,bj))*aim_drag(i-1,j,bi,bj)
99     & +(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
100     & )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
101 jmc 1.5 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
102 jmc 1.6 & + uStr_tmp*gravity*recip_drF(kLev)
103     c & * recip_hFacW(i,j,kLev,bi,bj)
104 jmc 1.5 #ifdef ALLOW_TIMEAVE
105     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
106     #endif
107 cnh 1.3 ENDIF
108     ENDDO
109 adcroft 1.2 ENDDO
110 cnh 1.3 ENDIF
111     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
112 jmc 1.5 #endif /* OLD_AIM_INTERFACE */
113 adcroft 1.2
114     #endif /* ALLOW_AIM */
115    
116     RETURN
117     END
118     CStartOfInterface
119     SUBROUTINE AIM_EXTERNAL_FORCING_V(
120     I iMin, iMax, jMin, jMax,bi,bj,kLev,
121     I myCurrentTime,myThid)
122     C /==========================================================\
123     C | S/R EXTERNAL_FORCING_V |
124     C | o Add AIM tendency to meridional velocity. |
125     C \==========================================================/
126 jmc 1.6 IMPLICIT NONE
127 adcroft 1.2
128     C == Global data ==
129     #include "SIZE.h"
130     #include "EEPARAMS.h"
131     #include "PARAMS.h"
132     #include "GRID.h"
133     #include "DYNVARS.h"
134    
135 cnh 1.3 #include "AIM2DYN.h"
136 jmc 1.5 #include "AIM_DIAGS.h"
137 adcroft 1.2
138     C == Routine arguments ==
139     C iMin - Working range of tile for applying forcing.
140     C iMax
141     C jMin
142     C jMax
143     C kLev
144     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
145     _RL myCurrentTime
146     INTEGER myThid
147     CEndOfInterface
148    
149     #ifdef ALLOW_AIM
150     C == Local variables ==
151     C Loop counters
152 cnh 1.3 INTEGER i, j
153 jmc 1.5 _RL DDTT, vStr_tmp
154    
155     DDTT = deltaTclock
156 cnh 1.3
157     C call CHKSUM_TILED( ' drag AAA ',aim_drag,1,bi,bj,myThid )
158 adcroft 1.2
159 jmc 1.5 #ifdef OLD_AIM_INTERFACE
160 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
161 jmc 1.5 C - to reproduce old results (coupled run, summer 2000) :
162 cnh 1.3 IF (kLev.eq.1) THEN
163     DO j=jMin,jMax
164     DO i=iMin,iMax
165 jmc 1.5 vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
166 cnh 1.3 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
167 jmc 1.6 & + vStr_tmp*gravity*recip_drF(kLev)
168 jmc 1.5 #ifdef ALLOW_TIMEAVE
169     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
170     #endif
171 cnh 1.3 ENDDO
172     ENDDO
173     ELSE
174     DO j=jMin,jMax
175     DO i=iMin,iMax
176 jmc 1.5 IF ( maskS(i,j,kLev-1,bi,bj) .EQ. 0. ) THEN
177     vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
178     #ifdef ALLOW_TIMEAVE
179     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
180     #endif
181     C - put the same bug as in the old setup :
182     IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) vStr_tmp = 0.
183 cnh 1.3 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
184 jmc 1.6 & + vStr_tmp*gravity*recip_drF(kLev)
185 cnh 1.3 ENDIF
186     ENDDO
187     ENDDO
188     ENDIF
189 jmc 1.5 #else /* OLD_AIM_INTERFACE */
190 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
191     IF (kLev.eq.1) THEN
192     DO j=jMin,jMax
193     DO i=iMin,iMax
194     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
195 jmc 1.5 vStr_tmp =
196 cnh 1.3 & -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
197     & * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
198 jmc 1.5 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
199 jmc 1.6 & + vStr_tmp*gravity*recip_drF(kLev)
200     c & * recip_hFacS(i,j,kLev,bi,bj)
201 jmc 1.5 #ifdef ALLOW_TIMEAVE
202     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
203     #endif
204 cnh 1.3 ENDIF
205     ENDDO
206     ENDDO
207     ELSE
208     DO j=jMin,jMax
209     DO i=iMin,iMax
210     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
211 jmc 1.5 vStr_tmp =
212 cnh 1.3 & -( (1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
213     & +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
214     & )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
215 jmc 1.5 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
216 jmc 1.6 & + vStr_tmp*gravity*recip_drF(kLev)
217     c & * recip_hFacS(i,j,kLev,bi,bj)
218 jmc 1.5 #ifdef ALLOW_TIMEAVE
219     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
220     #endif
221 cnh 1.3 ENDIF
222     ENDDO
223 adcroft 1.2 ENDDO
224 cnh 1.3 ENDIF
225     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
226 jmc 1.5 #endif /* OLD_AIM_INTERFACE */
227 adcroft 1.2
228     #endif /* ALLOW_AIM */
229    
230     RETURN
231     END
232     CStartOfInterface
233     SUBROUTINE AIM_EXTERNAL_FORCING_T(
234     I iMin, iMax, jMin, jMax,bi,bj,kLev,
235     I myCurrentTime,myThid)
236     C /==========================================================\
237     C | S/R AIM_EXTERNAL_FORCING_T |
238     C | o Add AIM tendency to T |
239     C \==========================================================/
240 jmc 1.6 IMPLICIT NONE
241 adcroft 1.2
242     C == Global data ==
243     #include "SIZE.h"
244     #include "EEPARAMS.h"
245     #include "PARAMS.h"
246     #include "GRID.h"
247     #include "DYNVARS.h"
248    
249 cnh 1.3 #include "AIM2DYN.h"
250 adcroft 1.2
251     C == Routine arguments ==
252     C iMin - Working range of tile for applying forcing.
253     C iMax
254     C jMin
255     C jMax
256     C kLev
257     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
258     _RL myCurrentTime
259     INTEGER myThid
260     CEndOfInterface
261    
262     #ifdef ALLOW_AIM
263     C == Local variables ==
264     C Loop counters
265 jmc 1.6 INTEGER I, J
266 cnh 1.3
267 jmc 1.6 C-- Forcing: add AIM heating/cooling tendency to gT:
268     DO J=1,sNy
269     DO I=1,sNx
270     gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
271     & *( gT(i,j,kLev,bi,bj) + aim_dTdt(i,j,kLev,bi,bj) )
272 cnh 1.3 ENDDO
273     ENDDO
274 adcroft 1.2
275     #endif /* ALLOW_AIM */
276    
277     RETURN
278     END
279     CStartOfInterface
280     SUBROUTINE AIM_EXTERNAL_FORCING_S(
281     I iMin, iMax, jMin, jMax,bi,bj,kLev,
282     I myCurrentTime,myThid)
283     C /==========================================================\
284     C | S/R AIM_EXTERNAL_FORCING_S |
285     C | o Add AIM tendency to S. |
286     C \==========================================================/
287 jmc 1.6 IMPLICIT NONE
288 adcroft 1.2
289     C == Global data ==
290     #include "SIZE.h"
291     #include "EEPARAMS.h"
292     #include "PARAMS.h"
293     #include "GRID.h"
294     #include "DYNVARS.h"
295    
296 cnh 1.3 #include "AIM2DYN.h"
297 adcroft 1.2
298     C == Routine arguments ==
299     C iMin - Working range of tile for applying forcing.
300     C iMax
301     C jMin
302     C jMax
303     C kLev
304     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
305     _RL myCurrentTime
306     INTEGER myThid
307     CEndOfInterface
308    
309 cnh 1.3
310 adcroft 1.2 #ifdef ALLOW_AIM
311     C == Local variables ==
312     C Loop counters
313 jmc 1.6 INTEGER I, J
314 adcroft 1.2
315 jmc 1.6 C-- Forcing: add AIM dq/dt tendency to gS:
316     DO J=1,sNy
317     DO I=1,sNx
318     gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)
319     & *( gS(i,j,kLev,bi,bj) + aim_dSdt(i,j,kLev,bi,bj) )
320 cnh 1.3 ENDDO
321     ENDDO
322 adcroft 1.2
323     #endif /* ALLOW_AIM */
324    
325     RETURN
326     END

  ViewVC Help
Powered by ViewVC 1.1.22