1 |
C $Header: /u/gcmpack/MITgcm/pkg/cheapaml/cheapaml_coare3_flux.F,v 1.2 2011/02/24 16:11:41 wienders Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "CHEAPAML_OPTIONS.h" |
5 |
|
6 |
C !ROUTINE: CHEAPAML_COARE3_flux |
7 |
C !INTERFACE: |
8 |
subroutine cheapaml_COARE3_flux |
9 |
&(i,j,bi,bj,hf,ef,evap,Rnl,ssqt,q100) |
10 |
c |
11 |
implicit none |
12 |
C === Global variables === |
13 |
#include "SIZE.h" |
14 |
#include "EEPARAMS.h" |
15 |
#include "PARAMS.h" |
16 |
#include "CHEAPAML.h" |
17 |
#include "DYNVARS.h" |
18 |
|
19 |
integer iter,i,j,bi,bj,nits |
20 |
_RL hf,ef,evap,tau,L,psu,pst,Bf |
21 |
_RL CD,usr,tsr,qsr,q100,ssqt,ttas,essqt |
22 |
_RL zo,zot,zoq,RR,zL,pt,ttt,tta |
23 |
_RL Rnl,es,twopi,cwave,lwave |
24 |
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
25 |
c various constants |
26 |
c |
27 |
_RL u,ts,q,zi,qs,tsw |
28 |
_RL psiu,psit,zot10,Ct10,CC,Ribu |
29 |
_RL Du,Wg,Dt,Dq,u10,zo10,Cd10,Ch10 |
30 |
_RL xBeta,visa,Ribcu,QaR |
31 |
_RL Ct,zetu,L10,Tas,ta,charn |
32 |
c |
33 |
c |
34 |
c Constants and coefficients (Stull 1988 p640). |
35 |
xBeta=1.2 !Given as 1.25 in Fairall et al.(1996) |
36 |
twopi=2. _d 0*pi |
37 |
visa=1.326 _d -5 |
38 |
c default relative humidity |
39 |
QaR=0.8 _d 0 |
40 |
|
41 |
c sea surface temperature without skin correction |
42 |
ts=theta(i,j,1,bi,bj) |
43 |
tsw=ts |
44 |
Tas=Tair(i,j,bi,bj) |
45 |
|
46 |
|
47 |
c net upward long wave |
48 |
Rnl= 0.97*(stefan*(tsw+Celsius2K)**4) !Net longwave (up = +). |
49 |
c |
50 |
c Teten''s returns air svp es in mb |
51 |
es = (1.0007+3.46e-6*p0)*6.1121*dexp(17.502*tsw/(240.97+tsw)) !mb |
52 |
es=es*0.98 !reduced for salinity Kraus 1972 p. 46 |
53 |
qs=.62197*es/(p0-0.378*es) !convert from mb to spec. humidity kg/kg |
54 |
tta=Tas+Celsius2K |
55 |
ttas=tta+gamma_blk*zt |
56 |
ttt=tta-(cheapaml_h - zt)*gamma_blk |
57 |
pt=p0*(1-gamma_blk*cheapaml_h/ttas)**(gravity/gamma_blk/gasR) |
58 |
essqt = (1.0007+3.46e-6*pt)*6.1121*dexp(17.502*tas/(240.97+tas)) !mb |
59 |
ssqt = .62197*essqt/(pt-0.378*essqt) !convert from mb to spec. humidity kg/kg |
60 |
|
61 |
if (useFreshWaterFlux)then |
62 |
q=qair(i,j,bi,bj) |
63 |
else |
64 |
q=QaR*ssqt |
65 |
endif |
66 |
|
67 |
|
68 |
c Wave parameters |
69 |
cwave=gravity*wavesp(i,j,bi,bj)/twopi |
70 |
lwave=cwave*wavesp(i,j,bi,bj) |
71 |
c |
72 |
c Initial guesses |
73 |
zo=0.0001 |
74 |
Wg=0.5 !Gustiness factor initial guess |
75 |
c |
76 |
c Air-sea differences - includes warm layer in Dt and Dq |
77 |
u=(uwind(i,j,bi,bj)-uVel(i,j,1,bi,bj))**2+ |
78 |
&(vwind(i,j,bi,bj)-vVel(i,j,1,bi,bj))**2 |
79 |
u=dsqrt(u) |
80 |
Du=(u**2.+Wg**2.)**.5 !include gustiness in wind spd. difference |
81 |
Dt=tsw-Tas-gamma_blk*zt !potential temperature difference. |
82 |
Dq=qs-q |
83 |
c |
84 |
c **************** neutral coefficients ****************** |
85 |
c |
86 |
u10=Du*dlog(10. _d 0/zo)/dlog(zu/zo) |
87 |
usr=0.035*u10 |
88 |
zo10=0.011*usr*usr/gravity+0.11*visa/usr |
89 |
Cd10=(xkar/dlog(10. _d 0/zo10))**2 |
90 |
Ch10=0.00115 _d 0 |
91 |
Ct10=Ch10/sqrt(Cd10) |
92 |
zot10=10._d 0/dexp(xkar/Ct10) |
93 |
Cd=(xkar/dlog(zu/zo10))**2 |
94 |
|
95 |
c standard coare3 boundary layer height |
96 |
zi=600. _d 0 |
97 |
|
98 |
c |
99 |
c ************* Grachev and Fairall (JAM, 1997) ********** |
100 |
c |
101 |
ta=Tas+Celsius2K |
102 |
Ct=xkar/dlog(zt/zot10) ! Temperature transfer coefficient |
103 |
CC=xkar*Ct/Cd ! z/L vs Rib linear coefficient |
104 |
Ribcu=-zu/(zi*0.004 _d 0*xBeta**3) ! Saturation or plateau Rib |
105 |
Ribu=-gravity*zu*(Dt+0.61 _d 0*ta*Dq)/(ta*Du**2) |
106 |
if (Ribu.lt.0. _d 0) then |
107 |
zetu=CC*Ribu/(1. _d 0+Ribu/Ribcu) ! Unstable G and F |
108 |
else |
109 |
zetu=CC*Ribu*(1. _d 0 +27. _d 0/9. _d 0*Ribu/CC) ! Stable |
110 |
endif |
111 |
L10=zu/zetu ! MO length |
112 |
if (zetu.gt.50. _d 0) then |
113 |
nits=1 |
114 |
else |
115 |
nits=3 ! number of iterations |
116 |
endif |
117 |
c |
118 |
c First guess M-O stability dependent scaling params.(u*,t*,q*) to estimate zo and z/L |
119 |
c |
120 |
usr= Du*xkar/(dlog(zu/zo10)-psiu(zu/L10)) |
121 |
tsr=-(Dt)*xkar/(dlog(zt/zot10)-psit(zt/L10)) |
122 |
qsr=-(Dq)*xkar/(dlog(zq/zot10)-psit(zq/L10)) |
123 |
c |
124 |
charn=0.011 _d 0 !then modify Charnock for high wind speeds Chris s data |
125 |
if(Du.gt.10. _d 0) charn=0.011 _d 0 |
126 |
& +(0.018-0.011)*(Du-10.)/(18.0-10.0) |
127 |
if(Du.gt.18. _d 0) charn=0.018 _d 0 |
128 |
c |
129 |
c **** Iterate across u*(t*,q*),zo(zot,zoq) and z/L including cool skin **** |
130 |
c |
131 |
do iter=1,nits |
132 |
if(WAVEMODEL.eq.'Smith') then |
133 |
zo=charn*usr*usr/gravity + 0.11 _d 0*visa/usr !after Smith 1988 |
134 |
else if(WAVEMODEL.eq.'Oost') then |
135 |
zo=(50./twopi)*lwave*(usr/cwave)**4.5 _d 0+0.11*visa/usr !Oost et al. |
136 |
else if(WAVEMODEL.eq.'TayYel') then |
137 |
zo=1200. _d 0*wavesh(i,j,bi,bj)*(wavesh(i,j,bi,bj)/lwave)**4.5 |
138 |
& +0.11 _d 0*visa/usr !Taylor and Yelland |
139 |
endif |
140 |
rr=zo*usr/visa |
141 |
c |
142 |
c *** zoq and zot fitted to results from several ETL cruises ************ |
143 |
c |
144 |
zoq=min(1.15 _d -4,5.5 _d -5/rr**0.6 _d 0) |
145 |
zot=zoq |
146 |
c |
147 |
zL=xkar*gravity*zu*(tsr*(1.+0.61*q)+0.61*ta*qsr) |
148 |
& /(ta*usr*usr*(1. _d 0+0.61 _d 0*q)) |
149 |
L=zu/zL |
150 |
psu=psiu(zu/L) |
151 |
pst=psit(zt/L) |
152 |
usr=Du*xkar/(dlog(zu/zo)-psiu(zu/L)) |
153 |
tsr=-(Dt)*xkar/(dlog(zt/zot)-psit(zt/L)) |
154 |
qsr=-(Dq)*xkar/(dlog(zq/zoq)-psit(zq/L)) |
155 |
Bf=-gravity/ta*usr*(tsr+0.61 _d 0*ta*qsr) |
156 |
if (Bf.gt.0. _d 0) then |
157 |
Wg=xBeta*(Bf*zi)**.333 _d 0 |
158 |
else |
159 |
Wg=0.2 _d 0 |
160 |
endif |
161 |
Du=sqrt(u**2.+Wg**2.) !include gustiness in wind spd. |
162 |
enddo |
163 |
|
164 |
c compute surface fluxes and other parameters |
165 |
tau=rhoa*usr*usr*u/Du !stress N/m2 |
166 |
hf=-cpair*rhoa*usr*tsr !sensible W/m2 |
167 |
ef=-lath*rhoa*usr*qsr !latent W/m2 |
168 |
evap=-rhoa*usr*qsr |
169 |
if(.NOT.useStressOption)THEN |
170 |
ustress(i,j,bi,bj)=tau*(uwind(i,j,bi,bj)-uVel(i,j,1,bi,bj))/u |
171 |
vstress(i,j,bi,bj)=tau*(vwind(i,j,bi,bj)-vVel(i,j,1,bi,bj))/u |
172 |
endif |
173 |
q100=qs+qsr*(dlog(100. _d 0/zoq)-psit(100. _d 0/L)) |
174 |
c |
175 |
return |
176 |
end |
177 |
c |
178 |
c------------------------------------------------------------------ |
179 |
function psiu(zL) |
180 |
c |
181 |
c psiu and psit evaluate stability function for wind speed and scalars |
182 |
c matching Kansas and free convection forms with weighting f |
183 |
c convective form follows Fairall et al (1996) with profile constants |
184 |
c from Grachev et al (2000) BLM |
185 |
c stable form from Beljaars and Holtslag (1991) |
186 |
c |
187 |
implicit none |
188 |
_RL zL,x,y,psik,psic,f,psiu,c |
189 |
if(zL.lt.0.0) then |
190 |
x=(1.-15.*zL)**.25 !Kansas unstable |
191 |
psik=2.*dlog((1.+x)/2.)+dlog((1.+x*x)/2.)-2.*atan(x)+2.*atan(1.) |
192 |
y=(1.-10.15*zL)**.3333 !Convective |
193 |
psic=1.5*dlog((1.+y+y*y)/3.)-sqrt(3.)*atan((1.+2.*y)/sqrt(3.)) |
194 |
& +4.*atan(1.)/sqrt(3.) |
195 |
f=zL*zL/(1.+zL*zL) |
196 |
psiu=(1.-f)*psik+f*psic |
197 |
else |
198 |
c=min(50.,0.35*zL) !Stable |
199 |
psiu=-((1.+1.*zL)**1.+.6667*(zL-14.28)/dexp(c)+8.525) |
200 |
endif |
201 |
return |
202 |
end |
203 |
c-------------------------------------------------------------- |
204 |
function psit(zL) |
205 |
|
206 |
implicit none |
207 |
_RL zL,x,y,psik,psic,f,psit,c |
208 |
if(zL.lt.0.0) then |
209 |
x=(1.-15.*zL)**.5 !Kansas unstable |
210 |
psik=2.*dlog((1.+x)/2.) |
211 |
y=(1.-34.15*zL)**.3333 !Convective |
212 |
psic=1.5*dlog((1.+y+y*y)/3.)-sqrt(3.)*atan((1.+2.*y)/sqrt(3.)) |
213 |
& +4.*atan(1.)/sqrt(3.) |
214 |
f=zL*zL/(1.+zL*zL) |
215 |
psit=(1.-f)*psik+f*psic |
216 |
else |
217 |
c=min(50.,0.35*zL) !Stable |
218 |
psit=-((1.+2.*zL/3.)**1.5+.6667*(zL-14.28)/dexp(c)+8.525) |
219 |
endif |
220 |
return |
221 |
end |
222 |
|
223 |
c------------------------------------------------------------- |