model/src/do_write_pickup.F

C $Header: /u/gcmpack/MITgcm/model/src/do_write_pickup.F,v 1.9 2013/08/20 20:22:35 jmc Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: DO_WRITE_PICKUP
C     !INTERFACE:
      SUBROUTINE DO_WRITE_PICKUP(
     I                    modelEnd,
     I                    myTime, myIter, myThid )

C     !DESCRIPTION:
C     This is the controlling routine that decides when to write restart
C      (or "pickup" or "checkpoint" ) files. Then it calls 2 subroutines
C     to write the main-model pickup and each package pickup files.
C
C     Both ``rolling-pickup'' files and permanent pickup files
C     are written from here. A rolling pickup works through a circular
C     list of suffices. Generally the circular list has two entries so
C     that a rolling pickup will overwrite the last rolling
C     pickup but one. This is useful for running long jobs without
C     filling too much disk space.  In a permanent pickup, data is
C     written suffixed by the current timestep number. Permanent
C     pickups can be used to provide snap-shots from which the
C     model can be restarted.

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "RESTART.h"
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE

C     !INPUT PARAMETERS:
C     modelEnd  :: true if call at end of model run.
C     myTime    :: Current time of simulation ( s )
C     myIter    :: Iteration number
C     myThid    :: Thread number for this instance of the routine.
      LOGICAL modelEnd
      INTEGER myThid
      INTEGER myIter
      _RL     myTime
CEOP

C     !LOCAL VARIABLES:
C     permPickup :: Flag indicating whether a permanent pickup will
C                       be written.
C     tempPickup :: Flag indicating if it is time to write a non-permanent
C                       pickup (that will be permanent if permPickup=T)
C     suffix     :: pickup-name suffix
C     msgBuf     :: message buffer
      LOGICAL permPickup, tempPickup
      CHARACTER*(10) suffix
      CHARACTER*(MAX_LEN_MBUF) msgBuf

      permPickup = .FALSE.
      tempPickup = .FALSE.
      permPickup =
     &     DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
      tempPickup =
     &     DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)

#ifdef ALLOW_CAL
      IF ( useCAL ) THEN
         CALL CAL_TIME2DUMP( zeroRL, pChkPtFreq, deltaTClock,
     U                       permPickup,
     I                       myTime, myIter, myThid )
         CALL CAL_TIME2DUMP( zeroRL, chkPtFreq,  deltaTClock,
     U                       tempPickup,
     I                       myTime, myIter, myThid )
      ENDIF
#endif

      IF ( (modelEnd.AND.writePickupAtEnd)
     &     .OR. permPickup .OR. tempPickup ) THEN
C--   This is time to write pickup files

C-    Create suffix to pass on to main & package pickup routines
        IF ( permPickup .AND. rwSuffixType.EQ.0 ) THEN
          WRITE(suffix,'(I10.10)') myIter
        ELSEIF ( permPickup ) THEN
          CALL RW_GET_SUFFIX( suffix, myTime, myIter, myThid )
        ELSE
          WRITE(suffix,'(A)') checkPtSuff(nCheckLev)
        ENDIF

C-    Write a pickup for each package which need it to restart
        CALL PACKAGES_WRITE_PICKUP(
     I                permPickup, suffix, myTime, myIter, myThid )

C-    Write main model pickup
        IF ( .NOT.useOffLine .OR. nonlinFreeSurf.GT.0 ) THEN
           CALL WRITE_PICKUP(
     I                permPickup, suffix, myTime, myIter, myThid )
        ENDIF

        _BEGIN_MASTER(myThid)
C-    Write information to stdout so there is a record that
C     writing the pickup was completed
        WRITE(msgBuf,'(A11,I10,1X,A10)')
     &     "%CHECKPOINT ", myIter, suffix
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT, myThid )

C-    Update pickup level for the next time we write pickup
        IF ( .NOT. permPickup ) THEN
          nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
        ENDIF
        _END_MASTER(myThid)

      ELSEIF ( modelEnd ) THEN
        WRITE(msgBuf,'(A)')
     &     "Did not write pickup because writePickupAtEnd = FALSE"
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT, myThid )

C--   time to write pickup files: end
      ENDIF

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/model/src/do_write_pickup.F,v 1.9 2013/08/20 20:22:35 jmc Exp $
2	C $Name: $
3
4	#include "PACKAGES_CONFIG.h"
5	#include "CPP_OPTIONS.h"
6
7	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
8	CBOP
9	C !ROUTINE: DO_WRITE_PICKUP
10	C !INTERFACE:
11	SUBROUTINE DO_WRITE_PICKUP(
12	I modelEnd,
13	I myTime, myIter, myThid )
14
15	C !DESCRIPTION:
16	C This is the controlling routine that decides when to write restart
17	C (or "pickup" or "checkpoint" ) files. Then it calls 2 subroutines
18	C to write the main-model pickup and each package pickup files.
19	C
20	C Both ``rolling-pickup'' files and permanent pickup files
21	C are written from here. A rolling pickup works through a circular
22	C list of suffices. Generally the circular list has two entries so
23	C that a rolling pickup will overwrite the last rolling
24	C pickup but one. This is useful for running long jobs without
25	C filling too much disk space. In a permanent pickup, data is
26	C written suffixed by the current timestep number. Permanent
27	C pickups can be used to provide snap-shots from which the
28	C model can be restarted.
29
30	C !USES:
31	IMPLICIT NONE
32	#include "SIZE.h"
33	#include "EEPARAMS.h"
34	#include "PARAMS.h"
35	#include "RESTART.h"
36	LOGICAL DIFFERENT_MULTIPLE
37	EXTERNAL DIFFERENT_MULTIPLE
38
39	C !INPUT PARAMETERS:
40	C modelEnd :: true if call at end of model run.
41	C myTime :: Current time of simulation ( s )
42	C myIter :: Iteration number
43	C myThid :: Thread number for this instance of the routine.
44	LOGICAL modelEnd
45	INTEGER myThid
46	INTEGER myIter
47	_RL myTime
48	CEOP
49
50	C !LOCAL VARIABLES:
51	C permPickup :: Flag indicating whether a permanent pickup will
52	C be written.
53	C tempPickup :: Flag indicating if it is time to write a non-permanent
54	C pickup (that will be permanent if permPickup=T)
55	C suffix :: pickup-name suffix
56	C msgBuf :: message buffer
57	LOGICAL permPickup, tempPickup
58	CHARACTER*(10) suffix
59	CHARACTER*(MAX_LEN_MBUF) msgBuf
60
61	permPickup = .FALSE.
62	tempPickup = .FALSE.
63	permPickup =
64	& DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
65	tempPickup =
66	& DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)
67
68	#ifdef ALLOW_CAL
69	IF ( useCAL ) THEN
70	CALL CAL_TIME2DUMP( zeroRL, pChkPtFreq, deltaTClock,
71	U permPickup,
72	I myTime, myIter, myThid )
73	CALL CAL_TIME2DUMP( zeroRL, chkPtFreq, deltaTClock,
74	U tempPickup,
75	I myTime, myIter, myThid )
76	ENDIF
77	#endif
78
79	IF ( (modelEnd.AND.writePickupAtEnd)
80	& .OR. permPickup .OR. tempPickup ) THEN
81	C-- This is time to write pickup files
82
83	C- Create suffix to pass on to main & package pickup routines
84	IF ( permPickup .AND. rwSuffixType.EQ.0 ) THEN
85	WRITE(suffix,'(I10.10)') myIter
86	ELSEIF ( permPickup ) THEN
87	CALL RW_GET_SUFFIX( suffix, myTime, myIter, myThid )
88	ELSE
89	WRITE(suffix,'(A)') checkPtSuff(nCheckLev)
90	ENDIF
91
92	C- Write a pickup for each package which need it to restart
93	CALL PACKAGES_WRITE_PICKUP(
94	I permPickup, suffix, myTime, myIter, myThid )
95
96	C- Write main model pickup
97	IF ( .NOT.useOffLine .OR. nonlinFreeSurf.GT.0 ) THEN
98	CALL WRITE_PICKUP(
99	I permPickup, suffix, myTime, myIter, myThid )
100	ENDIF
101
102	_BEGIN_MASTER(myThid)
103	C- Write information to stdout so there is a record that
104	C writing the pickup was completed
105	WRITE(msgBuf,'(A11,I10,1X,A10)')
106	& "%CHECKPOINT ", myIter, suffix
107	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
108	& SQUEEZE_RIGHT, myThid )
109
110	C- Update pickup level for the next time we write pickup
111	IF ( .NOT. permPickup ) THEN
112	nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
113	ENDIF
114	_END_MASTER(myThid)
115
116	ELSEIF ( modelEnd ) THEN
117	WRITE(msgBuf,'(A)')
118	& "Did not write pickup because writePickupAtEnd = FALSE"
119	CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
120	& SQUEEZE_RIGHT, myThid )
121
122	C-- time to write pickup files: end
123	ENDIF
124
125	RETURN
126	END