C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_whalos.F,v 1.8 2016/09/21 01:52:20 heimbach Exp $
C $Name:  $

#include "MDSIO_OPTIONS.h"

CBOP
C     !ROUTINE: mds_read_whalos
C     !INTERFACE:
      subroutine MDS_READ_WHALOS(
     I                   fName,
     I                   len,
     I                   filePrec,
     I                   fid,
     I                   n2d,
     O                   fldRL,
     I                   irec,
     I                   locSingleCPUIO,
     I                   locBufferIO,
     I                   mythid
     &                 )

C     !DESCRIPTION: \bv
c     ==================================================================
c     SUBROUTINE mds_read_whalos
c     ==================================================================
c     o Read file that includes halos. The main purpose is for
c       adjoint related "tape I/O". The secondary purpose is debugging.
c     ==================================================================
c     SUBROUTINE mds_read_whalos
c     ==================================================================
C     \ev

C     !USES:
      implicit none

c     == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#ifdef ALLOW_WHIO
#include "MDSIO_BUFF_WH.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
c     == routine arguments ==
c     fName     -  extended tape fName.
c     len       -  number of characters in fName.
c     filePrec  -  number of bits per word in file (32 or 64).
c     fid       -  file unit (its use is not implemented yet).
C     n2d       -  size of the fldRL third dimension.
c     fldRL     -  array to read.
c     irec      -  record number to be written.
c     mythid    -  number of the thread or instance of the program.

      integer mythid
      character*(*) fName
      integer len
      integer fid
      integer filePrec
      integer n2d
      integer irec
      _RL     fldRL(1-Olx:sNx+Olx,1-Oly:sNy+Oly,n2d,nSx,nSy)
      logical locSingleCPUIO, locBufferIO
CEOP

#ifdef ALLOW_WHIO
C     !LOCAL VARIABLES:
c     == local variables ==

C     sNxWh :: x tile size with halo included
C     sNyWh :: y tile size with halo included
C     pocNyWh :: processor sum of sNyWh
C     gloNyWh :: global sum of sNyWh
      INTEGER sNxWh
      INTEGER sNyWh
      INTEGER procNyWh
      INTEGER gloNyWh
      PARAMETER ( sNxWh = sNx+2*Olx )
      PARAMETER ( sNyWh = sNy+2*Oly )
      PARAMETER ( procNyWh = sNyWh*nSy*nSx )
      PARAMETER ( gloNyWh = procNyWh*nPy*nPx )

      character*(MAX_LEN_FNAM) pfName
      character*(MAX_LEN_MBUF) msgBuf
      integer IL
      integer bx,by

      integer lengthBuff, length_of_rec
      integer i2d, i3d
      integer i,j,k,bi,bj,ii
      integer dUnit, irec2d
      LOGICAL iAmDoingIO
cph(
#ifdef INTEL_COMMITQQ
cph   Fix on Pleiades following model crashes on disk /nobackupnfs2/
cph   reported by Yoshihiro.Nakayama@jpl.nasa.gov
cph forrtl: Device or resource busy
cph forrtl: severe (39): error during read, unit 1001, file
cph   Workaround by NAS engineer Sherry.Chang@nasa.gov
      logical results, commitqq
#endif
cph)


      _RL fld2d(1:sNxWh,1:sNyWh,nSx,nSy)

c     == functions ==
      INTEGER  ILNBLNK
      INTEGER  MDS_RECLEN
      EXTERNAL 
      EXTERNAL 

c     == end of interface ==

#ifdef ALLOW_WHIO_3D
      writeWh=.FALSE.
#endif

      IF ( .NOT.locSingleCpuIO ) then
        lengthBuff=sNxWh*procNyWh
      ELSE
        lengthBuff=sNxWh*gloNyWh
      ENDIF

C Only do I/O if I am the master thread (and mpi process 0 IF locSingleCpuIO):
      iAmDoingIO = .FALSE.
      IF ( .NOT.locSingleCpuIO .OR. myProcId.EQ.0 ) THEN
        _BEGIN_MASTER( myThid )
        iAmDoingIO = .TRUE.
        _END_MASTER( myThid )
      ENDIF

      IF ( iAmDoingIO ) THEN
c get the unit and open file
      IL  = ILNBLNK( fName )
      IF ( .NOT.locSingleCpuIO ) THEN
        WRITE(pfName,'(2A,I3.3,A)') fName(1:IL),'.',myProcId,'.data'
        length_of_rec = MDS_RECLEN( filePrec,sNxWh*procNyWh, myThid )
      ELSE
        WRITE(pfName,'(2A)') fName(1:IL),'.data'
        length_of_rec = MDS_RECLEN( filePrec,sNxWh*gloNyWh,myThid)
      ENDIF
      IF (fid.EQ.0) THEN
        CALL MDSFINDUNIT( dUnit, myThid )
        OPEN( dUnit, file=pfName, status='old',
     &         access='direct', recl=length_of_rec )
      ELSE
        dUnit=fid
      ENDIF
      ENDIF

cph(
cph   NAS Pleiades fix here:
#ifdef INTEL_COMMITQQ
      results = commitqq(dUnit)
#endif
cph)

      do i2d=1,n2d

        _BARRIER
#ifdef ALLOW_WHIO_3D
        IF ( iAmDoingIO.AND.locBufferIO.AND.(fid.NE.0) ) THEN
c reset counter if needed
          IF (jWh.EQ.nWh) jWh=0
c increment counter
          jWh=jWh+1
c determine current file record
          irec2d=i2d+n2d*(irec-1)
          iWh=(irec2d-1)/nWh+1
c read new chunk if needed
          IF (jWh.EQ.1) THEN
            IF ( .NOT.locSingleCpuIO ) then
              IF (filePrec .EQ. precFloat32) THEN
                READ(dUnit,rec=iWh) fld3d_procbuff_r4
              ELSE
                READ(dUnit,rec=iWh) fld3d_procbuff_r8
              ENDIF
            ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
              IF (filePrec .EQ. precFloat32) THEN
                READ(dUnit,rec=iWh) fld3d_globuff_r4
              ELSE
                READ(dUnit,rec=iWh) fld3d_globuff_r8
              ENDIF
#  endif
            ENDIF
          ENDIF
c copy
          DO i=1,lengthBuff
            j=(jWh-1)*lengthBuff+i
            IF ( .NOT.locSingleCpuIO ) then
              IF (filePrec .EQ. precFloat32) THEN
                fld2d_procbuff_r4(i)=fld3d_procbuff_r4(j)
              ELSE
                fld2d_procbuff_r8(i)=fld3d_procbuff_r8(j)
              ENDIF
            ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
              IF (filePrec .EQ. precFloat32) THEN
                fld2d_globuff_r4(i)=fld3d_globuff_r4(j)
              ELSE
                fld2d_globuff_r8(i)=fld3d_globuff_r8(j)
              ENDIF
#  endif
            ENDIF
          ENDDO

        ELSEIF ( iAmDoingIO ) THEN
#else
        IF ( iAmDoingIO ) THEN
#endif
          irec2d=i2d+n2d*(irec-1)
          IF ( .NOT.locSingleCpuIO ) then
            IF (filePrec .EQ. precFloat32) THEN
              READ(dUnit,rec=irec2d) fld2d_procbuff_r4
            ELSE
              READ(dUnit,rec=irec2d) fld2d_procbuff_r8
            ENDIF
          ELSE
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            IF (filePrec .EQ. precFloat32) THEN
              READ(dUnit,rec=irec2d) fld2d_globuff_r4
            ELSE
              READ(dUnit,rec=irec2d) fld2d_globuff_r8
            ENDIF
#  endif
          ENDIF
        ENDIF
        _BARRIER

        IF (filePrec .EQ. precFloat32) THEN
          IF ( locSingleCpuIO ) then
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            CALL SCATTER_2D_WH_R4 ( fld2d_globuff_r4,
     &                              fld2d_procbuff_r4,myThid)
#  endif
            CALL BAR2( myThid )
          ENDIF
          CALL MDS_PASS_R4TORL( fld2d_procbuff_r4, fldRL,
     &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
        ELSE
          IF ( locSingleCpuIO ) then
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            CALL SCATTER_2D_WH_R8 ( fld2d_globuff_r8,
     &                              fld2d_procbuff_r8,myThid)
#  endif
            CALL BAR2( myThid )
          ENDIF
          CALL MDS_PASS_R8TORL( fld2d_procbuff_r8, fldRL,
     &             OLx, OLy, 1, i2d, n2d, 0, 0, .TRUE., myThid )
        ENDIF

      enddo

       IF ( iAmDoingIO.AND.(fid.EQ.0) ) THEN
         CLOSE( dUnit )
       ENDIF

#endif

      RETURN
      END