/[MITgcm]/MITgcm/pkg/atm2d/atm2d_write_pickup.F
ViewVC logotype

Annotation of /MITgcm/pkg/atm2d/atm2d_write_pickup.F

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


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

  ViewVC Help
Powered by ViewVC 1.1.22