PageRenderTime 122ms CodeModel.GetById 20ms RepoModel.GetById 0ms app.codeStats 1ms

/wrfv2_fire/phys/module_surface_driver.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 4662 lines | 3098 code | 345 blank | 1219 comment | 27 complexity | 2cebd156424e3b0f3c100847e14ccdf1 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. !WRF:MEDIATION_LAYER:PHYSICS
    2. 

  2. !
    3. 

  3. MODULE module_surface_driver
    4. 

  4. CONTAINS
    5. 

  5. 

  6.    SUBROUTINE surface_driver(                                         &
    7. 

  7.      &           acgrdflx,achfx,aclhf                                 &
    8. 

  8.      &          ,acsnom,acsnow,akhs,akms,albedo,br,canwat             &
    9. 

  9.      &          ,chklowq,dt,dx,dz8w,dzs,glw                           &
    10. 

  10.      &          ,grdflx,gsw,swdown,gz1oz0,hfx,ht,ifsnow,isfflx        &
    11. 

  11.      &          ,fractional_seaice,seaice_albedo_opt,tice2tsk_if2cold &
    12. 

  12.      &          ,isltyp,itimestep,julian_in,ivgtyp,lowlyr,mavail,rmol &
    13. 

  13.      &          ,num_soil_layers,p8w,pblh,pi_phy,pshltr,psih          &
    14. 

  14. #if (NMM_CORE==1)
    15. 

  15.      &          ,psim,p_phy,q10,q2,qfx,taux,tauy,qsfc,qshltr,qz0      &
    16. 

  16. #else
    17. 

  17.      &          ,psim,p_phy,q10,q2,qfx,qsfc,qshltr,qz0                &
    18. 

  18. #endif
    19. 

  19.      &          ,raincv,rho,sfcevp,sfcexc,sfcrunoff                   &
    20. 

  20.      &          ,smois,smstav,smstot,snoalb,snow,snowc,snowh,stepbl   &
    21. 

  21.      &          ,smcrel                                               &
    22. 

  22.      &          ,th10,th2,thz0,th_phy,tmn,tshltr,tsk,tslb             &
    23. 

  23.      &          ,tyr,tyra,tdly,tlag,lagday,nyear,nday,tmn_update,yr   &
    24. 

  24.      &          ,t_phy,u10,udrunoff,ust,uz0,u_frame,u_phy,v10,vegfra  &
    25. 

  25.      &          ,vz0,v_frame,v_phy,warm_rain,wspd,xice,xland,z,znt,zs &
    26. 

  26. #if (NMM_CORE==1)
    27. 

  27.      &          ,xicem,isice,iswater,ct,tke_pbl,sfenth                &
    28. 

  28. #else
    29. 

  29.      &          ,xicem,isice,iswater,ct,tke_pbl                       &
    30. 

  30. #endif
    31. 

  31.      &          ,albbck,embck,lh,sh2o,shdmax,shdmin,z0                &
    32. 

  32.      &          ,flqc,flhc,psfc,sst,sstsk,dtw,sst_update,sst_skin     &
    33. 

  33.      &          ,scm_force_skintemp,scm_force_flux,t2,emiss           &
    34. 

  34.      &          ,sf_sfclay_physics,sf_surface_physics,ra_lw_physics   & 
    35. 

  35.      &          ,mosaic_lu,mosaic_soil                                &
    36. 

  36.      &          ,landusef,soilctop,soilcbot,ra,rs,nlcat,nscat,vegf_px & ! PX-LSM
    37. 

  37.      &          ,snowncv, anal_interval, lai, pxlsm_smois_init        & ! PX-LSM
    38. 

  38.      &          ,pxlsm_soil_nudge                                     & ! PX-LSM
    39. 

  39.      &          ,idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, iopt_inf     &
    40. 

  40.      &          ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc                     & 
    41. 

  41.      &          ,isnowxy  ,tvxy     ,tgxy     ,canicexy                                &
    42. 

  42.      &          ,canliqxy ,eahxy    ,tahxy    ,cmxy     ,chxy                          &
    43. 

  43.      &          ,fwetxy   ,sneqvoxy ,alboldxy ,qsnowxy  ,wslakexy ,zwtxy    ,waxy      &
    44. 

  44.      &          ,wtxy     ,tsnoxy   ,zsnsoxy  ,snicexy  ,snliqxy  ,lfmassxy ,rtmassxy  &
    45. 

  45.      &          ,stmassxy ,woodxy   ,stblcpxy ,fastcpxy ,xsaixy                        &
    46. 

  46.      &          ,tradxy   ,tsxy     ,neexy    ,gppxy    ,nppxy    ,fvegxy   ,qinxy     &
    47. 

  47.      &          ,runsfxy  ,runsbxy  ,ecanxy   ,edirxy   ,etranxy  ,fsaxy    ,firaxy    &
    48. 

  48.      &          ,aparxy   ,psnxy    ,savxy    ,sagxy                                   &
    49. 

  49.      &          ,fsnoxy                                                                &
    50. 

  50.      &          ,t2mvxy   ,t2mbxy   ,chstarxy ,rssunxy  ,rsshaxy  ,bgapxy   ,wgapxy    &    
    51. 

  51.      &          ,gapxy    ,tgvxy    ,tgbxy    ,q2mvxy   ,q2mbxy   ,chvxy    ,chbxy     &
    52. 

  52. #if ( EM_CORE==1)
    53. 

  53.      &          ,ch,tsq,qsq,cov                                       & ! MYNN
    54. 

  54. #endif
    55. 

  55.             !  Optional urban
    56. 

  56.      &          ,slope_rad,topo_shading,shadowmask                    & !I solar
    57. 

  57.      &          ,swnorm,slope,slp_azi                                 & !I solar
    58. 

  58.      &          ,declin,solcon,coszen,hrang,xlat_urb2d                & !I solar/urban
    59. 

  59.      &          ,num_roof_layers, num_wall_layers                     & !I urban
    60. 

  60.      &          ,num_road_layers, dzr, dzb, dzg                       & !I urban
    61. 

  61.      &          ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d         & !H urban
    62. 

  62.      &          ,uc_urb2d                                             & !H urban
    63. 

  63.      &          ,xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d          & !H urban
    64. 

  64.      &          ,trl_urb3d,tbl_urb3d,tgl_urb3d                        & !H urban
    65. 

  65.      &          ,sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d          & !H urban
    66. 

  66.      &          ,frc_urb2d, utype_urb2d                               & !H urban
    67. 

  67.      &          ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif          &
    68. 

  68. !-----SSiB LSM (fds 06/2010)---------------------------------------------------
    69. 

  69.      &          ,alswvisdir, alswvisdif, alswnirdir, alswnirdif       & ! ssib
    70. 

  70.      &          ,swvisdir, swvisdif, swnirdir, swnirdif               & ! ssib
    71. 

  71.      &          ,ssib_br  ,ssib_fm  ,ssib_fh  ,ssib_cm  ,ssibxdd      & ! ssib
    72. 

  72.      &          ,ssib_lhf ,ssib_shf ,ssib_ghf ,ssib_egs ,ssib_eci     & ! ssib
    73. 

  73.      &          ,ssib_ect ,ssib_egi ,ssib_egt ,ssib_sdn ,ssib_sup     & ! ssib
    74. 

  74.      &          ,ssib_ldn ,ssib_lup ,ssib_wat ,ssib_shc ,ssib_shg     & ! ssib
    75. 

  75.      &          ,ssib_lai ,ssib_vcf ,ssib_z00 ,ssib_veg               & ! ssib
    76. 

  76.      &          ,ISNOW ,SWE ,SNOWDEN ,SNOWDEPTH ,TKAIR                & ! ssib-snow
    77. 

  77.      &          ,DZO1 ,WO1 ,TSSN1 ,TSSNO1 ,BWO1 ,BTO1                 & ! ssib-snow
    78. 

  78.      &          ,CTO1 ,FIO1 ,FLO1 ,BIO1 ,BLO1 ,HO1                    & ! ssib-snow
    79. 

  79.      &          ,DZO2 ,WO2 ,TSSN2 ,TSSNO2 ,BWO2 ,BTO2                 & ! ssib-snow
    80. 

  80.      &          ,CTO2 ,FIO2 ,FLO2 ,BIO2 ,BLO2 ,HO2                    & ! ssib-snow
    81. 

  81.      &          ,DZO3 ,WO3 ,TSSN3 ,TSSNO3 ,BWO3 ,BTO3                 & ! ssib-snow
    82. 

  82.      &          ,CTO3 ,FIO3 ,FLO3 ,BIO3 ,BLO3 ,HO3                    & ! ssib-snow
    83. 

  83.      &          ,DZO4 ,WO4 ,TSSN4 ,TSSNO4 ,BWO4 ,BTO4                 & ! ssib-snow
    84. 

  84.      &          ,CTO4 ,FIO4 ,FLO4 ,BIO4 ,BLO4 ,HO4                    & ! ssib-snow
    85. 

  85.      &          ,ra_sw_physics                                        & ! ssib 
    86. 

  86. !------------------------------------------------------------------------------
    87. 

  87.      &          , ids,ide,jds,jde,kds,kde                             &
    88. 

  88.      &          , ims,ime,jms,jme,kms,kme                             &
    89. 

  89.      &          , i_start,i_end,j_start,j_end,kts,kte,num_tiles       &
    90. 

  90.              !  Optional moisture tracers
    91. 

  91.      &           ,qv_curr, qc_curr, qr_curr                           &
    92. 

  92.      &           ,qi_curr, qs_curr, qg_curr                           &
    93. 

  93.              !  Optional moisture tracer flags
    94. 

  94.      &           ,f_qv,f_qc,f_qr                                      &
    95. 

  95.      &           ,f_qi,f_qs,f_qg                                      &
    96. 

  96.              !  Other optionals (more or less em specific)
    97. 

  97.      &          ,capg,hol,mol                                         &
    98. 

  98.      &          ,rainncv,rainshv,rainbl,regime,thc                    &
    99. 

  99.      &          ,qsg,qvg,qcg,soilt1,tsnav                             &
    100. 

  100.      &          ,smfr3d,keepfr3dflag,dew                              &
    101. 

  101.              !  Other optionals (more or less nmm specific)
    102. 

  102.      &          ,potevp,snopcx,soiltb,sr                              &
    103. 

  103.              !  Optional observation PX LSM surface nudging
    104. 

  104.      &          ,t2_ndg_old, q2_ndg_old, t2_ndg_new, q2_ndg_new       &
    105. 

  105.      &          ,sn_ndg_old, sn_ndg_new                               &
    106. 

  106.      &          ,t2obs, q2obs                                         &
    107. 

  107.              ! OPTIONAL, Required by TEMF surface layer 1/7/09 WA
    108. 

  108.      &          ,hd_temf,te_temf,fCor,exch_temf,wm_temf               &
    109. 

  109.              ! Required by ideal SCM surface layer 1/6/10 WA
    110. 

  110.      &          ,hfx_force,lh_force,tsk_force                       &
    111. 

  111.      &          ,hfx_force_tend,lh_force_tend,tsk_force_tend          &
    112. 

  112.              !  Optional observation nudging
    113. 

  113.      &          ,uratx,vratx,tratx                                    &
    114. 

  114.              !  Optional simple oml model
    115. 

  115.      &          ,omlcall,oml_hml0,oml_gamma                           &
    116. 

  116.      &          ,tml,t0ml,hml,h0ml,huml,hvml,f,tmoml                  &
    117. 

  117.      &          ,ustm,ck,cka,cd,cda,isftcflx,iz0tlnd                  &
    118. 

  118.      &         ,isurban, mminlu                                       &
    119. 

  119.      &          ,snotime                                              &
    120. 

  120.      &           ,rdlai2d                                             &
    121. 

  121.      &          ,usemonalb                                            &
    122. 

  122.      &          ,noahres                                              &
    123. 

  123.              !  Optional adaptive time step
    124. 

  124.      &          ,bldt,curr_secs,adapt_step_flag,bldtacttime           & 
    125. 

  125.          ! Optional urban with BEP
    126. 

  126.      &          ,sf_urban_physics,gmt,xlat,xlong,julday               &
    127. 

  127.      &          ,num_urban_layers                                     & !multi-layer urban
    128. 

  128.      &          ,trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d              & !multi-layer urban
    129. 

  129.      &          ,tlev_urb3d,qlev_urb3d                                & !multi-layer urban
    130. 

  130.      &          ,tw1lev_urb3d,tw2lev_urb3d                            & !multi-layer urban
    131. 

  131.      &          ,tglev_urb3d,tflev_urb3d                              & !multi-layer urban
    132. 

  132.      &          ,sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d                  & !multi-layer urban
    133. 

  133.      &          ,sfvent_urb3d,lfvent_urb3d                            & !multi-layer urban 
    134. 

  134.      &          ,sfwin1_urb3d,sfwin2_urb3d                            & !multi-layer urban       
    135. 

  135.      &          ,sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d            & !multi-layer urban
    136. 

  136.      &          ,a_u_bep,a_v_bep,a_t_bep,a_q_bep                      &
    137. 

  137.      &          ,b_u_bep,b_v_bep,b_t_bep,b_q_bep                      &
    138. 

  138.      &          ,sf_bep,vl_bep                                        &
    139. 

  139.      &          ,a_e_bep,b_e_bep,dlg_bep                              &
    140. 

  140.      &          ,dl_u_bep                                             &                          
    141. 

  141.      &          ,cldfra                                               & !ssib
    142. 

  142.          ! Optional urban Bep end
    143. 

  143.      &                                                             )
    144. 

  144.               
    145. 

  145. #if ( ! NMM_CORE == 1 )
    146. 

  146.    USE module_state_description, ONLY : SFCLAYSCHEME              &
    147. 

  147.                                        ,SFCLAYREVSCHEME           &
    148. 

  148.                                        ,MYJSFCSCHEME              &
    149. 

  149.                                        ,QNSESFCSCHEME             &
    150. 

  150.                                        ,GFSSFCSCHEME              &
    151. 

  151.                                        ,PXSFCSCHEME               &
    152. 

  152.                                        ,NOAHMPSCHEME              &
    153. 

  153.                                        ,TEMFSFCSCHEME             &
    154. 

  154.                                        ,IDEALSCMSFCSCHEME         &
    155. 

  155.                                        ,SLABSCHEME                &
    156. 

  156.                                        ,LSMSCHEME                 &
    157. 

  157.                                        ,RUCLSMSCHEME              &
    158. 

  158.                                        ,PXLSMSCHEME               &
    159. 

  159.                                        ,SSIBSCHEME                & !ssib
    160. 

  160.                                        ,MYNNSFCSCHEME             
    161. 

  161. #else
    162. 

  162.    USE module_state_description, ONLY : SFCLAYSCHEME              &
    163. 

  163.                                        ,SFCLAYREVSCHEME           &
    164. 

  164.                                        ,MYJSFCSCHEME              &
    165. 

  165.                                        ,QNSESFCSCHEME             &
    166. 

  166.                                        ,GFSSFCSCHEME              &
    167. 

  167.                                        ,PXSFCSCHEME               &
    168. 

  168.                                        ,NOAHMPSCHEME              &
    169. 

  169.                                        ,SLABSCHEME                &
    170. 

  170.                                        ,LSMSCHEME                 &
    171. 

  171.                                        ,RUCLSMSCHEME              &
    172. 

  172.                                        ,PXLSMSCHEME               &
    173. 

  173.                                        ,TEMFSFCSCHEME             &
    174. 

  174.                                        ,GFDLSFCSCHEME             &
    175. 

  175.                                        ,SSIBSCHEME                & ! ssib
    176. 

  176.                                        ,GFDLSLAB 
    177. 

  177. 

  178. 

  179. #endif
    180. 

  180.    USE module_model_constants
    181. 

  181. ! *** add new modules of schemes here
    182. 

  182. 

  183.    USE module_sf_sfclay
    184. 

  184.    USE module_sf_myjsfc
    185. 

  185.    USE module_sf_qnsesfc
    186. 

  186.    USE module_sf_gfs
    187. 

  187.    USE module_sf_noahdrv, only : lsm
    188. 

  188.    USE module_sf_noahmpdrv, only : noahmplsm
    189. 

  189.    USE module_sf_noah_seaice_drv
    190. 

  190.    USE module_sf_ssib  ! ssib
    191. 

  191.    USE module_sf_ruclsm
    192. 

  192.    USE module_sf_pxsfclay
    193. 

  193.    USE module_sf_pxlsm
    194. 

  194.    USE module_sf_temfsfclay
    195. 

  195.    USE module_sf_sfclayrev
    196. 

  196.    USE module_sf_noah_seaice_drv
    197. 

  197. #if ( EM_CORE==1)
    198. 

  198.    USE module_sf_mynn
    199. 

  199.    USE module_sf_oml
    200. 

  200.    USE module_sf_idealscmsfclay
    201. 

  201. #endif
    202. 

  202.    USE module_sf_scmflux       
    203. 

  203.    USE module_sf_scmskintemp
    204. 

  204. 

  205. #if ( NMM_CORE == 1 )
    206. 

  206.    USE module_sf_gfdl
    207. 

  207. #endif
    208. 

  208. 

  209.    USE module_sf_slab
    210. 

  210. !
    211. 

  211.    USE module_sf_sfcdiags
    212. 

  212.    USE module_sf_sfcdiags_ruclsm
    213. 

  213.    USE module_sf_sstskin
    214. 

  214.    USE module_sf_tmnupdate
    215. 

  215. !
    216. 

  216. !  This driver calls subroutines for the surface parameterizations.
    217. 

  217. !
    218. 

  218. !  surface layer: (between surface and pbl)
    219. 

  219. !      1. sfclay
    220. 

  220. !      2. myjsfc
    221. 

  221. !      7. Pleim surface layer
    222. 

  222. !      5. MYNN surface layer
    223. 

  223. !  surface: ground temp/lsm scheme:
    224. 

  224. !      1. slab
    225. 

  225. !      2. Noah LSM
    226. 

  226. !      7. Pleim-Xiu LSM
    227. 

  227. !     11. Revised sfclay (option 1) 
    228. 

  228. !
    229. 

  229. !  surface: ground temp/lsm scheme for urban:
    230. 

  230. !      2.  BEP
    231. 

  231. !
    232. 

  232. !  ocean mixed layer model
    233. 

  233. !      omlcall = 1
    234. 

  234. !------------------------------------------------------------------
    235. 

  235.    IMPLICIT NONE
    236. 

  236. !======================================================================
    237. 

  237. ! Grid structure in physics part of WRF
    238. 

  238. !----------------------------------------------------------------------
    239. 

  239. ! The horizontal velocities used in the physics are unstaggered
    240. 

  240. ! relative to temperature/moisture variables. All predicted
    241. 

  241. ! variables are carried at half levels except w, which is at full
    242. 

  242. ! levels. Some arrays with names (*8w) are at w (full) levels.
    243. 

  243. !
    244. 

  244. !----------------------------------------------------------------------
    245. 

  245. ! In WRF, kms (smallest number) is the bottom level and kme (largest
    246. 

  246. ! number) is the top level.  In your scheme, if 1 is at the top level,
    247. 

  247. ! then you have to reverse the order in the k direction.
    248. 

  248. !
    249. 

  249. !         kme      -   half level (no data at this level)
    250. 

  250. !         kme    ----- full level
    251. 

  251. !         kme-1    -   half level
    252. 

  252. !         kme-1  ----- full level
    253. 

  253. !         .
    254. 

  254. !         kms+2    -   half level
    255. 

  255. !         kms+2  ----- full level
    256. 

  256. !         kms+1    -   half level
    257. 

  257. !         kms+1  ----- full level
    258. 

  258. !         kms      -   half level
    259. 

  259. !         kms    ----- full level
    260. 

  260. !
    261. 

  261. !======================================================================
    262. 

  262. ! Definitions
    263. 

  263. !-----------
    264. 

  264. ! Theta      potential temperature (K)
    265. 

  265. ! Qv         water vapor mixing ratio (kg/kg)
    266. 

  266. ! Qc         cloud water mixing ratio (kg/kg)
    267. 

  267. ! Qr         rain water mixing ratio (kg/kg)
    268. 

  268. ! Qi         cloud ice mixing ratio (kg/kg)
    269. 

  269. ! Qs         snow mixing ratio (kg/kg)
    270. 

  270. !-----------------------------------------------------------------
    271. 

  271. !-- itimestep     number of time steps
    272. 

  272. !-- GLW           downward long wave flux at ground surface (W/m^2)
    273. 

  273. !-- GSW           net short wave flux at ground surface (W/m^2)
    274. 

  274. !-- SWDOWN        downward short wave flux at ground surface (W/m^2)
    275. 

  275. !-- EMISS         surface emissivity (between 0 and 1)
    276. 

  276. !-- TSK           surface temperature (K)
    277. 

  277. !-- TMN           soil temperature at lower boundary (K)
    278. 

  278. !-- TYR           annual mean surface temperature of previous year (K)
    279. 

  279. !-- TYRA          accumulated surface temperature in the current year (K)
    280. 

  280. !-- TLAG          mean surface temperature of previous 140 days (K)
    281. 

  281. !-- TDLY          accumulated daily mean surface temperature of the current day (K)
    282. 

  282. !-- XLAND         land mask (1 for land, 2 for water)
    283. 

  283. !-- ZNT           time-varying roughness length (m)
    284. 

  284. !-- Z0            background roughness length (m)
    285. 

  285. !-- MAVAIL        surface moisture availability (between 0 and 1)
    286. 

  286. !-- UST           u* in similarity theory (m/s)
    287. 

  287. !-- MOL           T* (similarity theory) (K)
    288. 

  288. !-- HOL           PBL height over Monin-Obukhov length
    289. 

  289. !-- PBLH          PBL height (m)
    290. 

  290. !-- CAPG          heat capacity for soil (J/K/m^3)
    291. 

  291. !-- THC           thermal inertia (Cal/cm/K/s^0.5)
    292. 

  292. !-- SNOWC         flag indicating snow coverage (1 for snow cover)
    293. 

  293. !-- HFX           net upward heat flux at the surface (W/m^2)
    294. 

  294. !-- QFX           net upward moisture flux at the surface (kg/m^2/s)
    295. 

  295. !-- TAUX          RHO*U**2 for ocean coupling
    296. 

  296. !-- TAUY          RHO*U**2 for ocean coupling
    297. 

  297. !-- LH            net upward latent heat flux at surface (W/m^2)
    298. 

  298. !-- REGIME        flag indicating PBL regime (stable, unstable, etc.)
    299. 

  299. !-- tke_pbl       turbulence kinetic energy from PBL schemes (m^2/s^2)
    300. 

  300. !-- akhs          sfc exchange coefficient of heat/moisture from MYJ
    301. 

  301. !-- akms          sfc exchange coefficient of momentum from MYJ
    302. 

  302. !-- thz0          potential temperature at roughness length (K)
    303. 

  303. !-- uz0           u wind component at roughness length (m/s)
    304. 

  304. !-- vz0           v wind component at roughness length (m/s)
    305. 

  305. !-- qsfc          specific humidity at lower boundary (kg/kg)
    306. 

  306. !-- uratx         ratio of u over u10 (Added for obs-nudging)
    307. 

  307. !-- vratx         ratio of v over v10 (Added for obs-nudging)
    308. 

  308. !-- tratx         ratio of t over th2 (Added for obs-nudging)
    309. 

  309. !-- u10           diagnostic 10-m u component from surface layer
    310. 

  310. !-- v10           diagnostic 10-m v component from surface layer
    311. 

  311. !-- th2           diagnostic 2-m theta from surface layer and lsm
    312. 

  312. !-- t2            diagnostic 2-m temperature from surface layer and lsm
    313. 

  313. !-- q2            diagnostic 2-m mixing ratio from surface layer and lsm
    314. 

  314. !-- tshltr        diagnostic 2-m theta from MYJ
    315. 

  315. !-- th10          diagnostic 10-m theta from MYJ
    316. 

  316. !-- qshltr        diagnostic 2-m specific humidity from MYJ
    317. 

  317. !-- q10           diagnostic 10-m specific humidity from MYJ
    318. 

  318. !-- lowlyr        index of lowest model layer above ground
    319. 

  319. !-- rr            dry air density (kg/m^3)
    320. 

  320. !-- u_phy         u-velocity interpolated to theta points (m/s)
    321. 

  321. !-- v_phy         v-velocity interpolated to theta points (m/s)
    322. 

  322. !-- th_phy        potential temperature (K)
    323. 

  323. !-- moist         moisture array (4D - last index is species) (kg/kg)
    324. 

  324. !-- p_phy         pressure (Pa)
    325. 

  325. !-- pi_phy        exner function (dimensionless)
    326. 

  326. !-- pshltr        diagnostic shelter (2m) pressure from MYJ (Pa)
    327. 

  327. !-- p8w           pressure at full levels (Pa)
    328. 

  328. !-- t_phy         temperature (K)
    329. 

  329. !-- dz8w          dz between full levels (m)
    330. 

  330. !-- z             height above sea level (m)
    331. 

  331. !-- DX            horizontal space interval (m)
    332. 

  332. !-- DT            time step (second)
    333. 

  333. !-- PSFC          pressure at the surface (Pa)
    334. 

  334. !-- SST           sea-surface temperature (K)
    335. 

  335. !-- SSTSK         skin sea-surface temperature (K)
    336. 

  336. !-- DTW           warm layer temp diff (K)
    337. 

  337. !-- TSLB
    338. 

  338. !-- ZS
    339. 

  339. !-- DZS
    340. 

  340. !-- num_soil_layers number of soil layer
    341. 

  341. !-- IFSNOW      ifsnow=1 for snow-cover effects
    342. 

  342. !-- omlcall       whether to call simple ocean mixed layer model from slab (1 = use oml)
    343. 

  343. !-- oml_hml0      initial mixed layer depth (if real-data not available, default 50 m)
    344. 

  344. !-- oml_gamma     lapse rate below mixed layer in ocean (default 0.14 K m-1)
    345. 

  345. !-- ck            enthalpy exchange coeff at 10 meters
    346. 

  346. !-- cd            momentum exchange coeff at 10 meters
    347. 

  347. !-- cka           enthalpy exchange coeff at the lowest model level
    348. 

  348. !-- cda           momentum exchange coeff at the lowest model level
    349. 

  349. !!!!!!!!!!!!!!
    350. 

  350. !
    351. 

  351. !
    352. 

  352. !-- LANDUSEF     Landuse fraction                      ! P-X LSM
    353. 

  353. !-- SOILCTOP     Top soil fraction                     ! P-X LSM
    354. 

  354. !-- SOILCBOT     Bottom soil fraction                  ! P-X LSM
    355. 

  355. !-- RA           Aerodynamic resistence                        ! P-X LSM
    356. 

  356. !-- RS           Stomatal resistence                   ! P-X LSM
    357. 

  357. !-- NLCAT        Number of landuse categories          ! P-X LSM
    358. 

  358. !-- NSCAT        Number of soil categories             ! P-X LSM
    359. 

  359. !-- ch - drag coefficient for heat/moisture            ! MYNN LSM
    360. 

  360. 

  361. !
    362. 

  362. !-- ids           start index for i in domain
    363. 

  363. !-- ide           end index for i in domain
    364. 

  364. !-- jds           start index for j in domain
    365. 

  365. !-- jde           end index for j in domain
    366. 

  366. !-- kds           start index for k in domain
    367. 

  367. !-- kde           end index for k in domain
    368. 

  368. !-- ims           start index for i in memory
    369. 

  369. !-- ime           end index for i in memory
    370. 

  370. !-- jms           start index for j in memory
    371. 

  371. !-- jme           end index for j in memory
    372. 

  372. !-- kms           start index for k in memory
    373. 

  373. !-- kme           end index for k in memory
    374. 

  374. !-- its           start index for i in tile
    375. 

  375. !-- ite           end index for i in tile
    376. 

  376. !-- jts           start index for j in tile
    377. 

  377. !-- jte           end index for j in tile
    378. 

  378. !-- kts           start index for k in tile
    379. 

  379. !-- kte           end index for k in tile
    380. 

  380. !
    381. 

  381. !******************************************************************
    382. 

  382. !------------------------------------------------------------------
    383. 

  383. 

  384.    INTEGER, INTENT(IN) ::                                             &
    385. 

  385.      &           ids,ide,jds,jde,kds,kde                              &
    386. 

  386.      &          ,ims,ime,jms,jme,kms,kme                              &
    387. 

  387.      &          ,kts,kte,num_tiles
    388. 

  388. 

  389.    INTEGER, INTENT(IN)::   FRACTIONAL_SEAICE
    390. 

  390.    INTEGER, INTENT(IN)::   SEAICE_ALBEDO_OPT
    391. 

  391. 

  392.    INTEGER, INTENT(IN)::   NLCAT, mosaic_lu, mosaic_soil
    393. 

  393.    INTEGER, INTENT(IN)::   NSCAT
    394. 

  394. 

  395.    INTEGER, INTENT(IN) :: sf_sfclay_physics, sf_surface_physics,      &
    396. 

  396.                           sf_urban_physics,ra_lw_physics,sst_update,  &
    397. 

  397.                           ra_sw_physics                    
    398. 

  398.    INTEGER, INTENT(IN),OPTIONAL :: sst_skin, tmn_update,              &
    399. 

  399.                                    scm_force_skintemp, scm_force_flux 
    400. 

  400. 

  401.    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
    402. 

  402.      &           i_start,i_end,j_start,j_end
    403. 

  403. 

  404.    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::  ISLTYP
    405. 

  405.    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   IVGTYP
    406. 

  406.    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   LOWLYR
    407. 

  407.    INTEGER, INTENT(IN )::   IFSNOW
    408. 

  408.    INTEGER, INTENT(IN )::   ISFFLX
    409. 

  409.    INTEGER, INTENT(IN )::   ITIMESTEP
    410. 

  410.    INTEGER, INTENT(IN )::   NUM_SOIL_LAYERS
    411. 

  411.    REAL,    INTENT(IN ),OPTIONAL ::   JULIAN_in
    412. 

  412.    INTEGER, INTENT(IN )::   LAGDAY
    413. 

  413.    INTEGER, INTENT(IN )::   STEPBL
    414. 

  414.    INTEGER, INTENT(IN )::   ISICE
    415. 

  415.    INTEGER, INTENT(IN )::   ISWATER
    416. 

  416.    INTEGER, INTENT(IN ), OPTIONAL :: ISURBAN
    417. 

  417.    CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: MMINLU
    418. 

  418.    LOGICAL, INTENT(IN )::   WARM_RAIN
    419. 

  419.    LOGICAL, INTENT(IN)::   tice2tsk_if2cold
    420. 

  420.    INTEGER, INTENT(INOUT ),OPTIONAL ::   NYEAR
    421. 

  421.    REAL   , INTENT(INOUT ),OPTIONAL ::   NDAY
    422. 

  422.    INTEGER, INTENT(IN ),OPTIONAL ::   YR
    423. 

  423.    REAL , INTENT(IN )::   U_FRAME
    424. 

  424.    REAL , INTENT(IN )::   V_FRAME
    425. 

  425. #if (NMM_CORE==1)
    426. 

  426.    real , intent(IN )::   SFENTH
    427. 

  427. #endif
    428. 

  428.    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SMOIS
    429. 

  429.    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   TSLB
    430. 

  430.    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(OUT)  ::   SMCREL
    431. 

  431.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   GLW
    432. 

  432.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   GSW,SWDOWN
    433. 

  433.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   HT
    434. 

  434.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   RAINCV
    435. 

  435.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   SST
    436. 

  436.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL ::   SSTSK
    437. 

  437.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL ::   DTW
    438. 

  438.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   TMN
    439. 

  439.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL ::   TYR
    440. 

  440.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL ::   TYRA
    441. 

  441.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT ),OPTIONAL ::   TDLY
    442. 

  442.    REAL, DIMENSION( ims:ime , 1:lagday , jms:jme ), INTENT(INOUT ),OPTIONAL ::   TLAG
    443. 

  443.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   VEGFRA
    444. 

  444. !------fds (06/2010)--------------------------
    445. 

  445.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   XICE
    446. 

  446. !---------------------------------------------
    447. 

  447.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   XLAND
    448. 

  448.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   XICEM
    449. 

  449.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   MAVAIL
    450. 

  450.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT)::   SNOALB
    451. 

  451.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ACSNOW
    452. 

  452.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SNOTIME
    453. 

  453.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKHS
    454. 

  454.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   AKMS
    455. 

  455.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO
    456. 

  456.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   CANWAT
    457. 

  457. 

  458.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   GRDFLX
    459. 

  459.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   HFX
    460. 

  460.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   RMOL
    461. 

  461.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   PBLH
    462. 

  462.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   Q2
    463. 

  463.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QFX
    464. 

  464. #if (NMM_CORE==1)
    465. 

  465.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT):: TAUX
    466. 

  466.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT):: TAUY
    467. 

  467. #endif
    468. 

  468.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QSFC
    469. 

  469.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   QZ0
    470. 

  470.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SFCRUNOFF
    471. 

  471.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTAV
    472. 

  472.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SMSTOT
    473. 

  473.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOW
    474. 

  474.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWC
    475. 

  475.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   SNOWH
    476. 

  476.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TH2
    477. 

  477.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   THZ0
    478. 

  478.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   TSK
    479. 

  479.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UDRUNOFF
    480. 

  480.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UST
    481. 

  481.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   UZ0
    482. 

  482.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   VZ0
    483. 

  483.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   WSPD
    484. 

  484.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ZNT
    485. 

  485. !-----fds (06/2010)---------------------------------------------
    486. 

  486.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_LHF ! SSiB output
    487. 

  487.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_SHF ! SSiB output
    488. 

  488.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_GHF ! SSiB output
    489. 

  489.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_EGS ! SSiB output
    490. 

  490.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_ECI ! SSiB output
    491. 

  491.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_ECT ! SSiB output
    492. 

  492.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_EGI ! SSiB output
    493. 

  493.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_EGT ! SSiB output
    494. 

  494.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_SDN ! SSiB output
    495. 

  495.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_SUP ! SSiB output
    496. 

  496.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_LDN ! SSiB output
    497. 

  497.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_LUP ! SSiB output
    498. 

  498.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_WAT ! SSiB output
    499. 

  499.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_SHC ! SSiB output
    500. 

  500.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_SHG ! SSiB output
    501. 

  501.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_LAI ! SSiB output
    502. 

  502.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_VCF ! SSiB output
    503. 

  503.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_Z00 ! SSiB output
    504. 

  504.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   SSIB_VEG ! SSiB output
    505. 

  505.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   ALSWVISDIR! SSiB
    506. 

  506.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   ALSWVISDIF! SSiB
    507. 

  507.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   ALSWNIRDIR! SSiB
    508. 

  508.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(OUT)::   ALSWNIRDIF! SSiB
    509. 

  509.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN)::      SWVISDIR! SSiB
    510. 

  510.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN)::      SWVISDIF! SSiB
    511. 

  511.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN)::      SWNIRDIR! SSiB
    512. 

  512.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(IN)::      SWNIRDIF! SSiB
    513. 

  513.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SSiB_BR ! SSiB
    514. 

  514.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SSiB_FM ! SSiB
    515. 

  515.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SSiB_FH ! SSiB
    516. 

  516.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SSiB_CM ! SSiB
    517. 

  517.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SSiBXDD ! SSiB
    518. 

  518.    INTEGER, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: ISNOW  ! ssib-snow
    519. 

  519.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SWE     ! ssib-snow
    520. 

  520.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SNOWDEN ! ssib-snow
    521. 

  521.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT):: SNOWDEPTH ! ssib-snow
    522. 

  522.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TKAIR   ! ssib-snow
    523. 

  523.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   DZO1    ! ssib-snow
    524. 

  524.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   WO1     ! ssib-snow
    525. 

  525.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSN1   ! ssib-snow
    526. 

  526.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSNO1  ! ssib-snow
    527. 

  527.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BWO1    ! ssib-snow
    528. 

  528.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BTO1    ! ssib-snow
    529. 

  529.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   CTO1    ! ssib-snow
    530. 

  530.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FIO1    ! ssib-snow
    531. 

  531.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FLO1    ! ssib-snow
    532. 

  532.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BIO1    ! ssib-snow
    533. 

  533.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BLO1    ! ssib-snow
    534. 

  534.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   HO1     ! ssib-snow
    535. 

  535.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   DZO2    ! ssib-snow
    536. 

  536.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   WO2     ! ssib-snow
    537. 

  537.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSN2   ! ssib-snow
    538. 

  538.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSNO2  ! ssib-snow
    539. 

  539.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BWO2    ! ssib-snow
    540. 

  540.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BTO2    ! ssib-snow
    541. 

  541.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   CTO2    ! ssib-snow
    542. 

  542.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FIO2    ! ssib-snow
    543. 

  543.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FLO2    ! ssib-snow
    544. 

  544.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BIO2    ! ssib-snow
    545. 

  545.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BLO2    ! ssib-snow
    546. 

  546.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   HO2     ! ssib-snow
    547. 

  547.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   DZO3    ! ssib-snow
    548. 

  548.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   WO3     ! ssib-snow
    549. 

  549.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSN3   ! ssib-snow
    550. 

  550.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSNO3  ! ssib-snow
    551. 

  551.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BWO3    ! ssib-snow
    552. 

  552.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BTO3    ! ssib-snow
    553. 

  553.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   CTO3    ! ssib-snow
    554. 

  554.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FIO3    ! ssib-snow
    555. 

  555.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FLO3    ! ssib-snow
    556. 

  556.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BIO3    ! ssib-snow
    557. 

  557.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BLO3    ! ssib-snow
    558. 

  558.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   HO3     ! ssib-snow
    559. 

  559.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   DZO4    ! ssib-snow
    560. 

  560.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   WO4     ! ssib-snow
    561. 

  561.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSN4   ! ssib-snow
    562. 

  562.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSSNO4  ! ssib-snow
    563. 

  563.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BWO4    ! ssib-snow
    564. 

  564.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BTO4    ! ssib-snow
    565. 

  565.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   CTO4    ! ssib-snow
    566. 

  566.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FIO4    ! ssib-snow
    567. 

  567.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   FLO4    ! ssib-snow
    568. 

  568.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BIO4    ! ssib-snow
    569. 

  569.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   BLO4    ! ssib-snow
    570. 

  570.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   HO4     ! ssib-snow
    571. 

  571. !----------------------------------------------------------
    572. 

  572.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   BR
    573. 

  573.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   CHKLOWQ
    574. 

  574.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   GZ1OZ0
    575. 

  575.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSHLTR
    576. 

  576.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIH
    577. 

  577.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSIM
    578. 

  578.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   Q10
    579. 

  579.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   QSHLTR
    580. 

  580.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TH10
    581. 

  581.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   TSHLTR
    582. 

  582.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   U10
    583. 

  583.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   V10
    584. 

  584.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)::   PSFC
    585. 

  585.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   ACSNOM
    586. 

  586.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEVP
    587. 

  587.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL ::   ACHFX
    588. 

  588.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL ::   ACLHF
    589. 

  589.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT),OPTIONAL ::   ACGRDFLX
    590. 

  590.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   SFCEXC
    591. 

  591.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLHC
    592. 

  592.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)::   FLQC
    593. 

  593.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) ::   CT
    594. 

  594.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   DZ8W
    595. 

  595.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P8W
    596. 

  596.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   PI_PHY
    597. 

  597.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   P_PHY
    598. 

  598.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   RHO
    599. 

  599.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   TH_PHY
    600. 

  600.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   T_PHY
    601. 

  601.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   U_PHY
    602. 

  602.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   V_PHY
    603. 

  603.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN )::   Z
    604. 

  604. 

  605.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::   TKE_PBL
    606. 

  606.    REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   DZS
    607. 

  607.    REAL, DIMENSION(1:num_soil_layers), INTENT(IN)::   ZS
    608. 

  608.    REAL, INTENT(IN )::   DT
    609. 

  609.    REAL, INTENT(IN )::   DX
    610. 

  610.    REAL,       INTENT(IN   ),OPTIONAL    ::     bldt
    611. 

  611.    REAL,       INTENT(IN   ),OPTIONAL    ::     curr_secs
    612. 

  612.    LOGICAL,    INTENT(IN   ),OPTIONAL    ::     adapt_step_flag
    613. 

  613.    REAL,       INTENT(INOUT),OPTIONAL    ::     bldtacttime  
    614. 

  614. 

  615. !  arguments for NCAR surface physics
    616. 

  616. 

  617.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   ALBBCK  ! INOUT needed for NMM
    618. 

  618.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   EMBCK
    619. 

  619.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   LH
    620. 

  620.    REAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), INTENT(INOUT)::   SH2O
    621. 

  621.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMAX
    622. 

  622.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN )::   SHDMIN
    623. 

  623.    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT )::   Z0
    624. 

  624. 

  625.    INTEGER, OPTIONAL, INTENT(IN) :: idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, iopt_stc
    626. 

  626.    INTEGER, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: ISNOWXY
    627. 

  627.    REAL, OPTIONAL, DIMENSION(ims:ime ,-2:num_soil_layers, jms:jme), INTENT(INOUT) :: zsnsoxy
    628. 

  628.    REAL, OPTIONAL, DIMENSION(ims:ime ,-2:0,               jms:jme), INTENT(INOUT) :: tsnoxy, snicexy, snliqxy
    629. 

  629.    REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy, chxy,               &
    630. 

  630.         fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy, waxy, wtxy, lfmassxy, rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy,       &
    631. 

  631.         xsaixy, tradxy, tsxy, neexy, gppxy, nppxy, fvegxy, qinxy, runsfxy, runsbxy, ecanxy, edirxy, etranxy, fsaxy, firaxy,               &
    632. 

  632.         aparxy, psnxy, savxy, sagxy, fsnoxy, q2mvxy, q2mbxy
    633. 

  633.    REAL, OPTIONAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) ::  t2mvxy   ,t2mbxy   ,chstarxy, rssunxy, rsshaxy, bgapxy,wgapxy,gapxy , &
    634. 

  634.         tgvxy ,tgbxy, chvxy, chbxy
    635. 

  635. 

  636. ! Variables for multi-layer UCM
    637. 

  637.    REAL, OPTIONAL, INTENT(IN  )   ::                                   GMT 
    638. 

  638.    INTEGER, OPTIONAL, INTENT(IN  ) ::                               JULDAY
    639. 

  639.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )        ::XLAT, XLONG
    640. 

  640.    INTEGER, INTENT(IN )::   NUM_URBAN_LAYERS
    641. 

  641.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: trb_urb4d
    642. 

  642.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1_urb4d
    643. 

  643.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2_urb4d
    644. 

  644.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tgb_urb4d
    645. 

  645.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tlev_urb3d
    646. 

  646.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: qlev_urb3d
    647. 

  647.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw1lev_urb3d
    648. 

  648.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tw2lev_urb3d
    649. 

  649.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tglev_urb3d
    650. 

  650.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: tflev_urb3d
    651. 

  651.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d
    652. 

  652.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d
    653. 

  653.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d
    654. 

  654.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d
    655. 

  655.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d
    656. 

  656.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin1_urb3d
    657. 

  657.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfwin2_urb3d
    658. 

  658.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw1_urb3d
    659. 

  659.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfw2_urb3d
    660. 

  660.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfr_urb3d
    661. 

  661.    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_layers, jms:jme ), INTENT(INOUT) :: sfg_urb3d
    662. 

  662.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_u_bep   !Implicit momemtum component X-direction
    663. 

  663.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_v_bep   !Implicit momemtum component Y-direction
    664. 

  664.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_t_bep   !Implicit component pot. temperature
    665. 

  665.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_e_bep   !Implicit component TKE
    666. 

  666.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::a_q_bep   !Implicit component TKE
    667. 

  667.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_u_bep   !Explicit momentum component X-direction
    668. 

  668.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_v_bep   !Explicit momentum component Y-direction
    669. 

  669.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_t_bep   !Explicit component pot. temperature
    670. 

  670.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_e_bep   !Explicit component TKE
    671. 

  671.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::b_q_bep   !Explicit component TKE
    672. 

  672.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::vl_bep    !Fraction air volume in grid cell
    673. 

  673.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dlg_bep   !Height above ground
    674. 

  674.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::sf_bep  !Fraction air at the face of grid cell
    675. 

  675.    REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::dl_u_bep  !Length scale
    676. 

  676. 

  677. ! Optional
    678. 

  678. !
    679. 

  679. !  arguments for Ocean Mixed Layer Model
    680. 

  680.    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT )::   TML, T0ML, HML, H0ML, HUML, HVML
    681. 

  681.    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(IN    )::   F, TMOML
    682. 

  682.    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(OUT   )::   CK, CKA, CD, CDA, USTM
    683. 

  683. 

  684. #if ( EM_CORE==1)
    685. 

  685.    REAL, DIMENSION( ims:ime , jms:jme ), &
    686. 

  686.         &OPTIONAL, INTENT(INOUT   ):: ch
    687. 

  687.    
    688. 

  688.    REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
    689. 

  689.         &OPTIONAL, INTENT(IN   ):: tsq,qsq,cov
    690. 

  690. #endif
    691. 

  691. 

  692. 

  693.    INTEGER, OPTIONAL, INTENT(IN )::   slope_rad, topo_shading
    694. 

  694.    INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: shadowmask
    695. 

  695.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT):: swnorm
    696. 

  696.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN):: slope,slp_azi
    697. 

  697. 

  698.    INTEGER, OPTIONAL, INTENT(IN )::   ISFTCFLX,IZ0TLND
    699. 

  699.    INTEGER, OPTIONAL, INTENT(IN )::   OMLCALL
    700. 

  700.    REAL   , OPTIONAL, INTENT(IN )::   OML_HML0
    701. 

  701.    REAL   , OPTIONAL, INTENT(IN )::   OML_GAMMA
    702. 

  702. !
    703. 

  703. !  Observation nudging
    704. 

  704. !
    705. 

  705.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   uratx  !Added for obs-nudging
    706. 

  706.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   vratx  !Added for obs-nudging
    707. 

  707.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   tratx  !Added for obs-nudging
    708. 

  708. !
    709. 

  709. !  PX LSM Surface Grid Analysis nudging
    710. 

  710. !
    711. 

  711.    INTEGER, OPTIONAL, INTENT(IN)    :: pxlsm_smois_init, pxlsm_soil_nudge, ANAL_INTERVAL
    712. 

  712.    REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , OPTIONAL, INTENT(INOUT)::   LANDUSEF
    713. 

  713.    REAL, DIMENSION( ims:ime, NSCAT, jms:jme ) , OPTIONAL, INTENT(INOUT)::   SOILCTOP, SOILCBOT
    714. 

  714.    REAL, DIMENSION( ims:ime , jms:jme ), OPTIONAL, INTENT(INOUT)::   VEGF_PX
    715. 

  715.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   RA
    716. 

  716.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   RS
    717. 

  717.    REAL, DIMENSION( ims:ime, jms:jme ) , OPTIONAL, INTENT(INOUT)::   LAI
    718. 

  718.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   T2OBS
    719. 

  719.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(OUT)::   Q2OBS
    720. 

  720. 

  721.    REAL,       DIMENSION( ims:ime,  jms:jme ),                           &
    722. 

  722.                OPTIONAL, INTENT(INOUT)    ::      t2_ndg_old,            &
    723. 

  723.                                                   q2_ndg_old,            &
    724. 

  724.                                                   t2_ndg_new,            &
    725. 

  725.                                                   q2_ndg_new,            &
    726. 

  726.                                                   sn_ndg_old,            &
    727. 

  727.                                                   sn_ndg_new
    728. 

  728. !
    729. 

  729. !
    730. 

  730. ! Flags relating to the optional tendency arrays declared above
    731. 

  731. ! Models that carry the optional tendencies will provdide the
    732. 

  732. ! optional arguments at compile time; these flags all the model
    733. 

  733. ! to determine at run-time whether a particular tracer is in
    734. 

  734. ! use or not.
    735. 

  735. !
    736. 

  736.    LOGICAL, INTENT(IN), OPTIONAL ::                             &
    737. 

  737.                                                       f_qv      &
    738. 

  738.                                                      ,f_qc      &
    739. 

  739.                                                      ,f_qr      &
    740. 

  740.                                                      ,f_qi      &
    741. 

  741.                                                      ,f_qs      &
    742. 

  742.                                                      ,f_qg
    743. 

  743. 

  744.    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
    745. 

  745.          OPTIONAL, INTENT(INOUT) ::                              &
    746. 

  746.                       ! optional moisture tracers
    747. 

  747.                       ! 2 time levels; if only one then use CURR
    748. 

  748.                       qv_curr, qc_curr, qr_curr                  &
    749. 

  749.                      ,qi_curr, qs_curr, qg_curr
    750. 

  750.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN)   ::   snowncv
    751. 

  751.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   capg
    752. 

  752.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   emiss
    753. 

  753.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   hol
    754. 

  754.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   mol
    755. 

  755.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   regime
    756. 

  756.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     rainncv
    757. 

  757.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     rainshv
    758. 

  758.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   RAINBL
    759. 

  759.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   t2
    760. 

  760.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(IN )::     thc
    761. 

  761.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qsg
    762. 

  762.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qvg
    763. 

  763.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   qcg
    764. 

  764.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   dew
    765. 

  765.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soilt1
    766. 

  766.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   tsnav
    767. 

  767.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   potevp ! NMM LSM
    768. 

  768.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   snopcx ! NMM LSM
    769. 

  769.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   soiltb ! NMM LSM
    770. 

  770.    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT)::   sr ! NMM and RUC LSM
    771. 

  771.    REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   smfr3d
    772. 

  772.    REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), OPTIONAL, INTENT(INOUT)::   keepfr3dflag
    773. 

  773. 

  774.    REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(OUT), OPTIONAL  ::   NOAHRES
    775. 

  775. 

  776. ! Variables for TEMF surface layer
    777. 

  777.    REAL,OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: te_temf
    778. 

  778.    REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: hd_temf, exch_temf, wm_temf
    779. 

  779.    REAL,OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: fCor
    780. 

  780. 

  781. ! Variables for ideal SCM surface layer
    782. 

  782.    REAL,OPTIONAL, INTENT(INOUT) :: hfx_force,lh_force,tsk_force
    783. 

  783.    REAL,OPTIONAL, INTENT(IN   ) :: hfx_force_tend,lh_force_tend,tsk_force_tend
    784. 

  784. 

  785. !  LOCAL  VAR
    786. 

  786. 

  787.    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::v_phytmp
    788. 

  788.    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ) ::u_phytmp
    789. 

  789. 

  790.    REAL,       DIMENSION( ims:ime, jms:jme )          ::  ZOL
    791. 

  791. 

  792.    REAL,       DIMENSION( ims:ime, jms:jme )          ::          &
    793. 

  793.                                                              QGH, &
    794. 

  794.                                                              CHS, &
    795. 

  795.                                                              CPM, &
    796. 

  796.                                                             CHS2, &
    797. 

  797.                                                             CQS2
    798. 

  798. ! SSIB local variables
    799. 

  799.    REAL ZDIFF
    800. 

  800. !
    801. 

  801.    REAL    :: DTMIN,DTBL
    802. 

  802. !
    803. 

  803.    INTEGER :: i,J,K,NK,jj,ij
    804. 

  804.    INTEGER :: gfdl_ntsflg
    805. 

  805.    LOGICAL :: radiation, myj, frpcpn, isisfc
    806. 

  806.    LOGICAL, INTENT(in), OPTIONAL :: rdlai2d
    807. 

  807.    LOGICAL, INTENT(in), OPTIONAL :: usemonalb
    808. 

  808.    REAL    :: total_depth,mid_point_depth
    809. 

  809.    REAL    :: tconst,tprior,tnew,yrday,deltat
    810. 

  810.    REAL    :: SWSAVE
    811. 

  811.    REAL,       DIMENSION( ims:ime, jms:jme )          ::  GSWSAVE
    812. 

  812. !-------------------------------------------------
    813. 

  813. ! urban related variables are added to declaration
    814. 

  814. !-------------------------------------------------
    815. 

  815.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF
    816. 

  816.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF
    817. 

  817.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF
    818. 

  818.    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF
    819. 

  819.      REAL, OPTIONAL, INTENT(IN) :: DECLIN, SOLCON
    820. 

  820.      REAL, OPTIONAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZEN
    821. 

  821.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: HRANG
    822. 

  822.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: XLAT_URB2D  !urban
    823. 

  823.      INTEGER,  INTENT(IN) :: num_roof_layers                         !urban
    824. 

  824.      INTEGER,  INTENT(IN) :: num_wall_layers                         !urban
    825. 

  825.      INTEGER,  INTENT(IN) :: num_road_layers                         !urban
    826. 

  826.      REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZR          !urban
    827. 

  827.      REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZB          !urban
    828. 

  828.      REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(IN) :: DZG          !urban
    829. 

  829. 

  830.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TR_URB2D !urban
    831. 

  831.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TB_URB2D !urban
    832. 

  832.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: TG_URB2D !urban
    833. 

  833.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TC_URB2D !urban
    834. 

  834.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: QC_URB2D !urban
    835. 

  835.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: UC_URB2D !urban
    836. 

  836.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXR_URB2D !urban
    837. 

  837.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXB_URB2D !urban
    838. 

  838.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXG_URB2D !urban
    839. 

  839.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: XXXC_URB2D !urban
    840. 

  840.      REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
    841. 

  841.            INTENT(INOUT)  :: TRL_URB3D                                 !urban
    842. 

  842.      REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
    843. 

  843.            INTENT(INOUT)  :: TBL_URB3D                                 !urban
    844. 

  844.      REAL, OPTIONAL, DIMENSION( ims:ime , 1:num_soil_layers, jms:jme ), &       !urban
    845. 

  845.            INTENT(INOUT)  :: TGL_URB3D                                 !urban
    846. 

  846.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: SH_URB2D !urban
    847. 

  847.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: LH_URB2D !urban
    848. 

  848.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: G_URB2D  !urban
    849. 

  849.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: RN_URB2D !urban
    850. 

  850.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT):: TS_URB2D !urban
    851. 

  851. !
    852. 

  852.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: FRC_URB2D  !urban
    853. 

  853.      INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT)  :: UTYPE_URB2D  !urban
    854. 

  854. 

  855.      REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIM_URB2D  !urban local var
    856. 

  856.      REAL,  DIMENSION( ims:ime, jms:jme )  :: PSIH_URB2D  !urban local var
    857. 

  857.      REAL,  DIMENSION( ims:ime, jms:jme )  :: GZ1OZ0_URB2D  !urban local var
    858. 

  858. !m     REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_URB2D  !urban local var
    859. 

  859.      REAL,  DIMENSION( ims:ime, jms:jme )  :: AKMS_URB2D  !urban local var
    860. 

  860.      REAL,  DIMENSION( ims:ime, jms:jme )  :: U10_URB2D   !urban local var
    861. 

  861.      REAL,  DIMENSION( ims:ime, jms:jme )  :: V10_URB2D   !urban local var
    862. 

  862.      REAL,  DIMENSION( ims:ime, jms:jme )  :: TH2_URB2D   !urban local var
    863. 

  863.      REAL,  DIMENSION( ims:ime, jms:jme )  :: Q2_URB2D    !urban local var
    864. 

  864.      REAL,  DIMENSION( ims:ime, jms:jme )  :: UST_URB2D  !urban local var
    865. 

  865. !--------fds (06/2010)---------------------------------------------
    866. 

  866.      REAL,  DIMENSION( ims:ime, kms:kme, jms:jme ),               &
    867. 

  867.             OPTIONAL, INTENT(IN) ::                                 CLDFRA
    868. 

  868.      REAL             ::                            DAY, CLOUDFRAC
    869. 

  869. !------------------------------------------------------------------
    870. 

  870. !
    871. 

  871.      REAL, DIMENSION( ims:ime, jms:jme ) :: HFX_SEA
    872. 

  872.      REAL, DIMENSION( ims:ime, jms:jme ) :: QFX_SEA
    873. 

  873.      REAL, DIMENSION( ims:ime, jms:jme ) :: LH_SEA
    874. 

  874.      REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_SEA
    875. 

  875.      REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_SEA
    876. 

  876.      REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_SEA
    877. 

  877. 

  878.      REAL, DIMENSION( ims:ime, jms:jme ) :: CHS_SEA
    879. 

  879.      REAL, DIMENSION( ims:ime, jms:jme ) :: CHS2_SEA
    880. 

  880.      REAL, DIMENSION( ims:ime, jms:jme ) :: CQS2_SEA
    881. 

  881.      REAL, DIMENSION( ims:ime, jms:jme ) :: CPM_SEA
    882. 

  882.      REAL, DIMENSION( ims:ime, jms:jme ) :: FLHC_SEA
    883. 

  883.      REAL, DIMENSION( ims:ime, jms:jme ) :: FLQC_SEA
    884. 

  884.      REAL, DIMENSION( ims:ime, jms:jme ) :: QGH_SEA
    885. 

  885. !
    886. 

  886.      REAL, DIMENSION( ims:ime, jms:jme ) :: PSIH_SEA
    887. 

  887.      REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_SEA
    888. 

  888.      REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_SEA
    889. 

  889.      REAL, DIMENSION( ims:ime, jms:jme ) :: UST_SEA
    890. 

  890.      REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_SEA
    891. 

  891.      REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
    892. 

  892. !
    893. 

  893.    REAL   :: xice_threshold
    894. 

  894. !
    895. 

  895. 

  896. 

  897. !------------------------------------------------------------------
    898. 

  898.    CHARACTER*256 :: message
    899. 

  899.    REAL    :: next_bl_time
    900. 

  900.    LOGICAL :: run_param , doing_adapt_dt , decided
    901. 

  901.    LOGICAL :: do_adapt
    902. 

  902. !
    903. 

  903. !
    904. 

  904. !------------------------------------------------------------------
    905. 

  905. !
    906. 

  906. ! stop run if using ssib and fractional seaice=0  (fds 12/2010)
    907. 

  907.   if(sf_surface_physics .eq. SSIBSCHEME .and. fractional_seaice .eq. 0) then
    908. 

  908.     WRITE( message,* ) 'Please activate fractional seaice option when using SSiB model'
    909. 

  909.     CALL wrf_error_fatal ( message )
    910. 

  910.   endif
    911. 

  911. 

  912.   if (sf_sfclay_physics .eq. 0) return
    913. 

  913. 

  914.   if ( fractional_seaice == 0 ) then
    915. 

  915.      xice_threshold = 0.5
    916. 

  916.   else if ( fractional_seaice == 1 ) then
    917. 

  917.      xice_threshold = 0.02
    918. 

  918.   endif
    919. 

  919. 

  920. 

  921.   v_phytmp = 0.
    922. 

  922.   u_phytmp = 0.
    923. 

  923.   ZOL = 0.
    924. 

  924.   QGH = 0.
    925. 

  925.   CHS = 0.
    926. 

  926.   CPM = 0.
    927. 

  927.   CHS2 = 0.
    928. 

  928.   DTMIN = 0.
    929. 

  929.   DTBL = 0.
    930. 

  930. 

  931. ! RAINBL in mm (Accumulation between PBL calls)
    932. 

  932. 

  933.   IF ( PRESENT( rainncv ) .AND. PRESENT( rainbl ) ) THEN
    934. 

  934.     !$OMP PARALLEL DO   &
    935. 

  935.     !$OMP PRIVATE ( ij, i, j, k )
    936. 

  936.     DO ij = 1 , num_tiles
    937. 

  937.       DO j=j_start(ij),j_end(ij)
    938. 

  938.       DO i=i_start(ij),i_end(ij)
    939. 

  939.          RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j) + RAINNCV(i,j)
    940. 

  940.          IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
    941. 

  941.          RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
    942. 

  942.       ENDDO
    943. 

  943.       ENDDO
    944. 

  944.     ENDDO
    945. 

  945.     !$OMP END PARALLEL DO
    946. 

  946.   ELSE IF ( PRESENT( rainbl ) ) THEN
    947. 

  947.     !$OMP PARALLEL DO   &
    948. 

  948.     !$OMP PRIVATE ( ij, i, j, k )
    949. 

  949.     DO ij = 1 , num_tiles
    950. 

  950.       DO j=j_start(ij),j_end(ij)
    951. 

  951.       DO i=i_start(ij),i_end(ij)
    952. 

  952.          RAINBL(i,j) = RAINBL(i,j) + RAINCV(i,j)
    953. 

  953.          IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j)
    954. 

  954.          RAINBL(i,j) = MAX (RAINBL(i,j), 0.0)
    955. 

  955.       ENDDO
    956. 

  956.       ENDDO
    957. 

  957.     ENDDO
    958. 

  958.     !$OMP END PARALLEL DO
    959. 

  959.   ENDIF
    960. 

  960. ! Update SST
    961. 

  961.   IF (sst_update .EQ. 1) THEN
    962. 

  962.     !$OMP PARALLEL DO   &
    963. 

  963.     !$OMP PRIVATE ( ij, i, j, k )
    964. 

  964.     DO ij = 1 , num_tiles
    965. 

  965.       DO j=j_start(ij),j_end(ij)
    966. 

  966.       DO i=i_start(ij),i_end(ij)
    967. 

  967. 

  968.          IF ( FRACTIONAL_SEAICE == 1 ) then
    969. 

  969.             IF ( ( XICE(I,J) .NE. XICEM(I,J) ) .AND. ( XICEM(I,J) .GT. XICE_THRESHOLD ) ) THEN
    970. 

  970.                ! Fractional values of ALBEDO and EMISSIVITY are valid according to the 
    971. 

  971.                ! earlier fractional seaice value, XICEM.  Recompute them for the new 
    972. 

  972.                ! seaice value XICE.
    973. 

  973.                ALBEDO(I,J) = 0.08 + XICE(I,J)/XICEM(I,J) * ( ALBEDO(I,J) - 0.08 )
    974. 

  974.                EMISS (I,J) = 0.98 + XICE(I,J)/XICEM(I,J) * ( EMISS (I,J) - 0.98 )
    975. 

  975.             ENDIF
    976. 

  976.          ENDIF
    977. 

  977. 

  978.         IF ( XLAND(i,j) .GT. 1.5 .AND. XICE(I,J) .GE. XICE_THRESHOLD .AND. XICEM(I,J) .LT. XICE_THRESHOLD ) THEN
    979. 

  979. ! water point turns to sea-ice point
    980. 

  980.           XICEM(I,J) = XICE(I,J)
    981. 

  981.           XLAND(I,J) = 1.
    982. 

  982.           IVGTYP(I,J) = ISICE
    983. 

  983.           ISLTYP(I,J) = 16
    984. 

  984.           VEGFRA(I,J) = 0.
    985. 

  985.           TMN(I,J) = 271.4
    986. 

  986.           ! Over new ice, initial guesses of ALBEDO and EMISS are
    987. 

  987.           ! based on default water and ice values for albedo and
    988. 

  988.           ! emissivity.  The land-surface schemes can update these
    989. 

  989.           ! values
    990. 

  990.           ALBEDO(I,J) = 0.80 * XICE(I,J) + 0.08 * ( 1.0-XICE(I,J) )
    991. 

  991.           ALBBCK(I,J) = 0.80
    992. 

  992.           EMISS(I,J)  = 0.98 * XICE(I,J) + 0.98 * ( 1.0-XICE(I,J) )
    993. 

  993.           EMBCK(I,J)  = 0.98
    994. 

  994.           DO nk = 1, num_soil_layers
    995. 

  995.             TSLB(I,NK,J) = TSK(I,J)
    996. 

  996.             SMOIS(I,NK,J) = 1.0
    997. 

  997.             SH2O(I,NK,J) = 0.0
    998. 

  998.           ENDDO
    999. 

  999.         ENDIF
    1000. 

  1000.         IF(XLAND(i,j) .GT. 1.5) THEN
    1001. 

  1001.           IF ( SST(i,j) .LT. 350. .and. SST(i,j) .GT. 250.) THEN
    1002. 

  1002.             TSK(i,j)   =SST(i,j)
    1003. 

  1003.             TSLB(i,1,j)=SST(i,j)
    1004. 

  1004.           ENDIF
    1005. 

  1005.         ENDIF
    1006. 

  1006.         IF ( XLAND(i,j) .LT. 1.5 .AND. XICEM(I,J) .GE. XICE_THRESHOLD .AND. XICE(I,J) .LT. XICE_THRESHOLD ) THEN
    1007. 

  1007. ! sea-ice point turns to water point
    1008. 

  1008.           XICEM(I,J) = XICE(I,J)
    1009. 

  1009.           XLAND(I,J) = 2.
    1010. 

  1010.           IVGTYP(I,J) = ISWATER
    1011. 

  1011.           ISLTYP(I,J) = 14
    1012. 

  1012.           VEGFRA(I,J) = 0.
    1013. 

  1013.           SNOW(I,J)  = 0.
    1014. 

  1014.           SNOWC(I,J) = 0.
    1015. 

  1015.           SNOWH(I,J) = 0.
    1016. 

  1016.           TMN(I,J) = SST(I,J)
    1017. 

  1017.           ALBEDO(I,J) = 0.08
    1018. 

  1018.           ALBBCK(I,J) = 0.08
    1019. 

  1019.           EMISS(I,J)  = 0.98
    1020. 

  1020.           EMBCK(I,J)  = 0.98
    1021. 

  1021.           DO nk = 1, num_soil_layers
    1022. 

  1022.             TSLB(I,NK,J) = SST(I,J)
    1023. 

  1023.             SMOIS(I,NK,J) = 1.0
    1024. 

  1024.             SH2O(I,NK,J) = 1.0
    1025. 

  1025.           ENDDO
    1026. 

  1026.         ENDIF
    1027. 

  1027. 

  1028.         XICEM(i,j) = XICE(i,j)
    1029. 

  1029. 

  1030.       ENDDO
    1031. 

  1031.       ENDDO
    1032. 

  1032.     ENDDO
    1033. 

  1033.     !$OMP END PARALLEL DO
    1034. 

  1034.   ENDIF
    1035. 

  1035. 

  1036.   IF(PRESENT(SST_SKIN))THEN
    1037. 

  1037.     IF (sst_skin .EQ. 1) THEN
    1038. 

  1038. ! Calculate skin sst based on Zeng and Beljaars (2005)
    1039. 

  1039.       CALL wrf_debug( 100, 'in SST_SKIN_UPDATE' )
    1040. 

  1040.       !$OMP PARALLEL DO   &
    1041. 

  1041.       !$OMP PRIVATE ( ij, i, j, k )
    1042. 

  1042.       DO ij = 1 , num_tiles
    1043. 

  1043.         DO j=j_start(ij),j_end(ij)
    1044. 

  1044.           DO i=i_start(ij),i_end(ij)
    1045. 

  1045.             IF(XLAND(i,j) .GT. 1.5 .and. sst_update .NE. 1) THEN
    1046. 

  1046.               TSK(i,j)   =SST(i,j)
    1047. 

  1047.               TSLB(i,1,j)=SST(i,j)
    1048. 

  1048.             ENDIF
    1049. 

  1049.           ENDDO
    1050. 

  1050.         ENDDO
    1051. 

  1051.         CALL sst_skin_update(xland,glw,gsw,hfx,qfx,tsk,ust,         &
    1052. 

  1052.                 emiss,dtw,sstsk,dt,stbolt,                          &
    1053. 

  1053.                 ids, ide, jds, jde, kds, kde,                       &
    1054. 

  1054.                 ims, ime, jms, jme, kms, kme,                       &
    1055. 

  1055.                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1056. 

  1056.         DO j=j_start(ij),j_end(ij)
    1057. 

  1057.           DO i=i_start(ij),i_end(ij)
    1058. 

  1058.             IF(XLAND(i,j) .GT. 1.5)TSK(i,j)=SSTSK(i,j)
    1059. 

  1059.           ENDDO
    1060. 

  1060.         ENDDO
    1061. 

  1061.       ENDDO
    1062. 

  1062.     !$OMP END PARALLEL DO
    1063. 

  1063.     ENDIF
    1064. 

  1064.   ENDIF
    1065. 

  1065. 

  1066.   IF(PRESENT(TMN_UPDATE))THEN
    1067. 

  1067.   IF (tmn_update .EQ. 1) THEN
    1068. 

  1068.       CALL wrf_debug( 100, 'in TMN_UPDATE' )
    1069. 

  1069.       CALL tmnupdate(tsk,tmn,tlag,tyr,tyra,tdly,nday,nyear,lagday, &
    1070. 

  1070.                 julian_in, dt, yr,                                  &
    1071. 

  1071.                 ids, ide, jds, jde, kds, kde,                       &
    1072. 

  1072.                 ims, ime, jms, jme, kms, kme,                       &
    1073. 

  1073.                 i_start,i_end, j_start,j_end, kts,kte, num_tiles   )
    1074. 

  1074. 

  1075.   ENDIF
    1076. 

  1076.   ENDIF
    1077. 

  1077. !
    1078. 

  1078. ! Modified for adaptive time step
    1079. 

  1079. !
    1080. 

  1080.    doing_adapt_dt = .FALSE.
    1081. 

  1081.    IF ( PRESENT(adapt_step_flag) ) THEN
    1082. 

  1082.       IF ( adapt_step_flag ) THEN
    1083. 

  1083.          doing_adapt_dt = .TRUE.
    1084. 

  1084.       END IF
    1085. 

  1085.    END IF
    1086. 

  1086. 

  1087. !  Do we run through this scheme or not?
    1088. 

  1088. 

  1089. !    Test 1:  If this is the initial model time, then yes.
    1090. 

  1090. !                ITIMESTEP=1
    1091. 

  1091. !    Test 2:  If the user asked for the surface to be run every time step, then yes.
    1092. 

  1092. !                BLDT=0 or STEPBL=1
    1093. 

  1093. !    Test 3:  If not adaptive dt, and this is on the requested surface frequency, then yes.
    1094. 

  1094. !                MOD(ITIMESTEP,STEPBL)=0
    1095. 

  1095. !    Test 4:  If using adaptive dt and the current time is past the last requested activate surface time, then yes.
    1096. 

  1096. !                CURR_SECS >= BLDTACTTIME
    1097. 

  1097. 

  1098. !  If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
    1099. 

  1099. !  to TRUE.  The decided flag says that one of these tests was able to say "yes", run the scheme.
    1100. 

  1100. !  We only proceed to other tests if the previous tests all have left decided as FALSE.
    1101. 

  1101. 

  1102.    run_param = .FALSE.
    1103. 

  1103.    decided = .FALSE.
    1104. 

  1104.    IF ( ( .NOT. decided ) .AND. &
    1105. 

  1105.         ( itimestep .EQ. 1 ) ) THEN
    1106. 

  1106.       run_param   = .TRUE.
    1107. 

  1107.       decided     = .TRUE.
    1108. 

  1108.    END IF
    1109. 

  1109. 

  1110.    IF ( PRESENT(bldt) )THEN
    1111. 

  1111.       IF ( ( .NOT. decided ) .AND. &
    1112. 

  1112.            ( ( bldt .EQ. 0. ) .OR. ( stepbl .EQ. 1 ) ) ) THEN
    1113. 

  1113.          run_param   = .TRUE.
    1114. 

  1114.          decided     = .TRUE.
    1115. 

  1115.       END IF
    1116. 

  1116.    ELSE
    1117. 

  1117.       IF ( ( .NOT. decided ) .AND. &
    1118. 

  1118.                                    ( stepbl .EQ. 1 )   ) THEN
    1119. 

  1119.          run_param   = .TRUE.
    1120. 

  1120.          decided     = .TRUE.
    1121. 

  1121.       END IF
    1122. 

  1122.    END IF
    1123. 

  1123. 

  1124.    IF ( ( .NOT. decided ) .AND. &
    1125. 

  1125.         ( .NOT. doing_adapt_dt ) .AND. &
    1126. 

  1126.         ( MOD(itimestep,stepbl) .EQ. 0 ) ) THEN
    1127. 

  1127.       run_param   = .TRUE.
    1128. 

  1128.       decided     = .TRUE.
    1129. 

  1129.    END IF
    1130. 

  1130. 

  1131.    IF ( ( .NOT. decided ) .AND. &
    1132. 

  1132.         ( doing_adapt_dt ) .AND. &
    1133. 

  1133.         ( curr_secs .GE. bldtacttime ) ) THEN
    1134. 

  1134.       run_param   = .TRUE.
    1135. 

  1135.       decided     = .TRUE.
    1136. 

  1136.    END IF
    1137. 

  1137. 

  1138.   IF ( run_param ) then
    1139. 

  1139. 

  1140.   radiation = .false.
    1141. 

  1141.   frpcpn = .false.
    1142. 

  1142.   myj    = ((sf_sfclay_physics .EQ. MYJSFCSCHEME) .OR. &
    1143. 

  1143.             (sf_sfclay_physics .EQ. QNSESFCSCHEME) )
    1144. 

  1144.   isisfc = ( FRACTIONAL_SEAICE .EQ. 1  .AND. (          &
    1145. 

  1145.             (sf_sfclay_physics .EQ. SFCLAYSCHEME ) .OR. &
    1146. 

  1146.             (sf_sfclay_physics .EQ. PXSFCSCHEME  ) .OR. &
    1147. 

  1147.             (sf_sfclay_physics .EQ. MYJSFCSCHEME ) .OR. &
    1148. 

  1148.             (sf_sfclay_physics .EQ. GFSSFCSCHEME ) )    &
    1149. 

  1149.            )
    1150. 

  1150. 

  1151.   IF (ra_lw_physics .gt. 0) radiation = .true.
    1152. 

  1152. 

  1153.   IF( PRESENT(slope_rad).AND. radiation )THEN
    1154. 

  1154. ! topographic slope effects modify SWDOWN and GSW here
    1155. 

  1155.     IF (slope_rad .EQ. 1) THEN
    1156. 

  1156.     !$OMP PARALLEL DO   &
    1157. 

  1157.     !$OMP PRIVATE ( ij, i, j, k )
    1158. 

  1158.     DO ij = 1 , num_tiles
    1159. 

  1159.            CALL TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN,             &
    1160. 

  1160.                     shadowmask,                                   &
    1161. 

  1161.                     declin,                                       &
    1162. 

  1162.                     SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang,       &
    1163. 

  1163.                     slope,slp_azi,                                &
    1164. 

  1164.                 ids, ide, jds, jde, kds, kde,                     &
    1165. 

  1165.                 ims, ime, jms, jme, kms, kme,                     &
    1166. 

  1166.                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1167. 

  1167.     ENDDO
    1168. 

  1168.     !$OMP END PARALLEL DO
    1169. 

  1169. 

  1170.     ENDIF
    1171. 

  1171.   ENDIF
    1172. 

  1172. !----
    1173. 

  1173. ! CALCULATE CONSTANT
    1174. 

  1174. 

  1175.      DTMIN=DT/60.
    1176. 

  1176. ! Surface schemes need PBL time step for updates and accumulations
    1177. 

  1177. ! Assume these schemes provide no tendencies
    1178. 

  1178. 

  1179.     if (PRESENT(adapt_step_flag)) then
    1180. 

  1180.        if (adapt_step_flag) then
    1181. 

  1181.           do_adapt = .TRUE.
    1182. 

  1182.        else
    1183. 

  1183.           do_adapt = .FALSE.
    1184. 

  1184.        endif
    1185. 

  1185.     else
    1186. 

  1186.        do_adapt = .FALSE.
    1187. 

  1187.     endif
    1188. 

  1188. 

  1189.     if (PRESENT(BLDT)) then
    1190. 

  1190.        if (bldt .eq. 0) then
    1191. 

  1191.           DTBL = dt
    1192. 

  1192.        ELSE
    1193. 

  1193.           if (do_adapt) then
    1194. 

  1194.              IF ( curr_secs .LT. 2. * dt ) THEN
    1195. 

  1195.                 call wrf_message("WARNING: When using an adaptive time-step the boundary layer"// &
    1196. 

  1196.                                  " time-step should be 0 (i.e., equivalent to model time-step)." )
    1197. 

  1197.                 call wrf_message("In order to proceed, for surface calculations, the "// &
    1198. 

  1198.                                  "boundary layer time-step"// &
    1199. 

  1199.                                  " will be rounded to the nearest minute," )
    1200. 

  1200.                 call wrf_message("possibly resulting in innacurate results.")
    1201. 

  1201.              END IF
    1202. 

  1202.              DTBL=bldt*60
    1203. 

  1203.           else
    1204. 

  1204.              DTBL=DT*STEPBL
    1205. 

  1205.           endif
    1206. 

  1206.        endif
    1207. 

  1207.     else
    1208. 

  1208.        DTBL=DT*STEPBL
    1209. 

  1209.     endif
    1210. 

  1210. 

  1211. ! SAVE OLD VALUES
    1212. 

  1212. 

  1213. 

  1214.      !$OMP PARALLEL DO   &
    1215. 

  1215.      !$OMP PRIVATE ( ij, i, j, k )
    1216. 

  1216.      DO ij = 1 , num_tiles
    1217. 

  1217.        DO j=j_start(ij),j_end(ij)
    1218. 

  1218.        DO i=i_start(ij),i_end(ij)
    1219. 

  1219. ! PSFC : in Pa
    1220. 

  1220.           PSFC(I,J)=p8w(I,kts,J)
    1221. 

  1221. ! REVERSE ORDER IN THE VERTICAL DIRECTION
    1222. 

  1222.           DO k=kts,kte
    1223. 

  1223.             v_phytmp(i,k,j)=v_phy(i,k,j)+v_frame
    1224. 

  1224.             u_phytmp(i,k,j)=u_phy(i,k,j)+u_frame
    1225. 

  1225.           ENDDO
    1226. 

  1226.        ENDDO
    1227. 

  1227.        ENDDO
    1228. 

  1228.      ENDDO
    1229. 

  1229.      !$OMP END PARALLEL DO
    1230. 

  1230. 

  1231.      !$OMP PARALLEL DO   &
    1232. 

  1232.      !$OMP PRIVATE ( ij, i, j, k )
    1233. 

  1233.      DO ij = 1 , num_tiles
    1234. 

  1234.      sfclay_select: SELECT CASE(sf_sfclay_physics)
    1235. 

  1235. 

  1236.      CASE (SFCLAYSCHEME)
    1237. 

  1237. ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
    1238. 

  1238. ! because it takes a scalar DX. NMM passes in a dummy value for this
    1239. 

  1239. ! scalar.  NEEDS FURTHER ATTENTION. JM 20050215
    1240. 

  1240.        IF(PRESENT(SCM_FORCE_FLUX))THEN
    1241. 

  1241.          IF (scm_force_flux .EQ. 1) THEN
    1242. 

  1242. ! surface forcing by observed fluxes
    1243. 

  1243.          CALL scmflux(u_phytmp, v_phytmp, t_phy, qv_curr, p_phy, dz8w,   &
    1244. 

  1244.                      cp, rovcp, xlv, psfc, cpm, xland,                   &
    1245. 

  1245.                      psim, psih, hfx, qfx, lh, tsk, flhc, flqc,          &
    1246. 

  1246.                      znt, gz1oz0, wspd,                                  &
    1247. 

  1247.                      julian_in, karman, p1000mb,                         &
    1248. 

  1248.                      itimestep,chklowq,                                  &
    1249. 

  1249.                      ids, ide, jds, jde, kds, kde,                       &
    1250. 

  1250.                      ims, ime, jms, jme, kms, kme,                       &
    1251. 

  1251.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1252. 

  1252.          ENDIF
    1253. 

  1253.        ENDIF
    1254. 

  1254.        IF(PRESENT(SCM_FORCE_SKINTEMP))THEN
    1255. 

  1255.          IF (scm_force_skintemp .EQ. 1) THEN
    1256. 

  1256. ! surface forcing by observed skin temperature
    1257. 

  1257.          CALL scmskintemp(tsk, julian_in, itimestep,                     &
    1258. 

  1258.                      ids, ide, jds, jde, kds, kde,                       &
    1259. 

  1259.                      ims, ime, jms, jme, kms, kme,                       &
    1260. 

  1260.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1261. 

  1261.          ENDIF
    1262. 

  1262. !         IF (scm_force_skintemp .EQ. 2) THEN
    1263. 

  1263. ! surface forcing by gabls2 skin temperature
    1264. 

  1264. !         CALL scmgabls2(tsk, itimestep, dt,                              &
    1265. 

  1265. !                     ids, ide, jds, jde, kds, kde,                       &
    1266. 

  1266. !                     ims, ime, jms, jme, kms, kme,                       &
    1267. 

  1267. !                     i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1268. 

  1268. !         ENDIF
    1269. 

  1269.        ENDIF
    1270. 

  1270.        IF (PRESENT(qv_curr)                            .AND.    &
    1271. 

  1271.            PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
    1272. 

  1272.                                                       .TRUE. ) THEN
    1273. 

  1273.          CALL wrf_debug( 100, 'in SFCLAY' )
    1274. 

  1274.          IF ( FRACTIONAL_SEAICE == 1 ) THEN
    1275. 

  1275.             CALL SFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
    1276. 

  1276.                  p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1277. 

  1277.                  znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
    1278. 

  1278.                  xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1279. 

  1279.                  u10,v10,th2,t2,q2,                                  &
    1280. 

  1280.                  gz1oz0,wspd,br,isfflx,dx,                           &
    1281. 

  1281.                  svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
    1282. 

  1282.                  P1000mb,                                            &
    1283. 

  1283.                  XICE,SST,TSK_SEA,                                                  &
    1284. 

  1284.                  CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA,               &
    1285. 

  1285.                  HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA,                   &
    1286. 

  1286.                  ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD,                         &
    1287. 

  1287.                  ids,ide, jds,jde, kds,kde,                          &
    1288. 

  1288.                  ims,ime, jms,jme, kms,kme,                          &
    1289. 

  1289.                  i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
    1290. 

  1290.                  ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,                &
    1291. 

  1291.                  sf_surface_physics  )
    1292. 

  1292.          ELSE
    1293. 

  1293.          CALL SFCLAY(u_phytmp,v_phytmp,t_phy,qv_curr,              &
    1294. 

  1294.                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1295. 

  1295.                znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
    1296. 

  1296.                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1297. 

  1297.                u10,v10,th2,t2,q2,                                  &
    1298. 

  1298.                gz1oz0,wspd,br,isfflx,dx,                           &
    1299. 

  1299.                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
    1300. 

  1300.                P1000mb,                                            &
    1301. 

  1301.                ids,ide, jds,jde, kds,kde,                          &
    1302. 

  1302.                ims,ime, jms,jme, kms,kme,                          &
    1303. 

  1303.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
    1304. 

  1304.                ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,scm_force_flux  )
    1305. 

  1305. #if ( EM_CORE==1)
    1306. 

  1306.            DO j = j_start(ij),j_end(ij)
    1307. 

  1307.            DO i = i_start(ij),i_end(ij)
    1308. 

  1308.              ch(i,j) = chs (i,j)
    1309. 

  1309. !!             ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
    1310. 

  1310.            end do
    1311. 

  1311.            end do
    1312. 

  1312. #endif
    1313. 

  1313.          ENDIF
    1314. 

  1314.        ELSE
    1315. 

  1315.          CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
    1316. 

  1316.        ENDIF
    1317. 

  1317. 

  1318.      CASE (SFCLAYREVSCHEME)
    1319. 

  1319. ! DX varies spatially in NMM, therefore, SFCLAY cannot be called
    1320. 

  1320. ! because it takes a scalar DX. NMM passes in a dummy value for this
    1321. 

  1321. ! scalar.  NEEDS FURTHER ATTENTION. JM 20050215
    1322. 

  1322.        IF (PRESENT(qv_curr)                            .AND.    &
    1323. 

  1323.            PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
    1324. 

  1324.                                                       .TRUE. ) THEN
    1325. 

  1325.          CALL wrf_debug( 100, 'in SFCLAY' )
    1326. 

  1326. !         IF ( FRACTIONAL_SEAICE == 1 ) THEN
    1327. 

  1327. !            CALL SFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr,&
    1328. 

  1328. !                 p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1329. 

  1329. !                 znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
    1330. 

  1330. !                 xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1331. 

  1331. !                 u10,v10,th2,t2,q2,                                  &
    1332. 

  1332. !                 gz1oz0,wspd,br,isfflx,dx,                           &
    1333. 

  1333. !                 svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
    1334. 

  1334. !                 P1000mb,                                            &
    1335. 

  1335. !                 XICE,SST,TSK_SEA,
    1336. 

  1336. !&
    1337. 

  1337. !                 CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA,
    1338. 

  1338. !&
    1339. 

  1339. !                 HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA,
    1340. 

  1340. !&
    1341. 

  1341. !                 ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD,
    1342. 

  1342. !&
    1343. 

  1343. !                 ids,ide, jds,jde, kds,kde,                          &
    1344. 

  1344. !                 ims,ime, jms,jme, kms,kme,                          &
    1345. 

  1345. !                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
    1346. 

  1346. !                 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd                 )
    1347. 

  1347. !         ELSE
    1348. 

  1348.          CALL SFCLAYREV(u_phytmp,v_phytmp,t_phy,qv_curr,&
    1349. 

  1349.                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1350. 

  1350.                znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
    1351. 

  1351.                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1352. 

  1352.                u10,v10,th2,t2,q2,                                  &
    1353. 

  1353.                gz1oz0,wspd,br,isfflx,dx,                           &
    1354. 

  1354.                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
    1355. 

  1355.                P1000mb,                                            &
    1356. 

  1356.                ids,ide, jds,jde, kds,kde,                          &
    1357. 

  1357.                ims,ime, jms,jme, kms,kme,                          &
    1358. 

  1358.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
    1359. 

  1359.                ustm,ck,cka,cd,cda,isftcflx,iz0tlnd                 )
    1360. 

  1360. #if ( EM_CORE==1)
    1361. 

  1361.            DO j = j_start(ij),j_end(ij)
    1362. 

  1362.            DO i = i_start(ij),i_end(ij)
    1363. 

  1363.              ch(i,j) = chs (i,j)
    1364. 

  1364. !!             ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
    1365. 

  1365.            end do
    1366. 

  1366.            end do
    1367. 

  1367. #endif
    1368. 

  1368. !         ENDIF
    1369. 

  1369.        ELSE
    1370. 

  1370.          CALL wrf_error_fatal('Lacking arguments for SFCLAY in surface driver')
    1371. 

  1371.        ENDIF
    1372. 

  1372. 

  1373.      CASE (PXSFCSCHEME)
    1374. 

  1374. #if (NMM_CORE != 1)
    1375. 

  1375.        IF (PRESENT(qv_curr)                            .AND.    &
    1376. 

  1376.            PRESENT(mol)        .AND.  PRESENT(regime)  .AND.    &
    1377. 

  1377.                                                       .TRUE. ) THEN
    1378. 

  1378.          CALL wrf_debug( 100, 'in PX Surface Layer scheme' )
    1379. 

  1379.          IF ( FRACTIONAL_SEAICE == 1 ) THEN
    1380. 

  1380.             CALL WRF_ERROR_FATAL("PXSFCLAY not adapted for FRACTIONAL_SEAICE=1 option")
    1381. 

  1381.             CALL PXSFCLAY_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
    1382. 

  1382.                  p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1383. 

  1383.                  znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
    1384. 

  1384.                  xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1385. 

  1385.                  u10,v10,                                            &
    1386. 

  1386.                  gz1oz0,wspd,br,isfflx,dx,                           &
    1387. 

  1387.                  svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,              &
    1388. 

  1388.                  XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD, &
    1389. 

  1389.                  CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA,FLHC_SEA,FLQC_SEA,&
    1390. 

  1390.                  HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA,  &
    1391. 

  1391.                  ids,ide, jds,jde, kds,kde,                          &
    1392. 

  1392.                  ims,ime, jms,jme, kms,kme,                          &
    1393. 

  1393.                  i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1394. 

  1394.          ELSE
    1395. 

  1395.          CALL PXSFCLAY(u_phytmp,v_phytmp,t_phy,th_phy,qv_curr,&
    1396. 

  1396.                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1397. 

  1397.                znt,ust,pblh,mavail,zol,mol,regime,psim,psih,       &
    1398. 

  1398.                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1399. 

  1399.                u10,v10,                                            &
    1400. 

  1400.                gz1oz0,wspd,br,isfflx,dx,                           &
    1401. 

  1401.                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,              &
    1402. 

  1402.                ids,ide, jds,jde, kds,kde,                          &
    1403. 

  1403.                ims,ime, jms,jme, kms,kme,                          &
    1404. 

  1404.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1405. 

  1405.          ENDIF
    1406. 

  1406.        ELSE
    1407. 

  1407.          CALL wrf_error_fatal('Lacking arguments for PX Surface Layer in surface driver')
    1408. 

  1408.        ENDIF
    1409. 

  1409. #else
    1410. 

  1410.        CALL wrf_error_fatal('PX Surface Layer scheme cannot be used with NMM')
    1411. 

  1411. #endif
    1412. 

  1412. 

  1413.       CASE (MYJSFCSCHEME)
    1414. 

  1414.        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
    1415. 

  1415.                                                       .TRUE. ) THEN
    1416. 

  1416. 

  1417.         CALL wrf_debug(100,'in MYJSFC')
    1418. 

  1418.         IF ( FRACTIONAL_SEAICE == 1 ) THEN
    1419. 

  1419.            CALL MYJSFC_SEAICE_WRAPPER(itimestep,ht,dz8w,             &
    1420. 

  1420.                 p_phy,p8w,th_phy,t_phy,                              &
    1421. 

  1421.                 qv_curr,qc_curr,                                     &
    1422. 

  1422.                 u_phy,v_phy,tke_pbl,                                 &
    1423. 

  1423.                 tsk,qsfc,thz0,qz0,uz0,vz0,                           &
    1424. 

  1424.                 lowlyr,                                              &
    1425. 

  1425.                 xland,ivgtyp,isurban,iz0tlnd,                        &
    1426. 

  1426.                 TICE2TSK_IF2COLD,                                    & ! Extra for wrapper.
    1427. 

  1427.                 XICE_THRESHOLD,                                      & ! Extra for wrapper.
    1428. 

  1428.                 XICE, SST,                                           & ! Extra for wrapper.
    1429. 

  1429.                 CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA,            &
    1430. 

  1430.                 FLHC_SEA, FLQC_SEA, QSFC_SEA, &
    1431. 

  1431.                 QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA, LH_SEA,         &
    1432. 

  1432.                 TSK_SEA,                                             &
    1433. 

  1433.                 ust,znt,z0,pblh,mavail,rmol,                         &
    1434. 

  1434.                 akhs,akms,                                           &
    1435. 

  1435.                 br,                                                 &
    1436. 

  1436.                 chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct,       &
    1437. 

  1437.                 u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr,               &
    1438. 

  1438.                 p1000mb,                                             &
    1439. 

  1439.                 ids,ide, jds,jde, kds,kde,                           &
    1440. 

  1440.                 ims,ime, jms,jme, kms,kme,                           &
    1441. 

  1441.                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1442. 

  1442.         ELSE
    1443. 

  1443.             CALL MYJSFC(itimestep,ht,dz8w,                         &
    1444. 

  1444.               p_phy,p8w,th_phy,t_phy,                              &
    1445. 

  1445.               qv_curr,qc_curr,                                      &
    1446. 

  1446.               u_phy,v_phy,tke_pbl,                                 &
    1447. 

  1447.               tsk,qsfc,thz0,qz0,uz0,vz0,                           &
    1448. 

  1448.               lowlyr,                                              &
    1449. 

  1449.               xland,ivgtyp,isurban,iz0tlnd,                        &
    1450. 

  1450.               ust,znt,z0,pblh,mavail,rmol,                         &
    1451. 

  1451.               akhs,akms,                                           &
    1452. 

  1452.               br,                                                 &
    1453. 

  1453.               chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct,       &
    1454. 

  1454.               u10,v10,t2,th2,tshltr,th10,q2,qshltr,q10,pshltr,               &
    1455. 

  1455.               p1000mb,                                             &
    1456. 

  1456.               ids,ide, jds,jde, kds,kde,                           &
    1457. 

  1457.               ims,ime, jms,jme, kms,kme,                           &
    1458. 

  1458.               i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1459. 

  1459. #if ( EM_CORE==1)
    1460. 

  1460.          DO j = j_start(ij),j_end(ij)
    1461. 

  1461.             DO i = i_start(ij),i_end(ij)
    1462. 

  1462.                wspd(i,j) = MAX(SQRT(u_phy(i,kts,j)**2+v_phy(i,kts,j)**2),0.001)
    1463. 

  1463.                ch(i,j) = chs (i,j)
    1464. 

  1464. !!           ch(i,j) = flhc(i,j)/( cpm(i,j)*rho(i,kts,j) )
    1465. 

  1465.             END DO
    1466. 

  1466.          END DO
    1467. 

  1467. #endif         
    1468. 

  1468. 

  1469.         ENDIF
    1470. 

  1470.        ELSE
    1471. 

  1471.          CALL wrf_error_fatal('Lacking arguments for MYJSFC in surface driver')
    1472. 

  1472.        ENDIF
    1473. 

  1473. 

  1474.       CASE (QNSESFCSCHEME)
    1475. 

  1475.        IF(PRESENT(SCM_FORCE_FLUX))THEN
    1476. 

  1476.          IF (scm_force_flux .EQ. 1) THEN
    1477. 

  1477. ! surface forcing by observed fluxes
    1478. 

  1478.          CALL scmflux(u_phytmp, v_phytmp, t_phy, qv_curr, p_phy, dz8w,   &
    1479. 

  1479.                      cp, rovcp, xlv, psfc, cpm, xland,                   &
    1480. 

  1480.                      psim, psih, hfx, qfx, lh, tsk, flhc, flqc,          &
    1481. 

  1481.                      znt, gz1oz0, wspd,                                  &
    1482. 

  1482.                      julian_in, karman, p1000mb,                         &
    1483. 

  1483.                      itimestep,chklowq,                                  &
    1484. 

  1484.                      ids, ide, jds, jde, kds, kde,                       &
    1485. 

  1485.                      ims, ime, jms, jme, kms, kme,                       &
    1486. 

  1486.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1487. 

  1487.          ENDIF
    1488. 

  1488.        ENDIF
    1489. 

  1489.        IF(PRESENT(SCM_FORCE_SKINTEMP))THEN
    1490. 

  1490.          IF (scm_force_skintemp .EQ. 1) THEN
    1491. 

  1491. ! surface forcing by observed skin temperature
    1492. 

  1492.          CALL scmskintemp(tsk, julian_in, itimestep,                     &
    1493. 

  1493.                      ids, ide, jds, jde, kds, kde,                       &
    1494. 

  1494.                      ims, ime, jms, jme, kms, kme,                       &
    1495. 

  1495.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte   )
    1496. 

  1496.          ENDIF
    1497. 

  1497.        ENDIF
    1498. 

  1498. 

  1499.        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
    1500. 

  1500.                                                       .TRUE. ) THEN
    1501. 

  1501.             CALL wrf_debug(100,'in QNSESFC')
    1502. 

  1502.             CALL QNSESFC(itimestep,ht,dz8w,                         &
    1503. 

  1503.               p_phy,p8w,th_phy,t_phy,                              &
    1504. 

  1504.               qv_curr,qc_curr,                                     &
    1505. 

  1505.               u_phy,v_phy,tke_pbl,                                 &
    1506. 

  1506.               tsk,qsfc,thz0,qz0,uz0,vz0,                           &
    1507. 

  1507.               lowlyr,                                              &
    1508. 

  1508.               xland,                                               &
    1509. 

  1509.               ust,znt,z0,pblh,mavail,rmol,                         &
    1510. 

  1510.               akhs,akms,                                           &
    1511. 

  1511.               br,                                                 &
    1512. 

  1512.               chs,chs2,cqs2,hfx,qfx,lh,flhc,flqc,qgh,cpm,ct,       &
    1513. 

  1513.               u10,v10,tshltr,th10,qshltr,q10,pshltr,               &
    1514. 

  1514.               ids,ide, jds,jde, kds,kde,                           &
    1515. 

  1515.               ims,ime, jms,jme, kms,kme,                           &
    1516. 

  1516.               i_start(ij),i_end(ij), j_start(ij),j_end(ij),     &
    1517. 

  1517.               kts,kte,scm_force_flux    )
    1518. 

  1518.        ELSE
    1519. 

  1519.          CALL wrf_error_fatal('Lacking arguments for QNSESFC in surface driver')
    1520. 

  1520.        ENDIF
    1521. 

  1521. 

  1522.      CASE (GFSSFCSCHEME)
    1523. 

  1523.        IF (PRESENT(qv_curr) .AND. .TRUE. ) THEN
    1524. 

  1524.        CALL wrf_debug( 100, 'in GFSSFC' )
    1525. 

  1525.        IF (FRACTIONAL_SEAICE == 1) THEN
    1526. 

  1526.           CALL SF_GFS_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr, &
    1527. 

  1527.                p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM,        &
    1528. 

  1528.                ZNT,UST,PSIM,PSIH,                                  &
    1529. 

  1529.                XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,                     &
    1530. 

  1530.                QGH,QSFC,U10,V10,                                   &
    1531. 

  1531.                GZ1OZ0,WSPD,BR,ISFFLX,                              &
    1532. 

  1532.                EP_1,EP_2,KARMAN,itimestep,                         &
    1533. 

  1533.                TICE2TSK_IF2COLD,                            &
    1534. 

  1534.                XICE_THRESHOLD,                              &
    1535. 

  1535.                CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA,        &
    1536. 

  1536.                FLHC_SEA, FLQC_SEA,                          &
    1537. 

  1537.                HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, &
    1538. 

  1538.                UST_SEA, ZNT_SEA, SST, XICE,                 &
    1539. 

  1539.                ids,ide, jds,jde, kds,kde,                          &
    1540. 

  1540.                ims,ime, jms,jme, kms,kme,                          &
    1541. 

  1541.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1542. 

  1542.       ELSE
    1543. 

  1543.          CALL SF_GFS(u_phytmp,v_phytmp,t_phy,qv_curr,              &
    1544. 

  1544.                p_phy,CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM,        &
    1545. 

  1545.                ZNT,UST,PSIM,PSIH,                                  &
    1546. 

  1546.                XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,                     &
    1547. 

  1547.                QGH,QSFC,U10,V10,                                   &
    1548. 

  1548.                GZ1OZ0,WSPD,BR,ISFFLX,                              &
    1549. 

  1549.                EP_1,EP_2,KARMAN,itimestep,                         &
    1550. 

  1550.                ids,ide, jds,jde, kds,kde,                          &
    1551. 

  1551.                ims,ime, jms,jme, kms,kme,                          &
    1552. 

  1552.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1553. 

  1553.       ENDIF
    1554. 

  1554.         CALL wrf_debug(100,'in SFCDIAGS')
    1555. 

  1555.        ELSE
    1556. 

  1556.          CALL wrf_error_fatal('Lacking arguments for SF_GFS in surface driver')
    1557. 

  1557.       ENDIF
    1558. 

  1558. 

  1559. #if ( EM_CORE==1)
    1560. 

  1560.     CASE(MYNNSFCSCHEME)
    1561. 

  1561. 

  1562.        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr)     &
    1563. 

  1563.             & .AND.  PRESENT(qcg) ) THEN
    1564. 

  1564.           
    1565. 

  1565.           CALL wrf_debug(100,'in MYNNSFC')          
    1566. 

  1566. 

  1567.          IF (FRACTIONAL_SEAICE == 1) THEN
    1568. 

  1568.           CALL MYNN_SEAICE_WRAPPER(u_phytmp,v_phytmp,t_phy,qv_curr, &
    1569. 

  1569.                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1570. 

  1570.                znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
    1571. 

  1571.                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1572. 

  1572.                u10,v10,th2,t2,q2,                                  &
    1573. 

  1573.                gz1oz0,wspd,br,isfflx,dx,                           &
    1574. 

  1574.                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
    1575. 

  1575.                &itimestep,ch,th_phy,pi_phy,qc_curr,&
    1576. 

  1576.                &tsq,qsq,cov,qcg,&
    1577. 

  1577.                XICE,SST,TSK_SEA,                                   &
    1578. 

  1578.                CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA, &
    1579. 

  1579.                HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA,    &
    1580. 

  1580.                TICE2TSK_IF2COLD,XICE_THRESHOLD,                                     &
    1581. 

  1581.                ids,ide, jds,jde, kds,kde,                          &
    1582. 

  1582.                ims,ime, jms,jme, kms,kme,                          &
    1583. 

  1583.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1584. 

  1584.          ELSE
    1585. 

  1585.           CALL SFCLAY_mynn(u_phytmp,v_phytmp,t_phy,qv_curr,&
    1586. 

  1586.                p_phy,dz8w,cp,g,rcp,r_d,xlv,psfc,chs,chs2,cqs2,cpm, &
    1587. 

  1587.                znt,ust,pblh,mavail,zol,mol,regime,psim,psih, &
    1588. 

  1588.                xland,hfx,qfx,lh,tsk,flhc,flqc,qgh,qsfc,rmol,       &
    1589. 

  1589.                u10,v10,th2,t2,q2,                                  &
    1590. 

  1590.                gz1oz0,wspd,br,isfflx,dx,                           &
    1591. 

  1591.                svp1,svp2,svp3,svpt0,ep_1,ep_2,karman,eomeg,stbolt, &
    1592. 

  1592.                &itimestep,ch,th_phy,pi_phy,qc_curr,&
    1593. 

  1593.                &tsq,qsq,cov,qcg,&
    1594. 

  1594.                ids,ide, jds,jde, kds,kde,                          &
    1595. 

  1595.                ims,ime, jms,jme, kms,kme,                          &
    1596. 

  1596.                i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1597. 

  1597.          ENDIF
    1598. 

  1598.        ELSE
    1599. 

  1599.           CALL wrf_error_fatal('Lacking arguments for SFCLAY_mynn in surface driver')
    1600. 

  1600.  
    1601. 

  1601.        ENDIF
    1602. 

  1602. #endif
    1603. 

  1603. 

  1604. #if ( EM_CORE==1)
    1605. 

  1605.      CASE (TEMFSFCSCHEME)
    1606. 

  1606.        IF (PRESENT(qv_curr).and.PRESENT(hd_temf)) THEN
    1607. 

  1607.          CALL wrf_debug( 100, 'in TEMFSFCLAY' )
    1608. 

  1608. ! WA 9/7/09 must initialize Z0 and ZNT for TEMF in ideal cases
    1609. 

  1609.        ! DO J=j_start(ij),j_end(ij)
    1610. 

  1610.        ! DO I=i_start(ij),i_end(ij)
    1611. 

  1611.        !    CHKLOWQ(i,j) = 1.0
    1612. 

  1612.        !    Z0(i,j) = 0.03      ! For GABLS2
    1613. 

  1613.        !    ZNT(i,j) = 0.03     ! For GABLS2
    1614. 

  1614.        ! ENDDO
    1615. 

  1615.        ! ENDDO
    1616. 

  1616.          CALL TEMFSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy,    &
    1617. 

  1617.                qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
    1618. 

  1618.                CP=cp,G=g,ROVCP=rovcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
    1619. 

  1619.                chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust,        &
    1620. 

  1620.                MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh,   &
    1621. 

  1621.                TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc,      &
    1622. 

  1622.                U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2,                &
    1623. 

  1623.                SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
    1624. 

  1624.                EP2=ep_2,KARMAN=karman,fCor=fCor,te_temf=te_temf,   &
    1625. 

  1625.                hd_temf=hd_temf,exch_temf=exch_temf,wm_temf=wm_temf,&
    1626. 

  1626.                ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde,  &
    1627. 

  1627.                ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme,  &
    1628. 

  1628.                its=i_start(ij),ite=i_end(ij),                      &
    1629. 

  1629.                jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
    1630. 

  1630.        ELSE
    1631. 

  1631.          CALL wrf_error_fatal('Lacking arguments for TEMFSFCLAY in surface driver')
    1632. 

  1632.        ENDIF
    1633. 

  1633. 

  1634.      CASE (IDEALSCMSFCSCHEME)
    1635. 

  1635.        IF (PRESENT(qv_curr)) THEN
    1636. 

  1636.          CALL wrf_debug( 100, 'in IDEALSCMSFCLAY' )
    1637. 

  1637.          CALL IDEALSCMSFCLAY(u3d=u_phytmp,v3d=v_phytmp,th3d=th_phy,    &
    1638. 

  1638.                qv3d=qv_curr,p3d=p_phy,pi3d=pi_phy,rho=rho,z=z,ht=ht, &
    1639. 

  1639.                CP=cp,G=g,ROVCP=rovcp,R=r_d,XLV=xlv,psfc=psfc,chs=chs,&
    1640. 

  1640.                chs2=chs2,cqs2=cqs2,CPM=cpm,znt=znt,ust=ust,        &
    1641. 

  1641.                MAVAIL=mavail,XLAND=xland,HFX=hfx,QFX=qfx,LH=lh,   &
    1642. 

  1642.                TSK=tsk,FLHC=flhc,FLQC=flqc,QGH=qgh,qsfc=qsfc,      &
    1643. 

  1643.                U10=u10,V10=v10,TH2=th2,T2=t2,Q2=q2,                &
    1644. 

  1644.                SVP1=svp1,SVP2=svp2,SVP3=svp3,SVPT0=svpt0,EP1=ep_1, &
    1645. 

  1645.                EP2=ep_2,KARMAN=karman,fCor=fCor,   &
    1646. 

  1646.                exch_temf=exch_temf,                &
    1647. 

  1647.                hfx_force=hfx_force,lh_force=lh_force,tsk_force=tsk_force, &
    1648. 

  1648.                hfx_force_tend=hfx_force_tend,                      &
    1649. 

  1649.                lh_force_tend=lh_force_tend,                        &
    1650. 

  1650.                tsk_force_tend=tsk_force_tend,                      &
    1651. 

  1651.                dt=dt,itimestep=itimestep,                          &
    1652. 

  1652.                ids=ids,ide=ide, jds=jds,jde=jde, kds=kds,kde=kde,  &
    1653. 

  1653.                ims=ims,ime=ime, jms=jms,jme=jme, kms=kms,kme=kme,  &
    1654. 

  1654.                its=i_start(ij),ite=i_end(ij),                      &
    1655. 

  1655.                jts=j_start(ij),jte=j_end(ij), kts=kts,kte=kte )
    1656. 

  1656.        ELSE
    1657. 

  1657.          CALL wrf_error_fatal('Lacking arguments for IDEALSCMSFCLAY in surface driver')
    1658. 

  1658.        ENDIF
    1659. 

  1659. #endif
    1660. 

  1660. 

  1661. #if (NMM_CORE==1)
    1662. 

  1662. 

  1663.     CASE (GFDLSFCSCHEME)
    1664. 

  1664.        CALL wrf_debug( 100, 'in GFDLSFC' )
    1665. 

  1665. 

  1666.       IF(sf_surface_physics .eq. 88)THEN
    1667. 

  1667.         GFDL_NTSFLG=1
    1668. 

  1668.       ELSE
    1669. 

  1669.         GFDL_NTSFLG=0
    1670. 

  1670.       ENDIF
    1671. 

  1671. 

  1672.       CALL SF_GFDL(u_phytmp,v_phytmp,t_phy,qv_curr,p_phy, &
    1673. 

  1673.                    CP,RCP,R_d,XLV,PSFC,CHS,CHS2,CQS2,CPM,                 &
    1674. 

  1674.                    DTBL, SMOIS,num_soil_layers,ISLTYP,ZNT,UST,PSIM,PSIH,                          &  !DT & MAVAIL
    1675. 

  1675.                    XLAND,HFX,QFX,TAUX,TAUY,LH,GSW,GLW,TSK,FLHC,FLQC,  & ! gopal's doing for Ocean coupling
    1676. 

  1676.                    QGH,QSFC,U10,V10,                              &
    1677. 

  1677.                    GZ1OZ0,WSPD,BR,ISFFLX,                         &
    1678. 

  1678.                    EP_1,EP_2,KARMAN,GFDL_NTSFLG,SFENTH,           &
    1679. 

  1679.                    ids,ide, jds,jde, kds,kde,                     &
    1680. 

  1680.                    ims,ime, jms,jme, kms,kme,                             &
    1681. 

  1681.                    i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte    )
    1682. 

  1682.            DO j=j_start(ij),j_end(ij)
    1683. 

  1683.            DO i=i_start(ij),i_end(ij)
    1684. 

  1684.               CHKLOWQ(I,J)= 1.0
    1685. 

  1685.            ENDDO
    1686. 

  1686.            ENDDO
    1687. 

  1687. 

  1688. #endif
    1689. 

  1689.      CASE DEFAULT
    1690. 

  1690. 

  1691.        WRITE( message , * )                                &
    1692. 

  1692.    'The sfclay option does not exist: sf_sfclay_physics = ', sf_sfclay_physics
    1693. 

  1693.        CALL wrf_error_fatal ( message )
    1694. 

  1694. 

  1695.      END SELECT sfclay_select
    1696. 

  1696. 

  1697. !  Compute uratx, vratx, tratx for obs nudging
    1698. 

  1698.      IF(PRESENT(uratx) .and. PRESENT(vratx) .and. PRESENT(tratx))THEN
    1699. 

  1699.         DO J=j_start(ij),j_end(ij)
    1700. 

  1700.         DO I=i_start(ij),i_end(ij)
    1701. 

  1701.            IF(ABS(U10(I,J)) .GT. 1.E-10) THEN
    1702. 

  1702.               uratx(I,J) = U_PHYTMP(I,1,J)/U10(I,J)
    1703. 

  1703.            ELSE
    1704. 

  1704.               uratx(I,J) = 1.2
    1705. 

  1705.            END IF
    1706. 

  1706.            IF(ABS(V10(I,J)) .GT. 1.E-10) THEN
    1707. 

  1707.               vratx(I,J) = V_PHYTMP(I,1,J)/V10(I,J)
    1708. 

  1708.            ELSE
    1709. 

  1709.               vratx(I,J) = 1.2
    1710. 

  1710.            END IF
    1711. 

  1711. ! (Quotient P1000mb/P_PHY must be conditioned due to large value of P1000mb)
    1712. 

  1712.            tratx(I,J) = (T_PHY(I,1,J)*(P1000mb*0.001/(P_PHY(I,1,J)/1000.))**RCP)  &
    1713. 

  1713.                         /TH2(I,J)
    1714. 

  1714.         ENDDO
    1715. 

  1715.         ENDDO
    1716. 

  1716.      ENDIF
    1717. 

  1717. 

  1718.      ENDDO
    1719. 

  1719.      !$OMP END PARALLEL DO
    1720. 

  1720. 

  1721.      IF (ISFFLX.EQ.0 ) GOTO 430
    1722. 

  1722.      !$OMP PARALLEL DO   &
    1723. 

  1723.      !$OMP PRIVATE ( ij, i, j, k )
    1724. 

  1724.      DO ij = 1 , num_tiles
    1725. 

  1725. 

  1726.      sfc_select: SELECT CASE(sf_surface_physics)
    1727. 

  1727. 

  1728.      CASE (SLABSCHEME)
    1729. 

  1729. 

  1730.        IF (PRESENT(qv_curr)                            .AND.    &
    1731. 

  1731.            PRESENT(capg)        .AND.    &
    1732. 

  1732.                                                       .TRUE. ) THEN
    1733. 

  1733.            DO j=j_start(ij),j_end(ij)
    1734. 

  1734.            DO i=i_start(ij),i_end(ij)
    1735. 

  1735. !          CQS2 ACCOUNTS FOR MAVAIL FOR SFCDIAGS 2M Q
    1736. 

  1736.               CQS2(I,J)= CQS2(I,J)*MAVAIL(I,J)
    1737. 

  1737.            ENDDO
    1738. 

  1738.            ENDDO
    1739. 

  1739. 

  1740.            IF ( FRACTIONAL_SEAICE == 1 ) THEN
    1741. 

  1741.               CALL wrf_error_fatal('SLAB scheme cannot be used with fractional seaice')
    1742. 

  1742.            ENDIF
    1743. 

  1743.         CALL wrf_debug(100,'in SLAB')
    1744. 

  1744.           CALL SLAB(t_phy,qv_curr,p_phy,flhc,flqc,  &
    1745. 

  1745.              psfc,xland,tmn,hfx,qfx,lh,tsk,qsfc,chklowq,          &
    1746. 

  1746.              gsw,glw,capg,thc,snowc,emiss,mavail,                 &
    1747. 

  1747.              dtbl,rcp,xlv,dtmin,ifsnow,                           &
    1748. 

  1748.              svp1,svp2,svp3,svpt0,ep_2,karman,eomeg,stbolt,       &
    1749. 

  1749.              tslb,zs,dzs,num_soil_layers,radiation,               &
    1750. 

  1750.              p1000mb,                                             &
    1751. 

  1751.              ids,ide, jds,jde, kds,kde,                           &
    1752. 

  1752.              ims,ime, jms,jme, kms,kme,                           &
    1753. 

  1753.              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
    1754. 

  1754. 

  1755.            DO j=j_start(ij),j_end(ij)
    1756. 

  1756.            DO i=i_start(ij),i_end(ij)
    1757. 

  1757.               SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
    1758. 

  1758.               IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
    1759. 

  1759.               IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
    1760. 

  1760.            ENDDO
    1761. 

  1761.            ENDDO
    1762. 

  1762. 

  1763.         CALL wrf_debug(100,'in SFCDIAGS')
    1764. 

  1764.           CALL SFCDIAGS(hfx,qfx,tsk,qsfc,chs2,cqs2,t2,th2,q2,      &
    1765. 

  1765.                      psfc,cp,r_d,rcp,                              &
    1766. 

  1766.                      ids,ide, jds,jde, kds,kde,                    &
    1767. 

  1767.                      ims,ime, jms,jme, kms,kme,                    &
    1768. 

  1768.              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1769. 

  1769. 

  1770.        ENDIF
    1771. 

  1771. 

  1772.      CASE (LSMSCHEME)
    1773. 

  1773. 

  1774.        IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)        .AND.    &
    1775. 

  1775. !          PRESENT(emiss)      .AND.  PRESENT(t2)            .AND.    &
    1776. 

  1776. !          PRESENT(declin) .AND.  PRESENT(coszen)    .AND.    &
    1777. 

  1777. !          PRESENT(hrang)  .AND. PRESENT( xlat_urb2d)    .AND.    &
    1778. 

  1778. !          PRESENT(dzr)       .AND.    &
    1779. 

  1779. !          PRESENT( dzb)            .AND. PRESENT(dzg)       .AND.    &
    1780. 

  1780. !          PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d)         .AND.    &
    1781. 

  1781. !          PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND.            &
    1782. 

  1782. !          PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND.            &
    1783. 

  1783. !          PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND.        &
    1784. 

  1784. !          PRESENT(xxxg_urb2d) .AND.                                  &
    1785. 

  1785. !          PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND.         &
    1786. 

  1786. !          PRESENT(tbl_urb3d)   .AND. PRESENT(tgl_urb3d)  .AND.       &
    1787. 

  1787. !          PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d)  .AND.           &
    1788. 

  1788. !          PRESENT(g_urb2d)   .AND. PRESENT(rn_urb2d) .AND.           &
    1789. 

  1789. !          PRESENT(ts_urb2d)                          .AND.           &
    1790. 

  1790. !          PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d)   .AND.      &
    1791. 

  1791.                                                       .TRUE. ) THEN
    1792. 

  1792. !------------------------------------------------------------------
    1793. 

  1793.          IF( PRESENT(sr) ) THEN
    1794. 

  1794.            frpcpn=.true.
    1795. 

  1795.          ENDIF
    1796. 

  1796.          IF ( FRACTIONAL_SEAICE == 1) THEN
    1797. 

  1797.             ! The fields passed to LSM need to represent the full ice values, not
    1798. 

  1798.             ! the fractional values.  Convert ALBEDO and EMISS from the blended value 
    1799. 

  1799.             ! to a value representing only the sea-ice portion.   Albedo over open 
    1800. 

  1800.             ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
    1801. 

  1801.             DO j = j_start(ij) , j_end(ij)
    1802. 

  1802.                DO i = i_start(ij) , i_end(ij)
    1803. 

  1803.                   IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
    1804. 

  1804.                      ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
    1805. 

  1805.                      EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
    1806. 

  1806.                   ENDIF
    1807. 

  1807.                ENDDO
    1808. 

  1808.             ENDDO
    1809. 

  1809. 

  1810.             IF ( isisfc ) THEN
    1811. 

  1811.                ! Use surface layer routine values from the ice portion of grid point
    1812. 

  1812.             ELSE
    1813. 

  1813.                !
    1814. 

  1814.                ! We don't have surface layer routine values at this time, so
    1815. 

  1815.                ! just use what we have.  Use ice component of TSK
    1816. 

  1816.                !
    1817. 

  1817.                CALL get_local_ice_tsk( ims, ime, jms, jme,                   &
    1818. 

  1818.                                        i_start(ij), i_end(ij),               & 
    1819. 

  1819.                                        j_start(ij), j_end(ij),               &
    1820. 

  1820.                                        itimestep, .false., tice2tsk_if2cold, &
    1821. 

  1821.                                        XICE, XICE_THRESHOLD,                 &
    1822. 

  1822.                                        SST, TSK, TSK_SEA, TSK_LOCAL )
    1823. 

  1823. 

  1824.                DO j = j_start(ij) , j_end(ij)
    1825. 

  1825.                   DO i = i_start(ij) , i_end(ij)
    1826. 

  1826.                      TSK(i,j) = TSK_LOCAL(i,j)
    1827. 

  1827.                   ENDDO
    1828. 

  1828.                ENDDO
    1829. 

  1829.             ENDIF
    1830. 

  1830.          ENDIF
    1831. 

  1831. 

  1832.          CALL wrf_debug(100,'in NOAH DRV')
    1833. 

  1833.          CALL lsm(dz8w,qv_curr,p8w,t_phy,tsk,                 &
    1834. 

  1834.                 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot,    &
    1835. 

  1835.                 sfcrunoff,udrunoff,ivgtyp,isltyp,isurban,isice,vegfra,        &
    1836. 

  1836.                 albedo,albbck,znt,z0, tmn,xland,xice, emiss, embck,    &
    1837. 

  1837.                 snowc,qsfc,rainbl,                              &
    1838. 

  1838.                 mminlu,                                         &
    1839. 

  1839.                 num_soil_layers,dtbl,dzs,itimestep,             &
    1840. 

  1840.                 smois,tslb,snow,canwat,                         &
    1841. 

  1841.                 chs, chs2, cqs2, cpm,rcp,SR,chklowq,lai,qz0,    &
    1842. 

  1842.                 myj,frpcpn,                                     &
    1843. 

  1843. 		sh2o,snowh,                                     & !h
    1844. 

  1844.                 u_phy,v_phy,                                    & !I
    1845. 

  1845.                 snoalb,shdmin,shdmax,                           & !i
    1846. 

  1846.                 snotime,                                        & !o
    1847. 

  1847.                 acsnom,acsnow,                                  & !o
    1848. 

  1848.                 snopcx,                                         & !o
    1849. 

  1849.                 potevp,                                         & !o
    1850. 

  1850.                 smcrel,                                         & !o
    1851. 

  1851.                 xice_threshold,                                 &
    1852. 

  1852.                 rdlai2d,usemonalb,                              &
    1853. 

  1853.                 br,                                             & !?
    1854. 

  1854.                   NOAHRES,                                      &
    1855. 

  1855.                 ids,ide, jds,jde, kds,kde,                      &
    1856. 

  1856.                 ims,ime, jms,jme, kms,kme,                      &
    1857. 

  1857.                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte,    &
    1858. 

  1858.                 sf_urban_physics                                &
    1859. 

  1859. !Optional urban
    1860. 

  1860.                 ,cmr_sfcdif,chr_sfcdif,cmc_sfcdif,chc_sfcdif    &
    1861. 

  1861.                 ,tr_urb2d,tb_urb2d,tg_urb2d,tc_urb2d,qc_urb2d,  & !H urban
    1862. 

  1862.                 uc_urb2d,                                       & !H urban
    1863. 

  1863.                 xxxr_urb2d,xxxb_urb2d,xxxg_urb2d,xxxc_urb2d,    & !H urban
    1864. 

  1864.                 trl_urb3d,tbl_urb3d,tgl_urb3d,                  & !H urban
    1865. 

  1865.                 sh_urb2d,lh_urb2d,g_urb2d,rn_urb2d,ts_urb2d,    & !H urban
    1866. 

  1866.                 psim_urb2d,psih_urb2d,u10_urb2d,v10_urb2d,      & !O urban
    1867. 

  1867.                 GZ1OZ0_urb2d, AKMS_URB2D,                       & !O urban
    1868. 

  1868.                 th2_urb2d,q2_urb2d,ust_urb2d,                   & !O urban
    1869. 

  1869.                 declin,coszen,hrang,                            & !I solar
    1870. 

  1870.                 xlat_urb2d,                                     & !I urban
    1871. 

  1871.                 num_roof_layers, num_wall_layers,               & !I urban
    1872. 

  1872.                 num_road_layers, DZR, DZB, DZG,                 & !I urban
    1873. 

  1873.                 FRC_URB2D, UTYPE_URB2D,                         & !I urban
    1874. 

  1874.                 num_urban_layers,                               & !I multi-layer urban
    1875. 

  1875.                 trb_urb4d,tw1_urb4d,tw2_urb4d,tgb_urb4d,        & !H multi-layer urban
    1876. 

  1876.                 tlev_urb3d,qlev_urb3d,                          & !H multi-layer urban
    1877. 

  1877.                 tw1lev_urb3d,tw2lev_urb3d,                      & !H multi-layer urban
    1878. 

  1878.                 tglev_urb3d,tflev_urb3d,                        & !H multi-layer urban
    1879. 

  1879.                 sf_ac_urb3d,lf_ac_urb3d,cm_ac_urb3d,            & !H multi-layer urban
    1880. 

  1880.                 sfvent_urb3d,lfvent_urb3d,                      & !H multi-layer urban
    1881. 

  1881.                 sfwin1_urb3d,sfwin2_urb3d,                      & !H multi-layer urban
    1882. 

  1882.                 sfw1_urb3d,sfw2_urb3d,sfr_urb3d,sfg_urb3d,      & !H multi-layer urban
    1883. 

  1883.                 th_phy,rho,p_phy,ust,                           & !I multi-layer urban
    1884. 

  1884.                 gmt,julday,xlong,xlat,                          & !I multi-layer urban
    1885. 

  1885.                 a_u_bep,a_v_bep,a_t_bep,a_q_bep,                & !O multi-layer urban 
    1886. 

  1886.                 a_e_bep,b_u_bep,b_v_bep,                        & !O multi-layer urban
    1887. 

  1887.                 b_t_bep,b_q_bep,b_e_bep,dlg_bep,                & !O multi-layer urban
    1888. 

  1888.                 dl_u_bep,sf_bep,vl_bep                          & !O multi-layer urban
    1889. 

  1889.                 )
    1890. 

  1890. 

  1891.          call seaice_noah( SEAICE_ALBEDO_OPT,                                          &
    1892. 

  1892.               &            t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
    1893. 

  1893.               &            glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold,     &
    1894. 

  1894.               &            tslb, emiss, albedo, albbck, z0, tsk, snow, snowc, snowh,   &
    1895. 

  1895.               &            chs, chs2, cqs2,                                            &
    1896. 

  1896.               &            br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow,        &
    1897. 

  1897.               &            acsnom, snopcx, sfcrunoff, noahres,                         &
    1898. 

  1898.               &            sf_urban_physics, b_t_bep, b_q_bep, rho,                    &
    1899. 

  1899.               &            ids,ide, jds,jde, kds,kde,                                  &
    1900. 

  1900.               &            ims,ime, jms,jme, kms,kme,                                  &
    1901. 

  1901.               &            i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
    1902. 

  1902. 

  1903.          
    1904. 

  1904.          IF ( FRACTIONAL_SEAICE == 1 ) THEN
    1905. 

  1905.             ! LSM Returns full land/ice values, no fractional values.
    1906. 

  1906.             ! We return to a fractional component here.  SFLX currently hard-wires
    1907. 

  1907.             ! emissivity over sea ice to 0.98, the same value as over open water, so
    1908. 

  1908.             ! the fractional consideration doesn't have any effect for emissivity.
    1909. 

  1909.             DO j=j_start(ij),j_end(ij)
    1910. 

  1910.                DO i=i_start(ij),i_end(ij)
    1911. 

  1911.                   IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    1912. 

  1912.                      albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08  )
    1913. 

  1913.                      emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98  )
    1914. 

  1914.                   ENDIF
    1915. 

  1915.                ENDDO
    1916. 

  1916.             ENDDO
    1917. 

  1917. 

  1918.             IF ( isisfc ) THEN
    1919. 

  1919.                DO j=j_start(ij),j_end(ij)
    1920. 

  1920.                   DO i=i_start(ij),i_end(ij)
    1921. 

  1921.                      IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    1922. 

  1922.                         !  Weighted average of fields between ice-cover values and open-water values.
    1923. 

  1923.                         flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
    1924. 

  1924.                         flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
    1925. 

  1925.                         cpm(i,j)  = ( cpm(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j)  )
    1926. 

  1926.                         cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
    1927. 

  1927.                         chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
    1928. 

  1928.                         chs(i,j)  = ( chs(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j)  )
    1929. 

  1929.                         qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
    1930. 

  1930.                         qgh(i,j)  = ( qgh(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j)  )
    1931. 

  1931.                         qz0(i,j)  = ( qz0(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j)  )
    1932. 

  1932.                         hfx(i,j)  = ( hfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j)  )
    1933. 

  1933.                         qfx(i,j)  = ( qfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j)  )
    1934. 

  1934.                         lh(i,j)   = ( lh(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j)   )
    1935. 

  1935.                         tsk(i,j)  = ( tsk(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j)  )
    1936. 

  1936.                      ENDIF
    1937. 

  1937.                   ENDDO
    1938. 

  1938.                ENDDO
    1939. 

  1939.             ELSE
    1940. 

  1940.                DO j = j_start(ij) , j_end(ij)
    1941. 

  1941.                   DO i = i_start(ij) , i_end(ij)
    1942. 

  1942.                      IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    1943. 

  1943.                         ! Compute TSK as the open-water and ice-cover average
    1944. 

  1944.                         tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
    1945. 

  1945.                      ENDIF
    1946. 

  1946.                   ENDDO
    1947. 

  1947.                ENDDO
    1948. 

  1948.             ENDIF
    1949. 

  1949.          ENDIF
    1950. 

  1950.            DO j=j_start(ij),j_end(ij)
    1951. 

  1951.            DO i=i_start(ij),i_end(ij)
    1952. 

  1952. !              CHKLOWQ(I,J)= 1.0
    1953. 

  1953.                SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
    1954. 

  1954.                SFCEXC(I,J)= CHS(I,J)
    1955. 

  1955.                IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
    1956. 

  1956.                IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
    1957. 

  1957.                IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
    1958. 

  1958.            ENDDO
    1959. 

  1959.            ENDDO
    1960. 

  1960. 

  1961.           CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,      &
    1962. 

  1962.                      PSFC,CP,R_d,RCP,                              &
    1963. 

  1963.                      ids,ide, jds,jde, kds,kde,                    &
    1964. 

  1964.                      ims,ime, jms,jme, kms,kme,                    &
    1965. 

  1965.              i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    1966. 

  1966. !urban
    1967. 

  1967.      IF(SF_URBAN_PHYSICS.eq.1) THEN
    1968. 

  1968.        DO j=j_start(ij),j_end(ij)                             !urban
    1969. 

  1969.          DO i=i_start(ij),i_end(ij)                           !urban
    1970. 

  1970.           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &  !urban
    1971. 

  1971.               IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
    1972. 

  1972.              U10(I,J)  = U10_URB2D(I,J)                       !urban
    1973. 

  1973.              V10(I,J)  = V10_URB2D(I,J)                       !urban
    1974. 

  1974.              PSIM(I,J) = PSIM_URB2D(I,J)                      !urban
    1975. 

  1975.              PSIH(I,J) = PSIH_URB2D(I,J)                      !urban
    1976. 

  1976.              GZ1OZ0(I,J) = GZ1OZ0_URB2D(I,J)                  !urban
    1977. 

  1977. !m             AKHS(I,J) = AKHS_URB2D(I,J)                    !urban
    1978. 

  1978.              AKHS(I,J) = CHS(I,J)                             !urban
    1979. 

  1979.              AKMS(I,J) = AKMS_URB2D(I,J)                      !urban
    1980. 

  1980.            END IF                                             !urban
    1981. 

  1981.          ENDDO                                                !urban
    1982. 

  1982.        ENDDO                                                  !urban
    1983. 

  1983.      ENDIF
    1984. 

  1984. ! urban BEP
    1985. 

  1985.      IF((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.eq.3)) THEN
    1986. 

  1986.        DO j=j_start(ij),j_end(ij)                             !urban
    1987. 

  1987.          DO i=i_start(ij),i_end(ij)                           !urban
    1988. 

  1988.           IF( IVGTYP(I,J) == ISURBAN .or. IVGTYP(I,J) == 31 .or. &  !urban
    1989. 

  1989.               IVGTYP(I,J) == 32 .or. IVGTYP(I,J) == 33 ) THEN !urban
    1990. 

  1990.             T2(I,J)   = TH_PHY(i,1,j)/((1.E5/PSFC(I,J))**RCP) !urban
    1991. 

  1991.             TH2(I,J) = TH_PHY(i,1,j) !urban
    1992. 

  1992.             Q2(I,J)   = qv_curr(i,1,j)  !urban
    1993. 

  1993.             U10(I,J)  = U_phy(I,1,J)                       !urban
    1994. 

  1994.             V10(I,J)  = V_phy(I,1,J)                       !urban
    1995. 

  1995.            END IF                                             !urban
    1996. 

  1996.          ENDDO                                                !urban
    1997. 

  1997.        ENDDO                                                  !urban
    1998. 

  1998.      ENDIF
    1999. 

  1999. 

  2000. !------------------------------------------------------------------
    2001. 

  2001. 

  2002.        ELSE
    2003. 

  2003.          CALL wrf_error_fatal('Lacking arguments for LSM in surface driver')
    2004. 

  2004.        ENDIF
    2005. 

  2005. 

  2006.      CASE (NOAHMPSCHEME)
    2007. 

  2007.        IF (PRESENT(qv_curr)    .AND.  PRESENT(rainbl)        .AND.    &
    2008. 

  2008. !          PRESENT(emiss)      .AND.  PRESENT(t2)            .AND.    &
    2009. 

  2009. !          PRESENT(declin) .AND.  PRESENT(coszen)    .AND.    &
    2010. 

  2010. !          PRESENT(hrang)  .AND. PRESENT( xlat_urb2d)    .AND.    &
    2011. 

  2011. !          PRESENT(dzr)       .AND.    &
    2012. 

  2012. !          PRESENT( dzb)            .AND. PRESENT(dzg)       .AND.    &
    2013. 

  2013. !          PRESENT(tr_urb2d) .AND. PRESENT(tb_urb2d)         .AND.    &
    2014. 

  2014. !          PRESENT(tg_urb2d) .AND. PRESENT(tc_urb2d) .AND.            &
    2015. 

  2015. !          PRESENT(qc_urb2d) .AND. PRESENT(uc_urb2d) .AND.            &
    2016. 

  2016. !          PRESENT(xxxr_urb2d) .AND. PRESENT(xxxb_urb2d) .AND.        &
    2017. 

  2017. !          PRESENT(xxxg_urb2d) .AND.                                  &
    2018. 

  2018. !          PRESENT(xxxc_urb2d) .AND. PRESENT(trl_urb3d) .AND.         &
    2019. 

  2019. !          PRESENT(tbl_urb3d)   .AND. PRESENT(tgl_urb3d)  .AND.       &
    2020. 

  2020. !          PRESENT(sh_urb2d) .AND. PRESENT(lh_urb2d)  .AND.           &
    2021. 

  2021. !          PRESENT(g_urb2d)   .AND. PRESENT(rn_urb2d) .AND.           &
    2022. 

  2022. !          PRESENT(ts_urb2d)                          .AND.           &
    2023. 

  2023. !          PRESENT(frc_urb2d) .AND. PRESENT(utype_urb2d)   .AND.      &
    2024. 

  2024.                                                       .TRUE. ) THEN
    2025. 

  2025. !------------------------------------------------------------------
    2026. 

  2026.          IF( PRESENT(sr) ) THEN
    2027. 

  2027.            frpcpn=.true.
    2028. 

  2028.          ENDIF
    2029. 

  2029. 

  2030.          IF ( FRACTIONAL_SEAICE == 1) THEN
    2031. 

  2031.             ! The fields passed to LSM need to represent the full ice values, not
    2032. 

  2032.             ! the fractional values.  Convert ALBEDO and EMISS from the blended value 
    2033. 

  2033.             ! to a value representing only the sea-ice portion.   Albedo over open 
    2034. 

  2034.             ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
    2035. 

  2035.             DO j = j_start(ij) , j_end(ij)
    2036. 

  2036.                DO i = i_start(ij) , i_end(ij)
    2037. 

  2037.                   IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
    2038. 

  2038.                      ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
    2039. 

  2039.                      EMISS(I,J) = (EMISS(I,J)-(1.-XICE(I,J))*0.98)/XICE(I,J)
    2040. 

  2040.                   ENDIF
    2041. 

  2041.                ENDDO
    2042. 

  2042.             ENDDO
    2043. 

  2043. 

  2044.             IF ( isisfc ) THEN
    2045. 

  2045.                ! Use surface layer routine values from the ice portion of grid point
    2046. 

  2046.             ELSE
    2047. 

  2047.                !
    2048. 

  2048.                ! We don't have surface layer routine values at this time, so
    2049. 

  2049.                ! just use what we have.  Use ice component of TSK
    2050. 

  2050.                !
    2051. 

  2051.                CALL get_local_ice_tsk( ims, ime, jms, jme,                   &
    2052. 

  2052.                                        i_start(ij), i_end(ij),               &
    2053. 

  2053.                                        j_start(ij), j_end(ij),               &
    2054. 

  2054.                                        itimestep, .false., tice2tsk_if2cold, &
    2055. 

  2055.                                        XICE, XICE_THRESHOLD,                 &
    2056. 

  2056.                                        SST, TSK, TSK_SEA, TSK_LOCAL )
    2057. 

  2057. 

  2058.                DO j = j_start(ij) , j_end(ij)
    2059. 

  2059.                   DO i = i_start(ij) , i_end(ij)
    2060. 

  2060.                      TSK(i,j) = TSK_LOCAL(i,j)
    2061. 

  2061.                   ENDDO
    2062. 

  2062.                ENDDO
    2063. 

  2063.             ENDIF
    2064. 

  2064.          ENDIF
    2065. 

  2065. 

  2066.          CALL wrf_debug(100,'in NOAHMP DRV')
    2067. 

  2067.          CALL noahmplsm(dz8w,qv_curr,p8w,t_phy,tsk,                 &
    2068. 

  2068.                 hfx,qfx,lh,grdflx,qgh,gsw,swdown,glw,smstav,smstot,    &
    2069. 

  2069.                 sfcrunoff,udrunoff,ivgtyp,isltyp,vegfra,        &
    2070. 

  2070.                 albedo,albbck,znt,z0, tmn,xland,xice, xice_threshold, isice,emiss, embck,    &
    2071. 

  2071.                 snowc,qsfc,rainbl,                              &
    2072. 

  2072.                 num_soil_layers,dtbl,dzs,itimestep,             &
    2073. 

  2073.                 smois,tslb,snow,canwat,                         &
    2074. 

  2074.                 chs, chs2, cqs2, cpm,rcp,SR,chklowq,qz0,        &
    2075. 

  2075.                 myj,br,frpcpn,                                  &
    2076. 

  2076.                 sh2o,snowh,                                     & !h
    2077. 

  2077.                 u_phy,v_phy,                                    & !I
    2078. 

  2078.                 coszen, xlat_urb2d,                             & !I
    2079. 

  2079.                 snoalb,                                         & !I
    2080. 

  2080.                 snotime,                                        & !io
    2081. 

  2081.                 acsnom,acsnow,                                  & !o
    2082. 

  2082.                 idveg    ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz ,iopt_inf , &
    2083. 

  2083.                 iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot,iopt_stc ,                     &
    2084. 

  2084.                 isnowxy  ,tvxy     ,tgxy     ,canicexy ,                               &
    2085. 

  2085.                 canliqxy ,eahxy    ,tahxy    ,cmxy     ,chxy     ,                     &
    2086. 

  2086.                 fwetxy   ,sneqvoxy ,alboldxy ,qsnowxy  ,wslakexy ,zwtxy    ,waxy     , &
    2087. 

  2087.                 wtxy     ,tsnoxy   ,zsnsoxy  ,snicexy  ,snliqxy  ,lfmassxy ,rtmassxy , &
    2088. 

  2088.                 stmassxy ,woodxy   ,stblcpxy ,fastcpxy ,lai      ,xsaixy   ,           &
    2089. 

  2089.                 tradxy   ,tsxy     ,neexy    ,gppxy    ,nppxy    ,fvegxy   ,qinxy    , &
    2090. 

  2090.                 runsfxy  ,runsbxy  ,ecanxy   ,edirxy   ,etranxy  ,fsaxy    ,firaxy   , &
    2091. 

  2091.                 aparxy   ,psnxy    ,savxy    ,sagxy    ,                               &
    2092. 

  2092.                 fsnoxy   ,YR       ,JULIAN_IN,                                         &
    2093. 

  2093.                 potevp,                                         & !o
    2094. 

  2094. !jref:start
    2095. 

  2095.                 qc_curr     ,pblh   ,isurban  ,iz0tlnd  ,dx      ,     & !I 
    2096. 

  2096.                 chstarxy , t2mvxy   ,t2mbxy   ,rssunxy  ,rsshaxy , bgapxy, &
    2097. 

  2097.                 wgapxy , gapxy ,tgvxy ,tgbxy ,q2mvxy ,q2mbxy, shdmax ,chvxy,chbxy , & !O 
    2098. 

  2098. !jref:end
    2099. 

  2099.                 ids,ide, jds,jde, kds,kde,                      &
    2100. 

  2100.                 ims,ime, jms,jme, kms,kme,                      &
    2101. 

  2101.                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
    2102. 

  2102. 

  2103.          call seaice_noah( SEAICE_ALBEDO_OPT,                                          &
    2104. 

  2104.               &            t_phy, qv_curr, p8w, dz8w, num_soil_layers, dt, frpcpn, sr, &
    2105. 

  2105.               &            glw, swdown, rainbl, snoalb, qgh, xice, xice_threshold,     &
    2106. 

  2106.               &            tslb, emiss, albedo, albbck, z0, tsk, snow, snowc, snowh,   &
    2107. 

  2107.               &            chs, chs2, cqs2,                                            &
    2108. 

  2108.               &            br, znt, lh, hfx, qfx, potevp, grdflx, qsfc, acsnow,        &
    2109. 

  2109.               &            acsnom, snopcx, sfcrunoff, noahres,                         &
    2110. 

  2110.               &            sf_urban_physics, b_t_bep, b_q_bep, rho,                    &
    2111. 

  2111.               &            ids,ide, jds,jde, kds,kde,                                  &
    2112. 

  2112.               &            ims,ime, jms,jme, kms,kme,                                  &
    2113. 

  2113.               &            i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte )
    2114. 

  2114. 

  2115.          IF ( FRACTIONAL_SEAICE == 1 ) THEN
    2116. 

  2116.             ! LSM Returns full land/ice values, no fractional values.
    2117. 

  2117.             ! We return to a fractional component here.  SFLX currently hard-wires
    2118. 

  2118.             ! emissivity over sea ice to 0.98, the same value as over open water, so
    2119. 

  2119.             ! the fractional consideration doesn't have any effect for emissivity.
    2120. 

  2120.             DO j=j_start(ij),j_end(ij)
    2121. 

  2121.                DO i=i_start(ij),i_end(ij)
    2122. 

  2122.                   IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2123. 

  2123.                      albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08  )
    2124. 

  2124.                      emiss(i,j) = ( emiss(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98  )
    2125. 

  2125.                   ENDIF
    2126. 

  2126.                ENDDO
    2127. 

  2127.             ENDDO
    2128. 

  2128. 

  2129.             IF ( isisfc ) THEN
    2130. 

  2130.                DO j=j_start(ij),j_end(ij)
    2131. 

  2131.                   DO i=i_start(ij),i_end(ij)
    2132. 

  2132.                      IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2133. 

  2133.                         !  Weighted average of fields between ice-cover values and open-water values.
    2134. 

  2134.                         flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
    2135. 

  2135.                         flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
    2136. 

  2136.                         cpm(i,j)  = ( cpm(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j)  )
    2137. 

  2137.                         cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
    2138. 

  2138.                         chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
    2139. 

  2139.                         chs(i,j)  = ( chs(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j)  )
    2140. 

  2140.                         qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qsfc_sea(i,j) )
    2141. 

  2141.                         qgh(i,j)  = ( qgh(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qgh_sea(i,j)  )
    2142. 

  2142.                         qz0(i,j)  = ( qz0(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qz0_sea(i,j)  )
    2143. 

  2143.                         hfx(i,j)  = ( hfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j)  )
    2144. 

  2144.                         qfx(i,j)  = ( qfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j)  )
    2145. 

  2145.                         lh(i,j)   = ( lh(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j)   )
    2146. 

  2146.                         tsk(i,j)  = ( tsk(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j)  )
    2147. 

  2147.                      ENDIF
    2148. 

  2148.                   ENDDO
    2149. 

  2149.                ENDDO
    2150. 

  2150.             ELSE
    2151. 

  2151.                DO j = j_start(ij) , j_end(ij)
    2152. 

  2152.                   DO i = i_start(ij) , i_end(ij)
    2153. 

  2153.                      IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2154. 

  2154.                         ! Compute TSK as the open-water and ice-cover average
    2155. 

  2155.                         tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
    2156. 

  2156.                      ENDIF
    2157. 

  2157.                   ENDDO
    2158. 

  2158.                ENDDO
    2159. 

  2159.             ENDIF
    2160. 

  2160.          ENDIF
    2161. 

  2161.            DO j=j_start(ij),j_end(ij)
    2162. 

  2162.            DO i=i_start(ij),i_end(ij)
    2163. 

  2163. !              CHKLOWQ(I,J)= 1.0
    2164. 

  2164.                SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
    2165. 

  2165.                SFCEXC(I,J)= CHS(I,J)
    2166. 

  2166.                IF(PRESENT(ACHFX))ACHFX(I,J)=ACHFX(I,J) + HFX(I,J)*DT
    2167. 

  2167.                IF(PRESENT(ACLHF))ACLHF(I,J)=ACLHF(I,J) + LH(I,J)*DT
    2168. 

  2168.                IF(PRESENT(ACGRDFLX))ACGRDFLX(I,J)=ACGRDFLX(I,J) + GRDFLX(I,J)*DT
    2169. 

  2169. 

  2170.                ! Check that SFCDIAGS can declare these as intent(out)
    2171. 

  2171.                T2(I,J)  = -1.E36
    2172. 

  2172.                TH2(I,J) = -1.E36
    2173. 

  2173.                Q2(I,J)  = -1.E36
    2174. 

  2174.            ENDDO
    2175. 

  2175.            ENDDO
    2176. 

  2176.            
    2177. 

  2177. !jref: sfc diagnostics
    2178. 

  2178.            DO j=j_start(ij),j_end(ij)
    2179. 

  2179.            DO i=i_start(ij),i_end(ij)
    2180. 

  2180.               IF (IVGTYP(I,J) == ISWATER .OR. IVGTYP(I,J) == ISICE) THEN
    2181. 

  2181.                  IF(CQS2(I,J).lt.1.E-5) then
    2182. 

  2182.                    Q2(I,J)=QSFC(I,J)
    2183. 

  2183.                  ELSE
    2184. 

  2184.                    Q2(I,J) = QSFC(I,J) - QFX(I,J)/(PSFC(I,J)/(R_d * TSK(I,J))*CQS2(I,J))
    2185. 

  2185.                  ENDIF
    2186. 

  2186.                  IF(CHS2(I,J).lt.1.E-5) then
    2187. 

  2187.                    T2(I,J) = TSK(I,J) 
    2188. 

  2188.                  ELSE
    2189. 

  2189.                    T2(I,J) = TSK(I,J) - HFX(I,J)/(PSFC(I,J)/(R_d * TSK(I,J))*CP*CHS2(I,J))
    2190. 

  2190.                  ENDIF
    2191. 

  2191.                    TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**ROVCP
    2192. 

  2192.               ELSEIF (IVGTYP(I,J) == ISURBAN ) THEN
    2193. 

  2193.                    Q2(I,J)  = q2mbxy(i,j)
    2194. 

  2194.                    T2(I,J)  = t2mbxy(i,j)
    2195. 

  2195.                    TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
    2196. 

  2196.               ELSE
    2197. 

  2197.                  T2(I,J)  = fvegxy(i,j)*t2mvxy(i,j) + (1.-fvegxy(i,j))*t2mbxy(i,j)
    2198. 

  2198.                  Q2(I,J)  = fvegxy(i,j)*q2mvxy(i,j) + (1.-fvegxy(i,j))*q2mbxy(i,j)
    2199. 

  2199.                  TH2(I,J) = T2(i,j)*(1.E5/PSFC(i,j))**RCP
    2200. 

  2200.               ENDIF
    2201. 

  2201.            ENDDO
    2202. 

  2202.            ENDDO
    2203. 

  2203.            
    2204. 

  2204. !          CALL SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,      &
    2205. 

  2205. !                     PSFC,CP,R_d,RCP,                              &
    2206. 

  2206. !                     ids,ide, jds,jde, kds,kde,                    &
    2207. 

  2207. !                     ims,ime, jms,jme, kms,kme,                    &
    2208. 

  2208. !             i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    2209. 

  2209. 

  2210. !jref: sfc diagnostics end
    2211. 

  2211. 

  2212. !------------------------------------------------------------------
    2213. 

  2213. 

  2214.        ELSE
    2215. 

  2215.          CALL wrf_error_fatal('Lacking arguments for NOAHMPLSM in surface driver')
    2216. 

  2216.        ENDIF
    2217. 

  2217. 

  2218.      CASE (RUCLSMSCHEME)
    2219. 

  2219.        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
    2220. 

  2220. !           PRESENT(emiss)      .AND.  PRESENT(t2)      .AND.    &
    2221. 

  2221.            PRESENT(qsg)        .AND.  PRESENT(qvg)     .AND.    &
    2222. 

  2222.            PRESENT(qcg)        .AND.  PRESENT(soilt1)  .AND.    &
    2223. 

  2223.            PRESENT(tsnav)      .AND.  PRESENT(smfr3d)  .AND.    &
    2224. 

  2224.            PRESENT(keepfr3dflag) .AND. PRESENT(rainbl) .AND.    &
    2225. 

  2225.            PRESENT(dew)                                .AND.    &
    2226. 

  2226.                                                       .TRUE. ) THEN
    2227. 

  2227. 

  2228.            IF( PRESENT(sr) ) THEN
    2229. 

  2229.                frpcpn=.true.
    2230. 

  2230.            ELSE
    2231. 

  2231.                SR = 1.
    2232. 

  2232.            ENDIF
    2233. 

  2233.            CALL wrf_debug(100,'in RUC LSM')
    2234. 

  2234.            IF ( FRACTIONAL_SEAICE == 1 ) THEN
    2235. 

  2235.               ! The fields passed to LSMRUC need to represent the full ice values, not
    2236. 

  2236.               ! the fractional values.  Convert ALBEDO and EMISS from the blended value 
    2237. 

  2237.               ! to a value representing only the sea-ice portion.   Albedo over open 
    2238. 

  2238.               ! water is taken to be 0.08. Emissivity over open water is taken to be 0.98
    2239. 

  2239.               DO j = j_start(ij) , j_end(ij)
    2240. 

  2240.                  DO i = i_start(ij) , i_end(ij)
    2241. 

  2241.                     IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
    2242. 

  2242.                        ALBEDO(I,J) = (ALBEDO(I,J) - (1.-XICE(I,J))*0.08) / XICE(I,J)
    2243. 

  2243.                        EMISS(I,J)  = (EMISS(I,J)  - (1.-XICE(I,J))*0.98) / XICE(I,J)
    2244. 

  2244.                     ENDIF
    2245. 

  2245.                  ENDDO
    2246. 

  2246.               ENDDO
    2247. 

  2247. 

  2248.               IF ( isisfc ) THEN
    2249. 

  2249.                  !
    2250. 

  2250.                  ! use surface layer routine values from the ice portion of grid point
    2251. 

  2251.                  !
    2252. 

  2252.               ELSE
    2253. 

  2253.                  !
    2254. 

  2254.                  ! don't have srfc layer routine values at this time, so just use what you have
    2255. 

  2255.                  ! use ice component of TSK
    2256. 

  2256.                  !
    2257. 

  2257.                  CALL get_local_ice_tsk( ims, ime, jms, jme,                   &
    2258. 

  2258.                                          i_start(ij), i_end(ij),               &
    2259. 

  2259.                                          j_start(ij), j_end(ij),               &
    2260. 

  2260.                                          itimestep, .false., tice2tsk_if2cold, &
    2261. 

  2261.                                          XICE, XICE_THRESHOLD,                 &
    2262. 

  2262.                                          SST, TSK, TSK_SEA, TSK_LOCAL )
    2263. 

  2263.                  DO j = j_start(ij) , j_end(ij)
    2264. 

  2264.                     DO i = i_start(ij) , i_end(ij)
    2265. 

  2265.                        TSK(i,j) = TSK_LOCAL(i,j)
    2266. 

  2266.                     ENDDO
    2267. 

  2267.                  ENDDO
    2268. 

  2268.               ENDIF
    2269. 

  2269.            ENDIF
    2270. 

  2270. 

  2271.            CALL LSMRUC(dtbl,itimestep,num_soil_layers,          &
    2272. 

  2272.                 zs,rainbl,snow,snowh,snowc,sr,frpcpn,           &
    2273. 

  2273.                 dz8w,p8w,t_phy,qv_curr,qc_curr,rho,             & !p8w in [pa]
    2274. 

  2274.                 glw,gsw,emiss,chklowq,                          &
    2275. 

  2275.                 chs,flqc,flhc,mavail,canwat,vegfra,albedo,znt,  &
    2276. 

  2276.                 z0,snoalb, albbck, lai,                         &   !new
    2277. 

  2277.                 mminlu, landusef, nlcat, mosaic_lu,             &
    2278. 

  2278.                 mosaic_soil, soilctop, nscat,                   &   !new
    2279. 

  2279.                 qsfc,qsg,qvg,qcg,dew,soilt1,tsnav,              &
    2280. 

  2280.                 tmn,ivgtyp,isltyp,xland,                        &
    2281. 

  2281.                 iswater,isice,xice,xice_threshold,              &
    2282. 

  2282.                 cp,rovcp,g,xlv,stbolt,                          &
    2283. 

  2283.                 smois,sh2o,smstav,smstot,tslb,tsk,hfx,qfx,lh,   &
    2284. 

  2284.                 sfcrunoff,udrunoff,sfcexc,                      &
    2285. 

  2285.                 sfcevp,grdflx,acsnow,acsnom,                    &
    2286. 

  2286.                 smfr3d,keepfr3dflag,                            &
    2287. 

  2287.                 myj,                                            &
    2288. 

  2288.                 ids,ide, jds,jde, kds,kde,                      &
    2289. 

  2289.                 ims,ime, jms,jme, kms,kme,                      &
    2290. 

  2290.                 i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    2291. 

  2291. 

  2292.            IF ( FRACTIONAL_SEAICE == 1 ) THEN
    2293. 

  2293.               ! LSMRUC Returns full land/ice values, no fractional values.
    2294. 

  2294.               ! We return to a fractional component here.
    2295. 

  2295.               DO j=j_start(ij),j_end(ij)
    2296. 

  2296.                  DO i=i_start(ij),i_end(ij)
    2297. 

  2297.                     IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2298. 

  2298.                        albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08  )
    2299. 

  2299.                        emiss(i,j)  = ( emiss(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.98  )
    2300. 

  2300.                     ENDIF
    2301. 

  2301.                  ENDDO
    2302. 

  2302.               ENDDO
    2303. 

  2303.               if ( isisfc ) then
    2304. 

  2304.                  !
    2305. 

  2305.                  !  back to ice and ocean average
    2306. 

  2306.                  !
    2307. 

  2307.                  DO j=j_start(ij),j_end(ij)
    2308. 

  2308.                     DO i=i_start(ij),i_end(ij)
    2309. 

  2309.                        IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2310. 

  2310.                           flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flhc_sea(i,j) )
    2311. 

  2311.                           flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * flqc_sea(i,j) )
    2312. 

  2312.                           cpm(i,j)  = ( cpm(i,j)  * XICE(i,j) ) + ( (1.-XICE(i,j)) * cpm_sea(i,j)  )
    2313. 

  2313.                           cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * cqs2_sea(i,j) )
    2314. 

  2314.                           chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs2_sea(i,j) )
    2315. 

  2315.                           chs(i,j)  = ( chs(i,j)  * XICE(i,j) ) + ( (1.-XICE(i,j)) * chs_sea(i,j)  )
    2316. 

  2316.                           qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * QSFC_SEA(i,j) )
    2317. 

  2317.                           qgh(i,j)  = ( qgh(i,j)  * XICE(i,j) ) + ( (1.-XICE(i,j)) * qgh_sea(i,j)  )
    2318. 

  2318.                           hfx(i,j)  = ( hfx(i,j)  * XICE(i,j) ) + ( (1.-XICE(i,j)) * HFX_SEA(i,j)  )
    2319. 

  2319.                           qfx(i,j)  = ( qfx(i,j)  * XICE(i,j) ) + ( (1.-XICE(i,j)) * QFX_SEA(i,j)  )
    2320. 

  2320.                           lh(i,j)   = ( lh(i,j)   * XICE(i,j) ) + ( (1.-XICE(i,j)) * LH_SEA(i,j)   )
    2321. 

  2321.                           tsk(i,j)  = ( tsk(i,j)  * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j)  )
    2322. 

  2322.                        ENDIF
    2323. 

  2323.                     ENDDO
    2324. 

  2324.                  ENDDO
    2325. 

  2325.               else
    2326. 

  2326.                  !
    2327. 

  2327.                  ! tsk back to liquid and ice average
    2328. 

  2328.                  !
    2329. 

  2329.                  DO j = j_start(ij) , j_end(ij)
    2330. 

  2330.                     DO i = i_start(ij) , i_end(ij)
    2331. 

  2331.                        IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2332. 

  2332.                           tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.-XICE(i,j)) * TSK_SEA(i,j) )
    2333. 

  2333.                        ENDIF
    2334. 

  2334.                     ENDDO
    2335. 

  2335.                  ENDDO
    2336. 

  2336.               endif
    2337. 

  2337.            ENDIF
    2338. 

  2338. 

  2339.           CALL SFCDIAGS_RUCLSM(HFX,QFX,TSK,QSFC,CQS2,CQS2,T2,TH2,Q2,      &
    2340. 

  2340.                      T_PHY,QV_CURR,RHO,P8W,                              &
    2341. 

  2341.                      PSFC,CP,R_d,RCP,                                    &
    2342. 

  2342.                      ids,ide, jds,jde, kds,kde,                          &
    2343. 

  2343.                      ims,ime, jms,jme, kms,kme,                          &
    2344. 

  2344.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte    )
    2345. 

  2345. 

  2346. 

  2347.        ELSE
    2348. 

  2348.          CALL wrf_error_fatal('Lacking arguments for RUCLSM in surface driver')
    2349. 

  2349.        ENDIF
    2350. 

  2350. 

  2351.      CASE (PXLSMSCHEME)
    2352. 

  2352.        IF (PRESENT(qv_curr)    .AND.  PRESENT(qc_curr) .AND.    &
    2353. 

  2353.            PRESENT(emiss)      .AND.  PRESENT(t2)      .AND.    &
    2354. 

  2354.            PRESENT(rainbl) .AND.    &
    2355. 

  2355.                                                       .TRUE. ) THEN
    2356. 

  2356.           IF ( FRACTIONAL_SEAICE == 1 ) THEN
    2357. 

  2357. 

  2358.              CALL WRF_ERROR_FATAL("PXLSM not adapted for FRACTIONAL_SEAICE=1 option")
    2359. 

  2359. 

  2360.              IF ( isisfc ) THEN
    2361. 

  2361.                 !
    2362. 

  2362.                 ! use surface layer routine values from the ice portion of grid point
    2363. 

  2363.                 !
    2364. 

  2364.              ELSE
    2365. 

  2365.                 !
    2366. 

  2366.                 ! don't have srfc layer routine values at this time, so just use what you have
    2367. 

  2367.                 ! use ice component of TSK
    2368. 

  2368.                 !
    2369. 

  2369.                 CALL get_local_ice_tsk( ims, ime, jms, jme,                   &
    2370. 

  2370.                                         i_start(ij), i_end(ij),               &
    2371. 

  2371.                                         j_start(ij), j_end(ij),               &
    2372. 

  2372.                                         itimestep, .false., tice2tsk_if2cold, &
    2373. 

  2373.                                         XICE, XICE_THRESHOLD,                 &
    2374. 

  2374.                                         SST, TSK, TSK_SEA, TSK_LOCAL )
    2375. 

  2375.                 DO j = j_start(ij) , j_end(ij)
    2376. 

  2376.                    DO i=i_start(ij) , i_end(ij)
    2377. 

  2377.                       TSK(i,j) = TSK_LOCAL(i,j)
    2378. 

  2378.                    ENDDO
    2379. 

  2379.                 ENDDO
    2380. 

  2380.              ENDIF
    2381. 

  2381.           ENDIF
    2382. 

  2382.           CALL wrf_debug(100,'in P-X LSM')
    2383. 

  2383.           CALL PXLSM(u_phy, v_phy, dz8w, qv_curr, t_phy, th_phy, rho,&
    2384. 

  2384.                      psfc, gsw, glw, rainbl, emiss,                  &
    2385. 

  2385.                      ITIMESTEP, num_soil_layers, DT, anal_interval,  &
    2386. 

  2386.                      xland, xice, albbck, albedo, snoalb, smois, tslb, &
    2387. 

  2387.                      mavail,T2, Q2,                                  &
    2388. 

  2388.                      zs, dzs, psih,                                  &
    2389. 

  2389.                      landusef,soilctop,soilcbot,vegfra, vegf_px,     &
    2390. 

  2390.                      isltyp,ra,rs,lai,nlcat,nscat,                   &
    2391. 

  2391.                      hfx,qfx,lh,tsk,sst,znt,canwat,                  &
    2392. 

  2392.                      grdflx,shdmin,shdmax,                           &
    2393. 

  2393.                      snowc,pblh,rmol,ust,capg,dtbl,                  &
    2394. 

  2394.                      t2_ndg_old,t2_ndg_new,q2_ndg_old,q2_ndg_new,    &
    2395. 

  2395.                      sn_ndg_old, sn_ndg_new, snow, snowh,snowncv,    &
    2396. 

  2396.                      t2obs, q2obs, pxlsm_smois_init, pxlsm_soil_nudge, &
    2397. 

  2397.                      ids,ide, jds,jde, kds,kde,                      &
    2398. 

  2398.                      ims,ime, jms,jme, kms,kme,                      &
    2399. 

  2399.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
    2400. 

  2400.           IF ( FRACTIONAL_SEAICE == 1 ) THEN
    2401. 

  2401.              IF ( isisfc ) THEN
    2402. 

  2402.                 !
    2403. 

  2403.                 !  back to ice and ocean average
    2404. 

  2404.                 !
    2405. 

  2405.                 DO j = j_start(ij) , j_end(ij)
    2406. 

  2406.                    DO i = i_start(ij) , i_end(ij)
    2407. 

  2407.                       IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2408. 

  2408.                          flhc(i,j) = ( flhc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flhc_sea(i,j) )
    2409. 

  2409.                          flqc(i,j) = ( flqc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * flqc_sea(i,j) )
    2410. 

  2410.                          cpm(i,j)  = ( cpm(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cpm_sea(i,j)  )
    2411. 

  2411.                          cqs2(i,j) = ( cqs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * cqs2_sea(i,j) )
    2412. 

  2412.                          chs2(i,j) = ( chs2(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs2_sea(i,j) )
    2413. 

  2413.                          chs(i,j)  = ( chs(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * chs_sea(i,j)  )
    2414. 

  2414.                          qsfc(i,j) = ( qsfc(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QSFC_SEA(i,j) )
    2415. 

  2415.                          qgh(i,j)  = ( qgh(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QGH_SEA(i,j)  )
    2416. 

  2416.                          hfx(i,j)  = ( hfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * HFX_SEA(i,j)  )
    2417. 

  2417.                          qfx(i,j)  = ( qfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * QFX_SEA(i,j)  )
    2418. 

  2418.                          lh(i,j)   = ( lh(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * LH_SEA(i,j)   )
    2419. 

  2419.                          tsk(i,j)  = ( tsk(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * TSK_SEA(i,j)  )
    2420. 

  2420.                          psih(i,j) = ( psih(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j) )
    2421. 

  2421.                          pblh(i,j) = ( pblh(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PBLH_SEA(i,j) )
    2422. 

  2422.                          rmol(i,j) = ( rmol(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * RMOL_SEA(i,j) )
    2423. 

  2423.                          ust(i,j)  = ( ust(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * UST_SEA(i,j)  )
    2424. 

  2424.                       ENDIF
    2425. 

  2425.                    ENDDO
    2426. 

  2426.                 ENDDO
    2427. 

  2427.              ELSE
    2428. 

  2428.                 !
    2429. 

  2429.                 ! tsk back to liquid and ice average
    2430. 

  2430.                 !
    2431. 

  2431.                 DO j=j_start(ij),j_end(ij)
    2432. 

  2432.                    DO i=i_start(ij),i_end(ij)
    2433. 

  2433.                       IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2434. 

  2434.                          tsk(i,j)=tsk(i,j)*XICE(i,j)+(1.0-XICE(i,j))*TSK_SEA(i,j)
    2435. 

  2435.                       ENDIF
    2436. 

  2436.                    ENDDO
    2437. 

  2437.                 ENDDO
    2438. 

  2438.              ENDIF
    2439. 

  2439.           ENDIF
    2440. 

  2440.            DO j=j_start(ij),j_end(ij)
    2441. 

  2441.            DO i=i_start(ij),i_end(ij)
    2442. 

  2442.               CHKLOWQ(I,J)= 1.0
    2443. 

  2443.               TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**RCP
    2444. 

  2444.               SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
    2445. 

  2445.            ENDDO
    2446. 

  2446.            ENDDO
    2447. 

  2447. 

  2448.        ELSE
    2449. 

  2449.          CALL wrf_error_fatal('Lacking arguments for P-X LSM in surface driver')
    2450. 

  2450.        ENDIF
    2451. 

  2451. 

  2452.      CASE (SSIBSCHEME)
    2453. 

  2453.      IF(PRESENT(alswvisdir))THEN
    2454. 

  2454. !---Fernando De Sales (fds 06/2010)--------------------------------------
    2455. 

  2455.      CALL wrf_debug(100,'in SSIB')
    2456. 

  2456. !
    2457. 

  2457.        IF ( FRACTIONAL_SEAICE == 1) THEN
    2458. 

  2458.           ! The fields passed to SSIB need to represent the full ice values, not
    2459. 

  2459.           ! the fractional values.  Convert ALBEDO from the blended value
    2460. 

  2460.           ! to a value representing only the sea-ice portion.   Albedo over open
    2461. 

  2461.           ! water is taken to be 0.08.
    2462. 

  2462.           DO j = j_start(ij) , j_end(ij)
    2463. 

  2463.              DO i = i_start(ij) , i_end(ij)
    2464. 

  2464.                 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
    2465. 

  2465.                    ALBEDO(I,J) = (ALBEDO(I,J)-(1.-XICE(I,J))*0.08)/XICE(I,J)
    2466. 

  2466.                 ENDIF
    2467. 

  2467.              ENDDO
    2468. 

  2468.           ENDDO
    2469. 

  2469.        ELSE
    2470. 

  2470. !  we shouldn't be here. must have fractional seaice for SSIB to work properly (fds 12/2010)
    2471. 

  2471.        ENDIF
    2472. 

  2472. !
    2473. 

  2473. !This stuff is not needed anymore since isisfc is always TRUE for SSIB
    2474. 

  2474. !Keep it for later use when code is adapted for isisfc=FALSE
    2475. 

  2475. !          IF ( isisfc ) THEN
    2476. 

  2476. !             ! Use surface layer routine values from the ice portion of grid point
    2477. 

  2477. !          ELSE
    2478. 

  2478. !             !
    2479. 

  2479. !             ! We don't have surface layer routine values at this time, so
    2480. 

  2480. !             ! just use what we have.  Use ice component of TSK
    2481. 

  2481. !             !
    2482. 

  2482. !             DO j = j_start(ij) , j_end(ij)
    2483. 

  2483. !                DO i = i_start(ij) , i_end(ij)
    2484. 

  2484. !                   IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1 ) ) THEN
    2485. 

  2485. !                      IF ( SST(i,j) .LT. 271.4 ) THEN
    2486. 

  2486. !                         SST(i,j) = 271.4
    2487. 

  2487. !                      ENDIF
    2488. 

  2488. !                      TSK_SEA(i,j) = SST(i,j)
    2489. 

  2489. !                      ! Convert TSK from our ice/water average value to value good for solid-ice surface.
    2490. 

  2490. !                      TSK(i,j) = ( TSK(i,j) - (1.-XICE(i,j)) *SST(i,j) ) / XICE(i,j)
    2491. 

  2491. !                      IF (XICE(i,j).lt.0.2 .and. TSK(i,j).lt.253.15) THEN
    2492. 

  2492. !                         TSK(i,j) = 253.15
    2493. 

  2493. !                      ENDIF
    2494. 

  2494. !                      IF (XICE(i,j).lt.0.1 .and. TSK(i,j).lt.263.15) THEN
    2495. 

  2495. !                         TSK(i,j) = 263.15
    2496. 

  2496. !                      ENDIF
    2497. 

  2497. !                   ELSE
    2498. 

  2498. !                      TSK_SEA(i,j) = TSK(i,j)
    2499. 

  2499. !                   ENDIF
    2500. 

  2500. !                ENDDO
    2501. 

  2501. !             ENDDO
    2502. 

  2502. !          ENDIF
    2503. 

  2503. !
    2504. 

  2504.        day=float(int(julian_in+0.01))+1.
    2505. 

  2505.        DO j=j_start(ij),j_end(ij)
    2506. 

  2506.        DO i=i_start(ij),i_end(ij)
    2507. 

  2507. !check land mask and land-use map !fds (02/2012)
    2508. 

  2508. ! IF(itimestep .EQ. 1 ) THEN
    2509. 

  2509. !          IF(IVGTYP(i,j).NE.ISWATER)THEN
    2510. 

  2510. !            XLAND(I,J)=1.0
    2511. 

  2511. !          ELSE
    2512. 

  2512. !            XLAND(I,J)=2.0
    2513. 

  2513. !          ENDIF
    2514. 

  2514. !         IF (IVGTYP(I,J).LE.0 .AND. XLAND(I,J).NE.ISWATER ) IVGTYP(I,J) = 7.0
    2515. 

  2515. ! ENDIF
    2516. 

  2516. !
    2517. 

  2517. 

  2518. !        IF(XLAND(I,J).LT.1.5 .AND. IVGTYP(I,J).NE.ISICE) THEN !land and seaice-free points
    2519. 

  2519.          IF(XLAND(I,J).LT.1.5) THEN !land points, including land ice points
    2520. 

  2520. 

  2521.            CLOUDFRAC=0.
    2522. 

  2522.            IF(PRESENT(CLDFRA))THEN
    2523. 

  2523.            DO K=KMS,KME
    2524. 

  2524.              CLOUDFRAC=AMAX1(CLOUDFRAC,AMIN1(CLDFRA(I,K,J),1.0))
    2525. 

  2525.            ENDDO
    2526. 

  2526.            ENDIF
    2527. 

  2527. 

  2528.            CALL ssib( i, j, DTBL, itimestep, xlat_urb2d(i,j), coszen(i,j),        &
    2529. 

  2529.                      rainncv(i,j), raincv(i,j), glw(i,j), dz8w(i,1,j),            &
    2530. 

  2530.                      smois(i,1,j), smois(i,2,j), smois(i,3,j),                    &
    2531. 

  2531.                      tslb(i,1,j), tslb(i,2,j), tslb(i,3,j),                       &
    2532. 

  2532.                      snow(i,j), sfcrunoff(i,j),                                   &
    2533. 

  2533.                      u_phytmp(i,1,j),v_phytmp(i,1,j),qv_curr(i,1,j),t_phy(i,1,j), &
    2534. 

  2534.                      p_phy(i,1,j), psfc(i,j), ivgtyp(i,j),                        &
    2535. 

  2535.                      swdown(i,j), canwat(i,j),                                    &
    2536. 

  2536.                 alswvisdir(i,j),alswvisdif(i,j),alswnirdir(i,j),alswnirdif(i,j),  &
    2537. 

  2537.                      swvisdir(i,j), swvisdif(i,j), swnirdir(i,j), swnirdif(i,j),  &
    2538. 

  2538.                      hfx(i,j), lh(i,j), grdflx(i,j), qfx(i,j), tsk(i,j),          &
    2539. 

  2539.                      ust(i,j), ssib_br(i,j), ssib_fm(i,j), ssib_fh(i,j), ssib_cm(i,j), &
    2540. 

  2540.                      ssib_lhf(i,j), ssib_shf(i,j), ssib_ghf(i,j), ssib_egs(i,j),  & 
    2541. 

  2541.                      ssib_eci(i,j), ssib_ect(i,j), ssib_egi(i,j), ssib_egt(i,j),  &
    2542. 

  2542.                      ssib_sdn(i,j), ssib_sup(i,j), ssib_ldn(i,j), ssib_lup(i,j),  &
    2543. 

  2543.                      ssib_wat(i,j), ssib_shc(i,j), ssib_shg(i,j), ssib_lai(i,j),  &
    2544. 

  2544.                      ssib_vcf(i,j), ssib_z00(i,j), ssib_veg(i,j), ssibxdd(i,j),   &
    2545. 

  2545.                      isnow(i,j), swe(i,j), snowden(i,j), snowdepth(i,j),tkair(i,j),  &
    2546. 

  2546.                      dzo1(i,j),  wo1(i,j),   tssn1(i,j), tssno1(i,j), bwo1(i,j), bto1(i,j),  &
    2547. 

  2547.                      cto1(i,j), fio1(i,j),    flo1(i,j),   bio1(i,j), blo1(i,j),  ho1(i,j),  &
    2548. 

  2548.                      dzo2(i,j),  wo2(i,j),   tssn2(i,j), tssno2(i,j), bwo2(i,j), bto2(i,j),  &
    2549. 

  2549.                      cto2(i,j), fio2(i,j),    flo2(i,j),   bio2(i,j), blo2(i,j),  ho2(i,j),  &
    2550. 

  2550.                      dzo3(i,j),  wo3(i,j),   tssn3(i,j), tssno3(i,j), bwo3(i,j), bto3(i,j),  &
    2551. 

  2551.                      cto3(i,j), fio3(i,j),    flo3(i,j),   bio3(i,j), blo3(i,j),  ho3(i,j),  &
    2552. 

  2552.                      dzo4(i,j),  wo4(i,j),   tssn4(i,j), tssno4(i,j), bwo4(i,j), bto4(i,j),  &
    2553. 

  2553.                      cto4(i,j), fio4(i,j),    flo4(i,j),   bio4(i,j), blo4(i,j),  ho4(i,j),  &
    2554. 

  2554.                      day, cloudfrac, q2(i,j), t2(i,j), albedo(i,j),               &
    2555. 

  2555.                      ra_sw_physics, mminlu                                        &
    2556. 

  2556.                                                                                   )
    2557. 

  2557.                      BR(i,j)=ssib_br(i,j)
    2558. 

  2558.                      ZNT(i,j) = ssib_z00(i,j)
    2559. 

  2559.                      SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
    2560. 

  2560.                      snowh(i,j) = snowdepth(i,j)
    2561. 

  2561.                      IF (itimestep .ne. 1) THEN
    2562. 

  2562.                        ZDIFF=(0.5*dz8w(i,1,j))-SSiBXDD(I,J)
    2563. 

  2563.                        IF(ZDIFF.LE.ZNT(I,J)) ZDIFF=ZNT(I,J)+0.2
    2564. 

  2564.                        GZ1OZ0(I,J)=ALOG(ZDIFF/ZNT(I,J))
    2565. 

  2565.                      ENDIF
    2566. 

  2566. !                    Overwrite WSPD to remove convective velocity (wspd=wspd1 in YSU)
    2567. 

  2567.                      WSPD(I,J)=sqrt( u_phytmp(i,1,j)*u_phytmp(i,1,j) +      &
    2568. 

  2568.                                      v_phytmp(i,1,j)*v_phytmp(i,1,j) ) + 1.e-9
    2569. 

  2569. 

  2570.          ELSE IF (XICE(I,J) .GE. XICE_THRESHOLD) THEN !sea ice points
    2571. 

  2571. 

  2572.            CLOUDFRAC=0.
    2573. 

  2573.            DO K=KMS,KME
    2574. 

  2574.              CLOUDFRAC=AMAX1(CLOUDFRAC,AMIN1(CLDFRA(I,K,J),1.0))
    2575. 

  2575.            ENDDO
    2576. 

  2576. 

  2577. !          CALL wrf_message ( 'Calling ssib_seaice' ) !fds
    2578. 

  2578.            CALL ssib_seaice                                                        &
    2579. 

  2579.                     ( i, j, DTBL, itimestep, xlat_urb2d(i,j), coszen(i,j),         &
    2580. 

  2580.                       rainncv(i,j), raincv(i,j), glw(i,j), dz8w(i,1,j),            &
    2581. 

  2581.                       smois(i,1,j), smois(i,2,j), smois(i,3,j),                    &
    2582. 

  2582.                       tslb(i,1,j), tslb(i,2,j), tslb(i,3,j),                       &
    2583. 

  2583.                       snow(i,j), sfcrunoff(i,j), xicem(i,j),                        &
    2584. 

  2584.                       u_phytmp(i,1,j),v_phytmp(i,1,j),qv_curr(i,1,j),t_phy(i,1,j), &
    2585. 

  2585.                       p_phy(i,1,j), psfc(i,j),                                     &
    2586. 

  2586.                       swdown(i,j), canwat(i,j),                                    &
    2587. 

  2587.                  alswvisdir(i,j),alswvisdif(i,j),alswnirdir(i,j),alswnirdif(i,j),  &
    2588. 

  2588.                       swvisdir(i,j), swvisdif(i,j), swnirdir(i,j), swnirdif(i,j),  &
    2589. 

  2589.                       hfx(i,j), lh(i,j), grdflx(i,j), qfx(i,j), tsk(i,j),          &
    2590. 

  2590.                       ust(i,j), ssib_br(i,j), ssib_fm(i,j), ssib_fh(i,j), ssib_cm(i,j), &
    2591. 

  2591.                       ssib_lhf(i,j), ssib_shf(i,j), ssib_ghf(i,j),                 &
    2592. 

  2592.                       ssib_sdn(i,j), ssib_sup(i,j), ssib_ldn(i,j), ssib_lup(i,j),  &
    2593. 

  2593.                       ssib_wat(i,j),                                               &
    2594. 

  2594.                                      ssib_z00(i,j), ssib_veg(i,j),                 &
    2595. 

  2595.                       day, cloudfrac, q2(i,j), t2(i,j), albedo(i,j),               &
    2596. 

  2596.                       ra_sw_physics,xice_threshold                                 &
    2597. 

  2597.                                                                                    )
    2598. 

  2598.                      BR(i,j)=ssib_br(i,j)
    2599. 

  2599.                      ZNT(i,j) = ssib_z00(i,j)
    2600. 

  2600.                      SFCEVP(I,J)= SFCEVP(I,J) + QFX(I,J)*DTBL
    2601. 

  2601.                     t2(i,j) = tsk(i,j) !use SSiB's TGEFF as 2m temperature (Nov/2011)
    2602. 

  2602.                      IF (itimestep .ne. 1) THEN
    2603. 

  2603.                        ZDIFF=(0.5*dz8w(i,1,j))-SSiBXDD(I,J)
    2604. 

  2604.                        IF(ZDIFF.LE.ZNT(I,J)) ZDIFF=ZNT(I,J)+0.2
    2605. 

  2605.                        GZ1OZ0(I,J)=ALOG(ZDIFF/ZNT(I,J))
    2606. 

  2606.                      ENDIF
    2607. 

  2607. !                    Overwrite WSPD to remove convective velocity (wspd=wspd1 in YSU)
    2608. 

  2608.                      WSPD(I,J)=sqrt( u_phytmp(i,1,j)*u_phytmp(i,1,j) +      &
    2609. 

  2609.                                      v_phytmp(i,1,j)*v_phytmp(i,1,j) ) + 1.e-9
    2610. 

  2610.          ENDIF
    2611. 

  2611.        ENDDO
    2612. 

  2612.        ENDDO
    2613. 

  2613. !
    2614. 

  2614.        IF ( FRACTIONAL_SEAICE == 1 ) THEN
    2615. 

  2615.           ! SSIB_seaice returns full land/ice albedo values, no fractional values.
    2616. 

  2616.           ! We return to a fractional component here. 
    2617. 

  2617.           DO j=j_start(ij),j_end(ij)
    2618. 

  2618.              DO i=i_start(ij),i_end(ij)
    2619. 

  2619.                 IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2620. 

  2620.                    albedo(i,j) = ( albedo(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * 0.08  )
    2621. 

  2621.                 ENDIF
    2622. 

  2622.              ENDDO
    2623. 

  2623.           ENDDO
    2624. 

  2624. !
    2625. 

  2625.           IF ( isisfc ) THEN
    2626. 

  2626.              DO j=j_start(ij),j_end(ij)
    2627. 

  2627.                 DO i=i_start(ij),i_end(ij)
    2628. 

  2628.                    IF ( ( XICE(I,J) .GE. XICE_THRESHOLD) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2629. 

  2629.                       !  Weighted average of fields between ice-cover values and open-water values.
    2630. 

  2630.                       hfx(i,j)  = ( hfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * hfx_sea(i,j)  )
    2631. 

  2631.                       qfx(i,j)  = ( qfx(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * qfx_sea(i,j)  )
    2632. 

  2632.                       lh(i,j)   = ( lh(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * lh_sea(i,j)   )
    2633. 

  2633.                       tsk(i,j)  = ( tsk(i,j)  * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j)  )
    2634. 

  2634.                    ENDIF
    2635. 

  2635.                 ENDDO
    2636. 

  2636.              ENDDO
    2637. 

  2637.           ELSE
    2638. 

  2638.              DO j = j_start(ij) , j_end(ij)
    2639. 

  2639.                 DO i = i_start(ij) , i_end(ij)
    2640. 

  2640.                    IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2641. 

  2641.                       ! Compute TSK as the open-water and ice-cover average
    2642. 

  2642.                       tsk(i,j) = ( tsk(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * tsk_sea(i,j) )
    2643. 

  2643.                    ENDIF
    2644. 

  2644.                 ENDDO
    2645. 

  2645.              ENDDO
    2646. 

  2646.           ENDIF
    2647. 

  2647.        ENDIF
    2648. 

  2648.        ELSE
    2649. 

  2649.          CALL wrf_error_fatal('Lacking arguments for SSIB in surface driver')
    2650. 

  2650.        ENDIF
    2651. 

  2651. !end ssib
    2652. 

  2652. !-------------------------------------------------------------------
    2653. 

  2653. 

  2654.      CASE DEFAULT
    2655. 

  2655. 

  2656.        IF ( itimestep .eq. 1 ) THEN
    2657. 

  2657.        WRITE( message , * ) &
    2658. 

  2658.         'No land surface physics option is used: sf_surface_physics = ', sf_surface_physics
    2659. 

  2659.         CALL wrf_message ( message )
    2660. 

  2660.        ENDIF
    2661. 

  2661. 

  2662.      END SELECT sfc_select
    2663. 

  2663. 

  2664.      ENDDO
    2665. 

  2665.      !$OMP END PARALLEL DO
    2666. 

  2666. 

  2667.  430 CONTINUE
    2668. 

  2668. 

  2669. #if ( EM_CORE==1)
    2670. 

  2670.    IF (omlcall .EQ. 1) THEN
    2671. 

  2671. ! simple ocean mixed layer model based Pollard, Rhines and Thompson (1973)
    2672. 

  2672.      CALL wrf_debug( 100, 'Call OCEANML' )
    2673. 

  2673.      !$OMP PARALLEL DO   &
    2674. 

  2674.      !$OMP PRIVATE ( ij )
    2675. 

  2675.      DO ij = 1 , num_tiles
    2676. 

  2676.         CALL oceanml(tml,t0ml,hml,h0ml,huml,hvml,ust,u_phy,v_phy, &
    2677. 

  2677.                      tmoml,f,g,oml_gamma,                         &
    2678. 

  2678.                      xland,hfx,lh,tsk,gsw,glw,emiss,              &
    2679. 

  2679.                      dtbl,STBOLT,                                 &
    2680. 

  2680.                      ids,ide, jds,jde, kds,kde,                   &
    2681. 

  2681.                      ims,ime, jms,jme, kms,kme,                   &
    2682. 

  2682.                      i_start(ij),i_end(ij), j_start(ij),j_end(ij), kts,kte)
    2683. 

  2683.      ENDDO
    2684. 

  2684.      !$OMP END PARALLEL DO
    2685. 

  2685.    ENDIF
    2686. 

  2686. #endif
    2687. 

  2687. 

  2688. ! Reset RAINBL in mm (Accumulation between PBL calls)
    2689. 

  2689. 

  2690.      IF ( PRESENT( rainbl ) ) THEN
    2691. 

  2691.        !$OMP PARALLEL DO   &
    2692. 

  2692.        !$OMP PRIVATE ( ij, i, j, k )
    2693. 

  2693.        DO ij = 1 , num_tiles
    2694. 

  2694.          DO j=j_start(ij),j_end(ij)
    2695. 

  2695.          DO i=i_start(ij),i_end(ij)
    2696. 

  2696.             RAINBL(i,j) = 0.
    2697. 

  2697.          ENDDO
    2698. 

  2698.          ENDDO
    2699. 

  2699.        ENDDO
    2700. 

  2700.        !$OMP END PARALLEL DO
    2701. 

  2701.      ENDIF
    2702. 

  2702. 

  2703.      IF( PRESENT(slope_rad).AND. radiation )THEN
    2704. 

  2704. ! topographic slope effects removed from SWDOWN and GSW here for output
    2705. 

  2705.        IF (slope_rad .EQ. 1) THEN
    2706. 

  2706. 

  2707.        !$OMP PARALLEL DO   &
    2708. 

  2708.        !$OMP PRIVATE ( ij, i, j, k )
    2709. 

  2709.        DO ij = 1 , num_tiles
    2710. 

  2710.          DO j=j_start(ij),j_end(ij)
    2711. 

  2711.          DO i=i_start(ij),i_end(ij)
    2712. 

  2712.          IF(SWNORM(I,J) .GT. 1.E-3)THEN  ! daytime
    2713. 

  2713.             SWSAVE = SWDOWN(i,j)
    2714. 

  2714. ! SWDOWN contains unaffected SWDOWN in output
    2715. 

  2715.             SWDOWN(i,j) = SWNORM(i,j)
    2716. 

  2716. ! SWNORM contains slope-affected SWDOWN in output
    2717. 

  2717.             SWNORM(i,j) = SWSAVE
    2718. 

  2718.             GSW(i,j) = GSWSAVE(i,j)
    2719. 

  2719.          ENDIF
    2720. 

  2720.          ENDDO
    2721. 

  2721.          ENDDO
    2722. 

  2722.        ENDDO
    2723. 

  2723.        !$OMP END PARALLEL DO
    2724. 

  2724. 

  2725.        ENDIF
    2726. 

  2726.      ENDIF
    2727. 

  2727. 

  2728.    ENDIF
    2729. 

  2729. 

  2730.    END SUBROUTINE surface_driver
    2731. 

  2731. 

  2732. !-------------------------------------------------------------------------
    2733. 

  2733. !-------------------------------------------------------------------------
    2734. 

  2734. 

  2735.    subroutine myjsfc_seaice_wrapper(ITIMESTEP,HT,DZ,      &
    2736. 

  2736.         &     PMID,PINT,TH,T,QV,QC,U,V,Q2,                &
    2737. 

  2737.         &     TSK,QSFC,THZ0,QZ0,UZ0,VZ0,                  &
    2738. 

  2738.         &     LOWLYR,XLAND,IVGTYP,ISURBAN,IZ0TLND,        &
    2739. 

  2739.         &     TICE2TSK_IF2COLD,                           &  ! Extra for wrapper
    2740. 

  2740.         &     XICE_THRESHOLD,                             &  ! Extra for wrapper
    2741. 

  2741.         &     XICE,SST,                                   &  ! Extra for wrapper
    2742. 

  2742.         &     CHS_SEA, CHS2_SEA, CQS2_SEA, CPM_SEA,       &  ! Extra for wrapper
    2743. 

  2743.         &     FLHC_SEA, FLQC_SEA, QSFC_SEA,               &  ! Extra for wrapper
    2744. 

  2744.         &     QGH_SEA, QZ0_SEA, HFX_SEA, QFX_SEA,         &  ! Extra for wrapper
    2745. 

  2745.         &     FLX_LH_SEA, TSK_SEA,                        &  ! Extra for wrapper
    2746. 

  2746.         &     USTAR,ZNT,Z0BASE,PBLH,MAVAIL,RMOL,          &
    2747. 

  2747.         &     AKHS,AKMS,                                  &
    2748. 

  2748.         &     BR,                                         &
    2749. 

  2749.         &     CHS,CHS2,CQS2,HFX,QFX,FLX_LH,FLHC,FLQC,     &
    2750. 

  2750.         &     QGH,CPM,CT,                                 &
    2751. 

  2751.         &     U10,V10,T02,TH02,TSHLTR,TH10,Q02,QSHLTR,Q10,PSHLTR,          &
    2752. 

  2752.         &     P1000,                                        &
    2753. 

  2753.         &     IDS,IDE,JDS,JDE,KDS,KDE,                        &
    2754. 

  2754.         &     IMS,IME,JMS,JME,KMS,KME,                        &
    2755. 

  2755.         &     ITS,ITE,JTS,JTE,KTS,KTE )
    2756. 

  2756. !     USE module_model_constants
    2757. 

  2757.      USE module_sf_myjsfc
    2758. 

  2758. 

  2759.      IMPLICIT NONE
    2760. 

  2760. 

  2761.      INTEGER,                                INTENT(IN)    :: ITIMESTEP
    2762. 

  2762.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: HT
    2763. 

  2763.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: DZ
    2764. 

  2764.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: PMID
    2765. 

  2765.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: PINT
    2766. 

  2766.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: TH
    2767. 

  2767.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: T
    2768. 

  2768.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: QV
    2769. 

  2769.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: QC
    2770. 

  2770.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: U
    2771. 

  2771.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: V
    2772. 

  2772.      REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN)    :: Q2   ! Q2 is TKE?
    2773. 

  2773. 

  2774.      ! REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: TSK
    2775. 

  2775.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT)    :: TSK
    2776. 

  2776. 

  2777.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: QSFC
    2778. 

  2778.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: THZ0
    2779. 

  2779.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: QZ0
    2780. 

  2780.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: UZ0
    2781. 

  2781.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: VZ0
    2782. 

  2782.      INTEGER,DIMENSION(IMS:IME,JMS:JME),     INTENT(IN)    :: LOWLYR
    2783. 

  2783.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: XLAND
    2784. 

  2784.      INTEGER,DIMENSION(IMS:IME,JMS:JME),     INTENT(IN)    :: IVGTYP
    2785. 

  2785.      INTEGER                                               :: ISURBAN
    2786. 

  2786.      INTEGER                                               :: IZ0TLND
    2787. 

  2787.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: XICE       ! Extra for wrapper
    2788. 

  2788.      ! REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: SST        ! Extra for wrapper
    2789. 

  2789.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: SST        ! Extra for wrapper
    2790. 

  2790.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: BR
    2791. 

  2791.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CHS_SEA    ! Extra for wrapper
    2792. 

  2792.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CHS2_SEA   ! Extra for wrapper
    2793. 

  2793.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CQS2_SEA   ! Extra for wrapper
    2794. 

  2794.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CPM_SEA    ! Extra for wrapper
    2795. 

  2795.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QZ0_SEA   ! Extra for wrapper
    2796. 

  2796.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QSFC_SEA   ! Extra for wrapper
    2797. 

  2797.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QGH_SEA   ! Extra for wrapper
    2798. 

  2798.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: FLHC_SEA  ! Extra for wrapper
    2799. 

  2799.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: FLQC_SEA  ! Extra for wrapper
    2800. 

  2800.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: HFX_SEA    ! Extra for wrapper
    2801. 

  2801.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QFX_SEA    ! Extra for wrapper
    2802. 

  2802.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: FLX_LH_SEA ! Extra for wrapper
    2803. 

  2803.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: TSK_SEA    ! Extra for wrapper
    2804. 

  2804.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: USTAR
    2805. 

  2805.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: ZNT
    2806. 

  2806.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: Z0BASE
    2807. 

  2807.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: PBLH
    2808. 

  2808.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(IN)    :: MAVAIL
    2809. 

  2809.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: RMOL
    2810. 

  2810.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: AKHS
    2811. 

  2811.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(INOUT) :: AKMS
    2812. 

  2812.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CHS
    2813. 

  2813.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CHS2
    2814. 

  2814.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CQS2
    2815. 

  2815.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: HFX
    2816. 

  2816.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QFX
    2817. 

  2817.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: FLX_LH
    2818. 

  2818.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: FLHC
    2819. 

  2819.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: FLQC
    2820. 

  2820.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QGH
    2821. 

  2821.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CPM
    2822. 

  2822.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: CT
    2823. 

  2823.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: U10
    2824. 

  2824.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: V10
    2825. 

  2825.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: T02
    2826. 

  2826.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: TH02
    2827. 

  2827.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: TSHLTR
    2828. 

  2828.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: TH10
    2829. 

  2829.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: Q02
    2830. 

  2830.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: QSHLTR
    2831. 

  2831.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: Q10
    2832. 

  2832.      REAL,DIMENSION(IMS:IME,JMS:JME),        INTENT(OUT)   :: PSHLTR
    2833. 

  2833.      REAL,                                   INTENT(IN)    :: P1000
    2834. 

  2834.      REAL,                                   INTENT(IN)    :: XICE_THRESHOLD
    2835. 

  2835.      LOGICAL,                                INTENT(IN)    :: TICE2TSK_IF2COLD
    2836. 

  2836.      INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE,       &
    2837. 

  2837.           &                IMS,IME,JMS,JME,KMS,KME,       &
    2838. 

  2838.           &                ITS,ITE,JTS,JTE,KTS,KTE
    2839. 

  2839. 

  2840. 

  2841.      ! Local
    2842. 

  2842.      INTEGER :: i
    2843. 

  2843.      INTEGER :: j
    2844. 

  2844.      REAL, DIMENSION( ims:ime, jms:jme ) :: ct_sea
    2845. 

  2845.      REAL, DIMENSION( ims:ime, jms:jme ) :: u10_sea
    2846. 

  2846.      REAL, DIMENSION( ims:ime, jms:jme ) :: v10_sea
    2847. 

  2847.      REAL, DIMENSION( ims:ime, jms:jme ) :: t02_sea
    2848. 

  2848.      REAL, DIMENSION( ims:ime, jms:jme ) :: th02_sea
    2849. 

  2849.      REAL, DIMENSION( ims:ime, jms:jme ) :: tshltr_sea
    2850. 

  2850.      REAL, DIMENSION( ims:ime, jms:jme ) :: pshltr_sea
    2851. 

  2851.      REAL, DIMENSION( ims:ime, jms:jme ) :: qshltr_sea
    2852. 

  2852.      REAL, DIMENSION( ims:ime, jms:jme ) :: th10_sea
    2853. 

  2853.      REAL, DIMENSION( ims:ime, jms:jme ) :: q02_sea
    2854. 

  2854.      REAL, DIMENSION( ims:ime, jms:jme ) :: q10_sea
    2855. 

  2855.      REAL, DIMENSION( ims:ime, jms:jme ) :: thz0_sea
    2856. 

  2856.      REAL, DIMENSION( ims:ime, jms:jme ) :: uz0_sea
    2857. 

  2857.      REAL, DIMENSION( ims:ime, jms:jme ) :: vz0_sea
    2858. 

  2858.      REAL, DIMENSION( ims:ime, jms:jme ) :: ustar_sea
    2859. 

  2859.      REAL, DIMENSION( ims:ime, jms:jme ) :: pblh_sea
    2860. 

  2860.      REAL, DIMENSION( ims:ime, jms:jme ) :: rmol_sea
    2861. 

  2861.      REAL, DIMENSION( ims:ime, jms:jme ) :: akhs_sea
    2862. 

  2862.      REAL, DIMENSION( ims:ime, jms:jme ) :: akms_sea
    2863. 

  2863.      REAL, DIMENSION( ims:ime, jms:jme ) :: xland_sea
    2864. 

  2864.      REAL, DIMENSION( ims:ime, jms:jme ) :: mavail_sea
    2865. 

  2865.      REAL, DIMENSION( ims:ime, jms:jme ) :: znt_sea
    2866. 

  2866.      REAL, DIMENSION( ims:ime, jms:jme ) :: z0base_sea
    2867. 

  2867.      REAL, DIMENSION( ims:ime, jms:jme ) :: br_sea
    2868. 

  2868. 

  2869.      REAL, DIMENSION( ims:ime, jms:jme ) :: QSFC_HOLD
    2870. 

  2870.      REAL, DIMENSION( ims:ime, jms:jme ) :: QZ0_HOLD
    2871. 

  2871.      REAL, DIMENSION( ims:ime, jms:jme ) :: THZ0_HOLD
    2872. 

  2872.      REAL, DIMENSION( ims:ime, jms:jme ) :: UZ0_HOLD
    2873. 

  2873.      REAL, DIMENSION( ims:ime, jms:jme ) :: VZ0_HOLD
    2874. 

  2874.      REAL, DIMENSION( ims:ime, jms:jme ) :: USTAR_HOLD
    2875. 

  2875.      REAL, DIMENSION( ims:ime, jms:jme ) :: ZNT_HOLD
    2876. 

  2876.      REAL, DIMENSION( ims:ime, jms:jme ) :: PBLH_HOLD
    2877. 

  2877.      REAL, DIMENSION( ims:ime, jms:jme ) :: RMOL_HOLD
    2878. 

  2878.      REAL, DIMENSION( ims:ime, jms:jme ) :: AKHS_HOLD
    2879. 

  2879.      REAL, DIMENSION( ims:ime, jms:jme ) :: AKMS_HOLD
    2880. 

  2880.      REAL, DIMENSION( ims:ime, jms:jme ) :: TSK_LOCAL
    2881. 

  2881.      REAL :: PSFC
    2882. 

  2882. 

  2883.      ! Set things up for the frozen-surface call to myjsfc
    2884. 

  2884.      ! Is SST local here, or are the changes to be fed back to the calling routines?
    2885. 

  2885. 

  2886.      ! We want a TSK valid for the ice-covered regions of the grid cell.
    2887. 

  2887. 

  2888.      CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte,  &
    2889. 

  2889.                              itimestep, .true., tice2tsk_if2cold,     &
    2890. 

  2890.                              XICE, XICE_THRESHOLD,                    &
    2891. 

  2891.                              SST, TSK, TSK_SEA, TSK_LOCAL )
    2892. 

  2892.      DO j = JTS , JTE
    2893. 

  2893.         DO i = ITS , ITE
    2894. 

  2894.            TSK(i,j) = TSK_LOCAL(i,j)
    2895. 

  2895.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2896. 

  2896. 

  2897.               ! Over fractional sea-ice points, back out an ice portion of QSFC as well.
    2898. 

  2898.               ! QSFC_SEA calculation as done in myjsfc for open water points
    2899. 

  2899.               PSFC = PINT(I,LOWLYR(I,J),J)
    2900. 

  2900.               QSFC_SEA(i,j) = PQ0SEA/PSFC*EXP(A2S*(TSK(i,j)-A3S)/(TSK(i,j)-A4S))
    2901. 

  2901.               QSFC(i,j) = QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j) / XICE(i,j)
    2902. 

  2902. !
    2903. 

  2903.               HFX_SEA(i,j)  = HFX(i,j)
    2904. 

  2904.               QFX_SEA(i,j)  = QFX(i,j)
    2905. 

  2905.               FLX_LH_SEA(i,j)   = FLX_LH(i,j)
    2906. 

  2906.            ENDIF
    2907. 

  2907.         ENDDO
    2908. 

  2908.      ENDDO
    2909. 

  2909. 

  2910. !
    2911. 

  2911. ! frozen ocean call for sea ice points
    2912. 

  2912. !
    2913. 

  2913. 

  2914. ! Strictly INTENT(IN) to MYJSFC, should be unchanged by call.
    2915. 

  2915. 

  2916.      ! DZ
    2917. 

  2917.      ! HT
    2918. 

  2918.      ! LOWLYR
    2919. 

  2919.      ! MAVAIL
    2920. 

  2920.      ! PINT
    2921. 

  2921.      ! PMID
    2922. 

  2922.      ! QC
    2923. 

  2923.      ! QV
    2924. 

  2924.      ! Q2
    2925. 

  2925.      ! T
    2926. 

  2926.      ! TH
    2927. 

  2927.      ! TSK
    2928. 

  2928.      ! U
    2929. 

  2929.      ! V
    2930. 

  2930.      ! XLAND
    2931. 

  2931.      ! Z0BASE
    2932. 

  2932. 

  2933. ! INTENT (INOUT),  updated by MYJSFC.  Values will need to be saved before the first call to MYJSFC, so that
    2934. 

  2934. ! the second call to MYJSFC does not double-count the effect.
    2935. 

  2935. 

  2936.      ! Save INTENT(INOUT) variables before the frozen-water/true-land call to MYJSFC:
    2937. 

  2937.      QSFC_HOLD  = QSFC
    2938. 

  2938.      QZ0_HOLD   = QZ0
    2939. 

  2939.      THZ0_HOLD  = THZ0
    2940. 

  2940.      UZ0_HOLD   = UZ0
    2941. 

  2941.      VZ0_HOLD   = VZ0
    2942. 

  2942.      USTAR_HOLD = USTAR
    2943. 

  2943.      ZNT_HOLD   = ZNT
    2944. 

  2944.      PBLH_HOLD  = PBLH
    2945. 

  2945.      RMOL_HOLD  = RMOL
    2946. 

  2946.      AKHS_HOLD  = AKHS
    2947. 

  2947.      AKMS_HOLD  = AKMS
    2948. 

  2948. 

  2949. ! Strictly INTENT(OUT):  Set by MYJSFC
    2950. 

  2950. 

  2951.      ! CHS
    2952. 

  2952.      ! CHS2
    2953. 

  2953.      ! CPM
    2954. 

  2954.      ! CQS2
    2955. 

  2955.      ! CT
    2956. 

  2956.      ! FLHC
    2957. 

  2957.      ! FLQC
    2958. 

  2958.      ! FLX_LH
    2959. 

  2959.      ! HFX
    2960. 

  2960.      ! PSHLTR
    2961. 

  2961.      ! QFX
    2962. 

  2962.      ! QGH
    2963. 

  2963.      ! QSHLTR
    2964. 

  2964.      ! Q02
    2965. 

  2965.      ! Q10
    2966. 

  2966.      ! TH02
    2967. 

  2967.      ! TH10
    2968. 

  2968.      ! TSHLTR
    2969. 

  2969.      ! T02
    2970. 

  2970.      ! U10
    2971. 

  2971.      ! V10
    2972. 

  2972. 

  2973.      ! Frozen-water/true-land call.
    2974. 

  2974.      CALL MYJSFC ( ITIMESTEP, HT, DZ,                              &  ! I,I,I,
    2975. 

  2975.           &        PMID, PINT, TH, T, QV, QC, U, V, Q2,            &  ! I,I,I,I,I,I,I,I,I,
    2976. 

  2976.           &        TSK, QSFC, THZ0, QZ0, UZ0, VZ0,                 &  ! I,IO,IO,IO,IO,IO,
    2977. 

  2977.           &        LOWLYR, XLAND, IVGTYP, ISURBAN, IZ0TLND,        &  ! I,I,I,I,I
    2978. 

  2978.           &        USTAR, ZNT, Z0BASE, PBLH, MAVAIL, RMOL,         &  ! IO,IO,I,IO,I,IO,
    2979. 

  2979.           &        AKHS, AKMS,                                     &  ! IO,IO,
    2980. 

  2980.           &        BR,                                             &  ! O
    2981. 

  2981.           &        CHS, CHS2, CQS2, HFX, QFX, FLX_LH, FLHC, FLQC,  &  ! O,O,O,0,0,0,0,0,
    2982. 

  2982.           &        QGH, CPM, CT, U10, V10, T02,                    &  ! 0,0,0,0,0,0,
    2983. 

  2983.           &        TH02, TSHLTR, TH10, Q02,                        &  ! 0,0,0,0,
    2984. 

  2984.           &        QSHLTR, Q10, PSHLTR,                            &  ! 0,0,0,
    2985. 

  2985.           &        P1000,                                        &  ! I
    2986. 

  2986.           &        ids,ide, jds,jde, kds,kde,                      &
    2987. 

  2987.           &        ims,ime, jms,jme, kms,kme,                      &
    2988. 

  2988.           &        its,ite, jts,jte, kts,kte    )
    2989. 

  2989. 

  2990.      ! Set up things for the open ocean call.
    2991. 

  2991.      DO j = JTS, JTE
    2992. 

  2992.         DO i = ITS, ITE
    2993. 

  2993.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .AND. ( XICE(i,j) .LE. 1.0 ) ) THEN
    2994. 

  2994.               XLAND_SEA(i,j)=2.
    2995. 

  2995.               MAVAIL_SEA(I,J)  = 1.
    2996. 

  2996.               ZNT_SEA(I,J) = 0.0001
    2997. 

  2997.               Z0BASE_SEA(I,J) = ZNT_SEA(I,J)
    2998. 

  2998.               IF ( SST(i,j) .LT. 271.4 ) THEN
    2999. 

  2999.                  SST(i,j) = 271.4
    3000. 

  3000.               ENDIF
    3001. 

  3001.               TSK_SEA(i,j) = SST(i,j)
    3002. 

  3002.               PSFC = PINT(I,LOWLYR(I,J),J)
    3003. 

  3003.               QSFC_SEA(I,J) = PQ0SEA/PSFC*EXP(A2S*(TSK_SEA(i,j)-A3S)/(TSK_SEA(i,j)-A4S))
    3004. 

  3004.            ELSE
    3005. 

  3005.               ! This should be a land point or a true open water point
    3006. 

  3006.               XLAND_SEA(i,j)=xland(i,j)
    3007. 

  3007.               MAVAIL_SEA(i,j) = mavail(i,j)
    3008. 

  3008.               ZNT_SEA(I,J)    = ZNT_HOLD(I,J)
    3009. 

  3009.               Z0BASE_SEA(I,J) = Z0BASE(I,J)
    3010. 

  3010.               TSK_SEA(i,j)  = TSK(i,j)
    3011. 

  3011.               QSFC_SEA(i,j) = QSFC_HOLD(i,j)
    3012. 

  3012.            ENDIF
    3013. 

  3013.         ENDDO
    3014. 

  3014.      ENDDO
    3015. 

  3015. 

  3016.      QZ0_SEA  = QZ0_HOLD
    3017. 

  3017.      THZ0_SEA = THZ0_HOLD
    3018. 

  3018.      UZ0_SEA  = UZ0_HOLD
    3019. 

  3019.      VZ0_SEA  = VZ0_HOLD
    3020. 

  3020.      USTAR_SEA = USTAR_HOLD
    3021. 

  3021.      PBLH_SEA = PBLH_HOLD
    3022. 

  3022.      RMOL_SEA = RMOL_HOLD
    3023. 

  3023.      AKHS_SEA = AKHS_HOLD
    3024. 

  3024.      AKMS_SEA = AKMS_HOLD
    3025. 

  3025. 

  3026. !
    3027. 

  3027. ! open water call
    3028. 

  3028. !
    3029. 

  3029.      CALL MYJSFC ( ITIMESTEP, HT, DZ,                                                          & ! I,I,I,
    3030. 

  3030.           &        PMID, PINT, TH, T, QV, QC, U, V, Q2,                                        & ! I,I,I,I,I,I,I,I,I,
    3031. 

  3031.           &        TSK_SEA, QSFC_SEA, THZ0_SEA, QZ0_SEA, UZ0_SEA, VZ0_SEA,                     & ! I,IO,IO,IO,IO,IO,
    3032. 

  3032.           &        LOWLYR, XLAND_SEA, IVGTYP, ISURBAN, IZ0TLND,                                & ! I,I,I,I,I,
    3033. 

  3033.           &        USTAR_SEA, ZNT_SEA, Z0BASE_SEA, PBLH_SEA, MAVAIL_SEA, RMOL_SEA,             & ! IO,IO,I,IO,I,IO,
    3034. 

  3034.           &        AKHS_SEA, AKMS_SEA,                                                         & ! IO,IO,
    3035. 

  3035.           &        BR_SEA,                                                                     & ! dummy space holder
    3036. 

  3036.           &        CHS_SEA, CHS2_SEA, CQS2_SEA, HFX_SEA, QFX_SEA, FLX_LH_SEA, FLHC_SEA,        & ! 0,0,0,0,0,0,0,
    3037. 

  3037.           &        FLQC_SEA, QGH_SEA, CPM_SEA, CT_SEA, U10_SEA, V10_SEA, T02_SEA, TH02_SEA,    & ! 0,0,0,0,0,0,0,0,
    3038. 

  3038.           &        TSHLTR_SEA, TH10_SEA, Q02_SEA, QSHLTR_SEA, Q10_SEA, PSHLTR_SEA,             & ! 0,0,0,0,0,0,
    3039. 

  3039.           &        p1000,                                                                    & ! I
    3040. 

  3040.           &        ids,ide, jds,jde, kds,kde,                                                  &
    3041. 

  3041.           &        ims,ime, jms,jme, kms,kme,                                                  &
    3042. 

  3042.           &        its,ite, jts,jte, kts,kte    )
    3043. 

  3043. 

  3044. !
    3045. 

  3045. ! Scale the appropriate terms between open-water values and ice-covered values
    3046. 

  3046. !
    3047. 

  3047. 

  3048.      DO j = JTS, JTE
    3049. 

  3049.         DO i = ITS, ITE
    3050. 

  3050.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    3051. 

  3051.               ! Over sea-ice points, blend the results.
    3052. 

  3052. 

  3053.               ! INTENT(OUT) from MYJSFC
    3054. 

  3054.               ! CHS  wait
    3055. 

  3055.               ! CHS2 wait
    3056. 

  3056.               ! CPM  wait
    3057. 

  3057.               ! CQS2 wait
    3058. 

  3058.               CT(i,j)     = CT(i,j)     * XICE(i,j) + (1.0-XICE(i,j)) * CT_SEA (i,j)
    3059. 

  3059.               ! FLHC(i,j)   = FLHC(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * FLHC_SEA (i,j)
    3060. 

  3060.               ! FLQC(i,j)   = FLQC(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * FLQC_SEA (i,j)
    3061. 

  3061.               ! FLX_LH wait
    3062. 

  3062.               ! HFX  wait
    3063. 

  3063.               PSHLTR(i,j) = PSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * PSHLTR_SEA(i,j)
    3064. 

  3064.               ! QFX  wait
    3065. 

  3065.               ! QGH  wait
    3066. 

  3066.               QSHLTR(i,j) = QSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * QSHLTR_SEA(i,j)
    3067. 

  3067.               Q02(i,j)    = Q02(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * Q02_SEA(i,j)
    3068. 

  3068.               Q10(i,j)    = Q10(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * Q10_SEA(i,j)
    3069. 

  3069.               TH02(i,j)   = TH02(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * TH02_SEA(i,j)
    3070. 

  3070.               TH10(i,j)   = TH10(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * TH10_SEA(i,j)
    3071. 

  3071.               TSHLTR(i,j) = TSHLTR(i,j) * XICE(i,j) + (1.0-XICE(i,j)) * TSHLTR_SEA(i,j)
    3072. 

  3072.               T02(i,j)    = T02(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * T02_SEA(i,j)
    3073. 

  3073.               U10(i,j)    = U10(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * U10_SEA(i,j)
    3074. 

  3074.               V10(i,j)    = V10(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * V10_SEA(i,j)
    3075. 

  3075. 

  3076.               ! INTENT(INOUT):  updated by MYJSFC
    3077. 

  3077.               ! QSFC:  wait
    3078. 

  3078.               THZ0(i,j)   = THZ0(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * THZ0_SEA(i,j)
    3079. 

  3079.               ! qz0 wait
    3080. 

  3080.               UZ0(i,j)    = UZ0(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * UZ0_SEA(i,j)
    3081. 

  3081.               VZ0(i,j)    = VZ0(i,j)    * XICE(i,j) + (1.0-XICE(i,j)) * VZ0_SEA(i,j)
    3082. 

  3082.               USTAR(i,j)  = USTAR(i,j)  * XICE(i,j) + (1.0-XICE(i,j)) * USTAR_SEA(i,j)
    3083. 

  3083.               ! ZNT wait
    3084. 

  3084.               PBLH(i,j)   = PBLH(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * PBLH_SEA(i,j)
    3085. 

  3085.               RMOL(i,j)   = RMOL(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * RMOL_SEA(i,j)
    3086. 

  3086.               AKHS(i,j)   = AKHS(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * AKHS_SEA(i,j)
    3087. 

  3087.               AKMS(i,j)   = AKMS(i,j)   * XICE(i,j) + (1.0-XICE(i,j)) * AKMS_SEA(i,j)
    3088. 

  3088. 

  3089.               !         tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
    3090. 

  3090.            ELSE
    3091. 

  3091.               ! We're not over sea ice.  Take the results from the first call.
    3092. 

  3092.            ENDIF
    3093. 

  3093.         ENDDO
    3094. 

  3094.      ENDDO
    3095. 

  3095. 

  3096.    END SUBROUTINE myjsfc_seaice_wrapper
    3097. 

  3097. 

  3098. !-------------------------------------------------------------------------
    3099. 

  3099. 

  3100.    SUBROUTINE mynn_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w,     &
    3101. 

  3101.                      CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
    3102. 

  3102.                      ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    3103. 

  3103.                      XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
    3104. 

  3104.                      U10,V10,TH2,T2,Q2,                            &
    3105. 

  3105.                      GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    3106. 

  3106.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
    3107. 

  3107.                      KARMAN,EOMEG,STBOLT,                          &
    3108. 

  3108.                &itimestep,ch,th3d,pi3d,qc3d,                       &
    3109. 

  3109.                &tsq,qsq,cov,qcg,                                   &
    3110. 

  3110. XICE,SST,TSK_SEA,                                                  &
    3111. 

  3111. CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA,               &
    3112. 

  3112. HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA,                   &
    3113. 

  3113. TICE2TSK_IF2COLD,XICE_THRESHOLD,                                   &
    3114. 

  3114.                      ids,ide, jds,jde, kds,kde,                    &
    3115. 

  3115.                      ims,ime, jms,jme, kms,kme,                    &
    3116. 

  3116.                      its,ite, jts,jte, kts,kte)
    3117. 

  3117. !                     ustm,ck,cka,cd,cda,isftcflx,iz0tlnd           )
    3118. 

  3118.      USE module_sf_mynn, ONLY: sfclay_mynn
    3119. 

  3119.      implicit none
    3120. 

  3120. 

  3121.      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde,  &
    3122. 

  3122.                                        ims,ime, jms,jme, kms,kme,  &
    3123. 

  3123.                                        its,ite, jts,jte, kts,kte
    3124. 

  3124. 

  3125.      INTEGER,  INTENT(IN )   ::        ISFFLX
    3126. 

  3126.      REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
    3127. 

  3127.      REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN,EOMEG,STBOLT
    3128. 

  3128. 

  3129.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    3130. 

  3130.                INTENT(IN   )   ::                           dz8w
    3131. 

  3131. 

  3132.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    3133. 

  3133.                INTENT(IN   )   ::                           QV3D, &
    3134. 

  3134.                                                              P3D, &
    3135. 

  3135.                                                              T3D
    3136. 

  3136. 

  3137.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3138. 

  3138.                INTENT(IN   )               ::             MAVAIL, &
    3139. 

  3139.                                                             PBLH, &
    3140. 

  3140.                                                            XLAND
    3141. 

  3141. 

  3142.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3143. 

  3143.                INTENT(OUT  )               ::                U10, &
    3144. 

  3144.                                                              V10, &
    3145. 

  3145.                                                              TH2, &
    3146. 

  3146.                                                               T2, &
    3147. 

  3147.                                                               Q2, &
    3148. 

  3148.                                                             QSFC
    3149. 

  3149.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3150. 

  3150.                INTENT(INOUT)               ::             REGIME, &
    3151. 

  3151.                                                              HFX, &
    3152. 

  3152.                                                              QFX, &
    3153. 

  3153.                                                               LH, &
    3154. 

  3154.                                                          MOL,RMOL,TSK
    3155. 

  3155. 

  3156.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3157. 

  3157.                INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
    3158. 

  3158.                                                         PSIM,PSIH
    3159. 

  3159. 

  3160.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    3161. 

  3161.                INTENT(IN   )   ::                            U3D, &
    3162. 

  3162.                                                              V3D
    3163. 

  3163. 

  3164.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3165. 

  3165.                INTENT(IN   )               ::               PSFC
    3166. 

  3166. 

  3167.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3168. 

  3168.                INTENT(INOUT)   ::                            ZNT, &
    3169. 

  3169.                                                              ZOL, &
    3170. 

  3170.                                                              UST, &
    3171. 

  3171.                                                              CPM, &
    3172. 

  3172.                                                             CHS2, &
    3173. 

  3173.                                                             CQS2, &
    3174. 

  3174.                                                              CHS
    3175. 

  3175. 

  3176.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3177. 

  3177.                INTENT(INOUT)   ::                      FLHC,FLQC
    3178. 

  3178. 

  3179.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3180. 

  3180.                INTENT(INOUT)   ::                                 &
    3181. 

  3181.                                                               QGH
    3182. 

  3182. 

  3183.      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV,DX
    3184. 

  3184. ! from mynn subroutine
    3185. 

  3185.      INTEGER, INTENT(in) :: itimestep
    3186. 

  3186.      REAL,     DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: qcg
    3187. 

  3187.      REAL,     DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ch
    3188. 

  3188.      REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) ::     &
    3189. 

  3189.                                                              &QC3D,&
    3190. 

  3190.                                               &th3d,pi3d,tsq,qsq,cov
    3191. 

  3191. 

  3192. !     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme )              , &
    3193. 

  3193. !               INTENT(OUT)     ::              ck,cka,cd,cda,ustm
    3194. 

  3194. !     INTEGER,  OPTIONAL,  INTENT(IN )   ::     ISFTCFLX,IZ0TLND
    3195. 

  3195. 

  3196. !--------------------------------------------------------------------
    3197. 

  3197. !    New for wrapper
    3198. 

  3198. !--------------------------------------------------------------------
    3199. 

  3199.      LOGICAL,  INTENT(IN)               ::      TICE2TSK_IF2COLD
    3200. 

  3200.      REAL,     INTENT(IN)               ::      XICE_THRESHOLD
    3201. 

  3201.      REAL,     DIMENSION( ims:ime, jms:jme ),                     &
    3202. 

  3202.                INTENT(IN)               ::      XICE
    3203. 

  3203.      REAL,     DIMENSION( ims:ime, jms:jme ),                     &
    3204. 

  3204.                INTENT(INOUT)            ::      SST
    3205. 

  3205.      REAL,     DIMENSION( ims:ime, jms:jme ),                     &
    3206. 

  3206.                INTENT(OUT)              ::      TSK_SEA,          &
    3207. 

  3207.                                                 CHS2_SEA,         &
    3208. 

  3208.                                                 CHS_SEA,          &
    3209. 

  3209.                                                 CPM_SEA,          &
    3210. 

  3210.                                                 CQS2_SEA,         &
    3211. 

  3211.                                                 FLHC_SEA,         &
    3212. 

  3212.                                                 FLQC_SEA,         &
    3213. 

  3213.                                                 HFX_SEA,          &
    3214. 

  3214.                                                 LH_SEA,           &
    3215. 

  3215.                                                 QFX_SEA,          &
    3216. 

  3216.                                                 QGH_SEA,          &
    3217. 

  3217.                                                 QSFC_SEA,         &
    3218. 

  3218.                                                 ZNT_SEA
    3219. 

  3219. 

  3220. !--------------------------------------------------------------------
    3221. 

  3221. !    Local
    3222. 

  3222. !--------------------------------------------------------------------
    3223. 

  3223.      INTEGER :: I, J
    3224. 

  3224.      REAL,     DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA,        &
    3225. 

  3225.                                                 MAVAIL_sea,       &
    3226. 

  3226.                                                 TSK_LOCAL,        &
    3227. 

  3227.                                                 BR_HOLD,          &
    3228. 

  3228.                                                 CHS2_HOLD,        &
    3229. 

  3229.                                                 CHS_HOLD,         &
    3230. 

  3230.                                                 CPM_HOLD,         &
    3231. 

  3231.                                                 CQS2_HOLD,        &
    3232. 

  3232.                                                 FLHC_HOLD,        &
    3233. 

  3233.                                                 FLQC_HOLD,        &
    3234. 

  3234.                                                 GZ1OZ0_HOLD,      &
    3235. 

  3235.                                                 HFX_HOLD,         &
    3236. 

  3236.                                                 LH_HOLD,          &
    3237. 

  3237.                                                 MOL_HOLD,         &
    3238. 

  3238.                                                 PSIH_HOLD,        &
    3239. 

  3239.                                                 PSIM_HOLD,        &
    3240. 

  3240.                                                 QFX_HOLD,         &
    3241. 

  3241.                                                 QGH_HOLD,         &
    3242. 

  3242.                                                 REGIME_HOLD,      &
    3243. 

  3243.                                                 RMOL_HOLD,        &
    3244. 

  3244.                                                 UST_HOLD,         &
    3245. 

  3245.                                                 WSPD_HOLD,        &
    3246. 

  3246.                                                 ZNT_HOLD,         &
    3247. 

  3247.                                                 CH_HOLD,          & ! new
    3248. 

  3248.                                                 ZOL_HOLD,         &
    3249. 

  3249.                                                 Q2_SEA,           &
    3250. 

  3250.                                                 T2_SEA,           &
    3251. 

  3251.                                                 TH2_SEA,          &
    3252. 

  3252.                                                 U10_SEA,          &
    3253. 

  3253.                                                 V10_SEA
    3254. 

  3254. 

  3255.      REAL,     DIMENSION( ims:ime, jms:jme ) ::                   &
    3256. 

  3256.                                                 BR_SEA,           &
    3257. 

  3257.                                                 GZ1OZ0_SEA,       &
    3258. 

  3258.                                                 MOL_SEA,          &
    3259. 

  3259.                                                 PSIH_SEA,         &
    3260. 

  3260.                                                 PSIM_SEA,         &
    3261. 

  3261.                                                 REGIME_SEA,       &
    3262. 

  3262.                                                 RMOL_SEA,         &
    3263. 

  3263.                                                 UST_SEA,          &
    3264. 

  3264.                                                 WSPD_SEA,         &
    3265. 

  3265.                                                 CH_SEA,           & ! new
    3266. 

  3266.                                                 ZOL_SEA
    3267. 

  3267. ! INTENT(IN) to SFCLAY; unchanged by the call
    3268. 

  3268.       ! ISFFLX
    3269. 

  3269.       ! SVP1,SVP2,SVP3,SVPT0
    3270. 

  3270.       ! EP1,EP2,KARMAN,EOMEG,STBOLT
    3271. 

  3271.       ! CP,G,ROVCP,R,XLV,DX
    3272. 

  3272.       ! dz8w
    3273. 

  3273.       ! QV3D
    3274. 

  3274.       ! P3D
    3275. 

  3275.       ! T3D
    3276. 

  3276.       ! MAVAIL
    3277. 

  3277.       ! PBLH
    3278. 

  3278.       ! XLAND
    3279. 

  3279.       ! TSK
    3280. 

  3280.       ! U3D
    3281. 

  3281.       ! V3D
    3282. 

  3282.       ! PSFC
    3283. 

  3283. 

  3284.     CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte,  &
    3285. 

  3285.                              itimestep, .true., tice2tsk_if2cold,     &
    3286. 

  3286.                              XICE, XICE_THRESHOLD,                    &
    3287. 

  3287.                              SST, TSK, TSK_SEA, TSK_LOCAL )
    3288. 

  3288. 

  3289. ! DFS 8/25/10 Set TSK to ice value
    3290. 

  3290.     DO j = JTS , JTE
    3291. 

  3291.         DO i = ITS , ITE
    3292. 

  3292.             TSK(i,j) = TSK_LOCAL(i,j)
    3293. 

  3293.         ENDDO
    3294. 

  3294.     ENDDO
    3295. 

  3295. 

  3296. ! INTENT (INOUT) to SFCLAY:  Save the variables before the first call
    3297. 

  3297. ! (for land/frozen water) to SFCLAY, to keep from double-counting the
    3298. 

  3298. ! effects of that routine
    3299. 

  3299.      BR_HOLD   = BR
    3300. 

  3300.      CHS2_HOLD = CHS2
    3301. 

  3301.      CHS_HOLD  = CHS
    3302. 

  3302.      CPM_HOLD  = CPM
    3303. 

  3303.      CQS2_HOLD = CQS2
    3304. 

  3304.      FLHC_HOLD = FLHC
    3305. 

  3305.      FLQC_HOLD = FLQC
    3306. 

  3306.      GZ1OZ0_HOLD = GZ1OZ0
    3307. 

  3307.      HFX_HOLD  = HFX
    3308. 

  3308.      LH_HOLD   = LH
    3309. 

  3309.      MOL_HOLD  = MOL
    3310. 

  3310.      PSIH_HOLD = PSIH
    3311. 

  3311.      PSIM_HOLD = PSIM
    3312. 

  3312.      QFX_HOLD  = QFX
    3313. 

  3313.      QGH_HOLD  = QGH
    3314. 

  3314.      REGIME_HOLD = REGIME
    3315. 

  3315.      RMOL_HOLD = RMOL
    3316. 

  3316.      UST_HOLD  = UST
    3317. 

  3317.      WSPD_HOLD = WSPD
    3318. 

  3318.      ZNT_HOLD  = ZNT
    3319. 

  3319.      ZOL_HOLD  = ZOL
    3320. 

  3320.      CH_HOLD   = CH
    3321. 

  3321. 

  3322. ! INTENT(OUT) from SFCLAY.  Input shouldn't matter, but we'll want to
    3323. 

  3323. ! keep things around for weighting after the second call to SFCLAY.
    3324. 

  3324.      ! Q2
    3325. 

  3325.      ! QSFC
    3326. 

  3326.      ! T2
    3327. 

  3327.      ! TH2
    3328. 

  3328.      ! U10
    3329. 

  3329.      ! V10
    3330. 

  3330. 

  3331.      ! land/frozen-water call
    3332. 

  3332. !     call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w,                    & ! I
    3333. 

  3333. !                 CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      & !
    3334. 

  3334. !                 I,I,I,I,I,I,IO,IO,IO,IO,
    3335. 

  3335. !                 ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    3336. 

  3336. !                 XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
    3337. 

  3337. !                 U10,V10,TH2,T2,Q2,                            &
    3338. 

  3338. !                 GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    3339. 

  3339. !                 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
    3340. 

  3340. !                 KARMAN,EOMEG,STBOLT,                          &
    3341. 

  3341. !                 P1000,                                      &
    3342. 

  3342. !                 ids,ide, jds,jde, kds,kde,                    &
    3343. 

  3343. !                 ims,ime, jms,jme, kms,kme,                    &
    3344. 

  3344. !                 its,ite, jts,jte, kts,kte,                    &
    3345. 

  3345. !                 ustm,ck,cka,cd,cda,isftcflx,iz0tlnd           )
    3346. 

  3346. 

  3347.           CALL SFCLAY_mynn(U3D,V3D,T3D,QV3D,P3D,dz8w,              &
    3348. 

  3348.                CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,            &
    3349. 

  3349.                ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH,       &
    3350. 

  3350.                XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
    3351. 

  3351.                U10,V10,TH2,T2,Q2,                                  &
    3352. 

  3352.                GZ1OZ0,WSPD,BR,ISFFLX,DX,                           &
    3353. 

  3353.                SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,   &
    3354. 

  3354.                &itimestep,ch,th3d,pi3d,qc3d,                       &
    3355. 

  3355.                &tsq,qsq,cov,qcg,                                   &
    3356. 

  3356.                ids,ide, jds,jde, kds,kde,                          &
    3357. 

  3357.                ims,ime, jms,jme, kms,kme,                          &
    3358. 

  3358.                its,ite, jts,jte, kts,kte    )
    3359. 

  3359.      ! Set up for open-water call
    3360. 

  3360.      DO j = JTS , JTE
    3361. 

  3361.         DO i = ITS , ITE
    3362. 

  3362.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    3363. 

  3363.               XLAND_SEA(i,j)=2.
    3364. 

  3364.               MAVAIL_SEA(I,J)  =1.
    3365. 

  3365.               ZNT_SEA(I,J) = 0.0001
    3366. 

  3366.               TSK_SEA(i,j) = SST(i,j)
    3367. 

  3367.               IF ( SST(i,j) .LT. 271.4 ) THEN
    3368. 

  3368.                  SST(i,j) = 271.4
    3369. 

  3369.                  TSK_SEA(i,j) = SST(i,j)
    3370. 

  3370.               ENDIF
    3371. 

  3371.            ELSE
    3372. 

  3372.               XLAND_SEA(i,j) = XLAND(i,j)
    3373. 

  3373.               MAVAIL_SEA(i,j) = MAVAIL(i,j)
    3374. 

  3374.               ZNT_SEA(i,j)  = ZNT_HOLD(i,j)
    3375. 

  3375.               TSK_SEA(i,j) = TSK_LOCAL(i,j)
    3376. 

  3376.            ENDIF
    3377. 

  3377.         ENDDO
    3378. 

  3378.      ENDDO
    3379. 

  3379. 

  3380.      ! Restore the values from before the land/frozen-water call
    3381. 

  3381.      BR_SEA   = BR_HOLD
    3382. 

  3382.      CHS2_SEA = CHS2_HOLD
    3383. 

  3383.      CHS_SEA  = CHS_HOLD
    3384. 

  3384.      CPM_SEA  = CPM_HOLD
    3385. 

  3385.      CQS2_SEA = CQS2_HOLD
    3386. 

  3386.      FLHC_SEA = FLHC_HOLD
    3387. 

  3387.      FLQC_SEA = FLQC_HOLD
    3388. 

  3388.      GZ1OZ0_SEA = GZ1OZ0_HOLD
    3389. 

  3389.      HFX_SEA  = HFX_HOLD
    3390. 

  3390.      LH_SEA   = LH_HOLD
    3391. 

  3391.      MOL_SEA  = MOL_HOLD
    3392. 

  3392.      PSIH_SEA = PSIH_HOLD
    3393. 

  3393.      PSIM_SEA = PSIM_HOLD
    3394. 

  3394.      QFX_SEA  = QFX_HOLD
    3395. 

  3395.      QGH_SEA  = QGH_HOLD
    3396. 

  3396.      REGIME_SEA = REGIME_HOLD
    3397. 

  3397.      RMOL_SEA = RMOL_HOLD
    3398. 

  3398.      UST_SEA  = UST_HOLD
    3399. 

  3399.      WSPD_SEA = WSPD_HOLD
    3400. 

  3400.      ZOL_SEA  = ZOL_HOLD
    3401. 

  3401.      CH_SEA   = CH_HOLD
    3402. 

  3402. 

  3403.      ! open-water call
    3404. 

  3404. !     call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w,                    & ! I
    3405. 

  3405. !                 CP,G,ROVCP,R,XLV,PSFC,                        & ! I
    3406. 

  3406. !                 CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA,            & ! I/O
    3407. 

  3407. !                 ZNT_SEA,UST_SEA,                              & ! I/O
    3408. 

  3408. !                 PBLH,MAVAIL_SEA,                              & ! I
    3409. 

  3409. !                 ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
    3410. 

  3410. !                 XLAND_SEA,                              & ! I
    3411. 

  3411. !                 HFX_SEA,QFX_SEA,LH_SEA,                       & ! I/O
    3412. 

  3412. !                 TSK_SEA,                                      & ! I
    3413. 

  3413. !                 FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA,  & ! I/O
    3414. 

  3414. !                 U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea,        & ! O
    3415. 

  3415. !                 GZ1OZ0_SEA,WSPD_SEA,BR_SEA,                   & ! I/O
    3416. 

  3416. !                 ISFFLX,DX,                                    &
    3417. 

  3417. !                 SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
    3418. 

  3418. !                 KARMAN,EOMEG,STBOLT,
    3419. 

  3419. !                 P1000,                                      &
    3420. 

  3420. !                 ids,ide, jds,jde, kds,kde,                    &
    3421. 

  3421. !                 ims,ime, jms,jme, kms,kme,                    &
    3422. 

  3422. !                 its,ite, jts,jte, kts,kte,                    & ! 0
    3423. 

  3423. !                 ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd )
    3424. 

  3424.           CALL SFCLAY_mynn(U3D,V3D,T3D,QV3D,P3D,dz8w,              &
    3425. 

  3425.                CP,G,ROVCP,R,XLV,PSFC,                              &
    3426. 

  3426.                CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA,                  &
    3427. 

  3427.                ZNT_SEA,UST_SEA,                                    &
    3428. 

  3428.                PBLH,MAVAIL_SEA,                                    &
    3429. 

  3429.                ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA,       &
    3430. 

  3430.                XLAND_SEA,                                          &
    3431. 

  3431.                HFX_SEA,QFX_SEA,LH_SEA,                             &
    3432. 

  3432.                TSK_SEA,                                            &
    3433. 

  3433.                FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA,        &
    3434. 

  3434.                U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea,              &
    3435. 

  3435.                GZ1OZ0_SEA,WSPD_SEA,BR_SEA,                         &
    3436. 

  3436.                ISFFLX,DX,                                          &
    3437. 

  3437.                SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,EOMEG,STBOLT,   &
    3438. 

  3438.                &itimestep,CH_SEA,th3d,pi3d,qc3d,                   &
    3439. 

  3439.                &tsq,qsq,cov,qcg,                                   &
    3440. 

  3440.                ids,ide, jds,jde, kds,kde,                          &
    3441. 

  3441.                ims,ime, jms,jme, kms,kme,                          &
    3442. 

  3442.                its,ite, jts,jte, kts,kte    )
    3443. 

  3443. 

  3444.      DO j = JTS , JTE
    3445. 

  3445.         DO i = ITS, ITE
    3446. 

  3446.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD )  .and.( XICE(i,j) .LE. 1.0 ) ) THEN
    3447. 

  3447.               ! weighted average for sea ice points
    3448. 

  3448.               br(i,j)     = ( br(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j)     )
    3449. 

  3449.               ! CHS2 -- wait
    3450. 

  3450.               ! CHS  -- wait
    3451. 

  3451.               ! CPM  -- wait
    3452. 

  3452.               ! CQS2 -- wait
    3453. 

  3453.               ! FLHC -- wait
    3454. 

  3454.               ! FLQC -- wait
    3455. 

  3455.               gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
    3456. 

  3456.               ! HFX  -- wait
    3457. 

  3457.               ! LH   -- wait
    3458. 

  3458.               mol(i,j)    = ( mol(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j)    )
    3459. 

  3459.               psih(i,j)   = ( psih(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j)   )
    3460. 

  3460.               psim(i,j)   = ( psim(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j)   )
    3461. 

  3461.               ! QFX  -- wait
    3462. 

  3462.               ! QGH  -- wait
    3463. 

  3463.               if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
    3464. 

  3464.               rmol(i,j)   = ( rmol(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j)   )
    3465. 

  3465.               ust(i,j)    = ( ust(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j)    )
    3466. 

  3466.               wspd(i,j)   = ( wspd(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j)   )
    3467. 

  3467.               zol(i,j)    = ( zol(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j)    )
    3468. 

  3468.               ch(i,j)     = ( ch(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ch_sea(i,j)    )
    3469. 

  3469.               ! INTENT(OUT)
    3470. 

  3470.               ! --------------------------------------------------------------------
    3471. 

  3471.               q2(i,j)     = ( q2(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j)     )
    3472. 

  3472.               ! QSFC -- wait
    3473. 

  3473.               t2(i,j)     = ( t2(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j)     )
    3474. 

  3474.               th2(i,j)    = ( th2(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j)    )
    3475. 

  3475.               u10(i,j)    = ( u10(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j)    )
    3476. 

  3476. !              IF ( PRESENT ( USTM ) ) THEN
    3477. 

  3477. !                 USTM(i,j)    = ( USTM(i,j)    * XICE(i,j) ) + (
    3478. 

  3478. !                 (1.0-XICE(i,j)) * USTM_sea(i,j)    )
    3479. 

  3479. !              ENDIF
    3480. 

  3480.               v10(i,j)    = ( v10(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j)    )
    3481. 

  3481.            ENDIF
    3482. 

  3482.         END DO
    3483. 

  3483.      END DO
    3484. 

  3484. !
    3485. 

  3485. !         tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
    3486. 

  3486. !
    3487. 

  3487.    END SUBROUTINE mynn_seaice_wrapper
    3488. 

  3488. 

  3489. !-------------------------------------------------------------------------
    3490. 

  3490. 

  3491.    SUBROUTINE sf_gfs_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,        &
    3492. 

  3492. 		 CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,          &
    3493. 

  3493.                      ZNT,UST,PSIM,PSIH,                          &
    3494. 

  3494.                      XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,             &
    3495. 

  3495.                      QGH,QSFC,U10,V10,                           &
    3496. 

  3496.                      GZ1OZ0,WSPD,BR,ISFFLX,                      &
    3497. 

  3497.                      EP1,EP2,KARMAN,itimestep,                   &
    3498. 

  3498.                      TICE2TSK_IF2COLD,                           &
    3499. 

  3499.                      XICE_THRESHOLD,                             &
    3500. 

  3500.                      CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA,       &
    3501. 

  3501.                      FLHC_SEA, FLQC_SEA,                         &
    3502. 

  3502.                      HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA,&
    3503. 

  3503.                      UST_SEA, ZNT_SEA, SST, XICE,                &
    3504. 

  3504.                      ids,ide, jds,jde, kds,kde,                  &
    3505. 

  3505.                      ims,ime, jms,jme, kms,kme,                  &
    3506. 

  3506.                      its,ite, jts,jte, kts,kte                   )
    3507. 

  3507.      USE module_sf_gfs
    3508. 

  3508.      implicit none
    3509. 

  3509. 

  3510.      INTEGER, INTENT(IN) ::             ids,ide, jds,jde, kds,kde,      &
    3511. 

  3511.                                         ims,ime, jms,jme, kms,kme,      &
    3512. 

  3512.                                         its,ite, jts,jte, kts,kte,      &
    3513. 

  3513.                                         ISFFLX,itimestep
    3514. 

  3514. 

  3515.       REAL,    INTENT(IN) ::                                            &
    3516. 

  3516.                                         CP,                             &
    3517. 

  3517.                                         EP1,                            &
    3518. 

  3518.                                         EP2,                            &
    3519. 

  3519.                                         KARMAN,                         &
    3520. 

  3520.                                         R,                              &
    3521. 

  3521.                                         ROVCP,                          &
    3522. 

  3522.                                         XLV
    3523. 

  3523. 

  3524.       REAL,    DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) ::      &
    3525. 

  3525.                                         P3D,                            &
    3526. 

  3526.                                         QV3D,                           &
    3527. 

  3527.                                         T3D,                            &
    3528. 

  3528.                                         U3D,                            &
    3529. 

  3529.                                         V3D
    3530. 

  3530. 

  3531.       REAL,    DIMENSION(ims:ime, jms:jme), INTENT(IN) ::               &
    3532. 

  3532.                                         TSK,                            &
    3533. 

  3533.                                         PSFC,                           &
    3534. 

  3534.                                         XLAND
    3535. 

  3535. 

  3536.       REAL,    DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::            &
    3537. 

  3537.                                         UST,                            &
    3538. 

  3538.                                         ZNT
    3539. 

  3539. 

  3540.       REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) ::                 &
    3541. 

  3541.                                         BR,                             &
    3542. 

  3542.                                         CHS,                            &
    3543. 

  3543.                                         CHS2,                           &
    3544. 

  3544.                                         CPM,                            &
    3545. 

  3545.                                         CQS2,                           &
    3546. 

  3546.                                         FLHC,                           &
    3547. 

  3547.                                         FLQC,                           &
    3548. 

  3548.                                         GZ1OZ0,                         &
    3549. 

  3549.                                         HFX,                            &
    3550. 

  3550.                                         LH,                             &
    3551. 

  3551.                                         PSIM,                           &
    3552. 

  3552.                                         PSIH,                           &
    3553. 

  3553.                                         QFX,                            &
    3554. 

  3554.                                         QGH,                            &
    3555. 

  3555.                                         QSFC,                           &
    3556. 

  3556.                                         U10,                            &
    3557. 

  3557.                                         V10,                            &
    3558. 

  3558.                                         WSPD
    3559. 

  3559. 

  3560.       REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) ::                  &
    3561. 

  3561.                                         XICE
    3562. 

  3562.       REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) ::                 &
    3563. 

  3563.                                         CHS_SEA,                        &
    3564. 

  3564.                                         CHS2_SEA,                       &
    3565. 

  3565.                                         CPM_SEA,                        &
    3566. 

  3566.                                         CQS2_SEA,                       &
    3567. 

  3567.                                         FLHC_SEA,                       &
    3568. 

  3568.                                         FLQC_SEA,                       &
    3569. 

  3569.                                         HFX_SEA,                        &
    3570. 

  3570.                                         LH_SEA,                         &
    3571. 

  3571.                                         QFX_SEA,                        &
    3572. 

  3572.                                         QGH_SEA,                        &
    3573. 

  3573.                                         QSFC_SEA,                       &
    3574. 

  3574.                                         UST_SEA,                        &
    3575. 

  3575.                                         ZNT_SEA
    3576. 

  3576.       REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::               &
    3577. 

  3577.                                         SST
    3578. 

  3578. 

  3579.       REAL,                              INTENT(IN)    ::               &
    3580. 

  3580.                                         XICE_THRESHOLD
    3581. 

  3581.       LOGICAL,                          INTENT(IN)     :: TICE2TSK_IF2COLD
    3582. 

  3582. 

  3583. !-------------------------------------------------------------------------
    3584. 

  3584. !   Local
    3585. 

  3585. !-------------------------------------------------------------------------
    3586. 

  3586.       INTEGER :: I
    3587. 

  3587.       INTEGER :: J
    3588. 

  3588.       REAL, DIMENSION(ims:ime, jms:jme) ::                              &
    3589. 

  3589.                                         BR_SEA,                         &
    3590. 

  3590.                                         GZ1OZ0_SEA,                     &
    3591. 

  3591.                                         PSIM_SEA,                       &
    3592. 

  3592.                                         PSIH_SEA,                       &
    3593. 

  3593.                                         U10_SEA,                        &
    3594. 

  3594.                                         V10_SEA,                        &
    3595. 

  3595.                                         WSPD_SEA,                       &
    3596. 

  3596.                                         XLAND_SEA,                &
    3597. 

  3597.                                         TSK_SEA,                        &
    3598. 

  3598.                                         UST_HOLD,                       &
    3599. 

  3599.                                         ZNT_HOLD,                       &
    3600. 

  3600.                                         TSK_LOCAL
    3601. 

  3601. 

  3602.       CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte,  &
    3603. 

  3603.                               itimestep, .true., tice2tsk_if2cold,     &
    3604. 

  3604.                               XICE, XICE_THRESHOLD,                    &
    3605. 

  3605.                               SST, TSK, TSK_SEA, TSK_LOCAL )
    3606. 

  3606. 

  3607. !
    3608. 

  3608. ! Set up for frozen ocean call for sea ice points
    3609. 

  3609. !
    3610. 

  3610. 

  3611. ! Strictly INTENT(IN), Should be unchanged by SF_GFS:
    3612. 

  3612. !     CP
    3613. 

  3613. !     EP1
    3614. 

  3614. !     EP2
    3615. 

  3615. !     KARMAN
    3616. 

  3616. !     R
    3617. 

  3617. !     ROVCP
    3618. 

  3618. !     XLV
    3619. 

  3619. !     P3D
    3620. 

  3620. !     QV3D
    3621. 

  3621. !     T3D
    3622. 

  3622. !     U3D
    3623. 

  3623. !     V3D
    3624. 

  3624. !     TSK
    3625. 

  3625. !     PSFC
    3626. 

  3626. !     XLAND
    3627. 

  3627. !     ISFFLX
    3628. 

  3628. !     ITIMESTEP
    3629. 

  3629. 

  3630. 

  3631. ! Intent (INOUT), original value is used and changed by SF_GFS.
    3632. 

  3632. !     UST
    3633. 

  3633. !     ZNT
    3634. 

  3634. 

  3635.      ZNT_HOLD = ZNT
    3636. 

  3636.      UST_HOLD = UST
    3637. 

  3637. 

  3638. ! Strictly INTENT (OUT), set by SF_GFS:
    3639. 

  3639. !     BR
    3640. 

  3640. !     CHS     -- used by LSM routines
    3641. 

  3641. !     CHS2    -- used by LSM routines
    3642. 

  3642. !     CPM     -- used by LSM routines
    3643. 

  3643. !     CQS2    -- used by LSM routines
    3644. 

  3644. !     FLHC
    3645. 

  3645. !     FLQC
    3646. 

  3646. !     GZ1OZ0
    3647. 

  3647. !     HFX     -- used by LSM routines
    3648. 

  3648. !     LH      -- used by LSM routines
    3649. 

  3649. !     PSIM
    3650. 

  3650. !     PSIH
    3651. 

  3651. !     QFX     -- used by LSM routines
    3652. 

  3652. !     QGH     -- used by LSM routines
    3653. 

  3653. !     QSFC    -- used by LSM routines
    3654. 

  3654. !     U10
    3655. 

  3655. !     V10
    3656. 

  3656. !     WSPD
    3657. 

  3657. 

  3658. !
    3659. 

  3659. ! Frozen ocean / true land call.
    3660. 

  3660. !
    3661. 

  3661.      CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D,                  &
    3662. 

  3662.           CP,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM_SEA,    &
    3663. 

  3663.           ZNT,UST,PSIM,PSIH,                            &
    3664. 

  3664.           XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,         &
    3665. 

  3665.           QGH,QSFC,U10,V10,                             &
    3666. 

  3666.           GZ1OZ0,WSPD,BR,ISFFLX,                        &
    3667. 

  3667.           EP1,EP2,KARMAN,ITIMESTEP,                     &
    3668. 

  3668.           ids,ide, jds,jde, kds,kde,                    &
    3669. 

  3669.           ims,ime, jms,jme, kms,kme,                    &
    3670. 

  3670.           its,ite, jts,jte, kts,kte                     )
    3671. 

  3671. 

  3672. ! Set up for open-water call
    3673. 

  3673. 

  3674.      DO j = JTS , JTE
    3675. 

  3675.         DO i = ITS , ITE
    3676. 

  3676.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    3677. 

  3677.               ! Sets up things for open ocean fraction of sea-ice points
    3678. 

  3678.               XLAND_SEA(i,j)=2.
    3679. 

  3679.               ZNT_SEA(I,J) = 0.0001
    3680. 

  3680.               IF ( SST(i,j) .LT. 271.4 ) THEN
    3681. 

  3681.                  SST(i,j) = 271.4
    3682. 

  3682.               ENDIF
    3683. 

  3683.               TSK_SEA(i,j) = SST(i,j)
    3684. 

  3684.            ELSE
    3685. 

  3685.               ! Fully open ocean or true land points
    3686. 

  3686.               XLAND_SEA(i,j)=xland(i,j)
    3687. 

  3687.               ZNT_SEA(I,J) = ZNT_HOLD(I,J)
    3688. 

  3688.               UST_SEA(i,j) = UST_HOLD(i,j)
    3689. 

  3689.               TSK_SEA(i,j) = TSK(i,j)
    3690. 

  3690.            ENDIF
    3691. 

  3691.         ENDDO
    3692. 

  3692.      ENDDO
    3693. 

  3693. 

  3694.      ! Open-water call
    3695. 

  3695.      ! _SEA variables are held for later use as the result of the open-water call.
    3696. 

  3696.      CALL SF_GFS(U3D,V3D,T3D,QV3D,P3D,                  &
    3697. 

  3697.           CP,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM,        &
    3698. 

  3698.           ZNT_SEA,UST_SEA,PSIM_SEA,PSIH_SEA,                        &
    3699. 

  3699.           XLAND,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA,   &
    3700. 

  3700.           QGH_SEA,QSFC_SEA,U10_SEA,V10_SEA,                         &
    3701. 

  3701.           GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX,                        &
    3702. 

  3702.           EP1,EP2,KARMAN,ITIMESTEP,                     &
    3703. 

  3703.           ids,ide, jds,jde, kds,kde,                    &
    3704. 

  3704.           ims,ime, jms,jme, kms,kme,                    &
    3705. 

  3705.           its,ite, jts,jte, kts,kte                     )
    3706. 

  3706. 

  3707. ! Weighting, after our two calls to SF_GFS
    3708. 

  3708. 

  3709.      DO j = JTS , JTE
    3710. 

  3710.         DO i = ITS , ITE
    3711. 

  3711.            ! Over sea-ice points, weight the results.  Otherwise, just take the results from the
    3712. 

  3712.            ! first call to SF_GFS_
    3713. 

  3713.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    3714. 

  3714.               ! Weight a number of fields (between open-water results
    3715. 

  3715.               ! and full ice results) by sea-ice fraction.
    3716. 

  3716. 

  3717.               BR(i,j)     = ( BR(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * BR_SEA(i,j)     )
    3718. 

  3718.               ! CHS, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3719. 

  3719.               ! CHS2, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3720. 

  3720.               ! CPM, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3721. 

  3721.               ! CQS2, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3722. 

  3722.               ! FLHC(i,j) = ( FLHC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLHC_SEA(i,j) )
    3723. 

  3723.               ! FLQC(i,j) = ( FLQC(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * FLQC_SEA(i,j) )
    3724. 

  3724.               GZ1OZ0(i,j) = ( GZ1OZ0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * GZ1OZ0_SEA(i,j) )
    3725. 

  3725.               ! HFX, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3726. 

  3726.               ! LH, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3727. 

  3727.               PSIM(i,j)   = ( PSIM(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIM_SEA(i,j)   )
    3728. 

  3728.               PSIH(i,j)   = ( PSIH(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * PSIH_SEA(i,j)   )
    3729. 

  3729.               ! QFX, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3730. 

  3730.               ! QGH, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3731. 

  3731.               ! QSFC, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3732. 

  3732.               U10(i,j)    = ( U10(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * U10_SEA(i,j)    )
    3733. 

  3733.               V10(i,j)    = ( V10(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * V10_SEA(i,j)    )
    3734. 

  3734.               WSPD(i,j)   = ( WSPD(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * WSPD_SEA(i,j)   )
    3735. 

  3735.               ! UST, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3736. 

  3736.               ! ZNT, used by the LSM routines, is not updated yet.  Return results from both calls in separate variables
    3737. 

  3737. 

  3738.            ENDIF
    3739. 

  3739.         ENDDO
    3740. 

  3740.      ENDDO
    3741. 

  3741. 

  3742.    END SUBROUTINE sf_gfs_seaice_wrapper
    3743. 

  3743. 

  3744. !-------------------------------------------------------------------------
    3745. 

  3745. !-------------------------------------------------------------------------
    3746. 

  3746. 

  3747.    SUBROUTINE sfclay_seaice_wrapper(U3D,V3D,T3D,QV3D,P3D,dz8w,     &
    3748. 

  3748.                      CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
    3749. 

  3749.                      ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    3750. 

  3750.                      XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
    3751. 

  3751.                      U10,V10,TH2,T2,Q2,                            &
    3752. 

  3752.                      GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    3753. 

  3753.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
    3754. 

  3754.                      KARMAN,EOMEG,STBOLT,                          &
    3755. 

  3755.                      P1000,                                      &
    3756. 

  3756. XICE,SST,TSK_SEA,                                                  &
    3757. 

  3757. CHS2_SEA,CHS_SEA,CPM_SEA,CQS2_SEA,FLHC_SEA,FLQC_SEA,               &
    3758. 

  3758. HFX_SEA,LH_SEA,QFX_SEA,QGH_SEA,QSFC_SEA,ZNT_SEA,                   &
    3759. 

  3759. ITIMESTEP,TICE2TSK_IF2COLD,XICE_THRESHOLD,                         &
    3760. 

  3760.                      ids,ide, jds,jde, kds,kde,                    &
    3761. 

  3761.                      ims,ime, jms,jme, kms,kme,                    &
    3762. 

  3762.                      its,ite, jts,jte, kts,kte,                    &
    3763. 

  3763.                      ustm,ck,cka,cd,cda,isftcflx,iz0tlnd,          &
    3764. 

  3764.                      sf_surface_physics                             )
    3765. 

  3765. 

  3766.      USE module_sf_sfclay
    3767. 

  3767.      implicit none
    3768. 

  3768. 

  3769.      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde,  &
    3770. 

  3770.                                        ims,ime, jms,jme, kms,kme,  &
    3771. 

  3771.                                        its,ite, jts,jte, kts,kte
    3772. 

  3772. 

  3773.      INTEGER,  INTENT(IN )   ::        ISFFLX
    3774. 

  3774.      REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
    3775. 

  3775.      REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN,EOMEG,STBOLT
    3776. 

  3776.      REAL,     INTENT(IN )   ::        P1000
    3777. 

  3777. 

  3778.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    3779. 

  3779.                INTENT(IN   )   ::                           dz8w
    3780. 

  3780. 

  3781.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    3782. 

  3782.                INTENT(IN   )   ::                           QV3D, &
    3783. 

  3783.                                                              P3D, &
    3784. 

  3784.                                                              T3D
    3785. 

  3785. 

  3786.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3787. 

  3787.                INTENT(IN   )               ::             MAVAIL, &
    3788. 

  3788.                                                             PBLH, &
    3789. 

  3789.                                                            XLAND, &
    3790. 

  3790.                                                              TSK
    3791. 

  3791.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3792. 

  3792.                INTENT(OUT  )               ::                U10, &
    3793. 

  3793.                                                              V10, &
    3794. 

  3794.                                                              TH2, &
    3795. 

  3795.                                                               T2, &
    3796. 

  3796.                                                               Q2, &
    3797. 

  3797.                                                             QSFC
    3798. 

  3798.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3799. 

  3799.                INTENT(INOUT)               ::             REGIME, &
    3800. 

  3800.                                                              HFX, &
    3801. 

  3801.                                                              QFX, &
    3802. 

  3802.                                                               LH, &
    3803. 

  3803.                                                          MOL,RMOL
    3804. 

  3804. 

  3805.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3806. 

  3806.                INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
    3807. 

  3807.                                                         PSIM,PSIH
    3808. 

  3808. 

  3809.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    3810. 

  3810.                INTENT(IN   )   ::                            U3D, &
    3811. 

  3811.                                                              V3D
    3812. 

  3812. 

  3813.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3814. 

  3814.                INTENT(IN   )               ::               PSFC
    3815. 

  3815. 

  3816.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3817. 

  3817.                INTENT(INOUT)   ::                            ZNT, &
    3818. 

  3818.                                                              ZOL, &
    3819. 

  3819.                                                              UST, &
    3820. 

  3820.                                                              CPM, &
    3821. 

  3821.                                                             CHS2, &
    3822. 

  3822.                                                             CQS2, &
    3823. 

  3823.                                                              CHS
    3824. 

  3824. 

  3825.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3826. 

  3826.                INTENT(INOUT)   ::                      FLHC,FLQC
    3827. 

  3827. 

  3828.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    3829. 

  3829.                INTENT(INOUT)   ::                                 &
    3830. 

  3830.                                                               QGH
    3831. 

  3831. 

  3832.      REAL,     INTENT(IN   )               ::   CP,G,ROVCP,R,XLV,DX
    3833. 

  3833. 

  3834.      REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme )              , &
    3835. 

  3835.                INTENT(OUT)     ::              ck,cka,cd,cda,ustm
    3836. 

  3836. 

  3837.      INTEGER,  OPTIONAL,  INTENT(IN )   ::     ISFTCFLX,IZ0TLND
    3838. 

  3838. 

  3839. !--------------------------------------------------------------------
    3840. 

  3840. !    New for wrapper
    3841. 

  3841. !--------------------------------------------------------------------
    3842. 

  3842.      INTEGER,  INTENT(IN)          ::    ITIMESTEP, sf_surface_physics
    3843. 

  3843.      LOGICAL,  INTENT(IN)               ::      TICE2TSK_IF2COLD
    3844. 

  3844.      REAL,     INTENT(IN)               ::      XICE_THRESHOLD
    3845. 

  3845.      REAL,     DIMENSION( ims:ime, jms:jme ),                     &
    3846. 

  3846.                INTENT(IN)               ::      XICE
    3847. 

  3847.      REAL,     DIMENSION( ims:ime, jms:jme ),                     &
    3848. 

  3848.                INTENT(INOUT)            ::      SST
    3849. 

  3849.      REAL,     DIMENSION( ims:ime, jms:jme ),                     &
    3850. 

  3850.                INTENT(OUT)              ::      TSK_SEA,          &
    3851. 

  3851.                                                 CHS2_SEA,         &
    3852. 

  3852.                                                 CHS_SEA,          &
    3853. 

  3853.                                                 CPM_SEA,          &
    3854. 

  3854.                                                 CQS2_SEA,         &
    3855. 

  3855.                                                 FLHC_SEA,         &
    3856. 

  3856.                                                 FLQC_SEA,         &
    3857. 

  3857.                                                 HFX_SEA,          &
    3858. 

  3858.                                                 LH_SEA,           &
    3859. 

  3859.                                                 QFX_SEA,          &
    3860. 

  3860.                                                 QGH_SEA,          &
    3861. 

  3861.                                                 QSFC_SEA,         &
    3862. 

  3862.                                                 ZNT_SEA
    3863. 

  3863. 

  3864. !--------------------------------------------------------------------
    3865. 

  3865. !    Local
    3866. 

  3866. !--------------------------------------------------------------------
    3867. 

  3867.      INTEGER :: I, J
    3868. 

  3868.      REAL,     DIMENSION( ims:ime, jms:jme ) :: XLAND_SEA,        &
    3869. 

  3869.                                                 MAVAIL_sea,       &
    3870. 

  3870.                                                 TSK_LOCAL,        &
    3871. 

  3871.                                                 BR_HOLD,          &
    3872. 

  3872.                                                 CHS2_HOLD,        &
    3873. 

  3873.                                                 CHS_HOLD,         &
    3874. 

  3874.                                                 CPM_HOLD,         &
    3875. 

  3875.                                                 CQS2_HOLD,        &
    3876. 

  3876.                                                 FLHC_HOLD,        &
    3877. 

  3877.                                                 FLQC_HOLD,        &
    3878. 

  3878.                                                 GZ1OZ0_HOLD,      &
    3879. 

  3879.                                                 HFX_HOLD,         &
    3880. 

  3880.                                                 LH_HOLD,          &
    3881. 

  3881.                                                 MOL_HOLD,         &
    3882. 

  3882.                                                 PSIH_HOLD,        &
    3883. 

  3883.                                                 PSIM_HOLD,        &
    3884. 

  3884.                                                 QFX_HOLD,         &
    3885. 

  3885.                                                 QGH_HOLD,         &
    3886. 

  3886.                                                 REGIME_HOLD,      &
    3887. 

  3887.                                                 RMOL_HOLD,        &
    3888. 

  3888.                                                 UST_HOLD,         &
    3889. 

  3889.                                                 WSPD_HOLD,        &
    3890. 

  3890.                                                 ZNT_HOLD,         &
    3891. 

  3891.                                                 ZOL_HOLD,         &
    3892. 

  3892.                                                 TH2_HOLD,         & !ssib
    3893. 

  3893.                                                 T2_HOLD,          & !ssib
    3894. 

  3894.                                                 Q2_HOLD,          & !ssib
    3895. 

  3895.                                                 TSK_HOLD,         & !ssib
    3896. 

  3896.                                                 CD_SEA,           &
    3897. 

  3897.                                                 CDA_SEA,          &
    3898. 

  3898.                                                 CK_SEA,           &
    3899. 

  3899.                                                 CKA_SEA,          &
    3900. 

  3900.                                                 Q2_SEA,           &
    3901. 

  3901.                                                 T2_SEA,           &
    3902. 

  3902.                                                 TH2_SEA,          &
    3903. 

  3903.                                                 U10_SEA,          &
    3904. 

  3904.                                                 USTM_SEA,         &
    3905. 

  3905.                                                 V10_SEA
    3906. 

  3906. 

  3907.      REAL,     DIMENSION( ims:ime, jms:jme ) ::                   &
    3908. 

  3908.                                                 BR_SEA,           &
    3909. 

  3909.                                                 GZ1OZ0_SEA,       &
    3910. 

  3910.                                                 MOL_SEA,          &
    3911. 

  3911.                                                 PSIH_SEA,         &
    3912. 

  3912.                                                 PSIM_SEA,         &
    3913. 

  3913.                                                 REGIME_SEA,       &
    3914. 

  3914.                                                 RMOL_SEA,         &
    3915. 

  3915.                                                 UST_SEA,          &
    3916. 

  3916.                                                 WSPD_SEA,         &
    3917. 

  3917.                                                 ZOL_SEA
    3918. 

  3918. 

  3919. ! INTENT(IN) to SFCLAY; unchanged by the call
    3920. 

  3920.       ! ISFFLX
    3921. 

  3921.       ! SVP1,SVP2,SVP3,SVPT0
    3922. 

  3922.       ! EP1,EP2,KARMAN,EOMEG,STBOLT
    3923. 

  3923.       ! CP,G,ROVCP,R,XLV,DX
    3924. 

  3924.       ! ISFTCFLX,IZ0TLND
    3925. 

  3925.       ! P1000
    3926. 

  3926.       ! dz8w
    3927. 

  3927.       ! QV3D
    3928. 

  3928.       ! P3D
    3929. 

  3929.       ! T3D
    3930. 

  3930.       ! MAVAIL
    3931. 

  3931.       ! PBLH
    3932. 

  3932.       ! XLAND
    3933. 

  3933.       ! TSK
    3934. 

  3934.       ! U3D
    3935. 

  3935.       ! V3D
    3936. 

  3936.       ! PSFC
    3937. 

  3937. 

  3938.      CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte,  &
    3939. 

  3939.                              itimestep, .true., tice2tsk_if2cold,     &
    3940. 

  3940.                              XICE, XICE_THRESHOLD,                    &
    3941. 

  3941.                              SST, TSK, TSK_SEA, TSK_LOCAL )
    3942. 

  3942. 

  3943. 

  3944. ! INTENT (INOUT) to SFCLAY:  Save the variables before the first call
    3945. 

  3945. ! (for land/frozen water) to SFCLAY, to keep from double-counting the
    3946. 

  3946. ! effects of that routine
    3947. 

  3947.      BR_HOLD   = BR
    3948. 

  3948.      CHS2_HOLD = CHS2
    3949. 

  3949.      CHS_HOLD  = CHS
    3950. 

  3950.      CPM_HOLD  = CPM
    3951. 

  3951.      CQS2_HOLD = CQS2
    3952. 

  3952.      FLHC_HOLD = FLHC
    3953. 

  3953.      FLQC_HOLD = FLQC
    3954. 

  3954.      GZ1OZ0_HOLD = GZ1OZ0
    3955. 

  3955.      HFX_HOLD  = HFX
    3956. 

  3956.      LH_HOLD   = LH
    3957. 

  3957.      MOL_HOLD  = MOL
    3958. 

  3958.      PSIH_HOLD = PSIH
    3959. 

  3959.      PSIM_HOLD = PSIM
    3960. 

  3960.      QFX_HOLD  = QFX
    3961. 

  3961.      QGH_HOLD  = QGH
    3962. 

  3962.      REGIME_HOLD = REGIME
    3963. 

  3963.      RMOL_HOLD = RMOL
    3964. 

  3964.      UST_HOLD  = UST
    3965. 

  3965.      WSPD_HOLD = WSPD
    3966. 

  3966.      ZNT_HOLD  = ZNT
    3967. 

  3967.      ZOL_HOLD  = ZOL
    3968. 

  3968. !also save these variables for SSIB (fds 12/2010)
    3969. 

  3969.      TH2_HOLD = TH2
    3970. 

  3970.      T2_HOLD = T2
    3971. 

  3971.      Q2_HOLD = Q2
    3972. 

  3972.      TSK_HOLD = TSK
    3973. 

  3973.      
    3974. 

  3974. ! INTENT(OUT) from SFCLAY.  Input shouldn't matter, but we'll want to
    3975. 

  3975. ! keep things around for weighting after the second call to SFCLAY.
    3976. 

  3976.      ! CD
    3977. 

  3977.      ! CDA
    3978. 

  3978.      ! CK
    3979. 

  3979.      ! CKA
    3980. 

  3980.      ! Q2
    3981. 

  3981.      ! QSFC
    3982. 

  3982.      ! T2
    3983. 

  3983.      ! TH2
    3984. 

  3984.      ! U10
    3985. 

  3985.      ! USTM
    3986. 

  3986.      ! V10
    3987. 

  3987. 

  3988. 

  3989.      ! land/frozen-water call
    3990. 

  3990.      call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w,                    & ! I
    3991. 

  3991.                  CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      & ! I,I,I,I,I,I,IO,IO,IO,IO,
    3992. 

  3992.                  ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    3993. 

  3993.                  XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
    3994. 

  3994.                  U10,V10,TH2,T2,Q2,                            &
    3995. 

  3995.                  GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    3996. 

  3996.                  SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
    3997. 

  3997.                  KARMAN,EOMEG,STBOLT,                          &
    3998. 

  3998.                  P1000,                                      &
    3999. 

  3999.                  ids,ide, jds,jde, kds,kde,                    &
    4000. 

  4000.                  ims,ime, jms,jme, kms,kme,                    &
    4001. 

  4001.                  its,ite, jts,jte, kts,kte,                    &
    4002. 

  4002.                  ustm,ck,cka,cd,cda,isftcflx,iz0tlnd           )
    4003. 

  4003. !
    4004. 

  4004. !Restore land-point values calculated by SSiB (fds 12/2010)
    4005. 

  4005.      IF (itimestep .gt. 1 .and. sf_surface_physics .EQ. 8) then
    4006. 

  4006.      DO j = JTS , JTE
    4007. 

  4007.         DO i = ITS, ITE
    4008. 

  4008.            IF ( XLAND(I,J) .LT. 1.5 ) THEN
    4009. 

  4009.               BR(I,J) = BR_HOLD(I,J)
    4010. 

  4010.               TH2(I,J) = TH2_HOLD(I,J)
    4011. 

  4011.               T2(I,J) = T2_HOLD(I,J)
    4012. 

  4012.               Q2(I,J) = Q2_HOLD(I,J)
    4013. 

  4013.               HFX(I,J) = HFX_HOLD(I,J)
    4014. 

  4014.               QFX(I,J) = QFX_HOLD(I,J)
    4015. 

  4015.               LH(I,J) = LH_HOLD(I,J)
    4016. 

  4016.               GZ1OZ0(I,J) = GZ1OZ0_HOLD(I,J)
    4017. 

  4017.               WSPD(I,J) = WSPD_HOLD(I,J)
    4018. 

  4018.               ZNT(I,J) = ZNT_HOLD(I,J)
    4019. 

  4019.               UST(I,J) = UST_HOLD(I,J)
    4020. 

  4020. !             TSK(I,J) = TSK_HOLD(I,J)
    4021. 

  4021.            ENDIF
    4022. 

  4022.         ENDDO
    4023. 

  4023.      ENDDO
    4024. 

  4024.      ENDIF
    4025. 

  4025. !
    4026. 

  4026.      ! Set up for open-water call
    4027. 

  4027.      DO j = JTS , JTE
    4028. 

  4028.         DO i = ITS , ITE
    4029. 

  4029.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    4030. 

  4030.               XLAND_SEA(i,j)=2.
    4031. 

  4031.               MAVAIL_SEA(I,J)  =1.
    4032. 

  4032.               ZNT_SEA(I,J) = 0.0001
    4033. 

  4033.               TSK_SEA(i,j) = SST(i,j)
    4034. 

  4034.               IF ( SST(i,j) .LT. 271.4 ) THEN
    4035. 

  4035.                  SST(i,j) = 271.4
    4036. 

  4036.                  TSK_SEA(i,j) = SST(i,j)
    4037. 

  4037.               ENDIF
    4038. 

  4038.            ELSE
    4039. 

  4039.               XLAND_SEA(i,j) = XLAND(i,j)
    4040. 

  4040.               MAVAIL_SEA(i,j) = MAVAIL(i,j)
    4041. 

  4041.               ZNT_SEA(i,j)  = ZNT_HOLD(i,j)
    4042. 

  4042.               TSK_SEA(i,j) = TSK_LOCAL(i,j)
    4043. 

  4043.            ENDIF
    4044. 

  4044.         ENDDO
    4045. 

  4045.      ENDDO
    4046. 

  4046. 

  4047.      ! Restore the values from before the land/frozen-water call
    4048. 

  4048.      BR_SEA   = BR_HOLD
    4049. 

  4049.      CHS2_SEA = CHS2_HOLD
    4050. 

  4050.      CHS_SEA  = CHS_HOLD
    4051. 

  4051.      CPM_SEA  = CPM_HOLD
    4052. 

  4052.      CQS2_SEA = CQS2_HOLD
    4053. 

  4053.      FLHC_SEA = FLHC_HOLD
    4054. 

  4054.      FLQC_SEA = FLQC_HOLD
    4055. 

  4055.      GZ1OZ0_SEA = GZ1OZ0_HOLD
    4056. 

  4056.      HFX_SEA  = HFX_HOLD
    4057. 

  4057.      LH_SEA   = LH_HOLD
    4058. 

  4058.      MOL_SEA  = MOL_HOLD
    4059. 

  4059.      PSIH_SEA = PSIH_HOLD
    4060. 

  4060.      PSIM_SEA = PSIM_HOLD
    4061. 

  4061.      QFX_SEA  = QFX_HOLD
    4062. 

  4062.      QGH_SEA  = QGH_HOLD
    4063. 

  4063.      REGIME_SEA = REGIME_HOLD
    4064. 

  4064.      RMOL_SEA = RMOL_HOLD
    4065. 

  4065.      UST_SEA  = UST_HOLD
    4066. 

  4066.      WSPD_SEA = WSPD_HOLD
    4067. 

  4067.      ZOL_SEA  = ZOL_HOLD
    4068. 

  4068. !
    4069. 

  4069.      ! open-water call
    4070. 

  4070.      call sfclay(U3D,V3D,T3D,QV3D,P3D,dz8w,                    & ! I
    4071. 

  4071.                  CP,G,ROVCP,R,XLV,PSFC,                        & ! I
    4072. 

  4072.                  CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA,            & ! I/O
    4073. 

  4073.                  ZNT_SEA,UST_SEA,                              & ! I/O
    4074. 

  4074.                  PBLH,MAVAIL_SEA,                              & ! I
    4075. 

  4075.                  ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, & ! I/O
    4076. 

  4076.                  XLAND_SEA,                              & ! I
    4077. 

  4077.                  HFX_SEA,QFX_SEA,LH_SEA,                       & ! I/O
    4078. 

  4078.                  TSK_SEA,                                      & ! I
    4079. 

  4079.                  FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_sea,RMOL_SEA,  & ! I/O
    4080. 

  4080.                  U10_sea,V10_sea,TH2_sea,T2_sea,Q2_sea,        & ! O
    4081. 

  4081.                  GZ1OZ0_SEA,WSPD_SEA,BR_SEA,                   & ! I/O
    4082. 

  4082.                  ISFFLX,DX,                                    &
    4083. 

  4083.                  SVP1,SVP2,SVP3,SVPT0,EP1,EP2,                 &
    4084. 

  4084.                  KARMAN,EOMEG,STBOLT,                          &
    4085. 

  4085.                  P1000,                                      &
    4086. 

  4086.                  ids,ide, jds,jde, kds,kde,                    &
    4087. 

  4087.                  ims,ime, jms,jme, kms,kme,                    &
    4088. 

  4088.                  its,ite, jts,jte, kts,kte,                    & ! 0
    4089. 

  4089.                  ustm_sea,ck_sea,cka_sea,cd_sea,cda_sea,isftcflx,iz0tlnd )
    4090. 

  4090. !
    4091. 

  4091.      DO j = JTS , JTE
    4092. 

  4092.         DO i = ITS, ITE
    4093. 

  4093.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD )  .and.( XICE(i,j) .LE. 1.0 ) ) THEN
    4094. 

  4094.               ! weighted average for sea ice points
    4095. 

  4095.               br(i,j)     = ( br(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j)     )
    4096. 

  4096.               ! CHS2 -- wait
    4097. 

  4097.               ! CHS  -- wait
    4098. 

  4098.               ! CPM  -- wait
    4099. 

  4099.               ! CQS2 -- wait
    4100. 

  4100.               ! FLHC -- wait
    4101. 

  4101.               ! FLQC -- wait
    4102. 

  4102.               gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
    4103. 

  4103.               ! HFX  -- wait
    4104. 

  4104.               ! LH   -- wait
    4105. 

  4105.               mol(i,j)    = ( mol(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j)    )
    4106. 

  4106.               psih(i,j)   = ( psih(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j)   )
    4107. 

  4107.               psim(i,j)   = ( psim(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j)   )
    4108. 

  4108.               ! QFX  -- wait
    4109. 

  4109.               ! QGH  -- wait
    4110. 

  4110.               if ( XICE(i,j).GE. 0.5 ) regime(i,j) = regime_hold(i,j)
    4111. 

  4111.               rmol(i,j)   = ( rmol(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j)   )
    4112. 

  4112.               ust(i,j)    = ( ust(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j)    )
    4113. 

  4113.               wspd(i,j)   = ( wspd(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j)   )
    4114. 

  4114.               zol(i,j)    = ( zol(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j)    )
    4115. 

  4115.               ! INTENT(OUT) --------------------------------------------------------------------
    4116. 

  4116.               IF ( PRESENT ( CD ) ) THEN
    4117. 

  4117.                  CD(i,j)     = ( CD(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CD_sea(i,j)     )
    4118. 

  4118.               ENDIF
    4119. 

  4119.               IF ( PRESENT ( CDA ) ) THEN
    4120. 

  4120.                  CDA(i,j)     = ( CDA(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CDA_sea(i,j)     )
    4121. 

  4121.               ENDIF
    4122. 

  4122.               IF ( PRESENT ( CK ) ) THEN
    4123. 

  4123.                  CK(i,j)     = ( CK(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CK_sea(i,j)     )
    4124. 

  4124.               ENDIF
    4125. 

  4125.               IF ( PRESENT ( CKA ) ) THEN
    4126. 

  4126.                  CKA(i,j)     = ( CKA(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * CKA_sea(i,j)     )
    4127. 

  4127.               ENDIF
    4128. 

  4128.               q2(i,j)     = ( q2(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * q2_sea(i,j)     )
    4129. 

  4129.               ! QSFC -- wait
    4130. 

  4130.               t2(i,j)     = ( t2(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * t2_sea(i,j)     )
    4131. 

  4131.               th2(i,j)    = ( th2(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * th2_sea(i,j)    )
    4132. 

  4132.               u10(i,j)    = ( u10(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j)    )
    4133. 

  4133.               IF ( PRESENT ( USTM ) ) THEN
    4134. 

  4134.                  USTM(i,j)    = ( USTM(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * USTM_sea(i,j)    )
    4135. 

  4135.               ENDIF
    4136. 

  4136.               v10(i,j)    = ( v10(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j)    )
    4137. 

  4137.            ENDIF
    4138. 

  4138.         END DO
    4139. 

  4139.      END DO
    4140. 

  4140. !
    4141. 

  4141. !         tsk(i,j) = tsk(i,j)*XICE(i,j) + (1.0-XICE(i,j))*TSK_SEA(i,j)
    4142. 

  4142. !
    4143. 

  4143.    END SUBROUTINE sfclay_seaice_wrapper
    4144. 

  4144. 

  4145. !-------------------------------------------------------------------------
    4146. 

  4146. !-------------------------------------------------------------------------
    4147. 

  4147. 

  4148.    SUBROUTINE pxsfclay_seaice_wrapper(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w, &
    4149. 

  4149.                      CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
    4150. 

  4150.                      ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    4151. 

  4151.                      XLAND,HFX,QFX,LH,TSK,FLHC,FLQC,QGH,QSFC,RMOL, &
    4152. 

  4152.                      U10,V10,                                      &
    4153. 

  4153.                      GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    4154. 

  4154.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
    4155. 

  4155. XICE, SST, ITIMESTEP, TICE2TSK_IF2COLD,XICE_THRESHOLD,             &
    4156. 

  4156. CHS_SEA, CHS2_SEA, CPM_SEA, CQS2_SEA, FLHC_SEA, FLQC_SEA,          &
    4157. 

  4157. HFX_SEA, LH_SEA, QFX_SEA, QGH_SEA, QSFC_SEA, TSK_SEA,  &
    4158. 

  4158.                      ids,ide, jds,jde, kds,kde,                    &
    4159. 

  4159.                      ims,ime, jms,jme, kms,kme,                    &
    4160. 

  4160.                      its,ite, jts,jte, kts,kte                     )
    4161. 

  4161.      USE module_sf_pxsfclay
    4162. 

  4162.      implicit none
    4163. 

  4163.      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
    4164. 

  4164.                                        ims,ime, jms,jme, kms,kme, &
    4165. 

  4165.                                        its,ite, jts,jte, kts,kte
    4166. 

  4166. 

  4167.      INTEGER,  INTENT(IN )   ::        ISFFLX
    4168. 

  4168.      LOGICAL,  INTENT(IN )   ::        TICE2TSK_IF2COLD
    4169. 

  4169.      REAL,     INTENT(IN )   ::        SVP1,SVP2,SVP3,SVPT0
    4170. 

  4170.      REAL,     INTENT(IN )   ::        EP1,EP2,KARMAN
    4171. 

  4171. 

  4172.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    4173. 

  4173.                INTENT(IN   )   ::                           dz8w
    4174. 

  4174. 

  4175.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    4176. 

  4176.                INTENT(IN   )   ::                           QV3D, &
    4177. 

  4177.                                                              P3D, &
    4178. 

  4178.                                                              T3D, &
    4179. 

  4179.                                                             TH3D
    4180. 

  4180. 

  4181.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4182. 

  4182.                INTENT(IN   )               ::             MAVAIL, &
    4183. 

  4183.                                                             PBLH, &
    4184. 

  4184.                                                            XLAND, &
    4185. 

  4185.                                                              TSK
    4186. 

  4186.      REAL,     DIMENSION( ims:ime, kms:kme, jms:jme )           , &
    4187. 

  4187.                INTENT(IN   )   ::                            U3D, &
    4188. 

  4188.                                                              V3D
    4189. 

  4189. 

  4190.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4191. 

  4191.                INTENT(IN   )               ::               PSFC
    4192. 

  4192. 

  4193.      REAL,     INTENT(IN   )                  ::   CP,G,ROVCP,R,XLV,DX
    4194. 

  4194. 

  4195.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4196. 

  4196.                INTENT(OUT  )               ::                U10, &
    4197. 

  4197.                                                              V10, &
    4198. 

  4198.                                                             QSFC
    4199. 

  4199.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4200. 

  4200.                INTENT(INOUT)               ::             REGIME, &
    4201. 

  4201.                                                              HFX, &
    4202. 

  4202.                                                              QFX, &
    4203. 

  4203.                                                               LH, &
    4204. 

  4204.                                                          MOL,RMOL
    4205. 

  4205.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4206. 

  4206.                INTENT(INOUT)   ::                 GZ1OZ0,WSPD,BR, &
    4207. 

  4207.                                                        PSIM,PSIH
    4208. 

  4208. 

  4209.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4210. 

  4210.                INTENT(INOUT)   ::                            ZNT, &
    4211. 

  4211.                                                              ZOL, &
    4212. 

  4212.                                                              UST, &
    4213. 

  4213.                                                              CPM, &
    4214. 

  4214.                                                             CHS2, &
    4215. 

  4215.                                                             CQS2, &
    4216. 

  4216.                                                              CHS
    4217. 

  4217. 

  4218.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4219. 

  4219.                INTENT(INOUT)   ::                      FLHC,FLQC
    4220. 

  4220. 

  4221.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4222. 

  4222.                INTENT(INOUT)   ::                            QGH
    4223. 

  4223. 

  4224. !--------------------------------------------------------------------
    4225. 

  4225. !    For wrapper
    4226. 

  4226. !--------------------------------------------------------------------
    4227. 

  4227. 

  4228.      INTEGER,  INTENT(IN)                           :: ITIMESTEP
    4229. 

  4229.      REAL,     INTENT(IN)                           :: XICE_THRESHOLD
    4230. 

  4230.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4231. 

  4231.                INTENT(IN)                           ::      XICE
    4232. 

  4232.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4233. 

  4233.                INTENT(OUT)                        ::     TSK_SEA
    4234. 

  4234.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4235. 

  4235.                INTENT(INOUT)              ::                 SST
    4236. 

  4236. 

  4237. !--------------------------------------------------------------------
    4238. 

  4238. !    Local
    4239. 

  4239. !--------------------------------------------------------------------
    4240. 

  4240.      INTEGER :: I, J
    4241. 

  4241.      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
    4242. 

  4242.                INTENT(OUT)    ::                         CHS_SEA, &
    4243. 

  4243.                                                         CHS2_SEA, &
    4244. 

  4244.                                                          CPM_SEA, &
    4245. 

  4245.                                                         CQS2_SEA, &
    4246. 

  4246.                                                         FLHC_SEA, &
    4247. 

  4247.                                                         FLQC_SEA, &
    4248. 

  4248.                                                          HFX_SEA, &
    4249. 

  4249.                                                           LH_SEA, &
    4250. 

  4250.                                                          QFX_SEA, &
    4251. 

  4251.                                                          QGH_SEA, &
    4252. 

  4252.                                                         QSFC_SEA
    4253. 

  4253. 

  4254.      REAL,     DIMENSION( ims:ime, jms:jme ) ::          BR_HOLD, &
    4255. 

  4255.                                                         CHS_HOLD, &
    4256. 

  4256.                                                        CHS2_HOLD, &
    4257. 

  4257.                                                         CPM_HOLD, &
    4258. 

  4258.                                                        CQS2_HOLD, &
    4259. 

  4259.                                                        FLHC_HOLD, &
    4260. 

  4260.                                                        FLQC_HOLD, &
    4261. 

  4261.                                                      GZ1OZ0_HOLD, &
    4262. 

  4262.                                                         HFX_HOLD, &
    4263. 

  4263.                                                          LH_HOLD, &
    4264. 

  4264.                                                         MOL_HOLD, &
    4265. 

  4265.                                                        PSIH_HOLD, &
    4266. 

  4266.                                                        PSIM_HOLD, &
    4267. 

  4267.                                                         QFX_HOLD, &
    4268. 

  4268.                                                         QGH_HOLD, &
    4269. 

  4269.                                                      REGIME_HOLD, &
    4270. 

  4270.                                                        RMOL_HOLD, &
    4271. 

  4271.                                                         UST_HOLD, &
    4272. 

  4272.                                                        WSPD_HOLD, &
    4273. 

  4273.                                                         ZNT_HOLD, &
    4274. 

  4274.                                                         ZOL_HOLD, &
    4275. 

  4275.                                                        TSK_LOCAL
    4276. 

  4276. 

  4277.      REAL,     DIMENSION( ims:ime, jms:jme ) ::        XLAND_SEA, &
    4278. 

  4278.                                                       MAVAIL_SEA, &
    4279. 

  4279.                                                           BR_SEA, &
    4280. 

  4280.                                                       GZ1OZ0_SEA, &
    4281. 

  4281.                                                          MOL_SEA, &
    4282. 

  4282.                                                         PSIH_SEA, &
    4283. 

  4283.                                                         PSIM_SEA, &
    4284. 

  4284.                                                       REGIME_SEA, &
    4285. 

  4285.                                                         RMOL_SEA, &
    4286. 

  4286.                                                          UST_SEA, &
    4287. 

  4287.                                                         WSPD_SEA, &
    4288. 

  4288.                                                          ZNT_SEA, &
    4289. 

  4289.                                                          ZOL_SEA, &
    4290. 

  4290.                                                          U10_SEA, &
    4291. 

  4291.                                                          V10_SEA
    4292. 

  4292. 

  4293.      CALL get_local_ice_tsk( ims, ime, jms, jme, its, ite, jts, jte,  &
    4294. 

  4294.                              itimestep, .true., tice2tsk_if2cold,     &
    4295. 

  4295.                              XICE, XICE_THRESHOLD,                    &
    4296. 

  4296.                              SST, TSK, TSK_SEA, TSK_LOCAL )
    4297. 

  4297. !
    4298. 

  4298. ! INTENT (INOUT) to PXSFCLAY:  Save the variables before the first call
    4299. 

  4299. ! (for land/frozen water) to SFCLAY, to keep from double-counting the
    4300. 

  4300. ! effects of that routine
    4301. 

  4301. !
    4302. 

  4302.      BR_HOLD     = BR
    4303. 

  4303.      CHS_HOLD    = CHS
    4304. 

  4304.      CHS2_HOLD   = CHS2
    4305. 

  4305.      CPM_HOLD    = CPM
    4306. 

  4306.      CQS2_HOLD   = CQS2
    4307. 

  4307.      FLHC_HOLD   = FLHC
    4308. 

  4308.      FLQC_HOLD   = FLQC
    4309. 

  4309.      GZ1OZ0_HOLD = GZ1OZ0
    4310. 

  4310.      HFX_HOLD    = HFX
    4311. 

  4311.      LH_HOLD     = LH
    4312. 

  4312.      MOL_HOLD    = MOL
    4313. 

  4313.      PSIH_HOLD   = PSIH
    4314. 

  4314.      PSIM_HOLD   = PSIM
    4315. 

  4315.      QFX_HOLD    = QFX
    4316. 

  4316.      QGH_HOLD    = QGH
    4317. 

  4317.      REGIME_HOLD = REGIME
    4318. 

  4318.      RMOL_HOLD   = RMOL
    4319. 

  4319.      UST_HOLD    = UST
    4320. 

  4320.      WSPD_HOLD   = WSPD
    4321. 

  4321.      ZNT_HOLD    = ZNT
    4322. 

  4322.      ZOL_HOLD    = ZOL
    4323. 

  4323. 

  4324. ! INTENT(OUT) from PXSFCLAY.  Input shouldn't matter, but we'll want to
    4325. 

  4325. ! keep things around for weighting after the second call to PXSFCLAY.
    4326. 

  4326.      ! U10
    4327. 

  4327.      ! V10
    4328. 

  4328.      ! QSFC
    4329. 

  4329. 

  4330. ! Land/frozen-water call.
    4331. 

  4331.      CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w,                 &
    4332. 

  4332.                      CP,G,ROVCP,R,XLV,PSFC,CHS,CHS2,CQS2,CPM,      &
    4333. 

  4333.                      ZNT,UST,PBLH,MAVAIL,ZOL,MOL,REGIME,PSIM,PSIH, &
    4334. 

  4334.                      XLAND,HFX,QFX,LH,TSK_LOCAL,FLHC,FLQC,QGH,QSFC,RMOL, &
    4335. 

  4335.                      U10,V10,                                      &
    4336. 

  4336.                      GZ1OZ0,WSPD,BR,ISFFLX,DX,                     &
    4337. 

  4337.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
    4338. 

  4338.                      ids,ide, jds,jde, kds,kde,                    &
    4339. 

  4339.                      ims,ime, jms,jme, kms,kme,                    &
    4340. 

  4340.                      its,ite, jts,jte, kts,kte                     )
    4341. 

  4341. 

  4342.      DO j = JTS , JTE
    4343. 

  4343.         DO i= ITS , ITE
    4344. 

  4344.            IF( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    4345. 

  4345.               ! Sets up things for open ocean.
    4346. 

  4346.               XLAND_SEA(i,j)=2.
    4347. 

  4347.               MAVAIL_SEA(I,J)  =1.
    4348. 

  4348.               ZNT_SEA(I,J) = 0.0001
    4349. 

  4349.               TSK_SEA(i,j)  = SST(i,j)
    4350. 

  4350.               if ( SST(i,j) .LT. 271.4 ) then
    4351. 

  4351.                  SST(i,j) = 271.4
    4352. 

  4352.                  TSK_SEA(i,j) = SST(i,j)
    4353. 

  4353.               endif
    4354. 

  4354.            ELSE
    4355. 

  4355.               XLAND_SEA(i,j)=xland(i,j)
    4356. 

  4356.               MAVAIL_SEA(i,j) = mavail(i,j)
    4357. 

  4357.               ZNT_SEA(I,J)  = ZNT_HOLD(I,J)
    4358. 

  4358.               TSK_SEA(i,j)  = TSK(i,j)
    4359. 

  4359.            ENDIF
    4360. 

  4360.         ENDDO
    4361. 

  4361.      ENDDO
    4362. 

  4362. 

  4363.      ! INTENT(INOUT) variables held over from before the first call to PXSFCLAY:
    4364. 

  4364.      BR_SEA     = BR_HOLD
    4365. 

  4365.      CHS_SEA    = CHS_HOLD
    4366. 

  4366.      CHS2_SEA   = CHS2_HOLD
    4367. 

  4367.      CPM_SEA    = CPM_HOLD
    4368. 

  4368.      CQS2_SEA   = CQS2_HOLD
    4369. 

  4369.      FLHC_SEA   = FLHC_HOLD
    4370. 

  4370.      FLQC_SEA   = FLQC_HOLD
    4371. 

  4371.      GZ1OZ0_SEA = GZ1OZ0_HOLD
    4372. 

  4372.      HFX_SEA    = HFX_HOLD
    4373. 

  4373.      LH_SEA     = LH_HOLD
    4374. 

  4374.      MOL_SEA    = MOL_HOLD
    4375. 

  4375.      PSIH_SEA   = PSIH_HOLD
    4376. 

  4376.      PSIM_SEA   = PSIM_HOLD
    4377. 

  4377.      QFX_SEA    = QFX_HOLD
    4378. 

  4378.      QGH_SEA    = QGH_HOLD
    4379. 

  4379.      REGIME_SEA = REGIME_HOLD
    4380. 

  4380.      RMOL_SEA   = RMOL_HOLD
    4381. 

  4381.      UST_SEA    = UST_HOLD
    4382. 

  4382.      WSPD_SEA   = WSPD_HOLD
    4383. 

  4383.      ZOL_SEA    = ZOL_HOLD
    4384. 

  4384. 

  4385. ! Open-water call.
    4386. 

  4386.      ! Variables newly set (INTENT(OUT)) or changed (INTENT(INOUT)) by
    4387. 

  4387.      ! PXSFCLAY are here appended with the "_SEA" label.
    4388. 

  4388.      ! Special intent(IN) variables here:  XLAND_SEA, MAVAIL_SEA, TSK_SEA
    4389. 

  4389.      CALL pxsfclay(U3D,V3D,T3D,TH3D,QV3D,P3D,dz8w,                 &
    4390. 

  4390.                      CP,G,ROVCP,R,XLV,PSFC,CHS_SEA,CHS2_SEA,CQS2_SEA,CPM_SEA,      &
    4391. 

  4391.                      ZNT_SEA,UST_SEA,PBLH,MAVAIL_SEA,ZOL_SEA,MOL_SEA,REGIME_SEA,PSIM_SEA,PSIH_SEA, &
    4392. 

  4392.                      XLAND_SEA,HFX_SEA,QFX_SEA,LH_SEA,TSK_SEA,FLHC_SEA,FLQC_SEA,QGH_SEA,QSFC_SEA,RMOL_SEA, &
    4393. 

  4393.                      U10_SEA,V10_SEA,                              &
    4394. 

  4394.                      GZ1OZ0_SEA,WSPD_SEA,BR_SEA,ISFFLX,DX,         &
    4395. 

  4395.                      SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN,          &
    4396. 

  4396.                      ids,ide, jds,jde, kds,kde,                    &
    4397. 

  4397.                      ims,ime, jms,jme, kms,kme,                    &
    4398. 

  4398.                      its,ite, jts,jte, kts,kte                     )
    4399. 

  4399. 

  4400.      DO j = JTS , JTE
    4401. 

  4401.         DO i = ITS , ITE
    4402. 

  4402.            IF ( ( XICE(I,J) .GE. XICE_THRESHOLD ) .and. ( XICE(i,j) .LE. 1.0 ) ) THEN
    4403. 

  4403.               ! INTENT (INOUT) for PXSFCLAY:
    4404. 

  4404.               br(i,j)     = ( br(i,j)     * XICE(i,j) ) + ( (1.0-XICE(i,j)) * br_sea(i,j)     )
    4405. 

  4405.               gz1oz0(i,j) = ( gz1oz0(i,j) * XICE(i,j) ) + ( (1.0-XICE(i,j)) * gz1oz0_sea(i,j) )
    4406. 

  4406.               mol(i,j)    = ( mol(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * mol_sea(i,j)    )
    4407. 

  4407.               psih(i,j)   = ( psih(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psih_sea(i,j)   )
    4408. 

  4408.               psim(i,j)   = ( psim(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * psim_sea(i,j)   )
    4409. 

  4409.               rmol(i,j)   = ( rmol(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * rmol_sea(i,j)   )
    4410. 

  4410.               ust(i,j)    = ( ust(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * ust_sea(i,j)    )
    4411. 

  4411.               wspd(i,j)   = ( wspd(i,j)   * XICE(i,j) ) + ( (1.0-XICE(i,j)) * wspd_sea(i,j)   )
    4412. 

  4412.               zol(i,j)    = ( zol(i,j)    * XICE(i,j) ) + ( (1.0-XICE(i,j)) * zol_sea(i,j)    )
    4413. 

  4413.               ! REGIME:  Special case for this variable.  Just take the land values.
    4414. 

  4414.               ! CHS -- wait
    4415. 

  4415.               ! CHS2 -- wait
    4416. 

  4416.               ! CPM -- wait
    4417. 

  4417.               ! CQS2 -- wait
    4418. 

  4418.               ! FLHC -- wait
    4419. 

  4419.               ! FLQC -- wait
    4420. 

  4420.               ! HFX -- wait
    4421. 

  4421.               ! LH -- wait
    4422. 

  4422.               ! QFX -- wait
    4423. 

  4423.               ! QGH -- wait
    4424. 

  4424. 

  4425.               ! INTENT (OUT) from PXSFCLAY:
    4426. 

  4426.               u10(i,j) = ( u10(i,j)       * XICE(i,j) ) + ( (1.0-XICE(i,j)) * u10_sea(i,j)    )
    4427. 

  4427.               v10(i,j) = ( v10(i,j)       * XICE(i,j) ) + ( (1.0-XICE(i,j)) * v10_sea(i,j)    )
    4428. 

  4428.               ! QSFC -- wait
    4429. 

  4429.            ENDIF
    4430. 

  4430.         ENDDO
    4431. 

  4431.      ENDDO
    4432. 

  4432. 

  4433.    END SUBROUTINE pxsfclay_seaice_wrapper
    4434. 

  4434. 

  4435. !-------------------------------------------------------------------------
    4436. 

  4436. 

  4437.    SUBROUTINE TOPO_RAD_ADJ_DRVR (XLAT,XLONG,COSZEN,               &
    4438. 

  4438.                     shadowmask,                                   &
    4439. 

  4439.                     declin,                                       &
    4440. 

  4440.                     SWDOWN,GSW,SWNORM,GSWSAVE,solcon,hrang2d,     &
    4441. 

  4441.                     slope_in,slp_azi_in,                          &
    4442. 

  4442.                 ids, ide, jds, jde, kds, kde,                     &
    4443. 

  4443.                 ims, ime, jms, jme, kms, kme,                     &
    4444. 

  4444.                 its, ite, jts, jte, kts, kte                      )
    4445. 

  4445. !------------------------------------------------------------------
    4446. 

  4446.    IMPLICIT NONE
    4447. 

  4447. !------------------------------------------------------------------
    4448. 

  4448.    INTEGER, INTENT(IN)   ::       its,ite,jts,jte,kts,kte,        &
    4449. 

  4449.                                   ims,ime,jms,jme,kms,kme,        &
    4450. 

  4450.                                   ids,ide,jds,jde,kds,kde
    4451. 

  4451.    INTEGER, DIMENSION( ims:ime, jms:jme ),                        &
    4452. 

  4452.          INTENT(IN)      ::       shadowmask
    4453. 

  4453.    REAL, DIMENSION( ims:ime, jms:jme ),                           &
    4454. 

  4454.          INTENT(IN   )   ::       XLAT,XLONG
    4455. 

  4455.    REAL, DIMENSION( ims:ime, jms:jme ),                           &
    4456. 

  4456.          INTENT(INOUT)   ::       SWDOWN,GSW,SWNORM,GSWSAVE
    4457. 

  4457.    real,intent(in)  :: solcon   
    4458. 

  4458.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: hrang2d,coszen 
    4459. 

  4459. 

  4460. 

  4461.    REAL, INTENT(IN    )  ::       declin
    4462. 

  4462.    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   ) :: slope_in,slp_azi_in
    4463. 

  4463. 

  4464. 

  4465. ! LOCAL VARS
    4466. 

  4466.    integer    :: i,j
    4467. 

  4467.    real       :: pi,degrad
    4468. 

  4468.    integer    :: shadow
    4469. 

  4469.    real       :: swdown_teradj,swdown_in,xlat1,xlong1
    4470. 

  4470. 

  4471. !------------------------------------------------------------------
    4472. 

  4472. 

  4473.      pi = 4.*atan(1.)
    4474. 

  4474.      degrad=pi/180.
    4475. 

  4475. 

  4476.        DO J=jts,jte
    4477. 

  4477.        DO I=its,ite
    4478. 

  4478.          SWNORM(i,j) = SWDOWN(i,j)     ! save
    4479. 

  4479.          IF(SWDOWN(I,J) .GT. 1.E-3)THEN  ! daytime
    4480. 

  4480.              shadow = shadowmask(i,j)
    4481. 

  4481. 

  4482.          SWDOWN_IN = SWDOWN(i,j)
    4483. 

  4483.          XLAT1 = XLAT(i,j)
    4484. 

  4484.          XLONG1 = XLONG(i,j)
    4485. 

  4485.          CALL TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN(i,j),             &
    4486. 

  4486.                     DECLIN,DEGRAD,                                &
    4487. 

  4487.                     SWDOWN_IN,solcon,hrang2d(i,j),SWDOWN_teradj,  &
    4488. 

  4488.                     kts,kte,                                      &
    4489. 

  4489.                     slope_in(i,j),slp_azi_in(i,j),                &
    4490. 

  4490.                     shadow , i,j                                  &
    4491. 

  4491.                     )
    4492. 

  4492. 

  4493.          GSWSAVE(I,J) = GSW(I,J)       ! save
    4494. 

  4494.          GSW(I,J) = GSW(I,J)*SWDOWN_teradj/SWDOWN(i,j)
    4495. 

  4495.          SWDOWN(i,j) = SWDOWN_teradj
    4496. 

  4496. 

  4497.          ENDIF ! daytime
    4498. 

  4498.        ENDDO  ! i_loop
    4499. 

  4499.        ENDDO  ! j_loop
    4500. 

  4500. 

  4501. 

  4502.    END SUBROUTINE TOPO_RAD_ADJ_DRVR
    4503. 

  4503. !------------------------------------------------------------------
    4504. 

  4504. !------------------------------------------------------------------
    4505. 

  4505.    SUBROUTINE TOPO_RAD_ADJ (XLAT1,XLONG1,COSZEN,                 &
    4506. 

  4506.                     DECLIN,DEGRAD,                               &
    4507. 

  4507.                     SWDOWN_IN,solcon,hrang,SWDOWN_teradj,        &
    4508. 

  4508.                     kts,kte,                                     &
    4509. 

  4509.                     slope,slp_azi,                               &
    4510. 

  4510.                     shadow                                       &
    4511. 

  4511.                     ,i,j)
    4512. 

  4512. 

  4513. !------------------------------------------------------------------
    4514. 

  4514.    IMPLICIT NONE
    4515. 

  4515. !------------------------------------------------------------------
    4516. 

  4516.   INTEGER, INTENT(IN)       :: kts,kte
    4517. 

  4517.   REAL, INTENT(IN)          :: COSZEN,DECLIN,              &
    4518. 

  4518.                                XLAT1,XLONG1,DEGRAD
    4519. 

  4519.   REAL, INTENT(IN)          :: SWDOWN_IN,solcon,hrang
    4520. 

  4520.   INTEGER, INTENT(IN)       :: shadow
    4521. 

  4521.   REAL, INTENT(IN)          :: slp_azi,slope
    4522. 

  4522. 

  4523.   REAL, INTENT(OUT)         :: SWDOWN_teradj
    4524. 

  4524. 

  4525. ! LOCAL VARS
    4526. 

  4526.    REAL            :: XT24,TLOCTM,CSZA,XXLAT
    4527. 

  4527.    REAL            :: diffuse_frac,corr_fac,csza_slp
    4528. 

  4528.    integer         :: i,j
    4529. 

  4529. 

  4530. 

  4531. !------------------------------------------------------------------
    4532. 

  4532. 

  4533.      SWDOWN_teradj=SWDOWN_IN
    4534. 

  4534. 

  4535.      CSZA=COSZEN
    4536. 

  4536.      XXLAT=XLAT1*DEGRAD
    4537. 

  4537. 

  4538. ! RETURN IF NIGHT
    4539. 

  4539.          IF(CSZA.LE.1.E-9) return 
    4540. 

  4540.         
    4541. 

  4541. !  Parameterize diffuse fraction of global solar radiation as a function of the ratio between TOA radiation and surface global radiation
    4542. 

  4542.               diffuse_frac = min(1.,1./(max(0.1,2.1-2.8*log(log(csza*solcon/max(SWDOWN_IN,1.e-3))))))
    4543. 

  4543.         if ((slope.eq.0).or.(diffuse_frac.eq.1).or.(csza.lt.1.e-2)) then  ! no topographic effects when all radiation diffuse or sun too close to horizon
    4544. 

  4544.           corr_fac = 1
    4545. 

  4545.           goto 140
    4546. 

  4546.         endif
    4547. 

  4547. 

  4548. ! cosine of zenith angle over sloping topography
    4549. 

  4549.         csza_slp = ((SIN(XXLAT)*COS(HRANG))*                                          &
    4550. 

  4550.                     (-cos(slp_azi)*sin(slope))-SIN(HRANG)*(sin(slp_azi)*sin(slope))+  &
    4551. 

  4551.                     (COS(XXLAT)*COS(HRANG))*cos(slope))*                              &
    4552. 

  4552.                    COS(DECLIN)+(COS(XXLAT)*(cos(slp_azi)*sin(slope))+                 &
    4553. 

  4553.                    SIN(XXLAT)*cos(slope))*SIN(DECLIN)
    4554. 

  4554.         IF(csza_slp.LE.1.E-4) csza_slp = 0
    4555. 

  4555. 

  4556. ! Topographic shading
    4557. 

  4557.         if (shadow.eq.1) csza_slp = 0
    4558. 

  4558. 

  4559. ! Correction factor for sloping topography; the diffuse fraction of solar radiation is assumed to be unaffected by the slope
    4560. 

  4560.         corr_fac = diffuse_frac + (1-diffuse_frac)*csza_slp/csza
    4561. 

  4561. 

  4562.  140        continue
    4563. 

  4563. 

  4564.       SWDOWN_teradj=(1.)*SWDOWN_IN*corr_fac
    4565. 

  4565. 

  4566.    END SUBROUTINE TOPO_RAD_ADJ
    4567. 

  4567. 

  4568. !=======================================================================
    4569. 

  4569. 

  4570.    SUBROUTINE get_local_ice_tsk ( ims, ime, jms, jme,     &
    4571. 

  4571.                                   its, ite, jts, jte,     &
    4572. 

  4572.                                   itimestep,              &
    4573. 

  4573.                                   sfc_layer_values,       &
    4574. 

  4574.                                   tice2tsk_if2cold,       &
    4575. 

  4575.                                   XICE, XICE_THRESHOLD,   &
    4576. 

  4576.                                   SST, TSK, TSK_SEA, TSK_ICE )
    4577. 

  4577. !<DESCRIPTION>
    4578. 

  4578. !
    4579. 

  4579. ! For grid cells with a fractional ice area, derive the ice surface 
    4580. 

  4580. ! temperature from the area-averaged surface temperature (the blended
    4581. 

  4581. ! result of the open-water values (SST) and the ice-covered value).
    4582. 

  4582. !
    4583. 

  4583. !</DESCRIPTION>
    4584. 

  4584. 

  4585.       IMPLICIT NONE
    4586. 

  4586. 

  4587.       INTEGER, INTENT(IN) :: ims, ime, jms, jme    !-- start/end index for i/j in memory
    4588. 

  4588.       INTEGER, INTENT(IN) :: its, ite, jts, jte    !-- start/end index for i/j in tile
    4589. 

  4589.       INTEGER, INTENT(IN) :: itimestep             !-- timestep
    4590. 

  4590.       LOGICAL, INTENT(IN) :: sfc_layer_values      !-- True if there are surface layer routine values
    4591. 

  4591.                                                    !-- available from the ice portion of the grid point
    4592. 

  4592.                                                    !-- (i.e. called from a seaice_wrapper subroutine)
    4593. 

  4593.       LOGICAL, INTENT(IN) :: tice2tsk_if2cold      !-- True to set TSK_ICE to TSK.  This may be
    4594. 

  4594.                                                    !-- necessary to avoid unphysically low ice
    4595. 

  4595.                                                    !-- temperatures is there is a mis-match between
    4596. 

  4596.                                                    !-- ice fraction and surface temperature.
    4597. 

  4597. 

  4598.       REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)    :: XICE        ! Ice fraction
    4599. 

  4599.       REAL                                , INTENT(IN)    :: XICE_THRESHOLD 
    4600. 

  4600.       REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)    :: TSK         ! Surface temperature (K)
    4601. 

  4601.       REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: SST         ! Sea surface temperature (K)
    4602. 

  4602.       REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT)   :: TSK_SEA     ! Sfc temp of open water portion of grid cell 
    4603. 

  4603.       REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT)   :: TSK_ICE     ! Sfc temp of ice oprtion of grid cell
    4604. 

  4604. 

  4605. ! Local
    4606. 

  4606.       INTEGER :: i,j
    4607. 

  4607. 

  4608.       DO j = JTS , JTE
    4609. 

  4609.          DO i = ITS , ITE
    4610. 

  4610.             IF ( ( XICE(i,j) >= XICE_THRESHOLD ) .AND. ( XICE(I,J) <= 1.0 ) ) THEN
    4611. 

  4611.  
    4612. 

  4612.                IF ( SST(i,j) < 271.4 ) THEN
    4613. 

  4613.                   SST(i,j) = 271.4
    4614. 

  4614.                ENDIF
    4615. 

  4615.  
    4616. 

  4616.                IF (sfc_layer_values) THEN
    4617. 

  4617.                   IF ( SST(i,j) > 273. .AND. itimestep <= 3) then
    4618. 

  4618.                      ! Why the dependence on the time step count, here?
    4619. 

  4619.                      IF ( XICE(i,j) >= 0.6 ) THEN
    4620. 

  4620.                         SST(i,j) = 271.4
    4621. 

  4621.                      ELSEIF ( XICE(i,j) >= 0.4 ) THEN
    4622. 

  4622.                         SST(i,j) = 273.
    4623. 

  4623.                      ELSEIF (XICE(i,j) >= 0.2 .AND. SST(i,j) > 275.) THEN
    4624. 

  4624.                         SST(i,j) = 275.
    4625. 

  4625.                      ELSEIF (SST(i,j) > 278.) THEN
    4626. 

  4626.                         SST(i,j) = 278.
    4627. 

  4627.                      ENDIF
    4628. 

  4628.                   ENDIF
    4629. 

  4629.                ENDIF
    4630. 

  4630.                TSK_SEA(i,j) = SST(i,j)
    4631. 

  4631.  
    4632. 

  4632.                IF ( tice2tsk_if2cold ) THEN
    4633. 

  4633. !------------------------------------------------------------------------------------
    4634. 

  4634. ! This avoids unphysically low ice temperatures for grid cells with low ice fractions
    4635. 

  4635. ! and low area-averaged temperatures.  This can happen when the initial ice fraction 
    4636. 

  4636. ! and surface temperature come from different data sets.
    4637. 

  4637. !------------------------------------------------------------------------------------
    4638. 

  4638.                   TSK_ICE(i,j) = MIN( TSK(i,j), 273.15 )
    4639. 

  4639.                ELSE
    4640. 

  4640.                   TSK_ICE(i,j) = ( TSK(i,j) - (1.0-XICE(i,j)) * SST(i,j) ) / XICE(i,j)
    4641. 

  4641.                ENDIF
    4642. 

  4642.  
    4643. 

  4643.                IF ( ( XICE(i,j) < 0.2 ) .AND. ( TSK(i,j) < 253.15 ) ) THEN
    4644. 

  4644.                   TSK_ICE(i,j) = 253.15
    4645. 

  4645.                ENDIF
    4646. 

  4646.                IF ( ( XICE(i,j) < 0.1 ) .AND. ( TSK(i,j) < 263.15 ) ) THEN
    4647. 

  4647.                   TSK_ICE(i,j) = 263.15
    4648. 

  4648.                ENDIF
    4649. 

  4649.             ELSE
    4650. 

  4650.                ! land/open-water point
    4651. 

  4651.                TSK_SEA(i,j) = TSK(i,j)
    4652. 

  4652.                TSK_ICE(i,j) = TSK(i,j)
    4653. 

  4653.             ENDIF
    4654. 

  4654.          ENDDO
    4655. 

  4655.       ENDDO
    4656. 

  4656. 

  4657.    END SUBROUTINE get_local_ice_tsk
    4658. 

  4658. 

  4659. !=======================================================================
    4660. 

  4660. !=======================================================================
    4661. 

  4661. 

  4662. END MODULE module_surface_driver
    4663. 

  4663.