C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_whalos.F,v 1.7 2011/06/23 22:11:07 jmc Exp $
C $Name: $
#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
EXTERNAL
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