C $Header: /u/gcmpack/MITgcm/pkg/atm2d/atm2d_write_pickup.F,v 1.9 2012/08/06 16:56:59 jmc Exp $
C $Name:  $

#include "ctrparam.h"
#include "ATM2D_OPTIONS.h"
      SUBROUTINE ATM2D_WRITE_PICKUP(
     I     modelEnd,
     I     myTime,
     I     myIter,
     I     myThid )

C     *==========================================================*
C     | Write pickup files for atm2d package which needs it to   |
C     |restart. It writes both "rolling-checkpoint" files (ckptA,|
C     |ckptB) and permanent checkpoint files. NOT called from    |
C     |the usual MITGCM WRITE_PICKUP routine in forward step, as |
C     |NORM_OCN_FLUXES must be done before these fluxes are ready|
C     *==========================================================*

C     Note this routine was pilfered from the MITGCM code prior to
C     JMC's changes in 8/06.

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

      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL 
      INTEGER  IO_ERRCOUNT
      EXTERNAL 

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     modelEnd    :: Checkpoint call at end of model run.
C     myThid :: Thread number for this instance of the routine.
C     myIter :: Iteration number
C     myTime :: Current time of simulation ( s )
      LOGICAL modelEnd
      INTEGER myThid
      INTEGER myIter
      _RL     myTime

C     !LOCAL VARIABLES:
C     == Local variables ==
C     permCheckPoint :: Flag indicating whether a permanent checkpoint will
C                       be written.
C     tempCheckPoint :: Flag indicating if it is time to write a non-permanent
C                       checkpoint (that will be permanent if permCheckPoint=T)
      LOGICAL permCheckPoint, tempCheckPoint
CEOP

      permCheckPoint = .FALSE.
      tempCheckPoint = .FALSE.
      permCheckPoint=
     &     DIFFERENT_MULTIPLE(pChkPtFreq,myTime,deltaTClock)
      tempCheckPoint=
     &     DIFFERENT_MULTIPLE( chkPtFreq,myTime,deltaTClock)

#ifdef ALLOW_CAL
      IF ( useCAL ) THEN
         CALL CAL_TIME2DUMP( zeroRL, pChkPtFreq, deltaTClock,
     U                       permCheckPoint,
     I                       myTime, myIter, myThid )
         CALL CAL_TIME2DUMP( zeroRL, chkPtFreq,  deltaTClock,
     U                       tempCheckPoint,
     I                       myTime, myIter, myThid )
      ENDIF
#endif /* ALLOW_CAL */

      IF (
     &     ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) )
     &     .OR.
     &     ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) )
     &     ) THEN

        IF (tempCheckPoint)   !toggle was done prematurely...
     &       nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1

        CALL ATM2D_WRITE_PICKUP_NOW(
     &       permCheckPoint, myTime, myIter, myThid )

        IF (tempCheckPoint)   !note this works for A/B chpt only
     &       nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1

      ENDIF

      RETURN
      END


C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| #include "ctrparam.h" #include "ATM2D_OPTIONS.h" CBOP C !ROUTINE: ATM2D_WRITE_PICKUP_NOW C !INTERFACE: SUBROUTINE ATM2D_WRITE_PICKUP_NOW( I permCheckPoint, I myTime, I myIter, I myThid ) C !DESCRIPTION: C Write pickup files for atm2d package which needs it to restart and C do it NOW. C !USES: IMPLICIT NONE #include "ATMSIZE.h" #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "RESTART.h" #include "THSICE_VARS.h" #include "ATM2D_VARS.h" C !INPUT/OUTPUT PARAMETERS: C permCheckPoint :: Checkpoint is permanent C myThid :: Thread number for this instance of the routine. C myIter :: Iteration number C myTime :: Current time of simulation ( s ) LOGICAL permCheckPoint INTEGER myThid INTEGER myIter _RL myTime C == Common blocks == COMMON /PCKP_GBLFLS/ globalFile LOGICAL globalFile C !LOCAL VARIABLES: C == Local variables == C oldPrc :: Temp. for holding I/O precision C fn :: Temp. for building file name string. CHARACTER*(MAX_LEN_FNAM) fn INTEGER prec, i,j CEOP prec = precFloat64 C Create suffix to pass on to package pickup routines IF ( permCheckPoint ) THEN WRITE(fn,'(A,I10.10)') 'pickup_atm2d.',myIter ELSE WRITE(fn,'(A,A)') 'pickup_atm2d.',checkPtSuff(nCheckLev) ENDIF CALL WRITE_REC_3D_RL( fn,prec,1,pass_slp, 1,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_qnet, 2,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_solarnet, 3,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_fu, 4,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_fv, 5,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_precip, 6,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_evap, 7,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_runoff, 8,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_wspeed, 9,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_pCO2, 10,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_sIceLoad,11,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,sHeating, 12,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,flxCndBt, 13,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,pass_prcAtm, 14,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,snowPrc, 15,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,icFrwAtm, 16,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,icFlxSw, 17,myIter,myThid ) CALL WRITE_REC_3D_RL( fn,prec,1,siceAlb, 18,myIter,myThid ) RETURN END