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