#include "ESMFPIO.h" #define __PIO_FILE__ "iompi_mod.F90" module iompi_mod use pio_kinds, only : i4,r4,r8,log_kind,pio_offset use pio_types, only : io_desc_t,file_desc_t,var_desc_t, & iotype_pbinary, & iotype_direct_pbinary,pio_noerr #ifdef TIMING use perf_mod, only : t_startf, t_stopf !_EXTERNAL #endif use pio_support use alloc_mod, only : alloc_check implicit none private save include 'mpif.h' ! _EXTERNAL public :: open_mpiio, create_mpiio, close_mpiio, write_mpiio,read_mpiio !> !! @private !< interface write_mpiio ! TYPE int,real,double module procedure write_mpiio_{TYPE} end interface interface read_mpiio ! TYPE int,real,double module procedure read_mpiio_{TYPE} end interface character(len=*), parameter :: modName='iompi_mod' contains integer function close_mpiio(File) result(ierr) type (File_desc_t), intent(inout) :: File ! file descriptor ! =================== ! Local variables ! =================== character(len=*), parameter :: subName=modName//'::close_mpiio' integer :: amode,iotype logical, parameter :: Check = .TRUE. ierr = PIO_NOERR if(File%iosystem%ioproc) then #ifdef USEMPIIO iotype = File%iotype select case(iotype) case(iotype_pbinary,iotype_direct_pbinary) call MPI_file_close(File%fh,ierr) if(Check) call CheckMPIreturn('close_mpiio: after call to file_close: ',ierr) !--------------------------------- ! set the base file offset to zero !--------------------------------- File%offset = 0 end select #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') #endif end if end function close_mpiio integer function create_mpiio(File,fname) result(ierr) type (File_desc_t), intent(inout) :: File ! file descriptor character(len=*), intent(in) :: fname ! =================== ! Local variables ! =================== character(len=*), parameter :: subName=modName//'::create_mpiio' integer :: amode,iotype logical, parameter :: Check = .TRUE. integer :: ierrl #ifdef USEMPIIO ierr = PIO_noerr if(file%iosystem%ioproc) then iotype = File%iotype select case(iotype) case(iotype_pbinary,iotype_direct_pbinary) amode = IOR(MPI_MODE_RDWR,MPI_MODE_CREATE) if(Debug) print *,'OpenFile: io_rank: ',File%iosystem%io_rank,'amode,info: ',amode,File%iosystem%info,'fname: ',fname call MPI_file_open(File%iosystem%IO_comm,fname,amode,File%iosystem%info,File%fh,ierr) if(Check) call CheckMPIreturn('create_mpiio: after call to MPI_file_open: ',ierr) !--------------------------------- ! set the base file offset to zero !--------------------------------- File%offset = 0 end select ! print *, subName,':: CreateFile: io_rank: ',File%io_rank,'amode,info: ',amode,File%info,' fname: ',fname,' File%fh: ',File%fh end if if(File%iosystem%num_tasks>File%iosystem%num_iotasks) then ! broadcast the return code from MPI_file_open call MPI_BCAST(ierr,1,MPI_INTEGER,File%iosystem%IOMaster, File%iosystem%Comp_comm ,ierrl) if(Check) call CheckMPIreturn('create_mpiio: after call to MPI_BCAST: ',ierrl) end if #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') ierr=0 #endif end function create_mpiio integer function open_mpiio(File,fname) result(ierr) type (File_desc_t), intent(inout) :: File ! file descriptor character(len=*), intent(in) :: fname ! =================== ! Local variables ! =================== character(len=*), parameter :: subName=modName//'::open_mpiio' integer :: amode,iotype integer :: ierrl logical, parameter :: Check = .TRUE. #ifdef USEMPIIO ierr = PIO_noerr if(File%iosystem%ioproc) then iotype = File%iotype select case(iotype) case(iotype_pbinary,iotype_direct_pbinary) amode = MPI_MODE_RDONLY call MPI_file_open(File%iosystem%IO_comm,fname,amode,File%iosystem%info,File%fh,ierr) if(Check) call CheckMPIreturn('open_mpiio: after call to MPI_file_open: ',ierr) if(Debug) print *, subName,':: io_rank: ',File%iosystem%io_rank,'amode,info: ',amode,File%iosystem%info,'fname: ',fname !--------------------------------- ! set the base file offset to zero !--------------------------------- File%offset = 0 end select end if if(File%iosystem%num_tasks>File%iosystem%num_iotasks) then ! broadcast the return code from MPI_file_open call MPI_BCAST(ierr,1,MPI_INTEGER,File%iosystem%IOMaster, File%iosystem%Comp_comm ,ierrl) if(Check) call CheckMPIreturn('open_mpiio: after call to MPI_BCAST: ',ierrl) end if #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') ierr=0 #endif end function open_mpiio ! TYPE int,real,double integer function write_mpiio_{TYPE} (File,IOBUF,varDesc, iodesc) result(ierr) type (File_desc_t), intent(inout) :: File ! file descriptor {VTYPE}, intent(in) :: IOBUF(:) ! IO buffer type (VAR_desc_t), intent(in) :: varDesc type (IO_desc_t), intent(in) :: IODesc character(len=*), parameter :: subName=modName//'::write_mpiio_{TYPE}' character(len=10) :: datarep integer(kind=PIO_OFFSET) :: reclen integer(i4) :: iotype integer(i4) :: glen ! global length of IO request integer(kind=PIO_OFFSET) :: offset ! local offset integer :: fstatus(MPI_STATUS_SIZE) integer(i4) :: cnt logical, parameter :: Check = .TRUE. #ifdef TIMING call t_startf("pio_write_mpiio_{TYPE}") #endif #ifdef USEMPIIO datarep = 'native' iotype = File%iotype glen = iodesc%glen offset = iodesc%IOmap%start !------------------------------- ! write the record control word !------------------------------- reclen=glen*sizeof(iobuf(1)) if(iotype == iotype_direct_pbinary) then File%offset = INT(varDesc%rec-1,kind=PIO_OFFSET)*reclen endif !DBG print *,'TEMPLATE_NAME(write_mpiio_): At the begining of subroutine: ',File%offset !------------------------------------- ! Set file view for distributed array !------------------------------------- if(Debug) print *,__PIO_FILE__,__LINE__,' inside write_mpiio_{TYPE} offset: ',File%offset call MPI_File_set_view(File%fh,File%offset, iodesc%Write%elemTYPE, iodesc%Write%fileTYPE, 'native',File%iosystem%info,ierr) if(Check.and.ierr/=MPI_SUCCESS) then call CheckMPIreturn('write_mpiio_{TYPE} after call to file_set_view: ',ierr) call piodie(__PIO_FILE__,__LINE__) end if !----------------------------- ! Write out distributed array !----------------------------- call MPI_file_write_all(File%fh,IOBUF,iodesc%Write%n_elemTYPE,iodesc%Write%elemTYPE,fstatus,ierr) if(Check.and.ierr/=MPI_SUCCESS) then call CheckMPIreturn('write_mpiio_{TYPE}: after call to file_write_all: ',ierr) call piodie(__PIO_FILE__,__LINE__) end if !----------------------------------- ! increment the file offset pointer !----------------------------------- File%Offset = File%Offset + reclen #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') ierr=0 #endif #ifdef TIMING call t_stopf("pio_write_mpiio_{TYPE}") #endif end function write_mpiio_{TYPE} integer function read_mpiio_{TYPE} (File,IOBUF,varDesc, iodesc) result(ierr) type (File_desc_t), intent(inout) :: File ! file descriptor {VTYPE}, intent(out) :: IOBUF(:) ! IO buffer type (VAR_desc_t), intent(in) :: varDesc type (IO_desc_t), intent(in) :: IODesc character(len=*), parameter :: subName=modName//'::read_mpiio_{TYPE}' character(len=10) :: datarep integer(i4) :: reclen integer(i4) :: iotype integer(i4) :: cnt integer(i4) :: glen ! global length of IO request integer(kind=PIO_OFFSET) :: offset ! local offset integer :: fstatus(MPI_STATUS_SIZE) logical, parameter :: Debug = .FALSE. logical, parameter :: Check = .TRUE. datarep = 'native' iotype = File%iotype glen = iodesc%glen offset = iodesc%IOmap%start #ifdef TIMING call t_startf("pio_read_mpiio_{TYPE}") #endif #ifdef USEMPIIO reclen=glen*sizeof(iobuf(1)) if(Debug) print *, subName,':: IAM: ',File%iosystem%io_rank,' read_real8_mpiio: SIZE(IOBUF),n_RelemTYPE: ', & SIZE(IOBUF),iodesc%Read%n_elemTYPE if(iotype == iotype_direct_pbinary) then File%offset = INT(varDesc%rec-1,kind=PIO_OFFSET)*reclen endif !------------------------------------- ! Set file view for distributed array !------------------------------------- if(Debug) then print *,__PIO_FILE__,__LINE__,'IAM: ',File%iosystem%io_rank,' before set_view iodesc%Read%fileTYPE: ',iodesc%Read%FileTYPE end if call MPI_File_set_view(File%fh,File%offset, iodesc%Read%elemTYPE, iodesc%Read%fileType, 'native',File%iosystem%info,ierr) if(Check) call CheckMPIreturn('read_mpiio_{TYPE}: after call to file_set_view: ',ierr) !DBG if(Debug) print *,__PIO_FILE__,__LINE__,'IAM: ',File%iosystem%io_rank,' after set_view IODesc%Read%fileTYPE: ',iodesc%Read%fileTYPE !----------------------------- ! Read out distributed array !----------------------------- call MPI_file_read_all(File%fh,IOBUF,iodesc%Read%n_elemTYPE,iodesc%Read%elemTYPE,fstatus,ierr) if(Check) call CheckMPIreturn('read_mpiio_{TYPE}: after call to file_read_all: ',ierr) if(Debug) call MPI_get_count(fstatus,iodesc%Read%elemTYPE,cnt,ierr) if(Debug) print *,__PIO_FILE__,__LINE__,'IAM: ',File%iosystem%io_rank,'read_mpiio_{TYPE}: cnt is: ',iodesc%Read%n_elemTYPE, cnt if(Debug) print *,__PIO_FILE__,__LINE__,'IAM: ',File%iosystem%io_rank,'read_mpio_{TYPE}: reclen is: ',reclen !----------------------------------- ! increment the file offset pointer !----------------------------------- File%Offset = File%Offset + reclen #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') ierr=0 #endif #ifdef TIMING call t_stopf("pio_read_mpiio_{TYPE}") #endif end function read_mpiio_{TYPE} subroutine Write_FORTRAN_CntrlWord(File,reclen) type (File_desc_t), intent(inout) :: File integer(i4), intent(in) :: reclen character(len=*), parameter :: subName=modName//'::Write_FORTRAN_CntrlWord' character(len=10) :: datarep integer(kind=PIO_OFFSET) :: offset, offset2 integer(i4) :: glen,ierr logical, parameter :: Check = .TRUE. integer :: fstatus(MPI_STATUS_SIZE) #ifdef USEMPIIO datarep = 'native' call MPI_File_set_view(File%fh,File%offset,MPI_INTEGER, MPI_INTEGER, datarep,File%iosystem%info,ierr) if(Check) call CheckMPIreturn('write_FORTRAN_CntrlWord: after call to file_write_set_view: ',ierr) if(File%iosystem%io_rank == 0) then ! ------------------------------------ ! add the FORTRAN record control words ! ------------------------------------ offset = 0 call MPI_file_write_at(File%fh,offset,reclen,1,MPI_INTEGER,fstatus,ierr) if(Check) call CheckMPIreturn('write_FORTRAN_CntrlWord: after call to MPI_file_write_at offset ',ierr) glen = reclen/i4 offset2 = offset+glen+1 call MPI_file_write_at(File%fh,offset2,reclen,1,MPI_INTEGER,fstatus,ierr) if(Check) call CheckMPIreturn('write_FORTRAN_CntrlWord: after call to MPI_file_write_at: offset2 ',ierr) endif File%offset = File%offset+i4 #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') #endif end subroutine Write_FORTRAN_CntrlWord !*********************************************************************** subroutine Read_FORTRAN_CntrlWord(File,reclen) type (File_desc_t), intent(inout) :: File integer(i4), intent(inout) :: reclen character(len=*), parameter :: subName=modName//'::Read_FORTRAN_CntrlWord' character(len=10) :: datarep integer(kind=PIO_OFFSET) :: offset, offset2 integer(i4) :: glen,ierr logical, parameter :: Check = .TRUE. integer :: fstatus(MPI_STATUS_SIZE) #ifdef USEMPIIO datarep = 'native' print *,'Read_FORTRAN_CntrlWord: File%offset: ',File%offset call MPI_File_set_view(File%fh,File%offset,MPI_INTEGER, MPI_INTEGER, datarep,File%iosystem%info,ierr) if(Check) call CheckMPIreturn('Read_FORTRAN_CntrlWord: after call to MPI_file_set_view: ',ierr) if(File%iosystem%io_rank == 0) then ! ------------------------------------ ! read the FORTRAN record control words ! ------------------------------------ offset=0 call MPI_file_read_at(File%fh,offset,reclen,1,MPI_INTEGER,fstatus,ierr) if(Check) call CheckMPIreturn('Read_FORTRAN_CntrlWord: after call MPI_to file_read_at_all: ',ierr) endif File%offset = File%offset+i4 if(Debug) print *, subName,':: reclen ',reclen #else call piodie(__PIO_FILE__,__LINE__,'PIO was not built with -DUSEMPIIO') #endif end subroutine Read_FORTRAN_CntrlWord end module iompi_mod