distio_mix.F90

Go to the documentation of this file.

!OPTIONS NOOPT
MODULE distio_mix
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook

USE parkind1  ,ONLY : jpim     ,jprb
#ifdef SFX_MPI
USE mpl_module
#endif

IMPLICIT NONE

PRIVATE

INTERFACE comm_array
MODULE PROCEDURE real_comm_array, int_comm_array
END INTERFACE

PUBLIC ::&
     &dist_open, dist_close, &
     &dist_inquire, &
     &get_next_unit, get_mrfsdir, get_dist_maxfilesize,&
     &mrfsfile

INTEGER(KIND=JPIM) :: myproc, nproc
INTEGER(KIND=JPIM) :: iret, ilen, iroot, itag, icomm, iwords

INTEGER(KIND=JPIM), PARAMETER :: jpe_byte    = 0
INTEGER(KIND=JPIM), PARAMETER :: jpe_integer = 1
INTEGER(KIND=JPIM), PARAMETER :: jpe_real    = 2
INTEGER(KIND=JPIM), PARAMETER :: jpintbyt    = 4
INTEGER(KIND=JPIM), PARAMETER :: jpreabyt    = 8

CHARACTER(LEN=*), PARAMETER :: notdef = 'NOT DEFINED'
CHARACTER(LEN=255), SAVE :: mrfsdir          = notdef
CHARACTER(LEN=12),  SAVE :: dist_maxfilesize = notdef

LOGICAL, SAVE :: ll_has_mrfsdir = .false.
INTEGER(KIND=JPIM), SAVE :: maxfilesize    = 8 * 1024 * 1024 ! 8MB

INTEGER(KIND=JPIM), PARAMETER :: jp_maxunit = 99
INTEGER(KIND=JPIM), PARAMETER :: jp_minunit =  0

CONTAINS

!=======================================================================
!---- Public routines ----
!=======================================================================

SUBROUTINE dist_close(UNIT, FILE, STATUS, IOSTAT)

INTEGER(KIND=JPIM), INTENT(IN)                    :: UNIT
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: FILE, STATUS
INTEGER(KIND=JPIM), INTENT(OUT),         OPTIONAL :: IOSTAT

INTEGER(KIND=JPIM) :: IERR, I
LOGICAL OPENED
CHARACTER(LEN=255) CL_FILE
CHARACTER(LEN=80)  CL_STATUS

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:DIST_CLOSE',0,zhook_handle)
ierr = 0

IF (PRESENT(status)) THEN
  cl_status = adjustl(status)
  CALL toupper(cl_status)
ELSE
  cl_status = 'KEEP'
ENDIF

INQUIRE(unit=unit, opened=opened)

IF (opened) THEN
  IF (PRESENT(file) .AND. .NOT. PRESENT(status)) THEN
!--   Try to remove the "file" if in MRFSDIR to conserve MRFS-space 
!     (after all, the "file" was supposed to be a tmp-file)

    CALL get_mrfsdir()
    IF (ll_has_mrfsdir) THEN
      cl_file = adjustl(file)
      i = index(trim(cl_file), trim(mrfsdir))
      IF (i > 0) cl_status = 'DELETE'
    ENDIF
  ENDIF

  CLOSE(unit, status=trim(cl_status), iostat=ierr)
ENDIF

IF (PRESENT(iostat)) THEN
  iostat = ierr
ENDIF
IF (lhook) CALL dr_hook('DISTIO_MIX:DIST_CLOSE',1,zhook_handle)
END SUBROUTINE dist_close

!=======================================================================

SUBROUTINE dist_inquire(FILE, EXIST)

CHARACTER(LEN=*), INTENT(IN)   :: FILE
LOGICAL,          INTENT(OUT)  :: EXIST
INTEGER(KIND=JPIM) :: I_EXIST

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:DIST_INQUIRE',0,zhook_handle)
i_exist = 0
#ifdef SFX_MPI
nproc  = mpl_numproc
myproc = mpl_rank
#else
nproc = 1
myproc = 0
#endif

IF (myproc == 1) THEN
  INQUIRE(file=file, exist=exist)
  IF (exist) i_exist = 1
ENDIF

IF (nproc > 1) THEN
!--   Broadcast the file existence status
  ilen  = 1
  iroot = 1
  itag  = 500
  icomm = 0
#ifdef SFX_MPI
  CALL mpl_broadcast(i_exist,kroot=iroot,ktag=itag, &
   & cdstring='DIST_INQUIRE:')
#endif
ENDIF

exist = (i_exist == 1)
IF (lhook) CALL dr_hook('DISTIO_MIX:DIST_INQUIRE',1,zhook_handle)
END SUBROUTINE dist_inquire

!=======================================================================

SUBROUTINE dist_open(&
!--   Optional parameters (FORTRAN-OPEN style) --
     &unit, file, iostat,&
     &status, form, action,&
     &access, recl, &
     &fmt,&
!--   Optional ARRAYs (real ARRAY has presedence over the integer ARRAY)
     &array, iarray,&
!--   The actual filename on which the I/O is (was) applied to
     &localfile)


!..   A subroutine to open the same file only by the processor#1
!     and then distribute it to the other processors via
!     fast communication network.

!     Remote processors save the contents into their (preferably)
!     memory resident file system and open it there and return
!     a handle.

!     ... or ...

!     if one of the ARRAYs are provided, then data is read into it
!     by processor#1 and distributed to others

!     NOTE: Initially meant only for Read/Only -files

!     Algorithm(s) used:
!     ==================

!     (1) Processor#1 (raw-)reads the file
!         and sends it to all other processors (incl. itself)
!     (2) All processors store the bytes into their memory resident
!         file system and issue appropriate OPEN to that file
!     (3) File is silently closed if unit was not specified

!     except if:

!        If one of the arrays ARRAY or IARRAY exist, then the phase (2)
!        is skipped, but ARRAY/IARRAY is read in by proc#1 and xferred
!        to other PEs via network.

!        After this file is closed if no unit number was given

!     If environment-value MRFSDIR is not defined, then
!     all processors are forced to OPEN the same (shared) file.

!     Author: Sami Saarinen, ECMWF, 18/11/97




!--   unit : I/O-channel
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL       :: UNIT

!--   file: Target file, that processor#1 reads
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: FILE

!--   iostat: An error code from the latest I/O operation
!             OR internal error from the DISTIO_MIX-routine (iostat < -10000)
!     -10001 : Both file name AND unit number were not given
!     -10002 : File is not read/only
!     -10004 : Free format, textual direct access read not allowed
!     -10008 : Direct access file has record length <= 0
!     -10016 : Neither unit number, nor ARRAY/IARRAY were supplied
!     -10032 : Format error
!     or combination of internal errors; find out via "mod(-ierr,10000)"

INTEGER(KIND=JPIM), INTENT(OUT), OPTIONAL :: IOSTAT

!--   status, form, action, access, recl: FORTRAN-OPEN's keywords
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: STATUS, FORM, ACTION, ACCESS
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: RECL

!--   fmt: The possible format to be used when reading an ARRAY/IARRAY
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: FMT

!--   ARRAY: Real array
REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: ARRAY(:)

!--   IARRAY: Integer array
INTEGER(KIND=JPIM), INTENT(OUT), OPTIONAL :: IARRAY(:)

!--   localfile: The actual file name where the handle 'unit' (possibly)  refers to
!              An output parameter that (usually) has a value $MRFSDIR/file
CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: LOCALFILE


! === END OF INTERFACE BLOCK ===
INTEGER(KIND=JPIM) :: IERR, ITMP
INTEGER(KIND=JPIM) :: I_UNIT, I_RECL
LOGICAL LL_OPEN, LL_CLOSE, LL_HAS_BEEN_COMMUNICATED
LOGICAL LL_READ_ONLY, LL_FORMATTED, LL_DIRECT_ACCESS
LOGICAL LL_REAL_ARRAY, LL_HAS_ARRAY
CHARACTER(LEN=255) CL_FILE, CL_TMPNAME
CHARACTER(LEN= 80) CL_STATUS, CL_ACTION, CL_FORM, CL_ACCESS, CL_FMT

!234567890-234567890-234567890-234567890-234567890-234567890-234567890--

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:DIST_OPEN',0,zhook_handle)
ierr = 0
#ifdef SFX_MPI
nproc  = mpl_numproc
myproc = mpl_rank
#else
nproc = 1
myproc = 0
#endif

ll_open  = .false.
ll_close = .false.

!--   unit
IF (PRESENT(unit)) THEN
  i_unit = unit
ELSE
  CALL get_next_unit(i_unit)
  ll_close = .true.
ENDIF

!--   file
IF (PRESENT(file)) THEN
  cl_file = adjustl(file)
ELSE
  IF (i_unit >= jp_minunit .AND. i_unit <= jp_maxunit) THEN
    WRITE(cl_file,"('fort.',i4)") i_unit
    CALL strip(cl_file,' ') ! File became "fort.<unit>"
  ELSE
    cl_file = notdef
    ierr = ierr + 1
  ENDIF
ENDIF

!--   status
IF (PRESENT(status)) THEN
  cl_status = adjustl(status)
  CALL toupper(cl_status)
ELSE
  cl_status = 'OLD'
ENDIF

!--   action
IF (PRESENT(action)) THEN
  cl_action = adjustl(action)
  CALL toupper(cl_action)
ELSE
  cl_action = 'READ'
ENDIF

ll_read_only = (&
     &(cl_status == 'OLD' .OR. cl_status == 'UNKNOWN')&
     &.AND. &
     &(cl_action == 'READ') )

IF (.NOT. ll_read_only) THEN
  ierr = ierr + 2
ENDIF

!--   fmt
IF (PRESENT(fmt)) THEN
  cl_fmt = fmt
ELSE
  cl_fmt = '*'
ENDIF

!--   form
IF (PRESENT(form)) THEN
  cl_form = adjustl(form)
  CALL toupper(cl_form)
ELSE
  cl_form = 'FORMATTED'
ENDIF

ll_formatted = (cl_form == 'FORMATTED')

IF (ll_formatted) THEN
  IF (cl_fmt /= '*') THEN
    itmp = len_trim(cl_fmt)
    IF (itmp <= 2) THEN
      ierr = ierr + 32
    ELSE IF (cl_fmt(1:1) /= '(' .AND. cl_fmt(itmp:itmp) /= ')') THEN
      ierr = ierr + 32
    ENDIF
  ENDIF
ENDIF

!--   access
IF (PRESENT(access)) THEN
  cl_access = adjustl(access)
  CALL toupper(cl_access)
ELSE
  cl_access = 'SEQUENTIAL'
ENDIF

ll_direct_access = (cl_access == 'DIRECT')

IF ( ll_direct_access .AND. ll_formatted .AND. cl_fmt == '*') THEN
  ierr = ierr + 4
ENDIF

!--   recl
IF (PRESENT(recl)) THEN
  i_recl = recl
ELSE
  i_recl = 0
ENDIF

IF (ll_direct_access .AND. i_recl <= 0) THEN
  ierr = ierr + 8
ENDIF

!--   ARRAY or IARRAY
ll_real_array = .true.

IF (PRESENT(array)) THEN
  ll_real_array = .true.
ELSE IF (PRESENT(iarray)) THEN
  ll_real_array = .false.
ENDIF

ll_has_array = (PRESENT(array) .OR. PRESENT(iarray))

IF (.NOT. ll_has_array .AND. .NOT. PRESENT(unit)) THEN
  ierr = ierr + 16
ENDIF

!=======================================================================
IF (ierr /= 0) ierr = -(ierr + 10000)
IF (ierr < 0) GOTO 9999
!=======================================================================

!--   Is the memory resident file system available ?
CALL get_mrfsdir()

!--   Max file size that is allowed to go over the network
CALL get_dist_maxfilesize()

!=======================================================================
IF (.NOT. ll_has_array) THEN
!--   Communicate the file over the network
  CALL comm_file(cl_file, ll_has_been_communicated)
  ll_open = .true.
ELSE
  ll_has_been_communicated = .false.
  ll_open  = (myproc == 1)
  ll_close = ll_open
ENDIF
!=======================================================================

IF (ll_has_been_communicated) THEN
  CALL make_local_filename(cl_tmpname, cl_file)
  cl_file = cl_tmpname
ENDIF

IF (PRESENT(localfile)) THEN
  IF (scan(cl_file,'/') > 0) THEN
    localfile = adjustl(cl_file)
  ELSE
    localfile = './'//adjustl(cl_file)
  ENDIF
ENDIF

IF (ll_open) THEN
!--   Open the file via Fortran-OPEN

  IF (ll_formatted) THEN

!--   Formatted file
    IF (ll_direct_access) THEN
!---  .. Direct access
      OPEN(unit=i_unit, file=trim(cl_file),&
       &status=trim(cl_status), form='FORMATTED',&
       &access='DIRECT', recl=i_recl, action='READ',&
       &iostat=ierr, err=9999)
    ELSE
!---  .. Sequential
      OPEN(unit=i_unit, file=trim(cl_file),&
       &status=trim(cl_status), form='FORMATTED',&
       &access='SEQUENTIAL', action='READ',&
       &position='REWIND',&
       &iostat=ierr, err=9999)
    ENDIF

  ELSE

!--   Unformatted file
    IF (ll_direct_access) THEN
!---  .. Direct access
      OPEN(unit=i_unit, file=trim(cl_file),&
       &status=trim(cl_status), form='UNFORMATTED',&
       &access='DIRECT', recl=i_recl, action='READ',&
       &iostat=ierr, err=9999)
    ELSE
!---  .. Sequential
      OPEN(unit=i_unit, file=trim(cl_file),&
       &status=trim(cl_status), form='UNFORMATTED',&
       &access='SEQUENTIAL', action='READ',&
       &position='REWIND',&
       &iostat=ierr, err=9999)
    ENDIF

  ENDIF

ENDIF

!=======================================================================
IF (ll_has_array) THEN
  IF (ll_real_array) THEN
    CALL comm_array(i_unit, array,&
     &trim(adjustl(cl_fmt)), ierr,&
     &ll_direct_access, ll_formatted)
  ELSE
    CALL comm_array(i_unit, iarray,&
     &trim(adjustl(cl_fmt)), ierr,&
     &ll_direct_access, ll_formatted)
  ENDIF
ENDIF

IF (ierr /= 0) GOTO 9999
!=======================================================================

IF (ll_close) CLOSE(i_unit, iostat=ierr, err=9999)

9999 CONTINUE
IF (PRESENT(iostat)) THEN
  iostat = ierr
ENDIF
IF (lhook) CALL dr_hook('DISTIO_MIX:DIST_OPEN',1,zhook_handle)
END SUBROUTINE dist_open

!=======================================================================

SUBROUTINE get_next_unit(KUNIT)

INTEGER(KIND=JPIM), INTENT(OUT) :: KUNIT
INTEGER(KIND=JPIM) :: J
LOGICAL LOPENED
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:GET_NEXT_UNIT',0,zhook_handle)
kunit = -1
DO j=jp_maxunit, jp_minunit, -1
  INQUIRE(unit=j, opened=lopened)
  IF (.NOT.lopened) THEN
    kunit = j
    IF (lhook) CALL dr_hook('DISTIO_MIX:GET_NEXT_UNIT',1,zhook_handle)
    RETURN
  ENDIF
ENDDO
IF (lhook) CALL dr_hook('DISTIO_MIX:GET_NEXT_UNIT',1,zhook_handle)
END SUBROUTINE get_next_unit

SUBROUTINE get_mrfsdir(KOUT, CDOUT)
!--   Look for MRFSDIR (memory resident file system) environment variable

INTEGER(KIND=JPIM), INTENT(IN)          , OPTIONAL :: KOUT
CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: CDOUT
INTEGER(KIND=JPIM) :: I
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:GET_MRFSDIR',0,zhook_handle)
IF (mrfsdir == notdef) THEN
  CALL get_environment_variable('DIST_MRFSPATH', mrfsdir)
  mrfsdir = adjustl(mrfsdir)
  i = len_trim(mrfsdir)
  loop: DO WHILE (i > 0)
!     Remove any trailing slashes '/'
    IF (mrfsdir(i:i) /= '/') EXIT loop
    mrfsdir(i:i) = ' '
    i = i - 1
  ENDDO loop
  IF (mrfsdir == '.') mrfsdir = ' '
  ll_has_mrfsdir = (mrfsdir /= ' ')

  IF (PRESENT(kout)) THEN
#ifdef SFX_MPI
    myproc = mpl_rank
#else
    myproc = 0
#endif
    IF (myproc == 1) THEN
      IF (ll_has_mrfsdir) THEN
        WRITE(kout,*)'GET_MRFSDIR: MRFSDIR="'//trim(mrfsdir)//'"'
      ELSE
        WRITE(kout,*)'GET_MRFSDIR: MRFSDIR not present'
      ENDIF
    ENDIF
  ENDIF
ENDIF
IF (PRESENT(cdout)) THEN
  cdout = mrfsdir
ENDIF
IF (lhook) CALL dr_hook('DISTIO_MIX:GET_MRFSDIR',1,zhook_handle)
END SUBROUTINE get_mrfsdir

SUBROUTINE get_dist_maxfilesize(KOUT, KMAXSIZE)
!--   Get the maximum permissible size of the file to be communicated
!     This option is to avoid excessively large files dealt
!     with this concept

INTEGER(KIND=JPIM), INTENT(IN) , OPTIONAL :: KOUT
INTEGER(KIND=JPIM), INTENT(OUT), OPTIONAL :: KMAXSIZE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:GET_DIST_MAXFILESIZE',0,zhook_handle)
IF (dist_maxfilesize == notdef) THEN
  CALL get_environment_variable('DIST_MAXFILESIZE', dist_maxfilesize)
  IF (dist_maxfilesize /= ' ') THEN
    dist_maxfilesize = trim(adjustl(dist_maxfilesize))
    READ(dist_maxfilesize,'(i12)',err=9999) maxfilesize
  ENDIF
  9999 CONTINUE
  maxfilesize = max(-1,maxfilesize)

  IF (PRESENT(kout)) THEN
#ifdef SFX_MPI
    myproc = mpl_rank
#else
    myproc = 0
#endif
    IF (myproc == 1) THEN
      WRITE(kout,'(1x,2a,i12,a)')&
       &'GET_DIST_MAXFILESIZE: ',&
       &'Largest file to be distributed: ',&
       &maxfilesize,' bytes'
    ENDIF
  ENDIF
ENDIF
IF (PRESENT(kmaxsize)) THEN
  kmaxsize = maxfilesize
ENDIF
IF (lhook) CALL dr_hook('DISTIO_MIX:GET_DIST_MAXFILESIZE',1,zhook_handle)
END SUBROUTINE get_dist_maxfilesize

!=======================================================================
!---- Private routines ----
!=======================================================================

SUBROUTINE toupper(CDS)

!--   Converts lowercase letters to uppercase
CHARACTER(LEN=*), INTENT(INOUT) :: CDS
INTEGER(KIND=JPIM), PARAMETER :: ICH_A = ichar('A')
INTEGER(KIND=JPIM), PARAMETER :: ICHA  = ichar('a')
INTEGER(KIND=JPIM), PARAMETER :: ICHZ  = ichar('z')
INTEGER(KIND=JPIM) :: I, ICH, NEW_ICH, ILEN
CHARACTER(LEN=1) CH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:TOUPPER',0,zhook_handle)
ilen = len_trim(cds)
DO i=1,ilen
  ch = cds(i:i)
  ich = ichar(ch)
  IF ( ich >= icha .AND. ich <= ichz ) THEN
    new_ich = ich + (ich_a - icha)
    ch = char(new_ich)
    cds(i:i) = ch
  ENDIF
ENDDO
IF (lhook) CALL dr_hook('DISTIO_MIX:TOUPPER',1,zhook_handle)
END SUBROUTINE toupper

SUBROUTINE strip(CDS,CDWHAT)

!--   Strips off all possible characters 'cdwhat'
CHARACTER(LEN=*), INTENT(INOUT) :: CDS
CHARACTER(LEN=1), INTENT(IN)    :: CDWHAT
CHARACTER(LEN=LEN(CDS)) CLS
INTEGER(KIND=JPIM) :: I, J, ILEN
CHARACTER(LEN=1) CH
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:STRIP',0,zhook_handle)
cls = ' '
j = 0
ilen = len_trim(cds)
DO i=1,ilen
  ch = cds(i:i)
  IF (ch /= cdwhat) THEN
    j = j + 1
    cls(j:j) = ch
  ENDIF
ENDDO
cds = trim(adjustl(cls))
IF (lhook) CALL dr_hook('DISTIO_MIX:STRIP',1,zhook_handle)
END SUBROUTINE strip

SUBROUTINE make_local_filename(CLFILE, CDFILE)

CHARACTER(LEN=*), INTENT(OUT) :: CLFILE
CHARACTER(LEN=*), INTENT(IN)  :: CDFILE
LOGICAL, PARAMETER :: LL_REVERSE = .true.
INTEGER(KIND=JPIM) :: I
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:MAKE_LOCAL_FILENAME',0,zhook_handle)
clfile = adjustl(cdfile)
i = scan(clfile,'/',ll_reverse) ! The basename after the path
IF (i > 0) clfile(1:i) = ' '
clfile = trim(adjustl(clfile))
clfile = trim(adjustl(mrfsdir))//"/"//clfile ! $MRFSDIR/filename
WRITE(clfile,"(a,'.',i4.4)") trim(adjustl(clfile)),myproc
IF (lhook) CALL dr_hook('DISTIO_MIX:MAKE_LOCAL_FILENAME',1,zhook_handle)
END SUBROUTINE make_local_filename

SUBROUTINE comm_file(CDFILE, LDSTATUS)
!--   Communicate the file

CHARACTER(LEN=*), INTENT(IN) :: CDFILE
LOGICAL, INTENT(OUT)         :: LDSTATUS

INTEGER(KIND=JPIM) :: IFILESIZE
INTEGER(KIND=JPIM), ALLOCATABLE :: FILE_CONTENTS(:)
LOGICAL LL_HAS_BEEN_COMMUNICATED
CHARACTER(LEN=255) CL_TMPNAME
CHARACTER(LEN=4)   CL_PROCID

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:COMM_FILE',0,zhook_handle)
ll_has_been_communicated = .false.

IF (nproc <= 1) GOTO 9999

ifilesize = 0

IF (ll_has_mrfsdir) THEN
  IF (myproc == 1) THEN
    CALL util_filesize(trim(cdfile), ifilesize)
    IF (maxfilesize /= -1) THEN
      IF (ifilesize > maxfilesize) ifilesize = -ifilesize
    ENDIF
  ENDIF
ENDIF

iroot = 1
itag  = 100
icomm = 0
#ifdef SFX_MPI
CALL mpl_broadcast(ifilesize,kroot=iroot,ktag=itag, &
   & cdstring='COMM_FILE:')
#endif
IF (ifilesize > 0) THEN
  iwords = (ifilesize + jpintbyt - 1)/jpintbyt
  ALLOCATE(file_contents(iwords))

!--   Only processor#1 reads it
  IF (myproc == 1) THEN
    CALL util_readraw(trim(cdfile), file_contents, ifilesize, iret)
    IF (iret /= ifilesize) THEN
#ifdef SFX_MPI
      CALL mpl_message(ldabort=.true., &
        & cdmessage='File "'//trim(cdfile)//'" read error at proc#1', &
        & cdstring='** Problems with UTIL_READRAW **')
#endif
    ENDIF
  ENDIF

!--   ... and then broadcasts to all

  ilen  = iwords
  iroot = 1
  itag  = 200
  icomm = 0
#ifdef SFX_MPI
  CALL mpl_broadcast(file_contents(1:ilen),kroot=iroot,ktag=itag, &
   & cdstring='COMM_FILE:')
#endif

!--   ... and finally store it into the *local* MRFSDIR

  CALL make_local_filename(cl_tmpname, cdfile)

  CALL util_writeraw(trim(cl_tmpname), file_contents, ifilesize, iret)
  IF (iret /= ifilesize) THEN
    WRITE(cl_procid,'(i4)') myproc
#ifdef SFX_MPI
    CALL mpl_message(ldabort=.true., &
      & cdmessage='File "'//trim(cl_tmpname)//'" write error at proc#'&
      &//trim(adjustl(cl_procid)), &
      & cdstring='** Problems with UTIL_WRITERAW **')
#endif
  ENDIF

  DEALLOCATE(file_contents)
  ll_has_been_communicated = .true.
ENDIF

9999 CONTINUE
ldstatus = ll_has_been_communicated
IF (lhook) CALL dr_hook('DISTIO_MIX:COMM_FILE',1,zhook_handle)
END SUBROUTINE comm_file

SUBROUTINE real_comm_array(I_UNIT, ARRAY,&
           &CDFMT, IERR,&
           &LL_DIRECT_ACCESS, LL_FORMATTED)

INTEGER(KIND=JPIM), INTENT(IN) :: I_UNIT
REAL(KIND=JPRB), INTENT(INOUT) :: ARRAY(:)
LOGICAL, INTENT(IN), OPTIONAL ::LL_DIRECT_ACCESS, LL_FORMATTED
CHARACTER(LEN=*), INTENT(IN) :: CDFMT
INTEGER(KIND=JPIM), INTENT(OUT) :: IERR

LOGICAL LL_FREE_FORMAT, LL_PBIO
INTEGER(KIND=JPIM) :: I_SIZE

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:REAL_COMM_ARRAY',0,zhook_handle)
ll_free_format = (cdfmt == '*')
ll_pbio        = (cdfmt == 'PBIO')
i_size = SIZE(array)

IF (myproc == 1) THEN
  IF (ll_pbio) THEN
    CALL pbread(i_unit, array, i_size*jpreabyt, ierr)
    IF (ierr == i_size*jpreabyt) ierr = 0
  ELSE
    IF (ll_formatted) THEN
      IF (ll_direct_access) THEN
        READ(i_unit, fmt=cdfmt, iostat=ierr, err=9999,rec=1) array
      ELSE
        IF (ll_free_format) THEN
          READ(i_unit, fmt=*, iostat=ierr, err=9999,end=9999) array
        ELSE
          READ(i_unit, fmt=cdfmt, iostat=ierr, err=9999,end=9999) array
        ENDIF
      ENDIF
    ELSE
      IF (ll_direct_access) THEN
        READ(i_unit, iostat=ierr, err=9999, rec=1) array
      ELSE
        READ(i_unit, iostat=ierr, err=9999,end=9999) array
      ENDIF
    ENDIF
  ENDIF
ENDIF

9999 CONTINUE

IF (nproc > 1) THEN

!--   Broadcast the error code
  iroot = 1
  itag  = 300
  icomm = 0
#ifdef SFX_MPI
  CALL mpl_broadcast(ierr,kroot=iroot,ktag=itag, &
   & cdstring='REAL_COMM_ARRAY:')
#endif
  IF (ierr == 0) THEN
!--   Broadcast the data itself if no errors
    ilen  = i_size
    iroot = 1
    itag  = 301
    icomm = 0
#ifdef SFX_MPI
    CALL mpl_broadcast(array(1:ilen),kroot=iroot,ktag=itag, &
     & cdstring='REAL_COMM_ARRAY:')
#endif
  ENDIF

ENDIF

IF (lhook) CALL dr_hook('DISTIO_MIX:REAL_COMM_ARRAY',1,zhook_handle)
END SUBROUTINE real_comm_array


SUBROUTINE int_comm_array(I_UNIT, IARRAY,&
           &CDFMT, IERR,&
           &LL_DIRECT_ACCESS, LL_FORMATTED)

INTEGER(KIND=JPIM), INTENT(IN) :: I_UNIT
INTEGER(KIND=JPIM), INTENT(INOUT) :: IARRAY(:)
LOGICAL, INTENT(IN), OPTIONAL :: LL_DIRECT_ACCESS, LL_FORMATTED
CHARACTER(LEN=*), INTENT(IN) :: CDFMT
INTEGER(KIND=JPIM), INTENT(OUT) :: IERR

LOGICAL LL_FREE_FORMAT, LL_PBIO
INTEGER(KIND=JPIM) :: I_SIZE

REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:INT_COMM_ARRAY',0,zhook_handle)
ll_free_format = (cdfmt == '*')
ll_pbio        = (cdfmt == 'PBIO')
i_size = SIZE(iarray)

IF (myproc == 1) THEN
  IF (ll_pbio) THEN
    CALL pbread(i_unit, iarray, i_size*jpintbyt, ierr)
    IF (ierr == i_size*jpintbyt) ierr = 0
  ELSE
    IF (ll_formatted) THEN
      IF (ll_direct_access) THEN
        READ(i_unit, fmt=cdfmt, iostat=ierr, err=9999,rec=1) iarray
      ELSE
        IF (ll_free_format) THEN
          READ(i_unit, fmt=*, iostat=ierr, err=9999,end=9999) iarray
        ELSE
          READ(i_unit, fmt=cdfmt, iostat=ierr, err=9999,end=9999) iarray
        ENDIF
      ENDIF
    ELSE
      IF (ll_direct_access) THEN
        READ(i_unit, iostat=ierr, err=9999, rec=1) iarray
      ELSE
        READ(i_unit, iostat=ierr, err=9999,end=9999) iarray
      ENDIF
    ENDIF
  ENDIF
ENDIF

9999 CONTINUE

IF (nproc > 1) THEN

!--   Broadcast the error code
  iroot = 1
  itag  = 400
  icomm = 0
#ifdef SFX_MPI
  CALL mpl_broadcast(ierr,kroot=iroot,ktag=itag,kerror=ierr)
#endif
  IF (ierr == 0) THEN
!--   Broadcast the data itself if no errors
    ilen  = i_size
    iroot = 1
    itag  = 401
    icomm = 0
#ifdef SFX_MPI
    CALL mpl_broadcast(iarray(1:ilen),kroot=iroot,ktag=itag, &
     & cdstring='INT_COMM_ARRAY:')
#endif
  ENDIF

ENDIF

IF (lhook) CALL dr_hook('DISTIO_MIX:INT_COMM_ARRAY',1,zhook_handle)
END SUBROUTINE int_comm_array

SUBROUTINE mrfsfile(FILE_IN, FILE_OUT)

!     A routine to prepend the "$MRFSDIR" in the front of the filename
!     If $MRFSDIR is not defined, then return original filename w/o changes.

!     Author: Sami Saarinen, ECMWF, 23/1/1998 for CY18R4





CHARACTER(LEN=*), INTENT(IN)  :: FILE_IN
CHARACTER(LEN=*), INTENT(OUT) :: FILE_OUT

! === END OF INTERFACE BLOCK ===
CHARACTER(LEN=255), SAVE :: MRFSDIR = ' '
LOGICAL, SAVE :: ALREADY_CALLED = .false.
LOGICAL, SAVE :: HAS_MRFSDIR    = .false.

!--   Cache the $MRFSDIR to avoid any further calls to GET_MRFSDIR()
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('DISTIO_MIX:MRFSFILE',0,zhook_handle)
IF (.NOT. already_called) THEN
  CALL get_mrfsdir(cdout = mrfsdir)
  has_mrfsdir = (mrfsdir /= ' ')
  already_called = .true.
ENDIF

IF (has_mrfsdir) THEN
!--   Prepend "${MRFSDIR}/" and remove any leading/trailing blanks present
  file_out = trim(adjustl(mrfsdir))//'/'//trim(adjustl(file_in))
ELSE
!--   No change
  file_out = file_in
ENDIF

IF (lhook) CALL dr_hook('DISTIO_MIX:MRFSFILE',1,zhook_handle)
END SUBROUTINE mrfsfile

END MODULE distio_mix