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

Annotation of /MITgcm/pkg/bulk_force/bulkf_formula_vince.F

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


Revision 1.3 - (hide annotations) (download)
Sun Nov 23 01:31:47 2003 UTC (20 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +1 -1 lines
FILE REMOVED
removed (no longer used).

1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/bulk_force/bulkf_formula_vince.F,v 1.2 2003/10/09 04:19:19 edhill Exp $
2 edhill 1.2 C $Name: $
3 cheisey 1.1 c swd -- bulkf formula used in bulkf and ice pkgs
4     c cswd -- adapted from vince/andrei surf_flux.f
5    
6 edhill 1.2 #include "BULK_FORCE_OPTIONS.h"
7 cheisey 1.1 subroutine bulkf_formula_vince(
8     I uw, vw, us, Ta, Qa, nc, tsf_in,
9     I UFocean, flwup, flha, fsha, df0dT,
10     I ust, vst, evp, ssq,
11     I iceornot, readstress
12     & )
13    
14     IMPLICIT NONE
15     c
16     #include "EEPARAMS.h"
17     #include "SIZE.h"
18     #include "PARAMS.h"
19     #include "DYNVARS.h"
20     #include "GRID.h"
21     #include "FFIELDS.h"
22     #ifdef ALLOW_BULKFORMULA
23     #include "BULKF_ICE_CONSTANTS.h"
24     #endif
25     #ifdef ALLOW_TSEAICE
26     #include "ICE.h"
27     #endif
28    
29     c
30     c calculate bulk formula fluxes over open ocean or seaice
31     c
32     c input
33     _RL us ! wind speed
34     _RL uw ! zonal wind speed (at grid center)
35     _RL vw ! meridional wind speed (at grid center)
36     _RL Ta ! air temperature at ht
37     _RL Qa ! specific humidity at ht
38     _RL nc ! cloud cover
39     _RL tsf_in ! surface temperature (either ice or open water)
40     integer iceornot ! 0=open water, 1=ice cover
41     logical readstress
42     c output
43     _RL flwup ! upward long wave radiation
44     _RL flha ! latent heat flux
45     _RL fsha ! sensible heat flux
46     _RL df0dT ! derivative of heat flux with respect to Tsf
47     _RL ust ! zonal wind stress (at grid center)
48     _RL vst ! meridional wind stress (at grid center)
49     _RL evp ! evaporation rate (over open water)
50     _RL ssq ! surface specific humidity (kg/kg)
51     c
52     c input and output
53     _RL UFocean
54     c
55     c local variables
56     _RL ea
57     _RL mixratio
58     _RL stable
59     _RL tsf ! surface temperature in K
60     _RL ht ! reference height (m)
61     _RL usm ! wind speed limited
62     _RL deltap ! potential temperature diff (K)
63     _RL delq ! specific humidity difference
64     _RL lhcoef
65     _RL shcoef
66     _RL dflhdT ! derivative of latent heat with respect to T
67     _RL dfshdT ! derivative of sensible heat with respect to T
68     _RL dflwupdT ! derivative of long wave with respect to T
69     c from vinces
70     _RL elhx
71     _RL rough
72     _RL cdn
73     _RL surf_emissivity ! ocean or ice emissivity
74     _RL qg
75     _RL rigs
76     _RL dm
77     _RL dh
78     _RL cdm
79     _RL cdh
80     _RL rcdhws
81     _RL Tsv
82     _RL dqssdt
83     _RL x
84     integer lr
85    
86     _RL flwdown ! part of output eventually QQ
87     #ifdef ALLOW_BULKFORMULA
88    
89     _RL AROUGH(20),BROUGH(20),CROUGH(20),DROUGH(20),EROUGH(20)
90     DATA AROUGH/16.59,13.99,10.4,7.35,5.241,3.926,3.126,2.632,2.319,
91     *2.116,1.982,1.893,1.832,1.788,1.757,1.733,1.714,1.699,1.687,1.677/
92     DATA BROUGH/3.245,1.733,0.8481,0.3899,0.1832,0.9026E-1,0.4622E-1,
93     * .241E-1,.1254E-1,.6414E-2,.3199E-2,.1549E-2,.7275E-3,.3319E-3,
94     * .1474E-3,.6392E-4,.2713E-4,.1130E-4,.4630E-5,.1868E-5/
95     DATA CROUGH/5.111,3.088,1.682,.9239,.5626,.3994,.3282,.3017,.299
96     *,.3114,.3324,.3587,.3881,.4186,.4492,.4792,.5082,.5361,.5627,
97     * .5882/
98     DATA DROUGH/1.24,1.02,0.806,0.682,0.661,0.771,0.797,0.895,0.994,
99     * 1.09,1.18,1.27,1.35,1.43,1.50,1.58,1.65,1.71,1.78,1.84/
100     DATA EROUGH/0.128,0.130,0.141,0.174,0.238,0.330,0.438,0.550,0.660,
101     * 0.766,0.866,0.962,1.05,1.14,1.22,1.30,1.37,1.45,1.52,1.58/
102    
103    
104     c --- external functions ---
105     _RL exf_BulkCdn
106     external exf_BulkCdn
107    
108     c UFocean=1e-2 !QQ what is this and what is the number?
109    
110     c -- set all to zero
111     flwup = 0.d0 ! upward long wave radiation
112     flha = 0.d0 ! latent heat flux
113     fsha = 0.d0 ! sensible heat flux
114     df0dT = 0.d0 ! derivative of heat flux with respect to Tsf
115     ust = 0.d0 ! zonal wind stress (at grid center)
116     vst = 0.d0 ! meridional wind stress (at grid center)
117     evp = 0.d0 ! evaporation rate (over open water)
118     ssq = 0.d0 ! surface specific humidity (kg/kg)
119    
120    
121     Qa=max(Qa,1e-7)
122     Tsf=Tsf_in+Tf0kel
123     ht=10.e0
124     c Wind speed
125     if (us.eq.0.d0) then !in case we have a constant prescribed us
126     us = sqrt(uw*uw + vw*vw)
127     endif
128     usm = max(us,1.d-5)
129     cQQQ try to limit drag
130     cQQQ usm = min(usm,5.d0)
131    
132     c from vinces surfflux.F
133     if (iceornot.eq.0) then
134     c for open water
135     rough=max(0.018*UFocean/gravity,0.5E-5) !QQcheck
136     elhx=Lvap !QQcheck
137     else
138     c for sea ice cover
139     rough=10**(-3.37) !QQcheck
140     elhx = Lvap_ice
141     endif
142     Qg =3.797915*exp(elhx*(7.93252e-6-2.166847E-3/Ta))/p0
143     c
144     c find stability of atmospheric surface layer stratification
145     rough=log10(ht/rough)
146     cdn=.0231/(rough*rough) !QQcheck
147     lr=rough*2.d0 - 5.d-1 !QQcheck
148     lr=max(1,min(lr,20))
149     rigs=ht*gravity*(Tsf-Ta)/(Ta*usm*usm)
150     if (rigs.le.0.d0) then
151     c unstable
152     dm=sqrt((1.d0-AROUGH(lr)*rigs)*(1.d0-BROUGH(lr)*rigs)/
153     & (1.d0-CROUGH(lr)*rigs))
154     dh=1.35*sqrt((1.d0-DROUGH(lr)*rigs)/
155     & (1.d0-EROUGH(lr)*rigs)) !QQcheck
156     else
157     c stable
158     dm=1.d0/(1.d0+(11.238+89.9*rigs)*rigs) !QQcheck
159     dh=1.35/(1.d0+1.93*rigs) !QQcheck
160     endif
161     cdm = cdn * dm
162     cdh = cdn * dm * dh
163    
164     rcdhws = cdh*us*100*p0/(Rgas*Tsf) !QQ check units (take out 100)
165     ssq =3.797915*exp(elhx*(7.93252e-6-2.166847E-3/Tsf))/p0
166     cBB debugging
167     cBB print*,'ssq', qcoef, ssq
168     c
169    
170     if (Qa.le.ssq) then
171     Tsv=Tsf
172     ssq=ssq !QQQQ should be ssq=qa?
173     else
174     dqssdt=ssq*elhx/(Rvap*Tsf*Tsf)
175     x=(Qa-ssq)/(dqssdt+(sha/elhx))
176     Tsv=Tsf+x
177     ssq=Qa+x*(sha/elhx)
178     endif
179    
180     deltap = Ta - Tsv !tsv-Ta
181     delq = Qg - ssq !Qsv - Qg
182     cmine deltap = ta - tsf + gamma_blk*ht
183     cmine delq = Qa - ssq
184     c latent heat
185     c -------------
186     cvinc lhcoef = Lvap*rcdhws
187     cmine latent heat coeff. following Gill 2.4.6 and 2.6.2 formula
188     lhcoef =Lvap*rhoa*us*5e-3 !QQ name coeff. !QQwas 1.5e-3
189     flha = lhcoef*delq !QQQ
190     evp = lhcoef*delq/Lvap/rhosw
191     c sensible heat
192     c ----------------
193     cvinc shcoef=sha*rcdhws
194     cmine sensible heat coeff. following Gill 2.4.5 formula
195     stable = 5.d-1 + sign(5.d-1, deltap)
196     if (stable.gt.0) then
197     shcoef = 0.83e-3*rhoa*us*cpair
198     else
199     shcoef = 1.10e-3*rhoa*us*cpair
200     endif
201     fsha = shcoef*deltap
202    
203     c long wave
204     c ------------
205     cvinc if (iceornot.eq.1) then
206     cvinc#ifdef ALLOW_TSEAICE
207     cvinc if (snowheight.gt.0.d0) then
208     cvinc surf_emissivity=snow_emissivity
209     cvinc else
210     cvinc surf_emissivity=ice_emissivity
211     cvinc endif
212     cvinc#endif
213     cvinc else
214     cvinc surf_emissivity=ocean_emissivity
215     cvinc endif
216     cvinc flwup = -surf_emissivity*stefan*
217     cvinc & Tsf**4.0 !QQcheck
218     cvinc flwdown = atm_emissivity*stefan *
219     cvinc & Ta**4.0 * (1.0+0.275*nc) *
220     cvinc & (1.0-0.261*exp(-7.77e-4*(273.15-Ta)**2.0)) !QQcheck
221     cvinc flwup=flwup+flwdown !QQQQQ??
222     cmine up (net) long wave radiation
223     mixratio=Qa/(1-Qa)
224     ea=p0*mixratio/(0.62197+mixratio)
225     flwup=-0.985*stefan*tsf**4
226     & *(0.39-0.05*sqrt(ea))
227     & *(1-0.6*nc**2)
228     c -------------------------
229     UFocean=cdm*us*us
230    
231     #ifdef ALLOW_TSEAICE
232     if (iceornot.eq.1) then
233     c derivatives of heat flux
234     c -------------------------
235     c dflwupdT=-4.0*surf_emissivity*stefan *
236     c & Tsf**3.0 !QQcheck
237     cQQ corrected for Vince formula
238     dflhdT = -lhcoef*ssq*Lvap*2.166847E-3/(Tsf**2)
239     dfshdT = -shcoef !QQQQQQ not quite right
240     cmine derivatives with respect to Tsf
241     cmine dflhdT = -lhcoef*Tf0kel*ssq*22.47/(tsf**2)
242     cmine dfshdT = -shcoef
243     dflwupdT=-4.*0.985*stefan*tsf**3
244     & *(0.39-0.05*sqrt(ea))
245     c
246     c total derivative with respect to surface temperature
247     df0dT=dflwupdT+dfshdT+dflhdT
248     cBB
249     cBB print*,'derivatives:',df0dT,dflwupdT,dfshdT,dflhdT
250     endif
251     #endif /*ALLOW_TSEAICE*/
252     c
253     c wind stress at center points
254     c -----------------------------
255     if (.NOT.readstress) then
256     ust = rhoa*exf_BulkCdn(usm)*us*uw
257     vst = rhoa*exf_BulkCdn(usm)*us*vw
258     endif
259     #endif /*ALLOW_BULKFORMULA*/
260    
261     return
262     end

  ViewVC Help
Powered by ViewVC 1.1.22