/[MITgcm]/MITgcm/pkg/bulk_force/bulkf_formula_lanl.F
ViewVC logotype

Contents of /MITgcm/pkg/bulk_force/bulkf_formula_lanl.F

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


Revision 1.8 - (show annotations) (download)
Thu May 25 17:30:54 2006 UTC (17 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint59, checkpoint58f_post, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, mitgcm_mapl_00, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint58r_post, checkpoint58n_post, checkpoint65o, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint58k_post, checkpoint62b, checkpoint58v_post, checkpoint64y, checkpoint64x, checkpoint58l_post, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint61f, checkpoint58g_post, checkpoint58x_post, checkpoint61n, checkpoint58h_post, checkpoint58j_post, checkpoint61q, checkpoint61z, checkpoint61e, checkpoint58i_post, checkpoint58u_post, checkpoint58s_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61x, checkpoint61y, HEAD
Changes since 1.7: +117 -107 lines
cleaning up: add comments, remove unused variables, add some parameters
 to read from data.blk

1 C $Header: /u/gcmpack/MITgcm/pkg/bulk_force/bulkf_formula_lanl.F,v 1.7 2006/01/22 15:51:35 jmc Exp $
2 C $Name: $
3
4 #include "BULK_FORCE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: BULKF_FORMULA_LANL
8 C !INTERFACE:
9 SUBROUTINE BULKF_FORMULA_LANL(
10 I uw, vw, us, Ta, Qa, nc, tsf_in,
11 O flwupa, flha, fsha, df0dT,
12 O ust, vst, evp, ssq, dEvdT,
13 I iceornot, myThid )
14
15 C !DESCRIPTION: \bv
16 C *==========================================================*
17 C | SUBROUTINE BULKF_FORMULA_LANL
18 c | o Calculate bulk formula fluxes over open ocean or seaice
19 C *==========================================================*
20 C \ev
21 C swd -- bulkf formula used in bulkf and ice pkgs
22 C taken from exf package
23 C
24 C wind stress = (ust,vst) = rhoA * Cd * Ws * (del.u,del.v)
25 C Sensib Heat flux = fsha = rhoA * Ch * Ws * del.T * CpAir
26 C Latent Heat flux = flha = rhoA * Ce * Ws * del.Q * Lvap
27 C = -Evap * Lvap
28 C with Ws = wind speed = sqrt(del.u^2 +del.v^2) ;
29 C del.T = Tair - Tsurf ; del.Q = Qair - Qsurf
30 C Cd,Ch,Ce = transfer coefficient for momentum, sensible
31 C & latent heat flux [no units]
32 C *==========================================================*
33
34 C !USES:
35 IMPLICIT NONE
36 C === Global variables ===
37 #include "EEPARAMS.h"
38 #include "SIZE.h"
39 #include "PARAMS.h"
40 #include "BULKF_PARAMS.h"
41
42 C !INPUT/OUTPUT PARAMETERS:
43 C input:
44 _RL uw ! zonal wind speed (at grid center) [m/s]
45 _RL vw ! meridional wind speed (at grid center) [m/s]
46 _RL us ! wind speed [m/s] at height hu
47 _RL Ta ! air temperature [K] at height ht
48 _RL Qa ! specific humidity [kg/kg] at heigth ht
49 _RL nc ! fraction cloud cover
50 _RL tsf_in ! sea-ice or sea surface temperature [oC]
51 INTEGER iceornot ! 0=open water, 1=sea-ice, 2=sea-ice with snow
52 INTEGER myThid ! my Thread Id number
53 C output:
54 _RL flwupa ! upward long wave radiation (>0 upward) [W/m2]
55 _RL flha ! latent heat flux (>0 downward) [W/m2]
56 _RL fsha ! sensible heat flux (>0 downward) [W/m2]
57 _RL df0dT ! derivative of heat flux with respect to Tsf [W/m2/K]
58 _RL ust ! zonal wind stress (at grid center) [N/m2]
59 _RL vst ! meridional wind stress (at grid center)[N/m2]
60 _RL evp ! evaporation rate (over open water) [kg/m2/s]
61 _RL ssq ! surface specific humidity [kg/kg]
62 _RL dEvdT ! derivative of evap. with respect to Tsf [kg/m2/s/K]
63 CEOP
64
65 #ifdef ALLOW_BULK_FORCE
66
67 C == Local variables ==
68 _RL dflhdT ! derivative of latent heat with respect to T
69 _RL dfshdT ! derivative of sensible heat with respect to T
70 _RL dflwupdT ! derivative of long wave with respect to T
71
72 _RL tsf ! surface temperature [K]
73 _RL ht ! height for air temperature [m]
74 c _RL hq ! height for humidity [m]
75 _RL hu ! height for wind speed [m]
76 c _RL zref ! reference height [m]
77 _RL usm ! wind speed limited [m/s]
78 c _RL umin ! minimum wind speed used for drag-coeff [m/s]
79 _RL lath ! latent heat of vaporization or sublimation
80 _RL t0 ! virtual temperature [K]
81 _RL deltap ! potential temperature diff [K]
82 _RL delq ! specific humidity difference [kg/kg]
83 _RL ustar ! friction velocity [m/s]
84 _RL tstar ! temperature scale [K]
85 _RL qstar ! humidity scale [kg/kg]
86 _RL rd ! = sqrt(Cd) [-]
87 _RL re ! = Ce / sqrt(Cd) [-]
88 _RL rh ! = Ch / sqrt(Cd) [-]
89 _RL rdn, ren, rhn ! initial (neutral) values of rd, re, rh
90 _RL stable ! = 1 if stable ; = 0 if unstable
91 _RL huol ! stability parameter [-]
92 _RL x ! stability function [-]
93 _RL xsq ! = x^2 [-]
94 _RL psimh ! momentum stability function
95 _RL psixh ! latent & sensib. stability function
96 _RL czol ! = zref*Karman_cst*gravity
97 _RL aln ! = log(ht/zref)
98 c _RL cdalton ! coeff to evaluate Dalton Number
99 c _RL mixratio
100 c _RL ea
101 c _RL psim_fac
102 _RL tau ! surface stress coef = ?
103 _RL csha ! sensib.heat flx coef = rhoA * Ws * Ch * CpAir
104 _RL clha ! latent heat flx coef = rhoA * Ws * Ce * Lvap
105 _RL zice
106 _RL ssq0, ssq1, ssq2 ! constant used in surface specific humidity
107 _RL p0 ! reference sea-level atmospheric pressure [mb]
108 _RL bulkf_Cdn ! drag coefficient
109 INTEGER niter_bulk, iter
110
111 C == external Functions
112 c _RL exf_BulkCdn
113 c external exf_BulkCdn
114 c _RL exf_BulkqSat
115 c external exf_BulkqSat
116 c _RL exf_BulkRhn
117 c external exf_BulkRhn
118
119 DATA ssq0, ssq1, ssq2
120 & / 3.797915 _d 0 , 7.93252 _d -6 , 2.166847 _d -3 /
121 DATA p0 / 1013. _d 0 /
122
123 C--- Compute turbulent surface fluxes
124 ht = 2. _d 0
125 c hq = 2. _d 0
126 hu = 10. _d 0
127 c zref = 10. _d 0
128 zice = 0.0005 _d 0
129 aln = log(ht/zref)
130 niter_bulk = 5
131 c cdalton = 0.0346000 _d 0
132 czol = zref*xkar*gravity
133 c psim_fac=5. _d 0
134 c umin=1. _d 0
135
136 lath=Lvap
137 if (iceornot.gt.0) lath=Lvap+Lfresh
138 Tsf=Tsf_in+Tf0kel
139 C- Wind speed
140 if (us.eq.0. _d 0) then
141 us = sqrt(uw*uw + vw*vw)
142 endif
143 usm = max(us,umin)
144 c
145 t0 = Ta*(1. _d 0 + humid_fac*Qa)
146 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
147 cQQ ssq = 0.622*6.11*exp(22.47*(1.d0-Tf0kel/tsf))/p0
148 c ssq = 3.797915 _d 0*exp(
149 c & lath*(7.93252 _d -6 - 2.166847 _d -3/Tsf)
150 c & )/p0
151 ssq = ssq0*exp( lath*(ssq1-ssq2/Tsf) ) / p0
152
153 deltap = ta - tsf + gamma_blk*ht
154 delq = Qa - ssq
155
156 C-- initialize estimate exchange coefficients
157 rdn=xkar/(log(zref/zice))
158 rhn=rdn
159 ren=rdn
160 C-- calculate turbulent scales
161 ustar=rdn*usm
162 tstar=rhn*deltap
163 qstar=ren*delq
164
165 C-- iteration with psi-functions to find transfer coefficients
166 do iter=1,niter_bulk
167 huol = czol/ustar**2 *(tstar/t0 +
168 & qstar/(1. _d 0/humid_fac+Qa))
169 huol = sign( min(abs(huol),10. _d 0), huol)
170 stable = 5. _d -1 + sign(5. _d -1 , huol)
171 xsq = max(sqrt(abs(1. _d 0 - 16. _d 0*huol)),1. _d 0)
172 x = sqrt(xsq)
173 psimh = -5. _d 0*huol*stable + (1. _d 0-stable)*
174 & (2. _d 0*log(5. _d -1*(1. _d 0+x)) +
175 & 2. _d 0*log(5. _d -1*(1. _d 0+xsq)) -
176 & 2. _d 0*atan(x) + pi*.5 _d 0)
177 psixh = -5. _d 0*huol*stable + (1. _d 0-stable)*
178 & (2. _d 0*log(5. _d -1*(1. _d 0+xsq)))
179
180 C-- Update the transfer coefficients
181 rd = rdn/(1. _d 0 + rdn*(aln-psimh)/xkar)
182 rh = rhn/(1. _d 0 + rhn*(aln-psixh)/xkar)
183 re = rh
184 C-- Update ustar, tstar, qstar using updated, shifted coefficients.
185 ustar = rd*usm
186 qstar = re*delq
187 tstar = rh*deltap
188 enddo
189
190 tau = rhoa*ustar**2
191 tau = tau*us/usm
192 csha = rhoa*cpair*us*rh*rd
193 clha = rhoa*lath*us*re*rd
194
195 fsha = csha*deltap
196 flha = clha*delq
197 evp = -flha/lath
198
199 C-- Upward long wave radiation
200 cQQ mixratio=Qa/(1-Qa)
201 cQQ ea=p0*mixratio/(0.62197+mixratio)
202 cQQ flwupa=-0.985*stefan*tsf**4
203 cQQ & *(0.39-0.05*sqrt(ea))
204 cQQ & *(1-0.6*nc**2)
205 if (iceornot.eq.0) then
206 flwupa=ocean_emissivity*stefan*tsf**4
207 dflwupdT=4. _d 0*ocean_emissivity*stefan*tsf**3
208 elseif (iceornot.eq.2) then
209 flwupa=snow_emissivity*stefan*tsf**4
210 dflwupdT=4. _d 0*snow_emissivity*stefan*tsf**3
211 else
212 flwupa=ice_emissivity*stefan*tsf**4
213 dflwupdT=4. _d 0*ice_emissivity*stefan*tsf**3
214 endif
215 cQQ dflhdT = -clha*Tf0kel*ssq*22.47/(tsf**2)
216 c dflhdT = -clha*Lath*ssq/(Rvap*tsf**2)
217 c dflhdT = -clha*ssq*Lath*2.166847 _d -3/(Tsf**2)
218 dEvdT = clha*ssq*ssq2/(Tsf*Tsf)
219 dflhdT = -lath*dEvdT
220 dfshdT = -csha
221 cQQ dflwupdT= 4.*0.985*stefan*tsf**3
222 cQQ & *(0.39-0.05*sqrt(ea))
223 cQQ & *(1-0.6*nc**2)
224 c total derivative with respect to surface temperature
225 df0dT=-dflwupdT+dfshdT+dflhdT
226
227 C-- Wind stress at center points
228 C- in-lining of function: exf_BulkCdn(umps) = cdrag_1/umps + cdrag_2 + cdrag_3*umps
229 bulkf_Cdn = cdrag_1/usm + cdrag_2 + cdrag_3*usm
230 ust = rhoa*bulkf_Cdn*us*uw
231 vst = rhoa*bulkf_Cdn*us*vw
232 #endif /*ALLOW_BULK_FORCE*/
233
234 RETURN
235 END

  ViewVC Help
Powered by ViewVC 1.1.22