From fae9bc25629b8518f416fcc333b57c128cf5c6b9 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 18 Mar 2024 09:15:06 -0600 Subject: [PATCH 1/9] Updates of ccpp-framework and ccpp-physics (merge ccpp-framework feature/capgen into main/20240308) (#796) * Update ccpp-framework and ccpp-physics for the prep of capgen transition * In ccpp/data/GFS_typedefs.meta: change units 'flashes 5 min-1' to 'flashes min-1' and update long name to make clear this is per 5 minutes * In ccpp/driver/GFS_diagnostics.F90, scale lightning threat from flashes per minute to flashes per 5 minutes to match diagnostic units * Fix wrong long names for lightning threat indices in ccpp/data/GFS_typedefs.meta --- ccpp/data/GFS_typedefs.meta | 6 +++--- ccpp/driver/GFS_diagnostics.F90 | 6 ++++++ ccpp/framework | 2 +- ccpp/physics | 2 +- 4 files changed, 11 insertions(+), 5 deletions(-) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 497c3c786..f7b9239da 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -9954,7 +9954,7 @@ [ltg1_max] standard_name = lightning_threat_index_1 long_name = lightning threat index 1 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -9963,7 +9963,7 @@ [ltg2_max] standard_name = lightning_threat_index_2 long_name = lightning threat index 2 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -9972,7 +9972,7 @@ [ltg3_max] standard_name = lightning_threat_index_3 long_name = lightning threat index 3 - units = flashes 5 min-1 + units = flashes min-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index a96ac1197..68f89ae89 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -5071,6 +5071,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Max Lightning Threat 1' ExtDiag(idx)%unit = 'flashes/(5 min)' ExtDiag(idx)%mod_name = 'gfs_sfc' + ! CCPP physics units are flashes per minute + ExtDiag(idx)%cnvfac = 5.0_kind_phys allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ltg1_max @@ -5082,6 +5084,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Max Lightning Threat 2' ExtDiag(idx)%unit = 'flashes/(5 min)' ExtDiag(idx)%mod_name = 'gfs_sfc' + ! CCPP physics units are flashes per minute + ExtDiag(idx)%cnvfac = 5.0_kind_phys allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ltg2_max @@ -5093,6 +5097,8 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%desc = 'Max Lightning Threat 3' ExtDiag(idx)%unit = 'flashes/(5 min)' ExtDiag(idx)%mod_name = 'gfs_sfc' + ! CCPP physics units are flashes per minute + ExtDiag(idx)%cnvfac = 5.0_kind_phys allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%ltg3_max diff --git a/ccpp/framework b/ccpp/framework index 221788f4e..f1db41531 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit 221788f4e2539af797eb02efe42465b153533201 +Subproject commit f1db41531c772cc60b71296334e0a9616e8b4a91 diff --git a/ccpp/physics b/ccpp/physics index 8dff959bc..9f4a96bcf 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 8dff959bc1762dc46d14c3d277e38c689fe3152d +Subproject commit 9f4a96bcfb18c19336e308b41d8c8cb11a347c48 From 694227094198b8c1fe101af22dc506e9aeff9ebe Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Tue, 19 Mar 2024 17:18:20 -0400 Subject: [PATCH 2/9] Fix type mismatch compiler error when gfortran 10 is used without '-fallow-argument-mismatch' flag (#770) * Resolve argument mismatch errors when using gfortran * Switch from 'use mpi' to 'use mpi_f08' * More argument mismatch fixes * Merge Dom's ccpp-framework and ccpp-physics feature/depend_on_mpi braches * Check output_grid type and inline post compatibility * If output grid is 'cubed_sphere_grid' AND inline post is turned on print error and terminate the model. * Use type(MPI_Comm) in io/module_wrt_grid_comp.F90 --- CMakeLists.txt | 1 + atmos_model.F90 | 2 +- ccpp/config/ccpp_prebuild_config.py | 1 + ccpp/data/GFS_typedefs.F90 | 28 +++++++--------------------- ccpp/data/GFS_typedefs.meta | 2 +- ccpp/framework | 2 +- ccpp/physics | 2 +- io/module_write_netcdf.F90 | 10 ++++++---- io/module_write_restart_netcdf.F90 | 8 ++++---- io/module_wrt_grid_comp.F90 | 20 +++++++++++++------- io/post_fv3.F90 | 6 +++--- module_fcst_grid_comp.F90 | 6 +++--- module_fv3_config.F90 | 5 +++-- 13 files changed, 45 insertions(+), 48 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 5d0dcf6f6..eede1ef1e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -22,6 +22,7 @@ endif() ### CCPP ############################################################################### +set(MPI ON) add_subdirectory(ccpp) ############################################################################### diff --git a/atmos_model.F90 b/atmos_model.F90 index 3f5de6b2c..6a0834c65 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -450,7 +450,7 @@ end subroutine update_atmos_radiation_physics ! variable type are allocated for the global grid (without halo regions). ! subroutine atmos_timestep_diagnostics(Atmos) - use mpi + use mpi_f08 implicit none type (atmos_data_type), intent(in) :: Atmos !--- local variables--- diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index b27e5a2f6..976b1d4f6 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -29,6 +29,7 @@ TYPEDEFS_NEW_METADATA = { 'ccpp_types' : { 'ccpp_t' : 'cdata', + 'MPI_Comm' : '', 'ccpp_types' : '', }, 'machine' : { diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 7cd1d4a35..5fae71258 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1,5 +1,6 @@ module GFS_typedefs + use mpi_f08 use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec use physcons, only: con_cp, con_fvirt, con_g, rholakeice, & con_hvap, con_hfus, con_pi, con_rd, con_rv, & @@ -94,7 +95,7 @@ module GFS_typedefs type GFS_init_type integer :: me !< my MPI-rank integer :: master !< master MPI-rank - integer :: fcst_mpi_comm !< forecast tasks mpi communicator + type(MPI_Comm) :: fcst_mpi_comm !< forecast tasks mpi communicator integer :: fcst_ntasks !< total number of forecast tasks integer :: tile_num !< tile number for this MPI rank integer :: isc !< starting i-index for this MPI-domain @@ -700,7 +701,7 @@ module GFS_typedefs integer :: me !< MPI rank designator integer :: master !< MPI rank of master atmosphere processor - integer :: communicator !< MPI communicator + type(MPI_Comm) :: communicator !< MPI communicator integer :: ntasks !< MPI size in communicator integer :: nthreads !< OpenMP threads available for physics integer :: nlunit !< unit for namelist @@ -3306,7 +3307,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys), dimension(:), intent(in) :: bk logical, intent(in) :: restart logical, intent(in) :: hydrostatic - integer, intent(in) :: communicator + type(MPI_Comm), intent(in) :: communicator integer, intent(in) :: ntasks integer, intent(in) :: nthreads @@ -3316,9 +3317,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: seed0 logical :: exists real(kind=kind_phys) :: tem - real(kind=kind_phys) :: rinc(5) - real(kind=kind_sngl_prec) :: rinc4(5) - real(kind=kind_dbl_prec) :: rinc8(5) + real(kind=kind_dbl_prec) :: rinc(5) real(kind=kind_phys) :: wrk(1) real(kind=kind_phys), parameter :: con_hr = 3600. @@ -3974,7 +3973,6 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: radar_tten_limits(2) = (/ limit_unspecified, limit_unspecified /) integer :: itime - integer :: w3kindreal,w3kindint !--- END NAMELIST VARIABLES @@ -5608,19 +5606,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cdec = -9999. Model%clstp = -9999 rinc(1:5) = 0 - call w3kind(w3kindreal,w3kindint) - if (w3kindreal == 8) then - rinc8(1:5) = 0 - call w3difdat(jdat,idat,4,rinc8) - rinc = rinc8 - else if (w3kindreal == 4) then - rinc4(1:5) = 0 - call w3difdat(jdat,idat,4,rinc4) - rinc = rinc4 - else - write(0,*)' FATAL ERROR: Invalid w3kindreal' - call abort - endif + call w3difdat(jdat,idat,4,rinc) Model%phour = rinc(4)/con_hr Model%fhour = (rinc(4) + Model%dtp)/con_hr Model%zhour = mod(Model%phour,Model%fhzero) @@ -6418,7 +6404,7 @@ subroutine control_print(Model) print *, 'basic control parameters' print *, ' me : ', Model%me print *, ' master : ', Model%master - print *, ' communicator : ', Model%communicator + print *, ' communicator : ', Model%communicator%mpi_val print *, ' nlunit : ', Model%nlunit print *, ' fn_nml : ', trim(Model%fn_nml) print *, ' fhzero : ', Model%fhzero diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index f7b9239da..20a3b4ce4 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -3332,7 +3332,7 @@ long_name = MPI communicator units = index dimensions = () - type = integer + type = MPI_Comm [ntasks] standard_name = number_of_mpi_tasks long_name = number of MPI tasks in communicator diff --git a/ccpp/framework b/ccpp/framework index f1db41531..011db4f80 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit f1db41531c772cc60b71296334e0a9616e8b4a91 +Subproject commit 011db4f80a02cba6d65958ace56e8efb197be62b diff --git a/ccpp/physics b/ccpp/physics index 9f4a96bcf..983968088 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9f4a96bcfb18c19336e308b41d8c8cb11a347c48 +Subproject commit 9839680885141338fb14ff09bab6fe87a051b820 diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index d9d8ff970..7d4289a89 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -16,7 +16,7 @@ !> @author Dusan Jovic @date Nov 1, 2017 module module_write_netcdf - use mpi + use mpi_f08 use esmf use netcdf use module_fv3_io_def,only : ideflate, quantize_mode, quantize_nsd, zstandard_level, & @@ -44,13 +44,15 @@ module module_write_netcdf !> !> @author Dusan Jovic @date Nov 1, 2017 subroutine write_netcdf(wrtfb, filename, & - use_parallel_netcdf, mpi_comm, mype, & + use_parallel_netcdf, comm, mype, & grid_id, rc) ! + use mpi_f08 + type(ESMF_FieldBundle), intent(in) :: wrtfb character(*), intent(in) :: filename logical, intent(in) :: use_parallel_netcdf - integer, intent(in) :: mpi_comm + type(MPI_Comm), intent(in) :: comm integer, intent(in) :: mype integer, intent(in) :: grid_id integer, optional,intent(out) :: rc @@ -233,7 +235,7 @@ subroutine write_netcdf(wrtfb, filename, & if (par) then ncerr = nf90_create(trim(filename),& cmode=IOR(NF90_CLOBBER,NF90_NETCDF4),& - comm=mpi_comm, info = MPI_INFO_NULL, ncid=ncid); NC_ERR_STOP(ncerr) + comm=comm%mpi_val, info = MPI_INFO_NULL%mpi_val, ncid=ncid); NC_ERR_STOP(ncerr) else ncerr = nf90_create(trim(filename),& cmode=IOR(NF90_CLOBBER,NF90_NETCDF4),& diff --git a/io/module_write_restart_netcdf.F90 b/io/module_write_restart_netcdf.F90 index 2fd4c7732..4d1e73a9d 100644 --- a/io/module_write_restart_netcdf.F90 +++ b/io/module_write_restart_netcdf.F90 @@ -7,7 +7,7 @@ module module_write_restart_netcdf - use mpi + use mpi_f08 use esmf use fms use mpp_mod, only : mpp_chksum ! needed for fms 2023.02 @@ -24,13 +24,13 @@ module module_write_restart_netcdf !---------------------------------------------------------------------------------------- subroutine write_restart_netcdf(wrtfb, filename, & - use_parallel_netcdf, mpi_comm, mype, & + use_parallel_netcdf, comm, mype, & rc) ! type(ESMF_FieldBundle), intent(in) :: wrtfb character(*), intent(in) :: filename logical, intent(in) :: use_parallel_netcdf - integer, intent(in) :: mpi_comm + type(MPI_Comm), intent(in) :: comm integer, intent(in) :: mype integer, optional,intent(out) :: rc ! @@ -223,7 +223,7 @@ subroutine write_restart_netcdf(wrtfb, filename, & if (par) then ncerr = nf90_create(trim(filename),& cmode=IOR(NF90_CLOBBER,NF90_NETCDF4),& - comm=mpi_comm, info = MPI_INFO_NULL, ncid=ncid); NC_ERR_STOP(ncerr) + comm=comm%mpi_val, info = MPI_INFO_NULL%mpi_val, ncid=ncid); NC_ERR_STOP(ncerr) else ncerr = nf90_create(trim(filename),& ! cmode=IOR(NF90_CLOBBER,NF90_64BIT_OFFSET),& diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index de0cedb6f..eb3ccd8dc 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -26,7 +26,7 @@ module module_wrt_grid_comp ! !--------------------------------------------------------------------------------- ! - use mpi + use mpi_f08 use esmf use fms_mod, only : uppercase use fms @@ -67,7 +67,7 @@ module module_wrt_grid_comp integer,save :: itasks, jtasks !<-- # of write tasks in i/j direction in the current group integer,save :: ngrids - integer,save :: wrt_mpi_comm !<-- the mpi communicator in the write comp + type(MPI_Comm),save :: wrt_mpi_comm !<-- the mpi communicator in the write comp integer,save :: idate(7), start_time(7) logical,save :: write_nsflip logical,save :: change_wrtidate=.false. @@ -159,7 +159,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, integer,dimension(2,6) :: decomptile integer,dimension(2) :: regDecomp !define delayout for the nest grid integer :: fieldCount - integer :: vm_mpi_comm + type(MPI_Comm) :: vm_mpi_comm character(40) :: fieldName type(ESMF_Config) :: cf, cf_output_grid type(ESMF_Info) :: info @@ -242,7 +242,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! call ESMF_VMGetCurrent(vm=VM,rc=RC) call ESMF_VMGet(vm=VM, localPet=wrt_int_state%mype, & - petCount=wrt_int_state%petcount,mpiCommunicator=vm_mpi_comm,rc=rc) + petCount=wrt_int_state%petcount,mpiCommunicator=vm_mpi_comm%mpi_val,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call mpi_comm_dup(vm_mpi_comm, wrt_mpi_comm, rc) @@ -253,7 +253,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, last_write_task = ntasks -1 lprnt = lead_write_task == wrt_int_state%mype - call fms_init(wrt_mpi_comm) + call fms_init(wrt_mpi_comm%mpi_val) ! print *,'in wrt, lead_write_task=', & ! lead_write_task,'last_write_task=',last_write_task, & @@ -386,6 +386,12 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, print *,'grid_id= ', n, ' output_grid= ', trim(output_grid(n)) end if + if (trim(output_grid(n)) == 'cubed_sphere_grid' .and. wrt_int_state%write_dopost) then + write(0,*) 'wrt_initialize_p1: Inline post is not supported with cubed_sphere_grid outputs' + call ESMF_LogWrite("wrt_initialize_p1: Inline post is not supported with cubed_sphere_grid output",ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + call ESMF_ConfigGetAttribute(config=CF, value=itasks,default=1,label ='itasks:',rc=rc) jtasks = ntasks if(itasks > 0 ) jtasks = ntasks/itasks @@ -3386,7 +3392,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) logical :: thereAreVerticals integer :: ch_dimid, timeiso_varid character(len=ESMF_MAXSTR) :: time_iso - integer :: wrt_mpi_comm + type(MPI_Comm) :: wrt_mpi_comm type(ESMF_VM) :: vm rc = ESMF_SUCCESS @@ -3439,7 +3445,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_GridCompGet(comp, localPet=localPet, petCount=petCount, vm=vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_VMGet(vm=vm, mpiCommunicator=wrt_mpi_comm, rc=rc) + call ESMF_VMGet(vm=vm, mpiCommunicator=wrt_mpi_comm%mpi_val, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (petCount > 1) then diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 30eae6ba4..e00accfa0 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -1,6 +1,6 @@ module post_fv3 - use mpi + use mpi_f08 use module_fv3_io_def, only : wrttasks_per_group, filename_base, & lon1, lat1, lon2, lat2, dlon, dlat, & @@ -56,7 +56,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & type(wrt_internal_state),intent(inout) :: wrt_int_state integer,intent(in) :: grid_id integer,intent(in) :: mype - integer,intent(in) :: mpicomp + type(MPI_Comm),intent(in) :: mpicomp integer,intent(in) :: lead_write integer,intent(in) :: itasks, jtasks integer,intent(in) :: mynfhr @@ -586,7 +586,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) type(wrt_internal_state),intent(in) :: wrt_int_state integer,intent(in) :: grid_id integer,intent(in) :: mype - integer,intent(in) :: mpicomp + type(MPI_Comm),intent(in) :: mpicomp ! !----------------------------------------------------------------------- ! diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index ea622369c..df28a246b 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -15,7 +15,7 @@ module module_fcst_grid_comp ! !--------------------------------------------------------------------------------- ! - use mpi + use mpi_f08 use esmf use nuopc @@ -593,7 +593,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) call ESMF_VMGetCurrent(vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_VMGet(vm=vm, localPet=mype, mpiCommunicator=fcst_mpi_comm, & + call ESMF_VMGet(vm=vm, localPet=mype, mpiCommunicator=fcst_mpi_comm%mpi_val, & petCount=fcst_ntasks, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (mype == 0) write(*,*)'in fcst comp init, fcst_ntasks=',fcst_ntasks @@ -615,7 +615,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (mype == 0) print *,'af ufs config,restart_interval=',restart_interval ! - call fms_init(fcst_mpi_comm) + call fms_init(fcst_mpi_comm%mpi_val) call mpp_init() initClock = mpp_clock_id( 'Initialization' ) call mpp_clock_begin (initClock) !nesting problem diff --git a/module_fv3_config.F90 b/module_fv3_config.F90 index 9733fa8fc..6874c5cc5 100644 --- a/module_fv3_config.F90 +++ b/module_fv3_config.F90 @@ -6,6 +6,8 @@ !> !> @author Jun Wang @date 01/2017 module module_fv3_config + + use mpi_f08 use esmf implicit none @@ -18,12 +20,11 @@ module module_fv3_config integer :: first_kdt !> MPI communicator for the forecast grid component - integer :: fcst_mpi_comm + type(MPI_Comm) :: fcst_mpi_comm !> Total number of mpi tasks for the forecast grid components integer :: fcst_ntasks - !> ID number for the coupled grids integer :: cpl_grid_id From 1ba84102cb814ec377efae92264fceb317c24398 Mon Sep 17 00:00:00 2001 From: lisa-bengtsson <54411948+lisa-bengtsson@users.noreply.github.com> Date: Wed, 27 Mar 2024 12:12:00 -0600 Subject: [PATCH 3/9] Introduce namelist flag xr_cnvcld to control if suspended grid-mean convective cloud condensate should be included in cloud fraction and optical depth calculation in radiation in the GFS suite. (#799) * Update ccpp/physics for namelist flag xr_cnvcld --- ccpp/data/GFS_typedefs.F90 | 9 ++++++--- ccpp/data/GFS_typedefs.meta | 6 ++++++ ccpp/physics | 2 +- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 5fae71258..07eecbe20 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1160,6 +1160,7 @@ module GFS_typedefs logical :: lheatstrg !< flag for canopy heat storage parameterization logical :: lseaspray !< flag for sea spray parameterization logical :: cnvcld + logical :: xr_cnvcld !< flag for adding suspended convective clouds to Xu-Randall cloud fraction logical :: random_clds !< flag controls whether clouds are random logical :: shal_cnv !< flag for calling shallow convection logical :: do_deep !< whether to do deep convection @@ -3680,6 +3681,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: lheatstrg = .false. !< flag for canopy heat storage parameterization logical :: lseaspray = .false. !< flag for sea spray parameterization logical :: cnvcld = .false. + logical :: xr_cnvcld = .true. !< flag for including suspended convective clouds in Xu-Randall cloud fraction logical :: random_clds = .false. !< flag controls whether clouds are random logical :: shal_cnv = .false. !< flag for calling shallow convection integer :: imfshalcnv = 1 !< flag for mass-flux shallow convection scheme @@ -4062,8 +4064,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & hwrf_samfdeep, hwrf_samfshal,progsigma,betascu,betamcu, & betadcu,h2o_phys, pdfcld, shcnvcw, redrag, hybedmf, satmedmf,& shinhong, do_ysu, dspheat, lheatstrg, lseaspray, cnvcld, & - random_clds, shal_cnv, imfshalcnv, imfdeepcnv, isatmedmf, & - do_deep, jcap, & + xr_cnvcld, random_clds, shal_cnv, imfshalcnv, imfdeepcnv, & + isatmedmf, do_deep, jcap, & cs_parm, flgmin, cgwf, ccwf, cdmbgwd, sup, ctei_rm, crtrh, & dlqf, rbcr, shoc_parm, psauras, prauras, wminras, & do_sppt, do_shum, do_skeb, & @@ -4892,6 +4894,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%lheatstrg = lheatstrg Model%lseaspray = lseaspray Model%cnvcld = cnvcld + Model%xr_cnvcld = xr_cnvcld Model%random_clds = random_clds Model%shal_cnv = shal_cnv Model%imfshalcnv = imfshalcnv @@ -6181,7 +6184,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ' do_shoc=', Model%do_shoc, ' nshoc3d=', Model%nshoc_3d, & ' nshoc_2d=', Model%nshoc_2d, ' shoc_cld=', Model%shoc_cld, & ' nkbfshoc=', Model%nkbfshoc, ' nahdshoc=', Model%nahdshoc, & - ' nscfshoc=', Model%nscfshoc, & + ' nscfshoc=', Model%nscfshoc, ' xr_cnvcld=',Model%xr_cnvcld, & ' uni_cld=', Model%uni_cld, & ' ntot3d=', Model%ntot3d, ' ntot2d=', Model%ntot2d, & ' shocaftcnv=',Model%shocaftcnv,' indcld=', Model%indcld, & diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 20a3b4ce4..92e2cdf37 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -5410,6 +5410,12 @@ units = flag dimensions = () type = logical +[xr_cnvcld] + standard_name = flag_for_suspended_convective_clouds_in_Xu_Randall + long_name = flag for using suspended convective clouds in Xu Randall + units = flag + dimensions = () + type = logical [shal_cnv] standard_name = flag_for_simplified_arakawa_schubert_shallow_convection long_name = flag for calling shallow convection diff --git a/ccpp/physics b/ccpp/physics index 983968088..9b0ac7b16 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9839680885141338fb14ff09bab6fe87a051b820 +Subproject commit 9b0ac7b16a45afe5e7f1abf9571d3484158a5b43 From 1b75fe2c90f2a0abf03844d867bd2afa00e86de9 Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Mon, 1 Apr 2024 17:12:08 -0400 Subject: [PATCH 4/9] Update module_write_netcdf to avoid hangs in RRFS runs (#803) * Split add_dim into two routines * Add NF90_NODIMSCALE_ATTACH constant * Test classic netcdf file formats --- io/fv3atm_history_io.F90 | 1 - io/module_write_netcdf.F90 | 180 ++++++++++++++++++++++++++----------- 2 files changed, 126 insertions(+), 55 deletions(-) diff --git a/io/fv3atm_history_io.F90 b/io/fv3atm_history_io.F90 index d7ee4e808..7171aa673 100644 --- a/io/fv3atm_history_io.F90 +++ b/io/fv3atm_history_io.F90 @@ -595,7 +595,6 @@ subroutine history_type_store_data3D(hist, id, work, Time, idx, intpl_method, fl integer k,j,i,nv,i1,j1 logical used ! - write(0,*) ' history_type_store_data3D kinds ', kind_phys, kind(work), lbound(work), ubound(work), size(work) if( id > 0 ) then if( hist%use_wrtgridcomp_output ) then if( trim(intpl_method) == 'bilinear') then diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 7d4289a89..2b5fcacc1 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -30,6 +30,10 @@ module module_write_netcdf logical :: par !< True if parallel I/O should be used. + integer, parameter :: netcdf_file_type = NF90_NETCDF4 !< NetCDF file type HDF5 + ! integer, parameter :: netcdf_file_type = NF90_64BIT_DATA !< NetCDF file type CDF5 + ! integer, parameter :: netcdf_file_type = NF90_64BIT_OFFSET !< NetCDF file type CDF2 + contains !> Write netCDF file. @@ -37,7 +41,7 @@ module module_write_netcdf !> @param[in] wrtfb ESMF write field bundle. !> @param[in] filename NetCDF filename. !> @param[in] use_parallel_netcdf True if parallel I/O should be used. - !> @param[in] mpi_comm MPI communicator for parallel I/O. + !> @param[in] comm MPI communicator for parallel I/O. !> @param[in] mype MPI rank. !> @param[in] grid_id Output grid identifier. !> @param[out] rc Return code - 0 for success, ESMF error code otherwise. @@ -58,6 +62,7 @@ subroutine write_netcdf(wrtfb, filename, & integer, optional,intent(out) :: rc ! !** local vars + integer, parameter :: NF90_NODIMSCALE_ATTACH = int(Z'40000') integer :: i,j,t, istart,iend,jstart,jend integer :: im, jm, lm, lsoil @@ -89,8 +94,7 @@ subroutine write_netcdf(wrtfb, filename, & character(len=ESMF_MAXSTR) :: attName, fldName integer :: varival - real(4) :: varr4val, dataMin, dataMax - real(4), allocatable, dimension(:) :: compress_err + real(4) :: varr4val real(8) :: varr8val character(len=ESMF_MAXSTR) :: varcval @@ -98,8 +102,9 @@ subroutine write_netcdf(wrtfb, filename, & integer :: ncid integer :: oldMode integer :: dim_len - integer :: im_dimid, jm_dimid, tile_dimid, pfull_dimid, phalf_dimid, time_dimid, ch_dimid, lsoil_dimid - integer :: im_varid, jm_varid, tile_varid, lon_varid, lat_varid, timeiso_varid + integer :: im_dimid, jm_dimid, tile_dimid, pfull_dimid, phalf_dimid, time_dimid, lsoil_dimid, ch_dimid + integer :: im_varid, jm_varid, tile_varid, pfull_varid, phalf_varid, time_varid, lsoil_varid + integer :: lon_varid, lat_varid, timeiso_varid integer, dimension(:), allocatable :: dimids_2d, dimids_3d, dimids_soil, dimids, chunksizes integer, dimension(:), allocatable :: varids integer :: xtype @@ -117,6 +122,15 @@ subroutine write_netcdf(wrtfb, filename, & integer :: par_access character(len=ESMF_MAXSTR) :: output_grid_name ! + interface + function nf_set_log_level(new_level) result(status) + integer, intent(in) :: new_level + integer :: status + end function nf_set_log_level + end interface + + ! ncerr = nf_set_log_level(3); NC_ERR_STOP(ncerr) + is_cubed_sphere = .false. tileCount = 0 my_tile = 0 @@ -124,13 +138,21 @@ subroutine write_netcdf(wrtfb, filename, & start_j = -10000000 par = use_parallel_netcdf + + if (netcdf_file_type /= NF90_NETCDF4) then + par = .false. + if (ideflate(grid_id) > 0 .or. zstandard_level(grid_id) > 0) then + write(0,*)'Compression is unsupporeted in classic netcdf' + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + end if + do_io = par .or. (mype==0) call ESMF_FieldBundleGet(wrtfb, fieldCount=fieldCount, rc=rc); ESMF_ERR_RETURN(rc) call ESMF_AttributeGet(wrtfb, convention="NetCDF", purpose="FV3", & name='grid', value=output_grid_name, rc=rc); ESMF_ERR_RETURN(rc) - allocate(compress_err(fieldCount)); compress_err=-999. allocate(fldlev(fieldCount)) ; fldlev = 0 allocate(fcstField(fieldCount)) allocate(varids(fieldCount)) @@ -234,32 +256,32 @@ subroutine write_netcdf(wrtfb, filename, & if (par) then ncerr = nf90_create(trim(filename),& - cmode=IOR(NF90_CLOBBER,NF90_NETCDF4),& + cmode=IOR(IOR(NF90_CLOBBER,netcdf_file_type),NF90_NODIMSCALE_ATTACH),& comm=comm%mpi_val, info = MPI_INFO_NULL%mpi_val, ncid=ncid); NC_ERR_STOP(ncerr) else ncerr = nf90_create(trim(filename),& - cmode=IOR(NF90_CLOBBER,NF90_NETCDF4),& + cmode=IOR(IOR(NF90_CLOBBER,netcdf_file_type),NF90_NODIMSCALE_ATTACH),& ncid=ncid); NC_ERR_STOP(ncerr) end if ! disable auto filling. ncerr = nf90_set_fill(ncid, NF90_NOFILL, oldMode); NC_ERR_STOP(ncerr) - ! define dimensions [grid_xt, grid_yta ,(pfull/phalf), (tile), time] + ! define dimensions [grid_xt, grid_yt, nchars, (pfull/phalf), (tile), time] ncerr = nf90_def_dim(ncid, "grid_xt", im, im_dimid); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "grid_yt", jm, jm_dimid); NC_ERR_STOP(ncerr) ncerr = nf90_def_dim(ncid, "nchars", 20, ch_dimid); NC_ERR_STOP(ncerr) if (lm > 1) then - call add_dim(ncid, "pfull", pfull_dimid, wrtgrid, mype, rc) - call add_dim(ncid, "phalf", phalf_dimid, wrtgrid, mype, rc) + call add_dim(ncid, "pfull", pfull_dimid, pfull_varid, wrtgrid, mype, rc) + call add_dim(ncid, "phalf", phalf_dimid, phalf_varid, wrtgrid, mype, rc) end if if (lsoil > 1) then - call add_dim(ncid, "zsoil", lsoil_dimid, wrtgrid, mype, rc) + call add_dim(ncid, "zsoil", lsoil_dimid, lsoil_varid, wrtgrid, mype, rc) end if if (is_cubed_sphere) then ncerr = nf90_def_dim(ncid, "tile", tileCount, tile_dimid); NC_ERR_STOP(ncerr) end if - call add_dim(ncid, "time", time_dimid, wrtgrid, mype, rc) + call add_dim(ncid, "time", time_dimid, time_varid, wrtgrid, mype, rc) ! define coordinate variables ncerr = nf90_def_var(ncid, "grid_xt", NF90_DOUBLE, im_dimid, im_varid); NC_ERR_STOP(ncerr) @@ -314,20 +336,18 @@ subroutine write_netcdf(wrtfb, filename, & ncerr = nf90_put_att(ncid, lat_varid, "units", "degrees_N"); NC_ERR_STOP(ncerr) if (par) then - ncerr = nf90_var_par_access(ncid, im_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, lon_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, jm_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, lat_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) - ncerr = nf90_var_par_access(ncid, timeiso_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, im_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, lon_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, jm_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, lat_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, timeiso_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) if (is_cubed_sphere) then - ncerr = nf90_var_par_access(ncid, tile_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + ncerr = nf90_var_par_access(ncid, tile_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) end if end if - call get_global_attr(wrtfb, ncid, mype, rc) - ! define variables (fields) if (is_cubed_sphere) then allocate(dimids_2d(4)) @@ -346,7 +366,7 @@ subroutine write_netcdf(wrtfb, filename, & do i=1, fieldCount call ESMF_FieldGet(fcstField(i), name=fldName, rank=rank, typekind=typekind, rc=rc); ESMF_ERR_RETURN(rc) - par_access = NF90_INDEPENDENT + par_access = NF90_COLLECTIVE if (rank == 2) then dimids = dimids_2d @@ -394,7 +414,7 @@ subroutine write_netcdf(wrtfb, filename, & ishuffle = NF90_NOSHUFFLE ! shuffle filter on when using lossy compression - if ( quantize_nsd(grid_id) > 0) then + if (quantize_nsd(grid_id) > 0) then ishuffle = NF90_SHUFFLE end if if (ideflate(grid_id) > 0) then @@ -482,11 +502,23 @@ subroutine write_netcdf(wrtfb, filename, & end do ! i=1,fieldCount ncerr = nf90_enddef(ncid); NC_ERR_STOP(ncerr) + ! end of define mode + + ! write dimension variables, except grid_xt, grid_yt + ! those will be written later with lon,lat variables + if (lm > 1) then + call write_dim(ncid, "pfull", pfull_dimid, pfull_varid, wrtgrid, mype, rc) + call write_dim(ncid, "phalf", phalf_dimid, phalf_varid, wrtgrid, mype, rc) + end if + if (lsoil > 1) then + call write_dim(ncid, "zsoil", lsoil_dimid, lsoil_varid, wrtgrid, mype, rc) + end if + call write_dim(ncid, "time", time_dimid, time_varid, wrtgrid, mype, rc) + end if - ! end of define mode ! - ! write dimension variables and lon,lat variables + ! write lon,lat variables ! if (allocated(start_idx)) deallocate(start_idx) if (is_cubed_sphere) then @@ -755,7 +787,6 @@ subroutine write_netcdf(wrtfb, filename, & deallocate(fcstField) deallocate(varids) - deallocate(compress_err) if (do_io) then ncerr = nf90_close(ncid=ncid); NC_ERR_STOP(ncerr) @@ -808,7 +839,14 @@ subroutine get_global_attr(fldbundle, ncid, mype, rc) else if (typekind==ESMF_TYPEKIND_I8) then call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & name=trim(attname), value=varival_i8, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_put_att(ncid, nf90_global, trim(attname), varival_i8); NC_ERR_STOP(ncerr) + if (netcdf_file_type == NF90_64BIT_OFFSET) then + ! NetCDF NF90_64BIT_OFFSET (CDF2) does not support int64 attributes + ! Currently only one global attribute is int64 (:grid_id = 1LL) + varival_i4 = varival_i8 + ncerr = nf90_put_att(ncid, nf90_global, trim(attname), varival_i4); NC_ERR_STOP(ncerr) + else + ncerr = nf90_put_att(ncid, nf90_global, trim(attname), varival_i8); NC_ERR_STOP(ncerr) + end if else if (typekind==ESMF_TYPEKIND_R4) then allocate (varr4list(itemCount)) @@ -938,22 +976,19 @@ end subroutine get_dimlen_if_exists !> @param[out] rc Return code - 0 for success, ESMF error code otherwise. !> !> @author Dusan Jovic @date Nov 1, 2017 - subroutine add_dim(ncid, dim_name, dimid, grid, mype, rc) + subroutine add_dim(ncid, dim_name, dimid, dim_varid, grid, mype, rc) integer, intent(in) :: ncid character(len=*), intent(in) :: dim_name - integer, intent(inout) :: dimid + integer, intent(inout) :: dimid + integer, intent(inout) :: dim_varid type(ESMF_Grid), intent(in) :: grid integer, intent(in) :: mype integer, intent(out) :: rc ! local variable - integer :: n, dim_varid + integer :: n integer :: ncerr type(ESMF_TypeKind_Flag) :: typekind - - real(ESMF_KIND_I4), allocatable :: valueListI4(:) - real(ESMF_KIND_R4), allocatable :: valueListR4(:) - real(ESMF_KIND_R8), allocatable :: valueListR8(:) ! call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, name=dim_name, & @@ -972,43 +1007,80 @@ subroutine add_dim(ncid, dim_name, dimid, grid, mype, rc) end if if (typekind==ESMF_TYPEKIND_R8) then - ncerr = nf90_def_var(ncid, dim_name, NF90_REAL8, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) + ncerr = nf90_def_var(ncid, dim_name, NF90_REAL8, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) + else if (typekind==ESMF_TYPEKIND_R4) then + ncerr = nf90_def_var(ncid, dim_name, NF90_REAL4, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) + else if (typekind==ESMF_TYPEKIND_I4) then + ncerr = nf90_def_var(ncid, dim_name, NF90_INT4, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) + else + if (mype==0) write(0,*)'Error in module_write_netcdf.F90(add_dim) unknown typekind for ',trim(dim_name) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + end if + if (par) then + ncerr = nf90_var_par_access(ncid, dim_varid, NF90_COLLECTIVE); NC_ERR_STOP(ncerr) + end if + + call get_grid_attr(grid, dim_name, ncid, dim_varid, rc) + + end subroutine add_dim + + !> Write a dimension variable. + !> + !> @param[in] ncid NetCDF file ID. + !> @param[in] dim_name Dimension name. + !> @param[in] dimid Dimension ID. + !> @param[in] dim_varid Dimension variable ID. + !> @param[in] grid ESMF output grid. + !> @param[in] mype MPI rank. + !> @param[out] rc Return code - 0 for success, ESMF error code otherwise. + !> + !> @author Dusan Jovic @date Nov 1, 2017 + subroutine write_dim(ncid, dim_name, dimid, dim_varid, grid, mype, rc) + integer, intent(in) :: ncid + character(len=*), intent(in) :: dim_name + integer, intent(in) :: dimid + integer, intent(in) :: dim_varid + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: mype + integer, intent(out) :: rc + +! local variable + integer :: n + integer :: ncerr + type(ESMF_TypeKind_Flag) :: typekind + + real(ESMF_KIND_I4), allocatable :: valueListI4(:) + real(ESMF_KIND_R4), allocatable :: valueListR4(:) + real(ESMF_KIND_R8), allocatable :: valueListR8(:) +! + call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, name=dim_name, & + typekind=typekind, itemCount=n, rc=rc); ESMF_ERR_RETURN(rc) + + if (typekind==ESMF_TYPEKIND_R8) then allocate(valueListR8(n)) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(dim_name), valueList=valueListR8, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) ncerr = nf90_put_var(ncid, dim_varid, values=valueListR8); NC_ERR_STOP(ncerr) - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) deallocate(valueListR8) - else if (typekind==ESMF_TYPEKIND_R4) then - ncerr = nf90_def_var(ncid, dim_name, NF90_REAL4, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) + else if (typekind==ESMF_TYPEKIND_R4) then allocate(valueListR4(n)) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(dim_name), valueList=valueListR4, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) ncerr = nf90_put_var(ncid, dim_varid, values=valueListR4); NC_ERR_STOP(ncerr) - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) deallocate(valueListR4) - else if (typekind==ESMF_TYPEKIND_I4) then - ncerr = nf90_def_var(ncid, dim_name, NF90_INT4, dimids=[dimid], varid=dim_varid); NC_ERR_STOP(ncerr) + else if (typekind==ESMF_TYPEKIND_I4) then allocate(valueListI4(n)) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(dim_name), valueList=valueListI4, rc=rc); ESMF_ERR_RETURN(rc) - ncerr = nf90_enddef(ncid=ncid); NC_ERR_STOP(ncerr) ncerr = nf90_put_var(ncid, dim_varid, values=valueListI4); NC_ERR_STOP(ncerr) - ncerr = nf90_redef(ncid=ncid); NC_ERR_STOP(ncerr) deallocate(valueListI4) - else - if (mype==0) write(0,*)'Error in module_write_netcdf.F90(add_dim) unknown typekind for ',trim(dim_name) - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if - if (par) then - ncerr = nf90_var_par_access(ncid, dim_varid, NF90_INDEPENDENT); NC_ERR_STOP(ncerr) + else + if (mype==0) write(0,*)'Error in module_write_netcdf.F90(write_dim) unknown typekind for ',trim(dim_name) + call ESMF_Finalize(endflag=ESMF_END_ABORT) end if - call get_grid_attr(grid, dim_name, ncid, dim_varid, rc) - - end subroutine add_dim + end subroutine write_dim !---------------------------------------------------------------------------------------- end module module_write_netcdf From 1cac9d31d139b0069deb31034e2257a2a945a573 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 3 Apr 2024 16:48:31 -0400 Subject: [PATCH 5/9] Enable cpl_scalars (#794) * add cpl_scalars for atm * add field cpl_scalars to export state of fv3atm when coupled. cpl_scalars contain the dimensions of the fv3atm domain and are used by cmeps to write mediator history files as a single 2d grid for regional and 6 2d grids for CSG. * remove unused NUOPC use statement --- CMakeLists.txt | 1 + atmos_model.F90 | 54 +++++----- cpl/module_cap_cpl.F90 | 1 - cpl/module_cplfields.F90 | 42 ++++---- cpl/module_cplscalars.F90 | 203 ++++++++++++++++++++++++++++++++++++++ fv3_cap.F90 | 55 ++++++++++- module_fcst_grid_comp.F90 | 26 ++++- 7 files changed, 336 insertions(+), 46 deletions(-) create mode 100644 cpl/module_cplscalars.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index eede1ef1e..0d76a8f25 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -105,6 +105,7 @@ add_library(fv3atm cpl/module_block_data.F90 cpl/module_cplfields.F90 cpl/module_cap_cpl.F90 + cpl/module_cplscalars.F90 io/fv3atm_common_io.F90 io/fv3atm_clm_lake_io.F90 io/fv3atm_rrfs_sd_io.F90 diff --git a/atmos_model.F90 b/atmos_model.F90 index 6a0834c65..91a566671 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -3142,7 +3142,8 @@ subroutine setup_exportdata(rc) use ESMF - use module_cplfields, only: exportFields, chemistryFieldNames + use module_cplfields, only: exportFields, chemistryFieldNames + use module_cplscalars, only: flds_scalar_name !--- arguments integer, optional, intent(out) :: rc @@ -3192,33 +3193,36 @@ subroutine setup_exportdata(rc) if (isFound) then call ESMF_FieldGet(exportFields(n), name=fieldname, rank=rank, typekind=datatype, rc=localrc) if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - if (datatype == ESMF_TYPEKIND_R8) then - select case (rank) - case (2) - call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - case (3) - call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - case default - !--- skip field - isFound = .false. - end select - else if (datatype == ESMF_TYPEKIND_R4) then - select case (rank) - case (2) - call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc) - if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return - case default - !--- skip field - isFound = .false. - end select - else - !--- skip field + if (trim(fieldname) == trim(flds_scalar_name)) then isFound = .false. + else + if (datatype == ESMF_TYPEKIND_R8) then + select case (rank) + case (2) + call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + case (3) + call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + case default + !--- skip field + isFound = .false. + end select + else if (datatype == ESMF_TYPEKIND_R4) then + select case (rank) + case (2) + call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc) + if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + case default + !--- skip field + isFound = .false. + end select + else + !--- skip field + isFound = .false. + end if end if end if - !--- skip field if only required for chemistry if (isFound .and. GFS_control%cplchm) isFound = .not.any(trim(fieldname) == chemistryFieldNames) diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index 313ab6cf6..cd92532d7 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -11,7 +11,6 @@ module module_cap_cpl private public diagnose_cplFields -! contains !----------------------------------------------------------------------------- diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index bce01c979..524db0208 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -26,7 +26,7 @@ module module_cplfields ! l : model levels (3D) ! s : surface (2D) ! t : tracers (4D) - integer, public, parameter :: NexportFields = 119 + integer, public, parameter :: NexportFields = 120 type(ESMF_Field), target, public :: exportFields(NexportFields) type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & @@ -153,7 +153,8 @@ module module_cplfields FieldInfo("snwdph ", "s"), & FieldInfo("f10m ", "s"), & FieldInfo("zorl ", "s"), & - FieldInfo("t2m ", "s") ] + FieldInfo("t2m ", "s"), & + FieldInfo("cpl_scalars ", "s")] ! Import Fields ---------------------------------------- integer, public, parameter :: NimportFields = 64 @@ -192,7 +193,7 @@ module module_cplfields ! For receiving fluxes from external land component FieldInfo("land_fraction ", "s"), & FieldInfo("inst_snow_area_fraction_lnd ", "s"), & - FieldInfo("inst_spec_humid_lnd ", "s"), & + FieldInfo("inst_spec_humid_lnd ", "s"), & FieldInfo("inst_laten_heat_flx_lnd ", "s"), & FieldInfo("inst_sensi_heat_flx_lnd ", "s"), & FieldInfo("inst_potential_laten_heat_flx_lnd ", "s"), & @@ -441,6 +442,7 @@ subroutine realizeConnectedCplFields(state, grid, & use field_manager_mod, only: MODEL_ATMOS use tracer_manager_mod, only: get_number_tracers, get_tracer_names + use module_cplscalars, only: flds_scalar_name, flds_scalar_num, SetScalarField type(ESMF_State), intent(inout) :: state type(ESMF_Grid), intent(in) :: grid @@ -488,22 +490,27 @@ subroutine realizeConnectedCplFields(state, grid, & isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (isConnected) then - call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - select case (fields_info(item)%type) + if (trim(fields_info(item)%name) == trim(flds_scalar_name)) then + ! Create the scalar field + call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldEmptySet(field, grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + select case (fields_info(item)%type) case ('l','layer') call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return case ('i','interface') call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return case ('t','tracer') call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) + ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (allocated(tracerNames)) then call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc) @@ -518,14 +525,15 @@ subroutine realizeConnectedCplFields(state, grid, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return case ('g','soil') call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return case default call ESMF_LogSetError(ESMF_RC_NOT_VALID, & - msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & - line=__LINE__, file=__FILE__, rcToReturn=rc) + msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", & + line=__LINE__, file=__FILE__, rcToReturn=rc) return - end select + end select + end if call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -536,13 +544,13 @@ subroutine realizeConnectedCplFields(state, grid, & ! -- save field fieldList(item) = field call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & - // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + // ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) else ! remove a not connected Field from State call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) & - // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) + // ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc) end if end do diff --git a/cpl/module_cplscalars.F90 b/cpl/module_cplscalars.F90 new file mode 100644 index 000000000..2b3e5869e --- /dev/null +++ b/cpl/module_cplscalars.F90 @@ -0,0 +1,203 @@ +!> @file +!> @brief Manage cpl_scalars +!> @author mvertens@ucar.edu +!> @author modified for FV3atm by Denise.Worthen@noaa.gov @date 03-03-2024 + +!> Manage scalars in import and export states. Called by realizeConnectedCplFields +!> to set the required scalar data into a state. The scalar_value will be set into +!> a field with name flds_scalar_name. The scalar_id identifies which dimension in +!> the scalar field is given by the scalar_value. The number of scalars is used to +!> ensure that the scalar_id is within the bounds of the scalar field + +module module_cplscalars + + use ESMF, only : ESMF_Field, ESMF_Distgrid, ESMF_Grid, ESMF_State + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast + use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_FAILURE, ESMF_SUCCESS + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE, ESMF_TYPEKIND_R8, ESMF_KIND_R8 + use ESMF, only : ESMF_GridCreate, ESMF_FieldCreate, ESMF_StateGet, ESMF_DistGridCreate + use ESMF, only : ESMF_FieldGet + + implicit none + + private + public SetScalarField + public State_SetScalar + public State_GetScalar + + ! set from config + integer, public :: flds_scalar_num, flds_scalar_index_nx + integer, public :: flds_scalar_index_ny, flds_scalar_index_ntile + character(len=80), public :: flds_scalar_name + +contains + + !================================================================================ + !> Create a scalar field + !> + !> @param[inout] field an ESMF_Field + !> @param[in] flds_scalar_name the name of the scalar + !> @param[in] flds_scalar_num the number of scalars + !> @param[inout] rc a return code + !> + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 03-03-2024 + subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) + + type(ESMF_Field) , intent(inout) :: field + character(len=*) , intent(in) :: flds_scalar_name + integer , intent(in) :: flds_scalar_num + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Distgrid) :: distgrid + type(ESMF_Grid) :: grid + + character(len=*), parameter :: subname='(module_cplscalars:SetScalarField)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + ! create a DistGrid with a single index space element, which gets mapped onto DE 0. + distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & + ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), gridToFieldMap=(/2/), rc=rc) ! num of scalar values + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine SetScalarField + + !================================================================================ + !> Set scalar data into a state + !> + !> @param[inout] State an ESMF_State + !> @param[in] scalar_value the value of the scalar + !> @param[in] scalar_id the identity of the scalar + !> @param[in] flds_scalar_name the name of the scalar + !> @param[in] flds_scalar_num the number of scalars + !> @param[inout] rc a return code + !> + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 03-02-2024 + subroutine State_SetScalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! input/output arguments + real(ESMF_KIND_R8), intent(in) :: scalar_value + integer, intent(in) :: scalar_id + type(ESMF_State), intent(inout) :: State + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: lfield + type(ESMF_VM) :: vm + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + + character(len=*), parameter :: subname = ' (module_cplscalars:state_setscalar) ' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (mytask == 0) then + call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine State_SetScalar + + !=============================================================================== + !> Get scalar data from a state + !> + !> @details Obtain the field flds_scalar_name from a State and broadcast and + !> it to all PEs + !> + !> @param[in] State an ESMF_State + !> @param[in] scalar_value the value of the scalar + !> @param[in] scalar_id the identity of the scalar + !> @param[in] flds_scalar_name the name of the scalar + !> @param[in] flds_scalar_num the number of scalars + !> @param[out] rc a return code + !> + !> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov + !> @date 03-02-2024 + subroutine State_GetScalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Get scalar data from State for a particular name and broadcast it to all other pets + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(ESMF_KIND_R8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, icount + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + real(ESMF_KIND_R8) :: tmp(1) + + character(len=*), parameter :: subname = ' (module_cplscalars:state_getscalar) ' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! check item exist or not? + call ESMF_StateGet(State, itemSearch=trim(flds_scalar_name), itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (icount > 0) then + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + scalar_value = tmp(1) + else + scalar_value = 0.0_ESMF_KIND_R8 + call ESMF_LogWrite(trim(subname)//": no ESMF_Field found named: "//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + end if + + end subroutine State_GetScalar +end module module_cplscalars diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 5401e66a5..713460fe3 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -46,6 +46,9 @@ module fv3atm_cap_mod use module_cplfields, only: importFieldsValid, queryImportFields use module_cap_cpl, only: diagnose_cplFields + use module_cplscalars, only: flds_scalar_name, flds_scalar_num, & + flds_scalar_index_nx, flds_scalar_index_ny, & + flds_scalar_index_ntile implicit none private @@ -216,6 +219,7 @@ subroutine InitializeAdvertise(gcomp, rc) integer :: sloc type(ESMF_StaggerLoc) :: staggerloc + character(len=20) :: cvalue ! !------------------------------------------------------------------------ ! @@ -260,7 +264,7 @@ subroutine InitializeAdvertise(gcomp, rc) cplprint_flag = (trim(value)=="true") write(msgString,'(A,l6)') trim(subname)//' cplprint_flag = ',cplprint_flag - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) ! Read in cap debug flag call NUOPC_CompAttributeGet(gcomp, name='dbug_flag', value=value, isPresent=isPresent, isSet=isSet, rc=rc) @@ -269,7 +273,54 @@ subroutine InitializeAdvertise(gcomp, rc) read(value,*) dbug end if write(msgString,'(A,i6)') trim(subname)//' dbug = ',dbug - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + ! set cpl_scalars from config. Default to null values for standalone + flds_scalar_name = '' + flds_scalar_num = 0 + flds_scalar_index_nx = 0 + flds_scalar_index_ny = 0 + flds_scalar_index_ntile = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(msgString,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(msgString), ESMF_LOGMSG_INFO) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(msgString,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(msgString), ESMF_LOGMSG_INFO) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(msgString,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(msgString), ESMF_LOGMSG_INFO) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ntile + write(msgString,*) flds_scalar_index_ntile + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ntile = '//trim(msgString), ESMF_LOGMSG_INFO) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif !------------------------------------------------------------------------ ! get config variables diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index df28a246b..07f059023 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -474,6 +474,12 @@ end subroutine init_advertise ! subroutine init_realize(nest, importState, exportState, clock, rc) ! + + use module_cplscalars, only : flds_scalar_name, flds_scalar_num, & + flds_scalar_index_nx, flds_scalar_index_ny, & + flds_scalar_index_ntile + use module_cplscalars, only : State_SetScalar + type(ESMF_GridComp) :: nest type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -481,10 +487,18 @@ subroutine init_realize(nest, importState, exportState, clock, rc) ! !*** local variables ! + real(ESMF_KIND_R8) :: scalardim(3) type(ESMF_Grid) :: grid + scalardim = 0.0 + ! cpl_scalars for export state + scalardim(1) = real(Atmos%mlon,8) + scalardim(2) = real(Atmos%mlat,8) + scalardim(3) = 1.0 + if (.not. Atmos%regional)scalardim(3) = 6.0 + rc = ESMF_SUCCESS -! + ! access this domain grid call ESMF_GridCompGet(nest, grid=grid, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -495,6 +509,16 @@ subroutine init_realize(nest, importState, exportState, clock, rc) exportFieldsInfo, 'FV3 Export', exportFields, 0.0_ESMF_KIND_R8, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (flds_scalar_num > 0) then + ! Set the scalar data into the exportstate + call State_SetScalar(scalardim(1), flds_scalar_index_nx, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call State_SetScalar(scalardim(2), flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call State_SetScalar(scalardim(3), flds_scalar_index_ntile, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + ! -- initialize export fields if applicable call setup_exportdata(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return From 383687ef8752af2408d882c47a4f3cbb4d3121ee Mon Sep 17 00:00:00 2001 From: JONG KIM Date: Thu, 4 Apr 2024 16:34:52 -0400 Subject: [PATCH 6/9] cubed_sphere hash fix to f060e85 (#817) * Update cubed_sphere@f060e85 hash: a bug fix in the HAILCAST diagnostic code (units issue) --- atmos_cubed_sphere | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 6663459e5..f060e857f 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 6663459e58a04e3bda2157d5891d227e3abc3c7a +Subproject commit f060e857f184a4e8e988d8563794066525357336 From 37e7d4859db4eb75472091abc650831060037715 Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Sun, 14 Apr 2024 13:00:07 -0400 Subject: [PATCH 7/9] bug fixes: kchunk3d ignored, hailwat uninitialized in dycore, tile_num wrong for nests (#806) * nesting fixes 1. Initialize hailwat index in dynamical core. 2. Use the correct tile number for nests in atmos_model.F90. * remove unneeded write statements * Fix kchunk3d in io/module_write_netcdf.F90 --------- Co-authored-by: Dusan Jovic --- atmos_cubed_sphere | 2 +- atmos_model.F90 | 3 ++- io/module_write_netcdf.F90 | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index f060e857f..0301022fc 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit f060e857f184a4e8e988d8563794066525357336 +Subproject commit 0301022fc73b23f20b42b52e999fa47752708ef0 diff --git a/atmos_model.F90 b/atmos_model.F90 index 91a566671..a2ca32a75 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -582,7 +582,8 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) call atmosphere_diag_axes (Atmos%axes) call atmosphere_etalvls (Atmos%ak, Atmos%bk, flip=flip_vc) - call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, tile_num) + tile_num=-1 + call atmosphere_control_data (isc, iec, jsc, jec, nlev, p_hydro, hydro, global_tile_num=tile_num) allocate (Atmos%lon(nlon,nlat), Atmos%lat(nlon,nlat)) call atmosphere_grid_ctr (Atmos%lon, Atmos%lat) diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index 2b5fcacc1..b0164151e 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -407,7 +407,7 @@ end function nf_set_log_level if (is_cubed_sphere) then chunksizes = [im, jm, lm, tileCount, 1] else - chunksizes = [ichunk3d(grid_id), jchunk3d(grid_id), fldlev(i), 1] + chunksizes = [ichunk3d(grid_id), jchunk3d(grid_id), min(kchunk3d(grid_id),fldlev(i)), 1] end if ncerr = nf90_def_var_chunking(ncid, varids(i), NF90_CHUNKED, chunksizes) ; NC_ERR_STOP(ncerr) end if From 979bcab28f63b37411698cd9d23d04d0b0fe3a7e Mon Sep 17 00:00:00 2001 From: Dusan Jovic <48258889+DusanJovic-NOAA@users.noreply.github.com> Date: Wed, 17 Apr 2024 13:42:06 -0400 Subject: [PATCH 8/9] Update dycore to remove compiler warnings (#813) * Update atmos_cubed_sphere and add compile definition BYPASS_BREED_SLP_INLINE to dycore * Pass correct mpi communicator type to post_alctvars routine in inline post --- CMakeLists.txt | 3 ++- atmos_cubed_sphere | 2 +- io/post_fv3.F90 | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0d76a8f25..c310110ca 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -9,7 +9,7 @@ option(ENABLE_DOCS "Enable generation of doxygen-based documentation." OFF) # Determine whether or not to generate documentation. if(ENABLE_DOCS) find_package(Doxygen REQUIRED) - add_subdirectory(docs) + add_subdirectory(docs) endif() # Enable CI build & unit testing: @@ -38,6 +38,7 @@ if(MOVING_NEST) set(MOVING_NEST ON) endif() add_subdirectory(atmos_cubed_sphere) +target_compile_definitions(fv3 PRIVATE BYPASS_BREED_SLP_INLINE) ############################################################################### ### fv3atm diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 0301022fc..97114888f 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 0301022fc73b23f20b42b52e999fa47752708ef0 +Subproject commit 97114888f529c2df70ed4a350fd2428df74839ff diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index e00accfa0..c0ba56dda 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -136,7 +136,7 @@ subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & wrt_int_state%out_grid_info(grid_id)%jm, & wrt_int_state%out_grid_info(grid_id)%lm, & mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) + mpicomp%mpi_val,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po From da95cc428d8b626e99250fd57a4279b4980044f8 Mon Sep 17 00:00:00 2001 From: WenMeng-NOAA <48260754+WenMeng-NOAA@users.noreply.github.com> Date: Fri, 19 Apr 2024 12:36:43 -0400 Subject: [PATCH 9/9] Update upp submodule (#811) * Update github workflow. Update gcc to 12 and mpi to openmpi * Add 'spack clean' to reduce the size of the cache files * Split GCC.yml workflow into two jobs, build_spack and build_fv3atm * Update github workflow. Add mpich * Update github actions to v4 * Use action/cache/restore in build_fv3atm job * update upp revision to 5faac75 * Update GCC.yml --------- Co-authored-by: Dusan Jovic --- .github/workflows/GCC.yml | 73 ++++++++++++++++++++++++++++++--------- upp | 2 +- 2 files changed, 58 insertions(+), 17 deletions(-) diff --git a/.github/workflows/GCC.yml b/.github/workflows/GCC.yml index 4f1b7a894..0da81e763 100644 --- a/.github/workflows/GCC.yml +++ b/.github/workflows/GCC.yml @@ -15,33 +15,34 @@ on: - develop jobs: - GCC: + build_spack: runs-on: ubuntu-latest strategy: matrix: - cmake_opts: ["-D32BIT=ON", "-D32BIT=OFF"] - gcc_ver: ["11"] - mpi: ["mpich"] + gcc_ver: ["12"] + mpi: ["mpich", "openmpi"] steps: - - name: install-doxygen - run: | - sudo apt-get install doxygen graphviz - - name: checkout-fv3atm - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: path: ${{ github.workspace }}/fv3atm submodules: recursive + - name: install-cmake + run: | + cd ${{ github.workspace }} + curl -f -s -S -R -L https://github.com/Kitware/CMake/releases/download/v3.29.2/cmake-3.29.2-Linux-x86_64.tar.gz | tar -zx + echo "${{ github.workspace }}/cmake-3.29.2-linux-x86_64/bin" >> $GITHUB_PATH + - name: cache-spack id: cache-spack - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ${{ github.workspace }}/spack-develop - key: spack-${{ hashFiles('fv3atm/ci/spack.yaml') }}-gcc${{ matrix.gcc_ver }}-2-${{ matrix.cmake_opts }}-${{ matrix.mpich }} + key: spack-${{ hashFiles('fv3atm/ci/spack.yaml') }}-gcc${{ matrix.gcc_ver }}-${{ matrix.mpi }} # Building dependencies takes 40+ min - name: spack-install @@ -58,6 +59,42 @@ jobs: spack config add "packages:mpi:require:'${{ matrix.mpi }}'" spack concretize |& tee ${SPACK_ENV}/log.concretize spack install -j2 --fail-fast + spack clean --all + + build_fv3atm: + needs: build_spack + runs-on: ubuntu-latest + + strategy: + matrix: + cmake_opts: ["-D32BIT=ON", "-D32BIT=OFF"] + gcc_ver: ["12"] + mpi: ["mpich", "openmpi"] + + steps: + + - name: install-doxygen + run: | + sudo apt-get install doxygen graphviz + + - name: install-cmake + run: | + cd ${{ github.workspace }} + curl -f -s -S -R -L https://github.com/Kitware/CMake/releases/download/v3.29.2/cmake-3.29.2-Linux-x86_64.tar.gz | tar -zx + echo "${{ github.workspace }}/cmake-3.29.2-linux-x86_64/bin" >> $GITHUB_PATH + + - name: checkout-fv3atm + uses: actions/checkout@v4 + with: + path: ${{ github.workspace }}/fv3atm + submodules: recursive + + - name: cache-spack + id: cache-spack + uses: actions/cache/restore@v4 + with: + path: ${{ github.workspace }}/spack-develop + key: spack-${{ hashFiles('fv3atm/ci/spack.yaml') }}-gcc${{ matrix.gcc_ver }}-${{ matrix.mpi }} - name: build-fv3atm run: | @@ -70,20 +107,24 @@ jobs: mkdir ${GITHUB_WORKSPACE}/build sed -i 's/doc /upp_doc /' upp/docs/CMakeLists.txt cd ${GITHUB_WORKSPACE}/build + export CC=mpicc + export CXX=mpicxx + export FC=mpif90 + cat /home/runner/work/fv3atm/fv3atm/spack-develop/opt/spack/linux-ubuntu22.04-zen2/gcc-12.3.0/fms-2023.04-*/lib/cmake/fms/fms-config.cmake cmake ${GITHUB_WORKSPACE}/fv3atm -DBUILD_TESTING=ON ${{ matrix.cmake_opts }} -DENABLE_DOCS=ON make -j2 ls -l /home/runner/work/fv3atm/fv3atm/fv3atm/io - - uses: actions/upload-artifact@v3 + - uses: actions/upload-artifact@v4 with: - name: docs + name: docs-gcc${{ matrix.gcc_ver }}-${{ matrix.mpi }}-${{ matrix.cmake_opts }} path: | build/docs/html - + - name: debug-artifacts - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 if: ${{ failure() }} with: - name: ccpp_prebuild_logs + name: ccpp_prebuild_logs-gcc${{ matrix.gcc_ver }}-${{ matrix.mpi }}-${{ matrix.cmake_opts }} path: ${{ github.workspace }}/build/ccpp/ccpp_prebuild.* diff --git a/upp b/upp index 945cb2cef..5faac752d 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit 945cb2cef5e8bd5949afd4f0fc35c4fb6e95a1bf +Subproject commit 5faac752d9550d3570705358fa1eb3f5ac78a786