bottom_ctrl_5x5/code_ad/dummy_in_hfac.F

f8e9124d84 Jean*0001 #include "AUTODIFF_OPTIONS.h"
9f5240b52a Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
f0aa841546 Patr*0005
9f5240b52a Jean*0006 C--  File dummy_in_hfac.F:
                0007 C--   Contents
                0008 C--   o DUMMY_IN_HFAC
                0009 C--   o ADDUMMY_IN_HFAC
f8e9124d84 Jean*0010
9f5240b52a Jean*0011 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0012 CBOP
                0013 C     !ROUTINE: DUMMY_IN_HFAC
                0014 C     !INTERFACE:
                0015       SUBROUTINE DUMMY_IN_HFAC( myName, myIter, myThid )
f8e9124d84 Jean*0016
9f5240b52a Jean*0017 C     !DESCRIPTION: \bv
                0018 C     Forward S/R is empty
                0019 C     \ev
                0020
                0021 C     !USES:
f0aa841546 Patr*0022       IMPLICIT NONE
                0023 C     == Global variables ===
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027
9f5240b52a Jean*0028 C     !INPUT/OUTPUT PARAMETERS:
                0029 C     myThid :: Thread number for this instance of the routine.
                0030       CHARACTER*(*) myName
f8e9124d84 Jean*0031       INTEGER myIter
                0032       INTEGER myThid
9f5240b52a Jean*0033 CEOP
f0aa841546 Patr*0034
f8e9124d84 Jean*0035       RETURN
                0036       END
f0aa841546 Patr*0037
f8e9124d84 Jean*0038 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
f0aa841546 Patr*0039 CBOP
9f5240b52a Jean*0040 C     !ROUTINE: ADDUMMY_IN_HFAC
f0aa841546 Patr*0041 C     !INTERFACE:
9f5240b52a Jean*0042       SUBROUTINE ADDUMMY_IN_HFAC( myName, myIter, myThid )
f0aa841546 Patr*0043
                0044 C     !DESCRIPTION: \bv
                0045 C     *==========================================================*
f8e9124d84 Jean*0046 C     | SUBROUTINE addummy_in_hfac
f0aa841546 Patr*0047 C     *==========================================================*
                0048 C     Extract adjoint variable from TAMC/TAF-generated
                0049 C     adjoint common blocks, contained in adcommon.h
                0050 C     and write fields to file;
                0051 C     Make sure common blocks in adcommon.h are up-to-date
                0052 C     w.r.t. current adjoint code.
                0053 C     *==========================================================*
f8e9124d84 Jean*0054 C     | SUBROUTINE addummy_in_hfac
f0aa841546 Patr*0055 C     *==========================================================*
                0056 C     \ev
                0057
                0058 C     !USES:
                0059       IMPLICIT NONE
                0060
                0061 C     == Global variables ===
                0062 #include "SIZE.h"
                0063 #include "EEPARAMS.h"
                0064 #include "PARAMS.h"
                0065 #ifdef ALLOW_AUTODIFF_MONITOR
                0066 #include "adcommon.h"
                0067 #endif
                0068
9f5240b52a Jean*0069 C     !INPUT/OUTPUT PARAMETERS:
                0070 C     myThid :: Thread number for this instance of the routine.
                0071       CHARACTER*(1) myName
                0072       INTEGER myIter
                0073       INTEGER myThid
                0074
                0075 #ifdef ALLOW_AUTODIFF_MONITOR
                0076 #ifdef ALLOW_DEPTH_CONTROL
                0077 C     !FUNCTIONS:
f0aa841546 Patr*0078       LOGICAL  DIFFERENT_MULTIPLE
                0079       EXTERNAL DIFFERENT_MULTIPLE
                0080       INTEGER  IO_ERRCOUNT
                0081       EXTERNAL IO_ERRCOUNT
                0082
                0083 C     !LOCAL VARIABLES:
9f5240b52a Jean*0084 C     suff            :: Hold suffix part of a filename
                0085 C     beginIOErrCount :: Begin IO error counts
                0086 C     endIOErrCount   :: End IO error counts
                0087 C     msgBuf          :: Error message buffer
f0aa841546 Patr*0088       CHARACTER*(MAX_LEN_FNAM) suff
                0089       INTEGER beginIOErrCount
                0090       INTEGER endIOErrCount
                0091       CHARACTER*(MAX_LEN_MBUF) msgBuf
9f5240b52a Jean*0092       _RL myTime
                0093       CHARACTER*(5) myFullName
f0aa841546 Patr*0094 CEOP
                0095
9f5240b52a Jean*0096       myTime = 0.
f0aa841546 Patr*0097
9f5240b52a Jean*0098       IF ( DIFFERENT_MULTIPLE( dumpFreq, myTime, myTime-deltaTClock )
                0099      &   ) THEN
f0aa841546 Patr*0100
f8e9124d84 Jean*0101         CALL TIMER_START('I/O (WRITE)        [ADJOINT LOOP]', myThid )
f0aa841546 Patr*0102
                0103 C--     Set suffix for this set of data files.
                0104         WRITE(suff,'(I10.10)') myIter
                0105
                0106 C--     Read IO error counter
                0107         beginIOErrCount = IO_ERRCOUNT(myThid)
                0108
9f5240b52a Jean*0109         IF ( myName .EQ. 'C' ) THEN
                0110           myFullName = 'hFacC'
                0111           CALL WRITE_FLD_XYZ_RL( 'ADJhFacC.', suff, adhfacc,
                0112      &                           myIter, myThid )
                0113         ELSE IF ( myName .EQ. 'W' ) THEN
                0114           myFullName = 'hFacW'
                0115           CALL WRITE_FLD_XYZ_RL( 'ADJhFacW.', suff, adhfacw,
                0116      &                           myIter, myThid )
                0117         ELSE IF ( myName .EQ. 'S' ) THEN
                0118           myFullName = 'hFacS'
                0119           CALL WRITE_FLD_XYZ_RL( 'ADJhFacS.', suff, adhfacs,
                0120      &                           myIter, myThid )
f0aa841546 Patr*0121         ELSE
9f5240b52a Jean*0122           WRITE(*,*) 'addummy_in_hfac: no valid myName specified'
f0aa841546 Patr*0123         END IF
                0124 C--     Reread IO error counter
                0125         endIOErrCount = IO_ERRCOUNT(myThid)
                0126
                0127 C--     Check for IO errors
                0128         IF ( endIOErrCount .NE. beginIOErrCount ) THEN
9f5240b52a Jean*0129           WRITE(msgBuf,'(A)')  'S/R WRITE_STATE'
                0130           CALL PRINT_ERROR( msgBuf, myThid )
                0131           WRITE(msgBuf,'(A)')  'Error writing out model state'
                0132           CALL PRINT_ERROR( msgBuf, myThid )
                0133           WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
                0134           CALL PRINT_ERROR( msgBuf, myThid )
f0aa841546 Patr*0135         ELSE
9f5240b52a Jean*0136           WRITE(msgBuf,'(A,I10)')
                0137      &     '// ad'//myFullName//' written, timestep', myIter
                0138           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0139      &                        SQUEEZE_RIGHT, myThid )
                0140           WRITE(msgBuf,'(A)')  ' '
                0141           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0142      &                        SQUEEZE_RIGHT, myThid )
f0aa841546 Patr*0143         ENDIF
                0144
f8e9124d84 Jean*0145         CALL TIMER_STOP( 'I/O (WRITE)        [ADJOINT LOOP]', myThid )
f0aa841546 Patr*0146
                0147       ENDIF
                0148
                0149 #endif /* ALLOW_DEPTH_CONTROL */
f55a683bf6 Jean*0150 #endif /* ALLOW_AUTODIFF_MONITOR */
f0aa841546 Patr*0151
f8e9124d84 Jean*0152       RETURN
                0153       END