pkg/autodiff/g_dummy_in_stepping.F

6d54cf9ca1 Ed H*0001 #include "AUTODIFF_OPTIONS.h"
bead363026 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
57c22ecc45 Jean*0005 #include "AD_CONFIG.h"
b79cab6898 Patr*0006
                0007 CBOP
                0008 C     !ROUTINE: g_dummy_in_stepping
                0009 C     !INTERFACE:
4545c79864 Jean*0010       subroutine g_dummy_in_stepping( myTime, myIter, myThid )
b79cab6898 Patr*0011
                0012 C     !DESCRIPTION: \bv
                0013 C     *==========================================================*
                0014 C     | SUBROUTINE g_dummy_in_stepping                           |
                0015 C     *==========================================================*
                0016 C     Extract tangent linear variable from TAMC/TAF-generated
                0017 C     tangent linear common blocks, contained in g_common.h
                0018 C     and write fields to file;
                0019 C     Make sure common blocks in g_common.h are up-to-date
                0020 C     w.r.t. current adjoint code.
                0021 C     *==========================================================*
                0022 C     | SUBROUTINE g_dummy_in_stepping                           |
                0023 C     *==========================================================*
                0024 C     \ev
                0025
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028
                0029 C     == Global variables ===
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032 #include "PARAMS.h"
d2b824a660 Patr*0033 #ifdef ALLOW_AUTODIFF_MONITOR
                0034 # include "g_common.h"
                0035 #endif
b79cab6898 Patr*0036
                0037 C     !INPUT/OUTPUT PARAMETERS:
                0038 C     == Routine arguments ==
4545c79864 Jean*0039 C     myIter :: iteration counter for this thread
                0040 C     myTime :: time counter for this thread
                0041 C     myThid :: Thread number for this instance of the routine.
                0042       INTEGER myThid
                0043       INTEGER myIter
                0044       _RL     myTime
d2b824a660 Patr*0045
ea0f79f160 Patr*0046 #ifdef ALLOW_TANGENTLINEAR_RUN
d2b824a660 Patr*0047 #ifdef ALLOW_AUTODIFF_MONITOR
b79cab6898 Patr*0048
4545c79864 Jean*0049 C     !FUNCTIONS:
                0050       LOGICAL  DIFFERENT_MULTIPLE
                0051       EXTERNAL DIFFERENT_MULTIPLE
                0052       INTEGER  IO_ERRCOUNT
                0053       EXTERNAL IO_ERRCOUNT
                0054
b79cab6898 Patr*0055 C     !LOCAL VARIABLES:
                0056 c     == local variables ==
4545c79864 Jean*0057 C     suff   :: Hold suffix part of a filename
                0058 C     msgBuf :: Error message buffer
df5a9764ba Jean*0059       CHARACTER*(10) suff
b79cab6898 Patr*0060       INTEGER beginIOErrCount
                0061       INTEGER endIOErrCount
                0062       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0063 CEOP
                0064
                0065       IF (
4545c79864 Jean*0066      &  DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
                0067      &   ) THEN
b79cab6898 Patr*0068
4545c79864 Jean*0069         CALL TIMER_START('I/O (WRITE)        [ADJOINT LOOP]', myThid )
                0070 c       write(*,*) 'myIter= ',myIter
b79cab6898 Patr*0071
                0072 C--     Set suffix for this set of data files.
df5a9764ba Jean*0073         IF ( rwSuffixType.EQ.0 ) THEN
                0074           WRITE(suff,'(I10.10)') myIter
                0075         ELSE
                0076           CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
                0077         ENDIF
b79cab6898 Patr*0078
                0079 C--     Read IO error counter
                0080         beginIOErrCount = IO_ERRCOUNT(myThid)
                0081
4545c79864 Jean*0082         CALL WRITE_FLD_XY_RL ( 'G_Jtaux.',suff, g_fu, myIter, myThid )
                0083         CALL WRITE_FLD_XY_RL ( 'G_Jtauy.',suff, g_fv, myIter, myThid )
                0084         CALL WRITE_FLD_XY_RL ( 'G_Jqnet.',suff, g_qnet, myIter,myThid )
                0085         CALL WRITE_FLD_XY_RL ( 'G_Jempr.',suff, g_empmr,myIter,myThid )
b79cab6898 Patr*0086 c
9274434acc Jean*0087         CALL WRITE_FLD_XYZ_RL(
4545c79864 Jean*0088      &       'G_Jtheta.',suff, g_theta, myIter, myThid )
9274434acc Jean*0089         CALL WRITE_FLD_XYZ_RL(
4545c79864 Jean*0090      &       'G_Jsalt.',suff, g_salt, myIter, myThid )
9274434acc Jean*0091         CALL WRITE_FLD_XYZ_RL(
4545c79864 Jean*0092      &       'G_Juvel.',suff, g_uvel, myIter, myThid )
9274434acc Jean*0093         CALL WRITE_FLD_XYZ_RL(
4545c79864 Jean*0094      &       'G_Jvvel.',suff, g_vvel, myIter, myThid )
ee0c301102 Patr*0095         CALL WRITE_FLD_XYZ_RL(
4545c79864 Jean*0096      &       'G_Jwvel.',suff, g_wvel, myIter, myThid )
ee0c301102 Patr*0097         CALL WRITE_FLD_XY_RL(
4545c79864 Jean*0098      &       'G_Jetan.',suff, g_etan, myIter, myThid )
b79cab6898 Patr*0099
                0100 #ifdef ALLOW_DIFFKR_CONTROL
9274434acc Jean*0101         CALL WRITE_FLD_XYZ_RL ( 'G_Jdiffkr.',suff, g_diffkr,
4545c79864 Jean*0102      &       myIter, myThid )
b79cab6898 Patr*0103 #endif
                0104 #ifdef ALLOW_KAPGM_CONTROL
7e2482cabc Gael*0105         CALL WRITE_FLD_XYZ_RL ( 'G_Jkapgm.',suff, g_kapgm,
4545c79864 Jean*0106      &       myIter, myThid )
7e2482cabc Gael*0107 #endif
                0108 #ifdef ALLOW_KAPREDI_CONTROL
                0109         CALL WRITE_FLD_XYZ_RL ( 'G_Jkapredi.',suff, g_kapredi,
4545c79864 Jean*0110      &       myIter, myThid )
b79cab6898 Patr*0111 #endif
                0112
4545c79864 Jean*0113 cph        CALL WRITE_FLD_XY_RL( 'G_J_sst.',suff, g_sst, myIter, myThid )
                0114 cph        CALL WRITE_FLD_XY_RL( 'G_J_sss.',suff, g_sss, myIter, myThid )
b79cab6898 Patr*0115
                0116 C--     Reread IO error counter
                0117         endIOErrCount = IO_ERRCOUNT(myThid)
                0118
                0119 C--     Check for IO errors
                0120         IF ( endIOErrCount .NE. beginIOErrCount ) THEN
                0121          WRITE(msgBuf,'(A)')  'S/R WRITE_STATE'
4545c79864 Jean*0122          CALL PRINT_ERROR( msgBuf, myThid )
b79cab6898 Patr*0123          WRITE(msgBuf,'(A)')  'Error writing out model state'
4545c79864 Jean*0124          CALL PRINT_ERROR( msgBuf, myThid )
b79cab6898 Patr*0125          WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
4545c79864 Jean*0126          CALL PRINT_ERROR( msgBuf, myThid )
b79cab6898 Patr*0127         ELSE
9274434acc Jean*0128          WRITE(msgBuf,'(A,I10)')
b79cab6898 Patr*0129      &    '// Model state written, timestep', myIter
9274434acc Jean*0130          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
4545c79864 Jean*0131      &                       SQUEEZE_RIGHT, myThid )
b79cab6898 Patr*0132          WRITE(msgBuf,'(A)')  ' '
9274434acc Jean*0133          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
4545c79864 Jean*0134      &                       SQUEEZE_RIGHT, myThid )
b79cab6898 Patr*0135         ENDIF
                0136
4545c79864 Jean*0137         CALL TIMER_STOP( 'I/O (WRITE)        [ADJOINT LOOP]', myThid )
b79cab6898 Patr*0138
                0139       ENDIF
                0140
d2b824a660 Patr*0141 #endif /* ALLOW_AUTODIFF_MONITOR */
ea0f79f160 Patr*0142 #endif /* ALLOW_TANGENTLINEAR_RUN */
d2b824a660 Patr*0143
4545c79864 Jean*0144       RETURN
                0145       END