dummy_in_hfac.F

#include "AUTODIFF_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif

C--  File dummy_in_hfac.F:
C--   Contents
C--   o DUMMY_IN_HFAC
C--   o ADDUMMY_IN_HFAC

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: DUMMY_IN_HFAC
C     !INTERFACE:
      SUBROUTINE DUMMY_IN_HFAC( myName, myIter, myThid )

C     !DESCRIPTION: \bv
C     Forward S/R is empty
C     \ev

C     !USES:
      IMPLICIT NONE
C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     myThid :: Thread number for this instance of the routine.
      CHARACTER*(*) myName
      INTEGER myIter
      INTEGER myThid
CEOP

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: ADDUMMY_IN_HFAC
C     !INTERFACE:
      SUBROUTINE ADDUMMY_IN_HFAC( myName, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE addummy_in_hfac
C     *==========================================================*
C     Extract adjoint variable from TAMC/TAF-generated
C     adjoint common blocks, contained in adcommon.h
C     and write fields to file;
C     Make sure common blocks in adcommon.h are up-to-date
C     w.r.t. current adjoint code.
C     *==========================================================*
C     | SUBROUTINE addummy_in_hfac
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#ifdef ALLOW_AUTODIFF_MONITOR
#include "adcommon.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     myThid :: Thread number for this instance of the routine.
      CHARACTER*(1) myName
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_AUTODIFF_MONITOR
#ifdef ALLOW_DEPTH_CONTROL
C     !FUNCTIONS:
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE
      INTEGER  IO_ERRCOUNT
      EXTERNAL IO_ERRCOUNT

C     !LOCAL VARIABLES:
C     suff            :: Hold suffix part of a filename
C     beginIOErrCount :: Begin IO error counts
C     endIOErrCount   :: End IO error counts
C     msgBuf          :: Error message buffer
      CHARACTER*(MAX_LEN_FNAM) suff
      INTEGER beginIOErrCount
      INTEGER endIOErrCount
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      _RL myTime
      CHARACTER*(5) myFullName
CEOP

      myTime = 0.

      IF ( DIFFERENT_MULTIPLE( dumpFreq, myTime, myTime-deltaTClock )
     &   ) THEN

        CALL TIMER_START('I/O (WRITE)        [ADJOINT LOOP]', myThid )

C--     Set suffix for this set of data files.
        WRITE(suff,'(I10.10)') myIter

C--     Read IO error counter
        beginIOErrCount = IO_ERRCOUNT(myThid)

        IF ( myName .EQ. 'C' ) THEN
          myFullName = 'hFacC'
          CALL WRITE_FLD_XYZ_RL( 'ADJhFacC.', suff, adhfacc,
     &                           myIter, myThid )
        ELSE IF ( myName .EQ. 'W' ) THEN
          myFullName = 'hFacW'
          CALL WRITE_FLD_XYZ_RL( 'ADJhFacW.', suff, adhfacw,
     &                           myIter, myThid )
        ELSE IF ( myName .EQ. 'S' ) THEN
          myFullName = 'hFacS'
          CALL WRITE_FLD_XYZ_RL( 'ADJhFacS.', suff, adhfacs,
     &                           myIter, myThid )
        ELSE
          WRITE(*,*) 'addummy_in_hfac: no valid myName specified'
        END IF
C--     Reread IO error counter
        endIOErrCount = IO_ERRCOUNT(myThid)

C--     Check for IO errors
        IF ( endIOErrCount .NE. beginIOErrCount ) THEN
          WRITE(msgBuf,'(A)')  'S/R WRITE_STATE'
          CALL PRINT_ERROR( msgBuf, myThid )
          WRITE(msgBuf,'(A)')  'Error writing out model state'
          CALL PRINT_ERROR( msgBuf, myThid )
          WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
          CALL PRINT_ERROR( msgBuf, myThid )
        ELSE
          WRITE(msgBuf,'(A,I10)')
     &     '// ad'//myFullName//' written, timestep', myIter
          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                        SQUEEZE_RIGHT, myThid )
          WRITE(msgBuf,'(A)')  ' '
          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                        SQUEEZE_RIGHT, myThid )
        ENDIF

        CALL TIMER_STOP( 'I/O (WRITE)        [ADJOINT LOOP]', myThid )

      ENDIF

#endif /* ALLOW_DEPTH_CONTROL */
#endif /* ALLOW_AUTODIFF_MONITOR */

      RETURN
      END