diff --git a/route/build/cpl/RtmMod.F90 b/route/build/cpl/RtmMod.F90 index 7a5d4a2f..7252bc1f 100644 --- a/route/build/cpl/RtmMod.F90 +++ b/route/build/cpl/RtmMod.F90 @@ -4,7 +4,7 @@ MODULE RtmMod USE pio USE perf_mod USE shr_pio_mod , ONLY : shr_pio_getiotype, shr_pio_getioformat, & - shr_pio_getrearranger, shr_pio_getioroot + shr_pio_getrearranger, shr_pio_getioroot, shr_pio_getiosys USE shr_kind_mod , ONLY : r8 => shr_kind_r8, CL => SHR_KIND_CL USE shr_sys_mod , ONLY : shr_sys_flush, shr_sys_abort USE RtmVar , ONLY : nt_rtm, rtm_tracers, & @@ -18,12 +18,14 @@ MODULE RtmMod USE public_var, ONLY : dt ! routing time step USE public_var , ONLY : iulog USE public_var , ONLY : rpntfil + USE globalData , ONLY : isStandalone USE globalData , ONLY : iam => pid USE globalData , ONLY : npes => nNodes USE globalData , ONLY : mpicom_rof => mpicom_route USE globalData , ONLY : masterproc USE globalData , ONLY : pio_netcdf_format, pio_typename, pio_rearranger, & pio_root, pio_stride + USE globalData , ONLY : pioSystem ! !PUBLIC TYPES: implicit none @@ -124,30 +126,34 @@ SUBROUTINE route_ini(rtm_active,flood_active) !------------------------------------------------------- ! Overwrite PIO parameter from CIME !------------------------------------------------------- + isStandalone = .false. + select case(shr_pio_getioformat(inst_name)) case(PIO_64BIT_OFFSET); pio_netcdf_format = '64bit_offset' case(PIO_64BIT_DATA); pio_netcdf_format = '64bit_data' case default; call shr_sys_abort(trim(subname)//'unexpected netcdf format index') end select - !select case(shr_pio_getiotype(inst_name)) - ! case(pio_iotype_netcdf); pio_typename = 'netcdf' - ! case(pio_iotype_pnetcdf); pio_typename = 'pnetcdf' - ! case(pio_iotype_netcdf4c); pio_typename = 'netcdf4c' - ! case(pio_iotype_NETCDF4p); pio_typename = 'netcdf4p' - ! case default; call shr_sys_abort(trim(subname)//'unexpected netcdf io type index') - !end select + select case(shr_pio_getiotype(inst_name)) + case(pio_iotype_netcdf); pio_typename = 'netcdf' + case(pio_iotype_pnetcdf); pio_typename = 'pnetcdf' + case(pio_iotype_netcdf4c); pio_typename = 'netcdf4c' + case(pio_iotype_NETCDF4p); pio_typename = 'netcdf4p' + case default; call shr_sys_abort(trim(subname)//'unexpected netcdf io type index') + end select !pio_numiotasks = shr_pio_(inst_name) ! there is no function to extract pio_numiotasks in cime/src/drivers/nuops/nems/util/shr_pio_mod.F90 - pio_rearranger = shr_pio_getrearranger(inst_name) - pio_root = shr_pio_getioroot(inst_name) - !pio_stride = shr_pio_(inst_name) ! there is no function to extract pio_stride - - write(iulog,*) 'pio_netcdf_format = ', trim(pio_netcdf_format) - write(iulog,*) 'pio_typename = ', trim(pio_typename) - write(iulog,*) 'pio_rearranger = ', pio_rearranger - write(iulog,*) 'pio_root = ', pio_root - write(iulog,*) 'pio_stride = ', pio_stride + pioSystem = shr_pio_getiosys(inst_name) + pio_rearranger = shr_pio_getrearranger(inst_name) + pio_root = shr_pio_getioroot(inst_name) + + if (masterproc) then + write(iulog,*) 'pio_netcdf_format = ', trim(pio_netcdf_format) + write(iulog,*) 'pio_typename = ', trim(pio_typename) + write(iulog,*) 'pio_rearranger = ', pio_rearranger + write(iulog,*) 'pio_root = ', pio_root + write(iulog,*) 'pio_stride = ', pio_stride + end if !------------------------------------------------------- ! Initialize rtm_trstr diff --git a/route/build/src/globalData.f90 b/route/build/src/globalData.f90 index e39ca2df..a1443170 100644 --- a/route/build/src/globalData.f90 +++ b/route/build/src/globalData.f90 @@ -1,5 +1,6 @@ module globalData ! This module includes shared data + USE pio USE public_var, ONLY: integerMissing USE public_var, ONLY: maxDomain @@ -90,6 +91,8 @@ module globalData type(infileinfo) , allocatable , public :: infileinfo_data(:) ! conversion factor to convert time to units of days ! ---------- Misc. data ------------------------------------------------------------------------- + ! standalone mode + logical(lgt) , public :: isStandalone=.true. ! flag to indicate model is running in standalone mode (True), otherwise coupled mode ! I/O stuff logical(lgt) , public :: isFileOpen ! flag to indicate output netcdf is open @@ -111,6 +114,7 @@ module globalData integer(i4b) , public :: pio_rearranger = 2 ! 0=>PIO_rearr_none 1=> PIO_rearr_box 2=> PIO_rearr_subset integer(i4b) , public :: pio_root = 1 integer(i4b) , public :: pio_stride = 1 + type(iosystem_desc_t) , public :: pioSystem ! PIO I/O system data ! ---------- conversion factors ------------------------------------------------------------------- diff --git a/route/build/src/write_restart_pio.f90 b/route/build/src/write_restart_pio.f90 index a03dff0d..ce330209 100644 --- a/route/build/src/write_restart_pio.f90 +++ b/route/build/src/write_restart_pio.f90 @@ -37,13 +37,15 @@ MODULE write_restart_pio USE globalData, ONLY: pio_rearranger USE globalData, ONLY: pio_root USE globalData, ONLY: pio_stride +USE globalData, ONLY: pioSystem +USE globalData, ONLY: isStandalone USE nr_utility_module, ONLY: arth USE pio_utils implicit none -type(iosystem_desc_t),save :: pioSystemState +! The following variables used only in this module type(file_desc_t), save :: pioFileDescState ! contains data identifying the file type(io_desc_t), save :: iodesc_state_int type(io_desc_t), save :: iodesc_state_double @@ -284,16 +286,18 @@ SUBROUTINE define_state_nc(fname, & ! input: filename ! ---------------------------------- ! pio initialization for restart netCDF ! ---------------------------------- - pio_numiotasks = nNodes/pio_stride - call pio_sys_init(pid, mpicom_route, & ! input: MPI related parameters - pio_stride, pio_numiotasks, & ! input: PIO related parameters - pio_rearranger, pio_root, & ! input: PIO related parameters - pioSystemState) ! output: PIO system descriptors + if (isStandalone) then + pio_numiotasks = nNodes/pio_stride + call pio_sys_init(pid, mpicom_route, & ! input: MPI related parameters + pio_stride, pio_numiotasks, & ! input: PIO related parameters + pio_rearranger, pio_root, & ! input: PIO related parameters + pioSystem) ! output: PIO system descriptors + end if ! ---------------------------------- ! Create file ! ---------------------------------- - call createFile(pioSystemState, trim(fname), pio_typename, pio_netcdf_format, pioFileDescState, ierr, cmessage) + call createFile(pioSystem, trim(fname), pio_typename, pio_netcdf_format, pioFileDescState, ierr, cmessage) if(ierr/=0)then; message=trim(cmessage)//'cannot create state netCDF'; return; endif ! For common dimension/variables - seg id, time, time-bound ----------- @@ -370,14 +374,14 @@ SUBROUTINE define_state_nc(fname, & ! input: filename ixRch = arth(1,1,nSeg) ! type: float dim: [dim_seg, dim_ens, dim_time] -- channel runoff coming from hru - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_double, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: iodesc_state_double) ! type: int dim: [dim_seg, dim_ens, dim_time] -- number of wave or uh future time steps - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_int, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: @@ -385,14 +389,14 @@ SUBROUTINE define_state_nc(fname, & ! input: filename if (routOpt==allRoutingMethods .or. routOpt==kinematicWave) then ! type: int, dim: [dim_seg, dim_wave, dim_ens, dim_time] - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_int, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,nWave,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: iodesc_wave_int) ! type: float, dim: [dim_seg, dim_wave, dim_ens, dim_time] - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_double, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,nWave,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: @@ -401,7 +405,7 @@ SUBROUTINE define_state_nc(fname, & ! input: filename if (routOpt==kinematicWaveEuler) then ! type: float, dim: [dim_seg, dim_fdmesh, dim_ens, dim_time] - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_double, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,nFdmesh,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: @@ -410,7 +414,7 @@ SUBROUTINE define_state_nc(fname, & ! input: filename if (routOpt==allRoutingMethods .or. routOpt==impulseResponseFunc) then ! type: float dim: [dim_seg, dim_tdh_irf, dim_ens, dim_time] - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_double, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,ntdh_irf,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: @@ -418,7 +422,7 @@ SUBROUTINE define_state_nc(fname, & ! input: filename end if ! type: float dim: [dim_seg, dim_tdh_irf, dim_ens, dim_time] - call pio_decomp(pioSystemState, & ! input: pio system descriptor + call pio_decomp(pioSystem, & ! input: pio system descriptor ncd_double, & ! input: data type (pio_int, pio_real, pio_double, pio_char) [nSeg,ntdh,nEns], & ! input: dimension length == global array size ixRch(ix1:ix2), & ! input: @@ -714,7 +718,7 @@ SUBROUTINE write_state_nc(fname, & ! Input: state netcdf name ! -- Write out to netCDF - call openFile(pioSystemState, pioFileDescState, trim(fname),pio_typename, ncd_write, ierr, cmessage) + call openFile(pioSystem, pioFileDescState, trim(fname),pio_typename, ncd_write, ierr, cmessage) if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif ! Miscellaneous variables - seg id, time etc diff --git a/route/build/src/write_simoutput_pio.f90 b/route/build/src/write_simoutput_pio.f90 index 469f14e1..e95375b8 100644 --- a/route/build/src/write_simoutput_pio.f90 +++ b/route/build/src/write_simoutput_pio.f90 @@ -23,6 +23,8 @@ MODULE write_simoutput_pio USE globalData, ONLY: pio_rearranger USE globalData, ONLY: pio_root USE globalData, ONLY: pio_stride +USE globalData, ONLY: pioSystem +USE globalData, ONLY: isStandalone ! Moudle wide external modules USE nr_utility_module, ONLY: arth USE pio_utils @@ -32,7 +34,6 @@ MODULE write_simoutput_pio ! The following variables used only in this module character(300), save :: fileout ! name of the output file integer(i4b), save :: jTime ! time step in output netCDF -type(iosystem_desc_t),save :: pioSystem ! PIO I/O system data type(file_desc_t), save :: pioFileDesc ! PIO data identifying the file type(io_desc_t), save :: iodesc_rch_flx ! PIO domain decomposition data for reach flux [nRch] type(io_desc_t), save :: iodesc_hru_ro ! PIO domain decomposition data for hru runoff [nHRU] @@ -391,11 +392,13 @@ SUBROUTINE defineFile(fname, & ! input: filename end if ! pio initialization - pio_numiotasks = nNodes/pio_stride - call pio_sys_init(pid, mpicom_route, & ! input: MPI related parameters - pio_stride, pio_numiotasks, & ! input: PIO related parameters - pio_rearranger, pio_root, & ! input: PIO related parameters - pioSystem) ! output: PIO system descriptors + if (isStandalone) then + pio_numiotasks = nNodes/pio_stride + call pio_sys_init(pid, mpicom_route, & ! input: MPI related parameters + pio_stride, pio_numiotasks, & ! input: PIO related parameters + pio_rearranger, pio_root, & ! input: PIO related parameters + pioSystem) ! output: PIO system descriptors + endif ! For reach flux/volume if (masterproc) then