!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| module io_pio 1,6 !BOP ! !MODULE: io_pio ! !DESCRIPTION: ! Interfaces for pio initialization ! ! !REVISION HISTORY: ! SVN:$ID: ! ! !USES: use kinds_mod use broadcast use communicate use exit_mod use POP_IOUnitsMod use io_types use pio implicit none private save !PUBLIC MEMBER FUNCTIONS: public io_pio_init public :: io_pio_initdecomp !PUBLIC DATA MEMBERS !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer, private :: io_pio_stride, io_pio_num_iotasks, & io_pio_root, io_pio_type type(iosystem_desc_t), public :: io_pio_subsystem integer (i4), parameter :: nmax = 10 type ptr_ioDesc_int_type type (IO_desc_t), pointer :: ioDesc(:) end type ptr_ioDesc_int_type type (ptr_ioDesc_int_type), dimension(:), allocatable :: ptr_ioDesc_i type ptr_ioDesc_real_type type (IO_desc_t), pointer :: ioDesc(:) end type ptr_ioDesc_real_type type (ptr_ioDesc_real_type), dimension(:), allocatable :: ptr_ioDesc_r type ptr_ioDesc_double_type type (IO_desc_t), pointer :: ioDesc(:) end type ptr_ioDesc_double_type type (ptr_ioDesc_double_type), dimension(:), allocatable :: ptr_ioDesc_d integer(i4), parameter :: iunset = -999 integer(i4), dimension(nmax) :: nsize3d_i = iunset integer(i4), dimension(nmax) :: nsize3d_r = iunset integer(i4), dimension(nmax) :: nsize3d_d = iunset integer(i4), dimension(nmax) :: ksize3d_i = iunset integer(i4), dimension(nmax) :: ksize3d_r = iunset integer(i4), dimension(nmax) :: ksize3d_d = iunset !EOC !*********************************************************************** contains !*********************************************************************** !EOP ! !IROUTINE: io_pio_init - initialize io for input or output ! !INTERFACE: subroutine io_pio_init(mode, filename, File, clobber, cdf64) 2,9 ! ! !DESCRIPTION: ! Read the pio_inparm namelist and initialize the io subsystem ! ! !REVISION HISTORY: ! 2009-Feb-17 - J. Edwards - initial version ! ! !INPUT/OUTPUT PARAMETERS: ! implicit none character(len=*) , intent(in) :: mode character(len=*) , intent(in) :: filename type(file_desc_t) , intent(inout) :: File logical,optional , intent(in) :: clobber logical,optional , intent(in) :: cdf64 ! !EOP !BOC !----------------------------------------------------------------------- ! ! local variables ! !----------------------------------------------------------------------- integer (int_kind) :: & nml_error ! namelist read error flag character(len=16) :: io_pio_type_name logical :: exists logical :: lclobber logical :: lcdf64 integer :: status integer :: nmode logical, save :: first_call = .true. character(*),parameter :: subName = '(io_pio_init) ' ! Input namelist namelist /io_pio_nml/ & io_pio_num_iotasks, & io_pio_stride, & io_pio_type_name !----------------------------------------------------------------------- ! ! read and define namelist inputs ! !----------------------------------------------------------------------- if (first_call) then ! io_pio_root must be set to master_task since since currrently non-standard ! variables are only written from master_task io_pio_root = master_task io_pio_num_iotasks = -1 ! set based on io_stride value when initialized < 0 io_pio_stride = -1 ! set based on num_iotasks value when initialized < 0 io_pio_type_name = 'netcdf' if (my_task == master_task) then #ifdef CCSMCOUPLED call get_unit(nml_in) #endif open (nml_in, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then nml_error = -1 else nml_error = 1 endif do while (nml_error > 0) read(nml_in, nml=io_pio_nml,iostat=nml_error) end do if (nml_error == 0) close(nml_in) call io_pio_set_params(io_pio_type_name) write(stdout,*) 'POP2 PIO parameter settings...' write(stdout,*) ' io_pio_stride = ',io_pio_stride write(stdout,*) ' io_pio_num_iotasks = ',io_pio_num_iotasks write(stdout,*) ' io pio_type_name = ',io_pio_type_name endif call broadcast_scalar(nml_error, master_task) if (nml_error /= 0) then call exit_POP(sigAbort,' error reading pio_nml') endif call broadcast_scalar(io_pio_num_iotasks, master_task) call broadcast_scalar(io_pio_root, master_task) call broadcast_scalar(io_pio_stride, master_task) call broadcast_scalar(io_pio_type, master_task) call pio_init(my_task, MPI_COMM_OCN, io_pio_num_iotasks, & 0, io_pio_stride, PIO_REARR_BOX, io_pio_subsystem, base=io_pio_root) first_call = .false. end if if (trim(mode) == 'write') then lclobber = .false. if (present(clobber)) lclobber=clobber lcdf64 = .false. if (present(cdf64)) lcdf64=cdf64 if (File%fh<0) then ! filename not open inquire(file=trim(filename),exist=exists) if (exists) then if (lclobber) then nmode = pio_clobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) status = pio_createfile(io_pio_subsystem, File, io_pio_type, trim(filename), nmode) if (my_task == master_task) then write(stdout,*) subname,' create file ',trim(filename) end if else status = pio_openfile(io_pio_subsystem, File, io_pio_type, trim(filename), pio_write) if (my_task == master_task) then write(stdout,*) subname,' open file ',trim(filename) end if endif else nmode = pio_noclobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) status = pio_createfile(io_pio_subsystem, File, io_pio_type, trim(filename), nmode) if (my_task == master_task) then write(stdout,*) subname,' create file ',trim(filename) end if endif else ! filename is already open, just return endif end if if (trim(mode) == 'read') then inquire(file=trim(filename),exist=exists) if (exists) then status = pio_openfile(io_pio_subsystem, File, io_pio_type, trim(filename), pio_nowrite) else if(my_task==master_task) then write(stdout,*) 'io_pio_ropen ERROR: file invalid ',trim(filename) end if call exit_POP(sigAbort, 'aborting in io_pio_ropen with invalid file') endif end if end subroutine io_pio_init !=============================================================================== !BOP ! ! !IROUTINE: io_pio_set_params - set pio parameters ! ! !INTERFACE: subroutine io_pio_set_params(io_pio_type_name) 1,3 ! ! !DESCRIPTION: ! Set the pio parameters for the subsystem ! ! !USES: ! use shr_string_mod,only: shr_string_toUpper ! ! !INPUT/OUTPUT PARAMETERS: ! implicit none character(len=*), intent(in) :: io_pio_type_name ! !EOP ! character(len=16) :: tmpname integer (kind=int_kind) :: npes tmpname = shr_string_toupper(io_pio_type_name) if (trim(tmpname) == 'NETCDF') then io_pio_type = iotype_netcdf else if (trim(tmpname) == 'PNETCDF') then io_pio_type = iotype_pnetcdf else if (my_task == master_task) then write(stdout,*)' Bad io_type argument - using iotype_netcdf' end if io_pio_type = iotype_netcdf end if npes = get_num_procs() if (io_pio_stride>0 .and. io_pio_num_iotasks<0) then io_pio_num_iotasks = npes/io_pio_stride else if (io_pio_num_iotasks>0 .and. io_pio_stride<0) then io_pio_stride = npes/io_pio_num_iotasks else if (io_pio_num_iotasks<0 .and. io_pio_stride<0) then io_pio_stride = max(min(npes,4),npes/8) io_pio_num_iotasks = npes/io_pio_stride end if if (io_pio_root<0) then io_pio_root = 1 endif io_pio_root = min(io_pio_root,npes-1) if(io_pio_root + (io_pio_stride)*(io_pio_num_iotasks-1) >= npes .or. & io_pio_stride<=0 .or. io_pio_num_iotasks<=0 .or. io_pio_root < 0 .or. & io_pio_root > npes-1) then if (my_task == master_task) then write(stdout,*)& 'io_pio_stride or io_pio_num_iotasks out of bounds, resetting to defaults ',& io_pio_stride, io_pio_num_iotasks, io_pio_root end if io_pio_stride = max(1,npes/4) io_pio_num_iotasks = npes/io_pio_stride io_pio_root = min(1,npes-1) end if if (my_task == master_task) then write(stdout,*)'Using io_type=',tmpname,' stride=',io_pio_stride,& ' iotasks=',io_pio_num_iotasks,' root=',io_pio_root end if end subroutine io_pio_set_params !================================================================================ subroutine io_pio_initdecomp (basetype, ndim3, kdim3, iodesc) 12,6 use blocks, only : block, nx_block, ny_block, get_block use domain, only : nblocks_clinic, blocks_clinic use POP_DomainSizeMod, only : POP_nxGlobal, POP_nyGlobal integer (i4) , intent(in) :: basetype integer(kind=int_kind), intent(in) :: ndim3 integer(kind=int_kind), intent(in) :: kdim3 type(io_desc_t) , pointer :: iodesc integer (kind=int_kind) :: & iblk,ib,ie,jb,je,lon,lat,i,j,n,k,index type(block) :: this_block integer(kind=int_kind), pointer :: dof3d(:) logical, save :: first_time = .true. logical :: set_iodesc if (first_time) then allocate(ptr_ioDesc_i(nmax)) allocate(ptr_ioDesc_r(nmax)) allocate(ptr_ioDesc_d(nmax)) do i = 1,nmax allocate(ptr_ioDesc_i(i)%ioDesc(1)) allocate(ptr_ioDesc_r(i)%ioDesc(1)) allocate(ptr_ioDesc_d(i)%ioDesc(1)) end do first_time = .false. end if if (basetype == PIO_INT) then do i = 1,nmax if (nsize3d_i(i) == ndim3 .and. ksize3d_i(i) == kdim3) then index = i set_ioDesc = .false. exit else if (nsize3d_i(i) == iunset .and. ksize3d_i(i) == iunset) then index = i nsize3d_i(index) = ndim3 ksize3d_i(index) = kdim3 set_ioDesc = .true. exit end if end do else if (basetype == PIO_REAL) then do i = 1,nmax if (nsize3d_r(i) == ndim3 .and. ksize3d_r(i) == kdim3) then index = i set_ioDesc = .false. exit else if (nsize3d_r(i) == iunset .and. ksize3d_r(i) == iunset) then index = i nsize3d_r(index) = ndim3 ksize3d_r(index) = kdim3 set_ioDesc = .true. exit end if end do else if (basetype == PIO_DOUBLE) then do i = 1,nmax if (nsize3d_d(i) == ndim3 .and. ksize3d_d(i) == kdim3) then index = i set_ioDesc = .false. exit else if (nsize3d_d(i) == iunset .and. ksize3d_d(i) == iunset) then index = i nsize3d_d(index) = ndim3 ksize3d_d(index) = kdim3 set_ioDesc = .true. exit end if end do end if if (set_ioDesc) then if ((ndim3 == 0 .and. kdim3 /= 0) .or. (ndim3 /=0 .and. kdim3 == 0)) then call exit_POP(sigAbort,' io_pio_initdecomp: ndim3 and kdim3 must both be zero or nonzero') end if if (ndim3 > kdim3) then call exit_POP(sigAbort,' io_pio_initdecomp: ndim3 must be less than or equal to kdim3') end if if (ndim3 == 0) then allocate(dof3d(nx_block*ny_block*nblocks_clinic)) n=0 do iblk = 1, nblocks_clinic this_block = get_block(blocks_clinic(iblk),iblk) ib = this_block%ib ie = this_block%ie jb = this_block%jb je = this_block%je do j=1,ny_block do i=1,nx_block n = n+1 if (j < jb .or. j>je) then dof3d(n)=0 else if (i < ib .or. i > ie) then dof3d(n) = 0 else lon = this_block%i_glob(i) lat = this_block%j_glob(j) dof3d(n) = ((lat-1)*POP_nxGlobal + lon) endif enddo !i enddo !j end do else allocate(dof3d(nx_block*ny_block*nblocks_clinic*kdim3)) n=0 do iblk = 1, nblocks_clinic this_block = get_block(blocks_clinic(iblk),iblk) ib = this_block%ib ie = this_block%ie jb = this_block%jb je = this_block%je do k=1,kdim3 do j=1,ny_block do i=1,nx_block n = n+1 if (j < jb .or. j>je) then dof3d(n)=0 else if (i < ib .or. i > ie) then dof3d(n) = 0 else if (k > ndim3) then dof3d(n) = 0 else lon = this_block%i_glob(i) lat = this_block%j_glob(j) dof3d(n) = ((lat-1)*POP_nxGlobal + lon) + (k-1)*POP_nxGlobal*POP_nyGlobal end if endif enddo !i enddo !j enddo !kdim3 end do end if if (basetype == PIO_INT) then if (ndim3 == 0) then call pio_initdecomp(io_pio_subsystem, basetype, (/POP_nxGlobal,POP_nyGlobal/), & dof3d, ptr_ioDesc_i(index)%ioDesc(1)) else call pio_initdecomp(io_pio_subsystem, basetype, (/POP_nxGlobal,POP_nyGlobal,ndim3/), & dof3d, ptr_ioDesc_i(index)%ioDesc(1)) end if else if (basetype == PIO_REAL) then if (ndim3 == 0) then call pio_initdecomp(io_pio_subsystem, basetype, (/POP_nxGlobal,POP_nyGlobal/), & dof3d, ptr_ioDesc_r(index)%ioDesc(1)) else call pio_initdecomp(io_pio_subsystem, basetype, (/POP_nxGlobal,POP_nyGlobal,ndim3/), & dof3d, ptr_ioDesc_r(index)%ioDesc(1)) end if else if (basetype == PIO_DOUBLE) then if (ndim3 == 0) then call pio_initdecomp(io_pio_subsystem, basetype, (/POP_nxGlobal,POP_nyGlobal/), & dof3d, ptr_ioDesc_d(index)%ioDesc(1)) else call pio_initdecomp(io_pio_subsystem, basetype, (/POP_nxGlobal,POP_nyGlobal,ndim3/), & dof3d, ptr_ioDesc_d(index)%ioDesc(1)) end if end if deallocate(dof3d) end if if (basetype == PIO_INT) then iodesc => ptr_ioDesc_i(index)%ioDesc(1) elseif (basetype == PIO_REAL) then iodesc => ptr_ioDesc_r(index)%ioDesc(1) elseif (basetype == PIO_DOUBLE) then iodesc => ptr_ioDesc_d(index)%ioDesc(1) end if end subroutine io_pio_initdecomp !================================================================================ end module io_pio