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