#include "MDSIO_OPTIONS.h"

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

C     !DESCRIPTION: \bv
c     ==================================================================
c     SUBROUTINE mds_write_whalos
c     ==================================================================
c     o Write file that includes halos. The main purpose is for
c       adjoint related "tape I/O". The secondary purpose is debugging.
c     ==================================================================
c     SUBROUTINE mds_write_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 )

C     !LOCAL VARIABLES:
c     == local variables ==
      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

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

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

c     == end of interface ==

#ifdef ALLOW_WHIO_3D
      writeWh=.TRUE.
#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='unknown',
     &         access='direct', recl=length_of_rec )
      ELSE
        dUnit=fid
      ENDIF
      ENDIF


      do i2d=1,n2d

        IF (filePrec .EQ. precFloat32) THEN
          CALL MDS_PASS_R4toRL( fld2d_procbuff_r4, fldRL,
     &             OLx, OLy, 1, i2d, n2d, 0, 0, .FALSE., myThid )
          IF ( locSingleCpuIO ) then
            CALL BAR2( myThid )
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            CALL GATHER_2D_WH_R4( fld2d_globuff_r4,
     &                            fld2d_procbuff_r4,myThid)
#  endif
          ENDIF
        ELSE
          CALL MDS_PASS_R8toRL( fld2d_procbuff_r8, fldRL,
     &             OLx, OLy, 1, i2d, n2d, 0, 0, .FALSE., myThid )
          IF ( locSingleCpuIO ) then
            CALL BAR2( myThid )
#  ifndef EXCLUDE_WHIO_GLOBUFF_2D
            CALL GATHER_2D_WH_R8( fld2d_globuff_r8,
     &                            fld2d_procbuff_r8,myThid)
#  endif
          ENDIF
        ENDIF

        _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 copy
          DO i=1,lengthBuff
            j=(jWh-1)*lengthBuff+i
            IF ( .NOT.locSingleCpuIO ) then
              IF (filePrec .EQ. precFloat32) THEN
                fld3d_procbuff_r4(j)=fld2d_procbuff_r4(i)
              ELSE
                fld3d_procbuff_r8(j)=fld2d_procbuff_r8(i)
              ENDIF
            ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
              IF (filePrec .EQ. precFloat32) THEN
                fld3d_globuff_r4(j)=fld2d_globuff_r4(i)
              ELSE
                fld3d_globuff_r8(j)=fld2d_globuff_r8(i)
              ENDIF
#  endif
            ENDIF
          ENDDO
c write chunk if needed
          IF (jWh.EQ.nWh) THEN
            IF ( .NOT.locSingleCpuIO ) then
              IF (filePrec .EQ. precFloat32) THEN
                WRITE(dUnit,rec=iWh) fld3d_procbuff_r4
              ELSE
                WRITE(dUnit,rec=iWh) fld3d_procbuff_r8
              ENDIF
            ELSE
#  ifdef INCLUDE_WHIO_GLOBUFF_3D
              IF (filePrec .EQ. precFloat32) THEN
                WRITE(dUnit,rec=iWh) fld3d_globuff_r4
              ELSE
                WRITE(dUnit,rec=iWh) fld3d_globuff_r8
              ENDIF
#  endif
            ENDIF
          ENDIF

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

      enddo

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

#endif

      RETURN
      END
