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

Contents of /MITgcm/pkg/aim_v23/phy_suflux.F

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


Revision 1.1 - (show annotations) (download)
Fri Nov 22 17:17:03 2002 UTC (21 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint47j_post, checkpoint48d_pre, branch-exfmods-tag, checkpoint47e_post, checkpoint47i_post, checkpoint47f_post, checkpoint50e_post, checkpoint50c_post, checkpoint47d_post, checkpoint47a_post, checkpoint48e_post, checkpoint48d_post, checkpoint48f_post, checkpoint48c_post, checkpoint47d_pre, checkpoint48, checkpoint49, checkpoint47b_post, checkpoint48i_post, checkpoint48h_post, checkpoint50d_pre, checkpoint50, checkpoint47h_post, checkpoint50d_post, checkpoint47g_post, checkpoint50c_pre, checkpoint50b_pre, checkpoint48b_post, checkpoint50b_post, checkpoint50a_post, checkpoint48c_pre, checkpoint50e_pre, checkpoint48g_post, checkpoint48a_post
Branch point for: branch-exfmods-curt
new aim pkg: adapted from Franco Molteni SPEEDY code, ver23

1 C $Header: $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 SUBROUTINE SUFLUX (PSA,TA,QA,RH,Vsurf2,WVS,CLAT,FOROG,
7 I FMASK,TLAND,TSEA,SWAV,SSR,SLRD,
8 O SPEED0,DRAG,SHF,EVAP,SLRU,
9 O TSFC,TSKIN,T0,Q0,
10 I kGrd,bi,bj,myThid)
11 C--
12 C-- SUBROUTINE SUFLUX (PSA,UA,VA,TA,QA,RH,PHI,
13 C-- & PHI0,FMASK,TLAND,TSEA,SWAV,SSR,SLRD,
14 C-- & USTR,VSTR,SHF,EVAP,SLRU,
15 C-- & TSFC,TSKIN,U0,V0,T0,Q0)
16 C--
17 C-- Purpose: Compute surface fluxes of momentum, energy and moisture,
18 C-- and define surface skin temperature from energy balance
19 C-- Input: PSA = norm. surface pressure [p/p0] (2-dim)
20 C-- UA = u-wind (3-dim)
21 C-- VA = v-wind (3-dim)
22 C-- TA = temperature (3-dim)
23 C-- QA = specific humidity [g/kg] (3-dim)
24 C-- RH = relative humidity [0-1] (3-dim)
25 C Vsurf2 = square of surface wind speed (2-dim,input)
26 C ==> UA,VA are no longer used
27 C WVS = weights for near surf interp (2-dim)
28 C CLAT = cos(lat) (2-dim)
29 C FOROG = orographic factor (surf. drag) (2-dim)
30 C-- PHI = geopotential (3-dim)
31 C-- PHI0 = surface geopotential (2-dim)
32 C-- FMASK = fractional land-sea mask (2-dim)
33 C-- TLAND = land-surface temperature (2-dim)
34 C-- TSEA = sea-surface temperature (2-dim)
35 C-- SWAV = soil wetness availability [0-1] (2-dim)
36 C-- SSR = sfc sw radiation (net flux) (2-dim)
37 C-- SLRD = sfc lw radiation (downward flux)(2-dim)
38 C-- Output: SPEED0 = effective surface wind speed (2-dim)
39 C DRAG = surface Drag term (= Cd*Rho*|V|)(2-dim)
40 C ==> USTR,VSTR are no longer used
41 C-- USTR = u stress (2-dim)
42 C-- VSTR = v stress (2-dim)
43 C-- SHF = sensible heat flux (2-dim)
44 C-- EVAP = evaporation [g/(m^2 s)] (2-dim)
45 C-- SLRU = sfc lw radiation (upward flux) (2-dim)
46 C-- TSFC = surface temperature (clim.) (2-dim)
47 C-- TSKIN = skin surface temperature (2-dim)
48 C-- U0 = near-surface u-wind (2-dim)
49 C-- V0 = near-surface v-wind (2-dim)
50 C-- T0 = near-surface air temperature (2-dim)
51 C-- Q0 = near-surface sp. humidity [g/kg](2-dim)
52 C Input: kGrd = Ground level index (2-dim)
53 C bi,bj = tile index
54 C myThid = Thread number for this instance of the routine
55 C--
56
57 IMPLICIT NONE
58
59 C Resolution parameters
60
61 C-- size for MITgcm & Physics package :
62 #include "AIM_SIZE.h"
63
64 #include "EEPARAMS.h"
65
66 C Physical constants + functions of sigma and latitude
67 #include "com_physcon.h"
68
69 C Surface flux constants
70 #include "com_sflcon.h"
71
72 C-- Routine arguments:
73 _RL PSA(NGP), TA(NGP,NLEV), QA(NGP,NLEV), RH(NGP,NLEV)
74 _RL Vsurf2(NGP), WVS(NGP), CLAT(NGP), FOROG(NGP)
75 _RL FMASK(NGP), TLAND(NGP), TSEA(NGP), SWAV(NGP)
76 _RL SSR(NGP), SLRD(NGP)
77
78 _RL SPEED0(NGP), DRAG(NGP,3), SHF(NGP,3), EVAP(NGP,3)
79 _RL SLRU(NGP), TSFC(NGP), TSKIN(NGP), T0(NGP), Q0(NGP)
80
81 INTEGER kGrd(NGP)
82 INTEGER bi,bj,myThid
83
84 #ifdef ALLOW_AIM
85
86 C-- Local variables:
87 _RL T1(NGP), QSAT0(NGP,2), DENVV(NGP), CDENVV(NGP,2)
88
89 INTEGER J, K, Ktmp, NL1
90 _RL tmpRH(NGP)
91 _RL factWind2, kappa
92
93 C- jmc: declare all local variables:
94 _RL GTEMP0, GHUM0, RCP, PRD, VG2, RDTH
95 _RL FSLAND, FSSEA, QDUMMY, RDUMMY, TL4, TS4
96 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
97
98 C-- 1. Extrapolation of wind, temp, hum. and density to the surface
99
100 C 1.1 Wind components
101
102 c DO J=1,NGP
103 c U0(J) = 0.0
104 c V0(J) = 0.0
105 c Ktmp = kGrd(J)
106 c IF ( Ktmp.GT.0 ) THEN
107 c U0(J) = FWIND0*UA(J,Ktmp)
108 c V0(J) = FWIND0*VA(J,Ktmp)
109 c ENDIF
110 c ENDDO
111
112 C 1.2 Temperature
113
114 GTEMP0 = 1.-FTEMP0
115 RCP = 1. _d 0 /CP
116 kappa = RD/CP
117 C
118 DO J=1,NGP
119 Ktmp = kGrd(J)
120 NL1 = Ktmp-1
121 IF ( Ktmp.GT.1 ) THEN
122 c_FM T0(J) = TA(J,NLEV)+WVI(NLEV,2)*(TA(J,NLEV)-TA(J,NL1))
123 c_FM T1(J) = TA(J,NLEV)+RCP*(PHI(J,NLEV)-PHI0(J))
124 T0(J) = TA(J,Ktmp) + WVS(J)*(TA(J,Ktmp)-TA(J,NL1))
125 T1(J) = TA(J,Ktmp)*(SIGH(Ktmp)/SIG(Ktmp))**kappa
126 c T1(J) = TA(J,Ktmp)*(1.+kappa*0.5 _d 0*DSIG(Ktmp)/SIG(Ktmp) )
127 tmpRH(J)=RH(J,Ktmp)
128 ELSE
129 T0(J) = 273.16 _d 0
130 T1(J) = 273.16 _d 0
131 tmpRH(J)= 0.
132 ENDIF
133 ENDDO
134
135 DO J=1,NGP
136 T0(J) = FTEMP0*T0(J)+GTEMP0*T1(J)
137 ENDDO
138
139 C 1.3 Spec. humidity
140
141 GHUM0 = 1.-FHUM0
142
143 CALL SHTORH (-1,NGP,T0, PSA, 1. _d 0, Q0, tmpRH, QSAT0, myThid)
144
145 DO J=1,NGP
146 IF ( kGrd(J) .GT. 0 ) THEN
147 Q0(J)=FHUM0*Q0(J)+GHUM0*QA(J,kGrd(J))
148 ENDIF
149 ENDDO
150
151 C 1.4 Density * wind speed (including gustiness factor)
152
153 PRD = P0/RD
154 VG2 = VGUST*VGUST
155 factWind2 = FWIND0*FWIND0
156
157 DO J=1,NGP
158 c_FM DENVV(J)=(PRD*PSA(J)/T0(J))*
159 c_FM & SQRT(U0(J)*U0(J)+V0(J)*V0(J)+VG2)
160 SPEED0(J)=SQRT(factWind2*Vsurf2(J)+VG2)
161 DENVV(J)=(PRD*PSA(J)/T0(J))*SPEED0(J)
162 ENDDO
163
164 C 1.5 Define effective skin temperature to compensate for
165 C non-linearity of heat/moisture fluxes during the daily cycle
166
167 DO J=1,NGP
168 TSKIN(J)=TLAND(J)+CTDAY*CLAT(J)*SSR(J)*PSA(J)
169 ENDDO
170
171
172 C-- 2. Computation of fluxes over land and sea
173
174 C 2.1 Wind stress
175
176 C Orographic correction
177
178 DO J=1,NGP
179 c CDENVV(J,1)=CDL*DENVV(J)*FOROG(J)
180 c CDENVV(J,2)=CDS*DENVV(J)
181 DRAG(J,1) = CDL*DENVV(J)*FOROG(J)
182 DRAG(J,2) = CDS*DENVV(J)
183 ENDDO
184
185 C - Notes:
186 C Because of a different mapping between the Drag and the Wind (A/C-grid)
187 C the surface stress is computed later, in "External Forcing",
188 C Here compute only surface drag term (= C_drag*Rho*|V| )
189
190 c DO J=1,NGP
191 c USTR(J,1) = -CDENVV(J,1)*UA(J,NLEV)
192 c VSTR(J,1) = -CDENVV(J,1)*VA(J,NLEV)
193 c USTR(J,2) = -CDENVV(J,2)*UA(J,NLEV)
194 c VSTR(J,2) = -CDENVV(J,2)*VA(J,NLEV)
195 c ENDDO
196
197 C 2.2 Sensible heat flux (from clim. TS over land)
198
199 C Stability correction
200
201 RDTH = FSTAB/DTHETA
202
203 DO J=1,NGP
204 FSLAND=1.+MIN(DTHETA,MAX(-DTHETA,TSKIN(J)-T1(J)))*RDTH
205 FSSEA =1.+MIN(DTHETA,MAX(-DTHETA, TSEA(J)-T1(J)))*RDTH
206 CDENVV(J,1)=CHL*DENVV(J)*FSLAND
207 CDENVV(J,2)=CHS*DENVV(J)*FSSEA
208 ENDDO
209
210 DO J=1,NGP
211 SHF(J,1) = CDENVV(J,1)*CP*(TSKIN(J)-T0(J))
212 SHF(J,2) = CDENVV(J,2)*CP*(TSEA(J) -T0(J))
213 ENDDO
214
215 C 2.3 Evaporation
216
217 CALL SHTORH (0, NGP, TSKIN, PSA, 1. _d 0, QDUMMY, RDUMMY,
218 & QSAT0(1,1), myThid)
219 CALL SHTORH (0, NGP, TSEA , PSA, 1. _d 0, QDUMMY, RDUMMY,
220 & QSAT0(1,2), myThid)
221
222 DO J=1,NGP
223 C EVAP(J,1) = CDENVV(J,1)*SWAV(J)*MAX(0. _d 0,QSAT0(J,1)-Q0(J))
224 EVAP(J,1) = CDENVV(J,1)*MAX(0. _d 0,SWAV(J)*QSAT0(J,1)-Q0(J))
225 c_jmc - try the old formulation:
226 c EVAP(J,1)=CDENVV(J,1)*MIN(1. _d 0,SWAV(J))*(QSAT0(J,1)-Q0(J))
227 EVAP(J,2) = CDENVV(J,2)* (QSAT0(J,2)-Q0(J))
228 ENDDO
229
230 C 2.4 Emission of lw radiation from the surface
231
232 DO J=1,NGP
233 TL4 = TSKIN(J)**4
234 TS4 = TSEA(J) **4
235 SLRU(J) = SBC*(TS4+FMASK(J)*(TL4-TS4))
236 ENDDO
237
238 C-- 3. Adjustment of skin temperature and fluxes over land
239 C-- based on energy balance (to be implemented)
240
241 C-- 4. Weighted average of surface fluxes and temperatures
242 C-- according to land-sea mask
243
244 DO J=1,NGP
245 c USTR(J,3) = USTR(J,2)+FMASK(J)*(USTR(J,1)-USTR(J,2))
246 c VSTR(J,3) = VSTR(J,2)+FMASK(J)*(VSTR(J,1)-VSTR(J,2))
247 DRAG(J,3) = DRAG(J,2)+FMASK(J)*(DRAG(J,1)-DRAG(J,2))
248 SHF(J,3) = SHF(J,2)+FMASK(J)*( SHF(J,1)- SHF(J,2))
249 EVAP(J,3) = EVAP(J,2)+FMASK(J)*(EVAP(J,1)-EVAP(J,2))
250 ENDDO
251
252 DO J=1,NGP
253 TSFC(J) = TSEA(J)+FMASK(J)*(TLAND(J)-TSEA(J))
254 TSKIN(J) = TSEA(J)+FMASK(J)*(TSKIN(J)-TSEA(J))
255 ENDDO
256
257 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
258 #endif /* ALLOW_AIM */
259
260 RETURN
261 END
262
263
264 SUBROUTINE SFLSET (PHI0, FOROG, bi,bj,myThid)
265 C--
266 C-- SUBROUTINE SFLSET (PHI0)
267 C--
268 C-- Purpose: compute orographic factor for land surface drag
269 C-- Input: PHI0 = surface geopotential (2-dim)
270 C Output: FOROG = orographic factor (surf. drag) (2-dim)
271 C-- (originally in common blocks: SFLFIX)
272
273 IMPLICIT NONE
274
275 C Resolution parameters
276
277 C-- size for MITgcm & Physics package :
278 #include "AIM_SIZE.h"
279
280 #include "EEPARAMS.h"
281
282 C Physical constants + functions of sigma and latitude
283 #include "com_physcon.h"
284
285 C Surface flux constants
286 #include "com_sflcon.h"
287
288 C-- Routine arguments:
289 INTEGER bi,bj,myThid
290 _RL PHI0(NGP)
291 _RL FOROG(NGP)
292
293 #ifdef ALLOW_AIM
294
295 C-- Local variables:
296 INTEGER J
297 _RL RHDRAG
298
299 RHDRAG = 1./(GG*HDRAG)
300
301 DO J=1,NGP
302 FOROG(J) = 1. _d 0
303 & + FHDRAG*(1. _d 0 - EXP(-MAX(PHI0(J),0. _d 0)*RHDRAG) )
304 ENDDO
305
306 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
307 #endif /* ALLOW_AIM */
308
309 RETURN
310 END

  ViewVC Help
Powered by ViewVC 1.1.22