/[MITgcm]/MITgcm/pkg/exf/exf_adjoint_snapshots__g.F
ViewVC logotype

Annotation of /MITgcm/pkg/exf/exf_adjoint_snapshots__g.F

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


Revision 1.7 - (hide annotations) (download)
Fri Mar 24 23:34:13 2017 UTC (7 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, HEAD
Changes since 1.6: +8 -4 lines
use new S/R RW_GET_SUFFIX to get file suffix (according to "rwSuffixType")

1 jmc 1.7 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_adjoint_snapshots__g.F,v 1.6 2012/08/29 01:59:36 jmc Exp $
2 jmc 1.3 C $Name: $
3 heimbach 1.1
4 heimbach 1.2 #include "EXF_OPTIONS.h"
5 jmc 1.4 #include "AD_CONFIG.h"
6 heimbach 1.1
7     CBOP
8     C !ROUTINE: g_exf_adjoint_snapshots
9     C !INTERFACE:
10 jmc 1.7 SUBROUTINE g_exf_adjoint_snapshots(
11 jmc 1.6 & iwhen, myTime, myIter, myThid )
12 heimbach 1.1
13     C !DESCRIPTION: \bv
14     C *==========================================================*
15     C | SUBROUTINE g_exf_adjoint_snapshots |
16     C *==========================================================*
17     C Extract tangent linear variable from TAMC/TAF-generated
18     C tangent linear common blocks, contained in g_common.h
19     C and write fields to file;
20     C Make sure common blocks in g_common.h are up-to-date
21     C w.r.t. current adjoint code.
22     C *==========================================================*
23     C | SUBROUTINE g_exf_adjoint_snapshots |
24     C *==========================================================*
25     C \ev
26    
27     C !USES:
28     IMPLICIT NONE
29    
30     C == Global variables ===
31     #include "SIZE.h"
32     #include "EEPARAMS.h"
33     #include "PARAMS.h"
34 jmc 1.6 #include "EXF_PARAM.h"
35 heimbach 1.1 #ifdef ALLOW_AUTODIFF_MONITOR
36     # include "g_common.h"
37     #endif
38    
39     C !INPUT/OUTPUT PARAMETERS:
40     C == Routine arguments ==
41 jmc 1.6 C myIter :: iteration counter for this thread
42     C myTime :: time counter for this thread
43     C myThid :: Thread number for this instance of the routine.
44     INTEGER iwhen
45     _RL myTime
46     INTEGER myIter
47     INTEGER myThid
48 heimbach 1.1
49     #ifdef ALLOW_TANGENTLINEAR_RUN
50     #ifdef ALLOW_AUTODIFF_MONITOR
51    
52 jmc 1.6 C !FUNCTIONS:
53     LOGICAL DIFFERENT_MULTIPLE
54     EXTERNAL DIFFERENT_MULTIPLE
55    
56 heimbach 1.1 C !LOCAL VARIABLES:
57 jmc 1.6 C == local variables ==
58     C suff :: Hold suffix part of a filename
59     C msgBuf :: Error message buffer
60 jmc 1.7 CHARACTER*(10) suff
61 jmc 1.6 c CHARACTER*(MAX_LEN_MBUF) msgBuf
62 heimbach 1.1 CEOP
63    
64     IF (useEXF) THEN
65 jmc 1.6 IF (
66     & DIFFERENT_MULTIPLE(adjDumpFreq,myTime,deltaTClock)
67     & ) THEN
68 heimbach 1.1
69 jmc 1.6 CALL TIMER_START('I/O (WRITE) [TLM LOOP]', myThid )
70 heimbach 1.1
71     C-- Set suffix for this set of data files.
72 jmc 1.7 IF ( rwSuffixType.EQ.0 ) THEN
73     WRITE(suff,'(I10.10)') myIter
74     ELSE
75     CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
76     ENDIF
77 jmc 1.6 C ==>> Resetting run-time parameter writeBinaryPrec in the middle of a run
78     C ==>> is very very very nasty !!!
79     c writeBinaryPrec = writeStatePrec
80     C <<== If you really want to mess-up with this at your own risk,
81     C <<== uncomment the line above
82 heimbach 1.1
83     IF ( iwhen .EQ.1 ) THEN
84    
85     CALL WRITE_FLD_XY_RL ( 'G_Justress.',
86 jmc 1.6 & suff, g_ustress, myIter, myThid )
87 heimbach 1.1 CALL WRITE_FLD_XY_RL ( 'G_Jvstress.',
88 jmc 1.6 & suff, g_vstress, myIter, myThid )
89 heimbach 1.1 CALL WRITE_FLD_XY_RL ( 'G_Jhflux.',
90 jmc 1.6 & suff, g_hflux, myIter, myThid )
91 heimbach 1.1 CALL WRITE_FLD_XY_RL ( 'G_Jsflux.',
92 jmc 1.6 & suff, g_sflux, myIter, myThid )
93 heimbach 1.1
94     ELSEIF ( iwhen .EQ.2 ) THEN
95    
96     # ifdef ALLOW_ATM_TEMP
97     CALL WRITE_FLD_XY_RL ( 'G_Jatemp.',
98 jmc 1.6 & suff, g_atemp, myIter, myThid )
99 heimbach 1.1 CALL WRITE_FLD_XY_RL ( 'G_Jaqh.',
100 jmc 1.6 & suff, g_aqh, myIter, myThid )
101 heimbach 1.1 CALL WRITE_FLD_XY_RL ( 'G_Jprecip.',
102 jmc 1.6 & suff, g_precip, myIter, myThid )
103 heimbach 1.1 # endif
104 jmc 1.6 IF ( useAtmWind ) THEN
105     CALL WRITE_FLD_XY_RL ( 'G_Juwind.',
106     & suff, g_uwind, myIter, myThid )
107     CALL WRITE_FLD_XY_RL ( 'G_Jvwind.',
108     & suff, g_vwind, myIter, myThid )
109     ENDIF
110 heimbach 1.1 # ifdef ALLOW_DOWNWARD_RADIATION
111     CALL WRITE_FLD_XY_RL ( 'G_Jswdown.',
112 jmc 1.6 & suff, g_swdown, myIter, myThid )
113 heimbach 1.1 # endif
114     # ifdef ALLOW_CLIMSST_RELAXATION
115     CALL WRITE_FLD_XY_RL ( 'G_Jclimsst.',
116 jmc 1.6 & suff, g_climsst, myIter, myThid )
117 heimbach 1.1 # endif
118     # ifdef ALLOW_CLIMSSS_RELAXATION
119     CALL WRITE_FLD_XY_RL ( 'G_Jclimsss.',
120 jmc 1.6 & suff, g_climsss, myIter, myThid )
121 heimbach 1.1 # endif
122    
123     ENDIF
124    
125 jmc 1.6 CALL TIMER_STOP( 'I/O (WRITE) [TLM LOOP]', myThid )
126 heimbach 1.1
127 jmc 1.6 ENDIF
128 heimbach 1.1 ENDIF
129    
130     #endif /* ALLOW_AUTODIFF_MONITOR */
131     #endif /* ALLOW_TANGENTLINEAR_RUN */
132    
133 jmc 1.4 RETURN
134     END

  ViewVC Help
Powered by ViewVC 1.1.22