diff --git a/ccpp/suites/suite_FV3_HRRR_c3.xml b/ccpp/suites/suite_FV3_HRRR_c3.xml index ec55ee1ec..fe4feedc7 100644 --- a/ccpp/suites/suite_FV3_HRRR_c3.xml +++ b/ccpp/suites/suite_FV3_HRRR_c3.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml b/ccpp/suites/suite_FV3_HRRR_gf.xml similarity index 98% rename from ccpp/suites_not_used/suite_FV3_HRRR_gf.xml rename to ccpp/suites/suite_FV3_HRRR_gf.xml index f8aade231..7e594e621 100644 --- a/ccpp/suites_not_used/suite_FV3_HRRR_gf.xml +++ b/ccpp/suites/suite_FV3_HRRR_gf.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/io/fv3atm_clm_lake_io.F90 b/io/fv3atm_clm_lake_io.F90 index 5c61a26be..80c7bb586 100644 --- a/io/fv3atm_clm_lake_io.F90 +++ b/io/fv3atm_clm_lake_io.F90 @@ -22,7 +22,7 @@ module fv3atm_clm_lake_io public :: clm_lake_data_type, clm_lake_register_axes, clm_lake_allocate_data, & clm_lake_register_fields, clm_lake_deallocate_data, clm_lake_write_axes, & clm_lake_copy_from_grid, clm_lake_copy_to_grid, clm_lake_bundle_fields, & - clm_lake_final + clm_lake_final, clm_lake_fill_data !>\defgroup CLM Lake Model restart public interface !> @{ @@ -73,6 +73,9 @@ module fv3atm_clm_lake_io ! each axis, containing the appropriate information procedure, public :: write_axes => clm_lake_write_axes + ! fills internal arrays with zero: + procedure, public :: fill_data => clm_lake_fill_data + ! copy_from_grid copies from Sfcprop to internal pointers (declared above) procedure, public :: copy_from_grid => clm_lake_copy_from_grid @@ -194,6 +197,61 @@ subroutine clm_lake_write_axes(clm_lake, Model, Sfc_restart) call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', clm_lake%levsnowsoil1_clm_lake) end subroutine clm_lake_write_axes + !>@ This is clm_lake%fill_data. It fills internal arrays with zero + !! Terrible things will happen if you don't call + !! clm_lake%allocate_data first. + subroutine clm_lake_fill_data(clm_lake, Model, Atm_block, Sfcprop) + implicit none + class(clm_lake_data_type) :: clm_lake + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + real(kind_phys), parameter :: zero = 0 + integer :: nb, ix, isc, jsc, i, j + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + + !$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + clm_lake%T_snow(i,j) = zero + clm_lake%T_ice(i,j) = zero + clm_lake%lake_snl2d(i,j) = zero + clm_lake%lake_h2osno2d(i,j) = zero + clm_lake%lake_tsfc(i,j) = zero + clm_lake%lake_savedtke12d(i,j) = zero + clm_lake%lake_sndpth2d(i,j) = zero + clm_lake%clm_lakedepth(i,j) = zero + clm_lake%clm_lake_initialized(i,j) = zero + + clm_lake%lake_z3d(i,j,:) = zero + clm_lake%lake_dz3d(i,j,:) = zero + clm_lake%lake_soil_watsat3d(i,j,:) = zero + clm_lake%lake_csol3d(i,j,:) = zero + clm_lake%lake_soil_tkmg3d(i,j,:) = zero + clm_lake%lake_soil_tkdry3d(i,j,:) = zero + clm_lake%lake_soil_tksatu3d(i,j,:) = zero + clm_lake%lake_snow_z3d(i,j,:) = zero + clm_lake%lake_snow_dz3d(i,j,:) = zero + clm_lake%lake_snow_zi3d(i,j,:) = zero + clm_lake%lake_h2osoi_vol3d(i,j,:) = zero + clm_lake%lake_h2osoi_liq3d(i,j,:) = zero + clm_lake%lake_h2osoi_ice3d(i,j,:) = zero + clm_lake%lake_t_soisno3d(i,j,:) = zero + clm_lake%lake_t_lake3d(i,j,:) = zero + clm_lake%lake_icefrac3d(i,j,:) = zero + clm_lake%lake_clay3d(i,j,:) = zero + clm_lake%lake_sand3d(i,j,:) = zero + enddo + enddo + end subroutine clm_lake_fill_data + !>@ This is clm_lake%copy_from_grid. It copies from Sfcprop !! variables to the corresponding data temporary variables. !! Terrible things will happen if you don't call diff --git a/io/fv3atm_restart_io.F90 b/io/fv3atm_restart_io.F90 index ccdc6d719..487722601 100644 --- a/io/fv3atm_restart_io.F90 +++ b/io/fv3atm_restart_io.F90 @@ -651,6 +651,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! Tell CLM Lake to allocate data, and register its axes and fields if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) + call clm_lake%fill_data(Model,Atm_block,Sfcprop) call clm_lake%copy_from_grid(Model,Atm_block,Sfcprop) call clm_lake%register_axes(Model, Sfc_restart) call clm_lake%register_fields(Sfc_restart) @@ -985,10 +986,12 @@ subroutine fv3atm_restart_register (Sfcprop, GFS_restart, Atm_block, Model) if(Model%iopt_lake == 2 .and. Model%lkm > 0) then call clm_lake_quilt%allocate_data(Model) + call clm_lake_quilt%fill_data(Model, Atm_block, Sfcprop) endif if(Model%rrfs_sd) then call rrfs_sd_quilt%allocate_data(Model) + call rrfs_sd_quilt%fill_data(Model, Atm_block, Sfcprop) endif end subroutine fv3atm_restart_register diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 97dcf2d1b..c8fc139e2 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -2040,13 +2040,10 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif -!recover fields from cartesian vector and sfc pressure + !recover fields from cartesian vector and sfc pressure call recover_fields(file_bundle,rc) - ! FIXME rrfs_smoke_conus13km_fast_phy32_qr crashes with teh following error in recover_fields - ! 20230720 121647.816 ERROR PET147 ESMF_Grid.F90:20442 ESMF_GridGetCoord2DR8 Arguments are incompatible - - farrayPtr typekind does not match Grid typekind - ! 20230720 121647.816 ERROR PET147 module_wrt_grid_comp.F90:2450 Arguments are incompatible - Passing error in return code + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return enddo ! !----------------------------------------------------------------------- @@ -2485,6 +2482,7 @@ subroutine recover_fields(file_bundle,rc) type(ESMF_TypeKind_Flag) typekind character(100) fieldName,uwindname,vwindname type(ESMF_Field), allocatable :: fcstField(:) + real(ESMF_KIND_R4), dimension(:,:), pointer :: lonr4, latr4 real(ESMF_KIND_R8), dimension(:,:), pointer :: lon, lat real(ESMF_KIND_R8), dimension(:,:), pointer :: lonloc, latloc real(ESMF_KIND_R4), dimension(:,:), pointer :: pressfc @@ -2493,6 +2491,8 @@ subroutine recover_fields(file_bundle,rc) real(ESMF_KIND_R4), dimension(:,:,:), pointer :: cart3dPtr2dr4 real(ESMF_KIND_R4), dimension(:,:,:,:), pointer :: cart3dPtr3dr4 real(ESMF_KIND_R8) :: coslon, sinlon, sinlat + + type(ESMF_Array) :: lon_array, lat_array ! ! get filed count call ESMF_FieldBundleGet(file_bundle, fieldCount=fieldCount, rc=rc) @@ -2510,10 +2510,26 @@ subroutine recover_fields(file_bundle,rc) call ESMF_LogWrite("call recover field get coord 1",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) - + call ESMF_GridGetCoord(fieldgrid, coordDim=1, array=lon_array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(lon_array, typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lonr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(lon(lbound(lonr4,1):ubound(lonr4,1),lbound(lonr4,2):ubound(lonr4,2))) + lon = lonr4 + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(fieldgrid, coordDim=1, farrayPtr=lon, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + write(0,*)'lon_array unknown typekind' + rc = 1 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + allocate(lonloc(lbound(lon,1):ubound(lon,1),lbound(lon,2):ubound(lon,2))) istart = lbound(lon,1) iend = ubound(lon,1) @@ -2529,9 +2545,24 @@ subroutine recover_fields(file_bundle,rc) call ESMF_LogWrite("call recover field get coord 2",ESMF_LOGMSG_INFO,rc=RC) - call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) - + call ESMF_GridGetCoord(fieldgrid, coordDim=2, array=lat_array, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ArrayGet(lat_array, typekind=typekind, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (typekind == ESMF_TYPEKIND_R4) then + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=latr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(lat(lbound(latr4,1):ubound(latr4,1),lbound(latr4,2):ubound(latr4,2))) + lat = latr4 + else if (typekind == ESMF_TYPEKIND_R8) then + call ESMF_GridGetCoord(fieldgrid, coordDim=2, farrayPtr=lat, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + write(0,*)'lon_array unknown typekind' + rc = 1 + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif allocate(latloc(lbound(lat,1):ubound(lat,1),lbound(lat,2):ubound(lat,2))) istart = lbound(lat,1)