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