| 1 | molod | 1.1 | C $Header: /u/gcmpack/MITgcm/model/src/packages_write_pickup.F,v 1.5 2004/04/07 23:45:24 jmc Exp $ | 
| 2 |  |  | C $Name:  $ | 
| 3 |  |  |  | 
| 4 |  |  | #include "PACKAGES_CONFIG.h" | 
| 5 |  |  | #include "CPP_OPTIONS.h" | 
| 6 |  |  |  | 
| 7 |  |  | CBOP | 
| 8 |  |  | C     !ROUTINE: PACKAGES_WRITE_PICKUP | 
| 9 |  |  | C     !INTERFACE: | 
| 10 |  |  | SUBROUTINE PACKAGES_WRITE_PICKUP( | 
| 11 |  |  | I                    modelEnd, myTime, myIter, myThid ) | 
| 12 |  |  | C     !DESCRIPTION: \bv | 
| 13 |  |  | C     *==========================================================* | 
| 14 |  |  | C     | SUBROUTINE PACKAGES_WRITE_PICKUP | 
| 15 |  |  | C     | o write pickup files for each package which needs it | 
| 16 |  |  | C     |   to restart. | 
| 17 |  |  | C     *==========================================================* | 
| 18 |  |  | C     | This routine (S/R PACKAGES_WRITE_PICKUP) calls | 
| 19 |  |  | C     | per-package write-pickup (or checkpoint) routines. | 
| 20 |  |  | C     | o writes both "rolling-checkpoint" files (ckptA,ckptB) | 
| 21 |  |  | C     |   and permanent checkpoint files. | 
| 22 |  |  | C     *==========================================================* | 
| 23 |  |  | C     \ev | 
| 24 |  |  |  | 
| 25 |  |  | C     !USES: | 
| 26 |  |  | IMPLICIT NONE | 
| 27 |  |  | C     == Global variables === | 
| 28 |  |  | #include "SIZE.h" | 
| 29 |  |  | #include "EEPARAMS.h" | 
| 30 |  |  | #include "PARAMS.h" | 
| 31 |  |  |  | 
| 32 |  |  | LOGICAL  DIFFERENT_MULTIPLE | 
| 33 |  |  | EXTERNAL DIFFERENT_MULTIPLE | 
| 34 |  |  | INTEGER  IO_ERRCOUNT | 
| 35 |  |  | EXTERNAL IO_ERRCOUNT | 
| 36 |  |  |  | 
| 37 |  |  | C     !INPUT/OUTPUT PARAMETERS: | 
| 38 |  |  | C     == Routine arguments == | 
| 39 |  |  | C     modelEnd    :: Checkpoint call at end of model run. | 
| 40 |  |  | C     myThid :: Thread number for this instance of the routine. | 
| 41 |  |  | C     myIter :: Iteration number | 
| 42 |  |  | C     myTime :: Current time of simulation ( s ) | 
| 43 |  |  | LOGICAL modelEnd | 
| 44 |  |  | INTEGER myThid | 
| 45 |  |  | INTEGER myIter | 
| 46 |  |  | _RL     myTime | 
| 47 |  |  |  | 
| 48 |  |  | C     == Common blocks == | 
| 49 |  |  | COMMON /PCKP_GBLFLS/ globalFile | 
| 50 |  |  | LOGICAL globalFile | 
| 51 |  |  |  | 
| 52 |  |  | C     !LOCAL VARIABLES: | 
| 53 |  |  | C     == Local variables == | 
| 54 |  |  | C     permCheckPoint :: Flag indicating whether a permanent checkpoint will | 
| 55 |  |  | C                       be written. | 
| 56 |  |  | C     tempCheckPoint :: Flag indicating if it is time to write a non-permanent | 
| 57 |  |  | C                       checkpoint (that will be permanent if permCheckPoint=T) | 
| 58 |  |  | C     oldPrc :: Temp. for holding I/O precision | 
| 59 |  |  | C     fn     :: Temp. for building file name string. | 
| 60 |  |  | C     lgf    :: Flag to indicate whether to use global file mode. | 
| 61 |  |  | LOGICAL permCheckPoint, tempCheckPoint | 
| 62 |  |  | CHARACTER*(MAX_LEN_FNAM) fn | 
| 63 |  |  | CHARACTER*(MAX_LEN_MBUF) msgBuf | 
| 64 |  |  | INTEGER prec | 
| 65 |  |  | LOGICAL lgf | 
| 66 |  |  | CEOP | 
| 67 |  |  |  | 
| 68 |  |  | permCheckPoint = .FALSE. | 
| 69 |  |  | tempCheckPoint = .FALSE. | 
| 70 |  |  | permCheckPoint= | 
| 71 |  |  | &  DIFFERENT_MULTIPLE(pChkptFreq,myTime,myTime-deltaTClock) | 
| 72 |  |  | tempCheckPoint= | 
| 73 |  |  | &  DIFFERENT_MULTIPLE( ChkptFreq,myTime,myTime-deltaTClock) | 
| 74 |  |  |  | 
| 75 |  |  | C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| | 
| 76 |  |  | IF ( | 
| 77 |  |  | &    ( .NOT.modelEnd .AND. (permCheckPoint.OR.tempCheckPoint) ) | 
| 78 |  |  | &   .OR. | 
| 79 |  |  | &    ( modelEnd .AND. .NOT.(permCheckPoint.OR.tempCheckPoint) ) | 
| 80 |  |  | &   ) THEN | 
| 81 |  |  |  | 
| 82 |  |  | C--    Going to really do some IO. Make everyone except master thread wait. | 
| 83 |  |  | _BARRIER | 
| 84 |  |  | _BEGIN_MASTER( myThid ) | 
| 85 |  |  |  | 
| 86 |  |  | prec = precFloat64 | 
| 87 |  |  | lgf = globalFile | 
| 88 |  |  |  | 
| 89 |  |  | C Create suffix to pass on to package pickup routines | 
| 90 |  |  | IF ( permCheckPoint ) THEN | 
| 91 |  |  | WRITE(fn,'(I10.10)') myIter | 
| 92 |  |  | ELSE | 
| 93 |  |  | WRITE(fn,'(A)') checkPtSuff(nCheckLev) | 
| 94 |  |  | ENDIF | 
| 95 |  |  |  | 
| 96 |  |  | #ifdef ALLOW_CD_CODE | 
| 97 |  |  | IF (useCDscheme) THEN | 
| 98 |  |  | CALL CD_CODE_WRITE_CHECKPOINT( | 
| 99 |  |  | &               prec, lgf, permCheckPoint, myIter, myThid) | 
| 100 |  |  | ENDIF | 
| 101 |  |  | #endif /* ALLOW_CD_CODE */ | 
| 102 |  |  |  | 
| 103 |  |  | #ifdef  ALLOW_OBCS | 
| 104 |  |  | C SPK 4/9/01: Open boundary checkpointing | 
| 105 |  |  | IF (useOBCS) THEN | 
| 106 |  |  | CALL OBCS_WRITE_CHECKPOINT( | 
| 107 |  |  | &               prec, lgf, permCheckPoint, myIter, myThid) | 
| 108 |  |  | ENDIF | 
| 109 |  |  | #endif  /* ALLOW_OBCS */ | 
| 110 |  |  |  | 
| 111 |  |  | #ifdef  ALLOW_SEAICE | 
| 112 |  |  | IF ( useSEAICE ) THEN | 
| 113 |  |  | CALL SEAICE_WRITE_PICKUP( | 
| 114 |  |  | &               prec, lgf, permCheckPoint, myIter, myThid) | 
| 115 |  |  | ENDIF | 
| 116 |  |  | #endif  /* ALLOW_SEAICE */ | 
| 117 |  |  |  | 
| 118 |  |  | #ifdef ALLOW_THSICE | 
| 119 |  |  | IF (useThSIce) THEN | 
| 120 |  |  | CALL THSICE_WRITE_PICKUP( | 
| 121 |  |  | &               prec, lgf, permCheckPoint, myIter, myThid) | 
| 122 |  |  | ENDIF | 
| 123 |  |  | #endif /* ALLOW_THSICE */ | 
| 124 |  |  |  | 
| 125 |  |  | #ifdef  COMPONENT_MODULE | 
| 126 |  |  | IF (useCoupler) THEN | 
| 127 |  |  | CALL CPL_WRITE_PICKUP( | 
| 128 |  |  | &               prec, lgf, permCheckPoint, myIter, myThid) | 
| 129 |  |  | ENDIF | 
| 130 |  |  | #endif  /* COMPONENT_MODULE */ | 
| 131 |  |  |  | 
| 132 |  |  | #ifdef ALLOW_FLT | 
| 133 |  |  | C--     Write restart file for floats | 
| 134 |  |  | IF (useFLT) THEN | 
| 135 |  |  | CALL FLT_RESTART(myTime, myIter, myThid) | 
| 136 |  |  | ENDIF | 
| 137 |  |  | #endif | 
| 138 |  |  |  | 
| 139 |  |  | #ifdef ALLOW_LAND | 
| 140 |  |  | C--     Write pickup file for Lnad package: | 
| 141 |  |  | IF (useLand) THEN | 
| 142 |  |  | CALL LAND_WRITE_PICKUP(fn,myTime,myIter,myThid) | 
| 143 |  |  | ENDIF | 
| 144 |  |  | #endif | 
| 145 |  |  |  | 
| 146 |  |  | #ifdef ALLOW_FIZHI | 
| 147 |  |  | C--     Write pickup file for fizhi package | 
| 148 |  |  | IF (usefizhi) THEN | 
| 149 |  |  | CALL FIZHI_WRITE_PICKUP(fn,myTime,myIter,myThid) | 
| 150 |  |  | ENDIF | 
| 151 |  |  | #endif | 
| 152 |  |  |  | 
| 153 |  |  |  | 
| 154 |  |  | _END_MASTER( myThid ) | 
| 155 |  |  | _BARRIER | 
| 156 |  |  |  | 
| 157 |  |  | #ifdef ALLOW_PTRACERS | 
| 158 |  |  | C Write restart file for passive tracers | 
| 159 |  |  | IF (usePTRACERS) THEN | 
| 160 |  |  | CALL PTRACERS_WRITE_CHECKPOINT(fn,myIter,myTime,myThid) | 
| 161 |  |  | ENDIF | 
| 162 |  |  | #endif /* ALLOW_PTRACERS */ | 
| 163 |  |  |  | 
| 164 |  |  | ENDIF | 
| 165 |  |  |  | 
| 166 |  |  | RETURN | 
| 167 |  |  | END |