/[MITgcm]/MITgcm_contrib/eh3/regrid/hs94.cs-32x32x5/code/write_state.F
ViewVC logotype

Contents of /MITgcm_contrib/eh3/regrid/hs94.cs-32x32x5/code/write_state.F

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


Revision 1.1 - (show annotations) (download)
Thu Aug 10 21:49:50 2006 UTC (18 years, 11 months ago) by edhill
Branch: MAIN
CVS Tags: HEAD
good: compiles, runs without segfaulting, appears to read inputs
        correctly, produces all the right output files at correct
        times and with correct sizes, etc...
bad:  output is clearly wrong -- something wrong with global sum
        or the multiply or both

1 C $Header: /u/gcmpack/MITgcm/model/src/write_state.F,v 1.59 2005/11/08 23:01:10 cnh 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 #ifdef ALLOW_NONHYDROSTATIC
55 #include "NH_VARS.h"
56 #endif
57 #ifdef ALLOW_MNC
58 #include "MNC_PARAMS.h"
59 #endif
60
61 LOGICAL DIFFERENT_MULTIPLE
62 EXTERNAL DIFFERENT_MULTIPLE
63 INTEGER IO_ERRCOUNT
64 EXTERNAL IO_ERRCOUNT
65
66 C !INPUT/OUTPUT PARAMETERS:
67 C myThid - Thread number for this instance of the routine.
68 C myIter - Iteration number
69 C myTime - Current time of simulation ( s )
70 _RL myTime
71 INTEGER myThid
72 INTEGER myIter
73
74 C !LOCAL VARIABLES:
75 CHARACTER*(MAX_LEN_MBUF) suff
76 INTEGER iRec
77 #ifdef ALLOW_MNC
78 CHARACTER*(1) pf
79 #endif
80 #ifdef ALLOW_REGRID
81 INTEGER izlev(Nr), ii
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 _BARRIER
98 C _BEGIN_MASTER( myThid )
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 ENDIF
142 #ifdef ALLOW_NONHYDROSTATIC
143 IF (nonHydroStatic) THEN
144 CALL WRITE_FLD_XYZ_RL( 'PNH.',suff,phi_nh,myIter,myThid)
145 ENDIF
146 #endif /* ALLOW_NONHYDROSTATIC */
147 #ifdef NONLIN_FRSURF
148 c CALL WRITE_FLD_XYZ_RS('hFacC.',suff,hFacC,myIter,myThid)
149 c CALL WRITE_FLD_XYZ_RS('hFacW.',suff,hFacW,myIter,myThid)
150 c CALL WRITE_FLD_XYZ_RS('hFacS.',suff,hFacS,myIter,myThid)
151 #endif /* NONLIN_FRSURF */
152
153 #endif /* MULTIPLE_RECORD_STATE_FILES */
154
155 ENDIF
156
157 C _END_MASTER( myThid )
158 _BARRIER
159
160 #ifdef ALLOW_MNC
161 IF (useMNC .AND. snapshot_mnc) THEN
162
163 IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
164 pf(1:1) = 'D'
165 ELSE
166 pf(1:1) = 'R'
167 ENDIF
168
169 C Write dynvars using the MNC package
170 CALL MNC_CW_SET_UDIM('state', -1, myThid)
171 CALL MNC_CW_RL_W_S('D','state',0,0,'T', myTime, myThid)
172 CALL MNC_CW_SET_UDIM('state', 0, myThid)
173 CALL MNC_CW_I_W_S('I','state',0,0,'iter', myIter, myThid)
174 C CALL MNC_CW_RL_W_S('D','state',0,0,'model_time',myTime,myThid)
175 CALL MNC_CW_RL_W(pf,'state',0,0,'U', uVel, myThid)
176 CALL MNC_CW_RL_W(pf,'state',0,0,'V', vVel, myThid)
177 CALL MNC_CW_RL_W(pf,'state',0,0,'Temp', theta, myThid)
178 CALL MNC_CW_RL_W(pf,'state',0,0,'S', salt, myThid)
179 CALL MNC_CW_RL_W(pf,'state',0,0,'Eta', etaN, myThid)
180 CALL MNC_CW_RL_W(pf,'state',0,0,'W', wVel, myThid)
181 IF ( useDynP_inEos_Zc .OR. myIter.NE.nIter0 ) THEN
182 CALL MNC_CW_SET_UDIM('phiHyd', -1, myThid)
183 CALL MNC_CW_RL_W_S('D','phiHyd',0,0,'T',myTime,myThid)
184 CALL MNC_CW_SET_UDIM('phiHyd', 0, myThid)
185 CALL MNC_CW_I_W_S('I','phiHyd',0,0,'iter',myIter,myThid)
186 CALL MNC_CW_RL_W(pf,'phiHyd',0,0,'phiHyd',
187 & totPhiHyd, myThid)
188 ENDIF
189 IF ( fluidIsWater .AND. (myIter .NE. nIter0) ) THEN
190 CALL MNC_CW_SET_UDIM('phiHydLow', -1, myThid)
191 CALL MNC_CW_RL_W_S('D','phiHydLow',0,0,'T', myTime, myThid)
192 CALL MNC_CW_SET_UDIM('phiHydLow', 0, myThid)
193 CALL MNC_CW_I_W_S('I','phiHydLow',0,0,'iter',myIter,myThid)
194 CALL MNC_CW_RL_W(pf,'phiHydLow',0,0,'phiHydLow',
195 & phiHydLow, myThid)
196 ENDIF
197 #ifdef ALLOW_NONHYDROSTATIC
198 IF (nonHydroStatic) THEN
199 CALL MNC_CW_RL_W(pf,'state',0,0,'phi_nh',phi_nh,myThid)
200 ENDIF
201 #endif /* ALLOW_NONHYDROSTATIC */
202 ENDIF
203
204 #ifdef ALLOW_REGRID
205 DO ii = 1,Nr
206 izlev(ii) = ii
207 ENDDO
208 _BEGIN_MASTER( myThid )
209 #ifdef ALLOW_USE_MPI
210 IF ( mpiMyId .EQ. 0 ) THEN
211 #endif /* ALLOW_USE_MPI */
212 CALL MNC_CW_SET_UDIM('regrid_1', -1, myThid)
213 CALL MNC_CW_RL_W_S('D','regrid_1',1,1,'T', myTime, myThid)
214 CALL MNC_CW_SET_UDIM('regrid_1', 0, myThid)
215 CALL MNC_CW_I_W_S('I','regrid_1',1,1,'iter',myIter,myThid)
216 CALL REGRID_SCALAR_RL_OUT('regrid_1',1,theta,'Temp',Nr,
217 & izlev, myThid )
218 #ifdef ALLOW_USE_MPI
219 ENDIF
220 #endif /* ALLOW_USE_MPI */
221 _END_MASTER( myThid )
222 #endif /* ALLOW_REGRID */
223
224 #endif /* ALLOW_MNC */
225
226 ENDIF
227
228 RETURN
229 END

  ViewVC Help
Powered by ViewVC 1.1.22