From e905cce52f7327ad3e093de7eb3151dd1c893d81 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 4 Aug 2023 15:40:53 +0000 Subject: [PATCH 1/6] fix fortran coding error in dynamical core --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 49f15ecbb..b8baff3c2 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 49f15ecbbc16405025fae8d672dced19c2073d9e +Subproject commit b8baff3c2cd77ccc46c53754e5d7b3425eb1eac2 From 1d8434e30b03a0b061c8acce3bb9461bf820427b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 4 Aug 2023 15:41:12 +0000 Subject: [PATCH 2/6] use clm lake in fv3_hrrr_c3 --- ccpp/suites/suite_FV3_HRRR_c3.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From 01995d27c1b8904811427bb16e8ebc439a673118 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 4 Aug 2023 15:42:01 +0000 Subject: [PATCH 3/6] initialize arrays after allocation --- io/fv3atm_clm_lake_io.F90 | 60 ++++++++++++++++++++++++++++++++++++++- io/fv3atm_restart_io.F90 | 3 ++ 2 files changed, 62 insertions(+), 1 deletion(-) 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 From 1b1ec61526a82dd8872e12a1873a4e2635130650 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 4 Aug 2023 15:43:27 +0000 Subject: [PATCH 4/6] ressurect FV3_HRRR_gf suite and give it the clm lake model --- ccpp/{suites_not_used => suites}/suite_FV3_HRRR_gf.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) rename ccpp/{suites_not_used => suites}/suite_FV3_HRRR_gf.xml (98%) 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 From 2d9fbed2b434c5056eaadb5c39af6097f2cee7ab Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 24 Aug 2023 00:11:08 +0000 Subject: [PATCH 5/6] bug fix from Dusan to use the correct type kind when reading lan & lon in quilt server --- io/module_wrt_grid_comp.F90 | 46 +++++++++++++++++++++++++++++++++---- 1 file changed, 41 insertions(+), 5 deletions(-) diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 3cd17002f..9b9804882 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -1977,8 +1977,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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo ! !----------------------------------------------------------------------- @@ -2416,6 +2418,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 @@ -2424,6 +2427,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, & @@ -2437,9 +2442,25 @@ 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) @@ -2456,10 +2477,25 @@ 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) iend = ubound(lat,1) From e32ed73d5e0e4ba51014fc0c1157d01e12b94573 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 24 Aug 2023 13:15:35 +0000 Subject: [PATCH 6/6] revert bug fix to avoid a GFDL_atmos_cubed_sphere PR --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index b8baff3c2..49f15ecbb 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit b8baff3c2cd77ccc46c53754e5d7b3425eb1eac2 +Subproject commit 49f15ecbbc16405025fae8d672dced19c2073d9e