| blob | f1592a1f002951b4f5cc5cf791c5f15ee065c24a |
1 !WRF:MEDIATION_LAYER:PHYSICS
2 !
3 MODULE module_surface_driver
4 real, private, parameter :: QVAPOR_MIN = 0.0, SMOIS_MIN = 0.0, SMOIS_MAX = 1.0
5 CONTAINS
7 SUBROUTINE surface_driver( &
8 & HYDRO_dt,sfcheadrt,INFXSRT,soldrain, &
9 & qtiledrain,ZWATBLE2D, & ! tile drainage for WRF-Hydro
10 & acgrdflx,achfx,aclhf &
11 & ,acsnom,acsnow,snowfallac,akhs,akms,albedo,br,canwat &
12 & ,chklowq,dt,dx,dx2d,area2d,dz8w,dzs,glw &
13 & ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx &
14 & ,fractional_seaice,seaice_albedo_opt &
15 & ,seaice_albedo_default,seaice_thickness_opt, &
16 & seaice_thickness_default &
17 & ,seaice_snowdepth_opt,seaice_snowdepth_max &
18 & ,seaice_snowdepth_min,tice2tsk_if2cold &
19 & ,ifndalbsi, ifndicedepth, ifndsnowsi &
20 & ,isltyp,itimestep,julian_in,ivgtyp,lowlyr,mavail,rmol &
21 & ,num_soil_layers,p8w,pblh,pi_phy,pshltr,fm,fhh,psih &
22 & ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0 &
23 & ,raincv,rho,sfcevp,sfcexc,sfcrunoff ,acrunoff &
24 & ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl &
25 & ,smcrel &
26 & ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb &
27 & ,tyr,tyra,tdly,tlag,lagday,nyear,nday,tmn_update,yr &
28 & ,t_phy,u10,udrunoff,ust,uz0 &
29 & ,u_frame,u_phy,v10,vegfra,u10e,v10e,uoce,voce &
30 & ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt &
31 & ,max_edom,cplmask &
32 & ,zs &
33 & ,albsi, icedepth,snowsi &
34 & ,xicem,isice,iswater,ct,tke_pbl &
35 & ,albbck,embck,lh,sh2o,shdmax,shdmin,z0 &
36 & ,flqc,flhc,psfc,sst,sst_input,sstsk,dtw,sst_update,sst_skin &
37 & ,scm_force_skintemp,scm_force_flux,t2,emiss &
38 & ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics &
39 & ,bl_pbl_physics &
40 & ,mosaic_lu,mosaic_soil &
41 & ,landusef,soilctop,soilcbot,ra,rs,nlcat,nscat,vegf_px & ! PX-LSM
42 & ,snowncv, anal_interval, lai, imperv, canfra & ! PX-LSM
43 & ,pxlsm_smois_init, pxlsm_soil_nudge & ! PX-LSM
44 & ,pxlsm_modis_veg, lai_px, wwlt_px, wfc_px & ! PX-LSM
45 & ,wsat_px, clay_px, csand_px, fmsand_px & ! PX-LSM
46 & ,idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz &
47 & ,iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot ,iopt_stc &
48 & ,iopt_gla ,iopt_rsf ,iopt_soil ,iopt_pedo ,iopt_crop ,iopt_irr &
49 & ,iopt_irrm,iopt_infdv,iopt_tdrn ,soiltstep &
50 & ,soilcomp , soilcl1, soilcl2, soilcl3, soilcl4 &
51 & ,isnowxy ,tvxy ,tgxy ,canicexy ,canliqxy ,eahxy &
52 & ,tahxy ,cmxy ,chxy ,fwetxy ,sneqvoxy ,alboldxy &
53 & ,qsnowxy ,qrainxy ,wslakexy ,zwtxy ,waxy, wtxy, tsnoxy &
54 & ,zsnsoxy ,snicexy ,snliqxy ,lfmassxy ,rtmassxy ,stmassxy &
55 & ,woodxy ,stblcpxy ,fastcpxy ,xsaixy ,taussxy &
56 & ,grainxy ,gddxy ,cropcat ,pgsxy &
57 & ,planting ,harvest ,season_gdd &
58 & ,t2mvxy ,t2mbxy ,q2mvxy ,q2mbxy &
59 & ,tradxy ,neexy ,gppxy ,nppxy ,fvegxy ,runsfxy &
60 & ,runsbxy ,ecanxy ,edirxy ,etranxy ,fsaxy ,firaxy &
61 & ,aparxy ,psnxy ,savxy ,sagxy ,rssunxy ,rsshaxy &
62 & ,bgapxy ,wgapxy ,tgvxy ,tgbxy ,chvxy ,chbxy &
63 & ,shgxy ,shcxy ,shbxy ,evgxy ,evbxy ,ghvxy &
64 & ,ghbxy ,irgxy ,ircxy ,irbxy ,trxy ,evcxy &
65 & ,chleafxy ,chucxy ,chv2xy ,chb2xy ,chstarxy &
66 ! Noah-MP extra output fields
67 & ,qintsxy ,qintrxy ,qdripsxy ,qdriprxy ,qthrosxy ,qthrorxy &
68 & ,qsnsubxy ,qsnfroxy ,qsubcxy ,qfrocxy ,qevacxy ,qdewcxy &
69 & ,qfrzcxy ,qmeltcxy ,qsnbotxy ,pondingxy ,PAHXY ,PAHGXY &
70 & ,PAHVXY ,PAHBXY ,qmeltxy &
71 & ,fpicexy ,RAINLSM ,SNOWLSM ,forctlsm ,forcqlsm ,forcplsm &
72 & ,forczlsm ,forcwlsm ,acc_ssoil,acc_qinsur,acc_qseva ,acc_etrani &
73 & ,eflxbxy ,soilenergy,snowenergy, canhsxy &
74 & ,ACC_DWATERXY, ACC_PRCPXY, ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY &
75 ! Noah-MP irrigation
76 & ,IRFRACT ,SIFRACT ,MIFRACT ,FIFRACT ,IRNUMSI ,IRNUMMI &
77 & ,IRNUMFI ,IRWATSI ,IRWATMI ,IRWATFI ,IRELOSS ,IRSIVOL &
78 & ,IRMIVOL ,IRFIVOL ,IRRSPLH &
79 ! Noah-MP tile drainage
80 & ,QTDRAIN ,TD_FRACTION &
81 ! Noah-MP ground water
82 & ,smcwtdxy ,rechxy ,deeprechxy,fdepthxy,areaxy ,rivercondxy, riverbedxy &
83 & ,eqzwt ,pexpxy ,qrfxy ,qspringxy,qslatxy ,qrfsxy, qlatxy, qspringsxy &
84 & ,smoiseq ,wtddt ,stepwtd &
85 ,gecros_state & ! Optional gecros crop
86 & ,opt_thcnd &
87 ! Noah UA changes
88 & ,ua_phys,flx4,fvb,fbur,fgsn &
89 #if (EM_CORE==1)
90 & ,ch,fgdp,dfgdp,vdfg,grav_settling & ! Katata - fog dep
91 #endif
92 & ,shalwater_z0,water_depth,shalwater_depth &
93 & ,lakedepth2d, savedtke12d, snowdp2d, h2osno2d & !lake
94 & ,snl2d, t_grnd2d, t_lake3d, lake_icefrac3d & !lake
95 & ,z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d & !lake
96 & ,h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d & !lake
97 & ,zi3d, watsat3d, csol3d, tkmg3d & !lake
98 & ,tkdry3d, tksatu3d, LakeModel, lake_min_elev & !lake
99 #if (EM_CORE==1)
100 ! & ,lakemask, lakeflag & !lake
101 & ,lakemask & !lake
102 , restart_flag & ! restart_flag
103 #endif
104 ! cyl ocean variable
105 ,OM_TMP,OM_S,OM_U,OM_V,OM_DEPTH,OM_ML,OM_LON &
106 & ,OM_LAT,okms,okme,rdx,rdy,msfu,msfv,msft &
107 & ,XTIME,OM_TINI,OM_SINI,id,omdt &
108 ! CLM variables, some only included if WRF_CHEM is compiled BJG 3/28/19
109 #if ( WRF_CHEM == 1)
110 & ,e_bio,ne_area &
111 #endif
112 ,do_bioe,do_meganfile &
113 & ,numc,nump,sabv,sabg,lwup,snl,history_interval &
114 & ,snowdp,wtc,wtp,h2osno,t_grnd,t_veg, &
115 & h2ocan,h2ocan_col,t2m_max,t2m_min,t2clm , &
116 & t_ref2m,h2osoi_liq_s1, &
117 & h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4, &
118 & h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2, &
119 & h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6, &
120 & h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10, &
121 & h2osoi_ice_s1,h2osoi_ice_s2, &
122 & h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5, &
123 & h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4, &
124 & h2osoi_ice5,h2osoi_ice6,h2osoi_ice7, &
125 & h2osoi_ice8,h2osoi_ice9,h2osoi_ice10, &
126 & t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4, &
127 & t_soisno_s5,t_soisno1,t_soisno2,t_soisno3, &
128 & t_soisno4,t_soisno5,t_soisno6,t_soisno7, &
129 & t_soisno8,t_soisno9,t_soisno10, &
130 & dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5, &
131 & snowrds1,snowrds2,snowrds3,snowrds4,snowrds5, &
132 & t_lake1,t_lake2,t_lake3,t_lake4,t_lake5, &
133 & t_lake6,t_lake7,t_lake8,t_lake9,t_lake10, &
134 & h2osoi_vol1,h2osoi_vol2,h2osoi_vol3, &
135 & h2osoi_vol4,h2osoi_vol5,h2osoi_vol6, &
136 & h2osoi_vol7,h2osoi_vol8, &
137 & h2osoi_vol9,h2osoi_vol10, &
138 & maxpatch,inest, &
139 & ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid, &
140 & Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid, &
141 & SWUPsubgrid,LHsoi,LHveg,LHtran &
142 !sw++
143 & ,t_veg24, t_veg240, fsun24, fsun240, &
144 & fsd24, fsd240, fsi24, fsi240, laip &
145 !sw--
146 #ifdef CN
147 !ADD_NEW_VAR for crop and cn
148 & ,dyntlai,dyntsai,dyntop,dynbot &
149 & ,htmx,croplive,gdd1020,gdd820,gdd020,grainc,grainc_storage &
150 & ,grainc_xfer,grainn,grainn_storage,grainn_xfer,days_active &
151 & ,onset_flag,onset_counter,onset_gddflag,onset_fdd,onset_gdd &
152 & ,onset_swi,offset_flag,offset_counter,offset_fdd,offset_swi &
153 & ,dayl,annavg_t2m,tempavg_t2m,tempsum_potential_gpp &
154 & ,annsum_potential_gpp,tempmax_retransn,annmax_retransn &
155 & ,prev_leafc_to_litter,prev_frootc_to_litter,tempsum_npp &
156 & ,annsum_npp,leafc,leafc_storage,leafc_xfer,frootc &
157 & ,frootc_storage,frootc_xfer,livestemc,livestemc_storage &
158 & ,livestemc_xfer,deadstemc,deadstemc_storage,deadstemc_xfer &
159 & ,livecrootc,livecrootc_storage,livecrootc_xfer,deadcrootc &
160 & ,deadcrootc_storage,deadcrootc_xfer,cpool,pft_ctrunc &
161 & ,leafn,leafn_storage,leafn_xfer,frootn,frootn_storage &
162 & ,frootn_xfer,livestemn,livestemn_storage,livestemn_xfer &
163 & ,deadstemn,deadstemn_storage,deadstemn_xfer,livecrootn &
164 & ,livecrootn_storage,livecrootn_xfer,deadcrootn &
165 & ,deadcrootn_storage,deadcrootn_xfer,npool,pft_ntrunc &
166 & ,gresp_storage,gresp_xfer,xsmrpool,annsum_counter &
167 & ,cannsum_npp,cannavg_t2m,wf,me,mean_fire_prob,cwdc,litr1c &
168 & ,litr2c,litr3c,soil1c,soil2c,soil3c,soil4c,seedc,col_ctrunc &
169 & ,prod10c,prod100c,cwdn,litr1n,litr2n,litr3n,soil1n,soil2n &
170 & ,soil3n,soil4n,seedn,col_ntrunc,prod10n,prod100n,sminn &
171 & ,totlitc,dwt_seedc_to_leaf,dwt_seedc_to_deadstem,dwt_conv_cflux &
172 & ,dwt_prod10c_gain,dwt_prod100c_gain,prod100c_loss,dwt_frootc_to_litr1c &
173 & ,dwt_frootc_to_litr2c,dwt_frootc_to_litr3c,dwt_livecrootc_to_cwdc &
174 & ,dwt_deadcrootc_to_cwdc,dwt_seedn_to_leaf,dwt_seedn_to_deadstem &
175 & ,dwt_conv_nflux,dwt_prod10n_gain,dwt_prod100n_gain,prod100n_loss &
176 & ,dwt_frootn_to_litr1n,dwt_frootn_to_litr2n, dwt_frootn_to_litr3n &
177 & ,dwt_livecrootn_to_cwdn,dwt_deadcrootn_to_cwdn,retransn &
178 #endif
179 !sw++
180 ,pct_pft_input,num_pft_input,input_pft_flag &
181 !sw--
182 ! Optional urban
183 & ,slope_rad,topo_shading,shadowmask & !I solar
184 & ,swnorm,slope,slp_azi,diffuse_frac & !I solar
185 & ,declin,solcon,coszen,hrang,xlat_urb2d & !I solar/urban
186 & ,num_roof_layers, num_wall_layers & !I urban
187 & ,num_road_layers, dzr, dzb, dzg & !I urban
188 & ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d & !H urban
189 & ,uc_urb2d & !H urban
190 & ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d & !H urban
191 & ,cmcr_urb2d,tgr_urb2d,tgrl_urb3d,smr_urb3d & !H urban
192 & ,julian,julyr,drelr_urb2d,drelb_urb2d,drelg_urb2d & !H urban
193 & ,flxhumr_urb2d,flxhumb_urb2d,flxhumg_urb2d & !H urban
194 & ,trl_urb3d,tbl_urb3d,tgl_urb3d & !H urban
195 & ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d & !H urban
196 & ,frc_urb2d, utype_urb2d & !H urban
197 & ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
198 & ,cmgr_sfcdif,chgr_sfcdif &
199 !-----SSiB LSM (fds 06/2010)---------------------------------------------------
200 & ,alswvisdir, alswvisdif, alswnirdir, alswnirdif & ! ssib
201 & ,swvisdir, swvisdif, swnirdir, swnirdif & ! ssib
202 & ,ssib_br ,ssib_fm ,ssib_fh ,ssib_cm ,ssibxdd & ! ssib
203 & ,ssib_lhf ,ssib_shf ,ssib_ghf ,ssib_egs ,ssib_eci & ! ssib
204 & ,ssib_ect ,ssib_egi ,ssib_egt ,ssib_sdn ,ssib_sup & ! ssib
205 & ,ssib_ldn ,ssib_lup ,ssib_wat ,ssib_shc ,ssib_shg & ! ssib
206 & ,ssib_lai ,ssib_vcf ,ssib_z00 ,ssib_veg & ! ssib
207 & ,ISNOW ,SWE ,SNOWDEN ,SNOWDEPTH ,TKAIR & ! ssib-snow
208 & ,DZO1 ,WO1 ,TSSN1 ,TSSNO1 ,BWO1 ,BTO1 & ! ssib-snow
209 & ,CTO1 ,FIO1 ,FLO1 ,BIO1 ,BLO1 ,HO1 & ! ssib-snow
210 & ,DZO2 ,WO2 ,TSSN2 ,TSSNO2 ,BWO2 ,BTO2 & ! ssib-snow
211 & ,CTO2 ,FIO2 ,FLO2 ,BIO2 ,BLO2 ,HO2 & ! ssib-snow
212 & ,DZO3 ,WO3 ,TSSN3 ,TSSNO3 ,BWO3 ,BTO3 & ! ssib-snow
213 & ,CTO3 ,FIO3 ,FLO3 ,BIO3 ,BLO3 ,HO3 & ! ssib-snow
214 & ,DZO4 ,WO4 ,TSSN4 ,TSSNO4 ,BWO4 ,BTO4 & ! ssib-snow
215 & ,CTO4 ,FIO4 ,FLO4 ,BIO4 ,BLO4 ,HO4 & ! ssib-snow
216 & ,ra_sw_physics & ! ssib
217 !------------------------------------------------------------------------------
218 & , ids,ide,jds,jde,kds,kde &
219 & , ims,ime,jms,jme,kms,kme &
220 & , ips,ipe,jps,jpe,kps,kpe &
221 & , i_start,i_end,j_start,j_end,kts,kte,num_tiles &
222 ! Optional moisture tracers
223 & ,qv_curr, qc_curr, qr_curr &
224 & ,qi_curr, qs_curr, qg_curr &
225 ! Optional moisture tracer flags
226 & ,f_qv,f_qc,f_qr &
227 & ,f_qi,f_qs,f_qg &
228 ! Other optionals (more or less em specific)
229 & ,capg,hol,mol &
230 & ,rainncv,rainshv,rainbl,regime,thc,graupelncv,hailncv &
231 & ,qsg,qvg,qcg,soilt1,tsnav &
232 & ,smfr3d,keepfr3dflag,dew,rhosnf,precipfr &
233 ! Other optionals (more or less nmm specific)
234 & ,potevp,snopcx,soiltb,sr &
235 ! Optional observation PX LSM surface nudging
236 & ,t2_ndg_old, q2_ndg_old, t2_ndg_new, q2_ndg_new &
237 & ,sn_ndg_old, sn_ndg_new &
238 & ,t2obs, q2obs &
239 ! OPTIONAL, Required by TEMF surface layer 1/7/09 WA
240 & ,hd_temf,te_temf,fCor,exch_temf,wm_temf &
241 ! Required by ideal SCM surface layer 1/6/10 WA
242 & ,hfx_force,lh_force,tsk_force &
243 & ,hfx_force_tend,lh_force_tend,tsk_force_tend &
244 ! Optional observation nudging
245 & ,uratx,vratx,tratx &
246 ! Optional ocean model
247 & ,sf_ocean_physics,oml_hml0,oml_gamma &
248 & ,tml,t0ml,hml,h0ml,huml,hvml,f,tmoml &
249 & ,oml_relaxation_time &
250 & ,ustm,ck,cka,cd,cda,isftcflx,iz0tlnd &
251 & ,isurban, mminlu &
252 & ,snotime &
253 & ,rdlai2d &
254 & ,usemonalb &
255 & ,noahres &
256 ! Optional adaptive time step
257 & ,bldt,curr_secs,adapt_step_flag,bldtacttime &
258 ! Optional urban with BEP
259 & ,sf_urban_physics,gmt,xlat,xlong,julday &
260 & ,num_urban_ndm & !multi-layer urban
261 & ,urban_map_zrd & !multi-layer urban
262 & ,urban_map_zwd & !multi-layer urban
263 & ,urban_map_gd & !multi-layer urban
264 & ,urban_map_zd & !multi-layer urban
265 & ,urban_map_zdf & !multi-layer urban
266 & ,urban_map_bd & !multi-layer urban
267 & ,urban_map_wd & !multi-layer urban
268 & ,urban_map_gbd & !multi-layer urban
269 & ,urban_map_fbd & !multi-layer urban
270 & ,urban_map_zgrd & !multi-layer urban
271 & ,num_urban_hi & !multi-layer urban
272 & ,use_wudapt_lcz & !wudapt
273 & ,tsk_rural & !multi-layer urban
274 & ,trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d & !multi-layer urban
275 & ,tlev_urb3d,qlev_urb3d & !multi-layer urban
276 & ,tw1lev_urb3d,tw2lev_urb3d & !multi-layer urban
277 & ,tglev_urb3d,tflev_urb3d & !multi-layer urban
278 & ,sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d & !multi-layer urban
279 & ,sfvent_urb3d,lfvent_urb3d & !multi-layer urban
280 & ,sfwin1_urb3d,sfwin2_urb3d & !multi-layer urban
281 & ,sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d & !multi-layer urban
282 & ,ep_pv_urb3d,t_pv_urb3d & !multi-layer urban GRZ
283 & ,trv_urb4d,qr_urb4d,qgr_urb3d,tgr_urb3d & !multi-layer urban GRZ
284 & ,drain_urb4d,draingr_urb3d & !multi-layer urban GRZ
285 & ,sfrv_urb3d,lfrv_urb3d & !multi-layer urban GRZ
286 & ,dgr_urb3d,dg_urb3d & !multi-layer urb;:an GRZ
287 & ,lfr_urb3d,lfg_urb3d & !multi-layer urban GRZ
288 & ,swddir,swddif & !gl
289 & ,lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d & !multi-layer urban
290 & ,mh_urb2d,stdh_urb2d,lf_urb2d &
291 & ,a_u_bep,a_v_bep,a_t_bep,a_q_bep &
292 & ,b_u_bep,b_v_bep,b_t_bep,b_q_bep &
293 & ,sf_bep,vl_bep &
294 & ,a_e_bep,b_e_bep,dlg_bep &
295 & ,dl_u_bep &
296 & ,tsk_save & !for fractional seaice
297 & ,cldfra & !ssib
298 & ,sf_surface_mosaic,mosaic_cat,mosaic_cat_index & !danli mosaic
299 & ,landusef2,TSK_mosaic,QSFC_mosaic,TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic & !danli mosaic
300 & ,CANWAT_mosaic,SNOW_mosaic,SNOWH_mosaic,SNOWC_mosaic & !danli mosaic
301 & ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic & !danli mosaic
302 & ,HFX_mosaic,QFX_mosaic, LH_mosaic, GRDFLX_mosaic,SNOTIME_mosaic & !danli mosaic
303 & ,RS_mosaic,LAI_mosaic & !mosaic
304 & ,TR_URB2D_mosaic,TB_URB2D_mosaic & !danli mosaic
305 & ,TG_URB2D_mosaic,TC_URB2D_mosaic & !danli mosaic
306 & ,QC_URB2D_mosaic,UC_URB2D_mosaic & !danli mosaic
307 & ,TRL_URB3D_mosaic,TBL_URB3D_mosaic & !danli mosaic
308 & ,TGL_URB3D_mosaic & !danli mosaic
309 & ,SH_URB2D_mosaic,LH_URB2D_mosaic & !danli mosaic
310 & ,G_URB2D_mosaic,RN_URB2D_mosaic & !danli mosaic
311 & ,TS_URB2D_mosaic & !danli mosaic
312 & ,TS_RUL2D_mosaic & !danli mosaic
313 & ,ZOL & !ckay
314 & ,SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM, fasdas & !fasdas
315 & ,spp_lsm,pattern_spp_lsm,field_sf & !SPP
316 & ,spp_pbl,pattern_spp_pbl & !SPP
317 & ,XLAIDYN &
318 ! WRF-Solar EPS
319 & ,multi_perturb &
320 & ,pert_noah, perts_qvapor, perts_th, perts_smois &
321 & ,perts_tsoil, pert_noah_qv, pert_noah_t &
322 & ,pert_noah_smois, pert_noah_tslb &
323 & ,irrigation,sf_surf_irr_scheme, irr_daily_amount & !IRRIG
324 & ,irr_start_hour,irr_num_hours,irr_start_julianday &
325 & ,irr_end_julianday,irr_freq,irr_ph,irr_rand_field &
326 & )
328 USE module_state_description, ONLY : SFCLAYSCHEME &
329 ,SFCLAYREVSCHEME &
330 ,MYJSFCSCHEME &
331 ,QNSESFCSCHEME &
332 ,MYJPBLSCHEME &
333 ,QNSEPBLSCHEME &
334 ,GFSSFCSCHEME &
335 ,PXSFCSCHEME &
336 ,NOAHMPSCHEME &
337 ,TEMFSFCSCHEME &
338 ,IDEALSCMSFCSCHEME &
339 ,SLABSCHEME &
340 ,LSMSCHEME &
341 ,RUCLSMSCHEME &
342 ,PXLSMSCHEME &
343 ,CLMSCHEME &
344 ,CTSMSCHEME &
345 ,SSIBSCHEME & !ssib
346 ,MYNNSFCSCHEME &
347 ,OMLSCHEME &
348 ,PWP3DSCHEME &
349 ,DRIP &
350 ,CHANNEL
354 USE module_model_constants
355 ! *** add new modules of schemes here
356 USE module_irrigation
357 USE module_sf_sfclay
358 USE module_sf_myjsfc
359 USE module_sf_qnsesfc
360 USE module_sf_gfs
361 USE module_sf_noahdrv ! danli mosaic, the " ,only : lsm " needs to be deleted
362 USE module_sf_noahlsm, only : LCZ_1,LCZ_2,LCZ_3,LCZ_4,LCZ_5,LCZ_6,LCZ_7,LCZ_8,LCZ_9,LCZ_10,LCZ_11
363 USE module_sf_noahmpdrv, only : noahmplsm, noahmp_urban
364 USE module_sf_noahmp_groundwater
365 USE module_sf_noah_seaice_drv
366 #ifdef WRF_USE_CLM
367 USE module_sf_clm
368 #endif
369 #ifdef WRF_USE_CTSM
370 USE module_sf_ctsm, only : ctsm_run
371 #endif
372 USE module_sf_ssib ! ssib
373 USE module_sf_ruclsm
374 USE module_sf_pxsfclay
375 USE module_sf_pxlsm
376 USE module_sf_temfsfclay
377 USE module_sf_sfclayrev
378 USE module_sf_noah_seaice_drv
379 #if ( EM_CORE==1)
380 USE module_sf_mynn
381 USE module_sf_fogdes ! Katata - fog deposition module
382 USE module_sf_ocean_driver
383 USE module_sf_idealscmsfclay
384 #endif
385 USE module_sf_scmflux
386 USE module_sf_scmskintemp
388 USE module_sf_slab
389 !
390 USE module_sf_sfcdiags
391 USE module_sf_sfcdiags_ruclsm
392 USE module_sf_sstskin
393 USE module_sf_tmnupdate
394 USE module_sf_lake
395 USE module_cpl, ONLY : coupler_on, cpl_rcv
396 !
397 ! This driver calls subroutines for the surface parameterizations.
398 !
399 ! surface layer: (between surface and pbl)
400 ! 1. sfclay
401 ! 2. myjsfc
402 ! 7. Pleim surface layer
403 ! 5. MYNN surface layer
404 ! surface: ground temp/lsm scheme:
405 ! 1. slab
406 ! 2. Noah LSM
407 ! 7. Pleim-Xiu LSM
408 ! 11. Revised sfclay (option 1)
409 !
410 ! surface: ground temp/lsm scheme for urban:
411 ! 2. BEP
412 !
413 ! ocean mixed layer model
414 ! sf_ocean_physics = 1
415 ! ocean 3d PWP
416 ! sf_ocean_physics = 2
417 !------------------------------------------------------------------
418 IMPLICIT NONE
419 !======================================================================
420 ! Grid structure in physics part of WRF
421 !----------------------------------------------------------------------
422 ! The horizontal velocities used in the physics are unstaggered
423 ! relative to temperature/moisture variables. All predicted
424 ! variables are carried at half levels except w, which is at full
425 ! levels. Some arrays with names (*8w) are at w (full) levels.
426 !
427 !----------------------------------------------------------------------
428 ! In WRF, kms (smallest number) is the bottom level and kme (largest
429 ! number) is the top level. In your scheme, if 1 is at the top level,
430 ! then you have to reverse the order in the k direction.
431 !
432 ! kme - half level (no data at this level)
433 ! kme ----- full level
434 ! kme-1 - half level
435 ! kme-1 ----- full level
436 ! .
437 ! kms+2 - half level
438 ! kms+2 ----- full level
439 ! kms+1 - half level
440 ! kms+1 ----- full level
441 ! kms - half level
442 ! kms ----- full level
443 !
444 !======================================================================
445 ! Definitions
446 !-----------
447 ! Theta potential temperature (K)
448 ! Qv water vapor mixing ratio (kg/kg)
449 ! Qc cloud water mixing ratio (kg/kg)
450 ! Qr rain water mixing ratio (kg/kg)
451 ! Qi cloud ice mixing ratio (kg/kg)
452 ! Qs snow mixing ratio (kg/kg)
453 !-----------------------------------------------------------------
454 !-- itimestep number of time steps
455 !-- GLW downward long wave flux at ground surface (W/m^2)
456 !-- GSW net short wave flux at ground surface (W/m^2)
457 !-- SWDOWN downward short wave flux at ground surface (W/m^2)
458 !-- EMISS surface emissivity (between 0 and 1)
459 !-- TSK surface temperature (K)
460 !-- TMN soil temperature at lower boundary (K)
461 !-- TYR annual mean surface temperature of previous year (K)
462 !-- TYRA accumulated surface temperature in the current year (K)
463 !-- TLAG mean surface temperature of previous 140 days (K)
464 !-- TDLY accumulated daily mean surface temperature of the current day (K)
465 !-- XLAND land mask (1 for land, 2 for water)
466 !-- MAX_EDOM number of external model domains
467 !-- CPLMASK coupling mask (0 for data read in wrflowinput, 1 data received from the coupler)
468 !-- ZNT thermal time-varying roughness length (m)
469 !-- MZNT momentum time-varying roughness length (m)
470 !-- Z0 background roughness length (m)
471 !-- MAVAIL surface moisture availability (between 0 and 1)
472 !-- UST u* in similarity theory (m/s)
473 !-- MOL T* (similarity theory) (K)
474 !-- HOL PBL height over Monin-Obukhov length
475 !-- PBLH PBL height (m)
476 !-- CAPG heat capacity for soil (J/K/m^3)
477 !-- THC thermal inertia (Cal/cm/K/s^0.5)
478 !-- SNOWC flag indicating snow coverage (1 for snow cover)
479 !-- HFX net upward heat flux at the surface (W/m^2)
480 !-- QFX net upward moisture flux at the surface (kg/m^2/s)
481 !-- TAUX RHO*U**2 for ocean coupling
482 !-- TAUY RHO*U**2 for ocean coupling
483 !-- LH net upward latent heat flux at surface (W/m^2)
484 !-- REGIME flag indicating PBL regime (stable, unstable, etc.)
485 !-- tke_pbl turbulence kinetic energy from PBL schemes (m^2/s^2)
486 !-- akhs sfc exchange coefficient of heat/moisture from MYJ
487 !-- akms sfc exchange coefficient of momentum from MYJ
488 !-- thz0 potential temperature at roughness length (K)
489 !-- uz0 u wind component at roughness length (m/s)
490 !-- vz0 v wind component at roughness length (m/s)
491 !-- qsfc specific humidity at lower boundary (kg/kg)
492 !-- uratx ratio of u over u10 (Added for obs-nudging)
493 !-- vratx ratio of v over v10 (Added for obs-nudging)
494 !-- tratx ratio of t over th2 (Added for obs-nudging)
495 !-- u10 diagnostic 10-m u component from surface layer
496 !-- v10 diagnostic 10-m v component from surface layer
497 !-- UOCE sea surface zonal currents (m s-1)
498 !-- VOCE sea surface meridional currents (m s-1)
499 !-- th2 diagnostic 2-m theta from surface layer and lsm
500 !-- t2 diagnostic 2-m temperature from surface layer and lsm
501 !-- q2 diagnostic 2-m mixing ratio from surface layer and lsm
502 !-- tshltr diagnostic 2-m theta from MYJ
503 !-- th10 diagnostic 10-m theta from MYJ
504 !-- qshltr diagnostic 2-m specific humidity from MYJ
505 !-- q10 diagnostic 10-m specific humidity from MYJ
506 !-- lowlyr index of lowest model layer above ground
507 !-- rr dry air density (kg/m^3)
508 !-- u_phy u-velocity interpolated to theta points (m/s)
509 !-- v_phy v-velocity interpolated to theta points (m/s)
510 !-- th_phy potential temperature (K)
511 !-- moist moisture array (4D - last index is species) (kg/kg)
512 !-- p_phy pressure (Pa)
513 !-- pi_phy exner function (dimensionless)
514 !-- pshltr diagnostic shelter (2m) pressure from MYJ (Pa)
515 !-- p8w pressure at full levels (Pa)
516 !-- t_phy temperature (K)
517 !-- dz8w dz between full levels (m)
518 !-- z height above sea level (m)
519 !-- DX nominal horizontal space interval (m)
520 !-- DX2D horizontal space interval (m), sqrt(dx/mftx * dy/mfty)
521 !-- AREA2D horizontal cell area (m^2), (dx/mftx * dy/mfty)
522 !-- DT time step (second)
523 !-- PSFC pressure at the surface (Pa)
524 !-- SST sea-surface temperature (K)
525 !-- SST_INPUT sea-surface temperature read in wrflowinput (K) (= SST if no coupling)
526 !-- SSTSK skin sea-surface temperature (K)
527 !-- DTW warm layer temp diff (K)
528 !-- TSLB
529 !-- ZS
530 !-- DZS
531 !-- num_soil_layers number of soil layer
532 !-- IFSNOW ifsnow=1 for snow-cover effects
533 !-- sf_ocean_physics whether to call ocean model from slab (1 = oml, 2=3d PWP)
534 !-- oml_hml0 initial mixed layer depth (if real-data not available, default 50 m)
535 !-- oml_gamma lapse rate below mixed layer in ocean (default 0.14 K m-1)
536 !-- oml_relaxation_time time the oml will take to get back to its original state (seconds)
537 !-- ck enthalpy exchange coeff at 10 meters
538 !-- cd momentum exchange coeff at 10 meters
539 !-- cka enthalpy exchange coeff at the lowest model level
540 !-- cda momentum exchange coeff at the lowest model level
541 !!!!!!!!!!!!!!
542 !
543 !
544 !-- LANDUSEF Landuse fraction ! P-X LSM
545 !-- SOILCTOP Top soil fraction ! P-X LSM
546 !-- SOILCBOT Bottom soil fraction ! P-X LSM
547 !-- RA Aerodynamic resistence ! P-X LSM
548 !-- RS Stomatal resistence ! P-X LSM, also from Noah lsm, lsm_mosaic, or noahmp
549 !-- VEGF_PX PX LSM internal LU-based Veg Fraction ! P-X LSM
550 !-- IMPERV Impervious surface fraction ! P-X LSM
551 !-- CANFRA Canopy/Tree fraction ! P-X LSM
552 !-- NLCAT Number of landuse categories ! P-X LSM
553 !-- NSCAT Number of soil categories ! P-X LSM
554 !-- pxlsm_modis_veg Flag for using MODIS vegeation LAI and vegF (1 is yes) ! P-X LSM
555 !-- LAI_PX Computed LAI for PX (m^2/m^2) ! P-X LSM
556 !-- WWLT_PX Computed soil wilting point for PX (m^3/m^3) ! P-X LSM
557 !-- WFC_PX Computed soil field capacity for PX (m^3/m^3) ! P-X LSM
558 !-- WSAT_PX Computed soil saturation for PX (m^3/m^3) ! P-X LSM
559 !-- CLAY_PX Aggregated soil clay fraction for PX (%) ! P-X LSM
560 !-- CSAND_PX Aggregated soil coarse sand fraction for PX (%) ! P-X LSM
561 !-- FMSAND_PX Aggregated soil fine-medium sand fraction for PX (%) ! P-X LSM
562 !-- ch - drag coefficient for heat/moisture ! MYNN LSM
564 !
565 !-- ids start index for i in domain
566 !-- ide end index for i in domain
567 !-- jds start index for j in domain
568 !-- jde end index for j in domain
569 !-- kds start index for k in domain
570 !-- kde end index for k in domain
571 !-- ims start index for i in memory
572 !-- ime end index for i in memory
573 !-- jms start index for j in memory
574 !-- jme end index for j in memory
575 !-- kms start index for k in memory
576 !-- kme end index for k in memory
577 !-- ips start index for i in patch
578 !-- ipe end index for i in patch
579 !-- jps start index for j in patch
580 !-- jpe end index for j in patch
581 !-- kps start index for k in patch
582 !-- kpe end index for k in patch
583 !-- its start index for i in tile
584 !-- ite end index for i in tile
585 !-- jts start index for j in tile
586 !-- jte end index for j in tile
587 !-- kts start index for k in tile
588 !-- kte end index for k in tile
589 !
590 !******************************************************************
591 !------------------------------------------------------------------
593 INTEGER, INTENT(IN) :: &
594 & ids,ide,jds,jde,kds,kde &
595 & ,ims,ime,jms,jme,kms,kme &
596 & ,ips,ipe,jps,jpe,kps,kpe &
597 & ,kts,kte,num_tiles
599 INTEGER, INTENT(IN):: FRACTIONAL_SEAICE
600 INTEGER, INTENT(IN):: SEAICE_ALBEDO_OPT
601 REAL, INTENT(IN):: SEAICE_ALBEDO_DEFAULT
602 INTEGER, INTENT(IN):: SEAICE_THICKNESS_OPT
603 REAL, INTENT(IN):: SEAICE_THICKNESS_DEFAULT
604 INTEGER, INTENT(IN):: SEAICE_SNOWDEPTH_OPT
605 REAL, INTENT(IN):: SEAICE_SNOWDEPTH_MAX
606 REAL, INTENT(IN):: SEAICE_SNOWDEPTH_MIN
607 INTEGER, INTENT(IN):: IFNDALBSI
608 INTEGER, INTENT(IN):: IFNDICEDEPTH
609 INTEGER, INTENT(IN):: IFNDSNOWSI
610 LOGICAL, INTENT(IN):: do_bioe
611 LOGICAL, INTENT(IN):: do_meganfile
613 INTEGER, INTENT(IN):: NLCAT, mosaic_lu, mosaic_soil
614 INTEGER, INTENT(IN):: NSCAT
615 INTEGER, INTENT(IN ) :: LakeModel
616 REAL, INTENT(IN) :: lake_min_elev
618 INTEGER, INTENT(IN):: history_interval
620 INTEGER, INTENT(IN) :: sf_sfclay_physics, sf_surface_physics, &
621 sf_urban_physics,ra_lw_physics,sst_update, &
622 ra_sw_physics, bl_pbl_physics
623 INTEGER, INTENT(IN),OPTIONAL :: sst_skin, tmn_update, &
624 scm_force_skintemp, scm_force_flux
626 INTEGER, DIMENSION(num_tiles), INTENT(IN) :: &
627 & i_start,i_end,j_start,j_end
629 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ISLTYP
630 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: IVGTYP
631 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: LOWLYR
632 INTEGER, INTENT(IN ):: IFSNOW
633 INTEGER, INTENT(IN ):: ISFFLX
634 INTEGER, INTENT(IN ):: ITIMESTEP
635 INTEGER, INTENT(IN ):: NUM_SOIL_LAYERS
636 REAL, INTENT(IN ),OPTIONAL :: JULIAN_in
637 INTEGER, INTENT(IN ):: LAGDAY
638 INTEGER, INTENT(IN ):: STEPBL
639 INTEGER, INTENT(IN ):: ISICE
640 INTEGER, INTENT(IN ):: ISWATER
641 INTEGER, INTENT(IN ), OPTIONAL :: ISURBAN
642 CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: MMINLU
643 LOGICAL, INTENT(IN ):: WARM_RAIN
644 LOGICAL, INTENT(IN):: tice2tsk_if2cold
645 INTEGER, INTENT(INOUT ),OPTIONAL :: NYEAR
646 REAL , INTENT(INOUT ),OPTIONAL :: NDAY
647 INTEGER, INTENT(IN ),OPTIONAL :: YR
648 REAL , INTENT(IN ):: U_FRAME
649 REAL , INTENT(IN ):: V_FRAME
651 ! WRF-Solar EPS
652 integer, intent(in) :: multi_perturb
653 logical, intent(in) :: pert_noah
654 real, intent(in):: pert_noah_qv,pert_noah_t, pert_noah_smois,pert_noah_tslb
655 real, dimension (ims:ime, kms:kme, jms:jme) ,intent(inout), optional :: perts_qvapor, perts_th, &
656 perts_smois, perts_tsoil
658 !added by Wei Yu for WRF_HYDRO
659 real :: HYDRO_dt
660 REAL, DIMENSION( ims:ime , jms:jme ):: sfcheadrt,INFXSRT, soldrain
661 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: qtiledrain,ZWATBLE2D ! NoahMP tile drainage
663 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SMOIS
664 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: TSLB
665 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(OUT) :: SMCREL
666 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: GLW
667 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: GSW,SWDOWN
668 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: HT
669 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: RAINCV
670 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SST
671 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: SSTSK
672 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ),OPTIONAL :: SST_INPUT
673 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: DTW
674 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: TMN
675 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TYR
676 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TYRA
677 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL :: TDLY
678 REAL, DIMENSION( ims:ime , 1:lagday , jms:jme ), INTENT(INOUT ),OPTIONAL :: TLAG
679 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: VEGFRA
680 !------fds (06/2010)--------------------------
681 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XICE
682 !---------------------------------------------
683 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: ALBSI
684 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: ICEDEPTH
685 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SNOWSI
686 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XLAND
687 INTEGER, INTENT(IN ) :: MAX_EDOM
688 REAL, DIMENSION( ims:ime , 1:max_edom, jms:jme ), INTENT(IN ), OPTIONAL :: CPLMASK
689 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: XICEM
690 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MAVAIL
691 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: SNOALB
692 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ACSNOW
693 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOTIME
694 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKHS
695 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: AKMS
696 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ALBEDO
697 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: CANWAT
699 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: GRDFLX
700 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: HFX
701 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: RMOL
702 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: PBLH
703 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: Q2
704 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QFX
705 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QSFC
706 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: QZ0
707 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SFCRUNOFF
708 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ACRUNOFF
709 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTAV
710 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SMSTOT
711 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOW
712 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWC
713 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: SNOWH
714 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TH2
715 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: THZ0
716 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: TSK
717 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UDRUNOFF
718 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UST
719 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: UZ0
720 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: VZ0
721 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: WSPD
722 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT):: ZNT
723 !-----fds (06/2010)---------------------------------------------
724 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LHF ! SSiB output
725 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SHF ! SSiB output
726 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_GHF ! SSiB output
727 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_EGS ! SSiB output
728 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_ECI ! SSiB output
729 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_ECT ! SSiB output
730 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_EGI ! SSiB output
731 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_EGT ! SSiB output
732 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SDN ! SSiB output
733 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SUP ! SSiB output
734 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LDN ! SSiB output
735 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LUP ! SSiB output
736 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_WAT ! SSiB output
737 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SHC ! SSiB output
738 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_SHG ! SSiB output
739 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_LAI ! SSiB output
740 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_VCF ! SSiB output
741 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_Z00 ! SSiB output
742 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: SSIB_VEG ! SSiB output
743 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWVISDIR! SSiB
744 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWVISDIF! SSiB
745 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWNIRDIR! SSiB
746 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT):: ALSWNIRDIF! SSiB
747 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWVISDIR! SSiB
748 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWVISDIF! SSiB
749 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWNIRDIR! SSiB
750 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN):: SWNIRDIF! SSiB
751 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_BR ! SSiB
752 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_FM ! SSiB
753 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_FH ! SSiB
754 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiB_CM ! SSiB
755 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SSiBXDD ! SSiB
756 INTEGER, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: ISNOW ! ssib-snow
757 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SWE ! ssib-snow
758 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOWDEN ! ssib-snow
759 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOWDEPTH ! ssib-snow
760 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TKAIR ! ssib-snow
761 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO1 ! ssib-snow
762 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO1 ! ssib-snow
763 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN1 ! ssib-snow
764 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO1 ! ssib-snow
765 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO1 ! ssib-snow
766 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO1 ! ssib-snow
767 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO1 ! ssib-snow
768 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO1 ! ssib-snow
769 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO1 ! ssib-snow
770 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO1 ! ssib-snow
771 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO1 ! ssib-snow
772 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO1 ! ssib-snow
773 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO2 ! ssib-snow
774 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO2 ! ssib-snow
775 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN2 ! ssib-snow
776 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO2 ! ssib-snow
777 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO2 ! ssib-snow
778 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO2 ! ssib-snow
779 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO2 ! ssib-snow
780 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO2 ! ssib-snow
781 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO2 ! ssib-snow
782 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO2 ! ssib-snow
783 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO2 ! ssib-snow
784 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO2 ! ssib-snow
785 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO3 ! ssib-snow
786 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO3 ! ssib-snow
787 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN3 ! ssib-snow
788 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO3 ! ssib-snow
789 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO3 ! ssib-snow
790 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO3 ! ssib-snow
791 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO3 ! ssib-snow
792 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO3 ! ssib-snow
793 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO3 ! ssib-snow
794 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO3 ! ssib-snow
795 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO3 ! ssib-snow
796 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO3 ! ssib-snow
797 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: DZO4 ! ssib-snow
798 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: WO4 ! ssib-snow
799 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSN4 ! ssib-snow
800 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: TSSNO4 ! ssib-snow
801 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BWO4 ! ssib-snow
802 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BTO4 ! ssib-snow
803 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: CTO4 ! ssib-snow
804 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FIO4 ! ssib-snow
805 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: FLO4 ! ssib-snow
806 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BIO4 ! ssib-snow
807 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: BLO4 ! ssib-snow
808 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: HO4 ! ssib-snow
809 !----------------------------------------------------------
810 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: BR
811 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: CHKLOWQ
812 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: GZ1OZ0
813 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSHLTR
814 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: FHH
815 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: FM
816 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIH
817 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSIM
818 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: Q10
819 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: QSHLTR
820 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TH10
821 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: TSHLTR
822 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: U10
823 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: V10
824 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: U10E
825 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: V10E
826 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: UOCE
827 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: VOCE
828 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT):: PSFC
829 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: ACSNOM
830 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEVP
831 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACHFX
832 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACLHF
833 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL :: ACGRDFLX
834 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: SFCEXC
835 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLHC
836 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: FLQC
837 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CT
838 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: DZ8W
839 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P8W
840 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: PI_PHY
841 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: P_PHY
842 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: RHO
843 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: TH_PHY
844 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT):: T_PHY
845 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: U_PHY
846 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: V_PHY
847 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ):: Z
849 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: TKE_PBL
851 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),INTENT(INOUT),OPTIONAL :: pattern_spp_lsm,field_sf
852 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),INTENT(INOUT),OPTIONAL :: pattern_spp_pbl
853 INTEGER, INTENT(IN), OPTIONAL :: spp_lsm,spp_pbl
855 REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: DZS
856 REAL, DIMENSION(1:num_soil_layers), INTENT(IN):: ZS
857 REAL, INTENT(IN ):: DT
858 REAL, INTENT(IN ):: DX
859 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ), OPTIONAL :: DX2D, AREA2D
860 REAL, INTENT(IN ),OPTIONAL :: bldt
861 REAL, INTENT(IN ),OPTIONAL :: curr_secs
862 LOGICAL, INTENT(IN ),OPTIONAL :: adapt_step_flag
863 REAL, INTENT(INOUT),OPTIONAL :: bldtacttime
865 ! arguments for NCAR surface physics
867 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: ALBBCK ! INOUT needed for NMM
868 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: EMBCK
869 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: LH
870 REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: SH2O
871 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMAX
872 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SHDMIN
873 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ):: Z0
875 ! NoahMP specific fields
877 INTEGER, OPTIONAL, INTENT(IN) :: idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc , iopt_frz, &
878 iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, iopt_stc, &
879 iopt_gla, iopt_rsf, iopt_soil,iopt_pedo,iopt_crop, iopt_irr, &
880 iopt_irrm,iopt_infdv,iopt_tdrn
881 REAL, OPTIONAL, INTENT(IN) :: soiltstep ! NoahMP soil timestep (s)
882 REAL, OPTIONAL, DIMENSION(ims:ime ,8, jms:jme), INTENT(IN) :: SOILCOMP
883 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT(IN) :: SOILCL1,SOILCL2,SOILCL3,SOILCL4
885 INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: ISNOWXY, PGSXY
886 REAL, OPTIONAL, DIMENSION(ims:ime ,-2:num_soil_layers, jms:jme), INTENT(INOUT) :: ZSNSOXY
887 REAL, OPTIONAL, DIMENSION(ims:ime ,-2:0, jms:jme), INTENT(INOUT) :: TSNOXY, SNICEXY, SNLIQXY
888 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: &
889 TVXY, TGXY,CANICEXY,CANLIQXY, EAHXY, TAHXY, CMXY, CHXY, FWETXY,SNEQVOXY,ALBOLDXY, &
890 QSNOWXY, QRAINXY, WSLAKEXY, ZWTXY, WAXY,WTXY,LFMASSXY,RTMASSXY,STMASSXY, WOODXY,STBLCPXY,FASTCPXY, &
891 GRAINXY, GDDXY, &
892 XSAIXY, TAUSSXY, T2MVXY, T2MBXY, Q2MVXY, Q2MBXY, TRADXY, NEEXY, GPPXY, &
893 NPPXY, FVEGXY, RUNSFXY, RUNSBXY, ECANXY, EDIRXY, ETRANXY, FSAXY, FIRAXY, APARXY, PSNXY, &
894 SAVXY, SAGXY, RSSUNXY, RSSHAXY, BGAPXY, WGAPXY, TGVXY, TGBXY, CHVXY, CHBXY, SHGXY, &
895 SHCXY, SHBXY, EVGXY, EVBXY, GHVXY, GHBXY, IRGXY, IRCXY, IRBXY, TRXY, EVCXY, &
896 CHLEAFXY, CHUCXY, CHV2XY, CHB2XY,CHSTARXY
897 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT(INOUT) :: acc_ssoil,acc_qinsur,acc_qseva
898 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT(INOUT) :: ACC_DWATERXY, ACC_PRCPXY, &
899 ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY
900 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme) , INTENT( OUT) :: eflxbxy,soilenergy, snowenergy
901 REAL, OPTIONAL, DIMENSION(ims:ime , 1:num_soil_layers, jms:jme), INTENT(INOUT) :: acc_etrani
902 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: &
903 qintsxy ,qintrxy ,qdripsxy ,&
904 qdriprxy ,qthrosxy ,qthrorxy ,&
905 qsnsubxy ,qsnfroxy ,qsubcxy ,&
906 qfrocxy ,qevacxy ,qdewcxy,qfrzcxy ,qmeltcxy ,&
907 qsnbotxy ,qmeltxy ,pondingxy, PAHXY ,PAHGXY, PAHVXY, PAHBXY,&
908 fpicexy,RAINLSM,SNOWLSM,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm,canhsxy
909 INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: CROPCAT
910 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: PLANTING
911 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: HARVEST
912 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: SEASON_GDD
914 ! NoahMP irrigation
915 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: IRFRACT, SIFRACT, MIFRACT, FIFRACT
916 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: IRWATSI, IRWATMI, IRWATFI, IRELOSS, &
917 IRSIVOL, IRMIVOL, IRFIVOL, IRRSPLH
918 INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: IRNUMSI, IRNUMMI, IRNUMFI
919 ! NoahMP tiledrainage
920 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(IN) :: TD_FRACTION
921 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: QTDRAIN
923 ! NoahMP specific fields - runoff option 5
925 INTEGER, OPTIONAL, INTENT(IN) :: stepwtd
926 REAL, OPTIONAL, INTENT(IN) :: wtddt
927 REAL, OPTIONAL, DIMENSION(ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT):: smoiseq
928 REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: &
929 SMCWTDXY, RECHXY, DEEPRECHXY, FDEPTHXY, AREAXY, RIVERCONDXY, RIVERBEDXY, &
930 EQZWT, PEXPXY, QRFXY, QSPRINGXY, QSLATXY, QRFSXY, QSPRINGSXY, QLATXY
932 REAL, OPTIONAL, DIMENSION(ims:ime,60,jms:jme) :: gecros_state ! Optional gecros crop
934 INTEGER, INTENT(IN ):: OPT_THCND
935 ! Noah UA changes
936 LOGICAL, INTENT(IN) :: ua_phys
937 REAL, DIMENSION(ims:ime , jms:jme), INTENT(OUT) :: flx4,fvb,fbur,fgsn
939 ! Variables for multi-layer UCM
940 REAL, OPTIONAL, INTENT(IN ) :: GMT
941 INTEGER, OPTIONAL, INTENT(IN ) :: JULDAY
942 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) ::XLAT, XLONG
943 INTEGER , INTENT(IN) :: num_urban_ndm
944 INTEGER , INTENT(IN) :: urban_map_zrd
945 INTEGER , INTENT(IN) :: urban_map_zwd
946 INTEGER , INTENT(IN) :: urban_map_gd
947 INTEGER , INTENT(IN) :: urban_map_zd
948 INTEGER , INTENT(IN) :: urban_map_zdf
949 INTEGER , INTENT(IN) :: urban_map_bd
950 INTEGER , INTENT(IN) :: urban_map_wd
951 INTEGER , INTENT(IN) :: urban_map_gbd
952 INTEGER , INTENT(IN) :: urban_map_fbd
953 INTEGER , INTENT(IN) :: urban_map_zgrd
954 INTEGER, INTENT(IN ):: NUM_URBAN_HI
955 INTEGER, INTENT(IN ):: use_wudapt_lcz
956 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: tsk_rural
957 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d
958 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d
959 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d
960 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_gd, jms:jme ), INTENT(INOUT) :: tgb_urb4d
961 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_bd, jms:jme ), INTENT(INOUT) :: tlev_urb3d
962 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_bd, jms:jme ), INTENT(INOUT) :: qlev_urb3d
963 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd, jms:jme ), INTENT(INOUT) :: tw1lev_urb3d
964 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd, jms:jme ), INTENT(INOUT) :: tw2lev_urb3d
965 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_gbd, jms:jme ), INTENT(INOUT) :: tglev_urb3d
966 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_fbd, jms:jme ), INTENT(INOUT) :: tflev_urb3d
967 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d
968 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d
969 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d
970 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d
971 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d
972 REAL, OPTIONAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: SWDDIR,SWDDIF
973 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd, jms:jme ), INTENT(INOUT) :: sfwin1_urb3d
974 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd, jms:jme ), INTENT(INOUT) :: sfwin2_urb3d
975 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zd, jms:jme ), INTENT(INOUT) :: sfw1_urb3d
976 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zd, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
977 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d
978 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d
979 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ep_pv_urb3d !GRZ
980 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: t_pv_urb3d !GRZ
981 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ),INTENT(INOUT) :: trv_urb4d !GRZ
982 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ),INTENT(INOUT) :: qr_urb4d !GRZ
983 REAL, OPTIONAL, DIMENSION( ims:ime,jms:jme ), INTENT(INOUT) :: qgr_urb3d !GRZ
984 REAL, OPTIONAL, DIMENSION( ims:ime,jms:jme ), INTENT(INOUT) :: tgr_urb3d !GRZ
985 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: drain_urb4d !GRZ
986 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: draingr_urb3d !GRZ
987 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: sfrv_urb3d !GRZ
988 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfrv_urb3d !GRZ
989 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: dgr_urb3d !GRZ
990 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: dg_urb3d !GRZ
991 REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfr_urb3d !GRZ
992 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: lfg_urb3d !GRZ
993 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d !urban
994 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: lp_urb2d !urban
995 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: lb_urb2d !urban
996 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: hgt_urb2d !urban
997 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: mh_urb2d !urban
998 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: stdh_urb2d!urban
999 REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(IN) :: lf_urb2d !urban
1000 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep !Implicit momemtum component X-direction
1001 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep !Implicit momemtum component Y-direction
1002 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep !Implicit component pot. temperature
1003 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_e_bep !Implicit component TKE
1004 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_q_bep !Implicit component TKE
1005 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_u_bep !Explicit momentum component X-direction
1006 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_v_bep !Explicit momentum component Y-direction
1007 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_t_bep !Explicit component pot. temperature
1008 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_e_bep !Explicit component TKE
1009 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_q_bep !Explicit component TKE
1010 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::vl_bep !Fraction air volume in grid cell
1011 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dlg_bep !Height above ground
1012 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::sf_bep !Fraction air at the face of grid cell
1013 REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep !Length scale
1015 ! arguments for Ocean Mixed Layer Model
1016 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT ):: TML, T0ML, HML, H0ML, HUML, HVML
1017 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN ):: F, TMOML
1018 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(OUT ):: CK, CKA, CD, CDA
1019 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT ):: USTM
1021 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT ):: TSK_SAVE
1023 #if ( EM_CORE==1)
1024 REAL, DIMENSION( ims:ime , jms:jme ), &
1025 &OPTIONAL, INTENT(INOUT ):: ch
1027 !Katata-added - extra in-output
1028 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT):: fgdp,dfgdp,vdfg
1029 INTEGER, OPTIONAL, INTENT(IN) :: grav_settling
1030 !Katata-end
1032 #endif
1035 INTEGER, OPTIONAL, INTENT(IN ):: slope_rad, topo_shading
1036 INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: shadowmask
1037 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: swnorm
1038 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: slope,slp_azi
1039 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: diffuse_frac
1041 INTEGER, OPTIONAL, INTENT(IN ):: ISFTCFLX,IZ0TLND
1042 INTEGER, OPTIONAL, INTENT(IN ):: SF_OCEAN_PHYSICS
1043 REAL , OPTIONAL, INTENT(IN ):: OML_HML0
1044 REAL , OPTIONAL, INTENT(IN ):: OML_GAMMA
1045 REAL , OPTIONAL, INTENT(IN ):: OML_RELAXATION_TIME
1046 !
1047 ! Observation nudging
1048 !
1049 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: uratx !Added for obs-nudging
1050 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: vratx !Added for obs-nudging
1051 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: tratx !Added for obs-nudging
1052 !
1053 ! PX LSM Surface Grid Analysis nudging
1054 !
1055 INTEGER, OPTIONAL, INTENT(IN) :: pxlsm_smois_init, pxlsm_soil_nudge, &
1056 ANAL_INTERVAL, pxlsm_modis_veg
1058 REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: LANDUSEF
1059 REAL, DIMENSION( ims:ime, NSCAT, jms:jme ) , OPTIONAL, INTENT(INOUT):: SOILCTOP, SOILCBOT
1060 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT):: IMPERV, CANFRA
1061 REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT):: VEGF_PX
1062 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RA
1063 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: RS
1064 REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: LAI
1065 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: T2OBS, Q2OBS, LAI_PX
1066 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT):: WWLT_PX, WFC_PX, WSAT_PX, &
1067 CLAY_PX, CSAND_PX, FMSAND_PX
1069 REAL, DIMENSION( ims:ime, jms:jme ), &
1070 OPTIONAL, INTENT(INOUT) :: t2_ndg_old, t2_ndg_new, q2_ndg_old, &
1071 q2_ndg_new, sn_ndg_old, sn_ndg_new
1073 !
1074 !
1075 ! Flags relating to the optional tendency arrays declared above
1076 ! Models that carry the optional tendencies will provdide the
1077 ! optional arguments at compile time; these flags all the model
1078 ! to determine at run-time whether a particular tracer is in
1079 ! use or not.
1080 !
1081 LOGICAL, INTENT(IN), OPTIONAL :: &
1082 f_qv &
1083 ,f_qc &
1084 ,f_qr &
1085 ,f_qi &
1086 ,f_qs &
1087 ,f_qg
1089 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
1090 OPTIONAL, INTENT(INOUT) :: &
1091 ! optional moisture tracers
1092 ! 2 time levels; if only one then use CURR
1093 qv_curr, qc_curr, qr_curr &
1094 ,qi_curr, qs_curr, qg_curr
1095 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: snowncv
1096 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: graupelncv
1097 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN) :: hailncv
1098 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: capg
1099 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: emiss
1100 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: hol
1101 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: mol
1102 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: regime
1103 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainncv
1104 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: rainshv
1105 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: RAINBL
1106 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: t2
1107 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN ):: thc
1108 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qsg
1109 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qvg
1110 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: qcg
1111 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: dew
1112 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soilt1
1113 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: tsnav
1114 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: potevp ! NMM LSM
1115 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: snopcx ! NMM LSM
1116 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: soiltb ! NMM LSM
1117 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: sr ! NMM and RUC LSM
1118 REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: smfr3d
1119 REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT):: keepfr3dflag
1120 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: rhosnf ! density of snowfall
1121 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT) :: precipfr ! time-step frozen precip from RUC LSM
1122 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: snowfallac ! density of snowfall
1124 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT), OPTIONAL :: NOAHRES
1125 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT) :: ZOL
1127 INTEGER, INTENT(IN) :: MAXPATCH, inest
1128 #if ( WRF_CHEM == 1 )
1129 INTEGER, INTENT(IN) :: ne_area
1130 #endif
1131 ! End modification
1133 integer, optional, dimension(ims:ime,jms:jme ),intent(inout) :: numc,nump
1134 real, optional, dimension(ims:ime,jms:jme ),intent(inout) :: sabv,sabg,lwup
1135 integer, optional, dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) :: snl
1136 real, optional, dimension(ims:ime,jms:jme ),intent(inout) ::t2m_max,t2m_min,t2clm
1137 INTEGER, INTENT(IN) :: num_pft_input
1138 LOGICAL,OPTIONAL,INTENT(IN) :: input_pft_flag
1139 REAL, DIMENSION(ims:ime, num_pft_input,jms:jme ),OPTIONAL, INTENT(IN) :: pct_pft_input
1140 real, optional, dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) :: &
1141 snowdp,wtc,wtp,h2osno,t_grnd,t_veg, &
1142 h2ocan,h2ocan_col, &
1143 t_ref2m,h2osoi_liq_s1, &
1144 h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4, &
1145 h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2, &
1146 h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6, &
1147 h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10, &
1148 h2osoi_ice_s1,h2osoi_ice_s2, &
1149 h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5, &
1150 h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4, &
1151 h2osoi_ice5,h2osoi_ice6,h2osoi_ice7, &
1152 h2osoi_ice8,h2osoi_ice9,h2osoi_ice10, &
1153 t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4, &
1154 t_soisno_s5,t_soisno1,t_soisno2,t_soisno3, &
1155 t_soisno4,t_soisno5,t_soisno6,t_soisno7, &
1156 t_soisno8,t_soisno9,t_soisno10, &
1157 dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5, &
1158 snowrds1,snowrds2,snowrds3,snowrds4,snowrds5, &
1159 t_lake1,t_lake2,t_lake3,t_lake4,t_lake5, &
1160 t_lake6,t_lake7,t_lake8,t_lake9,t_lake10, &
1161 h2osoi_vol1,h2osoi_vol2,h2osoi_vol3, &
1162 h2osoi_vol4,h2osoi_vol5,h2osoi_vol6, &
1163 h2osoi_vol7,h2osoi_vol8, &
1164 h2osoi_vol9,h2osoi_vol10, &
1165 ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid, &
1166 Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,SWUPsubgrid ,&
1167 LHsoi,LHveg,LHtran
1168 #if ( WRF_CHEM == 1 )
1169 real, optional, dimension(ims:ime,jms:jme,1:ne_area ),intent(inout) :: &
1170 e_bio
1171 #endif
1172 #ifdef CN
1173 !ylu 05/31/2011
1175 !CROP&CN restart and potential output
1176 integer, optional, dimension(ims:ime,1:maxpatch,jms:jme ),intent(inout) :: croplive
1177 real,optional,dimension(ims:ime,1:maxpatch,jms:jme),intent(inout) :: &
1178 dyntlai,dyntsai,dyntop,dynbot, &
1179 htmx,gdd1020,gdd820,gdd020,grainc,grainc_storage &
1180 ,grainc_xfer,grainn,grainn_storage,grainn_xfer,days_active &
1181 ,onset_flag,onset_counter,onset_gddflag,onset_fdd,onset_gdd &
1182 ,onset_swi,offset_flag,offset_counter,offset_fdd,offset_swi &
1183 ,dayl,annavg_t2m,tempavg_t2m,tempsum_potential_gpp &
1184 ,annsum_potential_gpp,tempmax_retransn,annmax_retransn &
1185 ,prev_leafc_to_litter,prev_frootc_to_litter,tempsum_npp &
1186 ,annsum_npp,leafc,leafc_storage,leafc_xfer,frootc &
1187 ,frootc_storage,frootc_xfer,livestemc,livestemc_storage &
1188 ,livestemc_xfer,deadstemc,deadstemc_storage,deadstemc_xfer &
1189 ,livecrootc,livecrootc_storage,livecrootc_xfer,deadcrootc &
1190 ,deadcrootc_storage,deadcrootc_xfer,cpool,pft_ctrunc &
1191 ,leafn,leafn_storage,leafn_xfer,frootn,frootn_storage &
1192 ,frootn_xfer,livestemn,livestemn_storage,livestemn_xfer &
1193 ,deadstemn,deadstemn_storage,deadstemn_xfer,livecrootn &
1194 ,livecrootn_storage,livecrootn_xfer,deadcrootn &
1195 ,deadcrootn_storage,deadcrootn_xfer,npool,pft_ntrunc &
1196 ,gresp_storage,gresp_xfer,xsmrpool,annsum_counter &
1197 ,cannsum_npp,cannavg_t2m,wf,me,mean_fire_prob,cwdc,litr1c &
1198 ,litr2c,litr3c,soil1c,soil2c,soil3c,soil4c,seedc,col_ctrunc &
1199 ,prod10c,prod100c,cwdn,litr1n,litr2n,litr3n,soil1n,soil2n &
1200 ,soil3n,soil4n,seedn,col_ntrunc,prod10n,prod100n,sminn &
1201 ,totlitc,dwt_seedc_to_leaf,dwt_seedc_to_deadstem,dwt_conv_cflux &
1202 ,dwt_prod10c_gain,dwt_prod100c_gain,prod100c_loss,dwt_frootc_to_litr1c &
1203 ,dwt_frootc_to_litr2c,dwt_frootc_to_litr3c,dwt_livecrootc_to_cwdc &
1204 ,dwt_deadcrootc_to_cwdc,dwt_seedn_to_leaf,dwt_seedn_to_deadstem &
1205 ,dwt_conv_nflux,dwt_prod10n_gain,dwt_prod100n_gain,prod100n_loss &
1206 ,dwt_frootn_to_litr1n,dwt_frootn_to_litr2n, dwt_frootn_to_litr3n &
1207 , dwt_livecrootn_to_cwdn,dwt_deadcrootn_to_cwdn,retransn
1208 #endif
1211 ! Variables for TEMF surface layer
1212 REAL,OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: te_temf
1213 REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: hd_temf, exch_temf, wm_temf
1214 REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: fCor
1216 ! Variables for ideal SCM surface layer
1217 REAL,OPTIONAL, INTENT(INOUT) :: hfx_force,lh_force,tsk_force
1218 REAL,OPTIONAL, INTENT(IN ) :: hfx_force_tend,lh_force_tend,tsk_force_tend
1220 ! LOCAL VAR
1222 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
1223 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
1225 REAL, DIMENSION( ims:ime, jms:jme ) :: &
1226 QGH, &
1227 CHS, &
1228 CQS, &
1229 CPM, &
1230 CHS2, &
1231 CQS2
1232 ! CTSM local variable
1233 REAL, DIMENSION( ims:ime , jms:jme ) :: xland_ctsm
1234 ! SSIB local variables
1235 REAL ZDIFF
1236 REAL, DIMENSION( ims:ime , jms:jme ) :: XICE_save
1237 !
1238 REAL :: DTMIN,DTBL
1239 !
1240 INTEGER :: i,J,K,NK,jj,ij
1241 INTEGER :: gfdl_ntsflg
1242 LOGICAL :: radiation, myj, myjpbl, frpcpn, isisfc
1243 LOGICAL, INTENT(in), OPTIONAL :: rdlai2d
1244 LOGICAL, INTENT(in), OPTIONAL :: usemonalb
1245 REAL :: total_depth,mid_point_depth
1246 REAL :: tconst,tprior,tnew,yrday,deltat
1247 REAL :: SWSAVE
1248 REAL, DIMENSION( ims:ime, jms:jme ) :: GSWSAVE
1249 !-------------------------------------------------
1250 ! urban related variables are added to declaration
1251 !-------------------------------------------------
1252 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
1253 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
1254 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMGR_SFCDIF
1255 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHGR_SFCDIF
1256 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
1257 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
1258 REAL, OPTIONAL, INTENT(IN) :: DECLIN, SOLCON
1259 REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZEN
1260 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: HRANG
1261 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D !urban
1262 INTEGER, INTENT(IN) :: num_roof_layers !urban
1263 INTEGER, INTENT(IN) :: num_wall_layers !urban
1264 INTEGER, INTENT(IN) :: num_road_layers !urban
1265 INTEGER, INTENT(IN), OPTIONAL :: julian,julyr !urban
1266 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR !urban
1267 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB !urban
1268 REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG !urban
1270 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
1271 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
1272 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
1273 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
1274 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
1275 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
1276 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
1277 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
1278 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
1279 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
1281 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D
1282 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D
1283 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D
1284 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D
1285 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D
1286 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D
1287 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D
1288 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D
1290 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
1291 INTENT(INOUT) :: TGRL_URB3D !urban
1292 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
1293 INTENT(INOUT) :: SMR_URB3D !urban
1294 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
1295 INTENT(INOUT) :: TRL_URB3D !urban
1296 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
1297 INTENT(INOUT) :: TBL_URB3D !urban
1298 REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), & !urban
1299 INTENT(INOUT) :: TGL_URB3D !urban
1300 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
1301 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
1302 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D !urban
1303 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
1304 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
1305 !
1306 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
1307 INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
1309 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIM_URB2D !urban local var
1310 REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_URB2D !urban local var
1311 REAL, DIMENSION( ims:ime, jms:jme ) :: GZ1OZ0_URB2D !urban local var
1312 !m REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D !urban local var
1313 REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_URB2D !urban local var
1314 REAL, DIMENSION( ims:ime, jms:jme ) :: U10_URB2D !urban local var
1315 REAL, DIMENSION( ims:ime, jms:jme ) :: V10_URB2D !urban local var
1316 REAL, DIMENSION( ims:ime, jms:jme ) :: TH2_URB2D !urban local var
1317 REAL, DIMENSION( ims:ime, jms:jme ) :: Q2_URB2D !urban local var
1318 REAL, DIMENSION( ims:ime, jms:jme ) :: UST_URB2D !urban local var
1320 !-------------------------------------------------
1321 ! Noah-mosaic related variables are added to declaration (danli)
1322 !-------------------------------------------------
1324 INTEGER, INTENT(IN) :: sf_surface_mosaic
1325 INTEGER, INTENT(IN) :: mosaic_cat
1326 INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT), OPTIONAL :: mosaic_cat_index
1327 REAL, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT), OPTIONAL :: landusef2
1329 REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT):: &
1330 TSK_mosaic, QSFC_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic
1331 REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT):: &
1332 ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic, &
1333 HFX_mosaic,QFX_mosaic, LH_mosaic,GRDFLX_mosaic,SNOTIME_mosaic, &
1334 RS_mosaic,LAI_mosaic
1335 REAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), OPTIONAL, INTENT(INOUT):: &
1336 TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
1338 REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT):: &
1339 TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic, UC_URB2D_mosaic, &
1340 SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic
1342 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
1343 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
1344 REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic
1346 !-------------------------------------------------
1347 ! End of Noah-mosaic related variables
1348 !-------------------------------------------------
1350 !--------fds (06/2010)---------------------------------------------
1351 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
1352 OPTIONAL, INTENT(IN) :: CLDFRA
1353 REAL :: DAY, CLOUDFRAC, UV10
1354 !------------------------------------------------------------------
1355 !
1356 REAL, DIMENSION( ims:ime, jms:jme ) :: HFX_SEA
1357 REAL, DIMENSION( ims:ime, jms:jme ) :: QFX_SEA
1358 REAL, DIMENSION( ims:ime, jms:jme ) :: LH_SEA
1359 REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_SEA
1360 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_SEA
1361 REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_SEA
1363 REAL, DIMENSION( ims:ime, jms:jme ) :: CHS_SEA
1364 REAL, DIMENSION( ims:ime, jms:jme ) :: CHS2_SEA
1365 REAL, DIMENSION( ims:ime, jms:jme ) :: CQS2_SEA
1366 REAL, DIMENSION( ims:ime, jms:jme ) :: CPM_SEA
1367 REAL, DIMENSION( ims:ime, jms:jme ) :: FLHC_SEA
1368 REAL, DIMENSION( ims:ime, jms:jme ) :: FLQC_SEA
1369 REAL, DIMENSION( ims:ime, jms:jme ) :: QGH_SEA
1370 !
1371 REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_SEA
1372 REAL, DIMENSION( ims:ime, jms:jme ) :: UST_SEA
1373 REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_SEA
1374 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
1375 ! lake varibles ,inout(14)
1376 real, dimension(ims:ime,jms:jme ),intent(inout) :: savedtke12d
1377 real, dimension(ims:ime,jms:jme ),intent(inout) :: snowdp2d, &
1378 h2osno2d, &
1379 snl2d, &
1380 t_grnd2d
1382 real, dimension( ims:ime,1:nlevlake, jms:jme ),INTENT(inout) :: t_lake3d, &
1383 lake_icefrac3d
1384 real, dimension( ims:ime,-nlevsnow+1:nlevsoil, jms:jme ),INTENT(inout) :: t_soisno3d, &
1385 h2osoi_ice3d, &
1386 h2osoi_liq3d, &
1387 h2osoi_vol3d, &
1388 z3d, &
1389 dz3d
1390 real, dimension( ims:ime,-nlevsnow+0:nlevsoil, jms:jme ),INTENT(inout) :: zi3d
1391 ! in(8)
1392 real, dimension( ims:ime,1:nlevlake, jms:jme ),INTENT(in) :: z_lake3d, &
1393 dz_lake3d
1394 real, dimension( ims:ime,1:nlevsoil, jms:jme ),INTENT(in) :: watsat3d, &
1395 csol3d, &
1396 tkmg3d, &
1397 tkdry3d, &
1398 tksatu3d
1399 INTEGER, INTENT(IN) :: shalwater_z0
1400 REAL, INTENT(IN) :: shalwater_depth
1401 real, dimension(ims:ime,jms:jme ),intent(inout) :: water_depth
1402 real, dimension(ims:ime,jms:jme ),intent(in) :: lakedepth2d
1403 #if (EM_CORE==1)
1404 real , dimension(ims:ime,jms:jme ) :: lakemask
1405 logical , intent(in) :: restart_flag
1406 ! INTEGER :: lakeflag
1407 #endif
1408 ! logical, dimension(ims:ime,jms:jme ),intent(in) :: lake
1410 !
1411 REAL :: xice_threshold
1412 CHARACTER(LEN=256) :: LLANDUSE
1413 ! cyl 3d ocean variable
1414 integer :: okms, okme
1415 real, optional , dimension(ims:ime, okms:okme, jms:jme), INTENT(INOUT):: OM_TMP,OM_S,OM_U,OM_V,OM_DEPTH
1416 real, optional , dimension(ims:ime, okms:okme, jms:jme), INTENT(IN):: OM_TINI,OM_SINI
1417 real, optional , dimension(ims:ime, jms:jme),INTENT(INOUT):: OM_ML, OM_LAT, OM_LON
1418 REAL, OPTIONAL , INTENT(IN ) :: rdx, rdy,xtime,omdt
1419 REAL , OPTIONAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfu, msfv, msft
1420 INTEGER , OPTIONAL , INTENT(IN) :: id
1421 !
1422 real, dimension(ims:ime,1:maxpatch,jms:jme ) :: q_ref2m ! clm
1424 real, intent(inout),optional :: t_veg24(ims:ime,1:maxpatch,jms:jme) ! voce accum variables
1425 real, intent(inout),optional :: t_veg240(ims:ime,1:maxpatch,jms:jme)
1426 real, intent(inout),optional :: fsun24(ims:ime,1:maxpatch,jms:jme)
1427 real, intent(inout),optional :: fsun240(ims:ime,1:maxpatch,jms:jme)
1428 real, intent(inout),optional :: fsd24(ims:ime,1:maxpatch,jms:jme)
1429 real, intent(inout),optional :: fsd240(ims:ime,1:maxpatch,jms:jme)
1430 real, intent(inout),optional :: fsi24(ims:ime,1:maxpatch,jms:jme)
1431 real, intent(inout),optional :: fsi240(ims:ime,1:maxpatch,jms:jme)
1432 real, intent(inout),optional :: laip(ims:ime,1:maxpatch,jms:jme)
1434 !------------------------------------------------------------------
1435 CHARACTER*256 :: message
1436 REAL :: next_bl_time
1437 LOGICAL :: run_param , doing_adapt_dt , decided
1438 LOGICAL :: do_adapt
1439 !
1440 ! FASDAS
1441 !
1442 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT), OPTIONAL :: SDA_HFX,SDA_QFX,HFX_BOTH, QFX_BOTH, QNORM
1443 INTEGER, INTENT(IN ) :: fasdas
1444 ! local vars
1445 REAL, DIMENSION( ims:ime, jms:jme ) :: HFXOLD, QFXOLD
1446 REAL :: HFX_KAY, QFX_KAY
1447 ! local var for SPP_LSM
1448 INTEGER :: spp_lsm_loc
1450 real, optional, dimension(ims:ime,jms:jme ),intent(inout) :: XLAIDYN
1451 ! IRRIGATION
1452 INTEGER :: tloc, jmonth,timing
1453 REAL, PARAMETER :: PI_GRECO=3.14159
1454 INTEGER :: end_hour, irr_start,xt24,irr_day
1455 REAL :: constants_irrigation
1456 REAL, DIMENSION( ims:ime, jms:jme ) :: IRRIGATION_CHANNEL
1457 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) , OPTIONAL:: IRRIGATION
1458 REAL, INTENT(IN),OPTIONAL:: irr_daily_amount
1459 INTEGER :: phase
1460 INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT),OPTIONAL :: irr_rand_field
1461 INTEGER, INTENT(IN ),OPTIONAL:: sf_surf_irr_scheme,irr_start_hour,irr_num_hours,irr_start_julianday,irr_end_julianday,irr_freq,irr_ph
1463 ! WRF-Solar EPS
1464 real, dimension (:, :, :), allocatable :: smois_tmp, tslb_tmp
1466 !
1467 !------------------------------------------------------------------
1468 ! Initialize local variables
1469 q_ref2m = 0.0
1470 !------------------------------------------------------------------
1471 !
1472 ! stop run if using ssib and fractional seaice=0 (fds 12/2010)
1474 if(sf_surface_physics .eq. SSIBSCHEME .and. fractional_seaice .eq. 0) then
1475 WRITE( message,* ) 'Please activate fractional seaice option when using SSiB model'
1476 CALL wrf_error_fatal ( message )
1477 endif
1479 if (sf_sfclay_physics .eq. 0) return
1481 if ( fractional_seaice == 0 ) then
1482 xice_threshold = 0.5
1483 else if ( fractional_seaice == 1 ) then
1484 xice_threshold = 0.02
1485 endif
1487 if ( ( seaice_albedo_opt == 2 ) .and. ( ifndalbsi == 0 ) ) then
1488 call wrf_error_fatal("Field ALBSI not found in input. Field ALBSI is required if SEAICE_ALBEDO_OPT=2")
1489 endif
1491 if ( ( seaice_thickness_opt == 1 ) .and. ( ifndicedepth == 0 ) ) then
1492 call wrf_error_fatal("Field ICEDEPTH not found in input. Field ICEDEPTH is required if SEAICE_THICKNESS_OPT=1")
1493 endif
1495 if ( ( seaice_snowdepth_opt == 1 ) .and. ( ifndsnowsi == 0 ) ) then
1496 call wrf_error_fatal("Field SNOWSI not found in input. Field SNOWSI is required if SEAICE_SNOWDEPTH_OPT=1")
1497 endif
1499 IF ( coupler_on .and. present(cplmask) .and. present(sst_input) ) THEN
1501 CALL cpl_rcv( id, 'SST', &
1502 & ids, ide, jds, jde, kds, kde, &
1503 & ims, ime, jms, jme, kms, kme, &
1504 & ips, ipe, jps, jpe, kps, kpe, &
1505 & max_edom, cplmask, SST, SST_INPUT )
1507 CALL cpl_rcv( id, 'UOCE', &
1508 & ids, ide, jds, jde, kds, kde, &
1509 & ims, ime, jms, jme, kms, kme, &
1510 & ips, ipe, jps, jpe, kps, kpe, &
1511 & max_edom, cplmask, UOCE )
1513 CALL cpl_rcv( id, 'VOCE', &
1514 & ids, ide, jds, jde, kds, kde, &
1515 & ims, ime, jms, jme, kms, kme, &
1516 & ips, ipe, jps, jpe, kps, kpe, &
1517 & max_edom, cplmask, VOCE )
1519 END IF
1521 #if (EM_CORE==1)
1522 spp_lsm_loc = spp_lsm
1523 #else
1524 spp_lsm_loc = 0
1525 #endif
1528 !$OMP PARALLEL DO &
1529 !$OMP PRIVATE (ij, i, j, k)
1530 DO ij = 1,num_tiles
1531 DO j = j_start(ij),j_end(ij)
1532 DO k = kms,kme
1533 DO i = i_start(ij),i_end(ij)
1534 v_phytmp(i, k, j) = 0.
1535 u_phytmp(i, k, j) = 0.
1536 ENDDO
1537 ENDDO
1538 DO i = i_start(ij),i_end(ij)
1539 QGH(i,j) = 0.
1540 CHS(i,j) = 0.
1541 CPM(i,j) = 0.
1542 CHS2(i,j) = 0.
1543 ENDDO
1544 ENDDO
1545 ENDDO
1546 DTMIN = 0.
1547 DTBL = 0.
1549 ! RAINBL in mm (Accumulation between PBL calls)
1551 IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
1552 !$OMP PARALLEL DO &
1553 !$OMP PRIVATE ( ij, i, j, k )
1554 DO ij = 1 , num_tiles
1555 DO j=j_start(ij),j_end(ij)
1556 DO i=i_start(ij),i_end(ij)
1557 RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
1558 IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
1559 RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
1560 #if (EM_CORE==1)
1561 IRRIGATION_CHANNEL(i,j) = 0.
1562 sf_surf_irr: SELECT CASE(sf_surf_irr_scheme)
1563 CASE(DRIP)
1564 CALL drip_irrigation( &
1565 & julian_in,IRRIGATION(i,j),sf_surf_irr_scheme, &
1566 & irr_daily_amount,irr_start_hour,irr_num_hours, &
1567 & irr_start_julianday,irr_end_julianday, &
1568 & irr_freq,irr_ph,i,j,RAINBL(i,j), &
1569 & IRRIGATION_CHANNEL(i,j),gmt,xtime,dt, &
1570 & irr_rand_field(i,j) &
1571 )
1572 CASE(CHANNEL)
1573 CALL channel_irrigation( &
1574 & julian_in,IRRIGATION(i,j),sf_surf_irr_scheme, &
1575 & irr_daily_amount,irr_start_hour,irr_num_hours, &
1576 & irr_start_julianday,irr_end_julianday, &
1577 & irr_freq,irr_ph,i,j,RAINBL(i,j), &
1578 & IRRIGATION_CHANNEL(i,j),gmt,xtime,dt, &
1579 & irr_rand_field(i,j) &
1580 )
1581 END SELECT sf_surf_irr
1582 #endif
1583 ENDDO
1584 ENDDO
1585 ENDDO
1586 !$OMP END PARALLEL DO
1587 ELSE IF ( PRESENT( rainbl ) ) THEN
1588 !$OMP PARALLEL DO &
1589 !$OMP PRIVATE ( ij, i, j, k )
1590 DO ij = 1 , num_tiles
1591 DO j=j_start(ij),j_end(ij)
1592 DO i=i_start(ij),i_end(ij)
1593 RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
1594 IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
1595 RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
1597 #if (EM_CORE==1)
1598 sf_surf_irr1: SELECT CASE(sf_surf_irr_scheme)
1599 CASE(DRIP)
1600 CALL drip_irrigation( &
1601 & julian_in,IRRIGATION(i,j),sf_surf_irr_scheme, &
1602 & irr_daily_amount,irr_start_hour,irr_num_hours, &
1603 & irr_start_julianday,irr_end_julianday, &
1604 & irr_freq,irr_ph,i,j,RAINBL(i,j), &
1605 & IRRIGATION_CHANNEL(i,j),gmt,xtime,dt, &
1606 & irr_rand_field(i,j) &
1607 )
1609 CASE(CHANNEL)
1610 CALL channel_irrigation( &
1611 & julian_in,IRRIGATION(i,j),sf_surf_irr_scheme, &
1612 & irr_daily_amount,irr_start_hour,irr_num_hours, &
1613 & irr_start_julianday,irr_end_julianday, &
1614 & irr_freq,irr_ph,i,j,RAINBL(i,j), &
1615 & IRRIGATION_CHANNEL(i,j),gmt,xtime,dt, &
1616 & irr_rand_field(i,j) &
1617 )
1618 END SELECT sf_surf_irr1
1619 #endif
1621 ENDDO
1622 ENDDO
1623 ENDDO
1624 !$OMP END PARALLEL DO
1625 ENDIF
1626 ! Update SST
1627 IF (sst_update .EQ. 1) THEN
1628 CALL wrf_debug( 100, 'SST_UPDATE is on' )
1629 !$OMP PARALLEL DO &
1630 !$OMP PRIVATE ( ij, i, j, k )
1631 DO ij = 1 , num_tiles
1632 DO j=j_start(ij),j_end(ij)
1633 DO i=i_start(ij),i_end(ij)
1634 ! check for lake model
1635 #if (EM_CORE==1)
1636 if ( lakemodel==1) then
1637 if(lakemask(i,j).eq.1.) then
1638 if ( xice(i,j).gt.xice_threshold) then !mchen
1639 xice(i,j)=0.0
1640 endif
1641 endif
1642 endif
1643 #else
1644 if ( lakemodel==1) then
1645 if(ht(i,j)>=lake_min_elev) then
1646 if ( xice(i,j).gt.xice_threshold) then !mchen
1647 xice(i,j)=0.0
1648 endif
1649 endif
1650 endif
1651 #endif
1652 ! end check lake model
1653 XICE_save(I,J) = XICEM(I,J)
1655 IF ( FRACTIONAL_SEAICE == 1 ) then
1656 IF ( ( XICE(I,J) .NE. XICEM(I,J) ) .AND. ( XICEM(I,J) .GT. XICE_THRESHOLD ) ) THEN
1657 ! Fractional values of ALBEDO and EMISSIVITY are valid according to the
1658 ! earlier fractional seaice value, XICEM. Recompute them for the new
1659 ! seaice value XICE.
1660 IF ( SEAICE_ALBEDO_OPT ==2 ) THEN
1661 IF ( ALBSI(I,J) < -1.E6 ) THEN
1662 call wrf_error_fatal("Field ALBSI not found in input. Field ALBSI is required if SEAICE_ALBEDO_OPT=2")
1663 ENDIF
1664 ALBEDO(I,J) = 0.08 + XICE(I,J)/XICEM(I,J) * ( ALBSI(I,J) - 0.08 )
1665 ELSE
1666 ALBEDO(I,J) = 0.08 + XICE(I,J)/XICEM(I,J) * ( ALBEDO(I,J) - 0.08 )
1667 ENDIF
1668 EMISS (I,J) = 0.98 + XICE(I,J)/XICEM(I,J) * ( EMISS (I,J) - 0.98 )
1669 ! use old tsk from seaice part
1670 TSK(I,J) = TSK_SAVE(I,J)*XICE(I,J) + (1.-XICE(I,J))*SST(I,J)
1671 ENDIF
1672 ENDIF
1674 IF ( XLAND(i,j) .GT. 1.5 .AND. XICE(I,J) .GE. XICE_THRESHOLD .AND. XICEM(I,J) .LT. XICE_THRESHOLD ) THEN
1675 ! water point turns to sea-ice point
1676 XICEM(I,J) = XICE(I,J)
1677 XLAND(I,J) = 1.
1678 IVGTYP(I,J) = ISICE
1679 ISLTYP(I,J) = 16
1680 VEGFRA(I,J) = 0.
1681 TMN(I,J) = 271.4
1683 ! Over new ice, initial guesses of ALBEDO and EMISS are
1684 ! based on default water and ice values for albedo and
1685 ! emissivity. The land-surface schemes can update these
1686 ! values
1688 SELECT CASE ( SEAICE_ALBEDO_OPT )
1689 CASE ( 0, 1 )
1691 ALBEDO(I,J) = SEAICE_ALBEDO_DEFAULT * XICE(I,J) + 0.08 * ( 1.0-XICE(I,J) )
1692 ALBBCK(I,J) = SEAICE_ALBEDO_DEFAULT
1694 CASE ( 2 )
1696 IF ( ALBSI(I,J) < -1.E6 ) THEN
1697 call wrf_error_fatal("Field ALBSI not found in input. Field ALBSI is required if SEAICE_ALBEDO_OPT=2")
1698 ENDIF
1700 ALBEDO(I,J) = ALBSI(I,J) * XICE(I,J) + 0.08 * ( 1.0-XICE(I,J) )
1701 ALBBCK(I,J) = ALBSI(I,J)
1703 END SELECT
1705 EMISS(I,J) = 0.98 * XICE(I,J) + 0.98 * ( 1.0-XICE(I,J) )
1706 EMBCK(I,J) = 0.98
1707 DO nk = 1, num_soil_layers
1708 TSLB(I,NK,J) = TSK(I,J)
1709 SMOIS(I,NK,J) = 1.0
1710 SH2O(I,NK,J) = 0.0
1711 ENDDO
1712 ENDIF
1713 IF (lakemodel.ne.1) then
1714 IF(XLAND(i,j) .GT. 1.5) THEN
1715 IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
1716 TSK(i,j) =SST(i,j)
1717 TSLB(i,1,j)=SST(i,j)
1718 ENDIF
1719 ENDIF
1720 ELSE
1721 #if (EM_CORE==1)
1722 ! if(lakeflag.eq.1) then
1723 ! IF(XLAND(i,j) .GT. 1.5.AND.LAKEMASK(I,J).NE.1) THEN
1724 ! IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
1725 ! TSK(i,j) =SST(i,j)
1726 ! TSLB(i,1,j)=SST(i,j)
1727 ! ENDIF
1728 ! ENDIF
1729 ! else
1730 ! if(XLAND(i,j) .GT. 1.5.and.ht(i,j).lt.lake_min_elev) then
1731 ! IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
1732 ! TSK(i,j) =SST(i,j)
1733 ! TSLB(i,1,j)=SST(i,j)
1734 ! ENDIF
1735 ! ENDIF
1736 ! endif ! (lakeflag=1)
1737 IF(XLAND(i,j) .GT. 1.5.AND.LAKEMASK(I,J).NE.1) THEN
1738 IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
1739 TSK(i,j) =SST(i,j)
1740 TSLB(i,1,j)=SST(i,j)
1741 ENDIF
1742 ENDIF
1743 #else
1744 IF(XLAND(i,j) .GT. 1.5.and.ht(i,j).lt.lake_min_elev) then
1745 IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
1746 TSK(i,j) =SST(i,j)
1747 TSLB(i,1,j)=SST(i,j)
1748 ENDIF
1749 ENDIF
1750 #endif
1751 ENDIF ! (lakemodel=1)
1752 IF ( XLAND(i,j) .LT. 1.5 .AND. XICEM(I,J) .GE. XICE_THRESHOLD .AND. XICE(I,J) .LT. XICE_THRESHOLD ) THEN
1753 ! sea-ice point turns to water point
1754 XICEM(I,J) = XICE(I,J)
1755 XLAND(I,J) = 2.
1756 IVGTYP(I,J) = ISWATER
1757 ISLTYP(I,J) = 14
1758 VEGFRA(I,J) = 0.
1759 SNOW(I,J) = 0.
1760 SNOWC(I,J) = 0.
1761 SNOWH(I,J) = 0.
1762 TMN(I,J) = SST(I,J)
1763 ALBEDO(I,J) = 0.08
1764 ALBBCK(I,J) = 0.08
1765 EMISS(I,J) = 0.98
1766 EMBCK(I,J) = 0.98
1767 DO nk = 1, num_soil_layers
1768 TSLB(I,NK,J) = SST(I,J)
1769 SMOIS(I,NK,J) = 1.0
1770 SH2O(I,NK,J) = 1.0
1771 ENDDO
1772 ENDIF
1774 XICE_save(I,J) = XICEM(I,J)
1775 XICEM(i,j) = XICE(i,j)
1776 TSK_SAVE(I,J) = TSK(I, J)
1778 ENDDO
1779 ENDDO
1780 ENDDO
1781 !$OMP END PARALLEL DO
1782 ENDIF
1784 IF(PRESENT(SST_SKIN))THEN
1785 IF (sst_skin .EQ. 1) THEN
1786 ! Calculate skin sst based on Zeng and Beljaars (2005)
1787 CALL wrf_debug( 100, 'in SST_SKIN_UPDATE' )
1788 !$OMP PARALLEL DO &
1789 !$OMP PRIVATE ( ij, i, j, k )
1790 DO ij = 1 , num_tiles
1791 DO j=j_start(ij),j_end(ij)
1792 DO i=i_start(ij),i_end(ij)
1793 IF(XLAND(i,j) .GT. 1.5 .and. sst_update .NE. 1) THEN
1794 TSK(i,j) =SST(i,j)
1795 TSLB(i,1,j)=SST(i,j)
1796 ENDIF
1797 ENDDO
1798 ENDDO
1799 CALL sst_skin_update(xland,glw,gsw,hfx,qfx,tsk,ust, &
1800 emiss,dtw,sstsk,dt,stbolt, &
1801 ids, ide, jds, jde, kds, kde, &
1802 ims, ime, jms, jme, kms, kme, &
1803 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1804 DO j=j_start(ij),j_end(ij)
1805 DO i=i_start(ij),i_end(ij)
1806 IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SSTSK(i,j)
1807 ENDDO
1808 ENDDO
1809 ENDDO
1810 !$OMP END PARALLEL DO
1811 ENDIF
1812 ENDIF
1814 IF(PRESENT(TMN_UPDATE))THEN
1815 IF (tmn_update .EQ. 1) THEN
1816 CALL wrf_debug( 100, 'in TMN_UPDATE' )
1817 CALL tmnupdate(tsk,tmn,tlag,tyr,tyra,tdly,nday,nyear,lagday, &
1818 julian_in, dt, yr, &
1819 ids, ide, jds, jde, kds, kde, &
1820 ims, ime, jms, jme, kms, kme, &
1821 i_start,i_end, j_start,j_end, kts,kte, num_tiles )
1823 ENDIF
1824 ENDIF
1825 !
1826 ! Modified for adaptive time step
1827 !
1828 doing_adapt_dt = .FALSE.
1829 IF ( PRESENT(adapt_step_flag) ) THEN
1830 IF ( adapt_step_flag ) THEN
1831 doing_adapt_dt = .TRUE.
1832 END IF
1833 END IF
1835 ! Do we run through this scheme or not?
1837 ! Test 1: If this is the initial model time, then yes.
1838 ! ITIMESTEP=1
1839 ! Test 2: If the user asked for the surface to be run every time step, then yes.
1840 ! BLDT=0 or STEPBL=1
1841 ! Test 3: If not adaptive dt, and this is on the requested surface frequency, then yes.
1842 ! MOD(ITIMESTEP,STEPBL)=0
1843 ! Test 4: If using adaptive dt and the current time is past the last requested activate surface time, then yes.
1844 ! CURR_SECS >= BLDTACTTIME
1846 ! If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
1847 ! to TRUE. The decided flag says that one of these tests was able to say "yes", run the scheme.
1848 ! We only proceed to other tests if the previous tests all have left decided as FALSE.
1850 run_param = .FALSE.
1851 decided = .FALSE.
1852 IF ( ( .NOT. decided ) .AND. &
1853 ( itimestep .EQ. 1 ) ) THEN
1854 run_param = .TRUE.
1855 decided = .TRUE.
1856 END IF
1858 IF ( PRESENT(bldt) )THEN
1859 IF ( ( .NOT. decided ) .AND. &
1860 ( ( bldt .EQ. 0. ) .OR. ( stepbl .EQ. 1 ) ) ) THEN
1861 run_param = .TRUE.
1862 decided = .TRUE.
1863 END IF
1864 ELSE
1865 IF ( ( .NOT. decided ) .AND. &
1866 ( stepbl .EQ. 1 ) ) THEN
1867 run_param = .TRUE.
1868 decided = .TRUE.
1869 END IF
1870 END IF
1872 IF ( ( .NOT. decided ) .AND. &
1873 ( .NOT. doing_adapt_dt ) .AND. &
1874 ( MOD(itimestep,stepbl) .EQ. 0 ) ) THEN
1875 run_param = .TRUE.
1876 decided = .TRUE.
1877 END IF
1879 IF ( ( .NOT. decided ) .AND. &
1880 ( doing_adapt_dt ) .AND. &
1881 ( curr_secs .GE. bldtacttime ) ) THEN
1882 run_param = .TRUE.
1883 decided = .TRUE.
1884 END IF
1886 IF ( run_param ) then
1888 radiation = .false.
1889 frpcpn = .false.
1890 myj = ((sf_sfclay_physics .EQ. MYJSFCSCHEME) .OR. &
1891 (sf_sfclay_physics .EQ. QNSESFCSCHEME) )
1893 myjpbl = ((bl_pbl_physics .EQ. MYJPBLSCHEME) .OR. &
1894 (bl_pbl_physics .EQ. QNSEPBLSCHEME) )
1896 isisfc = ( FRACTIONAL_SEAICE .EQ. 1 .AND. ( &
1897 (sf_sfclay_physics .EQ. SFCLAYSCHEME ) .OR. &
1898 (sf_sfclay_physics .EQ. SFCLAYREVSCHEME ) .OR. &
1899 (sf_sfclay_physics .EQ. PXSFCSCHEME ) .OR. &
1900 (sf_sfclay_physics .EQ. MYJSFCSCHEME ) .OR. &
1901 (sf_sfclay_physics .EQ. QNSESFCSCHEME ) .OR. & !emt
1902 #if (EM_CORE==1)
1903 (sf_sfclay_physics .EQ. MYNNSFCSCHEME ) .OR. &
1904 #endif
1905 (sf_sfclay_physics .EQ. GFSSFCSCHEME ) ) &
1906 )
1908 IF (ra_lw_physics .gt. 0) radiation = .true.
1910 IF( PRESENT(slope_rad).AND. radiation )THEN
1911 ! topographic slope effects modify SWDOWN and GSW here
1912 IF (slope_rad .EQ. 1) THEN
1913 !$OMP PARALLEL DO &
1914 !$OMP PRIVATE ( ij, i, j, k )
1915 DO ij = 1 , num_tiles
1916 CALL TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN, &
1917 shadowmask,diffuse_frac, &
1918 declin, &
1919 SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang, &
1920 slope,slp_azi, &
1921 ids, ide, jds, jde, kds, kde, &
1922 ims, ime, jms, jme, kms, kme, &
1923 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
1924 ENDDO
1925 !$OMP END PARALLEL DO
1927 ENDIF
1928 ENDIF
1929 !----
1930 ! CALCULATE CONSTANT
1932 DTMIN=DT/60.
1933 ! Surface schemes need PBL time step for updates and accumulations
1934 ! Assume these schemes provide no tendencies
1936 if (PRESENT(adapt_step_flag)) then
1937 if (adapt_step_flag) then
1938 do_adapt = .TRUE.
1939 else
1940 do_adapt = .FALSE.
1941 endif
1942 else
1943 do_adapt = .FALSE.
1944 endif
1946 if (PRESENT(BLDT)) then
1947 if (bldt .eq. 0) then
1948 DTBL = dt
1949 ELSE
1950 if (do_adapt) then
1951 IF ( curr_secs .LT. 2. * dt ) THEN
1952 call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// &
1953 " time-step should be 0 (i.e., equivalent to model time-step)." )
1954 call wrf_message("In order to proceed, for surface calculations, the "// &
1955 "boundary layer time-step"// &
1956 " will be rounded to the nearest minute," )
1957 call wrf_message("possibly resulting in innacurate results.")
1958 END IF
1959 DTBL=bldt*60
1960 else
1961 DTBL=DT*STEPBL
1962 endif
1963 endif
1964 else
1965 DTBL=DT*STEPBL
1966 endif
1968 ! SAVE OLD VALUES
1971 !$OMP PARALLEL DO &
1972 !$OMP PRIVATE ( ij, i, j, k )
1973 DO ij = 1 , num_tiles
1974 DO j=j_start(ij),j_end(ij)
1975 DO i=i_start(ij),i_end(ij)
1976 ! PSFC : in Pa
1977 PSFC(I,J)=p8w(I,kts,J)
1978 ! REVERSE ORDER IN THE VERTICAL DIRECTION
1979 DO k=kts,kte
1980 v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
1981 u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
1982 ENDDO
1983 ! remove surface currents for atmospheric low-level winds
1984 u_phytmp(i,kts,j)=u_phytmp(i,kts,j)-uoce(i,j)
1985 v_phytmp(i,kts,j)=v_phytmp(i,kts,j)-voce(i,j)
1986 ENDDO
1987 ENDDO
1988 ENDDO
1989 !$OMP END PARALLEL DO
1991 !$OMP PARALLEL DO &
1992 !$OMP PRIVATE ( ij, i, j, k )
1993 DO ij = 1 , num_tiles
1994 sfclay_select: SELECT CASE(sf_sfclay_physics)
1996 CASE (SFCLAYSCHEME)
1997 ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
1998 ! because it takes a scalar DX. NMM passes in a dummy value for this
1999 ! scalar. NEEDS FURTHER ATTENTION. JM 20050215
2000 IF(PRESENT(SCM_FORCE_FLUX))THEN
2001 IF (scm_force_flux .EQ. 1) THEN
2002 ! surface forcing by observed fluxes
2003 CALL scmflux(u_phytmp, v_phytmp, t_phy, qv_curr, p_phy, dz8w, &
2004 cp, rcp, xlv, psfc, cpm, xland, &
2005 psim, psih, hfx, qfx, lh, tsk, flhc, flqc, &
2006 znt, gz1oz0, wspd, &
2007 julian_in, karman, p1000mb, &
2008 itimestep,chklowq, &
2009 ids, ide, jds, jde, kds, kde, &
2010 ims, ime, jms, jme, kms, kme, &
2011 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2012 ENDIF
2013 ENDIF
2014 IF(PRESENT(SCM_FORCE_SKINTEMP))THEN
2015 IF (scm_force_skintemp .EQ. 1) THEN
2016 ! surface forcing by observed skin temperature
2017 CALL scmskintemp(tsk, julian_in, itimestep, &
2018 ids, ide, jds, jde, kds, kde, &
2019 ims, ime, jms, jme, kms, kme, &
2020 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2021 ENDIF
2022 ! IF (scm_force_skintemp .EQ. 2) THEN
2023 ! surface forcing by gabls2 skin temperature
2024 ! CALL scmgabls2(tsk, itimestep, dt, &
2025 ! ids, ide, jds, jde, kds, kde, &
2026 ! ims, ime, jms, jme, kms, kme, &
2027 ! i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2028 ! ENDIF
2029 ENDIF
2030 IF (PRESENT(qv_curr) .AND. &
2031 PRESENT(mol) .AND. PRESENT(regime) .AND. &
2032 .TRUE. ) THEN
2033 CALL wrf_debug( 100, 'in SFCLAY' )
2034 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2035 CALL SFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
2036 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2037 znt,ust,pblh,mavail,zol,mol,regime,psim,psih,fm,fhh, &
2038 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2039 u10,v10,th2,t2,q2, &
2040 gz1oz0,wspd,br,isfflx,dx2d, &
2041 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
2042 P1000mb, &
2043 XICE,SST,TSK_SEA, &
2044 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
2045 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
2046 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
2047 ids,ide, jds,jde, kds,kde, &
2048 ims,ime, jms,jme, kms,kme, &
2049 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
2050 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux, &
2051 sf_surface_physics )
2052 ELSE
2053 CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr, &
2054 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2055 znt,ust,pblh,mavail,zol,mol,regime,psim,psih,fm,fhh, &
2056 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2057 u10,v10,th2,t2,q2, &
2058 gz1oz0,wspd,br,isfflx,dx2d, &
2059 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
2060 P1000mb, &
2061 ids,ide, jds,jde, kds,kde, &
2062 ims,ime, jms,jme, kms,kme, &
2063 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
2064 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux )
2065 #if ( EM_CORE==1)
2066 DO j = j_start(ij),j_end(ij)
2067 DO i = i_start(ij),i_end(ij)
2068 ch(i,j) = chs (i,j)
2069 !! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
2070 end do
2071 end do
2072 #endif
2073 ENDIF
2074 ELSE
2075 CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
2076 ENDIF
2078 CASE (SFCLAYREVSCHEME)
2079 ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
2080 ! because it takes a scalar DX. NMM passes in a dummy value for this
2081 ! scalar. NEEDS FURTHER ATTENTION. JM 20050215
2082 IF (PRESENT(qv_curr) .AND. &
2083 PRESENT(mol) .AND. PRESENT(regime) .AND. &
2084 .TRUE. ) THEN
2085 CALL wrf_debug( 100, 'in SFCLAY' )
2087 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2088 CALL SFCLAYREV_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
2089 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2090 znt,ust,pblh,mavail,zol,mol,regime,psim,psih,fm,fhh, &
2091 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2092 u10,v10,th2,t2,q2, &
2093 gz1oz0,wspd,br,isfflx,dx, &
2094 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
2095 P1000mb, &
2096 XICE,SST,TSK_SEA, &
2097 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
2098 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
2099 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
2100 ids,ide, jds,jde, kds,kde, &
2101 ims,ime, jms,jme, kms,kme, &
2102 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
2103 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
2104 shalwater_z0,water_depth,shalwater_depth, &
2105 scm_force_flux,sf_surface_physics )
2106 ELSE
2107 CALL SFCLAYREV(u_phytmp,v_phytmp,t_phy,qv_curr,&
2108 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2109 znt,ust,pblh,mavail,zol,mol,regime,psim,psih,fm,fhh, &
2110 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2111 u10,v10,th2,t2,q2, &
2112 gz1oz0,wspd,br,isfflx,dx, &
2113 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
2114 P1000mb, &
2115 ids,ide, jds,jde, kds,kde, &
2116 ims,ime, jms,jme, kms,kme, &
2117 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
2118 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
2119 shalwater_z0,water_depth,shalwater_depth, &
2120 scm_force_flux )
2121 #if ( EM_CORE==1)
2122 DO j = j_start(ij),j_end(ij)
2123 DO i = i_start(ij),i_end(ij)
2124 ch(i,j) = chs (i,j)
2125 !! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
2126 end do
2127 end do
2128 #endif
2129 ENDIF
2130 ELSE
2131 CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
2132 ENDIF
2134 CASE (PXSFCSCHEME)
2135 IF (PRESENT(qv_curr) .AND. &
2136 PRESENT(mol) .AND. PRESENT(regime) .AND. &
2137 .TRUE. ) THEN
2138 CALL wrf_debug( 100, 'in PX Surface Layer scheme' )
2139 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2140 CALL PXSFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
2141 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2142 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
2143 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2144 u10,v10, &
2145 gz1oz0,wspd,br,isfflx,dx, &
2146 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
2147 XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
2148 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA,FLHC_SEA,FLQC_SEA,&
2149 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA, &
2150 ids,ide, jds,jde, kds,kde, &
2151 ims,ime, jms,jme, kms,kme, &
2152 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2153 ELSE
2154 CALL PXSFCLAY(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
2155 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2156 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
2157 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2158 u10,v10, &
2159 gz1oz0,wspd,br,isfflx,dx, &
2160 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,itimestep, &
2161 ids,ide, jds,jde, kds,kde, &
2162 ims,ime, jms,jme, kms,kme, &
2163 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2164 ENDIF
2165 ELSE
2166 CALL wrf_error_fatal('Lacking arguments for PX Surface Layer in surface driver')
2167 ENDIF
2169 CASE (MYJSFCSCHEME)
2170 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
2171 .TRUE. ) THEN
2173 CALL wrf_debug(100,'in MYJSFC')
2174 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2175 CALL MYJSFC_SEAICE_WRAPPER(itimestep,ht,dz8w, &
2176 p_phy,p8w,th_phy,t_phy, &
2177 qv_curr,qc_curr, &
2178 u_phy,v_phy,tke_pbl, &
2179 tsk,qsfc,thz0,qz0,uz0,vz0, &
2180 lowlyr, &
2181 xland,ivgtyp,isurban,iz0tlnd, &
2182 TICE2TSK_IF2COLD, & ! Extra for wrapper.
2183 XICE_THRESHOLD, & ! Extra for wrapper.
2184 XICE, SST, & ! Extra for wrapper.
2185 CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, &
2186 FLHC_SEA, FLQC_SEA, QSFC_SEA, &
2187 QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, LH_SEA, &
2188 TSK_SEA, &
2189 ust,znt,z0,pblh,mavail,rmol, &
2190 akhs,akms, &
2191 br, &
2192 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
2193 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
2194 p1000mb,u10e,v10e, &
2195 ids,ide, jds,jde, kds,kde, &
2196 ims,ime, jms,jme, kms,kme, &
2197 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2198 ELSE
2199 CALL MYJSFC(itimestep,ht,dz8w, &
2200 p_phy,p8w,th_phy,t_phy, &
2201 qv_curr,qc_curr, &
2202 u_phy,v_phy,tke_pbl, &
2203 tsk,qsfc,thz0,qz0,uz0,vz0, &
2204 lowlyr, &
2205 xland,ivgtyp,isurban,iz0tlnd, &
2206 ust,znt,z0,pblh,mavail,rmol, &
2207 akhs,akms, &
2208 br, &
2209 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
2210 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
2211 p1000mb,u10e,v10e, &
2212 ids,ide, jds,jde, kds,kde, &
2213 ims,ime, jms,jme, kms,kme, &
2214 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2215 ENDIF
2216 ! ustm is needed for LES tke calculation (ustm is ust used in friction)
2217 DO j = j_start(ij),j_end(ij)
2218 DO i = i_start(ij),i_end(ij)
2219 ustm(i,j) = ust(i,j)
2220 wspd(i,j) = MAX(SQRT(u_phy(i,kts,j)**2+v_phy(i,kts,j)**2),0.001)
2221 ch(i,j) = chs (i,j)
2222 END DO
2223 END DO
2224 ELSE
2225 CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
2226 ENDIF
2228 CASE (QNSESFCSCHEME)
2229 IF(PRESENT(SCM_FORCE_FLUX))THEN
2230 IF (scm_force_flux .EQ. 1) THEN
2231 ! surface forcing by observed fluxes
2232 CALL scmflux(u_phytmp, v_phytmp, t_phy, qv_curr, p_phy, dz8w, &
2233 cp, rcp, xlv, psfc, cpm, xland, &
2234 psim, psih, hfx, qfx, lh, tsk, flhc, flqc, &
2235 znt, gz1oz0, wspd, &
2236 julian_in, karman, p1000mb, &
2237 itimestep,chklowq, &
2238 ids, ide, jds, jde, kds, kde, &
2239 ims, ime, jms, jme, kms, kme, &
2240 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2241 ENDIF
2242 ENDIF
2243 IF(PRESENT(SCM_FORCE_SKINTEMP))THEN
2244 IF (scm_force_skintemp .EQ. 1) THEN
2245 ! surface forcing by observed skin temperature
2246 CALL scmskintemp(tsk, julian_in, itimestep, &
2247 ids, ide, jds, jde, kds, kde, &
2248 ims, ime, jms, jme, kms, kme, &
2249 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2250 ENDIF
2251 ENDIF
2253 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
2254 .TRUE. ) THEN
2255 CALL wrf_debug(100,'in QNSESFC')
2256 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2257 CALL QNSESFC_SEAICE_WRAPPER(itimestep,ht,dz8w, &
2258 p_phy,p8w,th_phy,t_phy, &
2259 qv_curr,qc_curr, &
2260 u_phy,v_phy,tke_pbl, &
2261 tsk,qsfc,thz0,qz0,uz0,vz0, &
2262 lowlyr, &
2263 xland, &
2264 TICE2TSK_IF2COLD, & ! Extra for wrapper.
2265 XICE_THRESHOLD, & ! Extra for wrapper.
2266 XICE, SST, & ! Extra for wrapper.
2267 CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, &
2268 FLHC_SEA, FLQC_SEA, QSFC_SEA, &
2269 QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, LH_SEA, &
2270 TSK_SEA, &
2271 ust,znt,z0,pblh,mavail,rmol, &
2272 akhs,akms, &
2273 br, &
2274 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
2275 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
2276 u10e,v10e, &
2277 ids,ide, jds,jde, kds,kde, &
2278 ims,ime, jms,jme, kms,kme, &
2279 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,SCM_FORCE_FLUX )
2280 ELSE
2281 CALL QNSESFC(itimestep,ht,dz8w, &
2282 p_phy,p8w,th_phy,t_phy, &
2283 qv_curr,qc_curr, &
2284 u_phy,v_phy,tke_pbl, &
2285 tsk,qsfc,thz0,qz0,uz0,vz0, &
2286 lowlyr, &
2287 xland, &
2288 ust,znt,z0,pblh,mavail,rmol, &
2289 akhs,akms, &
2290 br, &
2291 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct, &
2292 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr, &
2293 u10e,v10e, &
2294 ids,ide, jds,jde, kds,kde, &
2295 ims,ime, jms,jme, kms,kme, &
2296 i_start(ij),i_end(ij), j_start(ij),j_end(ij), &
2297 kts,kte,scm_force_flux )
2298 ENDIF
2299 #if ( EM_CORE==1)
2300 DO j = j_start(ij),j_end(ij)
2301 DO i = i_start(ij),i_end(ij)
2302 wspd(i,j) = MAX(SQRT(u_phy(i,kts,j)**2+v_phy(i,kts,j)**2),0.001)
2303 ch(i,j) = chs (i,j)
2304 !! ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
2305 END DO
2306 END DO
2307 #endif
2308 ELSE
2309 CALL wrf_error_fatal('Lacking arguments for QNSESFC in surface driver')
2310 ENDIF
2312 CASE (GFSSFCSCHEME)
2313 IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
2314 CALL wrf_debug( 100, 'in GFSSFC' )
2315 IF (FRACTIONAL_SEAICE == 1) THEN
2316 CALL SF_GFS_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr, &
2317 p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
2318 ZNT,UST,PSIM,PSIH, &
2319 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
2320 QGH,QSFC,U10,V10, &
2321 GZ1OZ0,WSPD,BR,ISFFLX, &
2322 EP_1,EP_2,KARMAN,itimestep, &
2323 TICE2TSK_IF2COLD, &
2324 XICE_THRESHOLD, &
2325 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, &
2326 FLHC_SEA, FLQC_SEA, &
2327 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, &
2328 UST_SEA, ZNT_SEA, SST, XICE, &
2329 ids,ide, jds,jde, kds,kde, &
2330 ims,ime, jms,jme, kms,kme, &
2331 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2332 ELSE
2333 CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr, &
2334 p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
2335 ZNT,UST,PSIM,PSIH, &
2336 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
2337 QGH,QSFC,U10,V10, &
2338 GZ1OZ0,WSPD,BR,ISFFLX, &
2339 EP_1,EP_2,KARMAN,itimestep, &
2340 ids,ide, jds,jde, kds,kde, &
2341 ims,ime, jms,jme, kms,kme, &
2342 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2343 ENDIF
2344 CALL wrf_debug(100,'in SFCDIAGS')
2345 ELSE
2346 CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
2347 ENDIF
2349 #if ( EM_CORE==1)
2350 CASE(MYNNSFCSCHEME)
2352 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) &
2353 & .AND. PRESENT(qcg) ) THEN
2355 CALL wrf_debug(100,'in MYNNSFC')
2357 IF (FRACTIONAL_SEAICE == 1) THEN
2358 CALL MYNN_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
2359 p_phy,dz8w,th_phy,rho, &
2360 cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2361 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
2362 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2363 u10,v10,th2,t2,q2,SNOWH, &
2364 gz1oz0,wspd,br,isfflx,dx, &
2365 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
2366 itimestep,ch,qcg, &
2367 spp_pbl,pattern_spp_pbl, &
2368 XICE,SST,TSK_SEA, &
2369 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA,&
2370 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
2371 TICE2TSK_IF2COLD,XICE_THRESHOLD, &
2372 ids,ide, jds,jde, kds,kde, &
2373 ims,ime, jms,jme, kms,kme, &
2374 i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte,&
2375 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
2376 ELSE
2377 CALL SFCLAY_mynn(u_phytmp,v_phytmp,t_phy,qv_curr, &
2378 p_phy,dz8w,th_phy,rho, &
2379 cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
2380 znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
2381 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol, &
2382 u10,v10,th2,t2,q2,SNOWH, &
2383 gz1oz0,wspd,br,isfflx,dx, &
2384 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman, &
2385 itimestep,ch,qcg, &
2386 spp_pbl,pattern_spp_pbl, &
2387 ids,ide, jds,jde, kds,kde, &
2388 ims,ime, jms,jme, kms,kme, &
2389 i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte,&
2390 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
2391 ENDIF
2392 ELSE
2393 CALL wrf_error_fatal('Lacking arguments for SFCLAY_mynn in surface driver')
2394 ENDIF
2395 #endif
2397 #if ( EM_CORE==1)
2398 CASE (TEMFSFCSCHEME)
2399 IF (PRESENT(qv_curr).and.PRESENT(hd_temf)) THEN
2400 CALL wrf_debug( 100, 'in TEMFSFCLAY' )
2401 ! WA 9/7/09 must initialize Z0 and ZNT for TEMF in ideal cases
2402 ! DO J=j_start(ij),j_end(ij)
2403 ! DO I=i_start(ij),i_end(ij)
2404 ! CHKLOWQ(i,j) = 1.0
2405 ! Z0(i,j) = 0.03 ! For GABLS2
2406 ! ZNT(i,j) = 0.03 ! For GABLS2
2407 ! ENDDO
2408 ! ENDDO
2409 CALL TEMFSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy, &
2410 qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
2411 CP=cp,G=g,ROVCP=rcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
2412 chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust, &
2413 MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh, &
2414 TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc, &
2415 U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, &
2416 SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
2417 EP2=ep_2,KARMAN=karman,fCor=fCor,te_temf=te_temf, &
2418 hd_temf=hd_temf,exch_temf=exch_temf,wm_temf=wm_temf,&
2419 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
2420 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
2421 its=i_start(ij),ite=i_end(ij), &
2422 jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
2423 ELSE
2424 CALL wrf_error_fatal('Lacking arguments for TEMFSFCLAY in surface driver')
2425 ENDIF
2427 CASE (IDEALSCMSFCSCHEME)
2428 IF (PRESENT(qv_curr)) THEN
2429 CALL wrf_debug( 100, 'in IDEALSCMSFCLAY' )
2430 CALL IDEALSCMSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy, &
2431 qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
2432 CP=cp,G=g,ROVCP=rcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs, &
2433 chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust, &
2434 MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh, &
2435 TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc, &
2436 U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2, &
2437 SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
2438 EP2=ep_2,KARMAN=karman,fCor=fCor, &
2439 exch_temf=exch_temf, &
2440 hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, &
2441 hfx_force_tend=hfx_force_tend, &
2442 lh_force_tend=lh_force_tend, &
2443 tsk_force_tend=tsk_force_tend, &
2444 dt=dt,itimestep=itimestep, &
2445 ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde, &
2446 ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme, &
2447 its=i_start(ij),ite=i_end(ij), &
2448 jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
2449 ELSE
2450 CALL wrf_error_fatal('Lacking arguments for IDEALSCMSFCLAY in surface driver')
2451 ENDIF
2452 #endif
2454 CASE DEFAULT
2456 WRITE( message , * ) &
2457 'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
2458 CALL wrf_error_fatal ( message )
2460 END SELECT sfclay_select
2462 ! Compute uratx, vratx, tratx for obs nudging
2463 IF(PRESENT(uratx) .and. PRESENT(vratx) .and. PRESENT(tratx))THEN
2464 DO J=j_start(ij),j_end(ij)
2465 DO I=i_start(ij),i_end(ij)
2466 IF(ABS(U10(I,J)) .GT. 1.E-10) THEN
2467 uratx(I,J) = U_PHYTMP(I,1,J)/U10(I,J)
2468 ELSE
2469 uratx(I,J) = 1.2
2470 END IF
2471 IF(ABS(V10(I,J)) .GT. 1.E-10) THEN
2472 vratx(I,J) = V_PHYTMP(I,1,J)/V10(I,J)
2473 ELSE
2474 vratx(I,J) = 1.2
2475 END IF
2476 ! (Quotient P1000mb/P_PHY must be conditioned due to large value of P1000mb)
2477 tratx(I,J) = (T_PHY(I,1,J)*(P1000mb*0.001/(P_PHY(I,1,J)/1000.))**RCP) &
2478 /TH2(I,J)
2479 ENDDO
2480 ENDDO
2481 ENDIF
2483 #if ( EM_CORE==1)
2484 !Katata-added - fog (cloud) water deposition calculation
2485 IF ( grav_settling .EQ. 0 ) THEN
2486 !vdfg = 0.
2487 DO j=j_start(ij),j_end(ij)
2488 DO i=i_start(ij),i_end(ij)
2489 vdfg(i,j)=0.
2490 ENDDO
2491 ENDDO
2492 ELSE
2493 IF ( PRESENT(dfgdp) .AND. PRESENT(fgdp) .AND. &
2494 & PRESENT(rainbl) .AND. PRESENT(vdfg)) THEN
2495 DO j=j_start(ij),j_end(ij)
2496 DO i=i_start(ij),i_end(ij)
2497 dfgdp(i,j)=0.
2498 ENDDO
2499 ENDDO
2501 CALL sf_fogdes( &
2502 vdfg,fgdp,dfgdp,ivgtyp,lai,wspd,qc_curr, &
2503 dtbl,rho,dz8w,grav_settling,nlcat, &
2504 ids,ide, jds,jde, kds,kde, &
2505 ims,ime, jms,jme, kms,kme, &
2506 i_start(ij),i_end(ij), &
2507 j_start(ij),j_end(ij),kts,kte )
2509 !Add fog dep to RAINBL in mm (Accumulation between PBL calls).
2510 DO j=j_start(ij),j_end(ij)
2511 DO i=i_start(ij),i_end(ij)
2512 RAINBL(i,j) = RAINBL(i,j) + dfgdp(i,j)
2513 RAINBL(i,j) = MAX(RAINBL(i,j), 0.0)
2514 ENDDO
2515 ENDDO
2517 ELSE
2518 CALL wrf_error_fatal('Missing args for FGDP in surface driver')
2519 ENDIF
2520 ENDIF
2521 !Katata/Joe-END
2522 #endif
2524 ENDDO
2525 !$OMP END PARALLEL DO
2527 IF (ISFFLX.EQ.0 ) GOTO 430
2528 !$OMP PARALLEL DO &
2529 !$OMP PRIVATE ( ij, i, j, k ) firstprivate(frpcpn)
2530 DO ij = 1 , num_tiles
2532 sfc_select: SELECT CASE(sf_surface_physics)
2534 CASE (SLABSCHEME)
2536 IF (PRESENT(qv_curr) .AND. &
2537 PRESENT(capg) .AND. &
2538 .TRUE. ) THEN
2539 DO j=j_start(ij),j_end(ij)
2540 DO i=i_start(ij),i_end(ij)
2541 ! CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
2542 CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
2543 ENDDO
2544 ENDDO
2546 CALL wrf_debug(100,'in SLAB')
2547 CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc, &
2548 psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq, &
2549 gsw,glw,capg,thc,snowc,emiss,mavail, &
2550 dtbl,rcp,xlv,dtmin,ifsnow, &
2551 svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt, &
2552 tslb,zs,dzs,num_soil_layers,radiation, &
2553 p1000mb, &
2554 ids,ide, jds,jde, kds,kde, &
2555 ims,ime, jms,jme, kms,kme, &
2556 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
2558 DO j=j_start(ij),j_end(ij)
2559 DO i=i_start(ij),i_end(ij)
2560 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
2561 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
2562 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
2563 ENDDO
2564 ENDDO
2566 CALL wrf_debug(100,'in SFCDIAGS')
2567 CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2, &
2568 psfc,cp,r_d,rcp,CHS,t_phy,qv_curr,ua_phys, &
2569 ids,ide, jds,jde, kds,kde, &
2570 ims,ime, jms,jme, kms,kme, &
2571 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2573 ENDIF
2575 CASE (LSMSCHEME)
2577 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
2578 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
2579 ! PRESENT(declin) .AND. PRESENT(coszen) .AND. &
2580 ! PRESENT(hrang) .AND. PRESENT( xlat_urb2d) .AND. &
2581 ! PRESENT(dzr) .AND. &
2582 ! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
2583 ! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
2584 ! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
2585 ! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
2586 ! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
2587 ! PRESENT(xxxg_urb2d) .AND. &
2588 ! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
2589 ! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
2590 ! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
2591 ! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
2592 ! PRESENT(ts_urb2d) .AND. &
2593 ! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
2594 .TRUE. ) THEN
2595 !------------------------------------------------------------------
2596 IF( PRESENT(sr) ) THEN
2597 frpcpn=.true.
2598 ENDIF
2599 IF ( FRACTIONAL_SEAICE == 1) THEN
2600 ! The fields passed to LSM need to represent the full ice values, not
2601 ! the fractional values. Convert ALBEDO and EMISS from the blended value
2602 ! to a value representing only the sea-ice portion. Albedo over open
2603 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
2604 DO j = j_start(ij) , j_end(ij)
2605 DO i = i_start(ij) , i_end(ij)
2606 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
2607 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
2608 EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
2609 ENDIF
2610 ENDDO
2611 ENDDO
2613 IF ( isisfc ) THEN
2614 ! Use surface layer routine values from the ice portion of grid point
2615 ELSE
2616 !
2617 ! We don't have surface layer routine values at this time, so
2618 ! just use what we have. Use ice component of TSK
2619 !
2620 CALL get_local_ice_tsk( ims, ime, jms, jme, &
2621 i_start(ij), i_end(ij), &
2622 j_start(ij), j_end(ij), &
2623 itimestep, .false., tice2tsk_if2cold, &
2624 XICE, XICE_THRESHOLD, &
2625 SST, TSK, TSK_SEA, TSK_LOCAL )
2627 DO j = j_start(ij) , j_end(ij)
2628 DO i = i_start(ij) , i_end(ij)
2629 TSK(i,j) = TSK_LOCAL(i,j)
2630 ENDDO
2631 ENDDO
2632 ENDIF
2633 ENDIF
2635 !added for WRF_HYDRO
2636 #ifdef WRF_HYDRO
2637 if(HYDRO_dt .ge. 0) HYDRO_dt = dtbl
2638 #endif
2640 ! added RA population for WRF/Noah-CMAQ RS Consistency
2641 ! following Garland et al. (1977) and Nemitz et al., 2009
2642 IF ( PRESENT(RA) ) THEN
2643 DO j=j_start(ij),j_end(ij)
2644 DO i=i_start(ij),i_end(ij)
2645 RA(I,J) = WSPD(I,J)/UST(I,J)**2.0
2646 ENDDO
2647 ENDDO
2648 END IF
2650 CALL wrf_debug(100,'in NOAH DRV')
2652 IF (sf_surface_mosaic == 1) THEN
2654 IF ( PRESENT( TSK_mosaic ) .AND. PRESENT( HFX_mosaic ) ) THEN
2655 CALL lsm_mosaic(dz8w,qv_curr,p8w,t_phy,tsk, &
2656 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot, &
2657 sfcrunoff,udrunoff,ivgtyp,isltyp,isurban,isice,vegfra, &
2658 albedo,albbck,znt,z0, tmn,xland,xice,emiss, embck, &
2659 snowc,qsfc,rainbl, &
2660 mminlu, &
2661 num_soil_layers,dtbl,dzs,itimestep, &
2662 smois,tslb,snow,canwat, &
2663 chs, chs2, cqs2, cpm,rcp,SR,chklowq,lai,qz0, &
2664 myj,frpcpn, &
2665 sh2o,snowh, & !h
2666 u_phy,v_phy, & !I
2667 snoalb,shdmin,shdmax, & !i
2668 snotime, & !o
2669 acsnom,acsnow, & !o
2670 snopcx, & !o
2671 potevp, & !o
2672 smcrel, & !o
2673 xice_threshold, &
2674 rdlai2d,usemonalb, &
2675 br, & !?
2676 NOAHRES,opt_thcnd, &
2677 NLCAT,landusef,landusef2, & ! danli mosaic
2678 sf_surface_mosaic,mosaic_cat,mosaic_cat_index, & ! danli mosaic
2679 TSK_mosaic,QSFC_mosaic, & ! danli mosaic
2680 TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic, & ! danli mosaic
2681 CANWAT_mosaic,SNOW_mosaic, & ! danli mosaic
2682 SNOWH_mosaic,SNOWC_mosaic, & ! danli mosaic
2683 ALBEDO_mosaic,ALBBCK_mosaic, & ! danli mosaic
2684 EMISS_mosaic, EMBCK_mosaic, & ! danli mosaic
2685 ZNT_mosaic, Z0_mosaic, & ! danli mosaic
2686 HFX_mosaic,QFX_mosaic, & ! danli mosaic
2687 LH_mosaic, GRDFLX_mosaic, SNOTIME_mosaic, & ! danli mosaic
2688 RS_mosaic, LAI_mosaic, & ! mosaic
2689 ua_phys,flx4,fvb,fbur,fgsn, &
2690 ids,ide, jds,jde, kds,kde, &
2691 ims,ime, jms,jme, kms,kme, &
2692 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
2693 sf_urban_physics &
2694 !Optional urban
2695 ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
2696 ,cmgr_sfcdif,chgr_sfcdif &
2697 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
2698 uc_urb2d, & !H urban
2699 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
2700 trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
2701 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
2702 TR_URB2D_mosaic,TB_URB2D_mosaic, & !H urban danli mosaic
2703 TG_URB2D_mosaic,TC_URB2D_mosaic, & !H urban danli mosaic
2704 QC_URB2D_mosaic,UC_URB2D_mosaic, & !H urban danli mosaic
2705 TRL_URB3D_mosaic,TBL_URB3D_mosaic, & !H urban danli mosaic
2706 TGL_URB3D_mosaic, & !H urban danli mosaic
2707 SH_URB2D_mosaic,LH_URB2D_mosaic, & !H urban danli mosaic
2708 G_URB2D_mosaic,RN_URB2D_mosaic, & !H urban danli mosaic
2709 TS_URB2D_mosaic, & !H urban danli mosaic
2710 TS_RUL2D_mosaic, & !H urban danli mosaic
2711 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
2712 GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
2713 th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
2714 declin,coszen,hrang, & !I solar
2715 xlat_urb2d, & !I urban
2716 num_roof_layers, num_wall_layers, & !I urban
2717 num_road_layers, DZR, DZB, DZG, & !I urban
2718 CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D, & !H urban
2719 julian,julyr, & !H urban
2720 DRELR_URB2D,DRELB_URB2D,DRELG_URB2D, & !H urban
2721 FLXHUMR_URB2D,FLXHUMB_URB2D,FLXHUMG_URB2D, & !H urban
2722 FRC_URB2D, UTYPE_URB2D, & !I urban
2723 num_urban_ndm, & !I multi-layer urban
2724 urban_map_zrd, & !I multi-layer urban
2725 urban_map_zwd, & !I multi-layer urban
2726 urban_map_gd, & !I multi-layer urban
2727 urban_map_zd, & !I multi-layer urban
2728 urban_map_zdf, & !I multi-layer urban
2729 urban_map_bd, & !I multi-layer urban
2730 urban_map_wd, & !I multi-layer urban
2731 urban_map_gbd, & !I multi-layer urban
2732 urban_map_fbd, & !I multi-layer urban
2733 urban_map_zgrd, & !I multi-layer urban
2734 num_urban_hi, & !I multi-layer urban
2735 use_wudapt_lcz, & !I wudapt
2736 tsk_rural, & !H multi-layer urban
2737 trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d, & !H multi-layer urban
2738 tlev_urb3d,qlev_urb3d, & !H multi-layer urban
2739 tw1lev_urb3d,tw2lev_urb3d, & !H multi-layer urban
2740 tglev_urb3d,tflev_urb3d, & !H multi-layer urban
2741 sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d, & !H multi-layer urban
2742 sfvent_urb3d,lfvent_urb3d, & !H multi-layer urban
2743 sfwin1_urb3d,sfwin2_urb3d, & !H multi-layer urban
2744 sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d, & !H multi-layer urban
2745 ep_pv_urb3d,t_pv_urb3d, & !GRZ
2746 trv_urb4d,qr_urb4d,qgr_urb3d,tgr_urb3d, & !GRZ
2747 drain_urb4d,draingr_urb3d,sfrv_urb3d, & !GRZ
2748 lfrv_urb3d,dgr_urb3d,dg_urb3d,lfr_urb3d,lfg_urb3d,& !GRZ
2749 lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d, & !H multi-layer urban
2750 mh_urb2d,stdh_urb2D,lf_urb2d, & !SLUCM
2751 th_phy,rho,p_phy,ust, & !I multi-layer urban
2752 gmt,julday,xlong,xlat, & !I multi-layer urban
2753 a_u_bep,a_v_bep,a_t_bep,a_q_bep, & !O multi-layer urban
2754 a_e_bep,b_u_bep,b_v_bep, & !O multi-layer urban
2755 b_t_bep,b_q_bep,b_e_bep,dlg_bep, & !O multi-layer urban
2756 dl_u_bep,sf_bep,vl_bep & !O multi-layer urban
2757 #ifdef WRF_HYDRO
2758 ,sfcheadrt,INFXSRT, soldrain & !hydro
2759 #endif
2760 ,SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM, fasdas & ! fasdas
2761 ,RS,XLAIDYN,IRRIGATION_CHANNEL)
2762 ELSE
2763 CALL wrf_error_fatal('Lack arguments to call lsm_mosaic')
2764 ENDIF
2766 ELSEIF (sf_surface_mosaic == 0) THEN
2768 !
2769 ! FASDAS
2770 !
2771 IF( fasdas == 1 ) THEN
2772 DO j=j_start(ij),j_end(ij)
2773 DO i=i_start(ij),i_end(ij)
2775 !ckay2015 only do indirect nudging over land areas
2776 IF(XLAND(i,j) .GT. 1.5) then
2777 SDA_QFX(I,J) = 0.0
2778 SDA_HFX(I,J) = 0.0
2779 END IF
2781 ! TWG2015 Removed lines that update fluxes to ensure this section only defines
2782 ! the output
2783 QFXOLD(I,J)=QFX(I,J)
2784 QFX_KAY = SDA_QFX(I,J)*RHO(I,1,J)*DZ8W(I,1,J)
2785 QFX_KAY = QFX_KAY * QNORM(I,J)
2786 QFX_BOTH(I,J)=QFX(I,J)+QFX_KAY
2788 HFXOLD(I,J)=HFX(I,J)
2789 HFX_KAY = SDA_HFX(I,J)*RHO(I,1,J)*CPM(I,J)*DZ8W(I,1,J)
2790 HFX_BOTH(I,J)=HFX(I,J)+HFX_KAY
2792 ENDDO
2793 ENDDO
2794 END IF
2795 !
2796 ! END FASDAS
2797 !
2798 if (pert_noah .and. multi_perturb == 1) then
2799 allocate (tslb_tmp(i_start(ij):i_end(ij), 1:num_soil_layers, j_start(ij):j_end(ij)))
2800 allocate (smois_tmp(i_start(ij):i_end(ij), 1:num_soil_layers, j_start(ij):j_end(ij)))
2802 call Add_multi_perturb_lsm_perturbations (perts_qvapor, perts_th, perts_smois, perts_tsoil, &
2803 pert_noah_qv, pert_noah_t, pert_noah_smois, pert_noah_tslb, t_phy, qv_curr, tslb, smois, &
2804 tslb_tmp, smois_tmp, num_soil_layers, i_start(ij), i_end(ij), j_start(ij), j_end(ij), ims, &
2805 ime, jms, jme, kms, kme, kts, kte)
2806 end if
2808 CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk, &
2809 hfx,qfx,lh,grdflx,qgh,gsw,swdown,swddir,swddif, &
2810 glw,smstav,smstot, &
2811 sfcrunoff,udrunoff,ivgtyp,isltyp,isurban,isice,vegfra, &
2812 albedo,albbck,znt,z0, tmn,xland,xice,emiss, embck, &
2813 snowc,qsfc,rainbl, &
2814 mminlu, &
2815 num_soil_layers,dtbl,dzs,itimestep, &
2816 smois,tslb,snow,canwat, &
2817 chs, chs2, cqs2, cpm,rcp,SR,chklowq,lai,qz0, &
2818 myj,frpcpn, &
2819 sh2o,snowh, & !h
2820 u_phy,v_phy, & !I
2821 snoalb,shdmin,shdmax, & !i
2822 snotime, & !o
2823 acsnom,acsnow, & !o
2824 snopcx, & !o
2825 potevp, & !o
2826 smcrel, & !o
2827 xice_threshold, &
2828 rdlai2d,usemonalb, &
2829 br, & !?
2830 NOAHRES,opt_thcnd, &
2831 ua_phys,flx4,fvb,fbur,fgsn, &
2832 ids,ide, jds,jde, kds,kde, &
2833 ims,ime, jms,jme, kms,kme, &
2834 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
2835 sf_urban_physics &
2836 !Optional urban
2837 ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
2838 ,cmgr_sfcdif,chgr_sfcdif &
2839 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
2840 uc_urb2d, & !H urban
2841 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
2842 trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
2843 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
2844 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
2845 GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
2846 th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
2847 declin,coszen,hrang, & !I solar
2848 xlat_urb2d, & !I urban
2849 num_roof_layers, num_wall_layers, & !I urban
2850 num_road_layers, DZR, DZB, DZG, & !I urban
2851 CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D, & !H urban
2852 DRELR_URB2D,DRELB_URB2D,DRELG_URB2D, & !H urban
2853 FLXHUMR_URB2D,FLXHUMB_URB2D,FLXHUMG_URB2D, & !H urban
2854 julian, julyr, & !H urban
2855 FRC_URB2D, UTYPE_URB2D, & !I urban
2856 num_urban_ndm, & !I multi-layer urban
2857 urban_map_zrd, & !I multi-layer urban
2858 urban_map_zwd, & !I multi-layer urban
2859 urban_map_gd, & !I multi-layer urban
2860 urban_map_zd, & !I multi-layer urban
2861 urban_map_zdf, & !I multi-layer urban
2862 urban_map_bd, & !I multi-layer urban
2863 urban_map_wd, & !I multi-layer urban
2864 urban_map_gbd, & !I multi-layer urban
2865 urban_map_fbd, & !I multi-layer urban
2866 urban_map_zgrd, & !I multi-layer urban
2867 num_urban_hi, & !I multi-layer urban
2868 tsk_rural, & !H multi-layer urban
2869 trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d, & !H multi-layer urban
2870 tlev_urb3d,qlev_urb3d, & !H multi-layer urban
2871 tw1lev_urb3d,tw2lev_urb3d, & !H multi-layer urban
2872 tglev_urb3d,tflev_urb3d, & !H multi-layer urban
2873 sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d, & !H multi-layer urban
2874 sfvent_urb3d,lfvent_urb3d, & !H multi-layer urban
2875 sfwin1_urb3d,sfwin2_urb3d, & !H multi-layer urban
2876 sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d, & !H multi-layer urban
2877 ep_pv_urb3d,t_pv_urb3d, & !GRZ
2878 trv_urb4d,qr_urb4d,qgr_urb3d,tgr_urb3d, & !GRZ
2879 drain_urb4d,draingr_urb3d,sfrv_urb3d, & !GRZ
2880 lfrv_urb3d,dgr_urb3d,dg_urb3d,lfr_urb3d,lfg_urb3d,& !GRZ
2881 lp_urb2d,hi_urb2d,lb_urb2d,hgt_urb2d, & !H multi-layer urban
2882 mh_urb2d,stdh_urb2D,lf_urb2d, & !SLUCM
2883 th_phy,rho,p_phy,ust, & !I multi-layer urban
2884 gmt,julday,xlong,xlat, & !I multi-layer urban
2885 a_u_bep,a_v_bep,a_t_bep,a_q_bep, & !O multi-layer urban
2886 a_e_bep,b_u_bep,b_v_bep, & !O multi-layer urban
2887 b_t_bep,b_q_bep,b_e_bep,dlg_bep, & !O multi-layer urban
2888 dl_u_bep,sf_bep,vl_bep & !O multi-layer urban
2889 #ifdef WRF_HYDRO
2890 ,sfcheadrt,INFXSRT, soldrain &
2891 #endif
2892 ,SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM, fasdas &
2893 ,RS,XLAIDYN,IRRIGATION_CHANNEL)
2894 ENDIF
2896 if (pert_noah .and. multi_perturb == 1) then
2897 call Remove_multi_perturb_lsm_perturbations (perts_qvapor, perts_th, perts_smois, perts_tsoil, &
2898 pert_noah_qv, pert_noah_t, pert_noah_smois, pert_noah_tslb, t_phy, qv_curr, tslb, smois, &
2899 tslb_tmp, smois_tmp, num_soil_layers, i_start(ij), i_end(ij), j_start(ij), j_end(ij), ims, &
2900 ime, jms, jme, kms, kme, kts, kte)
2901 deallocate (tslb_tmp)
2902 deallocate (smois_tmp)
2903 end if
2905 call seaice_noah( SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT, SEAICE_THICKNESS_OPT, &
2906 & SEAICE_THICKNESS_DEFAULT, SEAICE_SNOWDEPTH_OPT, &
2907 & SEAICE_SNOWDEPTH_MAX, SEAICE_SNOWDEPTH_MIN, &
2908 & t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
2909 & glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold, &
2910 & albsi, icedepth, snowsi, &
2911 & tslb, emiss, albedo, z0, tsk, snow, snowc, snowh, &
2912 & chs, chs2, cqs2, &
2913 & br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow, &
2914 & acsnom, snopcx, sfcrunoff, noahres, &
2915 & sf_urban_physics, b_t_bep, b_q_bep, rho, &
2916 & ids,ide, jds,jde, kds,kde, &
2917 & ims,ime, jms,jme, kms,kme, &
2918 & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2920 IF ( FRACTIONAL_SEAICE == 1 ) THEN
2921 ! LSM Returns full land/ice values, no fractional values.
2922 ! We return to a fractional component here. SFLX currently hard-wires
2923 ! emissivity over sea ice to 0.98, the same value as over open water, so
2924 ! the fractional consideration doesn't have any effect for emissivity.
2925 DO j=j_start(ij),j_end(ij)
2926 DO i=i_start(ij),i_end(ij)
2927 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2928 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
2929 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
2930 ENDIF
2931 ENDDO
2932 ENDDO
2934 IF ( isisfc ) THEN
2935 DO j=j_start(ij),j_end(ij)
2936 DO i=i_start(ij),i_end(ij)
2937 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2938 ! Weighted average of fields between ice-cover values and open-water values.
2939 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
2940 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
2941 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
2942 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
2943 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
2944 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
2945 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
2946 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
2947 qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
2948 ! print *,'hfx =',hfx_sea(170,20)
2949 ! print *,'XICE =',XICE(170,20)
2950 ! print *,'QSFC =',QSFC(170,20)
2951 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
2952 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
2953 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
2954 !save old tsk_ice
2955 tsk_save(i,j) = tsk(i,j)
2956 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
2957 ENDIF
2958 ENDDO
2959 ENDDO
2960 ELSE
2961 DO j = j_start(ij) , j_end(ij)
2962 DO i = i_start(ij) , i_end(ij)
2963 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
2964 ! Compute TSK as the open-water and ice-cover average
2965 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
2966 ENDIF
2967 ENDDO
2968 ENDDO
2969 ENDIF
2970 ENDIF
2971 DO j=j_start(ij),j_end(ij)
2972 DO i=i_start(ij),i_end(ij)
2973 ! CHKLOWQ(I,J)= 1.0
2974 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
2975 SFCEXC(I,J)= CHS(I,J)
2976 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
2977 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
2978 IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
2979 ENDDO
2980 ENDDO
2982 CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
2983 PSFC,CP,R_d,RCP,CHS,t_phy,qv_curr,ua_phys, &
2984 ids,ide, jds,jde, kds,kde, &
2985 ims,ime, jms,jme, kms,kme, &
2986 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
2987 !urban
2988 IF(SF_URBAN_PHYSICS.eq.1) THEN
2989 DO j=j_start(ij),j_end(ij) !urban
2990 DO i=i_start(ij),i_end(ij) !urban
2991 IF(IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LCZ_1 .or. IVGTYP(I,J) == LCZ_2 .or. &
2992 IVGTYP(I,J) == LCZ_3 .or. IVGTYP(I,J) == LCZ_4 .or. IVGTYP(I,J) == LCZ_5 .or. &
2993 IVGTYP(I,J) == LCZ_6 .or. IVGTYP(I,J) == LCZ_7 .or. IVGTYP(I,J) == LCZ_8 .or. &
2994 IVGTYP(I,J) == LCZ_9 .or. IVGTYP(I,J) == LCZ_10 .or. IVGTYP(I,J) == LCZ_11 )THEN
2995 U10(I,J) = U10_URB2D(I,J) !urban
2996 V10(I,J) = V10_URB2D(I,J) !urban
2997 PSIM(I,J) = PSIM_URB2D(I,J) !urban
2998 PSIH(I,J) = PSIH_URB2D(I,J) !urban
2999 GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J) !urban
3000 !m AKHS(I,J) = AKHS_URB2D(I,J) !urban
3001 AKHS(I,J) = CHS(I,J) !urban
3002 AKMS(I,J) = AKMS_URB2D(I,J) !urban
3003 END IF !urban
3004 ENDDO !urban
3005 ENDDO !urban
3006 ENDIF
3007 ! urban BEP
3008 IF((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.eq.3)) THEN
3009 DO j=j_start(ij),j_end(ij) !urban
3010 DO i=i_start(ij),i_end(ij) !urban
3011 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LCZ_1 .or. IVGTYP(I,J) == LCZ_2 .or. &
3012 IVGTYP(I,J) == LCZ_3 .or. IVGTYP(I,J) == LCZ_4 .or. IVGTYP(I,J) == LCZ_5 .or. &
3013 IVGTYP(I,J) == LCZ_6 .or. IVGTYP(I,J) == LCZ_7 .or. IVGTYP(I,J) == LCZ_8 .or. &
3014 IVGTYP(I,J) == LCZ_9 .or. IVGTYP(I,J) == LCZ_10 .or. IVGTYP(I,J) == LCZ_11 )THEN
3015 T2(I,J) = TH_PHY(i,1,j)/((1.E5/PSFC(I,J))**RCP) !urban
3016 TH2(I,J) = TH_PHY(i,1,j) !urban
3017 Q2(I,J) = qv_curr(i,1,j) !urban
3018 U10(I,J) = U_phy(I,1,J) !urban
3019 V10(I,J) = V_phy(I,1,J) !urban
3020 END IF !urban
3021 ENDDO !urban
3022 ENDDO !urban
3023 ENDIF
3025 !------------------------------------------------------------------
3027 ELSE
3028 CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
3029 ENDIF
3031 CASE (NOAHMPSCHEME)
3032 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
3033 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
3034 ! PRESENT(declin) .AND. PRESENT(coszen) .AND. &
3035 ! PRESENT(hrang) .AND. PRESENT( xlat_urb2d) .AND. &
3036 ! PRESENT(dzr) .AND. &
3037 ! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
3038 ! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
3039 ! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
3040 ! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
3041 ! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
3042 ! PRESENT(xxxg_urb2d) .AND. &
3043 ! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
3044 ! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
3045 ! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
3046 ! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
3047 ! PRESENT(ts_urb2d) .AND. &
3048 ! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
3049 #if (EM_CORE==1)
3050 PRESENT(smcwtdxy) .AND. &
3051 PRESENT(rechxy) .AND. &
3052 PRESENT(deeprechxy) .AND. &
3053 PRESENT(fdepthxy) .AND. &
3054 PRESENT(areaxy) .AND. &
3055 PRESENT(rivercondxy) .AND. &
3056 PRESENT(riverbedxy) .AND. &
3057 PRESENT(eqzwt) .AND. &
3058 PRESENT(pexpxy) .AND. &
3059 PRESENT(qrfxy) .AND. &
3060 PRESENT(qspringxy) .AND. &
3061 PRESENT(qslatxy) .AND. &
3062 PRESENT(qrfsxy) .AND. &
3063 PRESENT(qspringsxy) .AND. &
3064 PRESENT(smoiseq) .AND. &
3065 PRESENT(wtddt) .AND. &
3066 PRESENT(stepwtd) .AND. &
3067 #endif
3068 .TRUE. ) THEN
3069 !------------------------------------------------------------------
3072 IF ( FRACTIONAL_SEAICE == 1) THEN
3073 ! The fields passed to LSM need to represent the full ice values, not
3074 ! the fractional values. Convert ALBEDO and EMISS from the blended value
3075 ! to a value representing only the sea-ice portion. Albedo over open
3076 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
3077 DO j = j_start(ij) , j_end(ij)
3078 DO i = i_start(ij) , i_end(ij)
3079 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
3080 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
3081 EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
3082 ENDIF
3083 ENDDO
3084 ENDDO
3086 IF ( isisfc ) THEN
3087 ! Use surface layer routine values from the ice portion of grid point
3088 ELSE
3089 !
3090 ! We don't have surface layer routine values at this time, so
3091 ! just use what we have. Use ice component of TSK
3092 !
3093 CALL get_local_ice_tsk( ims, ime, jms, jme, &
3094 i_start(ij), i_end(ij), &
3095 j_start(ij), j_end(ij), &
3096 itimestep, .false., tice2tsk_if2cold, &
3097 XICE, XICE_THRESHOLD, &
3098 SST, TSK, TSK_SEA, TSK_LOCAL )
3100 DO j = j_start(ij) , j_end(ij)
3101 DO i = i_start(ij) , i_end(ij)
3102 TSK(i,j) = TSK_LOCAL(i,j)
3103 ENDDO
3104 ENDDO
3105 ENDIF
3106 ENDIF
3108 !for NoahMP irrigation scheme
3109 LLANDUSE = MMINLU
3110 !added for WRF_HYDRO
3111 #ifdef WRF_HYDRO
3112 if(HYDRO_dt .ge. 0) HYDRO_dt = dtbl
3113 #endif
3114 CALL wrf_debug(100,'in NOAHMP DRV')
3115 CALL noahmplsm(ITIMESTEP, YR, JULIAN_IN, COSZEN, XLAT,XLONG, &
3116 DZ8W, DTBL, DZS, NUM_SOIL_LAYERS, DX, &
3117 IVGTYP, ISLTYP, VEGFRA, SHDMAX, TMN, &
3118 XLAND, XICE, XICE_THRESHOLD, CROPCAT, &
3119 PLANTING, HARVEST,SEASON_GDD, &
3120 IDVEG, IOPT_CRS, IOPT_BTR, IOPT_RUN, IOPT_SFC, IOPT_FRZ, &
3121 IOPT_INF, IOPT_RAD, IOPT_ALB, IOPT_SNF, IOPT_TBOT, IOPT_STC, &
3122 IOPT_GLA, IOPT_RSF, IOPT_SOIL,IOPT_PEDO,IOPT_CROP, IOPT_IRR, &
3123 IOPT_IRRM, IOPT_INFDV, IOPT_TDRN, soiltstep, &
3124 IZ0TLND, SF_URBAN_PHYSICS, &
3125 SOILCOMP, SOILCL1, SOILCL2, SOILCL3, SOILCL4, &
3126 T_PHY, QV_CURR, U_PHY, V_PHY, SWDOWN, SWDDIR, &
3127 SWDDIF, GLW, &
3128 P8W, RAINBL, SR, &
3129 IRFRACT, SIFRACT, MIFRACT, FIFRACT, &
3130 TSK, HFX, QFX, LH, GRDFLX, SMSTAV, &
3131 SMSTOT,SFCRUNOFF, UDRUNOFF, ALBEDO, SNOWC, SMOIS, &
3132 SH2O, TSLB, SNOW, SNOWH, CANWAT, ACSNOM, &
3133 ACSNOW, EMISS, QSFC, &
3134 Z0, ZNT, & ! IN/OUT LSM eqv
3135 IRNUMSI, IRNUMMI, IRNUMFI, IRWATSI, IRWATMI, IRWATFI, & ! IN/OUT Noah MP only
3136 IRELOSS, IRSIVOL, IRMIVOL, IRFIVOL, IRRSPLH, LLANDUSE, &
3137 ISNOWXY, TVXY, TGXY, CANICEXY, CANLIQXY, EAHXY, &
3138 TAHXY, CMXY, CHXY, FWETXY, SNEQVOXY, ALBOLDXY, &
3139 QSNOWXY, QRAINXY, WSLAKEXY, ZWTXY, WAXY, WTXY, TSNOXY, &
3140 ZSNSOXY, SNICEXY, SNLIQXY, LFMASSXY, RTMASSXY, STMASSXY, &
3141 WOODXY, STBLCPXY, FASTCPXY, LAI, XSAIXY, TAUSSXY, &
3142 SMOISEQ, SMCWTDXY,DEEPRECHXY, RECHXY, GRAINXY, GDDXY,PGSXY, & ! IN/OUT Noah MP only
3143 GECROS_STATE, & ! IN/OUT gecros model
3144 QTDRAIN, TD_FRACTION, & ! IN/OUT tile drainage
3145 T2MVXY, T2MBXY, Q2MVXY, Q2MBXY, &
3146 TRADXY, NEEXY, GPPXY, NPPXY, FVEGXY, RUNSFXY, &
3147 RUNSBXY, ECANXY, EDIRXY, ETRANXY, FSAXY, FIRAXY, &
3148 APARXY, PSNXY, SAVXY, SAGXY, RSSUNXY, RSSHAXY, &
3149 BGAPXY, WGAPXY, TGVXY, TGBXY, CHVXY, CHBXY, &
3150 SHGXY, SHCXY, SHBXY, EVGXY, EVBXY, GHVXY, &
3151 GHBXY, IRGXY, IRCXY, IRBXY, TRXY, EVCXY, &
3152 CHLEAFXY, CHUCXY, CHV2XY, CHB2XY, RS, &
3153 qintsxy ,qintrxy ,qdripsxy ,&
3154 qdriprxy ,qthrosxy ,qthrorxy ,&
3155 qsnsubxy ,qsnfroxy ,qsubcxy ,&
3156 qfrocxy ,qevacxy ,qdewcxy ,qfrzcxy ,qmeltcxy ,&
3157 qsnbotxy ,qmeltxy ,pondingxy ,PAHXY ,PAHGXY, PAHVXY, PAHBXY,&
3158 fpicexy,RAINLSM,SNOWLSM,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm,&
3159 acc_ssoil, acc_qinsur, acc_qseva, acc_etrani, eflxbxy, soilenergy, snowenergy, canhsxy,&
3160 ACC_DWATERXY, ACC_PRCPXY, ACC_ECANXY, ACC_ETRANXY, ACC_EDIRXY, &
3161 #ifdef WRF_HYDRO
3162 sfcheadrt,INFXSRT,soldrain,qtiledrain,ZWATBLE2D, & !O
3163 #endif
3164 ids,ide, jds,jde, kds,kde, &
3165 ims,ime, jms,jme, kms,kme, &
3166 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
3167 ! variables below are optional
3168 MP_RAINC = RAINCV, MP_RAINNC = RAINNCV, MP_SHCV = RAINSHV,&
3169 MP_SNOW = SNOWNCV, MP_GRAUP = GRAUPELNCV, MP_HAIL = HAILNCV )
3171 IF(SF_URBAN_PHYSICS > 0 ) THEN !urban
3173 call noahmp_urban (sf_urban_physics, NUM_SOIL_LAYERS, IVGTYP,ITIMESTEP, & ! IN : Model configuration
3174 DTBL, COSZEN, XLAT_URB2D, & ! IN : Time/Space-related
3175 T_PHY, QV_CURR, U_PHY, V_PHY, SWDOWN, & ! IN : Forcing
3176 SWDDIR, SWDDIF, &
3177 GLW, P8W, RAINBL, DZ8W, ZNT, & ! IN : Forcing
3178 TSK, HFX, QFX, LH, GRDFLX, & ! IN/OUT : LSM
3179 ALBEDO, EMISS, QSFC, & ! IN/OUT : LSM
3180 ids,ide, jds,jde, kds,kde, &
3181 ims,ime, jms,jme, kms,kme, &
3182 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
3183 cmr_sfcdif, chr_sfcdif, cmc_sfcdif, &
3184 chc_sfcdif, cmgr_sfcdif, chgr_sfcdif, &
3185 tr_urb2d, tb_urb2d, tg_urb2d, & !H urban
3186 tc_urb2d, qc_urb2d, uc_urb2d, & !H urban
3187 xxxr_urb2d, xxxb_urb2d, xxxg_urb2d, xxxc_urb2d, & !H urban
3188 trl_urb3d, tbl_urb3d, tgl_urb3d, & !H urban
3189 sh_urb2d, lh_urb2d, g_urb2d, rn_urb2d, ts_urb2d, & !H urban
3190 psim_urb2d, psih_urb2d, u10_urb2d, v10_urb2d, & !O urban
3191 GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
3192 th2_urb2d, q2_urb2d, ust_urb2d, & !O urban
3193 declin, hrang, & !I urban
3194 num_roof_layers,num_wall_layers,num_road_layers, & !I urban
3195 dzr, dzb, dzg, & !I urban
3196 cmcr_urb2d, tgr_urb2d, tgrl_urb3d, smr_urb3d, & !H urban
3197 drelr_urb2d, drelb_urb2d, drelg_urb2d, & !H urban
3198 flxhumr_urb2d, flxhumb_urb2d, flxhumg_urb2d, & !H urban
3199 julian, julyr, & !H urban
3200 frc_urb2d, utype_urb2d, & !I urban
3201 chs, chs2, cqs2, & !H
3202 num_urban_ndm, urban_map_zrd, urban_map_zwd, urban_map_gd, & !I multi-layer urban
3203 urban_map_zd, urban_map_zdf, urban_map_bd, urban_map_wd, & !I multi-layer urban
3204 urban_map_gbd, urban_map_fbd, urban_map_zgrd, & !I multi-layer urban
3205 num_urban_hi, & !I multi-layer urban
3206 trb_urb4d, tw1_urb4d, tw2_urb4d, tgb_urb4d, & !H multi-layer urban
3207 tlev_urb3d, qlev_urb3d, & !H multi-layer urban
3208 tw1lev_urb3d, tw2lev_urb3d, & !H multi-layer urban
3209 tglev_urb3d, tflev_urb3d, & !H multi-layer urban
3210 sf_ac_urb3d, lf_ac_urb3d, cm_ac_urb3d, & !H multi-layer urban
3211 sfvent_urb3d, lfvent_urb3d, & !H multi-layer urban
3212 sfwin1_urb3d, sfwin2_urb3d, & !H multi-layer urban
3213 sfw1_urb3d, sfw2_urb3d, sfr_urb3d, sfg_urb3d, & !H multi-layer urban
3214 ep_pv_urb3d, t_pv_urb3d, & !GRZ
3215 trv_urb4d, qr_urb4d, qgr_urb3d, tgr_urb3d, & !GRZ
3216 drain_urb4d, draingr_urb3d, sfrv_urb3d, lfrv_urb3d, & !GRZ
3217 dgr_urb3d, dg_urb3d, lfr_urb3d, lfg_urb3d, & !GRZ
3218 lp_urb2d, hi_urb2d, lb_urb2d, hgt_urb2d, & !H multi-layer urban
3219 mh_urb2d, stdh_urb2d, lf_urb2d, & !SLUCM
3220 th_phy, rho, p_phy, ust, & !I multi-layer urban
3221 gmt, julday, xlong, xlat, & !I multi-layer urban
3222 a_u_bep, a_v_bep, a_t_bep, a_q_bep, & !O multi-layer urban
3223 a_e_bep, b_u_bep, b_v_bep, & !O multi-layer urban
3224 b_t_bep, b_q_bep, b_e_bep, dlg_bep, & !O multi-layer urban
3225 dl_u_bep, sf_bep, vl_bep) !O multi-layer urban
3227 ENDIF
3229 IF ( iopt_run .EQ. 5 ) THEN
3230 IF ( MOD(itimestep,STEPWTD) .EQ. 0 ) THEN ! STEPWTD always and only non-zero for iopt_run == 5
3231 CALL wrf_debug( 100, 'calling WTABLE' )
3233 !gmm update wtable from lateral flow and shed water to rivers
3235 CALL WTABLE_mmf_noahmp(num_soil_layers,xland,xice, xice_threshold, isice, &
3236 isltyp,smoiseq,dzs,wtddt, &
3237 fdepthxy,areaxy,ht,isurban,ivgtyp, &
3238 rivercondxy,riverbedxy,eqzwt,pexpxy, &
3239 smois,sh2o,smcwtdxy,zwtxy,qlatxy,qrfxy,deeprechxy,qspringxy, &
3240 qslatxy,qrfsxy,qspringsxy,rechxy, &
3241 ids,ide, jds,jde, kds,kde, &
3242 ims,ime, jms,jme, kms,kme, &
3243 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
3245 END IF
3246 END IF
3248 call seaice_noah( SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT, SEAICE_THICKNESS_OPT, &
3249 & SEAICE_THICKNESS_DEFAULT, SEAICE_SNOWDEPTH_OPT, &
3250 & SEAICE_SNOWDEPTH_MAX, SEAICE_SNOWDEPTH_MIN, &
3251 & t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
3252 & glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold, &
3253 & albsi, icedepth, snowsi, &
3254 & tslb, emiss, albedo, z0, tsk, snow, snowc, snowh, &
3255 & chs, chs2, cqs2, &
3256 & br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow, &
3257 & acsnom, snopcx, sfcrunoff, noahres, &
3258 & sf_urban_physics, b_t_bep, b_q_bep, rho, &
3259 & ids,ide, jds,jde, kds,kde, &
3260 & ims,ime, jms,jme, kms,kme, &
3261 & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
3263 IF ( FRACTIONAL_SEAICE == 1 ) THEN
3264 ! LSM Returns full land/ice values, no fractional values.
3265 ! We return to a fractional component here. SFLX currently hard-wires
3266 ! emissivity over sea ice to 0.98, the same value as over open water, so
3267 ! the fractional consideration doesn't have any effect for emissivity.
3268 DO j=j_start(ij),j_end(ij)
3269 DO i=i_start(ij),i_end(ij)
3270 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3271 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
3272 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
3273 ENDIF
3274 ENDDO
3275 ENDDO
3277 IF ( isisfc ) THEN
3278 DO j=j_start(ij),j_end(ij)
3279 DO i=i_start(ij),i_end(ij)
3280 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3281 ! Weighted average of fields between ice-cover values and open-water values.
3282 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
3283 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
3284 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
3285 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
3286 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
3287 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
3288 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
3289 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
3290 qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
3291 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
3292 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
3293 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
3294 !save old tsk_ice
3295 tsk_save(i,j) = tsk(i,j)
3296 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
3297 ENDIF
3298 ENDDO
3299 ENDDO
3300 ELSE
3301 DO j = j_start(ij) , j_end(ij)
3302 DO i = i_start(ij) , i_end(ij)
3303 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3304 ! Compute TSK as the open-water and ice-cover average
3305 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
3306 ENDIF
3307 ENDDO
3308 ENDDO
3309 ENDIF
3310 ENDIF
3311 DO j=j_start(ij),j_end(ij)
3312 DO i=i_start(ij),i_end(ij)
3313 CHKLOWQ(I,J)= 1.0
3314 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
3315 SFCEXC(I,J)= CHS(I,J)
3316 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
3317 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
3318 IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
3320 ! Check that SFCDIAGS can declare these as intent(out)
3321 T2(I,J) = -1.E36
3322 TH2(I,J) = -1.E36
3323 Q2(I,J) = -1.E36
3324 ENDDO
3325 ENDDO
3327 !jref: sfc diagnostics
3328 DO j=j_start(ij),j_end(ij)
3329 DO i=i_start(ij),i_end(ij)
3330 ! IF (IVGTYP(I,J) == ISWATER .OR. XICE(I,J) .GE. XICE_THRESHOLD) THEN
3331 IF (IVGTYP(I,J) == ISWATER .OR. (IVGTYP(I,J) == ISICE .AND. XICE(I,J) .GE. XICE_THRESHOLD)) THEN
3332 IF(CQS2(I,J).lt.1.E-5) then
3333 Q2(I,J)=QSFC(I,J)
3334 ELSE
3335 Q2(I,J) = QSFC(I,J) - QFX(I,J)/(PSFC(I,J)/(R_d * TSK(I,J))*CQS2(I,J))
3336 ENDIF
3337 IF(CHS2(I,J).lt.1.E-5) then
3338 T2(I,J) = TSK(I,J)
3339 ELSE
3340 T2(I,J) = TSK(I,J) - HFX(I,J)/(PSFC(I,J)/(R_d * TSK(I,J))*CP*CHS2(I,J))
3341 ENDIF
3342 TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP
3343 ! ELSEIF (IVGTYP(I,J) == ISURBAN .OR. IVGTYP(I,J) == ISICE .OR. FVEGXY(I,J) == 0.0 ) THEN
3344 ELSEIF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LCZ_1 .or. IVGTYP(I,J) == LCZ_2 .or. &
3345 IVGTYP(I,J) == LCZ_3 .or. IVGTYP(I,J) == LCZ_4 .or. IVGTYP(I,J) == LCZ_5 .or. &
3346 IVGTYP(I,J) == LCZ_6 .or. IVGTYP(I,J) == LCZ_7 .or. IVGTYP(I,J) == LCZ_8 .or. &
3347 IVGTYP(I,J) == LCZ_9 .or. IVGTYP(I,J) == LCZ_10 .or. IVGTYP(I,J) == LCZ_11 .or. &
3348 (IVGTYP(I,J) == ISICE .AND. XICE(I,J) .LT. XICE_THRESHOLD)) THEN
3350 Q2(I,J) = Q2MBXY(I,J)
3351 T2(I,J) = T2MBXY(I,J)
3352 TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
3353 ELSE
3354 T2(I,J) = FVEGXY(I,J)*T2MVXY(I,J) + (1.-FVEGXY(I,J))*T2MBXY(I,J)
3355 Q2(I,J) = FVEGXY(I,J)*Q2MVXY(I,J) + (1.-FVEGXY(I,J))*Q2MBXY(I,J)
3356 TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
3357 ENDIF
3358 ENDDO
3359 ENDDO
3361 ! CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
3362 ! PSFC,CP,R_d,RCP,CHS,t_phy,qv_curr,ua_phys, &
3363 ! ids,ide, jds,jde, kds,kde, &
3364 ! ims,ime, jms,jme, kms,kme, &
3365 ! i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
3367 !jref: sfc diagnostics end
3369 IF(SF_URBAN_PHYSICS.eq.1) THEN
3370 DO j=j_start(ij),j_end(ij) !urban
3371 DO i=i_start(ij),i_end(ij) !urban
3372 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LCZ_1 .or. IVGTYP(I,J) == LCZ_2 .or. &
3373 IVGTYP(I,J) == LCZ_3 .or. IVGTYP(I,J) == LCZ_4 .or. IVGTYP(I,J) == LCZ_5 .or. &
3374 IVGTYP(I,J) == LCZ_6 .or. IVGTYP(I,J) == LCZ_7 .or. IVGTYP(I,J) == LCZ_8 .or. &
3375 IVGTYP(I,J) == LCZ_9 .or. IVGTYP(I,J) == LCZ_10 .or. IVGTYP(I,J) == LCZ_11 )THEN
3376 Q2(I,J) = (FVEGXY(I,J)*Q2MVXY(I,J) + (1.-FVEGXY(I,J))*Q2MBXY(I,J))*(1.-FRC_URB2D(I,J)) + &
3377 Q2_URB2D(I,J)*FRC_URB2D(I,J)
3378 T2(I,J) = (FVEGXY(I,J)*T2MVXY(I,J) + (1.-FVEGXY(I,J))*T2MBXY(I,J))*(1.-FRC_URB2D(I,J)) + &
3379 (TH2_URB2D(i,j)/((1.E5/PSFC(i,j))**RCP))*FRC_URB2D(I,J)
3380 TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
3381 U10(I,J) = U10_URB2D(I,J) !urban
3382 V10(I,J) = V10_URB2D(I,J) !urban
3383 PSIM(I,J) = PSIM_URB2D(I,J) !urban
3384 PSIH(I,J) = PSIH_URB2D(I,J) !urban
3385 GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J) !urban
3386 AKHS(I,J) = CHS(I,J) !urban
3387 AKMS(I,J) = AKMS_URB2D(I,J) !urban
3388 END IF !urban
3389 ENDDO !urban
3390 ENDDO !urban
3391 ENDIF
3393 IF((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.eq.3)) THEN
3394 DO j=j_start(ij),j_end(ij) !urban
3395 DO i=i_start(ij),i_end(ij) !urban
3396 IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == LCZ_1 .or. IVGTYP(I,J) == LCZ_2 .or. &
3397 IVGTYP(I,J) == LCZ_3 .or. IVGTYP(I,J) == LCZ_4 .or. IVGTYP(I,J) == LCZ_5 .or. &
3398 IVGTYP(I,J) == LCZ_6 .or. IVGTYP(I,J) == LCZ_7 .or. IVGTYP(I,J) == LCZ_8 .or. &
3399 IVGTYP(I,J) == LCZ_9 .or. IVGTYP(I,J) == LCZ_10 .or. IVGTYP(I,J) == LCZ_11 )THEN
3400 T2(I,J) = TH_PHY(i,1,j)/((1.E5/PSFC(I,J))**RCP) !urban
3401 TH2(I,J) = TH_PHY(i,1,j) !urban
3402 Q2(I,J) = qv_curr(i,1,j) !urban
3403 U10(I,J) = U_phy(I,1,J) !urban
3404 V10(I,J) = V_phy(I,1,J) !urban
3405 END IF !urban
3406 ENDDO !urban
3407 ENDDO !urban
3408 ENDIF
3410 ! added RA population for WRF/Noah-CMAQ RS Consistency
3411 ! following Garland et al. (1977) and Nemitz et al., 2009
3412 IF ( PRESENT(RA) ) THEN
3413 DO j=j_start(ij),j_end(ij)
3414 DO i=i_start(ij),i_end(ij)
3415 RA(I,J) = WSPD(I,J)/UST(I,J)**2.0
3416 ENDDO
3417 ENDDO
3418 END IF
3419 !------------------------------------------------------------------
3421 ELSE
3422 CALL wrf_error_fatal('Lacking arguments for NOAHMPLSM in surface driver')
3423 ENDIF
3425 CASE (RUCLSMSCHEME)
3426 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
3427 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
3428 PRESENT(qsg) .AND. PRESENT(qvg) .AND. &
3429 PRESENT(qcg) .AND. PRESENT(soilt1) .AND. &
3430 PRESENT(tsnav) .AND. PRESENT(smfr3d) .AND. &
3431 PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND. &
3432 PRESENT(dew) .AND. &
3433 .TRUE. ) THEN
3435 IF( PRESENT(sr) ) THEN
3436 frpcpn=.true.
3437 ELSE
3438 SR = 1.
3439 ENDIF
3440 CALL wrf_debug(100,'in RUC LSM')
3441 DO j = j_start(ij) , j_end(ij)
3442 DO i = i_start(ij) , i_end(ij)
3443 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1. ) ) THEN
3444 ALBBCK(I,J) = SEAICE_ALBEDO_DEFAULT
3445 ENDIF
3446 ENDDO
3447 ENDDO
3448 IF ( FRACTIONAL_SEAICE == 1 ) THEN
3449 ! The fields passed to LSMRUC need to represent the full ice values, not
3450 ! the fractional values. Convert ALBEDO and EMISS from the blended value
3451 ! to a value representing only the sea-ice portion. Albedo over open
3452 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
3453 DO j = j_start(ij) , j_end(ij)
3454 DO i = i_start(ij) , i_end(ij)
3455 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
3456 ALBEDO(I,J) = (ALBEDO(I,J) - (1.-XICE(I,J))*0.08) / XICE(I,J)
3457 EMISS(I,J) = (EMISS(I,J) - (1.-XICE(I,J))*0.98) / XICE(I,J)
3458 ! also set skin temperature to saved sea-ice portion only
3459 TSK(I,J) = TSK_SAVE(I,J)
3460 ENDIF
3461 ENDDO
3462 ENDDO
3464 IF ( isisfc ) THEN
3465 !
3466 ! use surface layer routine values from the ice portion of grid point
3467 !
3468 ELSE
3469 !
3470 ! don't have srfc layer routine values at this time, so just use what you have
3471 ! use ice component of TSK
3472 !
3473 CALL get_local_ice_tsk( ims, ime, jms, jme, &
3474 i_start(ij), i_end(ij), &
3475 j_start(ij), j_end(ij), &
3476 itimestep, .false., tice2tsk_if2cold, &
3477 XICE, XICE_THRESHOLD, &
3478 SST, TSK, TSK_SEA, TSK_LOCAL )
3479 DO j = j_start(ij) , j_end(ij)
3480 DO i = i_start(ij) , i_end(ij)
3481 TSK(i,j) = TSK_LOCAL(i,j)
3482 ENDDO
3483 ENDDO
3484 ENDIF
3485 ENDIF
3487 CALL LSMRUC( spp_lsm_loc, &
3488 #if (EM_CORE==1)
3489 pattern_spp_lsm,field_sf, &
3490 #endif
3491 dtbl,itimestep,num_soil_layers, &
3492 #if (EM_CORE==1)
3493 lakemodel,lakemask, &
3494 graupelncv,snowncv,rainncv, &
3495 #endif
3496 zs,rainbl,snow,snowh,snowc,sr,frpcpn, &
3497 rhosnf,precipfr, &
3498 dz8w,p_phy,t_phy,qv_curr,qc_curr,rho, & !p_phy in [pa]
3499 glw,gsw,emiss,chklowq, &
3500 chs,flqc,flhc,mavail,canwat,vegfra,albedo,znt, &
3501 z0,snoalb, albbck, lai, & !new
3502 mminlu, landusef, nlcat, mosaic_lu, &
3503 mosaic_soil, soilctop, nscat, & !new
3504 qsfc,qsg,qvg,qcg,dew,soilt1,tsnav, &
3505 tmn,ivgtyp,isltyp,xland, &
3506 iswater,isice,xice,xice_threshold, &
3507 cp ,rcp,g,xlv,stbolt, &
3508 smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh, &
3509 sfcrunoff,udrunoff,acrunoff,sfcexc, &
3510 sfcevp,grdflx,snowfallac,acsnow,acsnom, &
3511 smfr3d,keepfr3dflag, &
3512 myjpbl,shdmin,shdmax,rdlai2d, &
3513 ids,ide, jds,jde, kds,kde, &
3514 ims,ime, jms,jme, kms,kme, &
3515 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
3517 IF ( FRACTIONAL_SEAICE == 1 ) THEN
3518 ! LSMRUC Returns full land/ice values, no fractional values.
3519 ! We return to a fractional component here.
3520 DO j=j_start(ij),j_end(ij)
3521 DO i=i_start(ij),i_end(ij)
3522 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3523 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
3524 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
3525 ENDIF
3526 ENDDO
3527 ENDDO
3528 if ( isisfc ) then
3529 !
3530 ! back to ice and ocean average
3531 !
3532 DO j=j_start(ij),j_end(ij)
3533 DO i=i_start(ij),i_end(ij)
3534 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
3535 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flhc_sea(i,j) )
3536 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flqc_sea(i,j) )
3537 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cpm_sea(i,j) )
3538 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cqs2_sea(i,j) )
3539 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs2_sea(i,j) )
3540 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs_sea(i,j) )
3541 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QSFC_SEA(i,j) )
3542 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * qgh_sea(i,j) )
3543 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * HFX_SEA(i,j) )
3544 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QFX_SEA(i,j) )
3545 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * LH_SEA(i,j) )
3546 !save old tsk_ice
3547 tsk_save(i,j) = tsk(i,j)
3548 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
3549 ENDIF
3550 ENDDO
3551 ENDDO
3552 else
3553 !
3554 ! tsk back to liquid and ice average
3555 !
3556 DO j = j_start(ij) , j_end(ij)
3557 DO i = i_start(ij) , i_end(ij)
3558 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
3559 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
3560 ENDIF
3561 ENDDO
3562 ENDDO
3563 endif
3564 ENDIF
3566 ! Compute CHS and CQS that will be used in 2-m diagnostics
3567 DO j=j_start(ij),j_end(ij)
3568 DO i=i_start(ij),i_end(ij)
3569 cqs(i,j)=flqc(i,j)/(mavail(i,j)*rho(i,kts,j))
3570 chs(i,j)=flhc(i,j)/(cpm(i,j)*rho(i,kts,j) )
3571 ENDDO
3572 ENDDO
3574 CALL SFCDIAGS_RUCLSM(HFX,QFX,TSK,QSFC,CQS,CQS2,CHS,CHS2,T2,TH2,Q2, &
3575 T_PHY,QV_CURR,RHO,P_PHY,PSFC,SNOW, &
3576 CP,R_d,RCP, &
3577 ids,ide, jds,jde, kds,kde, &
3578 ims,ime, jms,jme, kms,kme, &
3579 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
3581 ELSE
3582 CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
3583 ENDIF
3585 CASE (PXLSMSCHEME)
3586 IF (PRESENT(qv_curr) .AND. PRESENT(qc_curr) .AND. &
3587 PRESENT(emiss) .AND. PRESENT(t2) .AND. &
3588 PRESENT(rainbl) .AND. &
3589 .TRUE. ) THEN
3590 IF ( FRACTIONAL_SEAICE == 1 ) THEN
3592 IF ( isisfc ) THEN
3593 !
3594 ! use surface layer routine values from the ice portion of grid point
3595 !
3596 ELSE
3597 !
3598 ! don't have srfc layer routine values at this time, so just use what you have
3599 ! use ice component of TSK
3600 !
3601 CALL get_local_ice_tsk( ims, ime, jms, jme, &
3602 i_start(ij), i_end(ij), &
3603 j_start(ij), j_end(ij), &
3604 itimestep, .false., tice2tsk_if2cold, &
3605 XICE, XICE_THRESHOLD, &
3606 SST, TSK, TSK_SEA, TSK_LOCAL )
3607 DO j = j_start(ij) , j_end(ij)
3608 DO i=i_start(ij) , i_end(ij)
3609 TSK(i,j) = TSK_LOCAL(i,j)
3610 ENDDO
3611 ENDDO
3612 ENDIF
3613 ENDIF
3614 CALL wrf_debug(100,'in P-X LSM')
3615 CALL PXLSM(u_phy, v_phy, dz8w, qv_curr, t_phy, th_phy, rho,&
3616 psfc, gsw, glw, rainbl, emiss, &
3617 ITIMESTEP, curr_secs, num_soil_layers, DT, &
3618 anal_interval, xland, xice, albbck, albedo, &
3619 snoalb, smois, tslb, mavail,T2, Q2, qsfc, &
3620 zs, dzs, psih, &
3621 landusef,soilctop,soilcbot,vegfra, vegf_px, &
3622 isltyp,ra,rs,lai,imperv,canfra,nlcat,nscat, &
3623 hfx,qfx,lh,tsk,sst,znt,canwat, &
3624 grdflx,shdmin,shdmax, &
3625 snowc,pblh,rmol,ust,capg,dtbl, &
3626 t2_ndg_old,t2_ndg_new,q2_ndg_old,q2_ndg_new, &
3627 sn_ndg_old, sn_ndg_new, snow, snowh,snowncv, &
3628 t2obs, q2obs,pxlsm_smois_init,pxlsm_soil_nudge, &
3629 pxlsm_modis_veg, LAI_PX, WWLT_PX, WFC_PX, &
3630 WSAT_PX, CLAY_PX, CSAND_PX, FMSAND_PX, &
3631 ids,ide, jds,jde, kds,kde, &
3632 ims,ime, jms,jme, kms,kme, &
3633 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
3634 IF ( FRACTIONAL_SEAICE == 1 ) THEN
3635 IF ( isisfc ) THEN
3636 !
3637 ! back to ice and ocean average
3638 !
3639 DO j = j_start(ij) , j_end(ij)
3640 DO i = i_start(ij) , i_end(ij)
3641 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3642 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
3643 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
3644 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
3645 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
3646 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
3647 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
3648 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QSFC_SEA(i,j) )
3649 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QGH_SEA(i,j) )
3650 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * HFX_SEA(i,j) )
3651 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QFX_SEA(i,j) )
3652 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * LH_SEA(i,j) )
3653 !save old tsk_ice
3654 tsk_save(i,j) = tsk(i,j)
3655 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * TSK_SEA(i,j) )
3656 ENDIF
3657 ENDDO
3658 ENDDO
3659 ELSE
3660 !
3661 ! tsk back to liquid and ice average
3662 !
3663 DO j=j_start(ij),j_end(ij)
3664 DO i=i_start(ij),i_end(ij)
3665 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3666 !save old tsk_ice
3667 tsk_save(i,j) = tsk(i,j)
3668 tsk(i,j)=tsk(i,j)*XICE(i,j)+(1.0-XICE(i,j))*TSK_SEA(i,j)
3669 ENDIF
3670 ENDDO
3671 ENDDO
3672 ENDIF
3673 ENDIF
3674 DO j=j_start(ij),j_end(ij)
3675 DO i=i_start(ij),i_end(ij)
3676 CHKLOWQ(I,J)= 1.0
3677 TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP
3678 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
3679 ENDDO
3680 ENDDO
3682 ELSE
3683 CALL wrf_error_fatal('Lacking arguments for P-X LSM in surface driver')
3684 ENDIF
3685 #ifdef WRF_USE_CLM
3686 !---------------------------------------------------------------------
3687 ! CLM coupling currently version 4 added by Yaqiong Lu and Jiming Jin
3689 CASE (CLMSCHEME)
3690 CALL wrf_debug(100,'in CLM')
3692 IF (MYJ) call wrf_error_fatal('CLM is not currently compatible with MYJ. Please pick different PBL Schemes')
3694 IF (present(qv_curr) .and. present(rainbl) .and. &
3695 .true. ) then
3697 ! print *, "itimestep = ", itimestep
3698 ! print *," in module_surface_driver.F : dz8w(i,1,j) = ",dz8w(:,1,:)
3699 IF( PRESENT(sr) ) THEN
3700 frpcpn=.true.
3701 ENDIF
3702 IF ( FRACTIONAL_SEAICE == 1) THEN
3703 ! The fields passed to LSM need to represent the full ice values, not
3704 ! the fractional values. Convert ALBEDO and EMISS from the blended value
3705 ! to a value representing only the sea-ice portion. Albedo over open
3706 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
3707 DO j = j_start(ij) , j_end(ij)
3708 DO i = i_start(ij) , i_end(ij)
3709 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
3710 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
3711 EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
3712 ENDIF
3713 ENDDO
3714 ENDDO
3715 IF ( isisfc ) THEN
3716 ! Use surface layer routine values from the ice portion of grid
3717 ! point
3718 ELSE
3719 !
3720 ! We don't have surface layer routine values at this time, so
3721 ! just use what we have. Use ice component of TSK
3722 !
3723 DO j = j_start(ij) , j_end(ij)
3724 DO i = i_start(ij) , i_end(ij)
3725 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
3726 IF ( SST(i,j) .LT. 271.4 ) THEN
3727 SST(i,j) = 271.4
3728 ENDIF
3729 TSK_SEA(i,j) = SST(i,j)
3730 ! Convert TSK from our ice/water average value to value
3731 ! good for solid-ice surface.
3732 TSK(i,j) = ( TSK(i,j) - (1.-XICE(i,j)) *SST(i,j) ) / XICE(i,j)
3733 IF (XICE(i,j).lt.0.2 .and. TSK(i,j).lt.253.15) THEN
3734 TSK(i,j) = 253.15
3735 ENDIF
3736 IF (XICE(i,j).lt.0.1 .and. TSK(i,j).lt.263.15) THEN
3737 TSK(i,j) = 263.15
3738 ENDIF
3739 ELSE
3740 TSK_SEA(i,j) = TSK(i,j)
3741 ENDIF
3742 ENDDO
3743 ENDDO
3744 ENDIF
3745 ENDIF
3747 write(message,'('' surface_driver: B4 call to clmdrv with do_bioe = '',l)') do_bioe
3748 CALL wrf_debug( 100,trim(message) )
3749 CALL wrf_debug(100,'in clmdrv')
3751 if (num_soil_layers.ne.10) then
3752 CALL wrf_error_fatal('CLM land surface model need num_soil_layers=10')
3753 endif
3755 CALL clmdrv(dz8w,qv_curr,p8w, t_phy,tsk, &
3756 hfx,qfx,lh,grdflx,qgh,gsw,swdown, &
3757 ra_sw_physics,history_interval,glw,smstav,smstot, &
3758 sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra, &
3759 albedo,znt,z0, tmn,xland,xice, emiss, &
3760 snowc,qsfc,rainbl,maxpatch, &
3761 num_soil_layers,dtbl,xtime, dt,dzs, &
3762 smois,tslb,snow,canwat, &
3763 chs,chs2,sh2o,snowh, &
3764 u_phy,v_phy,rho, &
3765 shdmin,shdmax, &
3766 acsnom,acsnow, &
3767 dx,xlat,xlong,ht, &
3768 #if ( WRF_CHEM == 1 )
3769 ne_area,e_bio, &
3770 #endif
3771 ids,ide, jds,jde, kds,kde, &
3772 ims,ime, jms,jme, kms,kme, &
3773 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
3774 inest,sf_urban_physics,do_bioe,do_meganfile,id &
3775 !Optional urban
3776 ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif &
3777 ,cmgr_sfcdif,chgr_sfcdif &
3778 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d, & !H urban
3779 uc_urb2d, & !H urban
3780 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d, & !H urban
3781 trl_urb3d,tbl_urb3d,tgl_urb3d, & !H urban
3782 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d, & !H urban
3783 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d, & !O urban
3784 GZ1OZ0_urb2d, AKMS_URB2D, & !O urban
3785 th2_urb2d,q2_urb2d,ust_urb2d, & !O urban
3786 declin,coszen,hrang, & !I urban ! by hongping Gu
3787 xlat_urb2d, & !I urban
3788 num_roof_layers, num_wall_layers, & !I urban
3789 num_road_layers, DZR, DZB, DZG, & !I urban
3790 FRC_URB2D, UTYPE_URB2D, & !I urban
3791 cmcr_urb2d,tgr_urb2d,tgrl_urb3d,smr_urb3d, & ! urban
3792 drelr_urb2d,drelb_urb2d,drelg_urb2d, & ! urban
3793 flxhumr_urb2d,flxhumb_urb2d,flxhumg_urb2d, &
3794 ! CLM subgrids
3795 numc,nump,sabv,sabg,lwup,snl, &
3796 snowdp,wtc,wtp,h2osno,t_grnd,t_veg, &
3797 h2ocan,h2ocan_col,t2m_max,t2m_min,t2clm , &
3798 t_ref2m,h2osoi_liq_s1, &
3799 h2osoi_liq_s2,h2osoi_liq_s3,h2osoi_liq_s4, &
3800 h2osoi_liq_s5,h2osoi_liq1,h2osoi_liq2, &
3801 h2osoi_liq3,h2osoi_liq4,h2osoi_liq5,h2osoi_liq6, &
3802 h2osoi_liq7,h2osoi_liq8,h2osoi_liq9,h2osoi_liq10, &
3803 h2osoi_ice_s1,h2osoi_ice_s2, &
3804 h2osoi_ice_s3,h2osoi_ice_s4,h2osoi_ice_s5, &
3805 h2osoi_ice1,h2osoi_ice2,h2osoi_ice3,h2osoi_ice4, &
3806 h2osoi_ice5,h2osoi_ice6,h2osoi_ice7, &
3807 h2osoi_ice8,h2osoi_ice9,h2osoi_ice10, &
3808 t_soisno_s1,t_soisno_s2,t_soisno_s3,t_soisno_s4, &
3809 t_soisno_s5,t_soisno1,t_soisno2,t_soisno3, &
3810 t_soisno4,t_soisno5,t_soisno6,t_soisno7, &
3811 t_soisno8,t_soisno9,t_soisno10, &
3812 dzsnow1,dzsnow2,dzsnow3,dzsnow4,dzsnow5, &
3813 snowrds1,snowrds2,snowrds3,snowrds4,snowrds5, &
3814 t_lake1,t_lake2,t_lake3,t_lake4,t_lake5, &
3815 t_lake6,t_lake7,t_lake8,t_lake9,t_lake10, &
3816 h2osoi_vol1,h2osoi_vol2,h2osoi_vol3, &
3817 h2osoi_vol4,h2osoi_vol5,h2osoi_vol6, &
3818 h2osoi_vol7,h2osoi_vol8, &
3819 h2osoi_vol9,h2osoi_vol10, &
3820 q_ref2m, &
3821 ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid, &
3822 Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,SWUPsubgrid,&
3823 LHsoi,LHveg,LHtran, &
3824 alswvisdir, alswvisdif, alswnirdir, alswnirdif, & ! clm
3825 swvisdir, swvisdif, swnirdir, swnirdif, & ! clm
3826 t_veg24, t_veg240, fsun24, fsun240, &
3827 fsd24, fsd240, fsi24, fsi240, laip &
3828 #ifdef CN
3829 !CROP&CN RESTART AND OUTPUTS
3830 ,dyntlai,dyntsai,dyntop,dynbot &
3831 ,htmx,croplive,gdd1020,gdd820,gdd020,grainc,grainc_storage &
3832 ,grainc_xfer,grainn,grainn_storage,grainn_xfer,days_active &
3833 ,onset_flag,onset_counter,onset_gddflag,onset_fdd,onset_gdd &
3834 ,onset_swi,offset_flag,offset_counter,offset_fdd,offset_swi &
3835 ,dayl,annavg_t2m,tempavg_t2m,tempsum_potential_gpp &
3836 ,annsum_potential_gpp,tempmax_retransn,annmax_retransn &
3837 ,prev_leafc_to_litter,prev_frootc_to_litter,tempsum_npp &
3838 ,annsum_npp,leafc,leafc_storage,leafc_xfer,frootc &
3839 ,frootc_storage,frootc_xfer,livestemc,livestemc_storage &
3840 ,livestemc_xfer,deadstemc,deadstemc_storage,deadstemc_xfer &
3841 ,livecrootc,livecrootc_storage,livecrootc_xfer,deadcrootc &
3842 ,deadcrootc_storage,deadcrootc_xfer,cpool,pft_ctrunc &
3843 ,leafn,leafn_storage,leafn_xfer,frootn,frootn_storage &
3844 ,frootn_xfer,livestemn,livestemn_storage,livestemn_xfer &
3845 ,deadstemn,deadstemn_storage,deadstemn_xfer,livecrootn &
3846 ,livecrootn_storage,livecrootn_xfer,deadcrootn &
3847 ,deadcrootn_storage,deadcrootn_xfer,npool,pft_ntrunc &
3848 ,gresp_storage,gresp_xfer,xsmrpool,annsum_counter &
3849 ,cannsum_npp,cannavg_t2m,wf,me,mean_fire_prob,cwdc,litr1c &
3850 ,litr2c,litr3c,soil1c,soil2c,soil3c,soil4c,seedc,col_ctrunc &
3851 ,prod10c,prod100c,cwdn,litr1n,litr2n,litr3n,soil1n,soil2n &
3852 ,soil3n,soil4n,seedn,col_ntrunc,prod10n,prod100n,sminn &
3853 ,totlitc,dwt_seedc_to_leaf,dwt_seedc_to_deadstem,dwt_conv_cflux &
3854 ,dwt_prod10c_gain,dwt_prod100c_gain,prod100c_loss,dwt_frootc_to_litr1c &
3855 ,dwt_frootc_to_litr2c,dwt_frootc_to_litr3c,dwt_livecrootc_to_cwdc &
3856 ,dwt_deadcrootc_to_cwdc,dwt_seedn_to_leaf,dwt_seedn_to_deadstem &
3857 ,dwt_conv_nflux,dwt_prod10n_gain,dwt_prod100n_gain,prod100n_loss &
3858 ,dwt_frootn_to_litr1n,dwt_frootn_to_litr2n, dwt_frootn_to_litr3n &
3859 ,dwt_livecrootn_to_cwdn,dwt_deadcrootn_to_cwdn,retransn &
3860 #endif
3861 ,nlcat,landusef,num_pft_input,pct_pft_input,input_pft_flag &
3862 )
3864 IF ( FRACTIONAL_SEAICE == 1 ) THEN
3865 DO j=j_start(ij),j_end(ij)
3866 DO i=i_start(ij),i_end(ij)
3867 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3868 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
3869 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
3870 ENDIF
3871 ENDDO
3872 ENDDO
3874 IF ( isisfc ) THEN
3875 DO j=j_start(ij),j_end(ij)
3876 DO i=i_start(ij),i_end(ij)
3877 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3878 ! Weighted average of fields between ice-cover values
3879 ! and open-water values.
3880 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
3881 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
3882 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
3883 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
3884 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
3885 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
3886 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
3887 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
3888 qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
3889 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
3890 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
3891 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
3892 !save old tsk_ice
3893 tsk_save(i,j) = tsk(i,j)
3894 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
3895 ENDIF
3896 ENDDO
3897 ENDDO
3898 ELSE
3899 DO j = j_start(ij) , j_end(ij)
3900 DO i = i_start(ij) , i_end(ij)
3901 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
3902 ! Compute TSK as the open-water and ice-cover average
3903 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
3904 ENDIF
3905 ENDDO
3906 ENDDO
3907 ENDIF
3908 ENDIF
3909 CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2, &
3910 PSFC,CP,R_d,RCP,CHS,t_phy,qv_curr,ua_phys, &
3911 ids,ide, jds,jde, kds,kde, &
3912 ims,ime, jms,jme, kms,kme, &
3913 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
3915 DO j=j_start(ij),j_end(ij)
3916 DO i=i_start(ij),i_end(ij)
3917 CHKLOWQ(I,J)= 1.0
3918 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
3920 ! update land variables from CLM
3921 IF(XLAND(I,J).LT.1.5) then
3922 Q2(I,J) = sum(q_ref2m(i,1:nump(i,j),j)*wtp(i,1:nump(i,j),j))
3924 ! convert specific humidty to mixing ratio unit: kg/kg)
3925 Q2(I,J) = Q2(I,J)/(1.0-Q2(I,J))
3927 T2(I,J) = sum(t_ref2m(i,1:nump(i,j),j)*wtp(i,1:nump(i,j),j))
3928 TH2(I,J)= T2(I,J)*(1.E5/PSFC(I,J))**RCP
3929 END IF
3930 ENDDO
3931 ENDDO
3933 ELSE
3934 CALL wrf_error_fatal('Lacking arguments for CLM in surface driver')
3935 ENDIF
3937 ! end of CLM scehme
3938 ! -------------------------------------------------------------------
3939 #endif
3941 #ifdef WRF_USE_CTSM
3942 CASE (CTSMSCHEME)
3944 IF (MYJ) call wrf_error_fatal('CTSM is not currently compatible with MYJ. Please pick a different PBL scheme,')
3946 IF (PRESENT(qv_curr) .AND. PRESENT(rainbl) .AND. &
3947 ! PRESENT(emiss) .AND. PRESENT(t2) .AND. &
3948 ! PRESENT(declin) .AND. PRESENT(coszen) .AND. &
3949 ! PRESENT(hrang) .AND. PRESENT( xlat_urb2d) .AND. &
3950 ! PRESENT(dzr) .AND. &
3951 ! PRESENT( dzb) .AND. PRESENT(dzg) .AND. &
3952 ! PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d) .AND. &
3953 ! PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND. &
3954 ! PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND. &
3955 ! PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND. &
3956 ! PRESENT(xxxg_urb2d) .AND. &
3957 ! PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND. &
3958 ! PRESENT(tbl_urb3d) .AND. PRESENT(tgl_urb3d) .AND. &
3959 ! PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d) .AND. &
3960 ! PRESENT(g_urb2d) .AND. PRESENT(rn_urb2d) .AND. &
3961 ! PRESENT(ts_urb2d) .AND. &
3962 ! PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d) .AND. &
3963 .TRUE. ) THEN
3966 !------------------------------------------------------------------
3967 !For WRF-CTSM simulations, we would like the land model (CTSM)
3968 ! to handle inland lake points.
3969 ! Here, we are making ctsm_xland to include lake points, so that
3970 ! CTSM can handle it.
3971 DO j=j_start(ij),j_end(ij)
3972 DO i=i_start(ij),i_end(ij)
3973 xland_ctsm (i,j) = xland (i,j)
3974 IF (lakemask(i,j).EQ.1.) THEN
3975 xland_ctsm (i,j) = 1
3976 ENDIF
3977 ENDDO
3978 ENDDO
3980 IF ( FRACTIONAL_SEAICE == 1) THEN
3981 ! The fields passed to LSM need to represent the full ice values, not
3982 ! the fractional values. Convert ALBEDO and EMISS from the blended value
3983 ! to a value representing only the sea-ice portion. Albedo over open
3984 ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
3985 DO j = j_start(ij) , j_end(ij)
3986 DO i = i_start(ij) , i_end(ij)
3987 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
3988 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
3989 EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
3990 ENDIF
3991 ENDDO
3992 ENDDO
3993 IF ( isisfc ) THEN
3994 ! Use surface layer routine values from the ice portion of grid point
3995 ELSE
3996 !
3997 ! We don't have surface layer routine values at this time, so
3998 ! just use what we have. Use ice component of TSK
3999 !
4000 CALL get_local_ice_tsk( ims, ime, jms, jme, &
4001 i_start(ij), i_end(ij), &
4002 j_start(ij), j_end(ij), &
4003 itimestep, .false., tice2tsk_if2cold, &
4004 XICE, XICE_THRESHOLD, &
4005 SST, TSK, TSK_SEA, TSK_LOCAL )
4007 DO j = j_start(ij) , j_end(ij)
4008 DO i = i_start(ij) , i_end(ij)
4009 TSK(i,j) = TSK_LOCAL(i,j)
4010 ENDDO
4011 ENDDO
4012 ENDIF
4013 ENDIF
4016 CALL ctsm_run( &
4017 ! bounds
4018 ids=ids, ide=ide, jds=jds, jde=jde, &
4019 ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, &
4020 its=i_start(ij), ite=i_end(ij), jts=j_start(ij), jte=j_end(ij), &
4022 ! restart flag
4023 restart_flag=restart_flag,&
4025 ! general information
4026 dt = dt, &
4027 xland = xland_ctsm, &
4028 xice = xice, &
4029 xice_threshold = xice_threshold, &
4031 ! atm -> lnd variables
4032 dz8w = dz8w, &
4033 ht = ht, &
4034 u_phy = u_phy, &
4035 v_phy = v_phy, &
4036 p8w = p_phy, &
4037 t_phy = t_phy, &
4038 th_phy = th_phy, &
4039 qv_curr = qv_curr, &
4040 rainbl = rainbl, &
4041 sr = sr, &
4042 glw = glw, &
4043 swvisdir = swvisdir, &
4044 swvisdif = swvisdif, &
4045 swnirdir = swnirdir, &
4046 swnirdif = swnirdif, &
4048 ! lnd -> atm variables
4049 tsk = tsk, &
4050 t2 = t2, &
4051 qsfc = qsfc, &
4052 albedo = albedo, &
4053 ust = ust, &
4054 hfx = hfx, &
4055 lh = lh, &
4056 qfx = qfx, &
4057 emiss = emiss, &
4058 z0 = z0, &
4059 znt = znt)
4061 call seaice_noah( SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT, SEAICE_THICKNESS_OPT, &
4062 & SEAICE_THICKNESS_DEFAULT, SEAICE_SNOWDEPTH_OPT, &
4063 & SEAICE_SNOWDEPTH_MAX, SEAICE_SNOWDEPTH_MIN, &
4064 & t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
4065 & glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold, &
4066 & albsi, icedepth, snowsi, &
4067 & tslb, emiss, albedo, z0, tsk, snow, snowc, snowh, &
4068 & chs, chs2, cqs2, &
4069 & br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow, &
4070 & acsnom, snopcx, sfcrunoff, noahres, &
4071 & sf_urban_physics, b_t_bep, b_q_bep, rho, &
4072 & ids,ide, jds,jde, kds,kde, &
4073 & ims,ime, jms,jme, kms,kme, &
4074 & i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
4076 IF ( FRACTIONAL_SEAICE == 1 ) THEN
4077 ! LSM Returns full land/ice values, no fractional values.
4078 ! We return to a fractional component here. SFLX currently hard-wires
4079 ! emissivity over sea ice to 0.98, the same value as over open water, so
4080 ! the fractional consideration doesn't have any effect for emissivity.
4081 DO j=j_start(ij),j_end(ij)
4082 DO i=i_start(ij),i_end(ij)
4083 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4084 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
4085 emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98 )
4086 ENDIF
4087 ENDDO
4088 ENDDO
4090 IF ( isisfc ) THEN
4091 DO j=j_start(ij),j_end(ij)
4092 DO i=i_start(ij),i_end(ij)
4093 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4094 ! Weighted average of fields between ice-cover values and open-water values.
4095 flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
4096 flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
4097 cpm(i,j) = ( cpm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j) )
4098 cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
4099 chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
4100 chs(i,j) = ( chs(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j) )
4101 qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
4102 qgh(i,j) = ( qgh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j) )
4103 qz0(i,j) = ( qz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j) )
4104 ! print *,'hfx =',hfx_sea(170,20)
4105 ! print *,'XICE =',XICE(170,20)
4106 ! print *,'QSFC =',QSFC(170,20)
4107 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
4108 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
4109 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
4110 !save old tsk_ice
4111 tsk_save(i,j) = tsk(i,j)
4112 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
4113 ENDIF
4114 ENDDO
4115 ENDDO
4116 ELSE
4117 DO j = j_start(ij) , j_end(ij)
4118 DO i = i_start(ij) , i_end(ij)
4119 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4120 ! Compute TSK as the open-water and ice-cover average
4121 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
4122 ENDIF
4123 ENDDO
4124 ENDDO
4125 ENDIF
4126 ENDIF
4128 ENDIF
4130 DO j=j_start(ij),j_end(ij)
4131 DO i=i_start(ij),i_end(ij)
4132 CHKLOWQ(I,J)= 1.0
4133 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
4134 !SFCEXC(I,J)= CHS(I,J)
4135 IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
4136 IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
4137 IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
4138 ENDDO
4139 ENDDO
4141 #endif
4143 CASE (SSIBSCHEME)
4144 IF(PRESENT(alswvisdir))THEN
4145 !---Fernando De Sales (fds 06/2010)--------------------------------------
4146 CALL wrf_debug(100,'in SSIB')
4147 !
4148 IF ( FRACTIONAL_SEAICE == 1) THEN
4149 ! The fields passed to SSIB need to represent the full ice values, not
4150 ! the fractional values. Convert ALBEDO from the blended value
4151 ! to a value representing only the sea-ice portion. Albedo over open
4152 ! water is taken to be 0.08.
4153 DO j = j_start(ij) , j_end(ij)
4154 DO i = i_start(ij) , i_end(ij)
4155 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
4156 ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
4157 ENDIF
4158 ENDDO
4159 ENDDO
4160 ELSE
4161 ! we shouldn't be here. must have fractional seaice for SSIB to work properly (fds 12/2010)
4162 ENDIF
4163 !
4164 !This stuff is not needed anymore since isisfc is always TRUE for SSIB
4165 !Keep it for later use when code is adapted for isisfc=FALSE
4166 ! IF ( isisfc ) THEN
4167 ! ! Use surface layer routine values from the ice portion of grid point
4168 ! ELSE
4169 ! !
4170 ! ! We don't have surface layer routine values at this time, so
4171 ! ! just use what we have. Use ice component of TSK
4172 ! !
4173 ! DO j = j_start(ij) , j_end(ij)
4174 ! DO i = i_start(ij) , i_end(ij)
4175 ! IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
4176 ! IF ( SST(i,j) .LT. 271.4 ) THEN
4177 ! SST(i,j) = 271.4
4178 ! ENDIF
4179 ! TSK_SEA(i,j) = SST(i,j)
4180 ! ! Convert TSK from our ice/water average value to value good for solid-ice surface.
4181 ! TSK(i,j) = ( TSK(i,j) - (1.-XICE(i,j)) *SST(i,j) ) / XICE(i,j)
4182 ! IF (XICE(i,j).lt.0.2 .and. TSK(i,j).lt.253.15) THEN
4183 ! TSK(i,j) = 253.15
4184 ! ENDIF
4185 ! IF (XICE(i,j).lt.0.1 .and. TSK(i,j).lt.263.15) THEN
4186 ! TSK(i,j) = 263.15
4187 ! ENDIF
4188 ! ELSE
4189 ! TSK_SEA(i,j) = TSK(i,j)
4190 ! ENDIF
4191 ! ENDDO
4192 ! ENDDO
4193 ! ENDIF
4194 !
4195 day=float(int(julian_in+0.01))+1.
4196 DO j=j_start(ij),j_end(ij)
4197 DO i=i_start(ij),i_end(ij)
4199 !check land mask and land-use map !fds (02/2012)
4200 ! IF(itimestep .EQ. 1 ) THEN
4201 ! IF(IVGTYP(i,j).NE.ISWATER)THEN
4202 ! XLAND(I,J)=1.0
4203 ! ELSE
4204 ! XLAND(I,J)=2.0
4205 ! ENDIF
4206 ! IF (IVGTYP(I,J).LE.0 .AND. XLAND(I,J).NE.ISWATER ) IVGTYP(I,J) = 7.0
4207 ! ENDIF
4209 IF(XLAND(I,J).LT.1.5) THEN ! seaice and land points
4211 CLOUDFRAC=0.
4212 IF(PRESENT(CLDFRA))THEN
4213 DO K=KMS,KME
4214 CLOUDFRAC=AMAX1(CLOUDFRAC,AMIN1(CLDFRA(I,K,J),1.0))
4215 ENDDO
4216 ENDIF
4218 IF (XICE(I,J) .GE. XICE_THRESHOLD) THEN !sea ice points only
4220 CALL ssib_seaice &
4221 ( i, j, DTBL, itimestep, xlat_urb2d(i,j), coszen(i,j), &
4222 rainncv(i,j), raincv(i,j), glw(i,j), dz8w(i,1,j), &
4223 smois(i,1,j), smois(i,2,j), smois(i,3,j), &
4224 tslb(i,1,j), tslb(i,2,j), tslb(i,3,j), &
4225 snow(i,j), sfcrunoff(i,j), xice_save(i,j), &
4226 u_phytmp(i,1,j),v_phytmp(i,1,j),qv_curr(i,1,j),t_phy(i,1,j), &
4227 p_phy(i,1,j), psfc(i,j), &
4228 swdown(i,j), canwat(i,j), &
4229 alswvisdir(i,j),alswvisdif(i,j),alswnirdir(i,j),alswnirdif(i,j), &
4230 swvisdir(i,j), swvisdif(i,j), swnirdir(i,j), swnirdif(i,j), &
4231 hfx(i,j), lh(i,j), grdflx(i,j), qfx(i,j), tsk(i,j), &
4232 ust(i,j), ssib_br(i,j), ssib_fm(i,j), ssib_fh(i,j), ssib_cm(i,j), &
4233 ssib_lhf(i,j), ssib_shf(i,j), ssib_ghf(i,j), &
4234 ssib_sdn(i,j), ssib_sup(i,j), ssib_ldn(i,j), ssib_lup(i,j), &
4235 ssib_wat(i,j), &
4236 ssib_z00(i,j), ssib_veg(i,j), &
4237 day, cloudfrac, q2(i,j), t2(i,j), albedo(i,j), uv10, &
4238 ra_sw_physics,xice_threshold &
4239 )
4240 ELSE !land points only (including land ice)
4242 CALL ssib( i, j, DTBL, itimestep, xlat_urb2d(i,j), coszen(i,j), &
4243 rainncv(i,j), raincv(i,j), glw(i,j), dz8w(i,1,j), &
4244 smois(i,1,j), smois(i,2,j), smois(i,3,j), &
4245 tslb(i,1,j), tslb(i,2,j), tslb(i,3,j), &
4246 snow(i,j), sfcrunoff(i,j), &
4247 u_phytmp(i,1,j),v_phytmp(i,1,j),qv_curr(i,1,j),t_phy(i,1,j), &
4248 p_phy(i,1,j), psfc(i,j), ivgtyp(i,j), &
4249 swdown(i,j), canwat(i,j), &
4250 alswvisdir(i,j),alswvisdif(i,j),alswnirdir(i,j),alswnirdif(i,j), &
4251 swvisdir(i,j), swvisdif(i,j), swnirdir(i,j), swnirdif(i,j), &
4252 hfx(i,j), lh(i,j), grdflx(i,j), qfx(i,j), tsk(i,j), &
4253 ust(i,j), ssib_br(i,j), ssib_fm(i,j), ssib_fh(i,j), ssib_cm(i,j), &
4254 ssib_lhf(i,j), ssib_shf(i,j), ssib_ghf(i,j), ssib_egs(i,j), &
4255 ssib_eci(i,j), ssib_ect(i,j), ssib_egi(i,j), ssib_egt(i,j), &
4256 ssib_sdn(i,j), ssib_sup(i,j), ssib_ldn(i,j), ssib_lup(i,j), &
4257 ssib_wat(i,j), ssib_shc(i,j), ssib_shg(i,j), ssib_lai(i,j), &
4258 ssib_vcf(i,j), ssib_z00(i,j), ssib_veg(i,j), ssibxdd(i,j), &
4259 isnow(i,j), swe(i,j), snowden(i,j), snowdepth(i,j),tkair(i,j), &
4260 dzo1(i,j), wo1(i,j), tssn1(i,j), tssno1(i,j), bwo1(i,j), bto1(i,j), &
4261 cto1(i,j), fio1(i,j), flo1(i,j), bio1(i,j), blo1(i,j), ho1(i,j), &
4262 dzo2(i,j), wo2(i,j), tssn2(i,j), tssno2(i,j), bwo2(i,j), bto2(i,j), &
4263 cto2(i,j), fio2(i,j), flo2(i,j), bio2(i,j), blo2(i,j), ho2(i,j), &
4264 dzo3(i,j), wo3(i,j), tssn3(i,j), tssno3(i,j), bwo3(i,j), bto3(i,j), &
4265 cto3(i,j), fio3(i,j), flo3(i,j), bio3(i,j), blo3(i,j), ho3(i,j), &
4266 dzo4(i,j), wo4(i,j), tssn4(i,j), tssno4(i,j), bwo4(i,j), bto4(i,j), &
4267 cto4(i,j), fio4(i,j), flo4(i,j), bio4(i,j), blo4(i,j), ho4(i,j), &
4268 day, cloudfrac, q2(i,j), t2(i,j), albedo(i,j), uv10, &
4269 ra_sw_physics, mminlu &
4270 )
4271 ENDIF
4272 !
4273 BR(i,j)=ssib_br(i,j)
4274 ZNT(i,j) = ssib_z00(i,j)
4275 SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
4276 t2(i,j) = tsk(i,j) !keep this
4277 IF (itimestep .ne. 1) THEN
4278 ZDIFF=(0.5*dz8w(i,1,j))-SSiBXDD(I,J)
4279 IF(ZDIFF.LE.ZNT(I,J)) ZDIFF=ZNT(I,J)+0.2
4280 GZ1OZ0(I,J)=ALOG(ZDIFF/ZNT(I,J))
4281 ENDIF
4282 IF (XICE(I,J) .GE. XICE_THRESHOLD) THEN
4283 snowh(i,j) = 0.0
4284 ELSE
4285 snowh(i,j) = snowdepth(i,j)
4286 ENDIF
4287 U10(i,j) = UV10*u_phytmp(i,1,j)/SQRT(u_phytmp(i,1,j)**2+v_phytmp(i,1,j)**2)
4288 V10(i,j) = UV10*v_phytmp(i,1,j)/SQRT(u_phytmp(i,1,j)**2+v_phytmp(i,1,j)**2)
4289 ! Overwrite WSPD to remove convective velocity (wspd=wspd1 in YSU)
4290 ! WSPD(I,J)=sqrt( u_phytmp(i,1,j)*u_phytmp(i,1,j) + &
4291 ! v_phytmp(i,1,j)*v_phytmp(i,1,j) ) + 1.e-9
4292 !
4293 ENDIF
4294 !
4295 ENDDO
4296 ENDDO
4297 !
4298 IF ( FRACTIONAL_SEAICE == 1 ) THEN
4299 ! SSIB_seaice returns full land/ice albedo values, no fractional values.
4300 ! We return to a fractional component here.
4301 DO j=j_start(ij),j_end(ij)
4302 DO i=i_start(ij),i_end(ij)
4303 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4304 albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08 )
4305 ENDIF
4306 ENDDO
4307 ENDDO
4308 !
4309 IF ( isisfc ) THEN
4310 DO j=j_start(ij),j_end(ij)
4311 DO i=i_start(ij),i_end(ij)
4312 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4313 ! Weighted average of fields between ice-cover values and open-water values.
4314 hfx(i,j) = ( hfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j) )
4315 qfx(i,j) = ( qfx(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j) )
4316 lh(i,j) = ( lh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j) )
4317 !save old tsk_ice
4318 tsk_save(i,j) = tsk(i,j)
4319 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
4320 ENDIF
4321 ENDDO
4322 ENDDO
4323 ELSE
4324 DO j = j_start(ij) , j_end(ij)
4325 DO i = i_start(ij) , i_end(ij)
4326 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4327 ! Compute TSK as the open-water and ice-cover average
4328 tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
4329 ENDIF
4330 ENDDO
4331 ENDDO
4332 ENDIF
4333 ENDIF
4334 ELSE
4335 CALL wrf_error_fatal('Lacking arguments for SSIB in surface driver')
4336 ENDIF
4337 !end ssib
4338 !-------------------------------------------------------------------
4340 CASE DEFAULT
4342 IF ( itimestep .eq. 1 ) THEN
4343 WRITE( message , * ) &
4344 'No land surface physics option is used: sf_surface_physics = ', sf_surface_physics
4345 CALL wrf_message ( message )
4346 ENDIF
4348 END SELECT sfc_select
4350 ENDDO
4351 !$OMP END PARALLEL DO
4353 430 CONTINUE
4355 #if ( EM_CORE==1)
4356 IF (sf_ocean_physics .EQ. OMLSCHEME .or. sf_ocean_physics .EQ. PWP3DSCHEME) THEN
4357 ! simple ocean mixed layer model based Pollard, Rhines and Thompson (1973)
4358 CALL wrf_debug( 100, 'Call OCEANML' )
4359 !$OMP PARALLEL DO &
4360 !$OMP PRIVATE ( ij )
4361 DO ij = 1 , num_tiles
4362 CALL ocean_driver(tml,t0ml,hml,h0ml,huml,hvml,ust,u_phy,v_phy, &
4363 tmoml,f,g,oml_gamma, &
4364 xland,hfx,lh,tsk,gsw,glw,emiss, &
4365 dtbl,STBOLT,oml_relaxation_time, &
4366 ids,ide, jds,jde, kds,kde, &
4367 ims,ime, jms,jme, kms,kme, &
4368 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte, &
4369 sf_ocean_physics,okms, okme, & !cyl
4370 om_tmp,om_s,om_u, om_v, om_depth, om_ml, & !cyl
4371 om_lat, om_lon, & !cyl
4372 QFX, & !cyl
4373 rdx, rdy, msfu, msfv, msft,xtime, & !cyl
4374 om_tini,om_sini,id,omdt, & !cyl
4375 itimestep ) !cyl
4376 ENDDO
4377 !$OMP END PARALLEL DO
4378 ENDIF
4379 #endif
4380 ! adding a lake model -- 07/02/2010
4381 IF ( LakeModel == 1 ) THEN
4383 CALL wrf_debug( 100, 'Call LakeModel' )
4385 DO ij = 1 , num_tiles
4387 CALL Lake( t_phy ,p8w ,dz8w ,qv_curr ,& !i
4388 u_phy ,v_phy , glw ,emiss ,&
4389 rainbl ,dtbl ,swdown ,albedo ,&
4390 xlat_urb2d ,z_lake3d ,dz_lake3d ,lakedepth2d ,&
4391 watsat3d ,csol3d ,tkmg3d ,tkdry3d ,&
4392 tksatu3d ,ivgtyp ,ht ,xland ,&
4393 iswater ,xice ,xice_threshold, lake_min_elev ,&
4394 ids ,ide ,jds ,jde ,&
4395 kds ,kde ,ims ,ime ,&
4396 jms ,jme ,kms ,kme ,&
4397 i_start(ij) ,i_end(ij) ,j_start(ij) ,j_end(ij) ,&
4398 kts ,kte ,&
4399 h2osno2d ,snowdp2d ,snl2d ,z3d ,& !h
4400 dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,&
4401 h2osoi_ice3d ,t_grnd2d ,t_soisno3d ,t_lake3d ,&
4402 savedtke12d ,lake_icefrac3d ,&
4403 #if ( EM_CORE==1)
4404 ! lakemask ,lakeflag ,&
4405 lakemask ,&
4406 #endif
4407 hfx ,lh ,grdflx ,tsk ,& !o
4408 qfx ,t2 ,th2 ,q2 )
4411 ENDDO
4413 ENDIF
4415 ! Reset RAINBL in mm (Accumulation between PBL calls)
4417 IF ( PRESENT( rainbl ) ) THEN
4418 !$OMP PARALLEL DO &
4419 !$OMP PRIVATE ( ij, i, j, k )
4420 DO ij = 1 , num_tiles
4421 DO j=j_start(ij),j_end(ij)
4422 DO i=i_start(ij),i_end(ij)
4423 RAINBL(i,j) = 0.
4424 ENDDO
4425 ENDDO
4426 ENDDO
4427 !$OMP END PARALLEL DO
4428 ENDIF
4430 ! Limit Q2 diagnostic to no more than 5 per cent higher than lowest level value
4431 ! This prevents unrealistic values when QFX is not mostly surface flux
4432 ! because calculation is based on surface flux only
4433 ! Problems occurred in transition periods and weak winds and vegetation source
4434 !$OMP PARALLEL DO &
4435 !$OMP PRIVATE ( ij, i, j, k )
4436 DO ij = 1 , num_tiles
4437 DO j=j_start(ij),j_end(ij)
4438 DO i=i_start(ij),i_end(ij)
4439 IF (XLAND(I,J).LT.1.5) THEN
4440 Q2(i,j) = MIN(Q2(i,j),1.05*QV_CURR(i,1,j))
4441 END IF
4442 ENDDO
4443 ENDDO
4444 ENDDO
4445 !$OMP END PARALLEL DO
4447 IF( PRESENT(slope_rad).AND. radiation )THEN
4448 ! topographic slope effects removed from SWDOWN and GSW here for output
4449 IF (slope_rad .EQ. 1) THEN
4451 !$OMP PARALLEL DO &
4452 !$OMP PRIVATE ( ij, i, j, k )
4453 DO ij = 1 , num_tiles
4454 DO j=j_start(ij),j_end(ij)
4455 DO i=i_start(ij),i_end(ij)
4456 IF(SWNORM(I,J) .GT. 1.E-3)THEN ! daytime
4457 SWSAVE = SWDOWN(i,j)
4458 ! SWDOWN contains unaffected SWDOWN in output
4459 SWDOWN(i,j) = SWNORM(i,j)
4460 ! SWNORM contains slope-affected SWDOWN in output
4461 SWNORM(i,j) = SWSAVE
4462 GSW(i,j) = GSWSAVE(i,j)
4463 ENDIF
4464 ENDDO
4465 ENDDO
4466 ENDDO
4467 !$OMP END PARALLEL DO
4469 ENDIF
4470 ENDIF
4472 ENDIF
4474 END SUBROUTINE surface_driver
4476 !-------------------------------------------------------------------------
4477 !-------------------------------------------------------------------------
4479 subroutine myjsfc_seaice_wrapper(ITIMESTEP,HT,DZ, &
4480 & PMID,PINT,TH,T,QV,QC,U,V,Q2, &
4481 & TSK,QSFC,THZ0,QZ0,UZ0,VZ0, &
4482 & LOWLYR,XLAND,IVGTYP,ISURBAN,IZ0TLND, &
4483 & TICE2TSK_IF2COLD, & ! Extra for wrapper
4484 & XICE_THRESHOLD, & ! Extra for wrapper
4485 & XICE,SST, & ! Extra for wrapper
4486 & CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, & ! Extra for wrapper
4487 & FLHC_SEA, FLQC_SEA, QSFC_SEA, & ! Extra for wrapper
4488 & QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, & ! Extra for wrapper
4489 & FLX_LH_SEA, TSK_SEA, & ! Extra for wrapper
4490 & USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL, &
4491 & AKHS,AKMS, &
4492 & BR, &
4493 & CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC, &
4494 & QGH,CPM,CT, &
4495 & U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR, &
4496 & P1000,U10E,V10E, &
4497 & IDS,IDE,JDS,JDE,KDS,KDE, &
4498 & IMS,IME,JMS,JME,KMS,KME, &
4499 & ITS,ITE,JTS,JTE,KTS,KTE )
4500 ! USE module_model_constants
4501 USE module_sf_myjsfc
4503 IMPLICIT NONE
4505 INTEGER, INTENT(IN) :: ITIMESTEP
4506 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: HT
4507 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ
4508 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PMID
4509 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
4510 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: TH
4511 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: T
4512 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QV
4513 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QC
4514 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: U
4515 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: V
4516 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: Q2 ! Q2 is TKE?
4518 ! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: TSK
4519 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: TSK
4521 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QSFC
4522 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: THZ0
4523 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QZ0
4524 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: UZ0
4525 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: VZ0
4526 INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: LOWLYR
4527 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XLAND
4528 INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: IVGTYP
4529 INTEGER :: ISURBAN
4530 INTEGER :: IZ0TLND
4531 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XICE ! Extra for wrapper
4532 ! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: SST ! Extra for wrapper
4533 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: SST ! Extra for wrapper
4534 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: BR
4535 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS_SEA ! Extra for wrapper
4536 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2_SEA ! Extra for wrapper
4537 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2_SEA ! Extra for wrapper
4538 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM_SEA ! Extra for wrapper
4539 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QZ0_SEA ! Extra for wrapper
4540 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSFC_SEA ! Extra for wrapper
4541 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH_SEA ! Extra for wrapper
4542 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC_SEA ! Extra for wrapper
4543 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC_SEA ! Extra for wrapper
4544 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX_SEA ! Extra for wrapper
4545 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX_SEA ! Extra for wrapper
4546 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH_SEA ! Extra for wrapper
4547 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSK_SEA ! Extra for wrapper
4548 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: USTAR
4549 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: ZNT
4550 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: Z0BASE
4551 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: PBLH
4552 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: MAVAIL
4553 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: RMOL
4554 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKHS
4555 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKMS
4556 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS
4557 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2
4558 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2
4559 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX
4560 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX
4561 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH
4562 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC
4563 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC
4564 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH
4565 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM
4566 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CT
4567 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: U10
4568 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: V10
4569 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: U10E
4570 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: V10E
4571 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: T02
4572 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH02
4573 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSHLTR
4574 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH10
4575 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q02
4576 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSHLTR
4577 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q10
4578 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: PSHLTR
4579 REAL, INTENT(IN) :: P1000
4580 REAL, INTENT(IN) :: XICE_THRESHOLD
4581 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
4582 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, &
4583 & IMS,IME,JMS,JME,KMS,KME, &
4584 & ITS,ITE,JTS,JTE,KTS,KTE
4587 ! Local
4588 INTEGER :: i
4589 INTEGER :: j
4590 REAL, DIMENSION( ims:ime, jms:jme ) :: ct_sea
4591 REAL, DIMENSION( ims:ime, jms:jme ) :: u10_sea
4592 REAL, DIMENSION( ims:ime, jms:jme ) :: v10_sea
4593 REAL, DIMENSION( ims:ime, jms:jme ) :: u10e_sea
4594 REAL, DIMENSION( ims:ime, jms:jme ) :: v10e_sea
4595 REAL, DIMENSION( ims:ime, jms:jme ) :: t02_sea
4596 REAL, DIMENSION( ims:ime, jms:jme ) :: th02_sea
4597 REAL, DIMENSION( ims:ime, jms:jme ) :: tshltr_sea
4598 REAL, DIMENSION( ims:ime, jms:jme ) :: pshltr_sea
4599 REAL, DIMENSION( ims:ime, jms:jme ) :: qshltr_sea
4600 REAL, DIMENSION( ims:ime, jms:jme ) :: th10_sea
4601 REAL, DIMENSION( ims:ime, jms:jme ) :: q02_sea
4602 REAL, DIMENSION( ims:ime, jms:jme ) :: q10_sea
4603 REAL, DIMENSION( ims:ime, jms:jme ) :: thz0_sea
4604 REAL, DIMENSION( ims:ime, jms:jme ) :: uz0_sea
4605 REAL, DIMENSION( ims:ime, jms:jme ) :: vz0_sea
4606 REAL, DIMENSION( ims:ime, jms:jme ) :: ustar_sea
4607 REAL, DIMENSION( ims:ime, jms:jme ) :: pblh_sea
4608 REAL, DIMENSION( ims:ime, jms:jme ) :: rmol_sea
4609 REAL, DIMENSION( ims:ime, jms:jme ) :: akhs_sea
4610 REAL, DIMENSION( ims:ime, jms:jme ) :: akms_sea
4611 REAL, DIMENSION( ims:ime, jms:jme ) :: xland_sea
4612 REAL, DIMENSION( ims:ime, jms:jme ) :: mavail_sea
4613 REAL, DIMENSION( ims:ime, jms:jme ) :: znt_sea
4614 REAL, DIMENSION( ims:ime, jms:jme ) :: z0base_sea
4615 REAL, DIMENSION( ims:ime, jms:jme ) :: br_sea
4617 REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_HOLD
4618 REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_HOLD
4619 REAL, DIMENSION( ims:ime, jms:jme ) :: THZ0_HOLD
4620 REAL, DIMENSION( ims:ime, jms:jme ) :: UZ0_HOLD
4621 REAL, DIMENSION( ims:ime, jms:jme ) :: VZ0_HOLD
4622 REAL, DIMENSION( ims:ime, jms:jme ) :: USTAR_HOLD
4623 REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_HOLD
4624 REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_HOLD
4625 REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_HOLD
4626 REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_HOLD
4627 REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_HOLD
4628 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
4629 REAL :: PSFC
4631 ! Set things up for the frozen-surface call to myjsfc
4632 ! Is SST local here, or are the changes to be fed back to the calling routines?
4634 ! We want a TSK valid for the ice-covered regions of the grid cell.
4636 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
4637 itimestep, .true., tice2tsk_if2cold, &
4638 XICE, XICE_THRESHOLD, &
4639 SST, TSK, TSK_SEA, TSK_LOCAL )
4640 DO j = JTS , JTE
4641 DO i = ITS , ITE
4642 TSK(i,j) = TSK_LOCAL(i,j)
4643 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
4645 ! Over fractional sea-ice points, back out an ice portion of QSFC as well.
4646 ! QSFC_SEA calculation as done in myjsfc for open water points
4647 PSFC = PINT(I,LOWLYR(I,J),J)
4648 QSFC_SEA(i,j) = PQ0SEA/PSFC*EXP(A2S*(TSK(i,j)-A3S)/(TSK(i,j)-A4S))
4649 QSFC(i,j) = (QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j)) / XICE(i,j)
4650 !
4651 HFX_SEA(i,j) = HFX(i,j)
4652 QFX_SEA(i,j) = QFX(i,j)
4653 FLX_LH_SEA(i,j) = FLX_LH(i,j)
4654 ENDIF
4655 ENDDO
4656 ENDDO
4658 !
4659 ! frozen ocean call for sea ice points
4660 !
4662 ! Strictly INTENT(IN) to MYJSFC, should be unchanged by call.
4664 ! DZ
4665 ! HT
4666 ! LOWLYR
4667 ! MAVAIL
4668 ! PINT
4669 ! PMID
4670 ! QC
4671 ! QV
4672 ! Q2
4673 ! T
4674 ! TH
4675 ! TSK
4676 ! U
4677 ! V
4678 ! XLAND
4679 ! Z0BASE
4681 ! INTENT (INOUT), updated by MYJSFC. Values will need to be saved before the first call to MYJSFC, so that
4682 ! the second call to MYJSFC does not double-count the effect.
4684 ! Save INTENT(INOUT) variables before the frozen-water/true-land call to MYJSFC:
4685 QSFC_HOLD(its:ite,jts:jte) = QSFC(its:ite,jts:jte)
4686 QZ0_HOLD(its:ite,jts:jte) = QZ0(its:ite,jts:jte)
4687 THZ0_HOLD(its:ite,jts:jte) = THZ0(its:ite,jts:jte)
4688 UZ0_HOLD(its:ite,jts:jte) = UZ0(its:ite,jts:jte)
4689 VZ0_HOLD(its:ite,jts:jte) = VZ0(its:ite,jts:jte)
4690 USTAR_HOLD(its:ite,jts:jte) = USTAR(its:ite,jts:jte)
4691 ZNT_HOLD(its:ite,jts:jte) = ZNT(its:ite,jts:jte)
4692 PBLH_HOLD(its:ite,jts:jte) = PBLH(its:ite,jts:jte)
4693 RMOL_HOLD(its:ite,jts:jte) = RMOL(its:ite,jts:jte)
4694 AKHS_HOLD(its:ite,jts:jte) = AKHS(its:ite,jts:jte)
4695 AKMS_HOLD(its:ite,jts:jte) = AKMS(its:ite,jts:jte)
4697 ! Strictly INTENT(OUT): Set by MYJSFC
4699 ! CHS
4700 ! CHS2
4701 ! CPM
4702 ! CQS2
4703 ! CT
4704 ! FLHC
4705 ! FLQC
4706 ! FLX_LH
4707 ! HFX
4708 ! PSHLTR
4709 ! QFX
4710 ! QGH
4711 ! QSHLTR
4712 ! Q02
4713 ! Q10
4714 ! TH02
4715 ! TH10
4716 ! TSHLTR
4717 ! T02
4718 ! U10
4719 ! V10
4721 ! Frozen-water/true-land call.
4722 CALL MYJSFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
4723 & PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
4724 & TSK, QSFC, THZ0, QZ0, UZ0, VZ0, & ! I,IO,IO,IO,IO,IO,
4725 & LOWLYR, XLAND, IVGTYP, ISURBAN, IZ0TLND, & ! I,I,I,I,I
4726 & USTAR, ZNT, Z0BASE, PBLH, MAVAIL, RMOL, & ! IO,IO,I,IO,I,IO,
4727 & AKHS, AKMS, & ! IO,IO,
4728 & BR, & ! O
4729 & CHS, CHS2, CQS2, HFX, QFX, FLX_LH, FLHC, FLQC, & ! O,O,O,0,0,0,0,0,
4730 & QGH, CPM, CT, U10, V10, T02, & ! 0,0,0,0,0,0,
4731 & TH02, TSHLTR, TH10, Q02, & ! 0,0,0,0,
4732 & QSHLTR, Q10, PSHLTR, & ! 0,0,0,
4733 & P1000, U10E, V10E, & ! I
4734 & ids,ide, jds,jde, kds,kde, &
4735 & ims,ime, jms,jme, kms,kme, &
4736 & its,ite, jts,jte, kts,kte )
4738 ! Set up things for the open ocean call.
4739 DO j = JTS, JTE
4740 DO i = ITS, ITE
4741 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
4742 XLAND_SEA(i,j)=2.
4743 MAVAIL_SEA(I,J) = 1.
4744 ZNT_SEA(I,J) = 0.0001
4745 Z0BASE_SEA(I,J) = ZNT_SEA(I,J)
4746 IF ( SST(i,j) .LT. 271.4 ) THEN
4747 SST(i,j) = 271.4
4748 ENDIF
4749 TSK_SEA(i,j) = SST(i,j)
4750 PSFC = PINT(I,LOWLYR(I,J),J)
4751 QSFC_SEA(I,J) = PQ0SEA/PSFC*EXP(A2S*(TSK_SEA(i,j)-A3S)/(TSK_SEA(i,j)-A4S))
4752 ELSE
4753 ! This should be a land point or a true open water point
4754 XLAND_SEA(i,j)=xland(i,j)
4755 MAVAIL_SEA(i,j) = mavail(i,j)
4756 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
4757 Z0BASE_SEA(I,J) = Z0BASE(I,J)
4758 TSK_SEA(i,j) = TSK(i,j)
4759 QSFC_SEA(i,j) = QSFC_HOLD(i,j)
4760 ENDIF
4761 ENDDO
4762 ENDDO
4764 QZ0_SEA(its:ite,jts:jte) = QZ0_HOLD(its:ite,jts:jte)
4765 THZ0_SEA(its:ite,jts:jte) = THZ0_HOLD(its:ite,jts:jte)
4766 UZ0_SEA(its:ite,jts:jte) = UZ0_HOLD(its:ite,jts:jte)
4767 VZ0_SEA(its:ite,jts:jte) = VZ0_HOLD(its:ite,jts:jte)
4768 USTAR_SEA(its:ite,jts:jte) = USTAR_HOLD(its:ite,jts:jte)
4769 PBLH_SEA(its:ite,jts:jte) = PBLH_HOLD(its:ite,jts:jte)
4770 RMOL_SEA(its:ite,jts:jte) = RMOL_HOLD(its:ite,jts:jte)
4771 AKHS_SEA(its:ite,jts:jte) = AKHS_HOLD(its:ite,jts:jte)
4772 AKMS_SEA(its:ite,jts:jte) = AKMS_HOLD(its:ite,jts:jte)
4773 !
4774 ! open water call
4775 !
4776 CALL MYJSFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
4777 & PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
4778 & TSK_SEA, QSFC_SEA, THZ0_SEA, QZ0_SEA, UZ0_SEA, VZ0_SEA, & ! I,IO,IO,IO,IO,IO,
4779 & LOWLYR, XLAND_SEA, IVGTYP, ISURBAN, IZ0TLND, & ! I,I,I,I,I,
4780 & USTAR_SEA, ZNT_SEA, Z0BASE_SEA, PBLH_SEA, MAVAIL_SEA, RMOL_SEA, & ! IO,IO,I,IO,I,IO,
4781 & AKHS_SEA, AKMS_SEA, & ! IO,IO,
4782 & BR_SEA, & ! dummy space holder
4783 & CHS_SEA, CHS2_SEA, CQS2_SEA, HFX_SEA, QFX_SEA, FLX_LH_SEA, FLHC_SEA, & ! 0,0,0,0,0,0,0,
4784 & FLQC_SEA, QGH_SEA, CPM_SEA, CT_SEA, U10_SEA, V10_SEA, T02_SEA, TH02_SEA, & ! 0,0,0,0,0,0,0,0,
4785 & TSHLTR_SEA, TH10_SEA, Q02_SEA, QSHLTR_SEA, Q10_SEA, PSHLTR_SEA, & ! 0,0,0,0,0,0,
4786 & p1000, u10e_sea, v10e_sea, & ! I
4787 & ids,ide, jds,jde, kds,kde, &
4788 & ims,ime, jms,jme, kms,kme, &
4789 & its,ite, jts,jte, kts,kte )
4791 !
4792 ! Scale the appropriate terms between open-water values and ice-covered values
4793 !
4795 DO j = JTS, JTE
4796 DO i = ITS, ITE
4797 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
4798 ! Over sea-ice points, blend the results.
4800 ! INTENT(OUT) from MYJSFC
4801 ! CHS wait
4802 ! CHS2 wait
4803 ! CPM wait
4804 ! CQS2 wait
4805 CT(i,j) = CT(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CT_SEA (i,j)
4806 ! FLHC(i,j) = FLHC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLHC_SEA (i,j)
4807 ! FLQC(i,j) = FLQC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLQC_SEA (i,j)
4808 ! FLX_LH wait
4809 ! HFX wait
4810 PSHLTR(i,j) = PSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PSHLTR_SEA(i,j)
4811 ! QFX wait
4812 ! QGH wait
4813 QSHLTR(i,j) = QSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * QSHLTR_SEA(i,j)
4814 Q02(i,j) = Q02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q02_SEA(i,j)
4815 Q10(i,j) = Q10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q10_SEA(i,j)
4816 TH02(i,j) = TH02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH02_SEA(i,j)
4817 TH10(i,j) = TH10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH10_SEA(i,j)
4818 TSHLTR(i,j) = TSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TSHLTR_SEA(i,j)
4819 T02(i,j) = T02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * T02_SEA(i,j)
4820 U10(i,j) = U10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * U10_SEA(i,j)
4821 V10(i,j) = V10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * V10_SEA(i,j)
4822 U10E(i,j) = U10(i,j)
4823 V10E(i,j) = V10(i,j)
4825 ! INTENT(INOUT): updated by MYJSFC
4826 ! QSFC: wait
4827 THZ0(i,j) = THZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * THZ0_SEA(i,j)
4828 ! qz0 wait
4829 UZ0(i,j) = UZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * UZ0_SEA(i,j)
4830 VZ0(i,j) = VZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * VZ0_SEA(i,j)
4831 USTAR(i,j) = USTAR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * USTAR_SEA(i,j)
4832 ! ZNT wait
4833 PBLH(i,j) = PBLH(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PBLH_SEA(i,j)
4834 RMOL(i,j) = RMOL(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * RMOL_SEA(i,j)
4835 AKHS(i,j) = AKHS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKHS_SEA(i,j)
4836 AKMS(i,j) = AKMS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKMS_SEA(i,j)
4838 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
4839 ELSE
4840 ! We're not over sea ice. Take the results from the first call.
4841 ENDIF
4842 ENDDO
4843 ENDDO
4845 END SUBROUTINE myjsfc_seaice_wrapper
4847 !------------------------------------------------------------------------
4849 subroutine qnsesfc_seaice_wrapper(ITIMESTEP,HT,DZ, &
4850 & PMID,PINT,TH,T,QV,QC,U,V,Q2, &
4851 & TSK,QSFC,THZ0,QZ0,UZ0,VZ0, &
4852 & LOWLYR,XLAND, &
4853 & TICE2TSK_IF2COLD, & ! Extra for wrapper
4854 & XICE_THRESHOLD, & ! Extra for wrapper
4855 & XICE,SST, & ! Extra for wrapper
4856 & CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA, & ! Extra for wrapper
4857 & FLHC_SEA, FLQC_SEA, QSFC_SEA, & ! Extra for wrapper
4858 & QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, & ! Extra for wrapper
4859 & FLX_LH_SEA, TSK_SEA, & ! Extra for wrapper
4860 & USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL, &
4861 & AKHS,AKMS, &
4862 & BR, &
4863 & CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC, &
4864 & QGH,CPM,CT, &
4865 & U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR, &
4866 & U10E,V10E, &
4867 & IDS,IDE,JDS,JDE,KDS,KDE, &
4868 & IMS,IME,JMS,JME,KMS,KME, &
4869 & ITS,ITE,JTS,JTE,KTS,KTE,SCM_FORCE_FLUX )
4870 ! USE module_model_constants
4871 USE module_sf_qnsesfc
4873 IMPLICIT NONE
4875 INTEGER, INTENT(IN) :: ITIMESTEP
4876 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: HT
4877 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DZ
4878 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PMID
4879 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
4880 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: TH
4881 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: T
4882 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QV
4883 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: QC
4884 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: U
4885 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: V
4886 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: Q2 ! Q2 is TKE?
4888 ! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: TSK
4889 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: TSK
4891 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QSFC
4892 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: THZ0
4893 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: QZ0
4894 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: UZ0
4895 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: VZ0
4896 INTEGER,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: LOWLYR
4897 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XLAND
4898 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: XICE ! Extra for wrapper
4899 ! REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: SST ! Extra for wrapper
4900 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: SST ! Extra for wrapper
4901 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: BR
4902 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS_SEA ! Extra for wrapper
4903 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2_SEA ! Extra for wrapper
4904 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2_SEA ! Extra for wrapper
4905 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM_SEA ! Extra for wrapper
4906 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QZ0_SEA ! Extra for wrapper
4907 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSFC_SEA ! Extra for wrapper
4908 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH_SEA ! Extra for wrapper
4909 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC_SEA ! Extra for wrapper
4910 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC_SEA ! Extra for wrapper
4911 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX_SEA ! Extra for wrapper
4912 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX_SEA ! Extra for wrapper
4913 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH_SEA ! Extra for wrapper
4914 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSK_SEA ! Extra for wrapper
4915 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: USTAR
4916 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: ZNT
4917 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: Z0BASE
4918 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: PBLH
4919 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: MAVAIL
4920 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: RMOL
4921 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKHS
4922 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: AKMS
4923 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS
4924 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CHS2
4925 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CQS2
4926 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: HFX
4927 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QFX
4928 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLX_LH
4929 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLHC
4930 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: FLQC
4931 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QGH
4932 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CPM
4933 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: CT
4934 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: U10
4935 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: V10
4936 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: U10E
4937 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: V10E
4938 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: T02
4939 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH02
4940 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TSHLTR
4941 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: TH10
4942 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q02
4943 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: QSHLTR
4944 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: Q10
4945 REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: PSHLTR
4946 REAL, INTENT(IN) :: XICE_THRESHOLD
4947 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
4948 INTEGER, INTENT(IN) :: SCM_FORCE_FLUX
4949 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE, &
4950 & IMS,IME,JMS,JME,KMS,KME, &
4951 & ITS,ITE,JTS,JTE,KTS,KTE
4954 ! Local
4955 INTEGER :: i
4956 INTEGER :: j
4957 REAL, DIMENSION( ims:ime, jms:jme ) :: ct_sea
4958 REAL, DIMENSION( ims:ime, jms:jme ) :: u10_sea
4959 REAL, DIMENSION( ims:ime, jms:jme ) :: v10_sea
4960 REAL, DIMENSION( ims:ime, jms:jme ) :: u10e_sea
4961 REAL, DIMENSION( ims:ime, jms:jme ) :: v10e_sea
4962 REAL, DIMENSION( ims:ime, jms:jme ) :: t02_sea
4963 REAL, DIMENSION( ims:ime, jms:jme ) :: th02_sea
4964 REAL, DIMENSION( ims:ime, jms:jme ) :: tshltr_sea
4965 REAL, DIMENSION( ims:ime, jms:jme ) :: pshltr_sea
4966 REAL, DIMENSION( ims:ime, jms:jme ) :: qshltr_sea
4967 REAL, DIMENSION( ims:ime, jms:jme ) :: th10_sea
4968 REAL, DIMENSION( ims:ime, jms:jme ) :: q02_sea
4969 REAL, DIMENSION( ims:ime, jms:jme ) :: q10_sea
4970 REAL, DIMENSION( ims:ime, jms:jme ) :: thz0_sea
4971 REAL, DIMENSION( ims:ime, jms:jme ) :: uz0_sea
4972 REAL, DIMENSION( ims:ime, jms:jme ) :: vz0_sea
4973 REAL, DIMENSION( ims:ime, jms:jme ) :: ustar_sea
4974 REAL, DIMENSION( ims:ime, jms:jme ) :: pblh_sea
4975 REAL, DIMENSION( ims:ime, jms:jme ) :: rmol_sea
4976 REAL, DIMENSION( ims:ime, jms:jme ) :: akhs_sea
4977 REAL, DIMENSION( ims:ime, jms:jme ) :: akms_sea
4978 REAL, DIMENSION( ims:ime, jms:jme ) :: xland_sea
4979 REAL, DIMENSION( ims:ime, jms:jme ) :: mavail_sea
4980 REAL, DIMENSION( ims:ime, jms:jme ) :: znt_sea
4981 REAL, DIMENSION( ims:ime, jms:jme ) :: z0base_sea
4982 REAL, DIMENSION( ims:ime, jms:jme ) :: br_sea
4984 REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_HOLD
4985 REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_HOLD
4986 REAL, DIMENSION( ims:ime, jms:jme ) :: THZ0_HOLD
4987 REAL, DIMENSION( ims:ime, jms:jme ) :: UZ0_HOLD
4988 REAL, DIMENSION( ims:ime, jms:jme ) :: VZ0_HOLD
4989 REAL, DIMENSION( ims:ime, jms:jme ) :: USTAR_HOLD
4990 REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_HOLD
4991 REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_HOLD
4992 REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_HOLD
4993 REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_HOLD
4994 REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_HOLD
4995 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
4996 REAL :: PSFC
4998 ! Set things up for the frozen-surface call to qnsesfc
5000 ! We want a TSK valid for the ice-covered regions of the grid cell.
5002 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
5003 itimestep, .true., tice2tsk_if2cold, &
5004 XICE, XICE_THRESHOLD, &
5005 SST, TSK, TSK_SEA, TSK_LOCAL )
5006 DO j = JTS , JTE
5007 DO i = ITS , ITE
5008 TSK(i,j) = TSK_LOCAL(i,j)
5009 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
5011 ! Over fractional sea-ice points, back out an ice portion of QSFC as well.
5012 ! QSFC_SEA calculation as done in qnsesfc for open water points
5013 PSFC = PINT(I,LOWLYR(I,J),J)
5014 QSFC_SEA(i,j) = PQ0SEA/PSFC*EXP(A2S*(TSK(i,j)-A3S)/(TSK(i,j)-A4S))
5015 QSFC(i,j) = (QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j)) / XICE(i,j)
5016 !
5017 HFX_SEA(i,j) = HFX(i,j)
5018 QFX_SEA(i,j) = QFX(i,j)
5019 FLX_LH_SEA(i,j) = FLX_LH(i,j)
5020 ENDIF
5021 ENDDO
5022 ENDDO
5024 !
5025 ! frozen ocean call for sea ice points
5026 !
5028 ! Strictly INTENT(IN) to QNSESFC, should be unchanged by call.
5030 ! DZ
5031 ! HT
5032 ! LOWLYR
5033 ! MAVAIL
5034 ! PINT
5035 ! PMID
5036 ! QC
5037 ! QV
5038 ! Q2
5039 ! T
5040 ! TH
5041 ! TSK
5042 ! U
5043 ! V
5044 ! XLAND
5045 ! Z0BASE
5047 ! INTENT (INOUT), updated by QNSESFC. Values will need to be saved before the first call to QNSESFC, so that
5048 ! the second call to QNSESFC does not double-count the effect.
5050 ! Save INTENT(INOUT) variables before the frozen-water/true-land call to QNSESFC:
5051 QSFC_HOLD(its:ite,jts:jte) = QSFC(its:ite,jts:jte)
5052 QZ0_HOLD(its:ite,jts:jte) = QZ0(its:ite,jts:jte)
5053 THZ0_HOLD(its:ite,jts:jte) = THZ0(its:ite,jts:jte)
5054 UZ0_HOLD(its:ite,jts:jte) = UZ0(its:ite,jts:jte)
5055 VZ0_HOLD(its:ite,jts:jte) = VZ0(its:ite,jts:jte)
5056 USTAR_HOLD(its:ite,jts:jte) = USTAR(its:ite,jts:jte)
5057 ZNT_HOLD(its:ite,jts:jte) = ZNT(its:ite,jts:jte)
5058 PBLH_HOLD(its:ite,jts:jte) = PBLH(its:ite,jts:jte)
5059 RMOL_HOLD(its:ite,jts:jte) = RMOL(its:ite,jts:jte)
5060 AKHS_HOLD(its:ite,jts:jte) = AKHS(its:ite,jts:jte)
5061 AKMS_HOLD(its:ite,jts:jte) = AKMS(its:ite,jts:jte)
5063 ! Strictly INTENT(OUT): Set by QNSESFC
5065 ! CHS
5066 ! CHS2
5067 ! CPM
5068 ! CQS2
5069 ! CT
5070 ! FLHC
5071 ! FLQC
5072 ! FLX_LH
5073 ! HFX
5074 ! PSHLTR
5075 ! QFX
5076 ! QGH
5077 ! QSHLTR
5078 ! Q02
5079 ! Q10
5080 ! TH02
5081 ! TH10
5082 ! TSHLTR
5083 ! T02
5084 ! U10
5085 ! V10
5087 ! Frozen-water/true-land call.
5088 CALL QNSESFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
5089 & PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
5090 & TSK, QSFC, THZ0, QZ0, UZ0, VZ0, & ! I,IO,IO,IO,IO,IO,
5091 & LOWLYR, XLAND, & ! I,I
5092 & USTAR, ZNT, Z0BASE, PBLH, MAVAIL, RMOL, & ! IO,IO,I,IO,I,IO,
5093 & AKHS, AKMS, & ! IO,IO,
5094 & BR, & ! O
5095 & CHS, CHS2, CQS2, HFX, QFX, FLX_LH, FLHC, FLQC, & ! O,O,O,0,0,0,0,0,
5096 & QGH, CPM, CT, U10, V10,T02,TH02, & ! 0,0,0,0,0,0,0
5097 & TSHLTR, TH10, Q02, & ! 0,0,0
5098 & QSHLTR, Q10, PSHLTR, & ! 0,0,0,
5099 & U10E, V10E, & ! 0,0,0,
5100 & ids,ide, jds,jde, kds,kde, &
5101 & ims,ime, jms,jme, kms,kme, &
5102 & its,ite, jts,jte, kts,kte, SCM_FORCE_FLUX )
5104 ! Set up things for the open ocean call.
5105 DO j = JTS, JTE
5106 DO i = ITS, ITE
5107 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
5108 XLAND_SEA(i,j)=2.
5109 MAVAIL_SEA(I,J) = 1.
5110 ZNT_SEA(I,J) = 0.0001
5111 Z0BASE_SEA(I,J) = ZNT_SEA(I,J)
5112 IF ( SST(i,j) .LT. 271.4 ) THEN
5113 SST(i,j) = 271.4
5114 ENDIF
5115 TSK_SEA(i,j) = SST(i,j)
5116 PSFC = PINT(I,LOWLYR(I,J),J)
5117 QSFC_SEA(I,J) = PQ0SEA/PSFC*EXP(A2S*(TSK_SEA(i,j)-A3S)/(TSK_SEA(i,j)-A4S))
5118 ELSE
5119 ! This should be a land point or a true open water point
5120 XLAND_SEA(i,j)=xland(i,j)
5121 MAVAIL_SEA(i,j) = mavail(i,j)
5122 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
5123 Z0BASE_SEA(I,J) = Z0BASE(I,J)
5124 TSK_SEA(i,j) = TSK(i,j)
5125 QSFC_SEA(i,j) = QSFC_HOLD(i,j)
5126 ENDIF
5127 ENDDO
5128 ENDDO
5130 QZ0_SEA(its:ite,jts:jte) = QZ0_HOLD(its:ite,jts:jte)
5131 THZ0_SEA(its:ite,jts:jte) = THZ0_HOLD(its:ite,jts:jte)
5132 UZ0_SEA(its:ite,jts:jte) = UZ0_HOLD(its:ite,jts:jte)
5133 VZ0_SEA(its:ite,jts:jte) = VZ0_HOLD(its:ite,jts:jte)
5134 USTAR_SEA(its:ite,jts:jte) = USTAR_HOLD(its:ite,jts:jte)
5135 PBLH_SEA(its:ite,jts:jte) = PBLH_HOLD(its:ite,jts:jte)
5136 RMOL_SEA(its:ite,jts:jte) = RMOL_HOLD(its:ite,jts:jte)
5137 AKHS_SEA(its:ite,jts:jte) = AKHS_HOLD(its:ite,jts:jte)
5138 AKMS_SEA(its:ite,jts:jte) = AKMS_HOLD(its:ite,jts:jte)
5139 !
5140 ! open water call
5141 !
5142 CALL QNSESFC ( ITIMESTEP, HT, DZ, & ! I,I,I,
5143 & PMID, PINT, TH, T, QV, QC, U, V, Q2, & ! I,I,I,I,I,I,I,I,I,
5144 & TSK_SEA, QSFC_SEA, THZ0_SEA, QZ0_SEA, UZ0_SEA, VZ0_SEA, & ! I,IO,IO,IO,IO,IO,
5145 & LOWLYR, XLAND_SEA, & ! I,I,
5146 & USTAR_SEA, ZNT_SEA, Z0BASE_SEA, PBLH_SEA, MAVAIL_SEA, RMOL_SEA, & ! IO,IO,I,IO,I,IO,
5147 & AKHS_SEA, AKMS_SEA, & ! IO,IO,
5148 & BR_SEA, & ! dummy space holder
5149 & CHS_SEA, CHS2_SEA, CQS2_SEA, HFX_SEA, QFX_SEA, FLX_LH_SEA, FLHC_SEA, & ! 0,0,0,0,0,0,0,
5150 & FLQC_SEA, QGH_SEA, CPM_SEA, CT_SEA, U10_SEA, V10_SEA,T02_SEA,TH02_SEA, & ! 0,0,0,0,0,0,0,0
5151 & TSHLTR_SEA, TH10_SEA, Q02_SEA, QSHLTR_SEA, Q10_SEA, PSHLTR_SEA, & ! 0,0,0,0,0,0
5152 & U10E, V10E, &
5153 & ids,ide, jds,jde, kds,kde, &
5154 & ims,ime, jms,jme, kms,kme, &
5155 & its,ite, jts,jte, kts,kte, SCM_FORCE_FLUX )
5157 !
5158 ! Scale the appropriate terms between open-water values and ice-covered values
5161 DO j = JTS, JTE
5162 DO i = ITS, ITE
5163 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
5164 ! Over sea-ice points, blend the results.
5166 ! INTENT(OUT) from QNSESFC
5167 ! CHS wait
5168 ! CHS2 wait
5169 ! CPM wait
5170 ! CQS2 wait
5171 CT(i,j) = CT(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CT_SEA (i,j)
5172 ! FLHC(i,j) = FLHC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLHC_SEA (i,j)
5173 ! FLQC(i,j) = FLQC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLQC_SEA (i,j)
5174 ! FLX_LH wait
5175 ! HFX wait
5176 PSHLTR(i,j) = PSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PSHLTR_SEA(i,j)
5177 ! QFX wait
5178 ! QGH wait
5179 QSHLTR(i,j) = QSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * QSHLTR_SEA(i,j)
5180 Q10(i,j) = Q10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q10_SEA(i,j)
5181 Q02(i,j) = Q02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * Q02_SEA(i,j)
5182 TH10(i,j) = TH10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH10_SEA(i,j)
5183 TH02(i,j) = TH02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TH02_SEA(i,j)
5184 TSHLTR(i,j) = TSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TSHLTR_SEA(i,j)
5185 T02(i,j) = T02(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * T02_SEA(i,j)
5186 U10(i,j) = U10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * U10_SEA(i,j)
5187 V10(i,j) = V10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * V10_SEA(i,j)
5188 U10E(i,j) = U10(i,j)
5189 V10E(i,j) = V10(i,j)
5191 ! INTENT(INOUT): updated by QNSESFC
5192 ! QSFC: wait
5193 THZ0(i,j) = THZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * THZ0_SEA(i,j)
5194 ! qz0 wait
5195 UZ0(i,j) = UZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * UZ0_SEA(i,j)
5196 VZ0(i,j) = VZ0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * VZ0_SEA(i,j)
5197 USTAR(i,j) = USTAR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * USTAR_SEA(i,j)
5198 ! ZNT wait
5199 PBLH(i,j) = PBLH(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PBLH_SEA(i,j)
5200 RMOL(i,j) = RMOL(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * RMOL_SEA(i,j)
5201 AKHS(i,j) = AKHS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKHS_SEA(i,j)
5202 AKMS(i,j) = AKMS(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * AKMS_SEA(i,j)
5204 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
5205 ELSE
5206 ! We're not over sea ice. Take the results from the first call.
5207 ENDIF
5208 ENDDO
5209 ENDDO
5211 END SUBROUTINE qnsesfc_seaice_wrapper
5214 !-------------------------------------------------------------------------
5216 SUBROUTINE mynn_seaice_wrapper(U3D,V3D,T3D,QV3D, &
5217 P3D,dz8w,th3d,rho, &
5218 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
5219 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
5220 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
5221 U10,V10,TH2,T2,Q2,SNOWH, &
5222 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
5223 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
5224 &itimestep,ch,qcg, &
5225 &spp_pbl,pattern_spp_pbl, &
5226 XICE,SST,TSK_SEA, &
5227 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
5228 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
5229 TICE2TSK_IF2COLD,XICE_THRESHOLD, &
5230 ids,ide, jds,jde, kds,kde, &
5231 ims,ime, jms,jme, kms,kme, &
5232 its,ite, jts,jte, kts,kte, &
5233 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
5235 USE module_sf_mynn
5237 implicit none
5239 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
5240 ims,ime, jms,jme, kms,kme, &
5241 its,ite, jts,jte, kts,kte
5242 INTEGER, INTENT(IN ) :: itimestep, ISFFLX
5243 INTEGER, INTENT(IN ), optional :: ISFTCFLX, IZ0TLND
5244 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
5245 REAL, INTENT(IN ) :: EP1,EP2,KARMAN, &
5246 CP,G,ROVCP,R,XLV,DX
5248 INTEGER, INTENT(IN), optional :: spp_pbl
5249 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), &
5250 INTENT(IN), OPTIONAL :: pattern_spp_pbl
5252 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
5253 INTENT(IN ) :: dz8w, &
5254 QV3D, &
5255 P3D, &
5256 T3D, &
5257 U3D, &
5258 V3D, &
5259 rho,th3d
5261 REAL, DIMENSION( ims:ime, jms:jme ) , &
5262 INTENT(IN ) :: MAVAIL, &
5263 PBLH, &
5264 XLAND, &
5265 QCG, &
5266 PSFC, &
5267 SNOWH, &
5268 TSK
5270 REAL, DIMENSION( ims:ime, jms:jme ) , &
5271 INTENT(OUT ) :: U10, &
5272 V10, &
5273 TH2, &
5274 T2, &
5275 Q2
5277 REAL, DIMENSION( ims:ime, jms:jme ) , &
5278 INTENT(INOUT) :: REGIME, &
5279 HFX, &
5280 QFX, &
5281 LH, &
5282 MOL,RMOL, &
5283 QSFC, &
5284 QGH, &
5285 ZNT, &
5286 ZOL, &
5287 UST, &
5288 CPM, &
5289 CHS2, &
5290 CQS2, &
5291 CHS, &
5292 CH, &
5293 FLHC,FLQC, &
5294 GZ1OZ0,WSPD,BR, &
5295 PSIM,PSIH
5297 REAL, DIMENSION( ims:ime, jms:jme ) , &
5298 INTENT(OUT), OPTIONAL :: ck,cka,cd,cda,ustm
5300 !--------------------------------------------------------------------
5301 ! New for wrapper
5302 !--------------------------------------------------------------------
5303 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
5304 REAL, INTENT(IN) :: XICE_THRESHOLD
5305 REAL, DIMENSION( ims:ime, jms:jme ), &
5306 INTENT(IN) :: XICE
5307 REAL, DIMENSION( ims:ime, jms:jme ), &
5308 INTENT(INOUT) :: SST
5309 REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, &
5310 INTENT(OUT) :: TSK_SEA, &
5311 CHS2_SEA, &
5312 CHS_SEA, &
5313 CPM_SEA, &
5314 CQS2_SEA, &
5315 FLHC_SEA, &
5316 FLQC_SEA, &
5317 HFX_SEA, &
5318 LH_SEA, &
5319 QFX_SEA, &
5320 QGH_SEA, &
5321 QSFC_SEA, &
5322 ZNT_SEA
5324 !--------------------------------------------------------------------
5325 ! Local
5326 !--------------------------------------------------------------------
5327 INTEGER :: I, J
5328 REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL, &
5329 XLAND_SEA, &
5330 MAVAIL_sea, &
5331 BR_SEA, BR_HOLD, &
5332 FLHC_HOLD, &
5333 FLQC_HOLD, &
5334 GZ1OZ0_SEA, GZ1OZ0_HOLD, &
5335 HFX_HOLD, &
5336 LH_HOLD, &
5337 CH_SEA, &
5338 MOL_SEA, MOL_HOLD, &
5339 PSIH_SEA, PSIH_HOLD, &
5340 PSIM_SEA, PSIM_HOLD, &
5341 QFX_HOLD, &
5342 QGH_HOLD, &
5343 CPM_HOLD, &
5344 RMOL_SEA, RMOL_HOLD, &
5345 UST_SEA, UST_HOLD, &
5346 WSPD_SEA, WSPD_HOLD, &
5347 ZNT_HOLD, &
5348 ZOL_SEA, ZOL_HOLD, &
5349 Q2_SEA, &
5350 T2_SEA, &
5351 TH2_SEA, &
5352 U10_SEA, &
5353 V10_SEA, &
5354 CD_SEA, &
5355 CDA_SEA, &
5356 CK_SEA, &
5357 CKA_SEA, &
5358 USTM_SEA, USTM_HOLD
5361 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
5362 itimestep, .true., tice2tsk_if2cold, &
5363 XICE, XICE_THRESHOLD, &
5364 SST, TSK, TSK_SEA, TSK_LOCAL )
5367 ! DFS 8/25/10 Set TSK to ice value
5368 ! DO j = JTS , JTE
5369 ! DO i = ITS , ITE
5370 ! TSK(i,j) = TSK_LOCAL(i,j)
5371 ! ENDDO
5372 ! ENDDO
5374 ! Save the variables before the first call
5375 ! (for land/frozen water) to SFCLAY_mynn.
5376 BR_HOLD(its:ite,jts:jte) = BR(its:ite,jts:jte)
5377 CPM_HOLD(its:ite,jts:jte) = CPM(its:ite,jts:jte)
5378 FLHC_HOLD(its:ite,jts:jte) = FLHC(its:ite,jts:jte)
5379 FLQC_HOLD(its:ite,jts:jte) = FLQC(its:ite,jts:jte)
5380 GZ1OZ0_HOLD(its:ite,jts:jte) = GZ1OZ0(its:ite,jts:jte)
5381 HFX_HOLD(its:ite,jts:jte) = HFX(its:ite,jts:jte)
5382 LH_HOLD(its:ite,jts:jte) = LH(its:ite,jts:jte)
5383 MOL_HOLD(its:ite,jts:jte) = MOL(its:ite,jts:jte)
5384 PSIH_HOLD(its:ite,jts:jte) = PSIH(its:ite,jts:jte)
5385 PSIM_HOLD(its:ite,jts:jte) = PSIM(its:ite,jts:jte)
5386 QFX_HOLD(its:ite,jts:jte) = QFX(its:ite,jts:jte)
5387 QGH_HOLD(its:ite,jts:jte) = QGH(its:ite,jts:jte)
5388 RMOL_HOLD(its:ite,jts:jte) = RMOL(its:ite,jts:jte)
5389 UST_HOLD(its:ite,jts:jte) = UST(its:ite,jts:jte)
5390 USTM_HOLD(its:ite,jts:jte) = USTM(its:ite,jts:jte)
5391 WSPD_HOLD(its:ite,jts:jte) = WSPD(its:ite,jts:jte)
5392 ZNT_HOLD(its:ite,jts:jte) = ZNT(its:ite,jts:jte)
5393 ZOL_HOLD(its:ite,jts:jte) = ZOL(its:ite,jts:jte)
5395 ! We'll want to save the ouput
5396 ! for weighting after the second call to SFCLAY.
5398 ! land/frozen-water call
5399 CALL SFCLAY_mynn(U3D,V3D,T3D,QV3D,P3D,dz8w,th3d,rho, &
5400 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
5401 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
5402 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
5403 U10,V10,TH2,T2,Q2,SNOWH, &
5404 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
5405 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
5406 itimestep,ch,qcg, &
5407 spp_pbl,pattern_spp_pbl, &
5408 ids,ide, jds,jde, kds,kde, &
5409 ims,ime, jms,jme, kms,kme, &
5410 its,ite, jts,jte, kts,kte, &
5411 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd )
5413 ! Set up lower boundary conditions to force an open-water call
5414 DO j = JTS , JTE
5415 DO i = ITS , ITE
5416 IF ( ( XICE(i,j) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
5417 XLAND_SEA(i,j) = 2. !water
5418 MAVAIL_SEA(i,j)= 1.
5419 ZNT_SEA(i,j) = 0.0001 !will be recalculated anyway
5420 TSK_SEA(i,j) = SST(i,j)
5421 IF ( SST(i,j) .LT. 271.4 ) THEN
5422 SST(i,j) = 271.4
5423 TSK_SEA(i,j)= SST(i,j)
5424 ENDIF
5425 QSFC_SEA(i,j) = QSFC(i,j) !will be recalculated anyway
5426 ELSE
5427 !keep original values
5428 XLAND_SEA(i,j) = XLAND(i,j)
5429 MAVAIL_SEA(i,j)= MAVAIL(i,j)
5430 ZNT_SEA(i,j) = ZNT_HOLD(i,j)
5431 TSK_SEA(i,j) = TSK_LOCAL(i,j)
5432 QSFC_SEA(i,j) = QSFC(i,j)
5433 ENDIF
5434 ENDDO
5435 ENDDO
5437 ! Restore the values from before the land/frozen-water call
5438 BR_SEA(its:ite,jts:jte) = BR_HOLD(its:ite,jts:jte)
5439 CPM_SEA(its:ite,jts:jte) = CPM_HOLD(its:ite,jts:jte)
5440 FLHC_SEA(its:ite,jts:jte) = FLHC_HOLD(its:ite,jts:jte)
5441 FLQC_SEA(its:ite,jts:jte) = FLQC_HOLD(its:ite,jts:jte)
5442 GZ1OZ0_SEA(its:ite,jts:jte) = GZ1OZ0_HOLD(its:ite,jts:jte)
5443 HFX_SEA(its:ite,jts:jte) = HFX_HOLD(its:ite,jts:jte)
5444 LH_SEA(its:ite,jts:jte) = LH_HOLD(its:ite,jts:jte)
5445 MOL_SEA(its:ite,jts:jte) = MOL_HOLD(its:ite,jts:jte)
5446 PSIH_SEA(its:ite,jts:jte) = PSIH_HOLD(its:ite,jts:jte)
5447 PSIM_SEA(its:ite,jts:jte) = PSIM_HOLD(its:ite,jts:jte)
5448 QFX_SEA(its:ite,jts:jte) = QFX_HOLD(its:ite,jts:jte)
5449 QGH_SEA(its:ite,jts:jte) = QGH_HOLD(its:ite,jts:jte)
5450 RMOL_SEA(its:ite,jts:jte) = RMOL_HOLD(its:ite,jts:jte)
5451 UST_SEA(its:ite,jts:jte) = UST_HOLD(its:ite,jts:jte)
5452 USTM_SEA(its:ite,jts:jte) = USTM_HOLD(its:ite,jts:jte)
5453 WSPD_SEA(its:ite,jts:jte) = WSPD_HOLD(its:ite,jts:jte)
5454 ZOL_SEA(its:ite,jts:jte) = ZOL_HOLD(its:ite,jts:jte)
5457 ! open-water call
5458 CALL SFCLAY_mynn(U3D,V3D,T3D,QV3D,P3D,dz8w,th3d,rho, &
5459 CP,G,ROVCP,R,XLV,PSFC, &
5460 CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, &
5461 ZNT_SEA,UST_SEA, &
5462 PBLH,MAVAIL_SEA, &
5463 ZOL_SEA,MOL_SEA,REGIME,PSIM_SEA,PSIH_SEA, &
5464 XLAND_SEA, &
5465 HFX_SEA,QFX_SEA,LH_SEA, &
5466 TSK_SEA, &
5467 FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_SEA,RMOL_SEA, &
5468 U10_SEA,V10_SEA,TH2_SEA,T2_SEA,Q2_SEA,SNOWH, &
5469 GZ1OZ0_SEA,WSPD_SEA,BR_SEA, &
5470 ISFFLX,DX, &
5471 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
5472 itimestep,CH_SEA,qcg, &
5473 spp_pbl,pattern_spp_pbl, &
5474 ids,ide, jds,jde, kds,kde, &
5475 ims,ime, jms,jme, kms,kme, &
5476 its,ite, jts,jte, kts,kte, &
5477 ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx, &
5478 iz0tlnd )
5480 DO j = JTS , JTE
5481 DO i = ITS, ITE
5482 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and.( XICE(i,j) .LE. 1.0 ) ) THEN
5483 ! weighted average for sea ice points
5484 br(i,j) = br(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * br_sea(i,j)
5485 ! CHS2 -- wait
5486 ! CHS -- wait
5487 ! CPM -- wait
5488 ! CQS2 -- wait
5489 !FLHC(i,j) = FLHC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLHC_SEA (i,j)
5490 !FLQC(i,j) = FLQC(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * FLQC_SEA (i,j)
5491 gz1oz0(i,j) = gz1oz0(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * gz1oz0_sea(i,j)
5492 ! HFX -- wait
5493 ! LH -- wait
5494 mol(i,j) = mol(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * mol_sea(i,j)
5495 psih(i,j) = psih(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * psih_sea(i,j)
5496 psim(i,j) = psim(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * psim_sea(i,j)
5497 ! QFX -- wait
5498 ! QGH -- wait
5499 rmol(i,j) = rmol(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * rmol_sea(i,j)
5500 ust(i,j) = ust(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * ust_sea(i,j)
5501 wspd(i,j) = wspd(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * wspd_sea(i,j)
5502 zol(i,j) = zol(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * zol_sea(i,j)
5503 ch(i,j) = ch(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * ch_sea(i,j)
5504 ! INTENT(OUT)
5505 ! --------------------------------------------------------------------
5506 IF ( PRESENT ( CD ) ) THEN
5507 CD(i,j) = CD(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CD_sea(i,j)
5508 ENDIF
5509 IF ( PRESENT ( CDA ) ) THEN
5510 CDA(i,j) = CDA(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CDA_sea(i,j)
5511 ENDIF
5512 IF ( PRESENT ( CK ) ) THEN
5513 CK(i,j) = CK(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CK_sea(i,j)
5514 ENDIF
5515 IF ( PRESENT ( CKA ) ) THEN
5516 CKA(i,j) = CKA(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * CKA_sea(i,j)
5517 ENDIF
5518 q2(i,j) = q2(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * q2_sea(i,j)
5519 ! QSFC -- wait
5520 t2(i,j) = t2(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * t2_sea(i,j)
5521 th2(i,j) = th2(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * th2_sea(i,j)
5522 u10(i,j) = u10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * u10_sea(i,j)
5523 IF ( PRESENT ( USTM ) ) THEN
5524 USTM(i,j)= USTM(i,j)* XICE(i,j) + (1.0-XICE(i,j)) * USTM_sea(i,j)
5525 ENDIF
5526 v10(i,j) = v10(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * v10_sea(i,j)
5527 ENDIF
5528 END DO
5529 END DO
5532 END SUBROUTINE mynn_seaice_wrapper
5534 !-------------------------------------------------------------------------
5536 SUBROUTINE sf_gfs_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D, &
5537 CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
5538 ZNT,UST,PSIM,PSIH, &
5539 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC, &
5540 QGH,QSFC,U10,V10, &
5541 GZ1OZ0,WSPD,BR,ISFFLX, &
5542 EP1,EP2,KARMAN,itimestep, &
5543 TICE2TSK_IF2COLD, &
5544 XICE_THRESHOLD, &
5545 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, &
5546 FLHC_SEA, FLQC_SEA, &
5547 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA,&
5548 UST_SEA, ZNT_SEA, SST, XICE, &
5549 ids,ide, jds,jde, kds,kde, &
5550 ims,ime, jms,jme, kms,kme, &
5551 its,ite, jts,jte, kts,kte )
5552 USE module_sf_gfs
5553 implicit none
5555 INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, &
5556 ims,ime, jms,jme, kms,kme, &
5557 its,ite, jts,jte, kts,kte, &
5558 ISFFLX,itimestep
5560 REAL, INTENT(IN) :: &
5561 CP, &
5562 EP1, &
5563 EP2, &
5564 KARMAN, &
5565 R, &
5566 ROVCP, &
5567 XLV
5569 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: &
5570 P3D, &
5571 QV3D, &
5572 T3D, &
5573 U3D, &
5574 V3D
5576 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
5577 TSK, &
5578 PSFC, &
5579 XLAND
5581 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
5582 UST, &
5583 ZNT
5585 REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: &
5586 BR, &
5587 CHS, &
5588 CHS2, &
5589 CPM, &
5590 CQS2, &
5591 FLHC, &
5592 FLQC, &
5593 GZ1OZ0, &
5594 HFX, &
5595 LH, &
5596 PSIM, &
5597 PSIH, &
5598 QFX, &
5599 QGH, &
5600 QSFC, &
5601 U10, &
5602 V10, &
5603 WSPD
5605 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
5606 XICE
5607 REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: &
5608 CHS_SEA, &
5609 CHS2_SEA, &
5610 CPM_SEA, &
5611 CQS2_SEA, &
5612 FLHC_SEA, &
5613 FLQC_SEA, &
5614 HFX_SEA, &
5615 LH_SEA, &
5616 QFX_SEA, &
5617 QGH_SEA, &
5618 QSFC_SEA, &
5619 UST_SEA, &
5620 ZNT_SEA
5621 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
5622 SST
5624 REAL, INTENT(IN) :: &
5625 XICE_THRESHOLD
5626 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
5628 !-------------------------------------------------------------------------
5629 ! Local
5630 !-------------------------------------------------------------------------
5631 INTEGER :: I
5632 INTEGER :: J
5633 REAL, DIMENSION(ims:ime, jms:jme) :: &
5634 BR_SEA, &
5635 GZ1OZ0_SEA, &
5636 PSIM_SEA, &
5637 PSIH_SEA, &
5638 U10_SEA, &
5639 V10_SEA, &
5640 WSPD_SEA, &
5641 XLAND_SEA, &
5642 TSK_SEA, &
5643 UST_HOLD, &
5644 ZNT_HOLD, &
5645 TSK_LOCAL
5647 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
5648 itimestep, .true., tice2tsk_if2cold, &
5649 XICE, XICE_THRESHOLD, &
5650 SST, TSK, TSK_SEA, TSK_LOCAL )
5652 !
5653 ! Set up for frozen ocean call for sea ice points
5654 !
5656 ! Strictly INTENT(IN), Should be unchanged by SF_GFS:
5657 ! CP
5658 ! EP1
5659 ! EP2
5660 ! KARMAN
5661 ! R
5662 ! ROVCP
5663 ! XLV
5664 ! P3D
5665 ! QV3D
5666 ! T3D
5667 ! U3D
5668 ! V3D
5669 ! TSK
5670 ! PSFC
5671 ! XLAND
5672 ! ISFFLX
5673 ! ITIMESTEP
5676 ! Intent (INOUT), original value is used and changed by SF_GFS.
5677 ! UST
5678 ! ZNT
5680 ZNT_HOLD = ZNT
5681 UST_HOLD = UST
5683 ! Strictly INTENT (OUT), set by SF_GFS:
5684 ! BR
5685 ! CHS -- used by LSM routines
5686 ! CHS2 -- used by LSM routines
5687 ! CPM -- used by LSM routines
5688 ! CQS2 -- used by LSM routines
5689 ! FLHC
5690 ! FLQC
5691 ! GZ1OZ0
5692 ! HFX -- used by LSM routines
5693 ! LH -- used by LSM routines
5694 ! PSIM
5695 ! PSIH
5696 ! QFX -- used by LSM routines
5697 ! QGH -- used by LSM routines
5698 ! QSFC -- used by LSM routines
5699 ! U10
5700 ! V10
5701 ! WSPD
5703 !
5704 ! Frozen ocean / true land call.
5705 !
5706 CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D, &
5707 CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM_SEA, &
5708 ZNT,UST,PSIM,PSIH, &
5709 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC, &
5710 QGH,QSFC,U10,V10, &
5711 GZ1OZ0,WSPD,BR,ISFFLX, &
5712 EP1,EP2,KARMAN,ITIMESTEP, &
5713 ids,ide, jds,jde, kds,kde, &
5714 ims,ime, jms,jme, kms,kme, &
5715 its,ite, jts,jte, kts,kte )
5717 ! Set up for open-water call
5719 DO j = JTS , JTE
5720 DO i = ITS , ITE
5721 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
5722 ! Sets up things for open ocean fraction of sea-ice points
5723 XLAND_SEA(i,j)=2.
5724 ZNT_SEA(I,J) = 0.0001
5725 IF ( SST(i,j) .LT. 271.4 ) THEN
5726 SST(i,j) = 271.4
5727 ENDIF
5728 TSK_SEA(i,j) = SST(i,j)
5729 ELSE
5730 ! Fully open ocean or true land points
5731 XLAND_SEA(i,j)=xland(i,j)
5732 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
5733 UST_SEA(i,j) = UST_HOLD(i,j)
5734 TSK_SEA(i,j) = TSK(i,j)
5735 ENDIF
5736 ENDDO
5737 ENDDO
5739 ! Open-water call
5740 ! _SEA variables are held for later use as the result of the open-water call.
5741 CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D, &
5742 CP,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM, &
5743 ZNT_SEA,UST_SEA,PSIM_SEA,PSIH_SEA, &
5744 XLAND,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA, &
5745 QGH_SEA,QSFC_SEA,U10_SEA,V10_SEA, &
5746 GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX, &
5747 EP1,EP2,KARMAN,ITIMESTEP, &
5748 ids,ide, jds,jde, kds,kde, &
5749 ims,ime, jms,jme, kms,kme, &
5750 its,ite, jts,jte, kts,kte )
5752 ! Weighting, after our two calls to SF_GFS
5754 DO j = JTS , JTE
5755 DO i = ITS , ITE
5756 ! Over sea-ice points, weight the results. Otherwise, just take the results from the
5757 ! first call to SF_GFS_
5758 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
5759 ! Weight a number of fields (between open-water results
5760 ! and full ice results) by sea-ice fraction.
5762 BR(i,j) = ( BR(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * BR_SEA(i,j) )
5763 ! CHS, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5764 ! CHS2, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5765 ! CPM, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5766 ! CQS2, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5767 ! FLHC(i,j) = ( FLHC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLHC_SEA(i,j) )
5768 ! FLQC(i,j) = ( FLQC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLQC_SEA(i,j) )
5769 GZ1OZ0(i,j) = ( GZ1OZ0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * GZ1OZ0_SEA(i,j) )
5770 ! HFX, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5771 ! LH, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5772 PSIM(i,j) = ( PSIM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIM_SEA(i,j) )
5773 PSIH(i,j) = ( PSIH(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j) )
5774 ! QFX, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5775 ! QGH, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5776 ! QSFC, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5777 U10(i,j) = ( U10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * U10_SEA(i,j) )
5778 V10(i,j) = ( V10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * V10_SEA(i,j) )
5779 WSPD(i,j) = ( WSPD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * WSPD_SEA(i,j) )
5780 ! UST, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5781 ! ZNT, used by the LSM routines, is not updated yet. Return results from both calls in separate variables
5783 ENDIF
5784 ENDDO
5785 ENDDO
5787 END SUBROUTINE sf_gfs_seaice_wrapper
5789 !-------------------------------------------------------------------------
5791 !-------------------------------------------------------------------------
5793 SUBROUTINE sfclayrev_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, &
5794 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
5795 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
5796 FM,FH, &
5797 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
5798 U10,V10,TH2,T2,Q2, &
5799 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
5800 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
5801 KARMAN,EOMEG,STBOLT, &
5802 P1000, &
5803 XICE,SST,TSK_SEA, &
5804 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
5805 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
5806 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
5807 ids,ide, jds,jde, kds,kde, &
5808 ims,ime, jms,jme, kms,kme, &
5809 its,ite, jts,jte, kts,kte, &
5810 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
5811 shalwater_z0,water_depth,shalwater_depth, &
5812 scm_force_flux,sf_surface_physics )
5814 USE module_sf_sfclayrev
5815 implicit none
5817 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
5818 ims,ime, jms,jme, kms,kme, &
5819 its,ite, jts,jte, kts,kte
5821 INTEGER, INTENT(IN ) :: ISFFLX
5822 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
5823 REAL, INTENT(IN ) :: EP1,EP2,KARMAN,EOMEG,STBOLT
5824 REAL, INTENT(IN ) :: P1000
5826 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
5827 INTENT(IN ) :: dz8w
5829 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
5830 INTENT(IN ) :: QV3D, &
5831 P3D, &
5832 T3D
5834 REAL, DIMENSION( ims:ime, jms:jme ) , &
5835 INTENT(IN ) :: MAVAIL, &
5836 PBLH, &
5837 XLAND, &
5838 TSK
5839 REAL, DIMENSION( ims:ime, jms:jme ) , &
5840 INTENT(OUT ) :: U10, &
5841 V10, &
5842 TH2, &
5843 T2, &
5844 Q2, &
5845 QSFC
5846 REAL, DIMENSION( ims:ime, jms:jme ) , &
5847 INTENT(INOUT) :: REGIME, &
5848 HFX, &
5849 QFX, &
5850 LH, &
5851 MOL,RMOL
5853 REAL, DIMENSION( ims:ime, jms:jme ) , &
5854 INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
5855 PSIM,PSIH,FM,FH
5857 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
5858 INTENT(IN ) :: U3D, &
5859 V3D
5861 REAL, DIMENSION( ims:ime, jms:jme ) , &
5862 INTENT(IN ) :: PSFC
5864 REAL, DIMENSION( ims:ime, jms:jme ) , &
5865 INTENT(INOUT) :: ZNT, &
5866 ZOL, &
5867 UST, &
5868 CPM, &
5869 CHS2, &
5870 CQS2, &
5871 CHS
5873 REAL, DIMENSION( ims:ime, jms:jme ) , &
5874 INTENT(INOUT) :: FLHC,FLQC
5876 REAL, DIMENSION( ims:ime, jms:jme ) , &
5877 INTENT(INOUT) :: &
5878 QGH
5880 REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
5882 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
5883 INTENT(OUT) :: ck,cka,cd,cda
5884 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
5885 INTENT(INOUT) :: ustm
5887 INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX,IZ0TLND
5888 INTEGER, INTENT(IN ) :: shalwater_z0
5889 REAL, INTENT(IN ) :: shalwater_depth
5890 REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(IN ) :: water_depth
5891 INTEGER, OPTIONAL, INTENT(IN ) :: SCM_FORCE_FLUX
5893 !--------------------------------------------------------------------
5894 ! New for wrapper
5895 !--------------------------------------------------------------------
5896 INTEGER, INTENT(IN) :: ITIMESTEP, sf_surface_physics
5897 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
5898 REAL, INTENT(IN) :: XICE_THRESHOLD
5899 REAL, DIMENSION( ims:ime, jms:jme ), &
5900 INTENT(IN) :: XICE
5901 REAL, DIMENSION( ims:ime, jms:jme ), &
5902 INTENT(INOUT) :: SST
5903 REAL, DIMENSION( ims:ime, jms:jme ), &
5904 INTENT(OUT) :: TSK_SEA, &
5905 CHS2_SEA, &
5906 CHS_SEA, &
5907 CPM_SEA, &
5908 CQS2_SEA, &
5909 FLHC_SEA, &
5910 FLQC_SEA, &
5911 HFX_SEA, &
5912 LH_SEA, &
5913 QFX_SEA, &
5914 QGH_SEA, &
5915 QSFC_SEA, &
5916 ZNT_SEA
5918 !--------------------------------------------------------------------
5919 ! Local
5920 !--------------------------------------------------------------------
5921 INTEGER :: I, J
5922 REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
5923 MAVAIL_sea, &
5924 TSK_LOCAL, &
5925 BR_HOLD, &
5926 CHS2_HOLD, &
5927 CHS_HOLD, &
5928 CPM_HOLD, &
5929 CQS2_HOLD, &
5930 FLHC_HOLD, &
5931 FLQC_HOLD, &
5932 GZ1OZ0_HOLD, &
5933 HFX_HOLD, &
5934 LH_HOLD, &
5935 MOL_HOLD, &
5936 PSIH_HOLD, &
5937 PSIM_HOLD, &
5938 FH_HOLD, &
5939 FM_HOLD, &
5940 QFX_HOLD, &
5941 QGH_HOLD, &
5942 REGIME_HOLD, &
5943 RMOL_HOLD, &
5944 UST_HOLD, &
5945 WSPD_HOLD, &
5946 ZNT_HOLD, &
5947 ZOL_HOLD, &
5948 QSFC_HOLD, &
5949 TH2_HOLD, & !ssib
5950 T2_HOLD, & !ssib
5951 Q2_HOLD, & !ssib
5952 TSK_HOLD, & !ssib
5953 U10_HOLD, & !ssib
5954 V10_HOLD, & !ssib
5955 CD_SEA, &
5956 CDA_SEA, &
5957 CK_SEA, &
5958 CKA_SEA, &
5959 Q2_SEA, &
5960 T2_SEA, &
5961 TH2_SEA, &
5962 U10_SEA, &
5963 USTM_SEA, &
5964 V10_SEA
5966 REAL, DIMENSION( ims:ime, jms:jme ) :: &
5967 BR_SEA, &
5968 GZ1OZ0_SEA, &
5969 MOL_SEA, &
5970 PSIH_SEA, &
5971 PSIM_SEA, &
5972 FH_SEA, &
5973 FM_SEA, &
5974 REGIME_SEA, &
5975 RMOL_SEA, &
5976 UST_SEA, &
5977 WSPD_SEA, &
5978 ZOL_SEA
5980 ! INTENT(IN) to SFCLAY; unchanged by the call
5981 ! ISFFLX
5982 ! SVP1,SVP2,SVP3,SVPT0
5983 ! EP1,EP2,KARMAN,EOMEG,STBOLT
5984 ! CP,G,ROVCP,R,XLV,DX
5985 ! ISFTCFLX,IZ0TLND
5986 ! P1000
5987 ! dz8w
5988 ! QV3D
5989 ! P3D
5990 ! T3D
5991 ! MAVAIL
5992 ! PBLH
5993 ! XLAND
5994 ! TSK
5995 ! U3D
5996 ! V3D
5997 ! PSFC
5999 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
6000 itimestep, .true., tice2tsk_if2cold, &
6001 XICE, XICE_THRESHOLD, &
6002 SST, TSK, TSK_SEA, TSK_LOCAL )
6005 ! INTENT (INOUT) to SFCLAY: Save the variables before the first call
6006 ! (for land/frozen water) to SFCLAY, to keep from double-counting the
6007 BR_HOLD(its:ite,jts:jte) = BR(its:ite,jts:jte)
6008 CHS2_HOLD(its:ite,jts:jte) = CHS2(its:ite,jts:jte)
6009 CHS_HOLD(its:ite,jts:jte) = CHS(its:ite,jts:jte)
6010 CPM_HOLD(its:ite,jts:jte) = CPM(its:ite,jts:jte)
6011 CQS2_HOLD(its:ite,jts:jte) = CQS2(its:ite,jts:jte)
6012 FLHC_HOLD(its:ite,jts:jte) = FLHC(its:ite,jts:jte)
6013 FLQC_HOLD(its:ite,jts:jte) = FLQC(its:ite,jts:jte)
6014 GZ1OZ0_HOLD(its:ite,jts:jte) = GZ1OZ0(its:ite,jts:jte)
6015 HFX_HOLD(its:ite,jts:jte) = HFX(its:ite,jts:jte)
6016 LH_HOLD(its:ite,jts:jte) = LH(its:ite,jts:jte)
6017 MOL_HOLD(its:ite,jts:jte) = MOL(its:ite,jts:jte)
6018 PSIH_HOLD(its:ite,jts:jte) = PSIH(its:ite,jts:jte)
6019 PSIM_HOLD(its:ite,jts:jte) = PSIM(its:ite,jts:jte)
6020 FH_HOLD(its:ite,jts:jte) = FH(its:ite,jts:jte)
6021 FM_HOLD(its:ite,jts:jte) = FM(its:ite,jts:jte)
6022 QFX_HOLD(its:ite,jts:jte) = QFX(its:ite,jts:jte)
6023 QGH_HOLD(its:ite,jts:jte) = QGH(its:ite,jts:jte)
6024 REGIME_HOLD(its:ite,jts:jte) = REGIME(its:ite,jts:jte)
6025 RMOL_HOLD(its:ite,jts:jte) = RMOL(its:ite,jts:jte)
6026 UST_HOLD(its:ite,jts:jte) = UST(its:ite,jts:jte)
6027 WSPD_HOLD(its:ite,jts:jte) = WSPD(its:ite,jts:jte)
6028 ZNT_HOLD(its:ite,jts:jte) = ZNT(its:ite,jts:jte)
6029 ZOL_HOLD(its:ite,jts:jte) = ZOL(its:ite,jts:jte)
6030 QSFC_HOLD(its:ite,jts:jte) = QSFC(its:ite,jts:jte)
6031 !also save these variables for SSIB (fds 12/2010)
6032 TH2_HOLD(its:ite,jts:jte) = TH2(its:ite,jts:jte)
6033 T2_HOLD(its:ite,jts:jte) = T2(its:ite,jts:jte)
6034 Q2_HOLD(its:ite,jts:jte) = Q2(its:ite,jts:jte)
6035 TSK_HOLD(its:ite,jts:jte) = TSK(its:ite,jts:jte)
6036 U10_HOLD(its:ite,jts:jte) = U10(its:ite,jts:jte) !fds (01/2014)
6037 V10_HOLD(its:ite,jts:jte) = V10(its:ite,jts:jte) !fds (01/2014)
6039 ! INTENT(OUT) from SFCLAY. Input shouldn't matter, but we'll want to
6040 ! keep things around for weighting after the second call to SFCLAY.
6041 ! CD
6042 ! CDA
6043 ! CK
6044 ! CKA
6045 ! Q2
6046 ! QSFC
6047 ! T2
6048 ! TH2
6049 ! U10
6050 ! USTM
6051 ! V10
6054 ! land/frozen-water call
6055 call sfclayrev(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
6056 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, & ! I,I,I,I,I,I,IO,IO,IO,IO,
6057 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
6058 FM,FH, &
6059 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
6060 U10,V10,TH2,T2,Q2, &
6061 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
6062 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
6063 KARMAN,EOMEG,STBOLT, &
6064 P1000, &
6065 ids,ide, jds,jde, kds,kde, &
6066 ims,ime, jms,jme, kms,kme, &
6067 its,ite, jts,jte, kts,kte, &
6068 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
6069 shalwater_z0,water_depth,shalwater_depth, &
6070 scm_force_flux )
6071 !
6072 !Restore land-point values calculated by SSiB (fds 12/2010)
6073 IF (itimestep .gt. 1 .and. sf_surface_physics .EQ. 8) then
6074 DO j = JTS , JTE
6075 DO i = ITS, ITE
6076 IF ( XLAND(I,J) .LT. 1.5 ) THEN
6077 BR(I,J) = BR_HOLD(I,J)
6078 TH2(I,J) = TH2_HOLD(I,J)
6079 T2(I,J) = T2_HOLD(I,J)
6080 Q2(I,J) = Q2_HOLD(I,J)
6081 HFX(I,J) = HFX_HOLD(I,J)
6082 QFX(I,J) = QFX_HOLD(I,J)
6083 LH(I,J) = LH_HOLD(I,J)
6084 GZ1OZ0(I,J) = GZ1OZ0_HOLD(I,J)
6085 WSPD(I,J) = WSPD_HOLD(I,J)
6086 ZNT(I,J) = ZNT_HOLD(I,J)
6087 UST(I,J) = UST_HOLD(I,J)
6088 ! TSK(I,J) = TSK_HOLD(I,J)
6089 ENDIF
6090 ENDDO
6091 ENDDO
6092 ENDIF
6093 !
6094 ! Set up for open-water call
6095 DO j = JTS , JTE
6096 DO i = ITS , ITE
6097 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
6098 XLAND_SEA(i,j)=2.
6099 MAVAIL_SEA(I,J) =1.
6100 ZNT_SEA(I,J) = 0.0001
6101 TSK_SEA(i,j) = SST(i,j)
6102 IF ( SST(i,j) .LT. 271.4 ) THEN
6103 SST(i,j) = 271.4
6104 TSK_SEA(i,j) = SST(i,j)
6105 ENDIF
6106 ELSE
6107 XLAND_SEA(i,j) = XLAND(i,j)
6108 MAVAIL_SEA(i,j) = MAVAIL(i,j)
6109 ZNT_SEA(i,j) = ZNT_HOLD(i,j)
6110 TSK_SEA(i,j) = TSK_LOCAL(i,j)
6111 ENDIF
6112 ENDDO
6113 ENDDO
6115 ! Restore the values from before the land/frozen-water call
6116 BR_SEA(its:ite,jts:jte) = BR_HOLD(its:ite,jts:jte)
6117 CHS2_SEA(its:ite,jts:jte) = CHS2_HOLD(its:ite,jts:jte)
6118 CHS_SEA(its:ite,jts:jte) = CHS_HOLD(its:ite,jts:jte)
6119 CPM_SEA(its:ite,jts:jte) = CPM_HOLD(its:ite,jts:jte)
6120 CQS2_SEA(its:ite,jts:jte) = CQS2_HOLD(its:ite,jts:jte)
6121 FLHC_SEA(its:ite,jts:jte) = FLHC_HOLD(its:ite,jts:jte)
6122 FLQC_SEA(its:ite,jts:jte) = FLQC_HOLD(its:ite,jts:jte)
6123 GZ1OZ0_SEA(its:ite,jts:jte) = GZ1OZ0_HOLD(its:ite,jts:jte)
6124 HFX_SEA(its:ite,jts:jte) = HFX_HOLD(its:ite,jts:jte)
6125 LH_SEA(its:ite,jts:jte) = LH_HOLD(its:ite,jts:jte)
6126 MOL_SEA(its:ite,jts:jte) = MOL_HOLD(its:ite,jts:jte)
6127 PSIH_SEA(its:ite,jts:jte) = PSIH_HOLD(its:ite,jts:jte)
6128 PSIM_SEA(its:ite,jts:jte) = PSIM_HOLD(its:ite,jts:jte)
6129 FH_SEA(its:ite,jts:jte) = FH_HOLD(its:ite,jts:jte)
6130 FM_SEA(its:ite,jts:jte) = FM_HOLD(its:ite,jts:jte)
6131 QFX_SEA(its:ite,jts:jte) = QFX_HOLD(its:ite,jts:jte)
6132 QGH_SEA(its:ite,jts:jte) = QGH_HOLD(its:ite,jts:jte)
6133 REGIME_SEA(its:ite,jts:jte) = REGIME_HOLD(its:ite,jts:jte)
6134 RMOL_SEA(its:ite,jts:jte) = RMOL_HOLD(its:ite,jts:jte)
6135 UST_SEA(its:ite,jts:jte) = UST_HOLD(its:ite,jts:jte)
6136 WSPD_SEA(its:ite,jts:jte) = WSPD_HOLD(its:ite,jts:jte)
6137 ZOL_SEA(its:ite,jts:jte) = ZOL_HOLD(its:ite,jts:jte)
6138 ZNT_SEA(its:ite,jts:jte) = ZNT_HOLD(its:ite,jts:jte)
6139 QSFC_SEA(its:ite,jts:jte) = QSFC_HOLD(its:ite,jts:jte)
6140 !
6141 ! open-water call
6142 call sfclayrev(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
6143 CP,G,ROVCP,R,XLV,PSFC, & ! I
6144 CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, & ! I/O
6145 ZNT_SEA,UST_SEA, & ! I/O
6146 PBLH,MAVAIL_SEA, & ! I
6147 ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
6148 FM_SEA,FH_SEA, &
6149 XLAND_SEA, & ! I
6150 HFX_SEA,QFX_SEA,LH_SEA, & ! I/O
6151 TSK_SEA, & ! I
6152 FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA, & ! I/O
6153 U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea, & ! O
6154 GZ1OZ0_SEA,WSPD_SEA,BR_SEA, & ! I/O
6155 ISFFLX,DX, &
6156 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
6157 KARMAN,EOMEG,STBOLT, &
6158 P1000, &
6159 ids,ide, jds,jde, kds,kde, &
6160 ims,ime, jms,jme, kms,kme, &
6161 its,ite, jts,jte, kts,kte, & ! 0
6162 ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd,&
6163 shalwater_z0,water_depth,shalwater_depth, &
6164 scm_force_flux )
6165 !
6166 DO j = JTS , JTE
6167 DO i = ITS, ITE
6168 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and.( XICE(i,j) .LE. 1.0 ) ) THEN
6169 ! weighted average for sea ice points
6170 br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
6171 ! CHS2 -- wait
6172 ! CHS -- wait
6173 ! CPM -- wait
6174 ! CQS2 -- wait
6175 ! FLHC -- wait
6176 ! FLQC -- wait
6177 gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
6178 ! HFX -- wait
6179 ! LH -- wait
6180 mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
6181 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
6182 psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
6183 fh(i,j) = ( fh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * fh_sea(i,j) )
6184 fm(i,j) = ( fm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * fm_sea(i,j) )
6185 ! QFX -- wait
6186 ! QGH -- wait
6187 if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
6188 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
6189 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
6190 wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
6191 zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
6192 ! INTENT(OUT) --------------------------------------------------------------------
6193 IF ( PRESENT ( CD ) ) THEN
6194 CD(i,j) = ( CD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CD_sea(i,j) )
6195 ENDIF
6196 IF ( PRESENT ( CDA ) ) THEN
6197 CDA(i,j) = ( CDA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CDA_sea(i,j) )
6198 ENDIF
6199 IF ( PRESENT ( CK ) ) THEN
6200 CK(i,j) = ( CK(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CK_sea(i,j) )
6201 ENDIF
6202 IF ( PRESENT ( CKA ) ) THEN
6203 CKA(i,j) = ( CKA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CKA_sea(i,j) )
6204 ENDIF
6205 q2(i,j) = ( q2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j) )
6206 ! QSFC -- wait
6207 t2(i,j) = ( t2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j) )
6208 th2(i,j) = ( th2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j) )
6209 u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
6210 IF ( PRESENT ( USTM ) ) THEN
6211 USTM(i,j) = ( USTM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * USTM_sea(i,j) )
6212 ENDIF
6213 v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
6214 ENDIF
6215 END DO
6216 END DO
6217 !
6218 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
6219 !
6220 END SUBROUTINE sfclayrev_seaice_wrapper
6222 !-------------------------------------------------------------------------
6224 SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w, &
6225 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
6226 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
6227 FM,FH, &
6228 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
6229 U10,V10,TH2,T2,Q2, &
6230 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
6231 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
6232 KARMAN,EOMEG,STBOLT, &
6233 P1000, &
6234 XICE,SST,TSK_SEA, &
6235 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
6236 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA, &
6237 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD, &
6238 ids,ide, jds,jde, kds,kde, &
6239 ims,ime, jms,jme, kms,kme, &
6240 its,ite, jts,jte, kts,kte, &
6241 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd, &
6242 scm_force_flux,sf_surface_physics )
6244 USE module_sf_sfclay
6245 implicit none
6247 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
6248 ims,ime, jms,jme, kms,kme, &
6249 its,ite, jts,jte, kts,kte
6251 INTEGER, INTENT(IN ) :: ISFFLX
6252 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
6253 REAL, INTENT(IN ) :: EP1,EP2,KARMAN,EOMEG,STBOLT
6254 REAL, INTENT(IN ) :: P1000
6256 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
6257 INTENT(IN ) :: dz8w
6259 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
6260 INTENT(IN ) :: QV3D, &
6261 P3D, &
6262 T3D
6264 REAL, DIMENSION( ims:ime, jms:jme ) , &
6265 INTENT(IN ) :: MAVAIL, &
6266 PBLH, &
6267 XLAND, &
6268 TSK
6269 REAL, DIMENSION( ims:ime, jms:jme ) , &
6270 INTENT(OUT ) :: U10, &
6271 V10, &
6272 TH2, &
6273 T2, &
6274 Q2, &
6275 QSFC
6276 REAL, DIMENSION( ims:ime, jms:jme ) , &
6277 INTENT(INOUT) :: REGIME, &
6278 HFX, &
6279 QFX, &
6280 LH, &
6281 MOL,RMOL
6283 REAL, DIMENSION( ims:ime, jms:jme ) , &
6284 INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
6285 PSIM,PSIH,FM,FH
6287 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
6288 INTENT(IN ) :: U3D, &
6289 V3D
6291 REAL, DIMENSION( ims:ime, jms:jme ) , &
6292 INTENT(IN ) :: PSFC
6294 REAL, DIMENSION( ims:ime, jms:jme ) , &
6295 INTENT(INOUT) :: ZNT, &
6296 ZOL, &
6297 UST, &
6298 CPM, &
6299 CHS2, &
6300 CQS2, &
6301 CHS
6303 REAL, DIMENSION( ims:ime, jms:jme ) , &
6304 INTENT(INOUT) :: FLHC,FLQC
6306 REAL, DIMENSION( ims:ime, jms:jme ) , &
6307 INTENT(INOUT) :: &
6308 QGH
6310 REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV
6311 REAL, DIMENSION( ims:ime, jms:jme ) , &
6312 INTENT(IN) :: DX
6314 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
6315 INTENT(OUT) :: ck,cka,cd,cda
6316 REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ) , &
6317 INTENT(INOUT) :: ustm
6319 INTEGER, OPTIONAL, INTENT(IN ) :: ISFTCFLX,IZ0TLND
6320 INTEGER, OPTIONAL, INTENT(IN ) :: SCM_FORCE_FLUX
6322 !--------------------------------------------------------------------
6323 ! New for wrapper
6324 !--------------------------------------------------------------------
6325 INTEGER, INTENT(IN) :: ITIMESTEP, sf_surface_physics
6326 LOGICAL, INTENT(IN) :: TICE2TSK_IF2COLD
6327 REAL, INTENT(IN) :: XICE_THRESHOLD
6328 REAL, DIMENSION( ims:ime, jms:jme ), &
6329 INTENT(IN) :: XICE
6330 REAL, DIMENSION( ims:ime, jms:jme ), &
6331 INTENT(INOUT) :: SST
6332 REAL, DIMENSION( ims:ime, jms:jme ), &
6333 INTENT(OUT) :: TSK_SEA, &
6334 CHS2_SEA, &
6335 CHS_SEA, &
6336 CPM_SEA, &
6337 CQS2_SEA, &
6338 FLHC_SEA, &
6339 FLQC_SEA, &
6340 HFX_SEA, &
6341 LH_SEA, &
6342 QFX_SEA, &
6343 QGH_SEA, &
6344 QSFC_SEA, &
6345 ZNT_SEA
6347 !--------------------------------------------------------------------
6348 ! Local
6349 !--------------------------------------------------------------------
6350 INTEGER :: I, J
6351 REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
6352 MAVAIL_sea, &
6353 TSK_LOCAL, &
6354 BR_HOLD, &
6355 CHS2_HOLD, &
6356 CHS_HOLD, &
6357 CPM_HOLD, &
6358 CQS2_HOLD, &
6359 FLHC_HOLD, &
6360 FLQC_HOLD, &
6361 GZ1OZ0_HOLD, &
6362 HFX_HOLD, &
6363 LH_HOLD, &
6364 MOL_HOLD, &
6365 PSIH_HOLD, &
6366 PSIM_HOLD, &
6367 FH_HOLD, &
6368 FM_HOLD, &
6369 QFX_HOLD, &
6370 QGH_HOLD, &
6371 REGIME_HOLD, &
6372 RMOL_HOLD, &
6373 UST_HOLD, &
6374 WSPD_HOLD, &
6375 ZNT_HOLD, &
6376 ZOL_HOLD, &
6377 QSFC_HOLD, &
6378 TH2_HOLD, & !ssib
6379 T2_HOLD, & !ssib
6380 Q2_HOLD, & !ssib
6381 TSK_HOLD, & !ssib
6382 U10_HOLD, & !ssib
6383 V10_HOLD, & !ssib
6384 CD_SEA, &
6385 CDA_SEA, &
6386 CK_SEA, &
6387 CKA_SEA, &
6388 Q2_SEA, &
6389 T2_SEA, &
6390 TH2_SEA, &
6391 U10_SEA, &
6392 USTM_SEA, &
6393 V10_SEA
6395 REAL, DIMENSION( ims:ime, jms:jme ) :: &
6396 BR_SEA, &
6397 GZ1OZ0_SEA, &
6398 MOL_SEA, &
6399 PSIH_SEA, &
6400 PSIM_SEA, &
6401 FH_SEA, &
6402 FM_SEA, &
6403 REGIME_SEA, &
6404 RMOL_SEA, &
6405 UST_SEA, &
6406 WSPD_SEA, &
6407 ZOL_SEA
6409 ! INTENT(IN) to SFCLAY; unchanged by the call
6410 ! ISFFLX
6411 ! SVP1,SVP2,SVP3,SVPT0
6412 ! EP1,EP2,KARMAN,EOMEG,STBOLT
6413 ! CP,G,ROVCP,R,XLV,DX
6414 ! ISFTCFLX,IZ0TLND
6415 ! P1000
6416 ! dz8w
6417 ! QV3D
6418 ! P3D
6419 ! T3D
6420 ! MAVAIL
6421 ! PBLH
6422 ! XLAND
6423 ! TSK
6424 ! U3D
6425 ! V3D
6426 ! PSFC
6428 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
6429 itimestep, .true., tice2tsk_if2cold, &
6430 XICE, XICE_THRESHOLD, &
6431 SST, TSK, TSK_SEA, TSK_LOCAL )
6434 ! INTENT (INOUT) to SFCLAY: Save the variables before the first call
6435 ! (for land/frozen water) to SFCLAY, to keep from double-counting the
6436 ! effects of that routine
6437 BR_HOLD(its:ite,jts:jte) = BR(its:ite,jts:jte)
6438 CHS2_HOLD(its:ite,jts:jte) = CHS2(its:ite,jts:jte)
6439 CHS_HOLD(its:ite,jts:jte) = CHS(its:ite,jts:jte)
6440 CPM_HOLD(its:ite,jts:jte) = CPM(its:ite,jts:jte)
6441 CQS2_HOLD(its:ite,jts:jte) = CQS2(its:ite,jts:jte)
6442 FLHC_HOLD(its:ite,jts:jte) = FLHC(its:ite,jts:jte)
6443 FLQC_HOLD(its:ite,jts:jte) = FLQC(its:ite,jts:jte)
6444 GZ1OZ0_HOLD(its:ite,jts:jte) = GZ1OZ0(its:ite,jts:jte)
6445 HFX_HOLD(its:ite,jts:jte) = HFX(its:ite,jts:jte)
6446 LH_HOLD(its:ite,jts:jte) = LH(its:ite,jts:jte)
6447 MOL_HOLD(its:ite,jts:jte) = MOL(its:ite,jts:jte)
6448 PSIH_HOLD(its:ite,jts:jte) = PSIH(its:ite,jts:jte)
6449 PSIM_HOLD(its:ite,jts:jte) = PSIM(its:ite,jts:jte)
6450 FH_HOLD(its:ite,jts:jte) = FH(its:ite,jts:jte)
6451 FM_HOLD(its:ite,jts:jte) = FM(its:ite,jts:jte)
6452 QFX_HOLD(its:ite,jts:jte) = QFX(its:ite,jts:jte)
6453 QGH_HOLD(its:ite,jts:jte) = QGH(its:ite,jts:jte)
6454 REGIME_HOLD(its:ite,jts:jte) = REGIME(its:ite,jts:jte)
6455 RMOL_HOLD(its:ite,jts:jte) = RMOL(its:ite,jts:jte)
6456 UST_HOLD(its:ite,jts:jte) = UST(its:ite,jts:jte)
6457 WSPD_HOLD(its:ite,jts:jte) = WSPD(its:ite,jts:jte)
6458 ZNT_HOLD(its:ite,jts:jte) = ZNT(its:ite,jts:jte)
6459 ZOL_HOLD(its:ite,jts:jte) = ZOL(its:ite,jts:jte)
6460 QSFC_HOLD(its:ite,jts:jte) = QSFC(its:ite,jts:jte)
6461 !also save these variables for SSIB (fds 12/2010)
6462 TH2_HOLD(its:ite,jts:jte) = TH2(its:ite,jts:jte)
6463 T2_HOLD(its:ite,jts:jte) = T2(its:ite,jts:jte)
6464 Q2_HOLD(its:ite,jts:jte) = Q2(its:ite,jts:jte)
6465 TSK_HOLD(its:ite,jts:jte) = TSK(its:ite,jts:jte)
6466 U10_HOLD(its:ite,jts:jte) = U10(its:ite,jts:jte) !fds (01/2014)
6467 V10_HOLD(its:ite,jts:jte) = V10(its:ite,jts:jte) !fds (01/2014)
6469 ! INTENT(OUT) from SFCLAY. Input shouldn't matter, but we'll want to
6470 ! keep things around for weighting after the second call to SFCLAY.
6471 ! CD
6472 ! CDA
6473 ! CK
6474 ! CKA
6475 ! Q2
6476 ! QSFC
6477 ! T2
6478 ! TH2
6479 ! U10
6480 ! USTM
6481 ! V10
6484 ! land/frozen-water call
6485 call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
6486 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, & ! I,I,I,I,I,I,IO,IO,IO,IO,
6487 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
6488 FM,FH, &
6489 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
6490 U10,V10,TH2,T2,Q2, &
6491 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
6492 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
6493 KARMAN,EOMEG,STBOLT, &
6494 P1000, &
6495 ids,ide, jds,jde, kds,kde, &
6496 ims,ime, jms,jme, kms,kme, &
6497 its,ite, jts,jte, kts,kte, &
6498 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux)
6499 !
6500 !Restore land-point values calculated by SSiB (fds 12/2010)
6501 IF (itimestep .gt. 1 .and. sf_surface_physics .EQ. 8) then
6502 DO j = JTS , JTE
6503 DO i = ITS, ITE
6504 IF ( XLAND(I,J) .LT. 1.5 ) THEN
6505 BR(I,J) = BR_HOLD(I,J)
6506 TH2(I,J) = TH2_HOLD(I,J)
6507 T2(I,J) = T2_HOLD(I,J)
6508 Q2(I,J) = Q2_HOLD(I,J)
6509 HFX(I,J) = HFX_HOLD(I,J)
6510 QFX(I,J) = QFX_HOLD(I,J)
6511 LH(I,J) = LH_HOLD(I,J)
6512 GZ1OZ0(I,J) = GZ1OZ0_HOLD(I,J)
6513 WSPD(I,J) = WSPD_HOLD(I,J)
6514 ZNT(I,J) = ZNT_HOLD(I,J)
6515 UST(I,J) = UST_HOLD(I,J)
6516 ! TSK(I,J) = TSK_HOLD(I,J)
6517 U10(I,J) = U10_HOLD(I,J) !fds (01/2014)
6518 V10(I,J) = V10_HOLD(I,J) !fds (01/2014)
6519 ENDIF
6520 ENDDO
6521 ENDDO
6522 ENDIF
6523 !
6524 ! Set up for open-water call
6525 DO j = JTS , JTE
6526 DO i = ITS , ITE
6527 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
6528 XLAND_SEA(i,j)=2.
6529 MAVAIL_SEA(I,J) =1.
6530 ZNT_SEA(I,J) = 0.0001
6531 TSK_SEA(i,j) = SST(i,j)
6532 IF ( SST(i,j) .LT. 271.4 ) THEN
6533 SST(i,j) = 271.4
6534 TSK_SEA(i,j) = SST(i,j)
6535 ENDIF
6536 ELSE
6537 XLAND_SEA(i,j) = XLAND(i,j)
6538 MAVAIL_SEA(i,j) = MAVAIL(i,j)
6539 ZNT_SEA(i,j) = ZNT_HOLD(i,j)
6540 TSK_SEA(i,j) = TSK_LOCAL(i,j)
6541 ENDIF
6542 ENDDO
6543 ENDDO
6545 ! Restore the values from before the land/frozen-water call
6546 BR_SEA(its:ite,jts:jte) = BR_HOLD(its:ite,jts:jte)
6547 CHS2_SEA(its:ite,jts:jte) = CHS2_HOLD(its:ite,jts:jte)
6548 CHS_SEA(its:ite,jts:jte) = CHS_HOLD(its:ite,jts:jte)
6549 CPM_SEA(its:ite,jts:jte) = CPM_HOLD(its:ite,jts:jte)
6550 CQS2_SEA(its:ite,jts:jte) = CQS2_HOLD(its:ite,jts:jte)
6551 FLHC_SEA(its:ite,jts:jte) = FLHC_HOLD(its:ite,jts:jte)
6552 FLQC_SEA(its:ite,jts:jte) = FLQC_HOLD(its:ite,jts:jte)
6553 GZ1OZ0_SEA(its:ite,jts:jte) = GZ1OZ0_HOLD(its:ite,jts:jte)
6554 HFX_SEA(its:ite,jts:jte) = HFX_HOLD(its:ite,jts:jte)
6555 LH_SEA(its:ite,jts:jte) = LH_HOLD(its:ite,jts:jte)
6556 MOL_SEA(its:ite,jts:jte) = MOL_HOLD(its:ite,jts:jte)
6557 PSIH_SEA(its:ite,jts:jte) = PSIH_HOLD(its:ite,jts:jte)
6558 PSIM_SEA(its:ite,jts:jte) = PSIM_HOLD(its:ite,jts:jte)
6559 FH_SEA(its:ite,jts:jte) = FH_HOLD(its:ite,jts:jte)
6560 FM_SEA(its:ite,jts:jte) = FM_HOLD(its:ite,jts:jte)
6561 QFX_SEA(its:ite,jts:jte) = QFX_HOLD(its:ite,jts:jte)
6562 QGH_SEA(its:ite,jts:jte) = QGH_HOLD(its:ite,jts:jte)
6563 REGIME_SEA(its:ite,jts:jte) = REGIME_HOLD(its:ite,jts:jte)
6564 RMOL_SEA(its:ite,jts:jte) = RMOL_HOLD(its:ite,jts:jte)
6565 UST_SEA(its:ite,jts:jte) = UST_HOLD(its:ite,jts:jte)
6566 WSPD_SEA(its:ite,jts:jte) = WSPD_HOLD(its:ite,jts:jte)
6567 ZOL_SEA(its:ite,jts:jte) = ZOL_HOLD(its:ite,jts:jte)
6568 ZNT_SEA(its:ite,jts:jte) = ZNT_HOLD(its:ite,jts:jte)
6569 QSFC_SEA(its:ite,jts:jte) = QSFC_HOLD(its:ite,jts:jte)
6570 !
6571 ! open-water call
6572 call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w, & ! I
6573 CP,G,ROVCP,R,XLV,PSFC, & ! I
6574 CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, & ! I/O
6575 ZNT_SEA,UST_SEA, & ! I/O
6576 PBLH,MAVAIL_SEA, & ! I
6577 ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
6578 FM_SEA,FH_SEA, &
6579 XLAND_SEA, & ! I
6580 HFX_SEA,QFX_SEA,LH_SEA, & ! I/O
6581 TSK_SEA, & ! I
6582 FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA, & ! I/O
6583 U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea, & ! O
6584 GZ1OZ0_SEA,WSPD_SEA,BR_SEA, & ! I/O
6585 ISFFLX,DX, &
6586 SVP1,SVP2,SVP3,SVPT0,EP1,EP2, &
6587 KARMAN,EOMEG,STBOLT, &
6588 P1000, &
6589 ids,ide, jds,jde, kds,kde, &
6590 ims,ime, jms,jme, kms,kme, &
6591 its,ite, jts,jte, kts,kte, & ! 0
6592 ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd,scm_force_flux)
6593 !
6594 DO j = JTS , JTE
6595 DO i = ITS, ITE
6596 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and.( XICE(i,j) .LE. 1.0 ) ) THEN
6597 ! weighted average for sea ice points
6598 br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
6599 ! CHS2 -- wait
6600 ! CHS -- wait
6601 ! CPM -- wait
6602 ! CQS2 -- wait
6603 ! FLHC -- wait
6604 ! FLQC -- wait
6605 gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
6606 ! HFX -- wait
6607 ! LH -- wait
6608 mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
6609 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
6610 psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
6611 fh(i,j) = ( fh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * fh_sea(i,j) )
6612 fm(i,j) = ( fm(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * fm_sea(i,j) )
6613 ! QFX -- wait
6614 ! QGH -- wait
6615 if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
6616 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
6617 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
6618 wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
6619 zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
6620 ! INTENT(OUT) --------------------------------------------------------------------
6621 IF ( PRESENT ( CD ) ) THEN
6622 CD(i,j) = ( CD(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CD_sea(i,j) )
6623 ENDIF
6624 IF ( PRESENT ( CDA ) ) THEN
6625 CDA(i,j) = ( CDA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CDA_sea(i,j) )
6626 ENDIF
6627 IF ( PRESENT ( CK ) ) THEN
6628 CK(i,j) = ( CK(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CK_sea(i,j) )
6629 ENDIF
6630 IF ( PRESENT ( CKA ) ) THEN
6631 CKA(i,j) = ( CKA(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CKA_sea(i,j) )
6632 ENDIF
6633 q2(i,j) = ( q2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j) )
6634 ! QSFC -- wait
6635 t2(i,j) = ( t2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j) )
6636 th2(i,j) = ( th2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j) )
6637 u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
6638 IF ( PRESENT ( USTM ) ) THEN
6639 USTM(i,j) = ( USTM(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * USTM_sea(i,j) )
6640 ENDIF
6641 v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
6642 ENDIF
6643 END DO
6644 END DO
6645 !
6646 ! tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
6647 !
6648 END SUBROUTINE sfclay_seaice_wrapper
6650 !-------------------------------------------------------------------------
6651 !-------------------------------------------------------------------------
6653 SUBROUTINE pxsfclay_seaice_wrapper(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
6654 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
6655 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
6656 XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
6657 U10,V10, &
6658 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
6659 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, &
6660 XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
6661 CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, FLHC_SEA, FLQC_SEA, &
6662 HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA, &
6663 ids,ide, jds,jde, kds,kde, &
6664 ims,ime, jms,jme, kms,kme, &
6665 its,ite, jts,jte, kts,kte )
6666 USE module_sf_pxsfclay
6667 implicit none
6668 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
6669 ims,ime, jms,jme, kms,kme, &
6670 its,ite, jts,jte, kts,kte
6672 INTEGER, INTENT(IN ) :: ISFFLX
6673 LOGICAL, INTENT(IN ) :: TICE2TSK_IF2COLD
6674 REAL, INTENT(IN ) :: SVP1,SVP2,SVP3,SVPT0
6675 REAL, INTENT(IN ) :: EP1,EP2,KARMAN
6677 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
6678 INTENT(IN ) :: dz8w
6680 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
6681 INTENT(IN ) :: QV3D, &
6682 P3D, &
6683 T3D, &
6684 TH3D
6686 REAL, DIMENSION( ims:ime, jms:jme ) , &
6687 INTENT(IN ) :: MAVAIL, &
6688 PBLH, &
6689 XLAND, &
6690 TSK
6691 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
6692 INTENT(IN ) :: U3D, &
6693 V3D
6695 REAL, DIMENSION( ims:ime, jms:jme ) , &
6696 INTENT(IN ) :: PSFC
6698 REAL, INTENT(IN ) :: CP,G,ROVCP,R,XLV,DX
6700 REAL, DIMENSION( ims:ime, jms:jme ) , &
6701 INTENT(OUT ) :: U10, &
6702 V10, &
6703 QSFC
6704 REAL, DIMENSION( ims:ime, jms:jme ) , &
6705 INTENT(INOUT) :: REGIME, &
6706 HFX, &
6707 QFX, &
6708 LH, &
6709 MOL,RMOL
6710 REAL, DIMENSION( ims:ime, jms:jme ) , &
6711 INTENT(INOUT) :: GZ1OZ0,WSPD,BR, &
6712 PSIM,PSIH
6714 REAL, DIMENSION( ims:ime, jms:jme ) , &
6715 INTENT(INOUT) :: ZNT, &
6716 ZOL, &
6717 UST, &
6718 CPM, &
6719 CHS2, &
6720 CQS2, &
6721 CHS
6723 REAL, DIMENSION( ims:ime, jms:jme ) , &
6724 INTENT(INOUT) :: FLHC,FLQC
6726 REAL, DIMENSION( ims:ime, jms:jme ) , &
6727 INTENT(INOUT) :: QGH
6729 !--------------------------------------------------------------------
6730 ! For wrapper
6731 !--------------------------------------------------------------------
6733 INTEGER, INTENT(IN) :: ITIMESTEP
6734 REAL, INTENT(IN) :: XICE_THRESHOLD
6735 REAL, DIMENSION( ims:ime, jms:jme ) , &
6736 INTENT(IN) :: XICE
6737 REAL, DIMENSION( ims:ime, jms:jme ) , &
6738 INTENT(OUT) :: TSK_SEA
6739 REAL, DIMENSION( ims:ime, jms:jme ) , &
6740 INTENT(INOUT) :: SST
6742 !--------------------------------------------------------------------
6743 ! Local
6744 !--------------------------------------------------------------------
6745 INTEGER :: I, J
6746 REAL, DIMENSION( ims:ime, jms:jme ) , &
6747 INTENT(OUT) :: CHS_SEA, &
6748 CHS2_SEA, &
6749 CPM_SEA, &
6750 CQS2_SEA, &
6751 FLHC_SEA, &
6752 FLQC_SEA, &
6753 HFX_SEA, &
6754 LH_SEA, &
6755 QFX_SEA, &
6756 QGH_SEA, &
6757 QSFC_SEA
6759 REAL, DIMENSION( ims:ime, jms:jme ) :: BR_HOLD, &
6760 CHS_HOLD, &
6761 CHS2_HOLD, &
6762 CPM_HOLD, &
6763 CQS2_HOLD, &
6764 FLHC_HOLD, &
6765 FLQC_HOLD, &
6766 GZ1OZ0_HOLD, &
6767 HFX_HOLD, &
6768 LH_HOLD, &
6769 MOL_HOLD, &
6770 PSIH_HOLD, &
6771 PSIM_HOLD, &
6772 QFX_HOLD, &
6773 QGH_HOLD, &
6774 REGIME_HOLD, &
6775 RMOL_HOLD, &
6776 UST_HOLD, &
6777 WSPD_HOLD, &
6778 ZNT_HOLD, &
6779 ZOL_HOLD, &
6780 TSK_LOCAL
6782 REAL, DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA, &
6783 MAVAIL_SEA, &
6784 BR_SEA, &
6785 GZ1OZ0_SEA, &
6786 MOL_SEA, &
6787 PSIH_SEA, &
6788 PSIM_SEA, &
6789 REGIME_SEA, &
6790 RMOL_SEA, &
6791 UST_SEA, &
6792 WSPD_SEA, &
6793 ZNT_SEA, &
6794 ZOL_SEA, &
6795 U10_SEA, &
6796 V10_SEA
6798 CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte, &
6799 itimestep, .true., tice2tsk_if2cold, &
6800 XICE, XICE_THRESHOLD, &
6801 SST, TSK, TSK_SEA, TSK_LOCAL )
6802 !
6803 ! INTENT (INOUT) to PXSFCLAY: Save the variables before the first call
6804 ! (for land/frozen water) to SFCLAY, to keep from double-counting the
6805 ! effects of that routine
6806 !
6807 BR_HOLD(its:ite,jts:jte) = BR(its:ite,jts:jte)
6808 CHS_HOLD(its:ite,jts:jte) = CHS(its:ite,jts:jte)
6809 CHS2_HOLD(its:ite,jts:jte) = CHS2(its:ite,jts:jte)
6810 CPM_HOLD(its:ite,jts:jte) = CPM(its:ite,jts:jte)
6811 CQS2_HOLD(its:ite,jts:jte) = CQS2(its:ite,jts:jte)
6812 FLHC_HOLD(its:ite,jts:jte) = FLHC(its:ite,jts:jte)
6813 FLQC_HOLD(its:ite,jts:jte) = FLQC(its:ite,jts:jte)
6814 GZ1OZ0_HOLD(its:ite,jts:jte) = GZ1OZ0(its:ite,jts:jte)
6815 HFX_HOLD(its:ite,jts:jte) = HFX(its:ite,jts:jte)
6816 LH_HOLD(its:ite,jts:jte) = LH(its:ite,jts:jte)
6817 MOL_HOLD(its:ite,jts:jte) = MOL(its:ite,jts:jte)
6818 PSIH_HOLD(its:ite,jts:jte) = PSIH(its:ite,jts:jte)
6819 PSIM_HOLD(its:ite,jts:jte) = PSIM(its:ite,jts:jte)
6820 QFX_HOLD(its:ite,jts:jte) = QFX(its:ite,jts:jte)
6821 QGH_HOLD(its:ite,jts:jte) = QGH(its:ite,jts:jte)
6822 REGIME_HOLD(its:ite,jts:jte) = REGIME(its:ite,jts:jte)
6823 RMOL_HOLD(its:ite,jts:jte) = RMOL(its:ite,jts:jte)
6824 UST_HOLD(its:ite,jts:jte) = UST(its:ite,jts:jte)
6825 WSPD_HOLD(its:ite,jts:jte) = WSPD(its:ite,jts:jte)
6826 ZNT_HOLD(its:ite,jts:jte) = ZNT(its:ite,jts:jte)
6827 ZOL_HOLD(its:ite,jts:jte) = ZOL(its:ite,jts:jte)
6829 ! INTENT(OUT) from PXSFCLAY. Input shouldn't matter, but we'll want to
6830 ! keep things around for weighting after the second call to PXSFCLAY.
6831 ! U10
6832 ! V10
6833 ! QSFC
6835 ! Land/frozen-water call.
6836 CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
6837 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM, &
6838 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
6839 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
6840 U10,V10, &
6841 GZ1OZ0,WSPD,BR,ISFFLX,DX, &
6842 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,ITIMESTEP,&
6843 ids,ide, jds,jde, kds,kde, &
6844 ims,ime, jms,jme, kms,kme, &
6845 its,ite, jts,jte, kts,kte )
6847 DO j = JTS , JTE
6848 DO i= ITS , ITE
6849 IF( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
6850 ! Sets up things for open ocean.
6851 XLAND_SEA(i,j)=2.
6852 MAVAIL_SEA(I,J) =1.
6853 ZNT_SEA(I,J) = 0.0001
6854 TSK_SEA(i,j) = SST(i,j)
6855 if ( SST(i,j) .LT. 271.4 ) then
6856 SST(i,j) = 271.4
6857 TSK_SEA(i,j) = SST(i,j)
6858 endif
6859 ELSE
6860 XLAND_SEA(i,j)=xland(i,j)
6861 MAVAIL_SEA(i,j) = mavail(i,j)
6862 ZNT_SEA(I,J) = ZNT_HOLD(I,J)
6863 TSK_SEA(i,j) = TSK(i,j)
6864 ENDIF
6865 ENDDO
6866 ENDDO
6868 ! INTENT(INOUT) variables held over from before the first call to PXSFCLAY:
6869 BR_SEA(its:ite,jts:jte) = BR_HOLD(its:ite,jts:jte)
6870 CHS_SEA(its:ite,jts:jte) = CHS_HOLD(its:ite,jts:jte)
6871 CHS2_SEA(its:ite,jts:jte) = CHS2_HOLD(its:ite,jts:jte)
6872 CPM_SEA(its:ite,jts:jte) = CPM_HOLD(its:ite,jts:jte)
6873 CQS2_SEA(its:ite,jts:jte) = CQS2_HOLD(its:ite,jts:jte)
6874 FLHC_SEA(its:ite,jts:jte) = FLHC_HOLD(its:ite,jts:jte)
6875 FLQC_SEA(its:ite,jts:jte) = FLQC_HOLD(its:ite,jts:jte)
6876 GZ1OZ0_SEA(its:ite,jts:jte) = GZ1OZ0_HOLD(its:ite,jts:jte)
6877 HFX_SEA(its:ite,jts:jte) = HFX_HOLD(its:ite,jts:jte)
6878 LH_SEA(its:ite,jts:jte) = LH_HOLD(its:ite,jts:jte)
6879 MOL_SEA(its:ite,jts:jte) = MOL_HOLD(its:ite,jts:jte)
6880 PSIH_SEA(its:ite,jts:jte) = PSIH_HOLD(its:ite,jts:jte)
6881 PSIM_SEA(its:ite,jts:jte) = PSIM_HOLD(its:ite,jts:jte)
6882 QFX_SEA(its:ite,jts:jte) = QFX_HOLD(its:ite,jts:jte)
6883 QGH_SEA(its:ite,jts:jte) = QGH_HOLD(its:ite,jts:jte)
6884 REGIME_SEA(its:ite,jts:jte) = REGIME_HOLD(its:ite,jts:jte)
6885 RMOL_SEA(its:ite,jts:jte) = RMOL_HOLD(its:ite,jts:jte)
6886 UST_SEA(its:ite,jts:jte) = UST_HOLD(its:ite,jts:jte)
6887 WSPD_SEA(its:ite,jts:jte) = WSPD_HOLD(its:ite,jts:jte)
6888 ZOL_SEA(its:ite,jts:jte) = ZOL_HOLD(its:ite,jts:jte)
6890 ! Open-water call.
6891 ! Variables newly set (INTENT(OUT)) or changed (INTENT(INOUT)) by
6892 ! PXSFCLAY are here appended with the "_SEA" label.
6893 ! Special intent(IN) variables here: XLAND_SEA, MAVAIL_SEA, TSK_SEA
6894 CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
6895 CP,G,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA, &
6896 ZNT_SEA,UST_SEA,PBLH,MAVAIL_SEA,ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, &
6897 XLAND_SEA,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_SEA,RMOL_SEA, &
6898 U10_SEA,V10_SEA, &
6899 GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX,DX, &
6900 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,ITIMESTEP,&
6901 ids,ide, jds,jde, kds,kde, &
6902 ims,ime, jms,jme, kms,kme, &
6903 its,ite, jts,jte, kts,kte )
6905 DO j = JTS , JTE
6906 DO i = ITS , ITE
6907 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
6908 ! INTENT (INOUT) for PXSFCLAY:
6909 br(i,j) = ( br(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j) )
6910 gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
6911 mol(i,j) = ( mol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j) )
6912 psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j) )
6913 psim(i,j) = ( psim(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j) )
6914 rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j) )
6915 ust(i,j) = ( ust(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j) )
6916 wspd(i,j) = ( wspd(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j) )
6917 zol(i,j) = ( zol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j) )
6918 ! REGIME: Special case for this variable. Just take the land values.
6919 ! CHS -- wait
6920 ! CHS2 -- wait
6921 ! CPM -- wait
6922 ! CQS2 -- wait
6923 ! FLHC -- wait
6924 ! FLQC -- wait
6925 ! HFX -- wait
6926 ! LH -- wait
6927 ! QFX -- wait
6928 ! QGH -- wait
6930 ! INTENT (OUT) from PXSFCLAY:
6931 u10(i,j) = ( u10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j) )
6932 v10(i,j) = ( v10(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j) )
6933 ! QSFC -- wait
6934 ENDIF
6935 ENDDO
6936 ENDDO
6938 END SUBROUTINE pxsfclay_seaice_wrapper
6940 !-------------------------------------------------------------------------
6942 SUBROUTINE TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN, &
6943 shadowmask, diffuse_frac, &
6944 declin, &
6945 SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang2d, &
6946 slope_in,slp_azi_in, &
6947 ids, ide, jds, jde, kds, kde, &
6948 ims, ime, jms, jme, kms, kme, &
6949 its, ite, jts, jte, kts, kte )
6950 !------------------------------------------------------------------
6951 IMPLICIT NONE
6952 !------------------------------------------------------------------
6953 INTEGER, INTENT(IN) :: its,ite,jts,jte,kts,kte, &
6954 ims,ime,jms,jme,kms,kme, &
6955 ids,ide,jds,jde,kds,kde
6956 INTEGER, DIMENSION( ims:ime, jms:jme ), &
6957 INTENT(IN) :: shadowmask
6958 REAL, DIMENSION( ims:ime, jms:jme ), &
6959 INTENT(IN) :: diffuse_frac
6960 REAL, DIMENSION( ims:ime, jms:jme ), &
6961 INTENT(IN ) :: XLAT,XLONG
6962 REAL, DIMENSION( ims:ime, jms:jme ), &
6963 INTENT(INOUT) :: SWDOWN,GSW,SWNORM,GSWSAVE
6964 real,intent(in) :: solcon
6965 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: hrang2d,coszen
6968 REAL, INTENT(IN ) :: declin
6969 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: slope_in,slp_azi_in
6972 ! LOCAL VARS
6973 integer :: i,j
6974 real :: pi,degrad
6975 integer :: shadow
6976 real :: swdown_teradj,swdown_in,xlat1,xlong1
6978 !------------------------------------------------------------------
6980 pi = 4.*atan(1.)
6981 degrad=pi/180.
6983 DO J=jts,jte
6984 DO I=its,ite
6985 SWNORM(i,j) = SWDOWN(i,j) ! save
6986 IF(SWDOWN(I,J) .GT. 1.E-3)THEN ! daytime
6987 shadow = shadowmask(i,j)
6989 SWDOWN_IN = SWDOWN(i,j)
6990 XLAT1 = XLAT(i,j)
6991 XLONG1 = XLONG(i,j)
6992 CALL TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN(i,j), &
6993 diffuse_frac(i,j),DECLIN,DEGRAD, &
6994 SWDOWN_IN,solcon,hrang2d(i,j),SWDOWN_teradj, &
6995 kts,kte, &
6996 slope_in(i,j),slp_azi_in(i,j), &
6997 shadow , i,j &
6998 )
7000 GSWSAVE(I,J) = GSW(I,J) ! save
7001 GSW(I,J) = GSW(I,J)*SWDOWN_teradj/SWDOWN(i,j)
7002 SWDOWN(i,j) = SWDOWN_teradj
7004 ENDIF ! daytime
7005 ENDDO ! i_loop
7006 ENDDO ! j_loop
7009 END SUBROUTINE TOPO_RAD_ADJ_DRVR
7010 !------------------------------------------------------------------
7011 !------------------------------------------------------------------
7012 SUBROUTINE TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN, &
7013 diffuse_frac_in,DECLIN,DEGRAD, &
7014 SWDOWN_IN,solcon,hrang,SWDOWN_teradj, &
7015 kts,kte, &
7016 slope,slp_azi, &
7017 shadow &
7018 ,i,j)
7020 !------------------------------------------------------------------
7021 IMPLICIT NONE
7022 !------------------------------------------------------------------
7023 INTEGER, INTENT(IN) :: kts,kte
7024 REAL, INTENT(IN) :: COSZEN,DECLIN, &
7025 XLAT1,XLONG1,DEGRAD
7026 REAL, INTENT(IN) :: SWDOWN_IN,solcon,hrang
7027 INTEGER, INTENT(IN) :: shadow
7028 REAL, INTENT(IN) :: slp_azi,slope
7029 REAL, INTENT(IN) :: diffuse_frac_in
7031 REAL, INTENT(OUT) :: SWDOWN_teradj
7033 ! LOCAL VARS
7034 REAL :: XT24,TLOCTM,CSZA,XXLAT
7035 REAL :: diffuse_frac,corr_fac,csza_slp
7036 integer :: i,j
7039 !------------------------------------------------------------------
7041 SWDOWN_teradj=SWDOWN_IN
7043 CSZA=COSZEN
7044 XXLAT=XLAT1*DEGRAD
7046 ! RETURN IF NIGHT
7047 IF(CSZA.LE.1.E-4) return
7049 ! Parameterize diffuse fraction of global solar radiation as a function of the ratio
7050 ! between TOA radiation and surface global radiation
7051 ! diffuse_frac = min(1.,1./(max(0.1,2.1-2.8*log(log(csza*solcon/max(SWDOWN_IN,1.e-3))))))
7052 diffuse_frac = diffuse_frac_in
7053 if ((slope.eq.0).or.(diffuse_frac.eq.1).or.(csza.le.1.e-4)) then
7054 ! no topographic effects when all radiation diffuse or sun too close to horizon
7055 corr_fac = 1
7056 if(shadow.eq.1) corr_fac = diffuse_frac
7057 goto 140
7058 endif
7060 ! cosine of zenith angle over sloping topography
7061 csza_slp = ((SIN(XXLAT)*COS(HRANG))* &
7062 (-cos(slp_azi)*sin(slope))-SIN(HRANG)*(sin(slp_azi)*sin(slope))+ &
7063 (COS(XXLAT)*COS(HRANG))*cos(slope))* &
7064 COS(DECLIN)+(COS(XXLAT)*(cos(slp_azi)*sin(slope))+ &
7065 SIN(XXLAT)*cos(slope))*SIN(DECLIN)
7066 IF(csza_slp.LE.1.E-4) csza_slp = 0
7068 ! Topographic shading
7069 if (shadow.eq.1) csza_slp = 0
7071 ! Correction factor for sloping topography; the diffuse fraction of solar radiation
7072 ! is assumed to be unaffected by the slope
7073 corr_fac = diffuse_frac + (1-diffuse_frac)*csza_slp/csza
7075 140 continue
7077 SWDOWN_teradj=(1.)*SWDOWN_IN*corr_fac
7079 END SUBROUTINE TOPO_RAD_ADJ
7081 !=======================================================================
7083 SUBROUTINE get_local_ice_tsk ( ims, ime, jms, jme, &
7084 its, ite, jts, jte, &
7085 itimestep, &
7086 sfc_layer_values, &
7087 tice2tsk_if2cold, &
7088 XICE, XICE_THRESHOLD, &
7089 SST, TSK, TSK_SEA, TSK_ICE )
7090 !<DESCRIPTION>
7091 !
7092 ! For grid cells with a fractional ice area, derive the ice surface
7093 ! temperature from the area-averaged surface temperature (the blended
7094 ! result of the open-water values (SST) and the ice-covered value).
7095 !
7096 !</DESCRIPTION>
7098 IMPLICIT NONE
7100 INTEGER, INTENT(IN) :: ims, ime, jms, jme !-- start/end index for i/j in memory
7101 INTEGER, INTENT(IN) :: its, ite, jts, jte !-- start/end index for i/j in tile
7102 INTEGER, INTENT(IN) :: itimestep !-- timestep
7103 LOGICAL, INTENT(IN) :: sfc_layer_values !-- True if there are surface layer routine values
7104 !-- available from the ice portion of the grid point
7105 !-- (i.e. called from a seaice_wrapper subroutine)
7106 LOGICAL, INTENT(IN) :: tice2tsk_if2cold !-- True to set TSK_ICE to TSK. This may be
7107 !-- necessary to avoid unphysically low ice
7108 !-- temperatures is there is a mis-match between
7109 !-- ice fraction and surface temperature.
7111 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: XICE ! Ice fraction
7112 REAL , INTENT(IN) :: XICE_THRESHOLD
7113 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: TSK ! Surface temperature (K)
7114 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: SST ! Sea surface temperature (K)
7115 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: TSK_SEA ! Sfc temp of open water portion of grid cell
7116 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: TSK_ICE ! Sfc temp of ice oprtion of grid cell
7118 ! Local
7119 INTEGER :: i,j
7120 REAL :: TICE_MIN
7122 TICE_MIN = 221.4
7124 DO j = JTS , JTE
7125 DO i = ITS , ITE
7126 IF ( ( XICE(i,j) >= XICE_THRESHOLD ) .AND. ( XICE(I,J) <= 1.0 ) ) THEN
7128 IF ( SST(i,j) < 271.4 ) THEN
7129 SST(i,j) = 271.4
7130 ENDIF
7132 IF (sfc_layer_values) THEN
7133 IF ( SST(i,j) > 273. .AND. itimestep <= 3) then
7134 ! Why the dependence on the time step count, here?
7135 IF ( XICE(i,j) >= 0.6 ) THEN
7136 SST(i,j) = 271.4
7137 ELSEIF ( XICE(i,j) >= 0.4 ) THEN
7138 SST(i,j) = 273.
7139 ELSEIF (XICE(i,j) >= 0.2 .AND. SST(i,j) > 275.) THEN
7140 SST(i,j) = 275.
7141 ELSEIF (SST(i,j) > 278.) THEN
7142 SST(i,j) = 278.
7143 ENDIF
7144 ENDIF
7145 ENDIF
7146 TSK_SEA(i,j) = SST(i,j)
7148 IF ( tice2tsk_if2cold ) THEN
7149 !------------------------------------------------------------------------------------
7150 ! This avoids unphysically low ice temperatures for grid cells with low ice fractions
7151 ! and low area-averaged temperatures. This can happen when the initial ice fraction
7152 ! and surface temperature come from different data sets.
7153 !------------------------------------------------------------------------------------
7154 TSK_ICE(i,j) = MIN( TSK(i,j), 273.15 )
7155 ELSE
7156 TSK_ICE(i,j) = ( TSK(i,j) - (1.0-XICE(i,j)) * SST(i,j) ) / XICE(i,j)
7157 IF ( TSK_ICE(i,j) < TICE_MIN ) TSK_ICE(i,j) = TICE_MIN
7158 ENDIF
7160 IF ( ( XICE(i,j) < 0.2 ) .AND. ( TSK(i,j) < 253.15 ) ) THEN
7161 TSK_ICE(i,j) = 253.15
7162 ENDIF
7163 IF ( ( XICE(i,j) < 0.1 ) .AND. ( TSK(i,j) < 263.15 ) ) THEN
7164 TSK_ICE(i,j) = 263.15
7165 ENDIF
7166 ELSE
7167 ! land/open-water point
7168 TSK_SEA(i,j) = TSK(i,j)
7169 TSK_ICE(i,j) = TSK(i,j)
7170 ENDIF
7171 ENDDO
7172 ENDDO
7174 END SUBROUTINE get_local_ice_tsk
7176 !=======================================================================
7177 !=======================================================================
7179 subroutine Add_multi_perturb_lsm_perturbations (perts_qvapor, perts_th, perts_smois, perts_tsoil, &
7180 pert_noah_qv, pert_noah_t, pert_noah_smois, pert_noah_tslb, t_phy, qv_curr, tslb, smois, &
7181 tslb_tmp, smois_tmp, num_soil_layers, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
7183 implicit none
7185 integer, intent(in) :: its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte, num_soil_layers
7186 real, intent(in) :: pert_noah_qv, pert_noah_t, pert_noah_smois, pert_noah_tslb
7187 real, dimension(ims:ime, kms:kme, jms:jme), optional, intent (in) :: perts_qvapor, &
7188 perts_th, perts_smois, perts_tsoil
7189 real, dimension(ims:ime, kms:kme, jms:jme), intent (inout) :: t_phy, qv_curr
7190 real, dimension(ims:ime, 1:num_soil_layers, jms:jme), intent (inout) :: tslb, smois
7191 real, dimension (its:ite, 1:num_soil_layers, jts:jte), intent(out) :: tslb_tmp, smois_tmp
7193 integer :: i, j, k
7196 k = 1
7197 do j = jts, jte
7198 do i = its, ite
7199 qv_curr(i, k, j) = max (QVAPOR_MIN, (1.0 + perts_qvapor(i, k, j) * pert_noah_qv) * qv_curr(i, k, j))
7200 t_phy(i, k, j) = (1.0 + perts_th(i, k, j) * pert_noah_t) * t_phy(i, k, j)
7201 end do
7202 end do
7204 do j = jts, jte
7205 do k = 1, num_soil_layers
7206 do i = its, ite
7207 smois_tmp(i, k, j) = smois(i, k, j)
7208 smois(i, k, j) = min (SMOIS_MAX, max (SMOIS_MIN, (1.0 + perts_smois(i, k, j) * pert_noah_smois) * smois(i, k, j)))
7209 tslb_tmp(i, k, j) = tslb(i, k, j)
7210 tslb(i, k, j) = (1.0 + perts_tsoil(i, k, j) * pert_noah_tslb) * tslb(i, k, j)
7211 end do
7212 end do
7213 end do
7215 end subroutine Add_multi_perturb_lsm_perturbations
7217 subroutine Remove_multi_perturb_lsm_perturbations (perts_qvapor, perts_th, perts_smois, perts_tsoil, &
7218 pert_noah_qv, pert_noah_t, pert_noah_smois, pert_noah_tslb, t_phy, qv_curr, tslb, smois, &
7219 tslb_tmp, smois_tmp, num_soil_layers, its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte)
7221 implicit none
7223 integer, intent(in) :: its, ite, jts, jte, ims, ime, jms, jme, kms, kme, kts, kte, num_soil_layers
7224 real, intent(in) :: pert_noah_qv, pert_noah_t, pert_noah_smois, pert_noah_tslb
7225 real, dimension(ims:ime, kms:kme, jms:jme), optional, intent (in) :: perts_qvapor, &
7226 perts_th, perts_smois, perts_tsoil
7227 real, dimension(ims:ime, kms:kme, jms:jme), intent (inout) :: t_phy, qv_curr
7228 real, dimension(ims:ime, 1:num_soil_layers, jms:jme), intent (inout) :: tslb, smois
7229 real, dimension (its:ite, 1:num_soil_layers, jts:jte), intent(in) :: tslb_tmp, smois_tmp
7231 integer :: i, j, k
7234 k = 1
7235 do j = jts, jte
7236 do i = its, ite
7237 qv_curr(i, k, j) = max (QVAPOR_MIN, qv_curr(i, k, j) / (1.0 + perts_qvapor(i, k, j) * pert_noah_qv))
7238 t_phy(i, k, j) = t_phy(i, k, j) / (1.0 + perts_th(i, k, j) * pert_noah_t)
7239 end do
7240 end do
7242 do j = jts, jte
7243 do k = 1, num_soil_layers
7244 do i = its, ite
7245 smois(i, k, j) = min (SMOIS_MAX, max (SMOIS_MIN, smois(i, k, j) - perts_smois(i, k, j) * pert_noah_smois * smois_tmp(i, k, j)))
7246 tslb(i, k, j) = tslb(i, k, j) - perts_tsoil(i, k, j) * pert_noah_tslb * tslb_tmp(i, k, j)
7247 end do
7248 end do
7249 end do
7251 end subroutine Remove_multi_perturb_lsm_perturbations
7253 END MODULE module_surface_driver