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

Annotation 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.1 - (hide annotations) (download)
Tue Oct 9 21:06:32 2007 UTC (18 years, 10 months ago) by jmc
Branch: MAIN
add S/R to compute FG forcing ; write Qnet to file (@ dumpFreq)

1 jmc 1.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: checkpoint58q_post $
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     #include "FFIELDS.h"
55     #ifdef ALLOW_NONHYDROSTATIC
56     #include "NH_VARS.h"
57     #endif
58     #ifdef ALLOW_MNC
59     #include "MNC_PARAMS.h"
60     #endif
61    
62     LOGICAL DIFFERENT_MULTIPLE
63     EXTERNAL DIFFERENT_MULTIPLE
64     INTEGER IO_ERRCOUNT
65     EXTERNAL IO_ERRCOUNT
66    
67     C !INPUT/OUTPUT PARAMETERS:
68     C myThid - Thread number for this instance of the routine.
69     C myIter - Iteration number
70     C myTime - Current time of simulation ( s )
71     _RL myTime
72     INTEGER myThid
73     INTEGER myIter
74    
75     C !LOCAL VARIABLES:
76     CHARACTER*(MAX_LEN_MBUF) suff
77     INTEGER iRec
78     #ifdef ALLOW_MNC
79     CHARACTER*(1) pf
80     #endif
81     CEOP
82    
83     IF (
84     & DIFFERENT_MULTIPLE(dumpFreq,myTime,deltaTClock)
85     & .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
86     & myTime.EQ.startTime )
87     & ) THEN
88     IF ( dumpFreq .EQ. 0.0 ) THEN
89     iRec = 1
90     ELSE
91     iRec = int ( (myTime-startTime) / dumpFreq +1.5 )
92     ENDIF
93    
94     C Going to really do some IO. Make everyone except master thread wait.
95     _BARRIER
96     C _BEGIN_MASTER( myThid )
97    
98     C Write model fields
99     IF (snapshot_mdsio) THEN
100    
101     #ifdef MULTIPLE_RECORD_STATE_FILES
102    
103     C Write each snap-shot as a new record in one file per variable
104     C - creates relatively few files but these files can become huge
105     CALL WRITE_REC_XYZ_RL( 'U', uVel,iRec,myIter,myThid)
106     CALL WRITE_REC_XYZ_RL( 'V', vVel,iRec,myIter,myThid)
107     CALL WRITE_REC_XYZ_RL( 'T', theta,iRec,myIter,myThid)
108     CALL WRITE_REC_XYZ_RL( 'S', salt,iRec,myIter,myThid)
109     CALL WRITE_REC_XY_RL('Eta',etaN,iRec,myIter,myThid)
110     CALL WRITE_REC_XYZ_RL( 'W',wVel,iRec,myIter,myThid)
111     #ifdef ALLOW_NONHYDROSTATIC
112     IF (nonHydroStatic) THEN
113     CALL WRITE_REC_XYZ_RL( 'PNH',phi_nh,iRec,myIter,myThid)
114     ENDIF
115     #endif /* ALLOW_NONHYDROSTATIC */
116     #ifdef NONLIN_FRSURF
117     c CALL WRITE_REC_XYZ_RS('hFacC.',hFacC,iRec,myIter,myThid)
118     c CALL WRITE_REC_XYZ_RS('hFacW.',hFacW,iRec,myIter,myThid)
119     c CALL WRITE_REC_XYZ_RS('hFacS.',hFacS,iRec,myIter,myThid)
120     #endif /* NONLIN_FRSURF */
121    
122     #else /* MULTIPLE_RECORD_STATE_FILES */
123    
124     C Write each snap-shot as a new file (original and default
125     C method) -- creates many files but for large configurations is
126     C easier to transfer analyse a particular snap-shots
127     WRITE(suff,'(I10.10)') myIter
128     CALL WRITE_FLD_XYZ_RL( 'U.',suff,uVel,myIter,myThid)
129     CALL WRITE_FLD_XYZ_RL( 'V.',suff,vVel,myIter,myThid)
130     CALL WRITE_FLD_XYZ_RL( 'T.',suff,theta,myIter,myThid)
131     CALL WRITE_FLD_XYZ_RL( 'S.',suff,salt,myIter,myThid)
132     CALL WRITE_FLD_XY_RL('Eta.',suff,etaN,myIter,myThid)
133     CALL WRITE_FLD_XYZ_RL( 'W.',suff,wVel,myIter,myThid)
134     IF ( useDynP_inEos_Zc .OR. myIter.NE.nIter0 ) THEN
135     CALL WRITE_FLD_XYZ_RL('PH.',suff,totPhiHyd,myIter,myThid)
136     ENDIF
137     IF ( fluidIsWater .AND. (myIter.NE.nIter0) ) THEN
138     CALL WRITE_FLD_XY_RL('PHL.',suff,phiHydLow,myIter,myThid)
139     CALL WRITE_FLD_XY_RL('Qnet.',suff,Qnet,myIter,myThid)
140     ENDIF
141     #ifdef ALLOW_NONHYDROSTATIC
142     IF (nonHydroStatic) THEN
143     CALL WRITE_FLD_XYZ_RL( 'PNH.',suff,phi_nh,myIter,myThid)
144     ENDIF
145     #endif /* ALLOW_NONHYDROSTATIC */
146     #ifdef NONLIN_FRSURF
147     c CALL WRITE_FLD_XYZ_RS('hFacC.',suff,hFacC,myIter,myThid)
148     c CALL WRITE_FLD_XYZ_RS('hFacW.',suff,hFacW,myIter,myThid)
149     c CALL WRITE_FLD_XYZ_RS('hFacS.',suff,hFacS,myIter,myThid)
150     #endif /* NONLIN_FRSURF */
151    
152     #endif /* MULTIPLE_RECORD_STATE_FILES */
153    
154     ENDIF
155    
156     C _END_MASTER( myThid )
157     _BARRIER
158    
159     #ifdef ALLOW_MNC
160     IF (useMNC .AND. snapshot_mnc) THEN
161    
162     IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
163     pf(1:1) = 'D'
164     ELSE
165     pf(1:1) = 'R'
166     ENDIF
167    
168     C Write dynvars using the MNC package
169     CALL MNC_CW_SET_UDIM('state', -1, myThid)
170     CALL MNC_CW_RL_W_S('D','state',0,0,'T', myTime, myThid)
171     CALL MNC_CW_SET_UDIM('state', 0, myThid)
172     CALL MNC_CW_I_W_S('I','state',0,0,'iter', myIter, myThid)
173     C CALL MNC_CW_RL_W_S('D','state',0,0,'model_time',myTime,myThid)
174     CALL MNC_CW_RL_W(pf,'state',0,0,'U', uVel, myThid)
175     CALL MNC_CW_RL_W(pf,'state',0,0,'V', vVel, myThid)
176     CALL MNC_CW_RL_W(pf,'state',0,0,'Temp', theta, myThid)
177     CALL MNC_CW_RL_W(pf,'state',0,0,'S', salt, myThid)
178     CALL MNC_CW_RL_W(pf,'state',0,0,'Eta', etaN, myThid)
179     CALL MNC_CW_RL_W(pf,'state',0,0,'W', wVel, myThid)
180     IF ( useDynP_inEos_Zc .OR. myIter.NE.nIter0 ) THEN
181     CALL MNC_CW_SET_UDIM('phiHyd', -1, myThid)
182     CALL MNC_CW_RL_W_S('D','phiHyd',0,0,'T',myTime,myThid)
183     CALL MNC_CW_SET_UDIM('phiHyd', 0, myThid)
184     CALL MNC_CW_I_W_S('I','phiHyd',0,0,'iter',myIter,myThid)
185     CALL MNC_CW_RL_W(pf,'phiHyd',0,0,'phiHyd',
186     & totPhiHyd, myThid)
187     ENDIF
188     IF ( fluidIsWater .AND. (myIter .NE. nIter0) ) THEN
189     CALL MNC_CW_SET_UDIM('phiHydLow', -1, myThid)
190     CALL MNC_CW_RL_W_S('D','phiHydLow',0,0,'T', myTime, myThid)
191     CALL MNC_CW_SET_UDIM('phiHydLow', 0, myThid)
192     CALL MNC_CW_I_W_S('I','phiHydLow',0,0,'iter',myIter,myThid)
193     CALL MNC_CW_RL_W(pf,'phiHydLow',0,0,'phiHydLow',
194     & phiHydLow, myThid)
195     ENDIF
196     #ifdef ALLOW_NONHYDROSTATIC
197     IF (nonHydroStatic) THEN
198     CALL MNC_CW_RL_W(pf,'state',0,0,'phi_nh',phi_nh,myThid)
199     ENDIF
200     #endif /* ALLOW_NONHYDROSTATIC */
201     ENDIF
202     #endif /* ALLOW_MNC */
203    
204     ENDIF
205    
206     RETURN
207     END

  ViewVC Help
Powered by ViewVC 1.1.22