C $Header: /u/gcmpack/MITgcm/pkg/autodiff/adread_adwrite.F,v 1.25 2014/04/04 23:03:59 jmc Exp $
C $Name: $
#include "AUTODIFF_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif
C ==================================================================
C
C ad_read_write.F: routines to handle the I/O of the TAMC generated
C code. All files are direct access files.
C Routines:
C o ADREAD - Read data from file.
C o ADWRITE - Write data to file.
C
C
C The following input veriables are used throughout in the argument
C lists:
C
C name - character
C On entry, name is the extended tape name.
C len - integer
C On entry, len is the number of characters in name.
C tid - integer
C On entry, tid identifies the tape.
C vid - integer
C On entry, vid identifies the variable to be stored on
C the tape.
C var - real array of dimension length
C On entry, var contains the values to be stored.
C var must not be changed.
C size - integer
C On entry, size is the size in bytes of the type of
C variable var.
C length - integer
C On entry, length is the dimension of the variable
C stored on the tape.
C irec - integer
C On entry, irec is the record number to be written.
C myThid - integer
C On entry, myThid is the number of the thread or
C instance of the program.
C
C For further details on this see the TAMC Users Manual, Appendix B,
C User defined Storage Subroutines.
C
C TAMC does not provide the two leading arguments myThid and myIter
C when compiling the MITgcmUV code. Instead the is a sed script avail-
C able that does change the TAMC-generated adjoint code.
C
C Only the master thread is allowed to write data and only gobal
C model arrays are allowed to be written be the subsequent routines.
C Tiled data are to be stored in common blocks. This implies that at
C least a two level checkpointing for the adjoint code has to be
C available.
C
C ==================================================================
CBOP
C !ROUTINE: adread
C !INTERFACE:
SUBROUTINE ADREAD(
I myThid,
I name,
I len,
I tid,
I vid,
O var,
I size,
I length,
I irec
& )
C !DESCRIPTION: \bv
C ==================================================================
C SUBROUTINE adread
C ==================================================================
C o Read direct access file.
C A call to this routine implies an open-read-close sequence
C since it uses the MITgcmUV i/o routine MDSREADVECTOR. Only
C the master thread reads the data. Otherwise each thread would
C read from file.
C started: Christian Eckert eckert@mit.edu 30-Jun-1999
C ==================================================================
C SUBROUTINE adread
C ==================================================================
C \ev
C !USES:
IMPLICIT NONE
C == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "ctrl.h"
#include "optim.h"
#include "AUTODIFF.h"
C !INPUT/OUTPUT PARAMETERS:
C == routine arguments ==
C name :: extended tape name.
C len :: number of characters in name.
C tid :: tape identifier.
C vid :: identifies the variable to be stored on tape.
C var :: values to be stored.
C size :: size in bytes of the type of variable var.
C length :: dimension of the variable stored on the tape.
C myThid :: number of the thread or instance of the program.
C irec :: record number to be written.
INTEGER myThid
CHARACTER*(*) name
INTEGER len
INTEGER tid
INTEGER vid
INTEGER size
INTEGER length
INTEGER irec
real*8 var(*)
C !FUNCTIONS:
INTEGER ILNBLNK
EXTERNAL
C !LOCAL VARIABLES:
C == local variables ==
CHARACTER*(MAX_LEN_FNAM) fname
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER filePrec
INTEGER il, jl, lenLoc
real*8 dummyR8(1)
real*4 dummyR4(1)
LOGICAL useWHTapeIO
#ifdef ALLOW_AUTODIFF_WHTAPEIO
INTEGER n2d,length2d, jrec, i2d, j2d
#endif
CEOP
#ifdef ALLOW_DEBUG
IF ( debugMode ) CALL DEBUG_ENTER('ADREAD',myThid)
#endif
C-- default is to write tape-files of same precision as array:
C convert bytes to file-prec
filePrec = 8*size
IF ( doSinglePrecTapelev ) THEN
filePrec = precFloat32
ENDIF
useWHTapeIO = .FALSE.
#ifdef ALLOW_AUTODIFF_WHTAPEIO
C determine number of 2d fields
length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy
n2d = INT(length/length2d)
IF ( size.EQ.8 .AND. n2d*length2d.EQ.length ) THEN
C- only use "WHTAPEIO" when type and length match
useWHTapeIO = .TRUE.
ENDIF
#endif /* ALLOW_AUTODIFF_WHTAPEIO */
il = ILNBLNK( name )
jl = ILNBLNK( adTapeDir )
IF ( useWHTapeIO ) THEN
lenLoc = il+jl
WRITE(fname,'(2A)') adTapeDir(1:jl),name(1:il)
ELSE
lenLoc = il+jl+7
WRITE(fname,'(3A,I4.4)')
& adTapeDir(1:jl),name(1:il),'.it',optimcycle
ENDIF
#ifdef ALLOW_DEBUG
IF ( debugLevel.GE.debLevC ) THEN
WRITE(msgBuf,'(2A,3I6,I9,2I3,2A)') 'ADREAD: ',
& ' tid,vid, irec, length, prec(x2)=', tid, vid, irec,
& length, size, filePrec, ' fname=', fname(1:lenLoc)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
#endif
#ifdef ALLOW_AUTODIFF_WHTAPEIO
IF ( useWHTapeIO ) THEN
cc if (n2d*length2d.EQ.length) then
DO i2d=1,n2d
if (tapeFileUnit.EQ.0) THEN
jrec=irec
else
tapeFileCounter=tapeFileCounter+1
jrec=tapeFileCounter+tapeMaxCounter*(irec-1)
if (tapeFileCounter.GT.tapeMaxCounter) stop
endif
j2d=(i2d-1)*length2d+1
call MDS_READ_WHALOS(fname,lenLoc,filePrec,tapeFileUnit,
& 1,var(j2d),jrec,tapeSingleCpuIO,tapeBufferIO,myThid)
ENDDO
cc else
C The other case actually does not (and should not) occur within the main loop,
C where we only store global arrays (i.e. with i,j,bi,bj indices) to disk.
C At init and final time it is always be possible to recompute or store in
C memory without much trouble or computational cost.
C
C Presently there are three instances where non-global arrays are stored to disk:
C (a) the one instance when onetape is used, to store myTime, which is of no effect.
C In the_main_loop, we switch onetape to memory tape if ALLOW_AUTODIFF_WHTAPEIO
C (b) the two instances when tapelev_ini_bibj_k is used (in convective
C _adjustment_ini.F and cost_drifter.F) are disabled at compile time if
C ALLOW_AUTODIFF_WHTAPEIO. So is the definition of tapelev_ini_bibj_k,
C which is not supported with ALLOW_AUTODIFF_WHTAPEIO (side-note:
C tapelev_ini_bibj_k is likely unsafe with mdsreadvector/mdsreadvector)
C
C The issue could be revisited if needed.
C But for now we stop if any otehr instance is met.
cc WRITE(msgBuf,'(3A)')
cc & 'ADWRITE: ',name,'was not saved to tape.'
cc CALL PRINT_ERROR( msgBuf, myThid )
cc STOP 'ABNORMAL END: S/R ADWRITE'
cc endif
ELSE
#else
IF ( .TRUE. ) THEN
#endif /* ALLOW_AUTODIFF_WHTAPEIO */
_BEGIN_MASTER( myThid )
IF ( size.EQ.4 ) THEN
c CALL MDSREADVECTOR( fname, filePrec, 'RS',
c & length, var, 1, 1, irec, myThid )
CALL MDS_READ_TAPE( fname, filePrec, 'R4',
& length, dummyR8, var,
& useSingleCpuIO, irec, myThid )
ELSE
c CALL MDSREADVECTOR( fname, filePrec, 'RL',
c & length, var, 1, 1, irec, myThid )
CALL MDS_READ_TAPE( fname, filePrec, 'R8',
& length, var, dummyR4,
& useSingleCpuIO, irec, myThid )
ENDIF
_END_MASTER( myThid )
C end if useWHTapeIO / else
ENDIF
C Everyone must wait for the read operation to be completed.
c _BARRIER
#ifdef ALLOW_DEBUG
IF ( debugMode ) CALL DEBUG_LEAVE('ADREAD',myThid)
#endif
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: adwrite
C !INTERFACE:
SUBROUTINE ADWRITE(
I myThid,
I name,
I len,
I tid,
I vid,
I var,
I size,
I length,
I irec
& )
C !DESCRIPTION: \bv
C ==================================================================
C SUBROUTINE adwrite
C ==================================================================
C o Write to direct access file.
C A call to this routine implies an open-read-close sequence
C since it uses the MITgcmUV i/o routine MDSREADVECTOR. Only
C the master thread writes the data. Otherwise each thread would
C write to file. This would result in an excessive waste of
C disk space.
C started: Christian Eckert eckert@mit.edu 30-Jun-1999
C ==================================================================
C SUBROUTINE adwrite
C ==================================================================
C \ev
C !USES:
IMPLICIT NONE
C == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "ctrl.h"
#include "optim.h"
#include "AUTODIFF.h"
C !INPUT/OUTPUT PARAMETERS:
C == routine arguments ==
C name :: extended tape name.
C len :: number of characters in name.
C tid :: tape identifier.
C vid :: identifies the variable to be stored on tape.
C var :: values to be stored.
C size :: size in bytes of the type of variable var.
C length :: dimension of the variable stored on the tape.
C myThid :: number of the thread or instance of the program.
C irec :: record number to be written.
INTEGER myThid
CHARACTER*(*) name
INTEGER len
INTEGER tid
INTEGER vid
INTEGER size
INTEGER length
INTEGER irec
real*8 var(*)
C !FUNCTIONS:
INTEGER ILNBLNK
EXTERNAL
C !LOCAL VARIABLES:
C == local variables ==
CHARACTER*(MAX_LEN_FNAM) fname
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER filePrec
INTEGER il,jl,lenLoc
real*8 dummyR8(1)
real*4 dummyR4(1)
LOGICAL useWHTapeIO
LOGICAL globalfile
#ifdef ALLOW_AUTODIFF_WHTAPEIO
INTEGER n2d,length2d, jrec, i2d, j2d
#endif
CEOP
#ifdef ALLOW_DEBUG
IF ( debugMode ) CALL DEBUG_ENTER('ADWRITE',myThid)
#endif
C-- default is to write tape-files of same precision as array:
C convert bytes to file-prec
filePrec = 8*size
IF ( doSinglePrecTapelev ) THEN
filePrec = precFloat32
ENDIF
useWHTapeIO = .FALSE.
#ifdef ALLOW_AUTODIFF_WHTAPEIO
C determine number of 2d fields
length2d = (sNx+2*OLx)*(sNy+2*OLy)*nSx*nSy
n2d = INT(length/length2d)
IF ( size.EQ.8 .AND. n2d*length2d.EQ.length ) THEN
C- only use "WHTAPEIO" when type and length match
useWHTapeIO = .TRUE.
ENDIF
#endif /* ALLOW_AUTODIFF_WHTAPEIO */
il = ILNBLNK( name )
jl = ILNBLNK( adTapeDir )
IF ( useWHTapeIO ) THEN
lenLoc = il+jl
WRITE(fname,'(2A)') adTapeDir(1:jl),name(1:il)
ELSE
lenLoc = il+jl+7
WRITE(fname,'(3A,I4.4)')
& adTapeDir(1:jl),name(1:il),'.it',optimcycle
ENDIF
#ifdef ALLOW_DEBUG
IF ( debugLevel .GE. debLevC ) THEN
WRITE(msgBuf,'(2A,3I6,I9,2I3,2A)') 'ADWRITE:',
& ' tid,vid, irec, length, prec(x2)=', tid, vid, irec,
& length, size, filePrec, ' fname=', fname(1:lenLoc)
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
#endif
#ifdef ALLOW_AUTODIFF_WHTAPEIO
IF ( useWHTapeIO ) THEN
cc if (n2d*length2d.EQ.length) then
DO i2d=1,n2d
if (tapeFileUnit.EQ.0) THEN
jrec=irec
else
tapeFileCounter=tapeFileCounter+1
jrec=tapeFileCounter+tapeMaxCounter*(irec-1)
if (tapeFileCounter.GT.tapeMaxCounter) then
write(msgBuf,'(A,2I5)')
& 'ADWRITE: tapeFileCounter > tapeMaxCounter ',
& tapeFileCounter, tapeMaxCounter
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
write(msgBuf,'(2A)') 'for file ', fname(1:lenLoc)
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
STOP 'in S/R ADWRITE'
endif
endif
j2d=(i2d-1)*length2d+1
call MDS_WRITE_WHALOS(fname,lenLoc,filePrec,tapeFileUnit,
& 1,var(j2d),jrec,tapeSingleCpuIO,tapeBufferIO,myThid)
ENDDO
cc else
cc write(msgBuf,'(3A)')
cc & 'ADWRITE: ',fname(1:lenLoc),'was not read from tape.'
cc call print_message( msgBuf, errorMessageUnit,
cc & SQUEEZE_RIGHT , myThid)
cc endif
ELSE
#else
IF ( .TRUE. ) THEN
#endif /* ALLOW_AUTODIFF_WHTAPEIO */
globalfile = globalFiles
c globalfile = .FALSE.
_BEGIN_MASTER( myThid )
IF ( size.EQ.4 ) THEN
c CALL MDSWRITEVECTOR( fname, filePrec, globalfile, 'RS',
c & length, var, 1, 1, irec, 0, myThid )
CALL MDS_WRITE_TAPE( fname, filePrec, globalfile, 'R4',
& length, dummyR8, var,
& useSingleCpuIO, irec, 0, myThid )
ELSE
c CALL MDSWRITEVECTOR( fname, filePrec, globalfile, 'RL',
c & length, var, 1, 1, irec, 0, myThid )
CALL MDS_WRITE_TAPE( fname, filePrec, globalfile, 'R8',
& length, var, dummyR4,
& useSingleCpuIO, irec, 0, myThid )
ENDIF
_END_MASTER( myThid )
C end if useWHTapeIO / else
ENDIF
C Everyone must wait for the write operation to be completed.
c _BARRIER
#ifdef ALLOW_DEBUG
IF ( debugMode ) CALL DEBUG_LEAVE('ADWRITE',myThid)
#endif
RETURN
END