pkg/land/land_read_pickup.F

e0a2f8aec4 Jean*0001 #include "LAND_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: LAND_READ_PICKUP
                0005 C     !INTERFACE:
                0006       SUBROUTINE LAND_READ_PICKUP( myIter, myThid )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | S/R LAND_READ_PICKUP
                0011 C     | o Reads current state of land model from a pickup file
                0012 C     *==========================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ===
                0019 #include "LAND_SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "LAND_PARAMS.h"
                0023 #include "LAND_VARS.h"
                0024
                0025 C     == Routine Arguments ==
                0026 C     myIter  :: time-step number
                0027 C     myThid  :: Number of this instance
                0028       INTEGER myIter
                0029       INTEGER myThid
                0030
                0031 #ifdef ALLOW_LAND
                0032
                0033 C     !LOCAL VARIABLES:
                0034 C     fn      :: character buffer for creating filename
                0035 C     prec    :: precision of pickup files
                0036 C     k       :: loop index
89992793c5 Jean*0037       INTEGER prec, k
df5a9764ba Jean*0038       CHARACTER*(10) suff
e0a2f8aec4 Jean*0039       CHARACTER*(MAX_LEN_FNAM) fn
                0040 CEOP
                0041
                0042 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0043
3a10a8cfd8 Jean*0044       IF ( .NOT.land_pickup_read_mnc ) THEN
cf701ea57b Ed H*0045
df5a9764ba Jean*0046         IF ( rwSuffixType.EQ.0 ) THEN
                0047           WRITE(fn,'(A,I10.10)') 'pickup_land.',myIter
                0048         ELSE
                0049           CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0050           WRITE(fn,'(A,A10)') 'pickup_land.',suff
                0051         ENDIF
                0052         prec = precFloat64
e0a2f8aec4 Jean*0053
df5a9764ba Jean*0054         IF ( land_oldPickup ) THEN
e0a2f8aec4 Jean*0055 C-    Read fields as consecutive records
df5a9764ba Jean*0056           CALL READ_REC_3D_RL( fn, prec, land_nLev,
                0057      &                         land_groundT, 1, myIter, myThid )
                0058           CALL READ_REC_3D_RL( fn, prec, land_nLev,
                0059      &                         land_groundW, 2, myIter, myThid )
e0a2f8aec4 Jean*0060
89992793c5 Jean*0061       ELSE
                0062
                0063 C-    Read fields as consecutive records
df5a9764ba Jean*0064           CALL READ_REC_3D_RL( fn, prec, land_nLev,
                0065      &                         land_enthalp, 1, myIter, myThid )
                0066           CALL READ_REC_3D_RL( fn, prec, land_nLev,
                0067      &                         land_groundW, 2, myIter, myThid )
                0068           k=2*land_nLev
                0069           CALL READ_REC_3D_RL( fn, prec, 1,
                0070      &                         land_skinT,  k+1, myIter, myThid )
                0071           CALL READ_REC_3D_RL( fn, prec, 1,
                0072      &                         land_hSnow,  k+2, myIter, myThid )
                0073           CALL READ_REC_3D_RL( fn, prec, 1,
                0074      &                         land_snowAge,k+3, myIter, myThid )
                0075
                0076         ENDIF
89992793c5 Jean*0077
cf701ea57b Ed H*0078       ENDIF
                0079
                0080 #ifdef ALLOW_MNC
                0081       IF ( land_pickup_read_mnc ) THEN
                0082
                0083         DO k = 1,MAX_LEN_FNAM
                0084           fn(k:k) = ' '
                0085         ENDDO
                0086         WRITE(fn,'(A)') 'pickup_land'
                0087         CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
                0088         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0089         CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
                0090
                0091         CALL MNC_CW_RL_R('D',fn,0,0,
                0092      &       'land_enthalp', land_enthalp, myThid)
                0093         CALL MNC_CW_RL_R('D',fn,0,0,
                0094      &       'land_groundW', land_groundW, myThid)
                0095
                0096         CALL MNC_CW_RL_R('D',fn,0,0,
                0097      &       'land_skinT', land_skinT, myThid)
                0098         CALL MNC_CW_RL_R('D',fn,0,0,
                0099      &       'land_hSnow', land_hSnow, myThid)
                0100         CALL MNC_CW_RL_R('D',fn,0,0,
                0101      &       'land_snAge', land_snowAge, myThid)
                0102
                0103       ENDIF
                0104 #endif
                0105
e0a2f8aec4 Jean*0106 C- jmc: exchange is not really necessary for land model
                0107 C-      and presently exchange S/R cannot work for 3d array where 3rd dim <> Nr
                0108
                0109 #endif /* ALLOW_LAND */
                0110
                0111       RETURN
                0112       END