/[MITgcm]/MITgcm_contrib/PRM/multi_comp_setup/fg/code/write_state.F
ViewVC logotype

Contents of /MITgcm_contrib/PRM/multi_comp_setup/fg/code/write_state.F

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


Revision 1.2 - (show annotations) (download)
Fri Apr 27 18:14:33 2012 UTC (14 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63m, checkpoint63n, HEAD
Changes since 1.1: +22 -18 lines
update local version (sync with checkpoint63m)

1 C $Header: /u/gcmpack/MITgcm/model/src/write_state.F,v 1.61 2010/01/23 00:04:03 jmc Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 #undef MULTIPLE_RECORD_STATE_FILES
8
9 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
10 CBOP
11 C !ROUTINE: WRITE_STATE
12
13 C !INTERFACE:
14 SUBROUTINE WRITE_STATE ( myTime, myIter, myThid )
15
16 C !DESCRIPTION:
17 C This is the controlling routine for writing mid-level IO. It
18 C includes code for diagnosing W and RHO for output.
19
20 C The CPP flag (MULTIPLE_RECORD_STATE_FILES) is #define/#undefed
21 C here since it is specific to this routine and very user-preference
22 C specific. If #undefed (default) the state files are written as in
23 C all versions prior to checkpoint32, where a file is created per
24 C variable, per time and per tile. This *has* to be the default
25 C because most users use this mode and all utilities and scripts
26 C (diagnostic) assume this form. It is also robust, as explained
27 C below.
28 C
29 C If #defined, subsequent snap-shots are written as records in the
30 C same file (no iteration number in filenames). The main advantage
31 C is fewer files. The disadvantages are that:
32 C (1) it breaks a lot of diagnostic scripts,
33 C (2) for large or long problems this creates huge files,
34 C (3) its an unexpected, unsolicited change in behaviour which
35 C came as a surprise (in c32) and is an inconvenience to
36 C several users
37 C (4) it can not accomodate changing the frequency of output
38 C after a pickup (this is trivial in previous method but
39 C needs new code and parameters in this new method)
40 C
41 C Known Bugs include:
42 C (1) if the length of integration is not exactly an integer
43 C times the output frequency then the last record written
44 C (at end of integration) overwrites a previously written
45 C record corresponding to an earier time. *BE WARNED*
46
47 C !USES:
48 IMPLICIT NONE
49 #include "SIZE.h"
50 #include "EEPARAMS.h"
51 #include "PARAMS.h"
52 #include "GRID.h"
53 #include "DYNVARS.h"
54 C-- PRM modif: start
55 #include "FFIELDS.h"
56 C-- PRM modif: end
57 #ifdef ALLOW_NONHYDROSTATIC
58 #include "NH_VARS.h"
59 #endif
60 #ifdef ALLOW_MNC
61 #include "MNC_PARAMS.h"
62 #endif
63
64 LOGICAL DIFFERENT_MULTIPLE
65 EXTERNAL DIFFERENT_MULTIPLE
66 INTEGER IO_ERRCOUNT
67 EXTERNAL IO_ERRCOUNT
68
69 C !INPUT/OUTPUT PARAMETERS:
70 C myThid - Thread number for this instance of the routine.
71 C myIter - Iteration number
72 C myTime - Current time of simulation ( s )
73 _RL myTime
74 INTEGER myThid
75 INTEGER myIter
76
77 C !LOCAL VARIABLES:
78 CHARACTER*(MAX_LEN_MBUF) suff
79 INTEGER iRec
80 #ifdef ALLOW_MNC
81 CHARACTER*(1) pf
82 #endif
83 CEOP
84
85 IF (
86 & DIFFERENT_MULTIPLE(dumpFreq,myTime,deltaTClock)
87 & .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
88 & myTime.EQ.startTime )
89 & ) THEN
90 IF ( dumpFreq .EQ. 0.0 ) THEN
91 iRec = 1
92 ELSE
93 iRec = int ( (myTime-startTime) / dumpFreq +1.5 )
94 ENDIF
95
96 C Going to really do some IO. Make everyone except master thread wait.
97 C this is done within IO routines => no longer needed
98 c _BARRIER
99
100 C Write model fields
101 IF (snapshot_mdsio) THEN
102
103 #ifdef MULTIPLE_RECORD_STATE_FILES
104
105 C Write each snap-shot as a new record in one file per variable
106 C - creates relatively few files but these files can become huge
107 CALL WRITE_REC_XYZ_RL( 'U', uVel,iRec,myIter,myThid)
108 CALL WRITE_REC_XYZ_RL( 'V', vVel,iRec,myIter,myThid)
109 CALL WRITE_REC_XYZ_RL( 'T', theta,iRec,myIter,myThid)
110 CALL WRITE_REC_XYZ_RL( 'S', salt,iRec,myIter,myThid)
111 CALL WRITE_REC_XY_RL('Eta',etaN,iRec,myIter,myThid)
112 CALL WRITE_REC_XYZ_RL( 'W',wVel,iRec,myIter,myThid)
113 #ifdef ALLOW_NONHYDROSTATIC
114 IF (nonHydroStatic) THEN
115 CALL WRITE_REC_XYZ_RL( 'PNH',phi_nh,iRec,myIter,myThid)
116 ENDIF
117 #endif /* ALLOW_NONHYDROSTATIC */
118 #ifdef NONLIN_FRSURF
119 c CALL WRITE_REC_XYZ_RS('hFacC.',hFacC,iRec,myIter,myThid)
120 c CALL WRITE_REC_XYZ_RS('hFacW.',hFacW,iRec,myIter,myThid)
121 c CALL WRITE_REC_XYZ_RS('hFacS.',hFacS,iRec,myIter,myThid)
122 #endif /* NONLIN_FRSURF */
123
124 #else /* MULTIPLE_RECORD_STATE_FILES */
125
126 C Write each snap-shot as a new file (original and default
127 C method) -- creates many files but for large configurations is
128 C easier to transfer analyse a particular snap-shots
129 WRITE(suff,'(I10.10)') myIter
130 CALL WRITE_FLD_XYZ_RL( 'U.',suff,uVel,myIter,myThid)
131 CALL WRITE_FLD_XYZ_RL( 'V.',suff,vVel,myIter,myThid)
132 CALL WRITE_FLD_XYZ_RL( 'T.',suff,theta,myIter,myThid)
133 CALL WRITE_FLD_XYZ_RL( 'S.',suff,salt,myIter,myThid)
134 CALL WRITE_FLD_XY_RL('Eta.',suff,etaN,myIter,myThid)
135 CALL WRITE_FLD_XYZ_RL( 'W.',suff,wVel,myIter,myThid)
136 IF ( useDynP_inEos_Zc .OR. myIter.NE.nIter0 ) THEN
137 CALL WRITE_FLD_XYZ_RL('PH.',suff,totPhiHyd,myIter,myThid)
138 ENDIF
139 IF ( fluidIsWater .AND. (myIter.NE.nIter0) ) THEN
140 CALL WRITE_FLD_XY_RL('PHL.',suff,phiHydLow,myIter,myThid)
141 C-- PRM modif: start
142 CALL WRITE_FLD_XY_RL('Qnet.',suff,Qnet,myIter,myThid)
143 C-- PRM modif: end
144 ENDIF
145 #ifdef ALLOW_NONHYDROSTATIC
146 IF (nonHydroStatic) THEN
147 CALL WRITE_FLD_XYZ_RL( 'PNH.',suff,phi_nh,myIter,myThid )
148 ENDIF
149 IF ( selectNHfreeSurf.GE.1 ) THEN
150 CALL WRITE_FLD_XY_RL( 'dPnh.',suff,dPhiNH,myIter,myThid )
151 ENDIF
152 #endif /* ALLOW_NONHYDROSTATIC */
153 #ifdef NONLIN_FRSURF
154 c CALL WRITE_FLD_XYZ_RS('hFacC.',suff,hFacC,myIter,myThid)
155 c CALL WRITE_FLD_XYZ_RS('hFacW.',suff,hFacW,myIter,myThid)
156 c CALL WRITE_FLD_XYZ_RS('hFacS.',suff,hFacS,myIter,myThid)
157 #endif /* NONLIN_FRSURF */
158
159 #endif /* MULTIPLE_RECORD_STATE_FILES */
160
161 ENDIF
162
163 #ifdef ALLOW_MNC
164 IF (useMNC .AND. snapshot_mnc) THEN
165
166 IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
167 pf(1:1) = 'D'
168 ELSE
169 pf(1:1) = 'R'
170 ENDIF
171
172 C Write dynvars using the MNC package
173 CALL MNC_CW_SET_UDIM('state', -1, myThid)
174 CALL MNC_CW_RL_W_S('D','state',0,0,'T', myTime, myThid)
175 CALL MNC_CW_SET_UDIM('state', 0, myThid)
176 CALL MNC_CW_I_W_S('I','state',0,0,'iter', myIter, myThid)
177 C CALL MNC_CW_RL_W_S('D','state',0,0,'model_time',myTime,myThid)
178 CALL MNC_CW_RL_W(pf,'state',0,0,'U', uVel, myThid)
179 CALL MNC_CW_RL_W(pf,'state',0,0,'V', vVel, myThid)
180 CALL MNC_CW_RL_W(pf,'state',0,0,'Temp', theta, myThid)
181 CALL MNC_CW_RL_W(pf,'state',0,0,'S', salt, myThid)
182 CALL MNC_CW_RL_W(pf,'state',0,0,'Eta', etaN, myThid)
183 CALL MNC_CW_RL_W(pf,'state',0,0,'W', wVel, myThid)
184 IF ( useDynP_inEos_Zc .OR. myIter.NE.nIter0 ) THEN
185 CALL MNC_CW_SET_UDIM('phiHyd', -1, myThid)
186 CALL MNC_CW_RL_W_S('D','phiHyd',0,0,'T',myTime,myThid)
187 CALL MNC_CW_SET_UDIM('phiHyd', 0, myThid)
188 CALL MNC_CW_I_W_S('I','phiHyd',0,0,'iter',myIter,myThid)
189 CALL MNC_CW_RL_W(pf,'phiHyd',0,0,'phiHyd',
190 & totPhiHyd, myThid)
191 ENDIF
192 IF ( fluidIsWater .AND. (myIter .NE. nIter0) ) THEN
193 CALL MNC_CW_SET_UDIM('phiHydLow', -1, myThid)
194 CALL MNC_CW_RL_W_S('D','phiHydLow',0,0,'T', myTime, myThid)
195 CALL MNC_CW_SET_UDIM('phiHydLow', 0, myThid)
196 CALL MNC_CW_I_W_S('I','phiHydLow',0,0,'iter',myIter,myThid)
197 CALL MNC_CW_RL_W(pf,'phiHydLow',0,0,'phiHydLow',
198 & phiHydLow, myThid)
199 ENDIF
200 #ifdef ALLOW_NONHYDROSTATIC
201 IF (nonHydroStatic) THEN
202 CALL MNC_CW_RL_W(pf,'state',0,0,'phi_nh',phi_nh,myThid)
203 ENDIF
204 #endif /* ALLOW_NONHYDROSTATIC */
205 ENDIF
206 #endif /* ALLOW_MNC */
207
208 ENDIF
209
210 RETURN
211 END

  ViewVC Help
Powered by ViewVC 1.1.22