pkg/land/land_write_pickup.F

e0a2f8aec4 Jean*0001 #include "LAND_OPTIONS.h"
                0002
                0003 CBOP
e68e66e343 Jean*0004 C     !ROUTINE: LAND_WRITE_PICKUP
e0a2f8aec4 Jean*0005 C     !INTERFACE:
cf701ea57b Ed H*0006       SUBROUTINE LAND_WRITE_PICKUP( isperm, suff,
e68e66e343 Jean*0007      I                              myTime, myIter, myThid )
e0a2f8aec4 Jean*0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | S/R LAND_WRITE_PICKUP
                0012 C     | o Writes current state of land package to a pickup file
                0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018
                0019 C     == Global variables ===
                0020 #include "LAND_SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "LAND_PARAMS.h"
                0024 #include "LAND_VARS.h"
                0025
                0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     == Routine Arguments ==
cf701ea57b Ed H*0028 C     isperm  :: flag for permanent or rolling checkpoint
e0a2f8aec4 Jean*0029 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0030 C     myTime  :: current time
                0031 C     myIter  :: time-step number
                0032 C     myThid  :: Number of this instance
cf701ea57b Ed H*0033       LOGICAL isperm
e0a2f8aec4 Jean*0034       CHARACTER*(*) suff
                0035       _RL myTime
                0036       INTEGER myIter
                0037       INTEGER myThid
                0038
                0039 #ifdef ALLOW_LAND
                0040
9f24b0ff20 Jean*0041 C     !FUNCTIONS:
                0042       INTEGER  ILNBLNK
                0043       EXTERNAL ILNBLNK
                0044
e0a2f8aec4 Jean*0045 C     !LOCAL VARIABLES:
                0046 C     fn      :: character buffer for creating filename
                0047 C     prec    :: precision of pickup files
89992793c5 Jean*0048 c     INTEGER prec, iChar, lChar, k
                0049       INTEGER prec, lChar, k
e0a2f8aec4 Jean*0050       CHARACTER*(MAX_LEN_FNAM) fn
                0051 CEOP
                0052
                0053 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0054
89992793c5 Jean*0055       lChar = ILNBLNK(suff)
cf701ea57b Ed H*0056
                0057       IF ( land_pickup_write_mdsio ) THEN
                0058
                0059 C--   Write fields as consecutive records
9f24b0ff20 Jean*0060         WRITE(fn,'(A,A)') 'pickup_land.',suff(1:lChar)
                0061         prec = precFloat64
                0062
                0063         CALL WRITE_REC_3D_RL( fn, prec, land_nLev,
                0064      &                        land_enthalp,  1, myIter, myThid )
                0065         CALL WRITE_REC_3D_RL( fn, prec, land_nLev,
                0066      &                        land_groundW,  2, myIter, myThid )
                0067         k=2*land_nLev
                0068         CALL WRITE_REC_3D_RL( fn, prec, 1,
                0069      &                        land_skinT,  k+1, myIter, myThid )
                0070         CALL WRITE_REC_3D_RL( fn, prec, 1,
                0071      &                        land_hSnow,  k+2, myIter, myThid )
                0072         CALL WRITE_REC_3D_RL( fn, prec, 1,
                0073      &                        land_snowAge,k+3, myIter, myThid )
e0a2f8aec4 Jean*0074
cf701ea57b Ed H*0075       ENDIF
                0076
                0077 #ifdef ALLOW_MNC
                0078       IF ( land_pickup_write_mnc ) THEN
                0079
                0080         DO k = 1,MAX_LEN_FNAM
                0081           fn(k:k) = ' '
                0082         ENDDO
                0083         IF ( isperm ) THEN
                0084           WRITE(fn,'(A)') 'pickup_land'
                0085         ELSE
                0086           WRITE(fn,'(A,A)') 'pickup_land.',suff(1:lChar)
                0087         ENDIF
                0088         CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
                0089         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0090         IF ( isperm ) THEN
                0091           CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, 0, myThid)
                0092         ELSE
                0093           CALL MNC_CW_SET_CITER(fn, 2, -1, -1, -1, myThid)
                0094         ENDIF
c29c5d093c Ed H*0095         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
cf701ea57b Ed H*0096
                0097         CALL MNC_CW_RL_W_S('D',fn,0,0,'T', myTime, myThid)
                0098         CALL MNC_CW_I_W_S('I',fn,0,0,'iter', myIter, myThid)
                0099
                0100         CALL MNC_CW_RL_W('D',fn,0,0,
                0101      &       'land_enthalp', land_enthalp, myThid)
                0102         CALL MNC_CW_RL_W('D',fn,0,0,
                0103      &       'land_groundW', land_groundW, myThid)
                0104
                0105         CALL MNC_CW_RL_W('D',fn,0,0,
                0106      &       'land_skinT', land_skinT, myThid)
                0107         CALL MNC_CW_RL_W('D',fn,0,0,
                0108      &       'land_hSnow', land_hSnow, myThid)
                0109         CALL MNC_CW_RL_W('D',fn,0,0,
                0110      &       'land_snAge', land_snowAge, myThid)
                0111
                0112       ENDIF
                0113 #endif /*  ALLOW_MNC  */
                0114
e0a2f8aec4 Jean*0115 #endif /* ALLOW_LAND */
                0116
                0117       RETURN
                0118       END