From 679ad3848906eb742ddb997ce22a5fa52d7cd68c Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 11:08:12 -0600 Subject: [PATCH 01/10] Introduce lilac_init_pio_mod This allows us to have a portion of shr_pio_mod that is truly shared between the drivers and a portion that is driver-specific. This file is currently identical to components/cpl7/driver/main/init_pio_mod.F90, except (1) the module name has been changed to lilac_init_pio_mod (rather than init_pio_mod), (2) all init_pio_* routines have been renamed to lilac_init_pio_*, and (3) this description comment has been added. This needs to be coordinated with a branch in the CESM_share repository. --- lilac/src/lilac_init_pio_mod.F90 | 774 +++++++++++++++++++++++++++++++ lilac/src/lilac_mod.F90 | 8 +- 2 files changed, 778 insertions(+), 4 deletions(-) create mode 100644 lilac/src/lilac_init_pio_mod.F90 diff --git a/lilac/src/lilac_init_pio_mod.F90 b/lilac/src/lilac_init_pio_mod.F90 new file mode 100644 index 0000000000..b3f8130126 --- /dev/null +++ b/lilac/src/lilac_init_pio_mod.F90 @@ -0,0 +1,774 @@ +module lilac_init_pio_mod + + ! As of 2022-07-05, this file is identical to + ! components/cpl7/driver/main/init_pio_mod.F90, except (1) the module name has been + ! changed to lilac_init_pio_mod (rather than init_pio_mod), (2) all init_pio_* routines + ! have been renamed to lilac_init_pio_*, and (3) this description comment has been + ! added. + + use pio + use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid + use shr_kind_mod, only : shr_kind_CS, shr_kind_cl, shr_kind_in + use shr_file_mod, only : shr_file_getunit, shr_file_freeunit + use shr_log_mod, only : shr_log_unit + use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr + use shr_sys_mod, only : shr_sys_abort +#ifndef NO_MPI2 + use mpi, only : mpi_comm_null, mpi_comm_world, mpi_finalize +#endif + implicit none +#ifdef NO_MPI2 +#include +#endif + private + public :: lilac_init_pio_init1 + public :: lilac_init_pio_init2 + public :: lilac_init_pio_finalize + + integer :: io_comm + logical :: pio_async_interface + integer :: pio_debug_level=0, pio_blocksize=0 + integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 + integer :: pio_rearr_opt_comm_type, pio_rearr_opt_fcd + logical :: pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend + integer :: pio_rearr_opt_c2i_max_pend_req + logical :: pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend + integer :: pio_rearr_opt_i2c_max_pend_req + integer :: total_comps=0 + +#define DEBUGI 1 + +#ifdef DEBUGI + integer :: drank +#endif + + +contains +!> +!! @public +!! @brief should be the first routine called after mpi_init. +!! It reads the pio default settings from file drv_in, namelist pio_default_inparm +!! and, if pio_async_interface is true, splits the IO tasks away from the +!! Compute tasks. It then returns the new compute comm in +!! Global_Comm and sets module variable io_comm. +!! +!< + subroutine lilac_init_pio_init1(ncomps, nlfilename, Global_Comm) + integer, intent(in) :: ncomps + character(len=*) :: nlfilename + integer, intent(inout) :: Global_Comm + + + integer :: i, pio_root, pio_stride, pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat + integer :: mpigrp_world, mpigrp, ierr, mpicom + character(*),parameter :: subName = '(lilac_init_pio_init1) ' + integer :: pelist(3,1) + + integer, allocatable :: comp_comm(:) + type(iosystem_desc_t), allocatable :: iosystems(:) + + call lilac_init_pio_read_default_namelist(nlfilename, Global_Comm, pio_stride, pio_root, pio_numiotasks, & + pio_iotype, pio_async_interface, pio_rearranger) + + pio_netcdf_ioformat = PIO_64BIT_OFFSET + call MPI_comm_rank(Global_Comm, drank, ierr) + + io_comm = MPI_COMM_NULL + allocate(pio_comp_settings(ncomps)) + do i=1,ncomps + pio_comp_settings(i)%pio_root = pio_root + pio_comp_settings(i)%pio_stride = pio_stride + pio_comp_settings(i)%pio_numiotasks = pio_numiotasks + pio_comp_settings(i)%pio_iotype = pio_iotype + pio_comp_settings(i)%pio_rearranger = pio_rearranger + pio_comp_settings(i)%pio_netcdf_ioformat = pio_netcdf_ioformat + end do + + if(pio_debug_level>0) then + if(drank==0) then + write(shr_log_unit,*) 'Setting pio_debuglevel : ',pio_debug_level + end if + call pio_setdebuglevel(pio_debug_level) + endif + if(pio_async_interface) then +#ifdef NO_MPI2 + call shr_sys_abort(subname//':: async IO requires an MPI2 compliant MPI library') +#else + + pelist(1,1) = pio_root + pelist(2,1) = pio_root + (pio_numiotasks-1)*pio_stride + pelist(3,1) = pio_stride + + call mpi_comm_group(GLOBAL_COMM, mpigrp_world, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_group mpigrp_world') + call mpi_group_range_incl(mpigrp_world, 1, pelist, mpigrp,ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_group_range_incl mpigrp') + call mpi_comm_create(GLOBAL_COMM, mpigrp, io_comm, ierr) + + call mpi_group_range_excl(mpigrp_world, 1, pelist, mpigrp,ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_group_range_incl mpigrp') + call mpi_comm_create(GLOBAL_COMM, mpigrp, mpicom, ierr) + Global_COMM=mpicom + if(io_comm .ne. MPI_COMM_NULL) then + allocate(iosystems(ncomps), comp_comm(ncomps)) + comp_comm = MPI_COMM_NULL + call pio_init(iosystems, MPI_COMM_WORLD, comp_comm, io_comm, PIO_REARR_BOX) + ! IO_COMM does not return until program ends + print *,__FILE__,__LINE__,'io tasks returned from pio' + deallocate(iosystems, comp_comm) + call mpi_finalize(ierr) + stop + endif + +#endif + end if + total_comps = ncomps + end subroutine lilac_init_pio_init1 +!> +!! @public +!! @brief if pio_async_interface is true, tasks in io_comm do not return from this subroutine. +!! +!! if pio_async_interface is false each component namelist pio_inparm is read from compname_modelio.nml +!! Then a subset of each components compute tasks are Identified as IO tasks using the root, stride and count +!! variables to select the tasks. +!! +!< + + + subroutine lilac_init_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + use shr_string_mod, only : shr_string_toLower + integer, intent(in) :: comp_id(:) + logical, intent(in) :: comp_iamin(:) + character(len=*), intent(in) :: comp_name(:) + integer, intent(in) :: comp_comm(:), comp_comm_iam(:) + integer :: i + character(len=shr_kind_cl) :: nlfilename, cname + integer :: ret + character(*), parameter :: subName = '(lilac_init_pio_init2) ' + + ! 0 is a valid value of pio_buffer_size_limit + if(pio_buffer_size_limit>=0) then + if(comp_comm_iam(1)==0) then + write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + end if + call pio_set_buffer_size_limit(pio_buffer_size_limit) + endif + if(pio_blocksize>0) then + if(comp_comm_iam(1)==0) then + write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + end if + call pio_set_blocksize(pio_blocksize) + endif + ! Correct the total_comps value which may be lower in nuopc + total_comps = size(comp_iamin) + allocate(iosystems(total_comps)) + + if(pio_async_interface) then +#ifdef PIO2 + call pio_init(iosystems, MPI_COMM_WORLD, comp_comm, io_comm, PIO_REARR_BOX) +#endif +! do i=1,total_comps +! ret = pio_set_rearr_opts(iosystems(i), pio_rearr_opt_comm_type,& +! pio_rearr_opt_fcd,& +! pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend,& +! pio_rearr_opt_c2i_max_pend_req,& +! pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend,& +! pio_rearr_opt_i2c_max_pend_req) +! if(ret /= PIO_NOERR) then +! write(shr_log_unit,*) "ERROR: Setting rearranger options failed" +! end if +! end do +! i=1 + else + do i=1,total_comps + if(comp_iamin(i)) then + cname = comp_name(i) + if(len_trim(cname) <= 3) then + nlfilename=trim(shr_string_toLower(cname))//'_modelio.nml' + else + nlfilename=trim(shr_string_toLower(cname(1:3)))//'_modelio.nml_'//cname(4:8) + endif + + call lilac_init_pio_read_component_namelist(nlfilename , comp_comm(i), pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_root, pio_comp_settings(i)%pio_numiotasks, & + pio_comp_settings(i)%pio_iotype, pio_comp_settings(i)%pio_rearranger, & + pio_comp_settings(i)%pio_netcdf_ioformat) + + call pio_init(comp_comm_iam(i), comp_comm(i), pio_comp_settings(i)%pio_numiotasks, 0, & + pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), & + base=pio_comp_settings(i)%pio_root) + ret = pio_set_rearr_opts(iosystems(i), pio_rearr_opt_comm_type,& + pio_rearr_opt_fcd,& + pio_rearr_opt_c2i_enable_hs, pio_rearr_opt_c2i_enable_isend,& + pio_rearr_opt_c2i_max_pend_req,& + pio_rearr_opt_i2c_enable_hs, pio_rearr_opt_i2c_enable_isend,& + pio_rearr_opt_i2c_max_pend_req) + if(ret /= PIO_NOERR) then + write(shr_log_unit,*) "ERROR: Setting rearranger options failed" + end if + end if + end do + end if + + allocate(io_compid(total_comps), io_compname(total_comps)) + + io_compid = comp_id + io_compname = comp_name + do i=1,total_comps + if(comp_iamin(i) .and. (comp_comm_iam(i) == 0)) then + write(shr_log_unit,*) io_compname(i),' : pio_numiotasks = ',pio_comp_settings(i)%pio_numiotasks + write(shr_log_unit,*) io_compname(i),' : pio_stride = ',pio_comp_settings(i)%pio_stride + write(shr_log_unit,*) io_compname(i),' : pio_rearranger = ',pio_comp_settings(i)%pio_rearranger + write(shr_log_unit,*) io_compname(i),' : pio_root = ',pio_comp_settings(i)%pio_root + write(shr_log_unit,*) io_compname(i),' : pio_iotype = ',pio_comp_settings(i)%pio_iotype + end if + enddo + + end subroutine lilac_init_pio_init2 + +!=============================================================================== + subroutine lilac_init_pio_finalize( ) + integer :: ierr + integer :: i + do i=1,total_comps + call pio_finalize(iosystems(i), ierr) + end do + + end subroutine lilac_init_pio_finalize + +!=============================================================================== + + + + subroutine lilac_init_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, pio_numiotasks, & + pio_iotype, pio_async_interface, pio_rearranger) + + character(len=*), intent(in) :: nlfilename + integer, intent(in) :: Comm + logical, intent(out) :: pio_async_interface + integer, intent(out) :: pio_stride, pio_root, pio_numiotasks, pio_iotype, pio_rearranger + + character(len=shr_kind_cs) :: pio_typename + character(len=shr_kind_cs) :: pio_rearr_comm_type, pio_rearr_comm_fcd + integer :: pio_netcdf_ioformat + integer :: pio_rearr_comm_max_pend_req_comp2io + logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io + integer :: pio_rearr_comm_max_pend_req_io2comp + logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp + character(*),parameter :: subName = '(lilac_init_pio_read_default_namelist) ' + + integer :: iam, ierr, npes, unitn + logical :: iamroot + namelist /pio_default_inparm/ & + pio_async_interface, pio_debug_level, pio_blocksize, & + pio_buffer_size_limit, pio_root, pio_numiotasks, pio_stride, & + pio_rearr_comm_type, pio_rearr_comm_fcd, & + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp + + + call mpi_comm_rank(Comm, iam , ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') + call mpi_comm_size(Comm, npes, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') + + if(iam==0) then + iamroot=.true. + else + iamroot=.false. + end if + + !-------------------------------------------------------------------------- + ! read io nml parameters + !-------------------------------------------------------------------------- + pio_stride = -99 ! set based on pio_numiotasks value when initialized < 0 + pio_numiotasks = -99 ! set based on pio_stride value when initialized < 0 + pio_root = -99 + pio_typename = 'nothing' + pio_blocksize= -99 ! io blocking size set internally in pio when < 0 + pio_buffer_size_limit = -99 ! io task memory buffer maximum set internally in pio when < 0 + pio_debug_level = 0 ! no debug info by default + pio_async_interface = .false. ! pio tasks are a subset of component tasks + pio_rearranger = PIO_REARR_SUBSET + pio_netcdf_ioformat = PIO_64BIT_OFFSET + pio_rearr_comm_type = 'p2p' + pio_rearr_comm_fcd = '2denable' + pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_enable_hs_comp2io = .true. + pio_rearr_comm_enable_isend_comp2io = .false. + pio_rearr_comm_max_pend_req_io2comp = 0 + pio_rearr_comm_enable_hs_io2comp = .true. + pio_rearr_comm_enable_isend_io2comp = .false. + + if(iamroot) then + unitn=shr_file_getunit() + open( unitn, file=trim(nlfilename), status='old' , iostat=ierr) + if(ierr/=0) then + write(shr_log_unit,*) 'File ',trim(nlfilename),' not found, setting default values.' + else + ierr = 1 + do while( ierr /= 0 ) + read(unitn,nml=pio_default_inparm,iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' end of file or end of record condition '//trim(nlfilename) ) + end if + end do + close(unitn) + call shr_file_freeUnit( unitn ) + + call lilac_init_pio_getiotypefromname(pio_typename, pio_iotype, pio_iotype_netcdf) + end if + end if + + call lilac_init_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & + iamroot, pio_rearranger, pio_netcdf_ioformat) + call shr_mpi_bcast(pio_debug_level, Comm) + call shr_mpi_bcast(pio_root, Comm) + call shr_mpi_bcast(pio_numiotasks, Comm) + call shr_mpi_bcast(pio_blocksize, Comm) + call shr_mpi_bcast(pio_buffer_size_limit, Comm) + call shr_mpi_bcast(pio_async_interface, Comm) + call shr_mpi_bcast(pio_rearranger, Comm) + call shr_mpi_bcast(pio_stride, Comm) + if (npes == 1) then + pio_rearr_comm_max_pend_req_comp2io = 0 + pio_rearr_comm_max_pend_req_io2comp = 0 + endif + + + call lilac_init_pio_rearr_opts_set(Comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp, pio_numiotasks) + + end subroutine lilac_init_pio_read_default_namelist + + subroutine lilac_init_pio_read_component_namelist(nlfilename, Comm, pio_stride, pio_root, & + pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat) + character(len=*), intent(in) :: nlfilename + integer, intent(in) :: Comm + + integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks + integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat + character(len=SHR_KIND_CS) :: pio_typename + character(len=SHR_KIND_CS) :: pio_netcdf_format + integer :: unitn + + integer :: iam, ierr, npes + logical :: iamroot + character(*),parameter :: subName = '(lilac_init_pio_read_component_namelist) ' + integer :: pio_default_stride, pio_default_root, pio_default_numiotasks, pio_default_iotype + integer :: pio_default_rearranger, pio_default_netcdf_ioformat + + namelist /pio_inparm/ pio_stride, pio_root, pio_numiotasks, & + pio_typename, pio_rearranger, pio_netcdf_format + + + + call mpi_comm_rank(Comm, iam , ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') + call mpi_comm_size(Comm, npes, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') + + if(iam==0) then + iamroot=.true. + else + iamroot=.false. + end if + + pio_default_stride = pio_stride + pio_default_root = pio_root + pio_default_numiotasks = pio_numiotasks + pio_default_iotype = pio_iotype + pio_default_rearranger = pio_rearranger + pio_default_netcdf_ioformat = PIO_64BIT_DATA + + !-------------------------------------------------------------------------- + ! read io nml parameters + !-------------------------------------------------------------------------- + pio_stride = -99 ! set based on pio_numiotasks value when initialized < 0 + pio_numiotasks = -99 ! set based on pio_stride value when initialized < 0 + pio_root = -99 + pio_typename = 'nothing' + pio_rearranger = -99 + pio_netcdf_format = '64bit_offset' + + if(iamroot) then + unitn=shr_file_getunit() + open( unitn, file=trim(nlfilename), status='old' , iostat=ierr) + if( ierr /= 0) then + write(shr_log_unit,*) 'No ',trim(nlfilename),' found, using defaults for pio settings' + pio_stride = pio_default_stride + pio_root = pio_default_root + pio_numiotasks = pio_default_numiotasks + pio_iotype = pio_default_iotype + pio_rearranger = pio_default_rearranger + pio_netcdf_ioformat = pio_default_netcdf_ioformat + else + ierr = 1 + do while( ierr /= 0 ) + read(unitn,nml=pio_inparm,iostat=ierr) + if (ierr < 0) then + call shr_sys_abort( subname//':: namelist read returns an'// & + ' end of file or end of record condition' ) + end if + end do + close(unitn) + call shr_file_freeUnit( unitn ) + + call lilac_init_pio_getiotypefromname(pio_typename, pio_iotype, pio_default_iotype) + call lilac_init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + end if + if(pio_stride== -99) then + if (pio_numiotasks > 0) then + pio_stride = npes/pio_numiotasks + else + pio_stride = pio_default_stride + endif + endif + if(pio_root == -99) pio_root = pio_default_root + if(pio_rearranger == -99) pio_rearranger = pio_default_rearranger + if(pio_numiotasks == -99) then + pio_numiotasks = npes/pio_stride + endif + endif + + + + call lilac_init_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & + iamroot, pio_rearranger, pio_netcdf_ioformat) + + + end subroutine lilac_init_pio_read_component_namelist + + subroutine lilac_init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + use shr_string_mod, only : shr_string_toupper + character(len=*), intent(inout) :: pio_netcdf_format + integer, intent(out) :: pio_netcdf_ioformat + integer, intent(in) :: pio_default_netcdf_ioformat + + pio_netcdf_format = shr_string_toupper(pio_netcdf_format) + if ( pio_netcdf_format .eq. 'CLASSIC' ) then + pio_netcdf_ioformat = 0 + elseif ( pio_netcdf_format .eq. '64BIT_OFFSET' ) then + pio_netcdf_ioformat = PIO_64BIT_OFFSET + elseif ( pio_netcdf_format .eq. '64BIT_DATA' ) then + pio_netcdf_ioformat = PIO_64BIT_DATA + else + pio_netcdf_ioformat = pio_default_netcdf_ioformat + endif + + end subroutine lilac_init_pio_getioformatfromname + + + subroutine lilac_init_pio_getiotypefromname(typename, iotype, defaulttype) + use shr_string_mod, only : shr_string_toupper + character(len=*), intent(inout) :: typename + integer, intent(out) :: iotype + integer, intent(in) :: defaulttype + + typename = shr_string_toupper(typename) + if ( typename .eq. 'NETCDF' ) then + iotype = pio_iotype_netcdf + else if ( typename .eq. 'PNETCDF') then + iotype = pio_iotype_pnetcdf + else if ( typename .eq. 'NETCDF4P') then + iotype = pio_iotype_netcdf4p + else if ( typename .eq. 'NETCDF4C') then + iotype = pio_iotype_netcdf4c + else if ( typename .eq. 'NOTHING') then + iotype = defaulttype + else if ( typename .eq. 'DEFAULT') then + iotype = defaulttype + else + write(shr_log_unit,*) 'lilac_init_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + iotype=pio_iotype_netcdf + end if + + end subroutine lilac_init_pio_getiotypefromname + +!=============================================================================== + subroutine lilac_init_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & + pio_iotype, iamroot, pio_rearranger, pio_netcdf_ioformat) + integer, intent(in) :: npes, mycomm + integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks + integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat + logical, intent(in) :: iamroot + character(*),parameter :: subName = '(lilac_init_pio_namelist_set) ' + + call shr_mpi_bcast(pio_iotype , mycomm) + call shr_mpi_bcast(pio_stride , mycomm) + call shr_mpi_bcast(pio_root , mycomm) + call shr_mpi_bcast(pio_numiotasks, mycomm) + call shr_mpi_bcast(pio_rearranger, mycomm) + call shr_mpi_bcast(pio_netcdf_ioformat, mycomm) + + if (pio_root<0) then + pio_root = 1 + endif + if(.not. pio_async_interface) then + pio_root = min(pio_root,npes-1) +! If you are asking for parallel IO then you should use at least two io pes + if(npes > 1 .and. pio_numiotasks == 1 .and. & + (pio_iotype .eq. PIO_IOTYPE_PNETCDF .or. & + pio_iotype .eq. PIO_IOTYPE_NETCDF4P)) then + pio_numiotasks = 2 + pio_stride = min(pio_stride, npes/2) + endif + endif + + !-------------------------------------------------------------------------- + ! check/set/correct io pio parameters + !-------------------------------------------------------------------------- + if (pio_stride>0.and.pio_numiotasks<0) then + pio_numiotasks = max(1,npes/pio_stride) + else if(pio_numiotasks>0 .and. pio_stride<0) then + pio_stride = max(1,npes/pio_numiotasks) + else if(pio_numiotasks<0 .and. pio_stride<0) then + pio_stride = max(1,npes/4) + pio_numiotasks = max(1,npes/pio_stride) + end if + if(pio_stride == 1 .and. .not. pio_async_interface) then + pio_root = 0 + endif + if(pio_rearranger .ne. PIO_REARR_SUBSET .and. pio_rearranger .ne. PIO_REARR_BOX) then + write(shr_log_unit,*) 'pio_rearranger value, ',pio_rearranger,& + ', not supported - using PIO_REARR_BOX' + pio_rearranger = PIO_REARR_BOX + + endif + + + if (.not. pio_async_interface .and. & + pio_root + (pio_stride)*(pio_numiotasks-1) >= npes .or. & + pio_stride<=0 .or. pio_numiotasks<=0 .or. pio_root < 0 .or. & + pio_root > npes-1 ) then + if(npes<100) then + pio_stride = max(1,npes/4) + else if(npes<1000) then + pio_stride = max(1,npes/8) + else + pio_stride = max(1,npes/16) + end if + if(pio_stride>1) then + pio_numiotasks = npes/pio_stride + pio_root = min(1,npes-1) + else + pio_numiotasks = npes + pio_root = 0 + end if + if( iamroot) then + write(shr_log_unit,*) 'pio_stride, iotasks or root out of bounds - resetting to defaults: ',& + pio_stride,pio_numiotasks, pio_root + end if + end if + + end subroutine lilac_init_pio_namelist_set + + ! This subroutine sets the global PIO rearranger options + ! The input args that represent the rearranger options are valid only + ! on the root proc of comm + ! The rearranger options are passed to PIO_Init() in lilac_init_pio_init2() + subroutine lilac_init_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & + pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & + pio_rearr_comm_enable_isend_comp2io, & + pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & + pio_rearr_comm_enable_isend_io2comp, & + pio_numiotasks) + integer(SHR_KIND_IN), intent(in) :: comm + character(len=shr_kind_cs), intent(in) :: pio_rearr_comm_type, pio_rearr_comm_fcd + integer, intent(in) :: pio_rearr_comm_max_pend_req_comp2io + logical, intent(in) :: pio_rearr_comm_enable_hs_comp2io + logical, intent(in) :: pio_rearr_comm_enable_isend_comp2io + integer, intent(in) :: pio_rearr_comm_max_pend_req_io2comp + logical, intent(in) :: pio_rearr_comm_enable_hs_io2comp + logical, intent(in) :: pio_rearr_comm_enable_isend_io2comp + integer, intent(in) :: pio_numiotasks + + character(*), parameter :: subname = '(lilac_init_pio_rearr_opts_set) ' + integer, parameter :: NUM_REARR_COMM_OPTS = 8 + integer, parameter :: PIO_REARR_COMM_DEF_MAX_PEND_REQ = 64 + ! Automatically reset if the number of maximum pending requests is set to 0 + integer, parameter :: REARR_COMM_DEF_MAX_PEND_REQ_RESET = 0 + integer(SHR_KIND_IN), dimension(NUM_REARR_COMM_OPTS) :: buf + integer :: rank, ierr + + call mpi_comm_rank(comm, rank, ierr) + call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') + + buf = 0 + ! buf(1) = comm_type + ! buf(2) = comm_fcd + ! buf(3) = max_pend_req_comp2io + ! buf(4) = enable_hs_comp2io + ! buf(5) = enable_isend_comp2io + ! buf(6) = max_pend_req_io2comp + ! buf(7) = enable_hs_io2comp + ! buf(8) = enable_isend_io2comp + if(rank == 0) then + ! buf(1) = comm_type + select case(pio_rearr_comm_type) + case ("p2p") + case ("default") + buf(1) = pio_rearr_comm_p2p + case ("coll") + buf(1) = pio_rearr_comm_coll + case default + write(shr_log_unit,*) "Invalid PIO rearranger comm type, ", pio_rearr_comm_type + write(shr_log_unit,*) "Resetting PIO rearrange comm type to p2p" + buf(1) = pio_rearr_comm_p2p + end select + + ! buf(2) = comm_fcd + select case(pio_rearr_comm_fcd) + case ("2denable") + case ("default") + buf(2) = pio_rearr_comm_fc_2d_enable + case ("io2comp") + buf(2) = pio_rearr_comm_fc_1d_io2comp + case ("comp2io") + buf(2) = pio_rearr_comm_fc_1d_comp2io + case ("disable") + buf(2) = pio_rearr_comm_fc_2d_disable + case default + write(shr_log_unit,*) "Invalid PIO rearranger comm flow control direction, ", pio_rearr_comm_fcd + write(shr_log_unit,*) "Resetting PIO rearrange comm flow control direction to 2denable" + buf(2) = pio_rearr_comm_fc_2d_enable + end select + + ! buf(3) = max_pend_req_comp2io + if((pio_rearr_comm_max_pend_req_comp2io <= 0) .and. & + (pio_rearr_comm_max_pend_req_comp2io /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then + + if(pio_rearr_comm_max_pend_req_comp2io /= REARR_COMM_DEF_MAX_PEND_REQ_RESET) then + write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (comp2io), ",& + pio_rearr_comm_max_pend_req_comp2io + else + write(shr_log_unit, *) "User-specified PIO rearranger comm max pend req (comp2io), ",& + pio_rearr_comm_max_pend_req_comp2io, " (value will be reset as requested) " + end if + + ! Small multiple of pio_numiotasks has proven to perform + ! well empirically, and we do not want to allow maximum for + ! very large process count runs. Can improve this by + ! communicating between iotasks first, and then non-iotasks + ! to iotasks (TO DO) + write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (comp2io) to ", & + max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) + buf(3) = max(PIO_REARR_COMM_DEF_MAX_PEND_REQ, 2 * pio_numiotasks) + else + buf(3) = pio_rearr_comm_max_pend_req_comp2io + end if + + ! buf(4) = enable_hs_comp2io + if(pio_rearr_comm_enable_hs_comp2io) then + buf(4) = 1 + else + buf(4) = 0 + end if + + ! buf(5) = enable_isend_comp2io + if(pio_rearr_comm_enable_isend_comp2io) then + buf(5) = 1 + else + buf(5) = 0 + end if + + ! buf(6) = max_pend_req_io2comp + if((pio_rearr_comm_max_pend_req_io2comp <= 0) .and. & + (pio_rearr_comm_max_pend_req_io2comp /= PIO_REARR_COMM_UNLIMITED_PEND_REQ)) then + + if(pio_rearr_comm_max_pend_req_io2comp /= REARR_COMM_DEF_MAX_PEND_REQ_RESET) then + write(shr_log_unit, *) "Invalid PIO rearranger comm max pend req (io2comp), ",& + pio_rearr_comm_max_pend_req_io2comp + else + write(shr_log_unit, *) "User-specified PIO rearranger comm max pend req (io2comp), ",& + pio_rearr_comm_max_pend_req_io2comp, " (value will be reset as requested) " + end if + + write(shr_log_unit, *) "Resetting PIO rearranger comm max pend req (io2comp) to ", PIO_REARR_COMM_DEF_MAX_PEND_REQ + buf(6) = PIO_REARR_COMM_DEF_MAX_PEND_REQ + else + buf(6) = pio_rearr_comm_max_pend_req_io2comp + end if + + ! buf(7) = enable_hs_io2comp + if(pio_rearr_comm_enable_hs_io2comp) then + buf(7) = 1 + else + buf(7) = 0 + end if + + ! buf(8) = enable_isend_io2comp + if(pio_rearr_comm_enable_isend_io2comp) then + buf(8) = 1 + else + buf(8) = 0 + end if + + end if + + call shr_mpi_bcast(buf, comm) + + ! buf(1) = comm_type + ! buf(2) = comm_fcd + ! buf(3) = max_pend_req_comp2io + ! buf(4) = enable_hs_comp2io + ! buf(5) = enable_isend_comp2io + ! buf(6) = max_pend_req_io2comp + ! buf(7) = enable_hs_io2comp + ! buf(8) = enable_isend_io2comp + pio_rearr_opt_comm_type = buf(1) + pio_rearr_opt_fcd = buf(2) + pio_rearr_opt_c2i_max_pend_req = buf(3) + if(buf(4) == 0) then + pio_rearr_opt_c2i_enable_hs = .false. + else + pio_rearr_opt_c2i_enable_hs = .true. + end if + if(buf(5) == 0) then + pio_rearr_opt_c2i_enable_isend = .false. + else + pio_rearr_opt_c2i_enable_isend = .true. + end if + pio_rearr_opt_i2c_max_pend_req = buf(6) + if(buf(7) == 0) then + pio_rearr_opt_i2c_enable_hs = .false. + else + pio_rearr_opt_i2c_enable_hs = .true. + end if + if(buf(8) == 0) then + pio_rearr_opt_i2c_enable_isend = .false. + else + pio_rearr_opt_i2c_enable_isend = .true. + end if + + if(rank == 0) then + ! Log the rearranger options + write(shr_log_unit, *) "PIO rearranger options:" + write(shr_log_unit, *) " comm type = ", trim(pio_rearr_comm_type) + write(shr_log_unit, *) " comm fcd = ", trim(pio_rearr_comm_fcd) + if(pio_rearr_opt_c2i_max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opt_c2i_max_pend_req + end if + write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opt_c2i_enable_hs + write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opt_c2i_enable_isend + if(pio_rearr_opt_i2c_max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + else + write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opt_i2c_max_pend_req + end if + write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opt_i2c_enable_hs + write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opt_i2c_enable_isend + end if + end subroutine +!=============================================================================== + +end module lilac_init_pio_mod diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index 6eb17d008c..a789a8c6ae 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -11,7 +11,6 @@ module lilac_mod use mct_mod , only : mct_world_init ! shr code routines - use shr_pio_mod , only : shr_pio_init1, shr_pio_init2 use shr_sys_mod , only : shr_sys_abort use shr_kind_mod , only : r8 => shr_kind_r8 @@ -25,6 +24,7 @@ module lilac_mod use lilac_history , only : lilac_history_write use lilac_methods , only : chkerr use lilac_constants, only : logunit + use lilac_init_pio_mod, only : lilac_init_pio_init1, lilac_init_pio_init2 use ctsm_LilacCouplingFields, only : create_a2l_field_list, create_l2a_field_list use ctsm_LilacCouplingFields, only : complete_a2l_field_list, complete_l2a_field_list use ctsm_LilacCouplingFields, only : a2l_fields @@ -199,7 +199,7 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & ! AFTER call to MPI_init (which is in the host atm driver) and ! BEFORE call to ESMF_Initialize !------------------------------------------------------------------------- - call shr_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) + call lilac_init_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. @@ -231,8 +231,8 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- ! Initialize PIO with second initialization !------------------------------------------------------------------------- - call shr_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) - call ESMF_LogWrite(subname//"initialized shr_pio_init2 ...", ESMF_LOGMSG_INFO) + call lilac_init_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) + call ESMF_LogWrite(subname//"initialized lilac_init_pio_init2 ...", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- ! Initial lilac atmosphere cap module variables From 60499d525462c6215dc92f85143e7cde84401bfe Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 11:44:05 -0600 Subject: [PATCH 02/10] Point to branches of cmeps, cpl7 and share --- Externals.cfg | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 8b03512519..cdc08349f4 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -48,9 +48,9 @@ tag = cime6.0.27 required = True [cmeps] -tag = cmeps0.13.63 +hash = 28bcf741163e91bb4d97e5d8d16ae86b71559eff protocol = git -repo_url = https://github.com/ESCOMP/CMEPS.git +repo_url = https://github.com/billsacks/CMEPS.git local_path = components/cmeps required = True @@ -63,16 +63,16 @@ externals = Externals_CDEPS.cfg required = True [cpl7] -tag = cpl7.0.12 +hash = 2e05082ab4b167266c90e05349e56b0d5f247a6d protocol = git -repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps +repo_url = https://github.com/billsacks/CESM_CPL7andDataComps local_path = components/cpl7 required = True [share] -tag = share1.0.11 +hash = a8522ac522f6933f91a467008b867a1d9dd6fb91 protocol = git -repo_url = https://github.com/ESCOMP/CESM_share +repo_url = https://github.com/billsacks/CESM_share local_path = share required = True From d8357fc6a3fd9b69be306a8f2f3385d3c526ad08 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 14:45:25 -0600 Subject: [PATCH 03/10] Unrelated change needed for the gnu compiler Without this we get a seg fault if the mpierr argument is absent --- lilac/src/lilac_methods.F90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lilac/src/lilac_methods.F90 b/lilac/src/lilac_methods.F90 index eb2aa38dab..fd6da03c1a 100644 --- a/lilac/src/lilac_methods.F90 +++ b/lilac/src/lilac_methods.F90 @@ -1685,11 +1685,13 @@ logical function ChkErr(rc, line, file, mpierr) ChkErr = .false. lrc = rc - if (present(mpierr) .and. mpierr) then - if (rc == MPI_SUCCESS) return - call MPI_ERROR_STRING(rc, lstring, len, ierr) - call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) - lrc = ESMF_FAILURE + if (present(mpierr)) then + if (mpierr) then + if (rc == MPI_SUCCESS) return + call MPI_ERROR_STRING(rc, lstring, len, ierr) + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif endif if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then From 2ead6826d6698b5e8634ec0acd56b9cdf75f449e Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 15:03:55 -0600 Subject: [PATCH 04/10] Update cmeps and share externals (minor updates) --- Externals.cfg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index cdc08349f4..4c35f21556 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -48,7 +48,7 @@ tag = cime6.0.27 required = True [cmeps] -hash = 28bcf741163e91bb4d97e5d8d16ae86b71559eff +hash = 03ce9b7b31c5163038b47f528cd2218cc6b35471 protocol = git repo_url = https://github.com/billsacks/CMEPS.git local_path = components/cmeps @@ -70,7 +70,7 @@ local_path = components/cpl7 required = True [share] -hash = a8522ac522f6933f91a467008b867a1d9dd6fb91 +hash = 602a82fe616c134441eb5ebf51ff66f2b8a74fff protocol = git repo_url = https://github.com/billsacks/CESM_share local_path = share From 14bd8fd06f3fb5c9a3691cb9573e75b83944e260 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 16:06:58 -0600 Subject: [PATCH 05/10] Rename lilac_init_pio to lilac_driver_pio As per Jim Edwards suggestion (https://github.com/ESCOMP/CESM_CPL7andDataComps/pull/16#pullrequestreview-1029231612) --- ...t_pio_mod.F90 => lilac_driver_pio_mod.F90} | 82 +++++++++---------- lilac/src/lilac_mod.F90 | 8 +- 2 files changed, 45 insertions(+), 45 deletions(-) rename lilac/src/{lilac_init_pio_mod.F90 => lilac_driver_pio_mod.F90} (90%) diff --git a/lilac/src/lilac_init_pio_mod.F90 b/lilac/src/lilac_driver_pio_mod.F90 similarity index 90% rename from lilac/src/lilac_init_pio_mod.F90 rename to lilac/src/lilac_driver_pio_mod.F90 index b3f8130126..6e4a646224 100644 --- a/lilac/src/lilac_init_pio_mod.F90 +++ b/lilac/src/lilac_driver_pio_mod.F90 @@ -1,9 +1,9 @@ -module lilac_init_pio_mod +module lilac_driver_pio_mod ! As of 2022-07-05, this file is identical to - ! components/cpl7/driver/main/init_pio_mod.F90, except (1) the module name has been - ! changed to lilac_init_pio_mod (rather than init_pio_mod), (2) all init_pio_* routines - ! have been renamed to lilac_init_pio_*, and (3) this description comment has been + ! components/cpl7/driver/main/driver_pio_mod.F90, except (1) the module name has been + ! changed to lilac_driver_pio_mod (rather than driver_pio_mod), (2) all driver_pio_* routines + ! have been renamed to lilac_driver_pio_*, and (3) this description comment has been ! added. use pio @@ -21,9 +21,9 @@ module lilac_init_pio_mod #include #endif private - public :: lilac_init_pio_init1 - public :: lilac_init_pio_init2 - public :: lilac_init_pio_finalize + public :: lilac_driver_pio_init1 + public :: lilac_driver_pio_init2 + public :: lilac_driver_pio_finalize integer :: io_comm logical :: pio_async_interface @@ -53,7 +53,7 @@ module lilac_init_pio_mod !! Global_Comm and sets module variable io_comm. !! !< - subroutine lilac_init_pio_init1(ncomps, nlfilename, Global_Comm) + subroutine lilac_driver_pio_init1(ncomps, nlfilename, Global_Comm) integer, intent(in) :: ncomps character(len=*) :: nlfilename integer, intent(inout) :: Global_Comm @@ -61,13 +61,13 @@ subroutine lilac_init_pio_init1(ncomps, nlfilename, Global_Comm) integer :: i, pio_root, pio_stride, pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat integer :: mpigrp_world, mpigrp, ierr, mpicom - character(*),parameter :: subName = '(lilac_init_pio_init1) ' + character(*),parameter :: subName = '(lilac_driver_pio_init1) ' integer :: pelist(3,1) integer, allocatable :: comp_comm(:) type(iosystem_desc_t), allocatable :: iosystems(:) - call lilac_init_pio_read_default_namelist(nlfilename, Global_Comm, pio_stride, pio_root, pio_numiotasks, & + call lilac_driver_pio_read_default_namelist(nlfilename, Global_Comm, pio_stride, pio_root, pio_numiotasks, & pio_iotype, pio_async_interface, pio_rearranger) pio_netcdf_ioformat = PIO_64BIT_OFFSET @@ -123,7 +123,7 @@ subroutine lilac_init_pio_init1(ncomps, nlfilename, Global_Comm) #endif end if total_comps = ncomps - end subroutine lilac_init_pio_init1 + end subroutine lilac_driver_pio_init1 !> !! @public !! @brief if pio_async_interface is true, tasks in io_comm do not return from this subroutine. @@ -135,7 +135,7 @@ end subroutine lilac_init_pio_init1 !< - subroutine lilac_init_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) + subroutine lilac_driver_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_comm_iam) use shr_string_mod, only : shr_string_toLower integer, intent(in) :: comp_id(:) logical, intent(in) :: comp_iamin(:) @@ -144,7 +144,7 @@ subroutine lilac_init_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_ integer :: i character(len=shr_kind_cl) :: nlfilename, cname integer :: ret - character(*), parameter :: subName = '(lilac_init_pio_init2) ' + character(*), parameter :: subName = '(lilac_driver_pio_init2) ' ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then @@ -189,7 +189,7 @@ subroutine lilac_init_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_ nlfilename=trim(shr_string_toLower(cname(1:3)))//'_modelio.nml_'//cname(4:8) endif - call lilac_init_pio_read_component_namelist(nlfilename , comp_comm(i), pio_comp_settings(i)%pio_stride, & + call lilac_driver_pio_read_component_namelist(nlfilename , comp_comm(i), pio_comp_settings(i)%pio_stride, & pio_comp_settings(i)%pio_root, pio_comp_settings(i)%pio_numiotasks, & pio_comp_settings(i)%pio_iotype, pio_comp_settings(i)%pio_rearranger, & pio_comp_settings(i)%pio_netcdf_ioformat) @@ -225,23 +225,23 @@ subroutine lilac_init_pio_init2(comp_id, comp_name, comp_iamin, comp_comm, comp_ end if enddo - end subroutine lilac_init_pio_init2 + end subroutine lilac_driver_pio_init2 !=============================================================================== - subroutine lilac_init_pio_finalize( ) + subroutine lilac_driver_pio_finalize( ) integer :: ierr integer :: i do i=1,total_comps call pio_finalize(iosystems(i), ierr) end do - end subroutine lilac_init_pio_finalize + end subroutine lilac_driver_pio_finalize !=============================================================================== - subroutine lilac_init_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, pio_numiotasks, & + subroutine lilac_driver_pio_read_default_namelist(nlfilename, Comm, pio_stride, pio_root, pio_numiotasks, & pio_iotype, pio_async_interface, pio_rearranger) character(len=*), intent(in) :: nlfilename @@ -256,7 +256,7 @@ subroutine lilac_init_pio_read_default_namelist(nlfilename, Comm, pio_stride, pi logical :: pio_rearr_comm_enable_hs_comp2io, pio_rearr_comm_enable_isend_comp2io integer :: pio_rearr_comm_max_pend_req_io2comp logical :: pio_rearr_comm_enable_hs_io2comp, pio_rearr_comm_enable_isend_io2comp - character(*),parameter :: subName = '(lilac_init_pio_read_default_namelist) ' + character(*),parameter :: subName = '(lilac_driver_pio_read_default_namelist) ' integer :: iam, ierr, npes, unitn logical :: iamroot @@ -320,11 +320,11 @@ subroutine lilac_init_pio_read_default_namelist(nlfilename, Comm, pio_stride, pi close(unitn) call shr_file_freeUnit( unitn ) - call lilac_init_pio_getiotypefromname(pio_typename, pio_iotype, pio_iotype_netcdf) + call lilac_driver_pio_getiotypefromname(pio_typename, pio_iotype, pio_iotype_netcdf) end if end if - call lilac_init_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & + call lilac_driver_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & iamroot, pio_rearranger, pio_netcdf_ioformat) call shr_mpi_bcast(pio_debug_level, Comm) call shr_mpi_bcast(pio_root, Comm) @@ -340,15 +340,15 @@ subroutine lilac_init_pio_read_default_namelist(nlfilename, Comm, pio_stride, pi endif - call lilac_init_pio_rearr_opts_set(Comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & + call lilac_driver_pio_rearr_opts_set(Comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & pio_rearr_comm_enable_isend_comp2io, & pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & pio_rearr_comm_enable_isend_io2comp, pio_numiotasks) - end subroutine lilac_init_pio_read_default_namelist + end subroutine lilac_driver_pio_read_default_namelist - subroutine lilac_init_pio_read_component_namelist(nlfilename, Comm, pio_stride, pio_root, & + subroutine lilac_driver_pio_read_component_namelist(nlfilename, Comm, pio_stride, pio_root, & pio_numiotasks, pio_iotype, pio_rearranger, pio_netcdf_ioformat) character(len=*), intent(in) :: nlfilename integer, intent(in) :: Comm @@ -361,7 +361,7 @@ subroutine lilac_init_pio_read_component_namelist(nlfilename, Comm, pio_stride, integer :: iam, ierr, npes logical :: iamroot - character(*),parameter :: subName = '(lilac_init_pio_read_component_namelist) ' + character(*),parameter :: subName = '(lilac_driver_pio_read_component_namelist) ' integer :: pio_default_stride, pio_default_root, pio_default_numiotasks, pio_default_iotype integer :: pio_default_rearranger, pio_default_netcdf_ioformat @@ -421,8 +421,8 @@ subroutine lilac_init_pio_read_component_namelist(nlfilename, Comm, pio_stride, close(unitn) call shr_file_freeUnit( unitn ) - call lilac_init_pio_getiotypefromname(pio_typename, pio_iotype, pio_default_iotype) - call lilac_init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + call lilac_driver_pio_getiotypefromname(pio_typename, pio_iotype, pio_default_iotype) + call lilac_driver_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) end if if(pio_stride== -99) then if (pio_numiotasks > 0) then @@ -440,13 +440,13 @@ subroutine lilac_init_pio_read_component_namelist(nlfilename, Comm, pio_stride, - call lilac_init_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & + call lilac_driver_pio_namelist_set(npes, Comm, pio_stride, pio_root, pio_numiotasks, pio_iotype, & iamroot, pio_rearranger, pio_netcdf_ioformat) - end subroutine lilac_init_pio_read_component_namelist + end subroutine lilac_driver_pio_read_component_namelist - subroutine lilac_init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + subroutine lilac_driver_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: pio_netcdf_format integer, intent(out) :: pio_netcdf_ioformat @@ -463,10 +463,10 @@ subroutine lilac_init_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_iofo pio_netcdf_ioformat = pio_default_netcdf_ioformat endif - end subroutine lilac_init_pio_getioformatfromname + end subroutine lilac_driver_pio_getioformatfromname - subroutine lilac_init_pio_getiotypefromname(typename, iotype, defaulttype) + subroutine lilac_driver_pio_getiotypefromname(typename, iotype, defaulttype) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: typename integer, intent(out) :: iotype @@ -486,20 +486,20 @@ subroutine lilac_init_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'lilac_init_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(shr_log_unit,*) 'lilac_driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if - end subroutine lilac_init_pio_getiotypefromname + end subroutine lilac_driver_pio_getiotypefromname !=============================================================================== - subroutine lilac_init_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & + subroutine lilac_driver_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_numiotasks, & pio_iotype, iamroot, pio_rearranger, pio_netcdf_ioformat) integer, intent(in) :: npes, mycomm integer, intent(inout) :: pio_stride, pio_root, pio_numiotasks integer, intent(inout) :: pio_iotype, pio_rearranger, pio_netcdf_ioformat logical, intent(in) :: iamroot - character(*),parameter :: subName = '(lilac_init_pio_namelist_set) ' + character(*),parameter :: subName = '(lilac_driver_pio_namelist_set) ' call shr_mpi_bcast(pio_iotype , mycomm) call shr_mpi_bcast(pio_stride , mycomm) @@ -568,13 +568,13 @@ subroutine lilac_init_pio_namelist_set(npes,mycomm, pio_stride, pio_root, pio_nu end if end if - end subroutine lilac_init_pio_namelist_set + end subroutine lilac_driver_pio_namelist_set ! This subroutine sets the global PIO rearranger options ! The input args that represent the rearranger options are valid only ! on the root proc of comm - ! The rearranger options are passed to PIO_Init() in lilac_init_pio_init2() - subroutine lilac_init_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & + ! The rearranger options are passed to PIO_Init() in lilac_driver_pio_init2() + subroutine lilac_driver_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_comm_fcd, & pio_rearr_comm_max_pend_req_comp2io, pio_rearr_comm_enable_hs_comp2io, & pio_rearr_comm_enable_isend_comp2io, & pio_rearr_comm_max_pend_req_io2comp, pio_rearr_comm_enable_hs_io2comp, & @@ -590,7 +590,7 @@ subroutine lilac_init_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_co logical, intent(in) :: pio_rearr_comm_enable_isend_io2comp integer, intent(in) :: pio_numiotasks - character(*), parameter :: subname = '(lilac_init_pio_rearr_opts_set) ' + character(*), parameter :: subname = '(lilac_driver_pio_rearr_opts_set) ' integer, parameter :: NUM_REARR_COMM_OPTS = 8 integer, parameter :: PIO_REARR_COMM_DEF_MAX_PEND_REQ = 64 ! Automatically reset if the number of maximum pending requests is set to 0 @@ -771,4 +771,4 @@ subroutine lilac_init_pio_rearr_opts_set(comm, pio_rearr_comm_type, pio_rearr_co end subroutine !=============================================================================== -end module lilac_init_pio_mod +end module lilac_driver_pio_mod diff --git a/lilac/src/lilac_mod.F90 b/lilac/src/lilac_mod.F90 index a789a8c6ae..12dd4f74a6 100644 --- a/lilac/src/lilac_mod.F90 +++ b/lilac/src/lilac_mod.F90 @@ -24,7 +24,7 @@ module lilac_mod use lilac_history , only : lilac_history_write use lilac_methods , only : chkerr use lilac_constants, only : logunit - use lilac_init_pio_mod, only : lilac_init_pio_init1, lilac_init_pio_init2 + use lilac_driver_pio_mod, only : lilac_driver_pio_init1, lilac_driver_pio_init2 use ctsm_LilacCouplingFields, only : create_a2l_field_list, create_l2a_field_list use ctsm_LilacCouplingFields, only : complete_a2l_field_list, complete_l2a_field_list use ctsm_LilacCouplingFields, only : a2l_fields @@ -199,7 +199,7 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & ! AFTER call to MPI_init (which is in the host atm driver) and ! BEFORE call to ESMF_Initialize !------------------------------------------------------------------------- - call lilac_init_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) + call lilac_driver_pio_init1(ncomps=1, nlfilename="lilac_in", Global_Comm=mpicom) !------------------------------------------------------------------------- ! Initialize ESMF, set the default calendar and log type. @@ -231,8 +231,8 @@ subroutine lilac_init2(mpicom, atm_global_index, atm_lons, atm_lats, & !------------------------------------------------------------------------- ! Initialize PIO with second initialization !------------------------------------------------------------------------- - call lilac_init_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) - call ESMF_LogWrite(subname//"initialized lilac_init_pio_init2 ...", ESMF_LOGMSG_INFO) + call lilac_driver_pio_init2(compids, compLabels, comp_iamin, (/mpicom/), (/mytask/)) + call ESMF_LogWrite(subname//"initialized lilac_driver_pio_init2 ...", ESMF_LOGMSG_INFO) !------------------------------------------------------------------------- ! Initial lilac atmosphere cap module variables From 998bd2375d8faacc762958dd8199386317e149f7 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Tue, 5 Jul 2022 16:15:24 -0600 Subject: [PATCH 06/10] Update externals with rename --- Externals.cfg | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 4c35f21556..974513f9d6 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -48,7 +48,7 @@ tag = cime6.0.27 required = True [cmeps] -hash = 03ce9b7b31c5163038b47f528cd2218cc6b35471 +hash = 1f8ce1304a7c0939cbc4584e1b5afa5165821fb6 protocol = git repo_url = https://github.com/billsacks/CMEPS.git local_path = components/cmeps @@ -63,14 +63,14 @@ externals = Externals_CDEPS.cfg required = True [cpl7] -hash = 2e05082ab4b167266c90e05349e56b0d5f247a6d +hash = 15c5d5ce45a9db320b1448e5c29d9892fc57e046 protocol = git repo_url = https://github.com/billsacks/CESM_CPL7andDataComps local_path = components/cpl7 required = True [share] -hash = 602a82fe616c134441eb5ebf51ff66f2b8a74fff +hash = d7c43983b8d84abfc357fa112870bc50b3b60d60 protocol = git repo_url = https://github.com/billsacks/CESM_share local_path = share From a3a31b078b0be665b5338686c4d0e710258298fd Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 8 Jul 2022 14:51:59 -0600 Subject: [PATCH 07/10] Update to latest versions of cmeps, cpl7 and share These include the changes needed for shr_pio_mod --- Externals.cfg | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Externals.cfg b/Externals.cfg index 974513f9d6..ade436e8db 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -48,9 +48,9 @@ tag = cime6.0.27 required = True [cmeps] -hash = 1f8ce1304a7c0939cbc4584e1b5afa5165821fb6 +tag = cmeps0.13.68 protocol = git -repo_url = https://github.com/billsacks/CMEPS.git +repo_url = https://github.com/ESCOMP/CMEPS.git local_path = components/cmeps required = True @@ -63,16 +63,16 @@ externals = Externals_CDEPS.cfg required = True [cpl7] -hash = 15c5d5ce45a9db320b1448e5c29d9892fc57e046 +tag = cpl7.0.13 protocol = git -repo_url = https://github.com/billsacks/CESM_CPL7andDataComps +repo_url = https://github.com/ESCOMP/CESM_CPL7andDataComps local_path = components/cpl7 required = True [share] -hash = d7c43983b8d84abfc357fa112870bc50b3b60d60 +tag = share1.0.12 protocol = git -repo_url = https://github.com/billsacks/CESM_share +repo_url = https://github.com/ESCOMP/CESM_share local_path = share required = True From beabb6e6a9023b3cedfc3150f124567f14e411ad Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Fri, 8 Jul 2022 15:06:33 -0600 Subject: [PATCH 08/10] Remove LILAC test from expected fails list It should pass now --- cime_config/testdefs/ExpectedTestFails.xml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/cime_config/testdefs/ExpectedTestFails.xml b/cime_config/testdefs/ExpectedTestFails.xml index 5f594127bf..a121a19289 100644 --- a/cime_config/testdefs/ExpectedTestFails.xml +++ b/cime_config/testdefs/ExpectedTestFails.xml @@ -37,13 +37,6 @@ - - - FAIL - #1759 - - - From 779aa1a9230aba7b17d9ba82c764f338bd88ba17 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 11 Jul 2022 12:38:53 -0600 Subject: [PATCH 09/10] Update ChangeLog --- doc/ChangeLog | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 96 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 7b0a6e3dca..d228953c2f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,99 @@ =============================================================== +Tag name: ctsm5.1.dev102 +Originator(s): sacks (Bill Sacks) +Date: Mon Jul 11 12:14:48 MDT 2022 +One-line Summary: Fix LILAC interface to PIO + +Purpose and description of changes +---------------------------------- + +Fixes the LILAC interface to PIO. + +This involved splitting shr_pio_mod into two pieces: + +(1) Reading configuration files and initializing PIO appropriately + +(2) Storing information about PIO (io system descriptors, io types, io +formats) and providing an interface to query this information + +Piece (2) lives in the share code and is used regardless of the driver. +Piece (1) is driver-specific, so for now we have three versions of that +piece: one in CMEPS (created by extracting the initialization pieces +from cmeps/cesm/nuopc_cap_share/shr_pio_mod.F90), one in the cpl7 repo +(created by extracting the initialization pieces from +share/src/shr_pio_mod.F90), and one in CTSM's LILAC directory (which is +essentially identical to the one in the cpl7 repo). Piece (2) – the +actual share code piece – is used by components (their use statements +stay exactly as they are now) as well as by piece (1) (which is +responsible for setting the module-level variables in piece (2)). See +https://github.com/ESCOMP/CTSM/issues/1759#issuecomment-1171779485 for +more context. + +Much of the work here was in externals: +https://github.com/ESCOMP/CESM_share/pull/34, +https://github.com/ESCOMP/CMEPS/pull/306 and +https://github.com/ESCOMP/CESM_CPL7andDataComps/pull/16. So this PR +updates those externals to versions with those changes. In addition, +changes were needed within LILAC - to implement the LILAC version of +piece (1) described above. + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[ ] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): +- Resolves ESCOMP/CTSM#1759 (LILAC test failing in ctsm5.1.dev095 with + cime/share/pio update) + +Externals issues fixed (include issue #): +- https://github.com/ESCOMP/CESM_share/issues/33 (ctsm lilac should use + old shr_pio_mod.F90) + + +Testing summary: +---------------- + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- PASS + izumi ------- PASS + + +Answer changes +-------------- + +Changes answers relative to baseline: NO + +Other details +------------- +List any externals directories updated (cime, rtm, mosart, cism, fates, etc.): +- CMEPS: cmeps0.13.63 -> cmeps0.13.68 +- CPL7: cpl7.0.12 -> cpl7.0.13 +- share: share1.0.11 -> share1.0.12 + +Pull Requests that document the changes (include PR ids): +https://github.com/ESCOMP/CTSM/pull/1800 +https://github.com/ESCOMP/CESM_share/pull/34 +https://github.com/ESCOMP/CMEPS/pull/306 +https://github.com/ESCOMP/CESM_CPL7andDataComps/pull/16 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev101 Originator(s): samrabin (Sam Rabin) Date: Mon Jul 11 11:48:48 MDT 2022 diff --git a/doc/ChangeSum b/doc/ChangeSum index fbcde73a2b..f6ed448986 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev102 sacks 07/11/2022 Fix LILAC interface to PIO ctsm5.1.dev101 samrabin 07/11/2022 Fix winter wheat sowing window bugs ctsm5.1.dev100 erik 07/05/2022 Start bringing in matrixcn overall options and sparse matrix multiplier code, misc updates ctsm5.1.dev099 rgknox 06/21/2022 Enabling FATES control over the number of patches on the natural land unit From 7b260604a955db7495a0d797b364fb6d58d7eb34 Mon Sep 17 00:00:00 2001 From: Bill Sacks Date: Mon, 11 Jul 2022 12:40:50 -0600 Subject: [PATCH 10/10] Add note in ChangeLog --- doc/ChangeLog | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index d228953c2f..a883f70742 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -73,6 +73,11 @@ Testing summary: cheyenne ---- PASS izumi ------- PASS + In addition, to verify that the LILAC changes don't change answers, I ran + LILACSMOKE_D_Ld2.f10_f10_mg37.I2000Ctsm50NwpSpAsRs.cheyenne_intel.clm-lilac + with my changes rebased onto dev097 (in order to avoid recent answer + changing tags), with comparisons against dev094 (which was the last + time that test passed). It was bit-for-bit. Answer changes --------------