/[MITgcm]/MITgcm/pkg/cheapaml/cheapaml_coare3_flux.F
ViewVC logotype

Contents of /MITgcm/pkg/cheapaml/cheapaml_coare3_flux.F

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


Revision 1.3 - (show annotations) (download)
Fri Jun 24 01:25:15 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63d, checkpoint63e, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63
Changes since 1.2: +19 -18 lines
avoid line longer than 72c

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-------------------------------------------------------------

  ViewVC Help
Powered by ViewVC 1.1.22