pkg/darwin/darwin_read_pickup.F

8fbfd1f382 Oliv*0001 #include "DARWIN_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: DARWIN_READ_PICKUP
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE DARWIN_READ_PICKUP( myIter, myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     Reads current state of DARWIN from a pickup file
                0012
                0013 C     !USES:
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
                0018 #include "PTRACERS_SIZE.h"
                0019 #include "PTRACERS_PARAMS.h"
                0020 #include "DARWIN_SIZE.h"
                0021 #include "DARWIN_FIELDS.h"
                0022
                0023 C     !INPUT PARAMETERS:
                0024 C     myIter            :: time-step number
                0025 C     myThid            :: thread number
                0026       INTEGER myIter
                0027       INTEGER myThid
                0028
                0029 #ifdef ALLOW_DARWIN
5bc6c7edbe Oliv*0030 #if defined(DARWIN_ALLOW_CARBON) || ((defined(DARWIN_ALLOW_GEIDER) || defined(ALLOW_RADTRANS)) && !defined(DARWIN_ALLOW_CHLQUOTA))
8fbfd1f382 Oliv*0031
                0032 C     !LOCAL VARIABLES:
                0033 C     fn          :: character buffer for creating filename
                0034 C     fp          :: precision of pickup files
                0035 C     filePrec    :: pickup-file precision (read from meta file)
                0036 C     nbFields    :: number of fields in pickup file (read from meta file)
                0037 C     missFldList :: List of missing fields   (attempted to read but not found)
                0038 C     missFldDim  :: Dimension of missing fields list array: missFldList
                0039 C     nMissing    :: Number of missing fields (attempted to read but not found)
                0040 C     j           :: loop index
                0041 C     nj          :: record number
                0042 C     ioUnit      :: temp for writing msg unit
                0043 C     msgBuf      :: Informational/error message buffer
                0044       INTEGER fp
                0045       INTEGER filePrec, nbFields
                0046       INTEGER missFldDim, nMissing
                0047       INTEGER j, nj, ioUnit, np
                0048       PARAMETER( missFldDim = 12 )
                0049       CHARACTER*(MAX_LEN_FNAM) fn
                0050       CHARACTER*(8) fldName
                0051       CHARACTER*(8) missFldList(missFldDim)
                0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0053 CEOP
                0054
                0055       _BARRIER
                0056
                0057 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0058
                0059        IF ( pickupSuff.EQ.' ' ) THEN
                0060         WRITE(fn,'(A,I10.10)') 'pickup_darwin.',myIter
                0061        ELSE
                0062         WRITE(fn,'(A,A10)')    'pickup_darwin.',pickupSuff
                0063        ENDIF
                0064        fp = precFloat64
                0065
                0066        CALL READ_MFLDS_SET(
                0067      I                      fn,
                0068      O                      nbFields, filePrec,
                0069      I                      Nr, myIter, myThid )
                0070        _BEGIN_MASTER( myThid )
                0071        IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
                0072          WRITE(msgBuf,'(2A,I4)') 'DARWIN_READ_PICKUP: ',
                0073      &    'pickup-file binary precision do not match !'
                0074          CALL PRINT_ERROR( msgBuf, myThid )
                0075          WRITE(msgBuf,'(A,2(A,I4))') 'DARWIN_READ_PICKUP: ',
                0076      &    'file prec.=', filePrec, ' but expecting prec.=', fp
                0077          CALL PRINT_ERROR( msgBuf, myThid )
                0078          STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP (data-prec Pb)'
                0079        ENDIF
                0080        _END_MASTER( myThid )
                0081
                0082        IF ( nbFields.LE.0 ) THEN
                0083 C-      No meta-file or old meta-file without List of Fields
                0084         ioUnit = errorMessageUnit
                0085         IF ( pickupStrictlyMatch ) THEN
                0086           WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
                0087      &      'no field-list found in meta-file',
                0088      &      ' => cannot check for strick-matching'
                0089           CALL PRINT_ERROR( msgBuf, myThid )
                0090           WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
                0091      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0092      &      ' in file: "data", NameList: "PARM03"'
                0093           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0094           STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
                0095         ELSE
                0096           WRITE(msgBuf,'(4A)') 'WARNING >> DARWIN_READ_PICKUP: ',
                0097      &      ' no field-list found'
                0098           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0099          IF ( nbFields.EQ.-1 ) THEN
                0100 C-      No meta-file
                0101           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0102      &      ' try to read pickup as currently written'
                0103           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0104          ELSE
                0105           WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
                0106      &      'no field-list found in meta-file'
                0107           CALL PRINT_ERROR( msgBuf, myThid )
                0108           STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
                0109          ENDIF
                0110         ENDIF
                0111        ENDIF
                0112
                0113 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0114
                0115        IF ( nbFields.EQ.0 ) THEN
                0116 C---   Old way to read pickup not supported
                0117           WRITE(msgBuf,'(2A)') 'DARWIN_READ_PICKUP: ',
                0118      &      'please provide a meta file with a field list'
                0119           STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
                0120        ELSE
                0121 C---   New way to read DARWIN pickup:
                0122         nj = 0
                0123 C---    read DARWIN 3-D fields for restart
                0124 #ifdef DARWIN_ALLOW_CARBON
                0125         fldName = 'pH'
                0126         CALL READ_MFLDS_3D_RL( fldName, pH, nj, fp, Nr, myIter, myThid )
                0127 #endif
5bc6c7edbe Oliv*0128 #if (defined(DARWIN_ALLOW_GEIDER) || defined(ALLOW_RADTRANS)) && !defined(DARWIN_ALLOW_CHLQUOTA)
8fbfd1f382 Oliv*0129 #ifdef ALLOW_RADTRANS
                0130         DO np = 1, nPhoto
                0131          fldName(1:6) = 'ChlPhy'
                0132          fldName(7:8) = PTRACERS_ioLabel(np)
                0133          CALL READ_MFLDS_3D_RL( fldName, ChlPrev(1-OLx,1-OLy,1,1,1,np),
                0134      &                          nj, fp, Nr, myIter, myThid )
                0135         ENDDO
                0136 #else
                0137         CALL READ_MFLDS_3D_RL( 'Chl     ', ChlPrev,
                0138      &                         nj, fp, Nr, myIter, myThid )
                0139 #endif
                0140 #endif
                0141 C--    end: new way to read pickup file
                0142        ENDIF
                0143
                0144 C--    Check for missing fields:
                0145        nMissing = missFldDim
                0146        CALL READ_MFLDS_CHECK(
                0147      O                     missFldList,
                0148      U                     nMissing,
                0149      I                     myIter, myThid )
                0150        IF ( nMissing.GT.missFldDim ) THEN
                0151          WRITE(msgBuf,'(2A,I4)') 'DARWIN_READ_PICKUP: ',
                0152      &     'missing fields list has been truncated to', missFldDim
                0153          CALL PRINT_ERROR( msgBuf, myThid )
                0154          STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP (list-size Pb)'
                0155        ENDIF
                0156        IF ( nMissing.GE.1 ) THEN
                0157         ioUnit = errorMessageUnit
                0158         DO j=1,nMissing
                0159          WRITE(msgBuf,'(4A)') 'DARWIN_READ_PICKUP: ',
                0160      &       'cannot restart without field "',missFldList(nj),'"'
                0161          CALL PRINT_ERROR( msgBuf, myThid )
                0162         ENDDO
                0163         STOP 'ABNORMAL END: S/R DARWIN_READ_PICKUP'
                0164        ENDIF
                0165
                0166 C--    Update overlap regions:
                0167 #ifdef DARWIN_ALLOW_CARBON
                0168         CALL EXCH_3D_RL( pH, 1, myThid )
                0169 #endif
                0170 #if defined(DARWIN_ALLOW_GEIDER) && !defined(DARWIN_ALLOW_CHLQUOTA)
                0171 #ifdef ALLOW_RADTRANS
                0172         DO np = 1, nPhoto
                0173          CALL EXCH_3D_RL( ChlPrev(1-OLx,1-OLy,1,1,1,np), Nr, myThid )
                0174         ENDDO
                0175 #else
                0176         CALL EXCH_3D_RL( ChlPrev, Nr, myThid )
                0177 #endif
                0178 #endif
                0179
                0180 #endif /* pickup needed */
                0181 #endif /* ALLOW_DARWIN */
                0182
                0183       RETURN
                0184       END