C $Header: /u/gcmpack/MITgcm/pkg/atm_compon_interf/atm_cpl_read_pickup.F,v 1.9 2017/03/24 23:31:41 jmc Exp $ C $Name: $ #include "ATM_CPL_OPTIONS.h" CBOP C !ROUTINE: ATM_CPL_READ_PICKUP C !INTERFACE: SUBROUTINE ATM_CPL_READ_PICKUP( myIter, myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE ATM_CPL_READ_PICKUP C | o Reads fields from a pickup file for a restart C *==========================================================* C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables == #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "CPL_PARAMS.h" #include "ATMCPL.h" C !INPUT/OUTPUT PARAMETERS: C myIter :: Current time-step number C myThid :: my Thread Id number INTEGER myIter INTEGER myThid #ifdef COMPONENT_MODULE C !LOCAL VARIABLES: C fn :: character buffer for creating filename C fp :: precision of pickup files C filePrec :: pickup-file precision (read from meta file) C nbFields :: number of fields in pickup file (read from meta file) C missFldList :: List of missing fields (attempted to read but not found) C missFldDim :: Dimension of missing fields list array: missFldList C nMissing :: Number of missing fields (attempted to read but not found) C j :: loop index C nj :: record number C ioUnit :: temp for writing msg unit C msgBuf :: Informational/error message buffer INTEGER fp INTEGER filePrec, nbFields INTEGER missFldDim, nMissing INTEGER j, nj, ioUnit PARAMETER( missFldDim = 18 ) CHARACTER*(10) suff CHARACTER*(MAX_LEN_FNAM) fn CHARACTER*(8) missFldList(missFldDim) CHARACTER*(MAX_LEN_MBUF) msgBuf INTEGER i, bi, bj CEOP C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF ( pickupSuff.EQ.' ' ) THEN IF ( rwSuffixType.EQ.0 ) THEN WRITE(fn,'(A,I10.10)') 'pickup_cpl.', myIter ELSE CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid ) WRITE(fn,'(A,A)') 'pickup_cpl.', suff ENDIF ELSE WRITE(fn,'(A,A10)') 'pickup_cpl.', pickupSuff ENDIF fp = precFloat64 CALL READ_MFLDS_SET( I fn, O nbFields, filePrec, I Nr, myIter, myThid ) _BEGIN_MASTER( myThid ) c IF ( filePrec.NE.0 .AND. filePrec.NE.fp ) THEN IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN WRITE(msgBuf,'(2A,I4)') 'ATM_CPL_READ_PICKUP: ', & 'pickup-file binary precision do not match !' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(A,2(A,I4))') 'ATM_CPL_READ_PICKUP: ', & 'file prec.=', filePrec, ' but expecting prec.=', fp CALL PRINT_ERROR( msgBuf, myThid ) CALL ALL_PROC_DIE( 0 ) STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP (data-prec Pb)' ENDIF _END_MASTER( myThid ) IF ( nbFields.LE.0 ) THEN C- No meta-file or old meta-file without List of Fields ioUnit = errorMessageUnit IF ( pickupStrictlyMatch ) THEN WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ', & 'no field-list found in meta-file', & ' => cannot check for strick-matching' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ', & 'try with " pickupStrictlyMatch=.FALSE.,"', & ' in file: "data", NameList: "PARM03"' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) CALL ALL_PROC_DIE( myThid ) STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP' ELSE WRITE(msgBuf,'(4A)') 'WARNING >> ATM_CPL_READ_PICKUP: ', & ' no field-list found' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) IF ( nbFields.EQ.-1 ) THEN C- No meta-file WRITE(msgBuf,'(4A)') 'WARNING >> ', & ' try to read pickup as currently written' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) ELSE C- Old meta-file without List of Fields WRITE(msgBuf,'(4A)') 'WARNING >> ', & ' try to read pickup as it used to be written' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) WRITE(msgBuf,'(4A)') 'WARNING >> ', & ' until checkpoint65r (2015 Dec 21)' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) c WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ', c & 'no field-list found in meta-file' c CALL PRINT_ERROR( msgBuf, myThid ) c CALL ALL_PROC_DIE( myThid ) c STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP' ENDIF ENDIF ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF ( nbFields.EQ.0 ) THEN C--- Old way to read pickup: c CALL READ_REC_3D_RL( fn, fp, 1, ocMxlD , 1, myIter,myThid ) c CALL READ_REC_3D_RL( fn, fp, 1, SSTocn , 2, myIter,myThid ) c CALL READ_REC_3D_RL( fn, fp, 1, SSSocn , 3, myIter,myThid ) c CALL READ_REC_3D_RL( fn, fp, 1, vSqocn , 4, myIter,myThid ) c CALL READ_REC_3D_RL( fn, fp, 1, atmSLPr , 5, myIter,myThid ) CALL READ_REC_3D_RL( fn, fp, 1, HeatFlux , 6, myIter,myThid ) CALL READ_REC_3D_RL( fn, fp, 1, qShortWave, 7, myIter,myThid ) CALL READ_REC_3D_RL( fn, fp, 1, tauX , 8, myIter,myThid ) CALL READ_REC_3D_RL( fn, fp, 1, tauY , 9, myIter,myThid ) CALL READ_REC_3D_RL( fn, fp, 1, EvMPrFlux , 10, myIter,myThid ) #ifdef ALLOW_LAND CALL READ_REC_3D_RL( fn, fp, 1, RunOffFlux, 11, myIter,myThid ) CALL READ_REC_3D_RL( fn, fp, 1, RunOffEnFx, 12, myIter,myThid ) #endif /* ALLOW_LAND */ #ifdef ALLOW_THSICE CALL READ_REC_3D_RL( fn, fp, 1, iceSaltFlx, 13, myIter,myThid ) c CALL READ_REC_3D_RL( fn, fp, 1, seaIceMass, 14, myIter,myThid ) #endif /* ALLOW_THSICE */ #ifdef ALLOW_AIM IF ( atm_cplExch_DIC ) THEN c CALL READ_REC_3D_RL( fn,fp, 1, flxCO2ocn , 15, myIter,myThid ) CALL READ_REC_3D_RL( fn,fp, 1, airCO2 , 16, myIter,myThid ) CALL READ_REC_3D_RL( fn,fp, 1, sWSpeed , 17, myIter,myThid ) # ifdef ALLOW_THSICE c CALL READ_REC_3D_RL( fn,fp,1,sIceFrac_cpl, 18, myIter,myThid ) # endif /* ALLOW_THSICE */ ENDIF #endif /* ALLOW_AIM */ ELSE C--- New way to read ATM_CPL pickup: nj = 0 C--- read ATM_CPL 3-D fields for restart nj = nj*Nr C--- read ATM_CPL 2-D fields for restart CALL READ_MFLDS_3D_RL( 'qHeatFlx', HeatFlux, & nj, fp, 1 , myIter, myThid ) CALL READ_MFLDS_3D_RL( 'qShortW ', qShortWave, & nj, fp, 1 , myIter, myThid ) CALL READ_MFLDS_3D_RL( 'surfTauX', tauX, & nj, fp, 1 , myIter, myThid ) CALL READ_MFLDS_3D_RL( 'surfTauY', tauY, & nj, fp, 1 , myIter, myThid ) CALL READ_MFLDS_3D_RL( 'Evp-Prec', EvMPrFlux, & nj, fp, 1 , myIter, myThid ) #ifdef ALLOW_LAND IF ( atm_cplExch_RunOff ) THEN CALL READ_MFLDS_3D_RL('RunOffFx', RunOffFlux, & nj, fp, 1 , myIter, myThid ) CALL READ_MFLDS_3D_RL('RnOfEnFx', RunOffEnFx, & nj, fp, 1 , myIter, myThid ) ENDIF #endif /* ALLOW_LAND */ #ifdef ALLOW_THSICE IF ( atm_cplExch1W_sIce ) THEN CALL READ_MFLDS_3D_RL('saltFlux', iceSaltFlx, & nj, fp, 1 , myIter, myThid ) ENDIF IF ( atm_cplExch_SaltPl ) THEN CALL READ_MFLDS_3D_RL('sltPlmFx', saltPlmFlx_cpl, & nj, fp, 1 , myIter, myThid ) ENDIF #endif /* ALLOW_THSICE */ #ifdef ALLOW_AIM IF ( atm_cplExch_DIC ) THEN CALL READ_MFLDS_3D_RL('atm-CO2 ', airCO2, & nj, fp, 1 , myIter, myThid ) CALL READ_MFLDS_3D_RL('wndSpeed', sWSpeed, & nj, fp, 1 , myIter, myThid ) ENDIF #endif /* ALLOW_AIM */ C-- end: new way to read pickup file ENDIF C-- Check for missing fields: nMissing = missFldDim CALL READ_MFLDS_CHECK( O missFldList, U nMissing, I myIter, myThid ) IF ( nMissing.GT.missFldDim ) THEN WRITE(msgBuf,'(2A,I4)') 'ATM_CPL_READ_PICKUP: ', & 'missing fields list has been truncated to', missFldDim CALL PRINT_ERROR( msgBuf, myThid ) CALL ALL_PROC_DIE( myThid ) STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP (list-size Pb)' ENDIF IF ( nMissing.GE.1 ) THEN ioUnit = errorMessageUnit DO j=1,nMissing WRITE(msgBuf,'(4A)') 'ATM_CPL_READ_PICKUP: ', & 'cannot restart without field "',missFldList(nj),'"' CALL PRINT_ERROR( msgBuf, myThid ) ENDDO CALL ALL_PROC_DIE( myThid ) STOP 'ABNORMAL END: S/R ATM_CPL_READ_PICKUP' ENDIF C-- Update overlap regions: C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF ( cpl_oldPickup ) THEN _BARRIER C- EmP & RunOff were (before checkpoint59h) in m/s , but are now in kg/m2/s: DO bj = myByLo(myThid), myByHi(myThid) DO bi = myBxLo(myThid), myBxHi(myThid) DO j=1-OLy,sNy+OLy DO i=1-OLx,sNx+OLx EvMPrFlux (i,j,bi,bj) = EvMPrFlux (i,j,bi,bj)*rhoConstFresh #ifdef ALLOW_LAND RunOffFlux(i,j,bi,bj) = RunOffFlux(i,j,bi,bj)*rhoConstFresh #endif /* ALLOW_LAND */ ENDDO ENDDO ENDDO ENDDO ENDIF #endif /* COMPONENT_MODULE */ RETURN END