/[MITgcm]/MITgcm_contrib/torge/itd/code/seaice_ad_dump.F
ViewVC logotype

Annotation of /MITgcm_contrib/torge/itd/code/seaice_ad_dump.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (hide annotations) (download)
Wed Mar 27 18:59:52 2013 UTC (12 years, 4 months ago) by torge
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +1 -1 lines
updating my MITgcm_contrib directory to include latest changes on main branch;
settings are to run a 1D test szenario with ITD code and 7 categories

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

  ViewVC Help
Powered by ViewVC 1.1.22