pkg/autodiff/g_dummy_in_stepping.F

C $Header: /u/gcmpack/MITgcm/pkg/autodiff/g_dummy_in_stepping.F,v 1.15 2012/07/06 23:10:28 jmc Exp $
C $Name:  $

#include "AUTODIFF_OPTIONS.h"
#include "AD_CONFIG.h"

CBOP
C     !ROUTINE: g_dummy_in_stepping
C     !INTERFACE:
      subroutine g_dummy_in_stepping( myTime, myIter, myThid )

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

C     !USES:
      IMPLICIT NONE

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

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myIter :: iteration counter for this thread
C     myTime :: time counter for this thread
C     myThid :: Thread number for this instance of the routine.
      INTEGER myThid
      INTEGER myIter
      _RL     myTime

#ifdef ALLOW_TANGENTLINEAR_RUN
#ifdef ALLOW_AUTODIFF_MONITOR

C     !FUNCTIONS:
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE
      INTEGER  IO_ERRCOUNT
      EXTERNAL IO_ERRCOUNT

C     !LOCAL VARIABLES:
c     == local variables ==
C     suff   :: Hold suffix part of a filename
C     msgBuf :: Error message buffer
      CHARACTER*(MAX_LEN_FNAM) suff
      INTEGER beginIOErrCount
      INTEGER endIOErrCount
      CHARACTER*(MAX_LEN_MBUF) msgBuf
CEOP

      IF (
     &  DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
     &   ) THEN

        CALL TIMER_START('I/O (WRITE)        [ADJOINT LOOP]', myThid )
c       write(*,*) 'myIter= ',myIter

C--     Set suffix for this set of data files.
        WRITE(suff,'(I10.10)') myIter
C ==>> Resetting run-time parameter writeBinaryPrec in the middle of a run
C ==>>  is very very very nasty !!!
c       writeBinaryPrec = writeStatePrec
C <<==  If you really want to mess-up with this at your own risk,
C <<==  uncomment the line above

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

        CALL WRITE_FLD_XY_RL ( 'G_Jtaux.',suff, g_fu, myIter, myThid )
        CALL WRITE_FLD_XY_RL ( 'G_Jtauy.',suff, g_fv, myIter, myThid )
        CALL WRITE_FLD_XY_RL ( 'G_Jqnet.',suff, g_qnet, myIter,myThid )
        CALL WRITE_FLD_XY_RL ( 'G_Jempr.',suff, g_empmr,myIter,myThid )
c
        CALL WRITE_FLD_XYZ_RL(
     &       'G_Jtheta.',suff, g_theta, myIter, myThid )
        CALL WRITE_FLD_XYZ_RL(
     &       'G_Jsalt.',suff, g_salt, myIter, myThid )
        CALL WRITE_FLD_XYZ_RL(
     &       'G_Juvel.',suff, g_uvel, myIter, myThid )
        CALL WRITE_FLD_XYZ_RL(
     &       'G_Jvvel.',suff, g_vvel, myIter, myThid )
        CALL WRITE_FLD_XYZ_RL(
     &       'G_Jwvel.',suff, g_wvel, myIter, myThid )
        CALL WRITE_FLD_XY_RL(
     &       'G_Jetan.',suff, g_etan, myIter, myThid )

#ifdef ALLOW_DIFFKR_CONTROL
        CALL WRITE_FLD_XYZ_RL ( 'G_Jdiffkr.',suff, g_diffkr,
     &       myIter, myThid )
#endif
#ifdef ALLOW_KAPGM_CONTROL
        CALL WRITE_FLD_XYZ_RL ( 'G_Jkapgm.',suff, g_kapgm,
     &       myIter, myThid )
#endif
#ifdef ALLOW_KAPREDI_CONTROL
        CALL WRITE_FLD_XYZ_RL ( 'G_Jkapredi.',suff, g_kapredi,
     &       myIter, myThid )
#endif

cph        CALL WRITE_FLD_XY_RL( 'G_J_sst.',suff, g_sst, myIter, myThid )
cph        CALL WRITE_FLD_XY_RL( 'G_J_sss.',suff, g_sss, myIter, myThid )

#ifdef ALLOW_AUTODIFF_MONITOR_PHIHYD
        CALL WRITE_FLD_XYZ_RL(
     &       'G_Jphihyd.',suff, g_totphihyd, myIter, myThid )
#endif

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)')
     &    '// Model state 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_AUTODIFF_MONITOR */
#endif /* ALLOW_TANGENTLINEAR_RUN */

      RETURN
      END
1	jmc	1.16	C $Header: /u/gcmpack/MITgcm/pkg/autodiff/g_dummy_in_stepping.F,v 1.15 2012/07/06 23:10:28 jmc Exp $
2	jmc	1.10	C $Name: $
3	heimbach	1.1
4	edhill	1.3	#include "AUTODIFF_OPTIONS.h"
5	jmc	1.15	#include "AD_CONFIG.h"
6	heimbach	1.1
7			CBOP
8			C !ROUTINE: g_dummy_in_stepping
9			C !INTERFACE:
10	jmc	1.16	subroutine g_dummy_in_stepping( myTime, myIter, myThid )
11	heimbach	1.1
12			C !DESCRIPTION: \bv
13			C ==========================================================
14			C \| SUBROUTINE g_dummy_in_stepping \|
15			C ==========================================================
16			C Extract tangent linear variable from TAMC/TAF-generated
17			C tangent linear common blocks, contained in g_common.h
18			C and write fields to file;
19			C Make sure common blocks in g_common.h are up-to-date
20			C w.r.t. current adjoint code.
21			C ==========================================================
22			C \| SUBROUTINE g_dummy_in_stepping \|
23			C ==========================================================
24			C \ev
25
26			C !USES:
27			IMPLICIT NONE
28
29			C == Global variables ===
30			#include "SIZE.h"
31			#include "EEPARAMS.h"
32			#include "PARAMS.h"
33	heimbach	1.2	#ifdef ALLOW_AUTODIFF_MONITOR
34			# include "g_common.h"
35			#endif
36	heimbach	1.1
37			C !INPUT/OUTPUT PARAMETERS:
38			C == Routine arguments ==
39	jmc	1.16	C myIter :: iteration counter for this thread
40			C myTime :: time counter for this thread
41			C myThid :: Thread number for this instance of the routine.
42			INTEGER myThid
43			INTEGER myIter
44			_RL myTime
45	heimbach	1.2
46	heimbach	1.4	#ifdef ALLOW_TANGENTLINEAR_RUN
47	heimbach	1.2	#ifdef ALLOW_AUTODIFF_MONITOR
48	heimbach	1.1
49	jmc	1.16	C !FUNCTIONS:
50			LOGICAL DIFFERENT_MULTIPLE
51			EXTERNAL DIFFERENT_MULTIPLE
52			INTEGER IO_ERRCOUNT
53			EXTERNAL IO_ERRCOUNT
54
55	heimbach	1.1	C !LOCAL VARIABLES:
56			c == local variables ==
57	jmc	1.16	C suff :: Hold suffix part of a filename
58			C msgBuf :: Error message buffer
59	heimbach	1.1	CHARACTER*(MAX_LEN_FNAM) suff
60			INTEGER beginIOErrCount
61			INTEGER endIOErrCount
62			CHARACTER*(MAX_LEN_MBUF) msgBuf
63			CEOP
64
65			IF (
66	jmc	1.16	& DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
67			& ) THEN
68	heimbach	1.1
69	jmc	1.16	CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
70			c write(,) 'myIter= ',myIter
71	heimbach	1.1
72			C-- Set suffix for this set of data files.
73			WRITE(suff,'(I10.10)') myIter
74	jmc	1.16	C ==>> Resetting run-time parameter writeBinaryPrec in the middle of a run
75			C ==>> is very very very nasty !!!
76			c writeBinaryPrec = writeStatePrec
77			C <<== If you really want to mess-up with this at your own risk,
78			C <<== uncomment the line above
79	heimbach	1.1
80			C-- Read IO error counter
81			beginIOErrCount = IO_ERRCOUNT(myThid)
82
83	jmc	1.16	CALL WRITE_FLD_XY_RL ( 'G_Jtaux.',suff, g_fu, myIter, myThid )
84			CALL WRITE_FLD_XY_RL ( 'G_Jtauy.',suff, g_fv, myIter, myThid )
85			CALL WRITE_FLD_XY_RL ( 'G_Jqnet.',suff, g_qnet, myIter,myThid )
86			CALL WRITE_FLD_XY_RL ( 'G_Jempr.',suff, g_empmr,myIter,myThid )
87	heimbach	1.1	c
88	jmc	1.10	CALL WRITE_FLD_XYZ_RL(
89	jmc	1.16	& 'G_Jtheta.',suff, g_theta, myIter, myThid )
90	jmc	1.10	CALL WRITE_FLD_XYZ_RL(
91	jmc	1.16	& 'G_Jsalt.',suff, g_salt, myIter, myThid )
92	jmc	1.10	CALL WRITE_FLD_XYZ_RL(
93	jmc	1.16	& 'G_Juvel.',suff, g_uvel, myIter, myThid )
94	jmc	1.10	CALL WRITE_FLD_XYZ_RL(
95	jmc	1.16	& 'G_Jvvel.',suff, g_vvel, myIter, myThid )
96	heimbach	1.5	CALL WRITE_FLD_XYZ_RL(
97	jmc	1.16	& 'G_Jwvel.',suff, g_wvel, myIter, myThid )
98	heimbach	1.5	CALL WRITE_FLD_XY_RL(
99	jmc	1.16	& 'G_Jetan.',suff, g_etan, myIter, myThid )
100	heimbach	1.1
101			#ifdef ALLOW_DIFFKR_CONTROL
102	jmc	1.10	CALL WRITE_FLD_XYZ_RL ( 'G_Jdiffkr.',suff, g_diffkr,
103	jmc	1.16	& myIter, myThid )
104	heimbach	1.1	#endif
105			#ifdef ALLOW_KAPGM_CONTROL
106	gforget	1.11	CALL WRITE_FLD_XYZ_RL ( 'G_Jkapgm.',suff, g_kapgm,
107	jmc	1.16	& myIter, myThid )
108	gforget	1.11	#endif
109			#ifdef ALLOW_KAPREDI_CONTROL
110			CALL WRITE_FLD_XYZ_RL ( 'G_Jkapredi.',suff, g_kapredi,
111	jmc	1.16	& myIter, myThid )
112	heimbach	1.1	#endif
113
114	jmc	1.16	cph CALL WRITE_FLD_XY_RL( 'G_J_sst.',suff, g_sst, myIter, myThid )
115			cph CALL WRITE_FLD_XY_RL( 'G_J_sss.',suff, g_sss, myIter, myThid )
116	heimbach	1.1
117	heimbach	1.12	#ifdef ALLOW_AUTODIFF_MONITOR_PHIHYD
118			CALL WRITE_FLD_XYZ_RL(
119	jmc	1.16	& 'G_Jphihyd.',suff, g_totphihyd, myIter, myThid )
120	heimbach	1.12	#endif
121
122	heimbach	1.1	C-- Reread IO error counter
123			endIOErrCount = IO_ERRCOUNT(myThid)
124
125			C-- Check for IO errors
126			IF ( endIOErrCount .NE. beginIOErrCount ) THEN
127			WRITE(msgBuf,'(A)') 'S/R WRITE_STATE'
128	jmc	1.16	CALL PRINT_ERROR( msgBuf, myThid )
129	heimbach	1.1	WRITE(msgBuf,'(A)') 'Error writing out model state'
130	jmc	1.16	CALL PRINT_ERROR( msgBuf, myThid )
131	heimbach	1.1	WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
132	jmc	1.16	CALL PRINT_ERROR( msgBuf, myThid )
133	heimbach	1.1	ELSE
134	jmc	1.10	WRITE(msgBuf,'(A,I10)')
135	heimbach	1.1	& '// Model state written, timestep', myIter
136	jmc	1.10	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
137	jmc	1.16	& SQUEEZE_RIGHT, myThid )
138	heimbach	1.1	WRITE(msgBuf,'(A)') ' '
139	jmc	1.10	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
140	jmc	1.16	& SQUEEZE_RIGHT, myThid )
141	heimbach	1.1	ENDIF
142
143	jmc	1.16	CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid )
144	heimbach	1.1
145			ENDIF
146
147	heimbach	1.2	#endif /* ALLOW_AUTODIFF_MONITOR */
148	heimbach	1.4	#endif /* ALLOW_TANGENTLINEAR_RUN */
149	heimbach	1.2
150	jmc	1.16	RETURN
151			END