/[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.5 - (hide annotations) (download)
Tue Sep 25 19:53:57 2001 UTC (22 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: icebear2, checkpoint44h_pre, release1_p12, release1_p10, release1_p11, release1_p16, release1_p15, ecco_c44_e17, ecco_c44_e16, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, icebear5, icebear4, checkpoint44f_pre, icebear3, checkpoint46f_post, release1_p13_pre, checkpoint46d_pre, checkpoint46e_post, release1-branch_tutorials, release1_p14, checkpoint44g_post, checkpoint46h_pre, checkpoint44h_post, release1_p12_pre, checkpoint44e_post, checkpoint46e_pre, ecco-branch-mod4, checkpoint43a-release1mods, checkpoint45d_post, checkpoint45b_post, checkpoint46b_pre, chkpt44a_pre, release1-branch-end, release1_final_v1, ecco_c44_e19, checkpoint46, ecco_c44_e20, checkpoint44, release1_p13, ecco_c44_e18, checkpoint44f_post, release1_p17, release1_b1, checkpoint44b_post, chkpt44c_post, chkpt44d_post, checkpoint42, release1_p9, release1_p8, checkpoint43, checkpoint46g_pre, release1_p2, release1_p3, release1_p4, release1_p6, checkpoint46a_post, chkpt44a_post, checkpoint44b_pre, release1_p1, checkpoint46a_pre, ecco-branch-mod1, checkpoint45c_post, release1_p5, checkpoint44e_pre, chkpt44c_pre, release1_p7, ecco_ice2, ecco_ice1, checkpoint46b_post, checkpoint46d_post, ecco-branch-mod2, checkpoint46g_post, checkpoint45a_post, checkpoint46c_pre, ecco-branch-mod3, ecco-branch-mod5, ecco_c44_e22, release1_beta1, ecco_c44_e23, release1-branch_branchpoint, checkpoint46c_post, checkpoint45, checkpoint46h_post, release1_chkpt44d_post, ecco_c44_e25
Branch point for: c24_e25_ice, ecco-branch, release1_coupled, icebear, release1_final, release1-branch, release1, release1_50yr
Changes since 1.4: +76 -47 lines 
add a CPP option to turn back to old AIM Interface.
diagnostic of surface stress consistent with dynamical effects.
1 jmc 1.5 C $Header: /u/gcmpack/models/MITgcmUV/pkg/aim/aim_external_forcing.F,v 1.4 2001/08/24 00:49:51 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 cnh 1.3 IMPLICIT rEAL*8 (A-H,O-Z)
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     #ifdef ALLOW_AIM
24 cnh 1.3 #include "AIM2DYN.h"
25 jmc 1.5 #include "AIM_DIAGS.h"
26 adcroft 1.2 #endif /* ALLOW_AIM */
27    
28     C == Routine arguments ==
29     C iMin - Working range of tile for applying forcing.
30     C iMax
31     C jMin
32     C jMax
33     C kLev
34     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
35     _RL myCurrentTime
36     INTEGER myThid
37     CEndOfInterface
38    
39     #ifdef ALLOW_AIM
40     C == Local variables ==
41 jmc 1.5 C i,j - Loop counters
42 cnh 1.3 INTEGER i, j
43 jmc 1.5 _RL DDTT, uStr_tmp
44 adcroft 1.2
45 jmc 1.5 DDTT = deltaTclock
46 cnh 1.3
47 jmc 1.5 #ifdef OLD_AIM_INTERFACE
48 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
49 jmc 1.5 C - to reproduce old results (coupled run, summer 2000) :
50 cnh 1.3 IF (kLev.eq.1) THEN
51 jmc 1.5 DO j=jMin,jMax
52     DO i=iMin,iMax
53     uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
54     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
55     & + uStr_tmp*horiVertRatio*recip_drF(kLev)
56     #ifdef ALLOW_TIMEAVE
57     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
58     #endif
59 cnh 1.3 ENDDO
60 jmc 1.5 ENDDO
61 cnh 1.3 ELSE
62 jmc 1.5 DO j=jMin,jMax
63     DO i=iMin,iMax
64     IF ( maskW(i,j,kLev-1,bi,bj) .EQ. 0. ) THEN
65     uStr_tmp = -aim_drag(i,j,bi,bj)*uVel(i,j,kLev,bi,bj)
66     #ifdef ALLOW_TIMEAVE
67     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
68     #endif
69     C - put the same bug as in the old setup :
70     IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) uStr_tmp = 0.
71     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
72     & + uStr_tmp*horiVertRatio*recip_drF(kLev)
73     ENDIF
74 cnh 1.3 ENDDO
75 jmc 1.5 ENDDO
76 cnh 1.3 ENDIF
77 jmc 1.5 #else /* OLD_AIM_INTERFACE */
78 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
79     IF (kLev.eq.1) THEN
80     DO j=jMin,jMax
81     DO i=iMin,iMax
82     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
83 jmc 1.5 uStr_tmp =
84 cnh 1.3 & -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
85     & * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
86 jmc 1.5 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
87     & + uStr_tmp*horiVertRatio*recip_drF(kLev)
88     #ifdef ALLOW_TIMEAVE
89     USTRtave(i,j,bi,bj) = USTRtave(i,j,bi,bj) + uStr_tmp*DDTT
90     #endif
91 cnh 1.3 ENDIF
92     ENDDO
93     ENDDO
94     ELSE
95     DO j=jMin,jMax
96     DO i=iMin,iMax
97     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
98 jmc 1.5 uStr_tmp =
99 jmc 1.4 & -( (1.-maskC(i-1,j,kLev-1,bi,bj))*aim_drag(i-1,j,bi,bj)
100     & +(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
101     & )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
102 jmc 1.5 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
103     & + uStr_tmp*horiVertRatio*recip_drF(kLev)
104     #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     IMPLICIT rEAL*8 (A-H,O-Z)
127    
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     #ifdef ALLOW_AIM
136 cnh 1.3 #include "AIM2DYN.h"
137 jmc 1.5 #include "AIM_DIAGS.h"
138 adcroft 1.2 #endif /* ALLOW_AIM */
139    
140     C == Routine arguments ==
141     C iMin - Working range of tile for applying forcing.
142     C iMax
143     C jMin
144     C jMax
145     C kLev
146     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
147     _RL myCurrentTime
148     INTEGER myThid
149     CEndOfInterface
150    
151     #ifdef ALLOW_AIM
152     C == Local variables ==
153     C Loop counters
154 cnh 1.3 INTEGER i, j
155 jmc 1.5 _RL DDTT, vStr_tmp
156    
157     DDTT = deltaTclock
158 cnh 1.3
159     C call CHKSUM_TILED( ' drag AAA ',aim_drag,1,bi,bj,myThid )
160 adcroft 1.2
161 jmc 1.5 #ifdef OLD_AIM_INTERFACE
162 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
163 jmc 1.5 C - to reproduce old results (coupled run, summer 2000) :
164 cnh 1.3 IF (kLev.eq.1) THEN
165     DO j=jMin,jMax
166     DO i=iMin,iMax
167 jmc 1.5 vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
168 cnh 1.3 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
169 jmc 1.5 & + vStr_tmp*horiVertRatio*recip_drF(kLev)
170     #ifdef ALLOW_TIMEAVE
171     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
172     #endif
173 cnh 1.3 ENDDO
174     ENDDO
175     ELSE
176     DO j=jMin,jMax
177     DO i=iMin,iMax
178 jmc 1.5 IF ( maskS(i,j,kLev-1,bi,bj) .EQ. 0. ) THEN
179     vStr_tmp = -aim_drag(i,j,bi,bj)*vVel(i,j,kLev,bi,bj)
180     #ifdef ALLOW_TIMEAVE
181     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
182     #endif
183     C - put the same bug as in the old setup :
184     IF ( maskC(i,j,kLev-1,bi,bj) .EQ. 1. ) vStr_tmp = 0.
185 cnh 1.3 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
186 jmc 1.5 & + vStr_tmp*horiVertRatio*recip_drF(kLev)
187 cnh 1.3 ENDIF
188     ENDDO
189     ENDDO
190     ENDIF
191 jmc 1.5 #else /* OLD_AIM_INTERFACE */
192 cnh 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
193     IF (kLev.eq.1) THEN
194     DO j=jMin,jMax
195     DO i=iMin,iMax
196     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
197 jmc 1.5 vStr_tmp =
198 cnh 1.3 & -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
199     & * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
200 jmc 1.5 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
201     & + vStr_tmp*horiVertRatio*recip_drF(kLev)
202     #ifdef ALLOW_TIMEAVE
203     VSTRtave(i,j,bi,bj) = VSTRtave(i,j,bi,bj) + vStr_tmp*DDTT
204     #endif
205 cnh 1.3 ENDIF
206     ENDDO
207     ENDDO
208     ELSE
209     DO j=jMin,jMax
210     DO i=iMin,iMax
211     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
212 jmc 1.5 vStr_tmp =
213 cnh 1.3 & -( (1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
214     & +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
215     & )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
216 jmc 1.5 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
217     & + vStr_tmp*horiVertRatio*recip_drF(kLev)
218     #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 cnh 1.3 IMPLICIT rEAL*8 (A-H,O-Z)
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     #ifdef ALLOW_AIM
250     #include "atparam0.h"
251     #include "atparam1.h"
252     INTEGER NGP
253     INTEGER NLON
254     INTEGER NLAT
255     INTEGER NLEV
256     PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
257     #include "com_physvar.h"
258 cnh 1.3 #include "AIM2DYN.h"
259 adcroft 1.2 #endif
260    
261     C == Routine arguments ==
262     C iMin - Working range of tile for applying forcing.
263     C iMax
264     C jMin
265     C jMax
266     C kLev
267     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
268     _RL myCurrentTime
269     INTEGER myThid
270     CEndOfInterface
271    
272     #ifdef ALLOW_AIM
273     C == Local variables ==
274     C Loop counters
275 cnh 1.3 INTEGER I, J, I2, katm
276     _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
277 adcroft 1.2
278     C-- Forcing term
279     _RL pGround
280 cnh 1.3 _RL convert_fact
281 adcroft 1.2
282 cnh 1.3
283     C-- Forcing:
284     C- AIM heating/cooling tendencies terms: Convert to Pot.Temp and Add to gT
285 adcroft 1.2 pGround = 1. _d 5
286     RD = 287. _d 0
287     CPAIR = 1004. _d 0
288 cnh 1.3 katm = _KD2KA( Klev )
289     convert_fact = ((pGround/rC(kLev))**(RD/CPAIR))
290     DO J=1-OLy,sNy+OLy
291     DO I=1-OLx,sNx+OLx
292     C I2 = sNx*(J-1)+I
293     C phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
294     C & +convert_fact*(
295     C & TT_PBL(I2,katm)
296     C & +TT_CNV(I2,katm)
297     C & +TT_LSC(I2,katm)
298     C & +TT_RSW(I2,katm)
299     C & +TT_RLW(I2,katm)
300     C & )
301     phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
302     & +aim_dTdt(i,j,kLev,bi,bj)
303 adcroft 1.2 ENDDO
304     ENDDO
305    
306 cnh 1.3 C This can't stay here
307     C _EXCH_XY_R8( phiTemp , myThid)
308    
309     DO J=1-OLy,sNy+OLy
310     DO I=1-OLx,sNx+OLx
311     gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
312     ENDDO
313     ENDDO
314 adcroft 1.2
315     #endif /* ALLOW_AIM */
316    
317     RETURN
318     END
319     CStartOfInterface
320     SUBROUTINE AIM_EXTERNAL_FORCING_S(
321     I iMin, iMax, jMin, jMax,bi,bj,kLev,
322     I myCurrentTime,myThid)
323     C /==========================================================\
324     C | S/R AIM_EXTERNAL_FORCING_S |
325     C | o Add AIM tendency to S. |
326     C \==========================================================/
327 cnh 1.3 IMPLICIT rEAL*8 (A-H,O-Z)
328 adcroft 1.2
329     C == Global data ==
330     #include "SIZE.h"
331     #include "EEPARAMS.h"
332     #include "PARAMS.h"
333     #include "GRID.h"
334     #include "DYNVARS.h"
335    
336     #ifdef ALLOW_AIM
337     #include "atparam0.h"
338     #include "atparam1.h"
339     INTEGER NGP
340     INTEGER NLON
341     INTEGER NLAT
342     INTEGER NLEV
343     PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
344     #include "com_physvar.h"
345 cnh 1.3 #include "AIM2DYN.h"
346 adcroft 1.2 #endif
347    
348    
349     C == Routine arguments ==
350     C iMin - Working range of tile for applying forcing.
351     C iMax
352     C jMin
353     C jMax
354     C kLev
355     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
356     _RL myCurrentTime
357     INTEGER myThid
358     CEndOfInterface
359    
360 cnh 1.3
361 adcroft 1.2 #ifdef ALLOW_AIM
362     C == Local variables ==
363     C Loop counters
364 cnh 1.3 INTEGER I, J, I2, katm
365     _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
366 adcroft 1.2
367 cnh 1.3 katm = _KD2KA( kLev )
368     DO J=1-OLy,sNy+OLy
369     DO I=1-OLx,sNx+OLx
370 adcroft 1.2 I2 = sNx*(J-1)+I
371 cnh 1.3 C phiTemp(i,j,bi,bj) = gS(i,j,kLev,bi,bj)
372     C & +QT_PBL(I2,katm)
373     C & +QT_CNV(I2,katm)
374     C & +QT_LSC(I2,katm)
375     phiTemp(I,J,bi,bj) = gS(i,j,kLev,bi,bj)
376     & +aim_dSdt(i,j,kLev,bi,bj)
377 adcroft 1.2 ENDDO
378     ENDDO
379    
380 cnh 1.3 C This can't stay here
381     C _EXCH_XY_R8( phiTemp , myThid)
382     C _EXCH_XYZ_R8( gS , myThid)
383    
384     DO J=1-OLy,sNy+OLy
385     DO I=1-OLx,sNx+OLx
386     gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
387     ENDDO
388     ENDDO
389 adcroft 1.2
390     #endif /* ALLOW_AIM */
391    
392     RETURN
393     END
  ViewVC Help
Powered by ViewVC 1.1.22