Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:33 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
c04db39328 Jean*0001 #include "ATM_CPL_OPTIONS.h"
5a2fc21c93 Jean*0002 
4ff1cd5702 Jean*0003 CBOP
                0004 C     !ROUTINE: ATM_CPL_READ_PICKUP
                0005 C     !INTERFACE:
5a2fc21c93 Jean*0006       SUBROUTINE ATM_CPL_READ_PICKUP( myIter, myThid )
4ff1cd5702 Jean*0007 
                0008 C     !DESCRIPTION: \bv
5a2fc21c93 Jean*0009 C     *==========================================================*
                0010 C     | SUBROUTINE ATM_CPL_READ_PICKUP
                0011 C     | o Reads fields from a pickup file for a restart
                0012 C     *==========================================================*
                0013 C     *==========================================================*
4ff1cd5702 Jean*0014 C     \ev
                0015 
                0016 C     !USES:
5a2fc21c93 Jean*0017       IMPLICIT NONE
                0018 
                0019 C     == Global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "CPL_PARAMS.h"
                0024 #include "ATMCPL.h"
                0025 
4ff1cd5702 Jean*0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     myIter  :: Current time-step number
                0028 C     myThid  :: my Thread Id number
5a2fc21c93 Jean*0029       INTEGER myIter
                0030       INTEGER myThid
                0031 
                0032 #ifdef COMPONENT_MODULE
d1469cc589 Jean*0033 C     !LOCAL VARIABLES:
                0034 C     fn          :: character buffer for creating filename
                0035 C     fp          :: precision of pickup files
                0036 C     filePrec    :: pickup-file precision (read from meta file)
                0037 C     nbFields    :: number of fields in pickup file (read from meta file)
                0038 C     missFldList :: List of missing fields   (attempted to read but not found)
                0039 C     missFldDim  :: Dimension of missing fields list array: missFldList
                0040 C     nMissing    :: Number of missing fields (attempted to read but not found)
                0041 C     j           :: loop index
                0042 C     nj          :: record number
                0043 C     ioUnit      :: temp for writing msg unit
                0044 C     msgBuf      :: Informational/error message buffer
                0045       INTEGER fp
                0046       INTEGER filePrec, nbFields
                0047       INTEGER missFldDim, nMissing
                0048       INTEGER j, nj, ioUnit
                0049       PARAMETER( missFldDim = 18 )
ab33782b56 Jean*0050       CHARACTER*(10) suff
5a2fc21c93 Jean*0051       CHARACTER*(MAX_LEN_FNAM) fn
d1469cc589 Jean*0052       CHARACTER*(8) missFldList(missFldDim)
                0053       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0054       INTEGER i, bi, bj
                0055 CEOP
5a2fc21c93 Jean*0056 
d1469cc589 Jean*0057 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0058 
                0059        IF ( pickupSuff.EQ.' ' ) THEN
ab33782b56 Jean*0060         IF ( rwSuffixType.EQ.0 ) THEN
                0061           WRITE(fn,'(A,I10.10)') 'pickup_cpl.', myIter
                0062         ELSE
                0063           CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0064           WRITE(fn,'(A,A)') 'pickup_cpl.', suff
                0065         ENDIF
d1469cc589 Jean*0066        ELSE
ab33782b56 Jean*0067         WRITE(fn,'(A,A10)') 'pickup_cpl.', pickupSuff
d1469cc589 Jean*0068        ENDIF
                0069        fp = precFloat64
                0070 
                0071        CALL READ_MFLDS_SET(
                0072      I                      fn,
                0073      O                      nbFields, filePrec,
                0074      I                      Nr, myIter, myThid )
                0075        _BEGIN_MASTER( myThid )
                0076 c      IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN
                0077        IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
                0078          WRITE(msgBuf,'(2A,I4)') 'ATM_CPL_READ_PICKUP: ',
                0079      &    'pickup-file binary precision do not match !'
                0080          CALL PRINT_ERROR( msgBuf, myThid )
                0081          WRITE(msgBuf,'(A,2(A,I4))') 'ATM_CPL_READ_PICKUP: ',
                0082      &    'file prec.=', filePrec, ' but expecting prec.=', fp
                0083          CALL PRINT_ERROR( msgBuf, myThid )
                0084          CALL ALL_PROC_DIE( 0 )
                0085          STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP (data-prec Pb)'
                0086        ENDIF
                0087        _END_MASTER( myThid )
                0088 
                0089        IF ( nbFields.LE.0 ) THEN
                0090 C-      No meta-file or old meta-file without List of Fields
                0091         ioUnit = errorMessageUnit
                0092         IF ( pickupStrictlyMatch ) THEN
                0093           WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
                0094      &      'no field-list found in meta-file',
                0095      &      ' => cannot check for strick-matching'
                0096           CALL PRINT_ERROR( msgBuf, myThid )
                0097           WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
                0098      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0099      &      ' in file: "data", NameList: "PARM03"'
                0100           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0101           CALL ALL_PROC_DIE( myThid )
                0102           STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP'
                0103         ELSE
                0104           WRITE(msgBuf,'(4A)') 'WARNING >> ATM_CPL_READ_PICKUP: ',
                0105      &      ' no field-list found'
                0106           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0107          IF ( nbFields.EQ.-1 ) THEN
                0108 C-      No meta-file
                0109           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0110      &      ' try to read pickup as currently written'
                0111           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0112          ELSE
                0113 C-      Old meta-file without List of Fields
                0114           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0115      &      ' try to read pickup as it used to be written'
                0116           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0117           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0118      &      ' until checkpoint65r (2015 Dec 21)'
                0119           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0120 c         WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
                0121 c    &      'no field-list found in meta-file'
                0122 c         CALL PRINT_ERROR( msgBuf, myThid )
                0123 c         CALL ALL_PROC_DIE( myThid )
                0124 c         STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP'
                0125          ENDIF
                0126         ENDIF
                0127        ENDIF
                0128 
                0129 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0130 
                0131        IF ( nbFields.EQ.0 ) THEN
                0132 C---   Old way to read pickup:
                0133 
                0134 c       CALL READ_REC_3D_RL( fn, fp, 1, ocMxlD    ,  1, myIter,myThid )
                0135 c       CALL READ_REC_3D_RL( fn, fp, 1, SSTocn    ,  2, myIter,myThid )
                0136 c       CALL READ_REC_3D_RL( fn, fp, 1, SSSocn    ,  3, myIter,myThid )
                0137 c       CALL READ_REC_3D_RL( fn, fp, 1, vSqocn    ,  4, myIter,myThid )
ece6c362bf Jean*0138 c       CALL READ_REC_3D_RL( fn, fp, 1, atmSLPr   ,  5, myIter,myThid )
d1469cc589 Jean*0139         CALL READ_REC_3D_RL( fn, fp, 1, HeatFlux  ,  6, myIter,myThid )
                0140         CALL READ_REC_3D_RL( fn, fp, 1, qShortWave,  7, myIter,myThid )
                0141         CALL READ_REC_3D_RL( fn, fp, 1, tauX      ,  8, myIter,myThid )
                0142         CALL READ_REC_3D_RL( fn, fp, 1, tauY      ,  9, myIter,myThid )
                0143         CALL READ_REC_3D_RL( fn, fp, 1, EvMPrFlux , 10, myIter,myThid )
                0144 #ifdef ALLOW_LAND
                0145         CALL READ_REC_3D_RL( fn, fp, 1, RunOffFlux, 11, myIter,myThid )
                0146         CALL READ_REC_3D_RL( fn, fp, 1, RunOffEnFx, 12, myIter,myThid )
                0147 #endif /* ALLOW_LAND */
                0148 #ifdef ALLOW_THSICE
                0149         CALL READ_REC_3D_RL( fn, fp, 1, iceSaltFlx, 13, myIter,myThid )
                0150 c       CALL READ_REC_3D_RL( fn, fp, 1, seaIceMass, 14, myIter,myThid )
                0151 #endif /* ALLOW_THSICE */
                0152 #ifdef ALLOW_AIM
                0153         IF ( atm_cplExch_DIC ) THEN
                0154 c        CALL READ_REC_3D_RL( fn,fp, 1, flxCO2ocn , 15, myIter,myThid )
                0155          CALL READ_REC_3D_RL( fn,fp, 1, airCO2    , 16, myIter,myThid )
                0156          CALL READ_REC_3D_RL( fn,fp, 1, sWSpeed   , 17, myIter,myThid )
                0157 # ifdef ALLOW_THSICE
c121b6d611 Jean*0158 c        CALL READ_REC_3D_RL( fn,fp,1,sIceFrac_cpl, 18, myIter,myThid )
d1469cc589 Jean*0159 # endif /* ALLOW_THSICE */
                0160         ENDIF
                0161 #endif /* ALLOW_AIM */
                0162 
                0163        ELSE
                0164 C---   New way to read ATM_CPL pickup:
                0165         nj = 0
                0166 C---    read ATM_CPL 3-D fields for restart
                0167         nj = nj*Nr
                0168 
                0169 C---    read ATM_CPL 2-D fields for restart
                0170         CALL READ_MFLDS_3D_RL( 'qHeatFlx', HeatFlux,
                0171      &                                 nj, fp, 1 , myIter, myThid )
                0172         CALL READ_MFLDS_3D_RL( 'qShortW ', qShortWave,
                0173      &                                 nj, fp, 1 , myIter, myThid )
                0174         CALL READ_MFLDS_3D_RL( 'surfTauX', tauX,
                0175      &                                 nj, fp, 1 , myIter, myThid )
                0176         CALL READ_MFLDS_3D_RL( 'surfTauY', tauY,
                0177      &                                 nj, fp, 1 , myIter, myThid )
                0178         CALL READ_MFLDS_3D_RL( 'Evp-Prec', EvMPrFlux,
                0179      &                                 nj, fp, 1 , myIter, myThid )
                0180 #ifdef ALLOW_LAND
                0181         IF ( atm_cplExch_RunOff ) THEN
                0182          CALL READ_MFLDS_3D_RL('RunOffFx', RunOffFlux,
                0183      &                                 nj, fp, 1 , myIter, myThid )
                0184          CALL READ_MFLDS_3D_RL('RnOfEnFx', RunOffEnFx,
                0185      &                                 nj, fp, 1 , myIter, myThid )
                0186         ENDIF
                0187 #endif /* ALLOW_LAND */
                0188 #ifdef ALLOW_THSICE
                0189         IF ( atm_cplExch1W_sIce ) THEN
                0190          CALL READ_MFLDS_3D_RL('saltFlux', iceSaltFlx,
                0191      &                                 nj, fp, 1 , myIter, myThid )
                0192         ENDIF
c121b6d611 Jean*0193         IF ( atm_cplExch_SaltPl ) THEN
                0194          CALL READ_MFLDS_3D_RL('sltPlmFx', saltPlmFlx_cpl,
                0195      &                                 nj, fp, 1 , myIter, myThid )
                0196         ENDIF
d1469cc589 Jean*0197 #endif /* ALLOW_THSICE */
                0198 #ifdef ALLOW_AIM
                0199         IF ( atm_cplExch_DIC ) THEN
                0200          CALL READ_MFLDS_3D_RL('atm-CO2 ', airCO2,
                0201      &                                 nj, fp, 1 , myIter, myThid )
                0202          CALL READ_MFLDS_3D_RL('wndSpeed', sWSpeed,
                0203      &                                 nj, fp, 1 , myIter, myThid )
                0204         ENDIF
                0205 #endif /* ALLOW_AIM */
                0206 
                0207 C--    end: new way to read pickup file
                0208        ENDIF
                0209 
                0210 C--    Check for missing fields:
                0211        nMissing = missFldDim
                0212        CALL READ_MFLDS_CHECK(
                0213      O                     missFldList,
                0214      U                     nMissing,
                0215      I                     myIter, myThid )
                0216        IF ( nMissing.GT.missFldDim ) THEN
                0217          WRITE(msgBuf,'(2A,I4)') 'ATM_CPL_READ_PICKUP: ',
                0218      &     'missing fields list has been truncated to', missFldDim
                0219          CALL PRINT_ERROR( msgBuf, myThid )
                0220          CALL ALL_PROC_DIE( myThid )
                0221          STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP (list-size Pb)'
                0222        ENDIF
                0223        IF ( nMissing.GE.1 ) THEN
                0224         ioUnit = errorMessageUnit
                0225         DO j=1,nMissing
                0226          WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ',
                0227      &       'cannot restart without field "',missFldList(nj),'"'
                0228          CALL PRINT_ERROR( msgBuf, myThid )
                0229         ENDDO
                0230         CALL ALL_PROC_DIE( myThid )
                0231         STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP'
                0232        ENDIF
                0233 
                0234 C--    Update overlap regions:
                0235 
                0236 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d39233fbd8 Jean*0237 
44ff40f0ae Jean*0238       IF ( cpl_oldPickup ) THEN
d39233fbd8 Jean*0239         _BARRIER
                0240 C-    EmP & RunOff were (before checkpoint59h) in m/s , but are now in kg/m2/s:
                0241         DO bj = myByLo(myThid), myByHi(myThid)
                0242          DO bi = myBxLo(myThid), myBxHi(myThid)
44ff40f0ae Jean*0243           DO j=1-OLy,sNy+OLy
                0244            DO i=1-OLx,sNx+OLx
d39233fbd8 Jean*0245             EvMPrFlux (i,j,bi,bj) = EvMPrFlux (i,j,bi,bj)*rhoConstFresh
d1469cc589 Jean*0246 #ifdef ALLOW_LAND
d39233fbd8 Jean*0247             RunOffFlux(i,j,bi,bj) = RunOffFlux(i,j,bi,bj)*rhoConstFresh
d1469cc589 Jean*0248 #endif /* ALLOW_LAND */
d39233fbd8 Jean*0249            ENDDO
                0250           ENDDO
                0251          ENDDO
                0252         ENDDO
5a2fc21c93 Jean*0253       ENDIF
                0254 
                0255 #endif /* COMPONENT_MODULE */
                0256 
                0257       RETURN
                0258       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!