1 |
C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/phy_suflux_prep.F,v 1.2 2004/06/24 23:43:11 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "AIM_OPTIONS.h" |
5 |
|
6 |
CBOP |
7 |
C !ROUTINE: SUFLUX_PREP |
8 |
C !INTERFACE: |
9 |
SUBROUTINE SUFLUX_PREP( |
10 |
I PSA,TA,QA,RH,ThA,Vsurf2,WVS,CLAT,FOROG, |
11 |
I FMASK,TLAND,TSEA,TSICE,SSR, |
12 |
O SPEED0,DRAG,DENVV,dTskin,T1,T0,Q0, |
13 |
I kGrd,bi,bj,myThid) |
14 |
|
15 |
C !DESCRIPTION: \bv |
16 |
C *==========================================================* |
17 |
C | S/R SUFLUX_PREP |
18 |
C | o prepare surface flux calculation |
19 |
C *==========================================================* |
20 |
C | o contain 1rst part of original S/R SUFLUX (Speedy code) |
21 |
C *==========================================================* |
22 |
C-- |
23 |
C-- SUBROUTINE SUFLUX (PSA,UA,VA,TA,QA,RH,PHI, |
24 |
C-- & PHI0,FMASK,TLAND,TSEA,SWAV,SSR,SLRD, |
25 |
C-- & USTR,VSTR,SHF,EVAP,SLRU, |
26 |
C-- & TSFC,TSKIN,U0,V0,T0,Q0) |
27 |
C-- |
28 |
C-- Purpose: Compute surface fluxes of momentum, energy and moisture, |
29 |
C-- and define surface skin temperature from energy balance |
30 |
C *==========================================================* |
31 |
C \ev |
32 |
|
33 |
C !USES: |
34 |
IMPLICIT NONE |
35 |
|
36 |
C Resolution parameters |
37 |
|
38 |
C-- size for MITgcm & Physics package : |
39 |
#include "AIM_SIZE.h" |
40 |
|
41 |
#include "EEPARAMS.h" |
42 |
|
43 |
C Physical constants + functions of sigma and latitude |
44 |
#include "com_physcon.h" |
45 |
|
46 |
C Surface flux constants |
47 |
#include "com_sflcon.h" |
48 |
|
49 |
C !INPUT/OUTPUT PARAMETERS: |
50 |
C == Routine Arguments == |
51 |
C-- Input: |
52 |
C PSA :: norm. surface pressure [p/p0] (2-dim) |
53 |
C TA :: temperature (3-dim) |
54 |
C QA :: specific humidity [g/kg] (3-dim) |
55 |
C RH :: relative humidity [0-1] (3-dim) |
56 |
C ThA :: Pot.temperature [K] (3-dim) |
57 |
C Vsurf2 :: square of surface wind speed (2-dim,input) |
58 |
C ==> UA,VA are no longer used |
59 |
C WVS :: weights for near surf interp (2-dim) |
60 |
C CLAT :: cos(lat) (2-dim) |
61 |
C FOROG :: orographic factor (surf. drag) (2-dim) |
62 |
C FMASK :: fraction land - sea - sea-ice (2.5-dim) |
63 |
C TLAND :: land-surface temperature (2-dim) |
64 |
C TSEA :: sea-surface temperature (2-dim) |
65 |
C TSICE :: sea-ice surface temperature (2-dim) |
66 |
C SSR :: sfc sw radiation (net flux) (2-dim) |
67 |
C-- Output: |
68 |
C SPEED0 :: effective surface wind speed (2-dim) |
69 |
C DRAG :: surface Drag term (= Cd*Rho*|V|)(2-dim) |
70 |
C ==> USTR,VSTR are no longer used |
71 |
C DENVV :: surface flux (sens,lat.) coeff. (=Rho*|V|) [kg/m2/s] |
72 |
C dTskin :: temp. correction for daily-cycle heating [K] |
73 |
C T1 :: near-surface air temperature (from Pot.Temp) |
74 |
C T0 :: near-surface air temperature (2-dim) |
75 |
C Q0 :: near-surface sp. humidity [g/kg](2-dim) |
76 |
C-- Input: |
77 |
C kGrd :: Ground level index (2-dim) |
78 |
C bi,bj :: tile index |
79 |
C myThid :: Thread number for this instance of the routine |
80 |
C-- |
81 |
_RL PSA(NGP), TA(NGP,NLEV), QA(NGP,NLEV), RH(NGP,NLEV) |
82 |
_RL ThA(NGP,NLEV) |
83 |
_RL Vsurf2(NGP), WVS(NGP), CLAT(NGP), FOROG(NGP) |
84 |
_RL FMASK(NGP,3), TLAND(NGP), TSEA(NGP), TSICE(NGP) |
85 |
_RL SSR(NGP) |
86 |
|
87 |
_RL SPEED0(NGP), DRAG(NGP,0:3), T1(NGP), DENVV(NGP) |
88 |
_RL dTskin(NGP), T0(NGP), Q0(NGP) |
89 |
|
90 |
INTEGER kGrd(NGP) |
91 |
INTEGER bi,bj,myThid |
92 |
CEOP |
93 |
|
94 |
#ifdef ALLOW_AIM |
95 |
|
96 |
C-- Local variables: |
97 |
_RL QSAT0(NGP,2) |
98 |
|
99 |
INTEGER J, Ktmp, NL1 |
100 |
_RL tmpRH(NGP) |
101 |
_RL factWind2, kappa |
102 |
|
103 |
C- jmc: declare all local variables: |
104 |
_RL GTEMP0, GHUM0, RCP, PRD, VG2 |
105 |
c _RL RDTH, FSLAND, FSSEA, FSSICE |
106 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
107 |
|
108 |
C-- 1. Extrapolation of wind, temp, hum. and density to the surface |
109 |
|
110 |
C 1.1 Wind components |
111 |
|
112 |
c DO J=1,NGP |
113 |
c U0(J) = 0.0 |
114 |
c V0(J) = 0.0 |
115 |
c Ktmp = kGrd(J) |
116 |
c IF ( Ktmp.GT.0 ) THEN |
117 |
c U0(J) = FWIND0*UA(J,Ktmp) |
118 |
c V0(J) = FWIND0*VA(J,Ktmp) |
119 |
c ENDIF |
120 |
c ENDDO |
121 |
|
122 |
C 1.2 Temperature |
123 |
|
124 |
GTEMP0 = 1.-FTEMP0 |
125 |
RCP = 1. _d 0 /CP |
126 |
kappa = RD/CP |
127 |
C |
128 |
DO J=1,NGP |
129 |
Ktmp = kGrd(J) |
130 |
NL1 = Ktmp-1 |
131 |
IF ( Ktmp.GT.1 ) THEN |
132 |
c_FM T0(J) = TA(J,NLEV)+WVI(NLEV,2)*(TA(J,NLEV)-TA(J,NL1)) |
133 |
c_FM T1(J) = TA(J,NLEV)+RCP*(PHI(J,NLEV)-PHI0(J)) |
134 |
T0(J) = TA(J,Ktmp) + WVS(J)*(TA(J,Ktmp)-TA(J,NL1)) |
135 |
Cjmc: used previously but not valid with partial cell ! |
136 |
c T1(J) = TA(J,Ktmp)*(SIGH(Ktmp)/SIG(Ktmp))**kappa |
137 |
T1(J) = ThA(J,Ktmp)*(PSA(J)**kappa) |
138 |
tmpRH(J)=RH(J,Ktmp) |
139 |
ELSE |
140 |
T0(J) = 273.16 _d 0 |
141 |
T1(J) = 273.16 _d 0 |
142 |
tmpRH(J)= 0. |
143 |
ENDIF |
144 |
ENDDO |
145 |
|
146 |
DO J=1,NGP |
147 |
c T0(J) = FTEMP0*T0(J)+GTEMP0*T1(J) |
148 |
T0(J) = FTEMP0*MIN(T0(J),T1(J))+GTEMP0*T1(J) |
149 |
ENDDO |
150 |
|
151 |
C 1.3 Spec. humidity |
152 |
|
153 |
GHUM0 = 1.-FHUM0 |
154 |
|
155 |
CALL SHTORH (-1,NGP,T0, PSA, 1. _d 0, Q0, tmpRH, QSAT0, myThid) |
156 |
|
157 |
DO J=1,NGP |
158 |
IF ( kGrd(J) .GT. 0 ) THEN |
159 |
Q0(J)=FHUM0*Q0(J)+GHUM0*QA(J,kGrd(J)) |
160 |
ENDIF |
161 |
ENDDO |
162 |
|
163 |
C 1.4 Density * wind speed (including gustiness factor) |
164 |
|
165 |
PRD = P0/RD |
166 |
VG2 = VGUST*VGUST |
167 |
factWind2 = FWIND0*FWIND0 |
168 |
|
169 |
DO J=1,NGP |
170 |
c_FM DENVV(J)=(PRD*PSA(J)/T0(J))* |
171 |
c_FM & SQRT(U0(J)*U0(J)+V0(J)*V0(J)+VG2) |
172 |
SPEED0(J)=SQRT(factWind2*Vsurf2(J)+VG2) |
173 |
DENVV(J)=(PRD*PSA(J)/T0(J))*SPEED0(J) |
174 |
ENDDO |
175 |
|
176 |
C 1.5 Define effective skin temperature to compensate for |
177 |
C non-linearity of heat/moisture fluxes during the daily cycle |
178 |
C Tskin = Tland + dTskin |
179 |
|
180 |
DO J=1,NGP |
181 |
dTskin(J)=CTDAY*CLAT(J)*SSR(J)*PSA(J) |
182 |
ENDDO |
183 |
|
184 |
|
185 |
C-- 2. Computation of fluxes over land and sea |
186 |
|
187 |
C 2.1 Wind stress |
188 |
|
189 |
C Orographic correction |
190 |
|
191 |
DO J=1,NGP |
192 |
c CDENVV(J,1)=CDL*DENVV(J)*FOROG(J) |
193 |
c CDENVV(J,2)=CDS*DENVV(J) |
194 |
DRAG(J,1) = CDL*DENVV(J)*FOROG(J) |
195 |
DRAG(J,2) = CDS*DENVV(J) |
196 |
DRAG(J,3) = CDS*DENVV(J) |
197 |
ENDDO |
198 |
|
199 |
C - Notes: |
200 |
C Because of a different mapping between the Drag and the Wind (A/C-grid) |
201 |
C the surface stress is computed later, in "External Forcing", |
202 |
C Here compute only surface drag term (= C_drag*Rho*|V| ) |
203 |
|
204 |
c DO J=1,NGP |
205 |
c USTR(J,1) = -CDENVV(J,1)*UA(J,NLEV) |
206 |
c VSTR(J,1) = -CDENVV(J,1)*VA(J,NLEV) |
207 |
c USTR(J,2) = -CDENVV(J,2)*UA(J,NLEV) |
208 |
c VSTR(J,2) = -CDENVV(J,2)*VA(J,NLEV) |
209 |
c ENDDO |
210 |
|
211 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
212 |
#endif /* ALLOW_AIM */ |
213 |
|
214 |
RETURN |
215 |
END |
216 |
|
217 |
SUBROUTINE SFLSET (PHI0, FOROG, bi,bj,myThid) |
218 |
C-- |
219 |
C-- SUBROUTINE SFLSET (PHI0) |
220 |
C-- |
221 |
C-- Purpose: compute orographic factor for land surface drag |
222 |
C-- Input: PHI0 = surface geopotential (2-dim) |
223 |
C Output: FOROG = orographic factor (surf. drag) (2-dim) |
224 |
C-- (originally in common blocks: SFLFIX) |
225 |
|
226 |
IMPLICIT NONE |
227 |
|
228 |
C Resolution parameters |
229 |
|
230 |
C-- size for MITgcm & Physics package : |
231 |
#include "AIM_SIZE.h" |
232 |
|
233 |
#include "EEPARAMS.h" |
234 |
|
235 |
C Physical constants + functions of sigma and latitude |
236 |
#include "com_physcon.h" |
237 |
|
238 |
C Surface flux constants |
239 |
#include "com_sflcon.h" |
240 |
|
241 |
C-- Routine arguments: |
242 |
INTEGER bi,bj,myThid |
243 |
_RL PHI0(NGP) |
244 |
_RL FOROG(NGP) |
245 |
|
246 |
#ifdef ALLOW_AIM |
247 |
|
248 |
C-- Local variables: |
249 |
INTEGER J |
250 |
_RL RHDRAG |
251 |
|
252 |
RHDRAG = 1./(GG*HDRAG) |
253 |
|
254 |
DO J=1,NGP |
255 |
FOROG(J) = 1. _d 0 |
256 |
& + FHDRAG*(1. _d 0 - EXP(-MAX(PHI0(J),0. _d 0)*RHDRAG) ) |
257 |
ENDDO |
258 |
|
259 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
260 |
#endif /* ALLOW_AIM */ |
261 |
|
262 |
RETURN |
263 |
END |