Bug fixes for 32-bit physics & correct the lake scheme in FV3_HRRR_c3 & FV3_HRRR_gf

ccpp/suites/suite_FV3_HRRR_c3.xml

@@ -43,7 +43,7 @@
       <scheme>mynnsfc_wrapper</scheme>
       <scheme>GFS_surface_loop_control_part1</scheme>
       <scheme>lsm_ruc</scheme>
-      <scheme>flake_driver</scheme>
+      <scheme>clm_lake</scheme>
       <scheme>GFS_surface_loop_control_part2</scheme>
     </subcycle>
     <!-- End of surface iteration loop -->

ccpp/suites_not_used/suite_FV3_HRRR_gf.xml → ccpp/suites/suite_FV3_HRRR_gf.xml

@@ -43,7 +43,7 @@
       <scheme>mynnsfc_wrapper</scheme>
       <scheme>GFS_surface_loop_control_part1</scheme>
       <scheme>lsm_ruc</scheme>
-      <scheme>flake_driver</scheme>
+      <scheme>clm_lake</scheme>
       <scheme>GFS_surface_loop_control_part2</scheme>
     </subcycle>
     <!-- End of surface iteration loop -->

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

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

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)