forked from altMITgcm/MITgcm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
aim_do_physics.F
245 lines (205 loc) · 7.8 KB
/
aim_do_physics.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_physics.F,v 1.23 2013/09/11 20:19:11 jmc Exp $
C $Name: $
#include "AIM_OPTIONS.h"
CBOP
C !ROUTINE: AIM_DO_PHYSICS
C !INTERFACE:
SUBROUTINE AIM_DO_PHYSICS( myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==================================================================*
C | S/R AIM_DO_PHYSICS
C *==================================================================*
C | Interface between atmospheric physics package and the
C | dynamical model.
C | Routine calls physics pacakge after setting surface BC.
C | Package should derive and set tendency terms
C | which can be included as external forcing terms in the dynamical
C | tendency routines. Packages should communicate this information
C | through common blocks.
C *==================================================================*
C \ev
C !USES:
IMPLICIT NONE
C -------------- Global variables ------------------------------------
C-- size for MITgcm & Physics package :
#include "AIM_SIZE.h"
C-- MITgcm
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "GRID.h"
#include "SURFACE.h"
C-- Physics package
#include "AIM_PARAMS.h"
#include "AIM_FFIELDS.h"
#include "AIM_GRID.h"
#include "com_physvar.h"
#include "com_forcing.h"
#include "AIM2DYN.h"
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C myTime :: Current time in simulation (s)
C myIter :: Current iteration number
C myThid :: My Thread Id. number
_RL myTime
INTEGER myIter
INTEGER myThid
CEOP
#ifdef ALLOW_AIM
C !FUNCTIONS:
C !LOCAL VARIABLES:
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-- Local Variables originally (Speedy) in common bloc (com_forcing.h):
C-- COMMON /FORFIX/ Time invariant forcing fields (initialise in INFORC)
C phi0 :: surface geopotential
_RL phi0 (NGP)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C == Local variables ==
C bi,bj :: Tile indices
C i,j,k,I2 :: Loop counters
C tYear :: Fraction into year
C aim_sWght0 :: weight for time interpolation of surface BC
C aim_sWght1 :: 0/1 = time period before/after the current time
C prcAtm :: total precip from the atmosphere [kg/m2/s]
C snowPr :: snow precipitation [kg/m2/s]
INTEGER bi,bj
INTEGER i,j,k,I2
_RL tYear, yearLength
_RL aim_sWght0, aim_sWght1
_RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
_RL snowPr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#ifdef ALLOW_THSICE
_RL qPrcRn(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#ifdef ALLOW_AIM_CO2
CALL AIM_DO_CO2( myTime, myIter, myThid )
#endif
C-- Start loops on tile indices
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
C_jmc: Because AIM physics LSC is not applied in the stratosphere (top level),
C ==> move water wapor from the stratos to the surface level.
DO j = 1-OLy, sNy+OLy
DO i = 1-OLx, sNx+OLx
k = kSurfC(i,j,bi,bj)
IF (k.LE.Nr)
& salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
& + salt(i,j,Nr,bi,bj)*drF(Nr)*recip_drF(k)
& *hFacC(i,j,Nr,bi,bj)*recip_hFacC(i,j,k,bi,bj)
salt(i,j,Nr,bi,bj) = 0.
ENDDO
ENDDO
#ifdef OLD_THSICE_CALL_SEQUENCE
#ifdef ALLOW_THSICE
IF ( useThSIce ) THEN
C- do sea-ice advection before setting any surface BC.
CALL THSICE_DO_ADVECT(
I bi, bj, myTime, myIter, myThid )
ENDIF
#endif /* ALLOW_THSICE */
#endif /* OLD_THSICE_CALL_SEQUENCE */
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C- Physics package needs to know time of year as a fraction
yearLength = 86400.*360.
tYear = MOD(myTime/yearLength, 1. _d 0)
C-- Set surface Boundary Conditions for atmos. physics package:
C (Albedo, Soil moisture, Surf Temp, Land sea mask)
C includes some parts of S/R FORDATE from F.Molteni SPEDDY code (ver23)
CALL AIM_SURF_BC(
U tYear,
O aim_sWght0, aim_sWght1,
I bi, bj, myTime, myIter, myThid )
C-- Set surface geopotential: (g * orographic height)
DO j=1,sNy
DO i=1,sNx
I2 = i+(j-1)*sNx
PHI0(I2) = gravity*topoZ(i,j,bi,bj)
ENDDO
ENDDO
C-- Set topographic dependent FOROG var (originally in common SFLFIX);
C used to compute for wind stress over land
c_FM IF (IDAY.EQ.0) THEN
c_FM CALL SFLSET (PHIS0)
CALL SFLSET (PHI0, fOrogr(1,myThid), bi,bj,myThid)
c_FM ENDIF
c_FM CALL SOL_OZ (SOLC,TYEAR)
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C- Compute atmospheric-physics tendencies (call the main AIM S/R)
CALL PHY_DRIVER( tYear, useDiagnostics,
I bi, bj, myTime, myIter, myThid )
CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )
#ifdef ALLOW_LAND
IF (useLand) THEN
C- prepare Surface flux over land for land package
CALL AIM_AIM2LAND( aim_landFr, bi, bj,
I myTime, myIter, myThid )
C- Step forward land model
CALL LAND_STEPFWD( aim_landFr, bi, bj,
I myTime, myIter, myThid )
C- Land diagnostics : write snap-shot & cumulate for TimeAve output
CALL LAND_DO_DIAGS( aim_landFr, bi, bj,
I myTime, myIter, myThid )
ENDIF
#endif /* ALLOW_LAND */
C- surface fluxes over ocean (ice-free & ice covered)
C used for diagnostics, thsice package and coupler
CALL AIM_AIM2SIOCE( aim_landFr, fmask1(1,3,myThid),
O prcAtm, snowPr,
I bi, bj, myTime, myIter, myThid )
#ifdef ALLOW_THSICE
IF ( useThSIce ) THEN
C- Step forward sea-ice model
DO j = 1-OLy, sNy+OLy
DO i = 1-OLx, sNx+OLx
qPrcRn(i,j) = 0.
ENDDO
ENDDO
CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,
I prcAtm, snowPr, qPrcRn,
I myTime, myIter, myThid )
ENDIF
#endif /* ALLOW_THSICE */
C- AIM diagnostics : write snap-shot & cumulate for TimeAve output
CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )
C-- end bi,bj loops.
ENDDO
ENDDO
#ifdef ALLOW_THSICE
IF ( useThSIce ) THEN
#ifndef OLD_THSICE_CALL_SEQUENCE
C-- Exchange fields that are advected by seaice dynamics
CALL THSICE_DO_EXCH( myThid )
C- do sea-ice advection after sea-ice thermodynamics
CALL THSICE_DO_ADVECT(
I 0, 0, myTime, myIter, myThid )
#endif /* ndef OLD_THSICE_CALL_SEQUENCE */
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
C- Slab Ocean : step forward ocean mixed-layer temp. & salinity
CALL THSICE_SLAB_OCEAN(
I aim_sWght0, aim_sWght1,
O dTsurf(1,2,myThid),
I bi, bj, myTime, myIter, myThid )
ENDDO
ENDDO
ENDIF
#endif /* ALLOW_THSICE */
C-- do exchanges for AIM related quantities:
_EXCH_XY_RL( aim_drag, myThid )
#ifdef OLD_THSICE_CALL_SEQUENCE
#ifdef ALLOW_THSICE
IF (useThSIce) THEN
C-- Exchange fields that are advected by seaice dynamics
CALL THSICE_DO_EXCH( myThid )
ENDIF
#endif
#endif /* OLD_THSICE_CALL_SEQUENCE */
#ifdef COMPONENT_MODULE
IF ( useCoupler ) THEN
CALL ATM_STORE_MY_DATA( myTime, myIter, myThid )
ENDIF
#endif /* COMPONENT_MODULE */
#endif /* ALLOW_AIM */
RETURN
END