diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index d32be0586..a567f992f 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -14,7 +14,8 @@ module fv3atm_restart_io_mod register_axis, register_restart_field, & register_variable_attribute, register_field, & read_restart, write_restart, write_data, & - get_global_io_domain_indices, get_dimension_size + get_global_io_domain_indices, get_dimension_size, & + global_att_exists, get_global_attribute use mpp_domains_mod, only: domain2d use fv3atm_common_io, only: create_2d_field_and_add_to_bundle, & create_3d_field_and_add_to_bundle, copy_from_gfs_data, axis_type @@ -515,6 +516,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- directory of the input files character(5) :: indir='INPUT' character(37) :: infile + character(2) :: file_ver !--- fms2_io file open logic logical :: amiopen logical :: override_frac_grid @@ -644,8 +646,19 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta amiopen=open_file(Sfc_restart, trim(infile), "read", domain=fv_domain, is_restart=.true., dont_add_res_to_filename=.true.) if( .not.amiopen ) call mpp_error(FATAL, 'Error opening file'//trim(infile)) + if (global_att_exists(Sfc_restart, "file_version")) then + call get_global_attribute(Sfc_restart, "file_version", file_ver) + if (file_ver == "V2") then + sfc%is_v2_file=.true. + endif + endif + if(sfc%allocate_arrays(Model, Atm_block, .true., warm_start)) then - call sfc%fill_2d_names(Model, warm_start) + if (sfc%is_v2_file) then + call sfc%fill_2d_names_v2(Model, warm_start) + else + call sfc%fill_2d_names(Model, warm_start) + endif call sfc%register_axes(Model, Sfc_restart, .true., warm_start) ! Tell CLM Lake to allocate data, and register its axes and fields diff --git a/io/fv3atm_sfc_io.F90 b/io/fv3atm_sfc_io.F90 index c0bfcf6d9..95957682a 100644 --- a/io/fv3atm_sfc_io.F90 +++ b/io/fv3atm_sfc_io.F90 @@ -21,7 +21,8 @@ module fv3atm_sfc_io private public :: Sfc_io_data_type - public :: Sfc_io_fill_2d_names, Sfc_io_fill_3d_names, Sfc_io_allocate_arrays, & + public :: Sfc_io_fill_2d_names, Sfc_io_fill_2d_names_v2, & + Sfc_io_fill_3d_names, Sfc_io_allocate_arrays, & Sfc_io_register_axes, Sfc_io_write_axes, Sfc_io_register_2d_fields, & Sfc_io_register_3d_fields, Sfc_io_copy_to_grid, Sfc_io_copy_from_grid, & Sfc_io_apply_safeguards, Sfc_io_transfer, Sfc_io_final @@ -49,6 +50,8 @@ module fv3atm_sfc_io ! The lsoil flag is only meaningful when reading:; logical, public :: is_lsoil = .false. + logical, public :: is_v2_file = .false. + ! SYNONYMS: Some nvar variables had two names in fv3atm_io.F90. They have ! only one name here. The "_s" is redundant because this file only has ! surface restart variables. @@ -79,6 +82,7 @@ module fv3atm_sfc_io procedure, public :: bundle_2d_fields => Sfc_io_bundle_2d_fields procedure, public :: bundle_3d_fields => Sfc_io_bundle_3d_fields procedure, public :: fill_2d_names => Sfc_io_fill_2d_names + procedure, public :: fill_2d_names_v2 => Sfc_io_fill_2d_names_v2 procedure, public :: fill_3d_names => Sfc_io_fill_3d_names procedure, public :: init_fields => Sfc_io_init_fields procedure, public :: transfer => Sfc_io_transfer @@ -558,6 +562,174 @@ subroutine Sfc_io_fill_2d_names(sfc,Model,warm_start) endif end subroutine Sfc_io_fill_2d_names + !>@ Fills the name2d array with all surface 2D field names. Updates nvar2m if needed. + !! This routine is for v2 coldstart files. + subroutine Sfc_io_fill_2d_names_v2(sfc,Model,warm_start) + implicit none + class(Sfc_io_data_type) :: sfc + type(GFS_control_type), intent(in) :: Model + logical, intent(in) :: warm_start + integer :: nt + + !--- names of the 2D variables to save + nt=0 + nt=nt+1 ; sfc%name2(nt) = 'slmsk' + nt=nt+1 ; sfc%name2(nt) = 'tsea' ! tsfc + nt=nt+1 ; sfc%name2(nt) = 'sheleg' ! weasd in file. Optional for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'tg3' + nt=nt+1 ; sfc%name2(nt) = 'zorl' ! Optional for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'alvsf' + nt=nt+1 ; sfc%name2(nt) = 'alvwf' + nt=nt+1 ; sfc%name2(nt) = 'alnsf' + nt=nt+1 ; sfc%name2(nt) = 'alnwf' + nt=nt+1 ; sfc%name2(nt) = 'facsf' + nt=nt+1 ; sfc%name2(nt) = 'facwf' + nt=nt+1 ; sfc%name2(nt) = 'vfrac' + nt=nt+1 ; sfc%name2(nt) = 'canopy' + nt=nt+1 ; sfc%name2(nt) = 'f10m' + nt=nt+1 ; sfc%name2(nt) = 't2m' + nt=nt+1 ; sfc%name2(nt) = 'q2m' + nt=nt+1 ; sfc%name2(nt) = 'vtype' + nt=nt+1 ; sfc%name2(nt) = 'stype' + nt=nt+1 ; sfc%name2(nt) = 'uustar' + nt=nt+1 ; sfc%name2(nt) = 'ffmm' + nt=nt+1 ; sfc%name2(nt) = 'ffhh' + nt=nt+1 ; sfc%name2(nt) = 'hice' + nt=nt+1 ; sfc%name2(nt) = 'fice' + nt=nt+1 ; sfc%name2(nt) = 'tisfc' + nt=nt+1 ; sfc%name2(nt) = 'tprcp' + nt=nt+1 ; sfc%name2(nt) = 'srflag' + nt=nt+1 ; sfc%name2(nt) = 'snwdph' ! snowd in file. Optional for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'shdmin' + nt=nt+1 ; sfc%name2(nt) = 'shdmax' + nt=nt+1 ; sfc%name2(nt) = 'slope' + nt=nt+1 ; sfc%name2(nt) = 'snoalb' + !--- variables below here are optional, unless indicated. + nt=nt+1 ; sfc%name2(nt) = 'scolor' + nt=nt+1 ; sfc%name2(nt) = 'sncovr' + nt=nt+1 ; sfc%name2(nt) = 'snodl' ! snowd on land portion of a cell. + ! Mandatory for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'weasdl'! weasd on land portion of a cell. + ! Mandatory for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'tsfc' ! tsfc composite + nt=nt+1 ; sfc%name2(nt) = 'tsfcl' ! temp on land portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'zorlw' ! zorl on water portion of a cell + ! Mandatory for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'zorll' ! zorl on land portion of a cell + nt=nt+1 ; sfc%name2(nt) = 'zorli' ! zorl on ice portion of a cell + ! Mandatory for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'albdirvis_lnd' + nt=nt+1 ; sfc%name2(nt) = 'albdirnir_lnd' + nt=nt+1 ; sfc%name2(nt) = 'albdifvis_lnd' + nt=nt+1 ; sfc%name2(nt) = 'albdifnir_lnd' + nt=nt+1 ; sfc%name2(nt) = 'emis_lnd' + nt=nt+1 ; sfc%name2(nt) = 'emis_ice' + nt=nt+1 ; sfc%name2(nt) = 'sncovr_ice' + nt=nt+1 ; sfc%name2(nt) = 'snodi' ! snowd on ice portion of a cell. + ! Mandatory for cold starts. + nt=nt+1 ; sfc%name2(nt) = 'weasdi'! weasd on ice portion of a cell + ! Mandatory for cold starts. + + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then + nt=nt+1 ; sfc%name2(nt) = 'albdirvis_ice' + nt=nt+1 ; sfc%name2(nt) = 'albdifvis_ice' + nt=nt+1 ; sfc%name2(nt) = 'albdirnir_ice' + nt=nt+1 ; sfc%name2(nt) = 'albdifnir_ice' + endif + + if(Model%cplwav) then + nt=nt+1 ; sfc%name2(nt) = 'zorlwav' !zorl from wave component + sfc%nvar2m = nt + endif + + if (Model%nstf_name(1) > 0) then + !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) + nt=nt+1 ; sfc%name2(nt) = 'tref' + nt=nt+1 ; sfc%name2(nt) = 'z_c' + nt=nt+1 ; sfc%name2(nt) = 'c_0' + nt=nt+1 ; sfc%name2(nt) = 'c_d' + nt=nt+1 ; sfc%name2(nt) = 'w_0' + nt=nt+1 ; sfc%name2(nt) = 'w_d' + nt=nt+1 ; sfc%name2(nt) = 'xt' + nt=nt+1 ; sfc%name2(nt) = 'xs' + nt=nt+1 ; sfc%name2(nt) = 'xu' + nt=nt+1 ; sfc%name2(nt) = 'xv' + nt=nt+1 ; sfc%name2(nt) = 'xz' + nt=nt+1 ; sfc%name2(nt) = 'zm' + nt=nt+1 ; sfc%name2(nt) = 'xtts' + nt=nt+1 ; sfc%name2(nt) = 'xzts' + nt=nt+1 ; sfc%name2(nt) = 'd_conv' + nt=nt+1 ; sfc%name2(nt) = 'ifd' + nt=nt+1 ; sfc%name2(nt) = 'dt_cool' + nt=nt+1 ; sfc%name2(nt) = 'qrain' + endif + ! + ! Only needed when Noah MP LSM is used - 29 2D + ! + if (Model%lsm == Model%lsm_noahmp) then + nt=nt+1 ; sfc%name2(nt) = 'snowxy' + nt=nt+1 ; sfc%name2(nt) = 'tvxy' + nt=nt+1 ; sfc%name2(nt) = 'tgxy' + nt=nt+1 ; sfc%name2(nt) = 'canicexy' + nt=nt+1 ; sfc%name2(nt) = 'canliqxy' + nt=nt+1 ; sfc%name2(nt) = 'eahxy' + nt=nt+1 ; sfc%name2(nt) = 'tahxy' + nt=nt+1 ; sfc%name2(nt) = 'cmxy' + nt=nt+1 ; sfc%name2(nt) = 'chxy' + nt=nt+1 ; sfc%name2(nt) = 'fwetxy' + nt=nt+1 ; sfc%name2(nt) = 'sneqvoxy' + nt=nt+1 ; sfc%name2(nt) = 'alboldxy' + nt=nt+1 ; sfc%name2(nt) = 'qsnowxy' + nt=nt+1 ; sfc%name2(nt) = 'wslakexy' + nt=nt+1 ; sfc%name2(nt) = 'zwtxy' + nt=nt+1 ; sfc%name2(nt) = 'waxy' + nt=nt+1 ; sfc%name2(nt) = 'wtxy' + nt=nt+1 ; sfc%name2(nt) = 'lfmassxy' + nt=nt+1 ; sfc%name2(nt) = 'rtmassxy' + nt=nt+1 ; sfc%name2(nt) = 'stmassxy' + nt=nt+1 ; sfc%name2(nt) = 'woodxy' + nt=nt+1 ; sfc%name2(nt) = 'stblcpxy' + nt=nt+1 ; sfc%name2(nt) = 'fastcpxy' + nt=nt+1 ; sfc%name2(nt) = 'xsaixy' + nt=nt+1 ; sfc%name2(nt) = 'xlaixy' + nt=nt+1 ; sfc%name2(nt) = 'taussxy' + nt=nt+1 ; sfc%name2(nt) = 'smcwtdxy' + nt=nt+1 ; sfc%name2(nt) = 'deeprechxy' + nt=nt+1 ; sfc%name2(nt) = 'rechxy' + else if (Model%lsm == Model%lsm_ruc .and. warm_start) then + nt=nt+1 ; sfc%name2(nt) = 'wetness' + nt=nt+1 ; sfc%name2(nt) = 'clw_surf_land' + nt=nt+1 ; sfc%name2(nt) = 'clw_surf_ice' + nt=nt+1 ; sfc%name2(nt) = 'qwv_surf_land' + nt=nt+1 ; sfc%name2(nt) = 'qwv_surf_ice' + nt=nt+1 ; sfc%name2(nt) = 'tsnow_land' + nt=nt+1 ; sfc%name2(nt) = 'tsnow_ice' + nt=nt+1 ; sfc%name2(nt) = 'snowfall_acc_land' + nt=nt+1 ; sfc%name2(nt) = 'snowfall_acc_ice' + nt=nt+1 ; sfc%name2(nt) = 'sfalb_lnd' + nt=nt+1 ; sfc%name2(nt) = 'sfalb_lnd_bck' + nt=nt+1 ; sfc%name2(nt) = 'sfalb_ice' + if (Model%rdlai) then + nt=nt+1 ; sfc%name2(nt) = 'lai' + endif + else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then + nt=nt+1 ; sfc%name2(nt) = 'lai' + endif + + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + nt=nt+1 ; sfc%name2(nt) = 'T_snow' + nt=nt+1 ; sfc%name2(nt) = 'T_ice' + nt=nt+1 ; sfc%name2(nt) = 'h_ML' + nt=nt+1 ; sfc%name2(nt) = 't_ML' + nt=nt+1 ; sfc%name2(nt) = 't_mnw' + nt=nt+1 ; sfc%name2(nt) = 'h_talb' + nt=nt+1 ; sfc%name2(nt) = 't_talb' + nt=nt+1 ; sfc%name2(nt) = 't_bot1' + nt=nt+1 ; sfc%name2(nt) = 't_bot2' + nt=nt+1 ; sfc%name2(nt) = 'c_t' + endif + end subroutine Sfc_io_fill_2d_names_v2 + !>@ Registers 2D fields with FMS for reading or writing non-quilt restart files subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) implicit none @@ -590,33 +762,62 @@ subroutine Sfc_io_register_2d_fields(sfc,Model,Sfc_restart,reading,warm_start) endif !--- register the 2D fields - do num = 1,sfc%nvar2m - var2_p => sfc%var2(:,:,num) - if (trim(sfc%name2(num)) == 'sncovr' .or. trim(sfc%name2(num)) == 'tsfcl' .or. trim(sfc%name2(num)) == 'zorll' & - .or. trim(sfc%name2(num)) == 'zorli' .or. trim(sfc%name2(num)) == 'zorlwav' & - .or. trim(sfc%name2(num)) == 'snodl' .or. trim(sfc%name2(num)) == 'weasdl' & - .or. trim(sfc%name2(num)) == 'snodi' .or. trim(sfc%name2(num)) == 'weasdi' & - .or. trim(sfc%name2(num)) == 'tsfc' .or. trim(sfc%name2(num)) == 'zorlw' & + if (sfc%is_v2_file) then + do num = 1,sfc%nvar2m + var2_p => sfc%var2(:,:,num) + if (trim(sfc%name2(num)) == 'sncovr' .or. trim(sfc%name2(num)) == 'zorll' & + .or. trim(sfc%name2(num)) == 'zorl' .or. trim(sfc%name2(num)) == 'zorlwav' & + .or. trim(sfc%name2(num)) == 'snwdph' .or. trim(sfc%name2(num)) == 'sheleg' & + .or. trim(sfc%name2(num)) == 'tsfc' & .or. trim(sfc%name2(num)) == 'albdirvis_lnd' .or. trim(sfc%name2(num)) == 'albdirnir_lnd' & .or. trim(sfc%name2(num)) == 'albdifvis_lnd' .or. trim(sfc%name2(num)) == 'albdifnir_lnd' & .or. trim(sfc%name2(num)) == 'albdirvis_ice' .or. trim(sfc%name2(num)) == 'albdirnir_ice' & .or. trim(sfc%name2(num)) == 'albdifvis_ice' .or. trim(sfc%name2(num)) == 'albdifnir_ice' & .or. trim(sfc%name2(num)) == 'emis_lnd' .or. trim(sfc%name2(num)) == 'emis_ice' & .or. trim(sfc%name2(num)) == 'sncovr_ice' .or. trim(sfc%name2(num)) == 'scolor') then - if(reading .and. sfc%is_lsoil) then - call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + if(reading .and. sfc%is_lsoil) then + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d,& + & chunksizes=chunksizes2d, is_optional=.true.) + end if else - call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d,& + if(reading .and. sfc%is_lsoil) then + call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=(/'lat','lon'/)) + else + call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=time2d, chunksizes=chunksizes2d) + end if + endif + enddo + else + do num = 1,sfc%nvar2m + var2_p => sfc%var2(:,:,num) + if (trim(sfc%name2(num)) == 'sncovr' .or. trim(sfc%name2(num)) == 'tsfcl' .or. trim(sfc%name2(num)) == 'zorll' & + .or. trim(sfc%name2(num)) == 'zorli' .or. trim(sfc%name2(num)) == 'zorlwav' & + .or. trim(sfc%name2(num)) == 'snodl' .or. trim(sfc%name2(num)) == 'weasdl' & + .or. trim(sfc%name2(num)) == 'snodi' .or. trim(sfc%name2(num)) == 'weasdi' & + .or. trim(sfc%name2(num)) == 'tsfc' .or. trim(sfc%name2(num)) == 'zorlw' & + .or. trim(sfc%name2(num)) == 'albdirvis_lnd' .or. trim(sfc%name2(num)) == 'albdirnir_lnd' & + .or. trim(sfc%name2(num)) == 'albdifvis_lnd' .or. trim(sfc%name2(num)) == 'albdifnir_lnd' & + .or. trim(sfc%name2(num)) == 'albdirvis_ice' .or. trim(sfc%name2(num)) == 'albdirnir_ice' & + .or. trim(sfc%name2(num)) == 'albdifvis_ice' .or. trim(sfc%name2(num)) == 'albdifnir_ice' & + .or. trim(sfc%name2(num)) == 'emis_lnd' .or. trim(sfc%name2(num)) == 'emis_ice' & + .or. trim(sfc%name2(num)) == 'sncovr_ice' .or. trim(sfc%name2(num)) == 'scolor') then + if(reading .and. sfc%is_lsoil) then + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) + else + call register_restart_field(Sfc_restart, sfc%name2(num), var2_p, dimensions=time2d,& & chunksizes=chunksizes2d, is_optional=.true.) - end if - else - if(reading .and. sfc%is_lsoil) then - call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=(/'lat','lon'/)) + end if else - call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=time2d, chunksizes=chunksizes2d) - end if - endif - enddo + if(reading .and. sfc%is_lsoil) then + call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=(/'lat','lon'/)) + else + call register_restart_field(Sfc_restart,sfc%name2(num),var2_p, dimensions=time2d, chunksizes=chunksizes2d) + end if + endif + enddo + endif if (Model%nstf_name(1) > 0) then mand = .false. @@ -702,7 +903,11 @@ subroutine Sfc_io_register_3d_fields(sfc,Model,Sfc_restart,reading,warm_start) !--- register the 3D fields var3_p => sfc%var3ice(:,:,:) - call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d, is_optional=.true.) + if (sfc%is_v2_file) then + call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d, is_optional=.false.) + else + call register_restart_field(Sfc_restart, sfc%name3(0), var3_p, dimensions=xyz1_time, chunksizes=chunksizes3d, is_optional=.true.) + endif if(reading) then do num = 1,sfc%nvar3 @@ -1309,6 +1514,157 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif + if (sfc%is_v2_file) then + + if (sfc%var2(i,j,27) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snowd') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + Sfcprop(nb)%snowd(ix) = Sfcprop(nb)%snodi(ix) + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%snowd(ix) = Sfcprop(nb)%snodl(ix) + else + Sfcprop(nb)%snowd(ix) = zero + endif + enddo + enddo + endif + + if (sfc%var2(i,j,3) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing weasd') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + Sfcprop(nb)%weasd(ix) = Sfcprop(nb)%weasdi(ix) + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%weasd(ix) = Sfcprop(nb)%weasdl(ix) + else + Sfcprop(nb)%weasd(ix) = zero + endif + enddo + enddo + endif + +! Needed for first time step in radiation before Noah/NoahMP sets it from look up table. +! Just use a nominal value. + if (sfc%var2(i,j,39) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorll') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%zorll(ix) = 25.0 + endif + enddo + enddo + endif + + if (sfc%var2(i,j,5) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorl') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%fice(ix) > zero) then + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) + elseif (Sfcprop(nb)%landfrac(ix) > zero) then + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix) + else + Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlw(ix) + endif + enddo + enddo + endif + + if (sfc%var2(i,j,46) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing emis_ice') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%emis_ice(ix) = 0.96 + enddo + enddo + endif + + if (sfc%var2(i,j,47) < -9990.0_kind_phys .and. Model%lsm /= Model%lsm_ruc) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing sncovr_ice') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + ! Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) + Sfcprop(nb)%sncovr_ice(ix) = zero + enddo + enddo + endif + + if (Model%use_cice_alb) then + if (sfc%var2(i,j,50) < -9990.0_kind_phys) then + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%oceanfrac(ix) > zero .and. & + Sfcprop(nb)%fice(ix) >= Model%min_seaice) then + Sfcprop(nb)%albdirvis_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdifvis_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdirnir_ice(ix) = 0.6_kind_phys + Sfcprop(nb)%albdifnir_ice(ix) = 0.6_kind_phys + endif + enddo + enddo + endif + + endif + + ! Fill in composite tsfc for coldstart runs - must happen after tsfcl is computed + compute_tsfc_for_coldstart: if (sfc%var2(i,j,36) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing composite tsfc') + if(Model%frac_grid) then ! 3-way composite + !$omp parallel do default(shared) private(nb, ix, tem, tem1) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%tsfco(ix) = max(con_tice, Sfcprop(nb)%tsfco(ix)) ! this may break restart reproducibility + tem1 = one - Sfcprop(nb)%landfrac(ix) + tem = tem1 * Sfcprop(nb)%fice(ix) ! tem = ice fraction wrt whole cell + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) * Sfcprop(nb)%landfrac(ix) & + + Sfcprop(nb)%tisfc(ix) * tem & + + Sfcprop(nb)%tsfco(ix) * (tem1-tem) + enddo + enddo + else + !$omp parallel do default(shared) private(nb, ix, tem) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + if (Sfcprop(nb)%slmsk(ix) == 1) then + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix) + if (Sfcprop(nb)%tsfc(ix) < -99 .or. Sfcprop(nb)%tsfc(ix) > 999.) print*,'bad tsfc land ',nb,ix,Sfcprop(nb)%tsfcl(ix) + elseif(Sfcprop(nb)%fice(ix) > 0.0)then + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) + if (Sfcprop(nb)%tsfc(ix) < -99 .or. Sfcprop(nb)%tsfc(ix) > 999.) print*,'bad tsfc ice ',nb,ix,Sfcprop(nb)%tisfc(ix) + else + Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix) + if (Sfcprop(nb)%tsfc(ix) < -99 .or. Sfcprop(nb)%tsfc(ix) > 999.) print*,'bad tsfc water ',nb,ix,Sfcprop(nb)%tsfco(ix) + endif + enddo + enddo + endif + endif compute_tsfc_for_coldstart + + if (sfc%var2(i,j,sfc%nvar2m) < -9990.0_kind_phys) then + if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing zorlwav') + !$omp parallel do default(shared) private(nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorl(ix) !--- compute zorlwav from existing variables + enddo + enddo + endif + + + else ! old verion of coldstart file + + if (sfc%var2(i,j,34) < -9990.0_kind_phys) then if (Model%me == Model%master ) call mpp_error(NOTE, 'gfs_driver::surface_props_input - computing snodl') !$omp parallel do default(shared) private(nb, ix, tem) @@ -1503,6 +1859,8 @@ subroutine Sfc_io_apply_safeguards(sfc, Model, Atm_block, Sfcprop) enddo endif + endif ! check on which version of the surface file. + end subroutine Sfc_io_apply_safeguards !>@ destructor for Sfc_io_data_type