/[MITgcm]/MITgcm_contrib/jscott/pkg_atm2d/atm2d_write_pickup.F
ViewVC logotype

Annotation of /MITgcm_contrib/jscott/pkg_atm2d/atm2d_write_pickup.F

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


Revision 1.2 - (hide annotations) (download)
Tue Aug 22 20:21:38 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
Changes since 1.1: +2 -1 lines
new revision of atm2d package

1 jscott 1.1 #include "ctrparam.h"
2     #include "ATM2D_OPTIONS.h"
3     SUBROUTINE ATM2D_WRITE_PICKUP(
4     I modelEnd,
5     I myTime,
6     I myIter,
7     I myThid )
8    
9     C !DESCRIPTION:
10     C Write pickup files for atm2d package which needs it to restart.
11     C It writes both "rolling-checkpoint" files (ckptA,ckptB) and
12     C permanent checkpoint files.
13    
14     C !USES:
15     IMPLICIT NONE
16     #include "SIZE.h"
17     #include "EEPARAMS.h"
18     #include "PARAMS.h"
19    
20     LOGICAL DIFFERENT_MULTIPLE
21     EXTERNAL DIFFERENT_MULTIPLE
22     INTEGER IO_ERRCOUNT
23     EXTERNAL IO_ERRCOUNT
24    
25     C !INPUT/OUTPUT PARAMETERS:
26     C == Routine arguments ==
27     C modelEnd :: Checkpoint call at end of model run.
28     C myThid :: Thread number for this instance of the routine.
29     C myIter :: Iteration number
30     C myTime :: Current time of simulation ( s )
31     LOGICAL modelEnd
32     INTEGER myThid
33     INTEGER myIter
34     _RL myTime
35    
36     C !LOCAL VARIABLES:
37     C == Local variables ==
38     C permCheckPoint :: Flag indicating whether a permanent checkpoint will
39     C be written.
40     C tempCheckPoint :: Flag indicating if it is time to write a non-permanent
41     C checkpoint (that will be permanent if permCheckPoint=T)
42     C oldPrc :: Temp. for holding I/O precision
43     C fn :: Temp. for building file name string.
44     C lgf :: Flag to indicate whether to use global file mode.
45     LOGICAL permCheckPoint, tempCheckPoint
46     CEOP
47    
48     permCheckPoint = .FALSE.
49     tempCheckPoint = .FALSE.
50     permCheckPoint=
51     & DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
52     tempCheckPoint=
53     & DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
54    
55     #ifdef ALLOW_CAL
56     IF ( useCAL ) THEN
57     CALL CAL_TIME2DUMP( pChkPtFreq, deltaTClock,
58     U permCheckPoint,
59     I myTime, myIter, myThid )
60     CALL CAL_TIME2DUMP( chkPtFreq, deltaTClock,
61     U tempCheckPoint,
62     I myTime, myIter, myThid )
63     ENDIF
64     #endif /* ALLOW_CAL */
65    
66     IF (
67     & ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
68     & .OR.
69     & ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
70     & ) THEN
71    
72 jscott 1.2 #ifndef ATM2D_MPI_ON
73 jscott 1.1 IF (tempCheckPoint) !toggle was done prematurely...
74     & nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
75 jscott 1.2 #endif
76 jscott 1.1 CALL ATM2D_WRITE_PICKUP_NOW(
77     & permCheckPoint, myTime, myIter, myThid )
78    
79     IF (tempCheckPoint) !note this works for A/B chpt only
80     & nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
81    
82     ENDIF
83    
84     RETURN
85     END
86    
87    
88     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
89     #include "ctrparam.h"
90     #include "ATM2D_OPTIONS.h"
91     CBOP
92     C !ROUTINE: ATM2D_WRITE_PICKUP_NOW
93    
94     C !INTERFACE:
95     SUBROUTINE ATM2D_WRITE_PICKUP_NOW(
96     I permCheckPoint,
97     I myTime,
98     I myIter,
99     I myThid )
100    
101     C !DESCRIPTION:
102     C Write pickup files for atm2d package which needs it to restart and
103     C do it NOW.
104    
105     C !USES:
106     IMPLICIT NONE
107     #include "ATMSIZE.h"
108     #include "SIZE.h"
109     #include "EEPARAMS.h"
110     #include "PARAMS.h"
111     #include "THSICE_VARS.h"
112     #include "ATM2D_VARS.h"
113    
114    
115     C !INPUT/OUTPUT PARAMETERS:
116     C permCheckPoint :: Checkpoint is permanent
117     C myThid :: Thread number for this instance of the routine.
118     C myIter :: Iteration number
119     C myTime :: Current time of simulation ( s )
120     LOGICAL permCheckPoint
121     INTEGER myThid
122     INTEGER myIter
123     _RL myTime
124    
125     C == Common blocks ==
126     COMMON /PCKP_GBLFLS/ globalFile
127     LOGICAL globalFile
128    
129     C !LOCAL VARIABLES:
130     C == Local variables ==
131     C oldPrc :: Temp. for holding I/O precision
132     C fn :: Temp. for building file name string.
133     C lgf :: Flag to indicate whether to use global file mode.
134     CHARACTER*(MAX_LEN_FNAM) fn
135     INTEGER prec, i,j
136     LOGICAL lgf
137     CEOP
138    
139     C Going to really do some IO. Make everyone except master thread wait.
140     C _BARRIER
141     C _BEGIN_MASTER( myThid )
142    
143     prec = precFloat64
144     lgf = globalFile
145    
146     C Create suffix to pass on to package pickup routines
147     IF ( permCheckPoint ) THEN
148     WRITE(fn,'(A,I10.10)') 'pickup_atm2d.',myIter
149     ELSE
150     WRITE(fn,'(A,A)') 'pickup_atm2d.',checkPtSuff(nCheckLev)
151     ENDIF
152    
153     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_slp,
154     & 1,myIter,myThid)
155     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_qnet,
156     & 2,myIter,myThid)
157     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_solarnet,
158     & 3,myIter,myThid)
159     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_fu,
160     & 4,myIter,myThid)
161     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_fv,
162     & 5,myIter,myThid)
163     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_precip,
164     & 6,myIter,myThid)
165     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_evap,
166     & 7,myIter,myThid)
167     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_runoff,
168     & 8,myIter,myThid)
169     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_wspeed,
170     & 9,myIter,myThid)
171     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_pCO2,
172     & 10,myIter,myThid)
173     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_sIceLoad,
174     & 11,myIter,myThid)
175    
176     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,sHeating,
177     & 12,myIter,myThid)
178     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,flxCndBt,
179     & 13,myIter,myThid)
180     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,pass_prcAtm,
181     & 14,myIter,myThid)
182     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,snowPrc,
183     & 15,myIter,myThid)
184     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,icFrwAtm,
185     & 16,myIter,myThid)
186     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,icFlxSw,
187     & 17,myIter,myThid)
188     CALL MDSWRITEFIELD(fn,prec,lgf,'RL',1,siceAlb,
189     & 18,myIter,myThid)
190    
191     C _END_MASTER( myThid )
192     C _BARRIER
193    
194     RETURN
195     END
196    

  ViewVC Help
Powered by ViewVC 1.1.22