pkg/seaice/seaice_ad_dump.F

C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_ad_dump.F,v 1.8 2012/08/07 21:19:18 gforget Exp $
C $Name:  $

#include "SEAICE_OPTIONS.h"
#include "AD_CONFIG.h"

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

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE seaice_ad_dump
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 seaice_ad_dump
C     *==========================================================*
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "SEAICE_PARAMS.h"
#ifdef ALLOW_MNC
#include "MNC_PARAMS.h"
#endif
#include "GRID.h"
#ifdef ALLOW_AUTODIFF_MONITOR
# include "AUTODIFF_PARAMS.h"
# include "AUTODIFF.h"
# include "adcommon.h"
#endif

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

#if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_ADMTLM))
#ifdef ALLOW_AUTODIFF_MONITOR

C     !FUNCTIONS:
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE

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

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

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

c increment ad dump record number (used only if dumpAdByRec is true)
        dumpAdRecSi=dumpAdRecSi+1
c#ifdef ALLOW_DEBUG
c      IF ( debugMode ) print*,'dumpAdRecSi',dumpAdRecSi
c#endif

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

        IF (.NOT.dumpAdByRec) THEN

        CALL WRITE_REC_3D_RL(
     &       'ADJarea.'//suff, writeBinaryPrec,
     &       1,  adarea, 1, myIter, myThid )
        CALL WRITE_REC_3D_RL(
     &       'ADJheff.'//suff, writeBinaryPrec,
     &       1,  adheff, 1, myIter, myThid )
        CALL WRITE_REC_3D_RL(
     &       'ADJhsnow.'//suff, writeBinaryPrec,
     &       1,  adhsnow, 1, myIter, myThid )
# ifdef SEAICE_ALLOW_DYNAMICS
cph        IF ( SEAICEuseDynamics ) THEN
          CALL WRITE_REC_3D_RL(
     &       'ADJuice.'//suff, writeBinaryPrec,
     &       1,  aduice, 1, myIter, myThid )
          CALL WRITE_REC_3D_RL(
     &       'ADJvice.'//suff, writeBinaryPrec,
     &       1,  advice, 1, myIter, myThid )
cph        ENDIF
# endif

        ELSE

        CALL WRITE_REC_3D_RL(
     &       'ADJarea', writeBinaryPrec,
     &       1,  adarea, dumpAdRecSi, myIter, myThid )
        CALL WRITE_REC_3D_RL(
     &       'ADJheff', writeBinaryPrec,
     &       1,  adheff, dumpAdRecSi, myIter, myThid )
        CALL WRITE_REC_3D_RL(
     &       'ADJhsnow', writeBinaryPrec,
     &       1,  adhsnow, dumpAdRecSi, myIter, myThid )
# ifdef SEAICE_ALLOW_DYNAMICS
cph        IF ( SEAICEuseDynamics ) THEN
          CALL WRITE_REC_3D_RL(
     &       'ADJuice', writeBinaryPrec,
     &       1,  aduice, dumpAdRecSi, myIter, myThid )
          CALL WRITE_REC_3D_RL(
     &       'ADJvice', writeBinaryPrec,
     &       1,  advice, dumpAdRecSi, myIter, myThid )
cph        ENDIF
# endif
        ENDIF

#ifdef ALLOW_MNC
        IF (useMNC .AND. autodiff_mnc) THEN

          CALL MNC_CW_SET_UDIM('adseaice', -1, myThid)
          CALL MNC_CW_RL_W_S('D','adseaice',0,0,'T',myTime,myThid)
          CALL MNC_CW_SET_UDIM('adseaice', 0, myThid)
          CALL MNC_CW_I_W_S('I','adseaice',0,0,'iter',myIter,myThid)
          CALL MNC_CW_RL_W_S('D','adseaice',0,0,'model_time',myTime,
     &         myThid)
c
          CALL MNC_CW_RL_W('D','adseaice',0,0,'adarea',
     &         adarea, myThid)
          CALL MNC_CW_RL_W('D','adseaice',0,0,'adheff',
     &         adheff, myThid)
          CALL MNC_CW_RL_W('D','adseaice',0,0,'adhsnow',
     &         adhsnow, myThid)
# ifdef SEAICE_ALLOW_DYNAMICS
          IF (SEAICEuseDYNAMICS) THEN
            CALL MNC_CW_RL_W('D','adseaice',0,0,'aduice',
     &         aduice, myThid)
            CALL MNC_CW_RL_W('D','adseaice',0,0,'advice',
     &         advice, myThid)
          ENDIF
# endif

        ENDIF
#endif /* ALLOW_MNC */

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

      ENDIF

#endif /* ALLOW_AUTODIFF_MONITOR */
#endif /* ALLOW_ADJOINT_RUN */

      RETURN
      END
1	jmc	1.9	C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_ad_dump.F,v 1.8 2012/08/07 21:19:18 gforget Exp $
2	heimbach	1.1	C $Name: $
3
4	jmc	1.7	#include "SEAICE_OPTIONS.h"
5	heimbach	1.2	#include "AD_CONFIG.h"
6	heimbach	1.1
7			CBOP
8			C !ROUTINE: seaice_ad_dump
9			C !INTERFACE:
10	jmc	1.9	subroutine seaice_ad_dump( myTime, myIter, myThid )
11	heimbach	1.1
12			C !DESCRIPTION: \bv
13			C ==========================================================
14	jmc	1.9	C \| SUBROUTINE seaice_ad_dump
15	heimbach	1.1	C ==========================================================
16			C Extract adjoint variable from TAMC/TAF-generated
17			C adjoint common blocks, contained in adcommon.h
18			C and write fields to file;
19			C Make sure common blocks in adcommon.h are up-to-date
20			C w.r.t. current adjoint code.
21			C ==========================================================
22	jmc	1.9	C \| SUBROUTINE seaice_ad_dump
23	heimbach	1.1	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	#include "SEAICE_PARAMS.h"
34	heimbach	1.1	#ifdef ALLOW_MNC
35			#include "MNC_PARAMS.h"
36			#endif
37			#include "GRID.h"
38			#ifdef ALLOW_AUTODIFF_MONITOR
39	gforget	1.8	# include "AUTODIFF_PARAMS.h"
40			# include "AUTODIFF.h"
41	heimbach	1.1	# include "adcommon.h"
42			#endif
43
44			C !INPUT/OUTPUT PARAMETERS:
45			C == Routine arguments ==
46	jmc	1.9	C myTime :: time counter for this thread
47			C myIter :: iteration counter for this thread
48			C myThid :: Thread number for this instance of the routine.
49			_RL myTime
50			INTEGER myIter
51			INTEGER myThid
52	heimbach	1.1
53			#if (defined (ALLOW_ADJOINT_RUN) \|\| defined (ALLOW_ADMTLM))
54			#ifdef ALLOW_AUTODIFF_MONITOR
55
56	jmc	1.9	C !FUNCTIONS:
57			LOGICAL DIFFERENT_MULTIPLE
58			EXTERNAL DIFFERENT_MULTIPLE
59
60	heimbach	1.1	C !LOCAL VARIABLES:
61			c == local variables ==
62	jmc	1.9	C suff :: Hold suffix part of a filename
63			C msgBuf :: Error message buffer
64	heimbach	1.1	CHARACTER*(MAX_LEN_FNAM) suff
65	jmc	1.9	c CHARACTER*(MAX_LEN_MBUF) msgBuf
66	heimbach	1.1	CEOP
67
68	jmc	1.9	IF (
69			& DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
70			& ) THEN
71	heimbach	1.1
72	jmc	1.9	CALL TIMER_START('I/O (WRITE) [ADJOINT LOOP]', myThid )
73	heimbach	1.1
74	gforget	1.8	c increment ad dump record number (used only if dumpAdByRec is true)
75			dumpAdRecSi=dumpAdRecSi+1
76			c#ifdef ALLOW_DEBUG
77			c IF ( debugMode ) print*,'dumpAdRecSi',dumpAdRecSi
78			c#endif
79
80	heimbach	1.1	C-- Set suffix for this set of data files.
81			WRITE(suff,'(I10.10)') myIter
82	jmc	1.9	C ==>> Resetting run-time parameter writeBinaryPrec in the middle of a run
83			C ==>> is very very very nasty !!!
84			c writeBinaryPrec = writeStatePrec
85			C <<== If you really want to mess-up with this at your own risk,
86			C <<== uncomment the line above
87	heimbach	1.1
88	gforget	1.8	IF (.NOT.dumpAdByRec) THEN
89
90	jmc	1.6	CALL WRITE_REC_3D_RL(
91			& 'ADJarea.'//suff, writeBinaryPrec,
92	mlosch	1.5	& 1, adarea, 1, myIter, myThid )
93	jmc	1.6	CALL WRITE_REC_3D_RL(
94			& 'ADJheff.'//suff, writeBinaryPrec,
95	mlosch	1.5	& 1, adheff, 1, myIter, myThid )
96	jmc	1.6	CALL WRITE_REC_3D_RL(
97			& 'ADJhsnow.'//suff, writeBinaryPrec,
98	heimbach	1.1	& 1, adhsnow, 1, myIter, myThid )
99			# ifdef SEAICE_ALLOW_DYNAMICS
100	heimbach	1.3	cph IF ( SEAICEuseDynamics ) THEN
101	jmc	1.6	CALL WRITE_REC_3D_RL(
102			& 'ADJuice.'//suff, writeBinaryPrec,
103	mlosch	1.5	& 1, aduice, 1, myIter, myThid )
104	jmc	1.6	CALL WRITE_REC_3D_RL(
105			& 'ADJvice.'//suff, writeBinaryPrec,
106	mlosch	1.5	& 1, advice, 1, myIter, myThid )
107	heimbach	1.3	cph ENDIF
108	heimbach	1.1	# endif
109
110	gforget	1.8	ELSE
111
112			CALL WRITE_REC_3D_RL(
113			& 'ADJarea', writeBinaryPrec,
114			& 1, adarea, dumpAdRecSi, myIter, myThid )
115			CALL WRITE_REC_3D_RL(
116			& 'ADJheff', writeBinaryPrec,
117			& 1, adheff, dumpAdRecSi, myIter, myThid )
118			CALL WRITE_REC_3D_RL(
119			& 'ADJhsnow', writeBinaryPrec,
120			& 1, adhsnow, dumpAdRecSi, myIter, myThid )
121			# ifdef SEAICE_ALLOW_DYNAMICS
122			cph IF ( SEAICEuseDynamics ) THEN
123			CALL WRITE_REC_3D_RL(
124			& 'ADJuice', writeBinaryPrec,
125			& 1, aduice, dumpAdRecSi, myIter, myThid )
126			CALL WRITE_REC_3D_RL(
127			& 'ADJvice', writeBinaryPrec,
128			& 1, advice, dumpAdRecSi, myIter, myThid )
129			cph ENDIF
130			# endif
131			ENDIF
132
133	heimbach	1.1	#ifdef ALLOW_MNC
134			IF (useMNC .AND. autodiff_mnc) THEN
135
136			CALL MNC_CW_SET_UDIM('adseaice', -1, myThid)
137			CALL MNC_CW_RL_W_S('D','adseaice',0,0,'T',myTime,myThid)
138			CALL MNC_CW_SET_UDIM('adseaice', 0, myThid)
139			CALL MNC_CW_I_W_S('I','adseaice',0,0,'iter',myIter,myThid)
140			CALL MNC_CW_RL_W_S('D','adseaice',0,0,'model_time',myTime,
141			& myThid)
142			c
143			CALL MNC_CW_RL_W('D','adseaice',0,0,'adarea',
144			& adarea, myThid)
145			CALL MNC_CW_RL_W('D','adseaice',0,0,'adheff',
146			& adheff, myThid)
147			CALL MNC_CW_RL_W('D','adseaice',0,0,'adhsnow',
148			& adhsnow, myThid)
149			# ifdef SEAICE_ALLOW_DYNAMICS
150			IF (SEAICEuseDYNAMICS) THEN
151			CALL MNC_CW_RL_W('D','adseaice',0,0,'aduice',
152			& aduice, myThid)
153			CALL MNC_CW_RL_W('D','adseaice',0,0,'advice',
154			& advice, myThid)
155			ENDIF
156			# endif
157
158			ENDIF
159			#endif /* ALLOW_MNC */
160
161	jmc	1.9	CALL TIMER_STOP( 'I/O (WRITE) [ADJOINT LOOP]', myThid )
162
163	heimbach	1.1	ENDIF
164
165			#endif /* ALLOW_AUTODIFF_MONITOR */
166			#endif /* ALLOW_ADJOINT_RUN */
167
168	jmc	1.4	RETURN
169			END