/[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.3 - (hide annotations) (download)
Tue May 29 19:28:53 2001 UTC (23 years ago) by cnh
Branch: MAIN
CVS Tags: checkpoint40pre1, checkpoint40pre2, checkpoint40pre5, checkpoint40pre6, checkpoint40pre8, checkpoint40pre4, checkpoint40pre3, checkpoint40pre7
Changes since 1.2: +173 -68 lines 
Updates for multi-threaded AIM with support for both latlon
and CS.
Needs compatible changes to verfication/
1 cnh 1.3 C $Header: /u/gcmpack/models/MITgcmUV/verification/aim.5l_LatLon/code/Attic/aim_external_forcing.F,v 1.1.2.2 2001/04/17 01:11:45 jmc Exp $
2     C $Name: $
3 adcroft 1.2
4     #include "AIM_OPTIONS.h"
5 cnh 1.3 #undef OLD_AIM_GRIG_MAPPING
6 adcroft 1.2
7     CStartOfInterface
8     SUBROUTINE AIM_EXTERNAL_FORCING_U(
9     I iMin, iMax, jMin, jMax,bi,bj,kLev,
10     I myCurrentTime,myThid)
11     C /==========================================================\
12     C | S/R AIM_EXTERNAL_FORCING_U |
13     C | o Add AIM tendency terms to U tendency. |
14     C \==========================================================/
15 cnh 1.3 IMPLICIT rEAL*8 (A-H,O-Z)
16 adcroft 1.2
17     C == Global data ==
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21     #include "GRID.h"
22     #include "DYNVARS.h"
23    
24     #ifdef ALLOW_AIM
25 cnh 1.3 #include "AIM2DYN.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     C Loop counters
42 cnh 1.3 INTEGER i, j
43 adcroft 1.2
44 cnh 1.3
45     #ifdef OLD_AIM_GRIG_MAPPING
46     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
47     c - to reproduce old results :
48     IF (kLev.eq.1) THEN
49     DO j=jMin,jMax
50     DO i=iMin,iMax
51     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
52     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
53     & -aim_drag(i-1,j,bi,bj)
54     & *0.25*(uVel(i-1,j,kLev,bi,bj)+uVel(i,j,kLev,bi,bj))
55     & -aim_drag(i,j,bi,bj)
56     & *0.25*(uVel(i,j,kLev,bi,bj)+uVel(i+1,j,kLev,bi,bj))
57     ENDIF
58     ENDDO
59     ENDDO
60     ELSE
61     DO j=jMin,jMax
62     DO i=iMin,iMax
63     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
64     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
65     & -(1.-maskC(i-1,j,kLev-1,bi,bj))*aim_drag(i-1,j,bi,bj)
66     & *0.25*(uVel(i-1,j,kLev,bi,bj)+uVel(i,j,kLev,bi,bj))
67     & -(1.-maskC( i ,j,kLev-1,bi,bj))*aim_drag( i ,j,bi,bj)
68     & *0.25*(uVel(i,j,kLev,bi,bj)+uVel(i+1,j,kLev,bi,bj))
69     ENDIF
70     ENDDO
71     ENDDO
72     ENDIF
73     #else /* OLD_AIM_GRIG_MAPPING */
74     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
75     IF (kLev.eq.1) THEN
76     DO j=jMin,jMax
77     DO i=iMin,iMax
78     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
79     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
80     & -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
81     & * 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
82     ENDIF
83     ENDDO
84     ENDDO
85     ELSE
86     DO j=jMin,jMax
87     DO i=iMin,iMax
88     IF ( hFacW(i,j,kLev,bi,bj) .NE. 0. ) THEN
89     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
90     & -( (1.-maskC(i-1,j,kLev-1,bi,bj))
91     & *aim_drag(i-1,j,bi,bj)*0.0
92     & +(1.-maskC( i ,j,kLev-1,bi,bj))
93     & *aim_drag( i ,j,bi,bj)*0.0
94     & )* 0.5 _d 0 * uVel(i,j,kLev,bi,bj)
95     ENDIF
96     ENDDO
97 adcroft 1.2 ENDDO
98 cnh 1.3 ENDIF
99     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
100     #endif /* OLD_AIM_GRIG_MAPPING */
101 adcroft 1.2
102     #endif /* ALLOW_AIM */
103    
104     RETURN
105     END
106     CStartOfInterface
107     SUBROUTINE AIM_EXTERNAL_FORCING_V(
108     I iMin, iMax, jMin, jMax,bi,bj,kLev,
109     I myCurrentTime,myThid)
110     C /==========================================================\
111     C | S/R EXTERNAL_FORCING_V |
112     C | o Add AIM tendency to meridional velocity. |
113     C \==========================================================/
114     IMPLICIT rEAL*8 (A-H,O-Z)
115    
116     C == Global data ==
117     #include "SIZE.h"
118     #include "EEPARAMS.h"
119     #include "PARAMS.h"
120     #include "GRID.h"
121     #include "DYNVARS.h"
122     #include "FFIELDS.h"
123    
124     #ifdef ALLOW_AIM
125 cnh 1.3 #include "AIM2DYN.h"
126 adcroft 1.2 #endif /* ALLOW_AIM */
127    
128     C == Routine arguments ==
129     C iMin - Working range of tile for applying forcing.
130     C iMax
131     C jMin
132     C jMax
133     C kLev
134     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
135     _RL myCurrentTime
136     INTEGER myThid
137     CEndOfInterface
138    
139     #ifdef ALLOW_AIM
140     C == Local variables ==
141     C Loop counters
142 cnh 1.3 INTEGER i, j
143    
144     C call CHKSUM_TILED( ' drag AAA ',aim_drag,1,bi,bj,myThid )
145 adcroft 1.2
146 cnh 1.3 #ifdef OLD_AIM_GRIG_MAPPING
147     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
148     c - to reproduce old results :
149     IF (kLev.eq.1) THEN
150     DO j=jMin,jMax
151     DO i=iMin,iMax
152     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
153     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
154     & -aim_drag(i,j-1,bi,bj)
155     & *0.25*(vVel(i,j-1,kLev,bi,bj)+vVel(i,j,kLev,bi,bj))
156     & -aim_drag(i,j,bi,bj)
157     & *0.25*(vVel(i,j,kLev,bi,bj)+vVel(i,j+1,kLev,bi,bj))
158     ENDIF
159     ENDDO
160     ENDDO
161     ELSE
162     DO j=jMin,jMax
163     DO i=iMin,iMax
164     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
165     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
166     & -(1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
167     & *0.25*(vVel(i,j-1,kLev,bi,bj)+vVel(i,j,kLev,bi,bj))
168     & -(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
169     & *0.25*(vVel(i,j,kLev,bi,bj)+vVel(i,j+1,kLev,bi,bj))
170     ENDIF
171     ENDDO
172     ENDDO
173     ENDIF
174     #else /* OLD_AIM_GRIG_MAPPING */
175     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
176     IF (kLev.eq.1) THEN
177     DO j=jMin,jMax
178     DO i=iMin,iMax
179     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
180     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
181     & -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
182     & * 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
183     ENDIF
184     ENDDO
185     ENDDO
186     ELSE
187     DO j=jMin,jMax
188     DO i=iMin,iMax
189     IF ( hFacS(i,j,kLev,bi,bj) .NE. 0. ) THEN
190     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
191     & -( (1.-maskC(i,j-1,kLev-1,bi,bj))*aim_drag(i,j-1,bi,bj)
192     & +(1.-maskC(i, j ,kLev-1,bi,bj))*aim_drag(i, j ,bi,bj)
193     & )* 0.5 _d 0 * vVel(i,j,kLev,bi,bj)
194     ENDIF
195     ENDDO
196 adcroft 1.2 ENDDO
197 cnh 1.3 ENDIF
198     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
199     #endif /* OLD_AIM_GRIG_MAPPING */
200 adcroft 1.2
201     #endif /* ALLOW_AIM */
202    
203     RETURN
204     END
205     CStartOfInterface
206     SUBROUTINE AIM_EXTERNAL_FORCING_T(
207     I iMin, iMax, jMin, jMax,bi,bj,kLev,
208     I myCurrentTime,myThid)
209     C /==========================================================\
210     C | S/R AIM_EXTERNAL_FORCING_T |
211     C | o Add AIM tendency to T |
212     C \==========================================================/
213 cnh 1.3 IMPLICIT rEAL*8 (A-H,O-Z)
214 adcroft 1.2
215     C == Global data ==
216     #include "SIZE.h"
217     #include "EEPARAMS.h"
218     #include "PARAMS.h"
219     #include "GRID.h"
220     #include "DYNVARS.h"
221    
222     #ifdef ALLOW_AIM
223     #include "atparam0.h"
224     #include "atparam1.h"
225     INTEGER NGP
226     INTEGER NLON
227     INTEGER NLAT
228     INTEGER NLEV
229     PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
230     #include "com_physvar.h"
231 cnh 1.3 #include "AIM2DYN.h"
232 adcroft 1.2 #endif
233    
234     C == Routine arguments ==
235     C iMin - Working range of tile for applying forcing.
236     C iMax
237     C jMin
238     C jMax
239     C kLev
240     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
241     _RL myCurrentTime
242     INTEGER myThid
243     CEndOfInterface
244    
245     #ifdef ALLOW_AIM
246     C == Local variables ==
247     C Loop counters
248 cnh 1.3 INTEGER I, J, I2, katm
249     _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
250 adcroft 1.2
251     C-- Forcing term
252     _RL pGround
253 cnh 1.3 _RL convert_fact
254 adcroft 1.2
255 cnh 1.3
256     C-- Forcing:
257     C- AIM heating/cooling tendencies terms: Convert to Pot.Temp and Add to gT
258 adcroft 1.2 pGround = 1. _d 5
259     RD = 287. _d 0
260     CPAIR = 1004. _d 0
261 cnh 1.3 katm = _KD2KA( Klev )
262     convert_fact = ((pGround/rC(kLev))**(RD/CPAIR))
263     DO J=1-OLy,sNy+OLy
264     DO I=1-OLx,sNx+OLx
265     C I2 = sNx*(J-1)+I
266     C phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
267     C & +convert_fact*(
268     C & TT_PBL(I2,katm)
269     C & +TT_CNV(I2,katm)
270     C & +TT_LSC(I2,katm)
271     C & +TT_RSW(I2,katm)
272     C & +TT_RLW(I2,katm)
273     C & )
274     phiTemp(I,J,bi,bj) = gT(i,j,kLev,bi,bj)
275     & +aim_dTdt(i,j,kLev,bi,bj)
276 adcroft 1.2 ENDDO
277     ENDDO
278    
279 cnh 1.3 C This can't stay here
280     C _EXCH_XY_R8( phiTemp , myThid)
281    
282     DO J=1-OLy,sNy+OLy
283     DO I=1-OLx,sNx+OLx
284     gT(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
285     ENDDO
286     ENDDO
287 adcroft 1.2
288     #endif /* ALLOW_AIM */
289    
290     RETURN
291     END
292     CStartOfInterface
293     SUBROUTINE AIM_EXTERNAL_FORCING_S(
294     I iMin, iMax, jMin, jMax,bi,bj,kLev,
295     I myCurrentTime,myThid)
296     C /==========================================================\
297     C | S/R AIM_EXTERNAL_FORCING_S |
298     C | o Add AIM tendency to S. |
299     C \==========================================================/
300 cnh 1.3 IMPLICIT rEAL*8 (A-H,O-Z)
301 adcroft 1.2
302     C == Global data ==
303     #include "SIZE.h"
304     #include "EEPARAMS.h"
305     #include "PARAMS.h"
306     #include "GRID.h"
307     #include "DYNVARS.h"
308    
309     #ifdef ALLOW_AIM
310     #include "atparam0.h"
311     #include "atparam1.h"
312     INTEGER NGP
313     INTEGER NLON
314     INTEGER NLAT
315     INTEGER NLEV
316     PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
317     #include "com_physvar.h"
318 cnh 1.3 #include "AIM2DYN.h"
319 adcroft 1.2 #endif
320    
321    
322     C == Routine arguments ==
323     C iMin - Working range of tile for applying forcing.
324     C iMax
325     C jMin
326     C jMax
327     C kLev
328     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
329     _RL myCurrentTime
330     INTEGER myThid
331     CEndOfInterface
332    
333 cnh 1.3
334 adcroft 1.2 #ifdef ALLOW_AIM
335     C == Local variables ==
336     C Loop counters
337 cnh 1.3 INTEGER I, J, I2, katm
338     _RL phiTemp( 1-OLx:sNx+OLx, 1-OLy:sNy+OLy,nSx,nSy)
339 adcroft 1.2
340 cnh 1.3 katm = _KD2KA( kLev )
341     DO J=1-OLy,sNy+OLy
342     DO I=1-OLx,sNx+OLx
343 adcroft 1.2 I2 = sNx*(J-1)+I
344 cnh 1.3 C phiTemp(i,j,bi,bj) = gS(i,j,kLev,bi,bj)
345     C & +QT_PBL(I2,katm)
346     C & +QT_CNV(I2,katm)
347     C & +QT_LSC(I2,katm)
348     phiTemp(I,J,bi,bj) = gS(i,j,kLev,bi,bj)
349     & +aim_dSdt(i,j,kLev,bi,bj)
350 adcroft 1.2 ENDDO
351     ENDDO
352    
353 cnh 1.3 C This can't stay here
354     C _EXCH_XY_R8( phiTemp , myThid)
355     C _EXCH_XYZ_R8( gS , myThid)
356    
357     DO J=1-OLy,sNy+OLy
358     DO I=1-OLx,sNx+OLx
359     gS(i,j,kLev,bi,bj) = maskC(i,j,kLev,bi,bj)*phiTemp(I,J,bi,bj)
360     ENDDO
361     ENDDO
362 adcroft 1.2
363     #endif /* ALLOW_AIM */
364    
365     RETURN
366     END
  ViewVC Help
Powered by ViewVC 1.1.22