diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index f788c2478..9be41b4d9 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -808,7 +808,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init, shr_pio_component_init + use init_pio_mod , only : init_pio_init, init_pio_component_init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -934,7 +934,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) ! Initialize PIO ! This reads in the pio parameters that are independent of component - call shr_pio_init(driver, rc=rc) + call init_pio_init(driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(comms(componentCount+1), comps(componentCount+1)) @@ -1182,7 +1182,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) enddo ! Read in component dependent PIO parameters and initialize ! IO systems - call shr_pio_component_init(driver, size(comps), rc) + call init_pio_component_init(driver, size(comps), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Initialize MCT (this is needed for data models and cice prescribed capability) diff --git a/cesm/nuopc_cap_share/shr_pio_mod.F90 b/cesm/nuopc_cap_share/init_pio_mod.F90 similarity index 58% rename from cesm/nuopc_cap_share/shr_pio_mod.F90 rename to cesm/nuopc_cap_share/init_pio_mod.F90 index e05a1ed99..d07cc0db1 100644 --- a/cesm/nuopc_cap_share/shr_pio_mod.F90 +++ b/cesm/nuopc_cap_share/init_pio_mod.F90 @@ -1,5 +1,6 @@ -module shr_pio_mod +module init_pio_mod use pio + use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>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 @@ -14,52 +15,12 @@ module shr_pio_mod #include #endif private - public :: shr_pio_init - public :: shr_pio_component_init - public :: shr_pio_getiosys - public :: shr_pio_getiotype - public :: shr_pio_getioroot - public :: shr_pio_finalize - public :: shr_pio_getioformat - public :: shr_pio_getrearranger - public :: shr_pio_log_comp_settings - - interface shr_pio_getiotype - module procedure shr_pio_getiotype_fromid, shr_pio_getiotype_fromname - end interface - interface shr_pio_getioformat - module procedure shr_pio_getioformat_fromid, shr_pio_getioformat_fromname - end interface - interface shr_pio_getiosys - module procedure shr_pio_getiosys_fromid, shr_pio_getiosys_fromname - end interface - interface shr_pio_getioroot - module procedure shr_pio_getioroot_fromid, shr_pio_getioroot_fromname - end interface - interface shr_pio_getindex - module procedure shr_pio_getindex_fromid, shr_pio_getindex_fromname - end interface - interface shr_pio_getrearranger - module procedure shr_pio_getrearranger_fromid, shr_pio_getrearranger_fromname - end interface - - type pio_comp_t - integer :: compid - integer :: pio_root - integer :: pio_stride - integer :: pio_numiotasks - integer :: pio_iotype - integer :: pio_rearranger - integer :: pio_netcdf_ioformat - logical :: pio_async_interface - end type pio_comp_t - - character(len=16), allocatable :: io_compname(:) - type(pio_comp_t), allocatable :: pio_comp_settings(:) - type (iosystem_desc_t), allocatable, target :: iosystems(:) + public :: init_pio_init + public :: init_pio_component_init + public :: init_pio_finalize + public :: init_pio_log_comp_settings + integer :: io_comm - logical :: pio_async_interface - integer, allocatable :: io_compid(:) integer :: pio_debug_level=0, pio_blocksize=0 integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 @@ -88,7 +49,7 @@ module shr_pio_mod !! !< - subroutine shr_pio_init(driver, rc) + subroutine init_pio_init(driver, rc) use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Config, ESMF_GridCompGet use ESMF, only : ESMF_VMGet, ESMF_RC_NOT_VALID, ESMF_LogSetError use NUOPC, only: NUOPC_CompAttributeGet @@ -104,7 +65,7 @@ subroutine shr_pio_init(driver, rc) character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd character(CS) :: msgstr - character(*), parameter :: subName = '(shr_pio_init) ' + character(*), parameter :: subName = '(init_pio_init) ' call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -205,9 +166,9 @@ subroutine shr_pio_init(driver, rc) write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if - end subroutine shr_pio_init + end subroutine init_pio_init - subroutine shr_pio_component_init(driver, ncomps, rc) + subroutine init_pio_component_init(driver, ncomps, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd @@ -226,6 +187,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) character(CS) :: msgstr integer :: do_async_init type(iosystem_desc_t), allocatable :: async_iosystems(:) + logical, allocatable :: pio_async_interface(:) allocate(pio_comp_settings(ncomps)) allocate(gcomp(ncomps)) @@ -234,6 +196,8 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(io_compname(ncomps)) allocate(iosystems(ncomps)) + allocate(pio_async_interface(ncomps)) + nullify(gcomp) do_async_init = 0 @@ -310,13 +274,13 @@ subroutine shr_pio_component_init(driver, ncomps, rc) call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') + pio_async_interface(i) = (trim(cval) == '.true.') call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + call init_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - if (pio_comp_settings(i)%pio_async_interface) then + if (pio_async_interface(i)) then do_async_init = do_async_init + 1 else if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then @@ -335,7 +299,7 @@ subroutine shr_pio_component_init(driver, ncomps, rc) allocate(async_iosystems(do_async_init)) j=1 do i=1,total_comps - if(pio_comp_settings(i)%pio_async_interface) then + if(pio_async_interface(i)) then iosystems(i) = async_iosystems(j) j = j+1 endif @@ -344,9 +308,9 @@ subroutine shr_pio_component_init(driver, ncomps, rc) endif deallocate(gcomp) - end subroutine shr_pio_component_init + end subroutine init_pio_component_init - subroutine shr_pio_log_comp_settings(gcomp, logunit) + subroutine init_pio_log_comp_settings(gcomp, logunit) use ESMF, only : ESMF_GridComp, ESMF_GridCompGet use NUOPC, only: NUOPC_CompAttributeGet @@ -377,173 +341,21 @@ subroutine shr_pio_log_comp_settings(gcomp, logunit) write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - end subroutine shr_pio_log_comp_settings + end subroutine init_pio_log_comp_settings !=============================================================================== - subroutine shr_pio_finalize( ) + subroutine init_pio_finalize( ) integer :: ierr integer :: i do i=1,total_comps call pio_finalize(iosystems(i), ierr) end do - end subroutine shr_pio_finalize - -!=============================================================================== - function shr_pio_getiotype_fromid(compid) result(io_type) - integer, intent(in) :: compid - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_iotype - - end function shr_pio_getiotype_fromid - - - function shr_pio_getiotype_fromname(component) result(io_type) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(component))%pio_iotype - - end function shr_pio_getiotype_fromname - - function shr_pio_getrearranger_fromid(compid) result(io_type) - integer, intent(in) :: compid - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(compid))%pio_rearranger - - end function shr_pio_getrearranger_fromid - - - function shr_pio_getrearranger_fromname(component) result(io_type) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_type - - io_type = pio_comp_settings(shr_pio_getindex(component))%pio_rearranger - - end function shr_pio_getrearranger_fromname - - function shr_pio_getioformat_fromid(compid) result(io_format) - integer, intent(in) :: compid - integer :: io_format - - io_format = pio_comp_settings(shr_pio_getindex(compid))%pio_netcdf_ioformat - - end function shr_pio_getioformat_fromid - - - function shr_pio_getioformat_fromname(component) result(io_format) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_format - - io_format = pio_comp_settings(shr_pio_getindex(component))%pio_netcdf_ioformat - - end function shr_pio_getioformat_fromname - -!=============================================================================== - function shr_pio_getioroot_fromid(compid) result(io_root) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - integer, intent(in) :: compid - integer :: io_root - - io_root = pio_comp_settings(shr_pio_getindex(compid))%pio_root - - end function shr_pio_getioroot_fromid - - function shr_pio_getioroot_fromname(component) result(io_root) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - integer :: io_root - - io_root = pio_comp_settings(shr_pio_getindex(component))%pio_root - - - end function shr_pio_getioroot_fromname - + end subroutine init_pio_finalize !=============================================================================== - !! Given a component name, return the index of that component. - !! This is the index into io_compid, io_compname, comp_pio_iotype, etc. - !! If the given component is not found, return -1 - - integer function shr_pio_getindex_fromid(compid) result(index) - implicit none - integer, intent(in) :: compid - integer :: i - character(len=shr_kind_cl) :: msg - index = -1 - do i=1,total_comps - if(io_compid(i)==compid) then - index = i - exit - end if - end do - - if(index<0) then - write(msg, *) 'shr_pio_getindex :: compid=',compid,' out of allowed range: ' - call shr_sys_abort(msg) - end if - end function shr_pio_getindex_fromid - - - integer function shr_pio_getindex_fromname(component) result(index) - use shr_string_mod, only : shr_string_toupper - - implicit none - - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - - character(len=len(component)) :: component_ucase - integer :: i - - ! convert component name to upper case in order to match case in io_compname - component_ucase = shr_string_toUpper(component) - - index = -1 ! flag for not found - do i=1,size(io_compname) - if (trim(component_ucase) == trim(io_compname(i))) then - index = i - exit - end if - end do - if(index<0) then - call shr_sys_abort(' shr_pio_getindex:: compid out of allowed range') - end if - end function shr_pio_getindex_fromname - - function shr_pio_getiosys_fromid(compid) result(iosystem) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - integer, intent(in) :: compid - type(iosystem_desc_t), pointer :: iosystem - - iosystem => iosystems(shr_pio_getindex(compid)) - - end function shr_pio_getiosys_fromid - - function shr_pio_getiosys_fromname(component) result(iosystem) - ! 'component' must be equal to some element of io_compname(:) - ! (but it is case-insensitive) - character(len=*), intent(in) :: component - type(iosystem_desc_t), pointer :: iosystem - - iosystem => iosystems(shr_pio_getindex(component)) - - end function shr_pio_getiosys_fromname - - subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, pio_default_netcdf_ioformat) + subroutine 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 @@ -560,10 +372,10 @@ subroutine shr_pio_getioformatfromname(pio_netcdf_format, pio_netcdf_ioformat, p pio_netcdf_ioformat = pio_default_netcdf_ioformat endif - end subroutine shr_pio_getioformatfromname + end subroutine init_pio_getioformatfromname - subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) + subroutine init_pio_getiotypefromname(typename, iotype, defaulttype) use shr_string_mod, only : shr_string_toupper character(len=*), intent(inout) :: typename integer, intent(out) :: iotype @@ -583,90 +395,12 @@ subroutine shr_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'shr_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(shr_log_unit,*) 'init_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if - end subroutine shr_pio_getiotypefromname - -!=============================================================================== - subroutine shr_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 = '(shr_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 shr_pio_namelist_set + end subroutine init_pio_getiotypefromname !=============================================================================== -end module shr_pio_mod +end module init_pio_mod diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index da7891c49..4fe80b534 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -132,7 +132,7 @@ end subroutine get_component_instance !=============================================================================== subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - use shr_pio_mod, only : shr_pio_log_comp_settings + use init_pio_mod, only : init_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: mastertask @@ -165,7 +165,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) ! Write the PIO settings to the beggining of each component log - call shr_pio_log_comp_settings(gcomp, logunit) + call init_pio_log_comp_settings(gcomp, logunit) else logUnit = 6