mpl_write_mod.F90

Go to the documentation of this file.

MODULE mpl_write_mod

!
!     Purpose.  write to an MPIIO file 
!     --------
!
!
!     Interface.
!     ----------
!        call mpl_write(...)
!
!        Explicit arguments :
!        --------------------
!
!        input arguments:
!        kfptr   - handle for file
!        kop     - requested operation 
!        kbuf    - buffer containing data to be written
!        klen    - length of buffer in words
!        input/output arguements:
!        kreq    - request handle for non-blocking operations
!        output arguments:
!        kerror  - error code
!
!        Implicit arguments :
!        --------------------
!
!     Method.
!     -------
!     MPL supports 4 styles of MPIIO
!
!     kop = 1    -  Blocking, non collective, shared file pointer
!                   using MPI_FILE_WRITE_SHARED,
!                         MPI_FILE_READ_SHARED
!     kop = 2    -  Blocking, collective, ordered, shared file pointer
!                   using MPI_FILE_WRITE_ORDERED,
!                         MPI_FILE_READ_ORDERED
!     kop = 3    -  Non Blocking, non collective, shared file pointer
!                   using MPI_FILE_IWRITE_SHARED,
!                         MPI_FILE_IREAD_SHARED
!                   and MPI_WAIT
!     kop = 4    -  Non Blocking, collective, ordered, shared file pointer
!                   using MPI_FILE_WRITE_ORDERED_BEGIN/END,
!                         MPI_FILE_READ_ORDERED_BEGIN/END
!
!     Externals.
!     ----------
!
!     Reference.
!     ----------
!        none yet
!
!     Author.
!     -------
!        G.Mozdzynski
!
!     Modifications.
!     --------------
!        Original : 2000-12-08 (Based on MPE_WRITE)
!        R. EL Khatib 24-May-2011 Change ifdef MPI2 into ifndef MPI1
!     -----------------------------------------------------------------
!
USE parkind1  ,ONLY : jpim     ,jprb     ,jprm

USE mpl_mpif
USE mpl_data_module
USE mpl_message_mod
USE mpl_ioinit_mod

IMPLICIT NONE

INTERFACE mpl_write
MODULE PROCEDURE mpl_write_int,mpl_write_real8
END INTERFACE

PRIVATE
PUBLIC mpl_write

CONTAINS

SUBROUTINE mpl_write_int(KFPTR,KOP,KBUF,KLEN,KREQ,KERROR)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_file_write_shared => mpi_file_write_shared8, &
    mpi_file_write_ordered => mpi_file_write_ordered8, &
    mpi_file_iwrite_shared => mpi_file_iwrite_shared8, &
    mpi_file_write_ordered_begin => mpi_file_write_ordered_begin8, &
    mpi_wait => mpi_wait8, &
    mpi_file_write_ordered_end => mpi_file_write_ordered_end8
#endif

INTEGER(KIND=JPIM),INTENT(IN) :: KFPTR,KOP,KLEN
INTEGER(KIND=JPIM),INTENT(OUT) :: KERROR
INTEGER(KIND=JPIM) KBUF(:)
INTEGER(KIND=JPIM) KREQ


INTEGER(KIND=JPIM) STATUS(mpi_status_size)
!
#ifndef MPI1

!     -----------------------------------------------------------------
!
!     1.    Preamble 
!           --------

IF( mpl_rank > mpl_numio ) THEN
  kerror = -1
  RETURN
ENDIF

IF( kop >= 1.AND.kop <= 4 ) THEN

  IF( kop /= mpl_iop ) THEN
    kerror = -1
    RETURN
  ENDIF

ENDIF
!     -----------------------------------------------------------------
!
!     2.    Check style and take appropriate action 
!           ---------------------------------------


IF( kop == 1 ) THEN

! blocking write, non collective, shared file pointer
        
  CALL mpi_file_write_shared(kfptr,&
                           & kbuf,&
                           & klen,&
                           & mpi_integer,&
                           & status,&
                           & kerror)

ELSEIF( kop == 2 ) THEN

! blocking write, collective, ordered with shared file pointer

  CALL mpi_file_write_ordered(kfptr,&
                            & kbuf,&
                            & klen,&
                            & mpi_integer,&
                            & status,&
                            & kerror)

ELSEIF( kop == 3 ) THEN

! non blocking write, non collective, shared file pointer

  CALL mpi_file_iwrite_shared(kfptr,&
                            & kbuf,&
                            & klen,&
                            & mpi_integer,&
                            & kreq,&
                            & kerror)

ELSEIF( kop == 4 ) THEN

! non blocking write, collective, ordered with shared file pointer

  CALL mpi_file_write_ordered_begin(kfptr,&
                                  & kbuf,&
                                  & klen,&
                                  & mpi_integer,&
                                  & kerror)

ELSEIF( kop == 5 ) THEN

  CALL mpi_wait(kreq,&
              & status,&
              & kerror )

ELSEIF( kop == 6 ) THEN

  CALL mpi_file_write_ordered_end(kfptr,&
                                & kbuf,&
                                & status,&
                                & kerror)
 
ELSE

  kerror =-1
  RETURN

ENDIF

#else

CALL abor1('MPL_WRITE_INT not built with MPI2')

#endif
!
!     -----------------------------------------------------------------
RETURN
END SUBROUTINE mpl_write_int

SUBROUTINE mpl_write_real8(KFPTR,KOP,PBUF,KLEN,KREQ,KERROR)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_file_write_shared => mpi_file_write_shared8, &
    mpi_file_write_ordered => mpi_file_write_ordered8, &
    mpi_file_iwrite_shared => mpi_file_iwrite_shared8, &
    mpi_file_write_ordered_begin => mpi_file_write_ordered_begin8, &
    mpi_wait => mpi_wait8, &
    mpi_file_write_ordered_end => mpi_file_write_ordered_end8
#endif

INTEGER(KIND=JPIM),INTENT(IN) :: KFPTR,KOP,KLEN
INTEGER(KIND=JPIM),INTENT(OUT) :: KERROR
REAL(KIND=JPRM) PBUF(:)
INTEGER(KIND=JPIM) KREQ


INTEGER(KIND=JPIM) STATUS(mpi_status_size)
!
#ifndef MPI1

!     -----------------------------------------------------------------
!
!     1.    Preamble 
!           --------

IF( mpl_rank > mpl_numio ) THEN
  kerror = -1
  RETURN
ENDIF

IF( kop >= 1.AND.kop <= 4 ) THEN

  IF( kop /= mpl_iop ) THEN
    kerror = -1
    RETURN
  ENDIF

ENDIF
!     -----------------------------------------------------------------
!
!     2.    Check style and take appropriate action 
!           ---------------------------------------


IF( kop == 1 ) THEN

! blocking write, non collective, shared file pointer
        
  CALL mpi_file_write_shared(kfptr,&
                           & pbuf,&
                           & klen,&
                           & mpi_real8,&
                           & status,&
                           & kerror)

ELSEIF( kop == 2 ) THEN

! blocking write, collective, ordered with shared file pointer

  CALL mpi_file_write_ordered(kfptr,&
                            & pbuf,&
                            & klen,&
                            & mpi_real8,&
                            & status,&
                            & kerror)

ELSEIF( kop == 3 ) THEN

! non blocking write, non collective, shared file pointer

  CALL mpi_file_iwrite_shared(kfptr,&
                            & pbuf,&
                            & klen,&
                            & mpi_real8,&
                            & kreq,&
                            & kerror)

ELSEIF( kop == 4 ) THEN

! non blocking write, collective, ordered with shared file pointer

  CALL mpi_file_write_ordered_begin(kfptr,&
                                  & pbuf,&
                                  & klen,&
                                  & mpi_real8,&
                                  & kerror)

ELSEIF( kop == 5 ) THEN

  CALL mpi_wait(kreq,&
              & status,&
              & kerror )

ELSEIF( kop == 6 ) THEN

  CALL mpi_file_write_ordered_end(kfptr,&
                                & pbuf,&
                                & status,&
                                & kerror)
 
ELSE

  kerror =-1
  RETURN

ENDIF

#else

CALL abor1('MPL_WRITE_REAL8 not built with MPI2')

#endif

!
!     -----------------------------------------------------------------
RETURN
END SUBROUTINE mpl_write_real8

END MODULE mpl_write_mod