C $Header: /u/gcmpack/MITgcm/pkg/seaice/seaice_read_pickup.F,v 1.26 2017/03/24 23:51:14 jmc Exp $ C $Name: $ #include "SEAICE_OPTIONS.h" CBOP C !ROUTINE: SEAICE_READ_PICKUP C !INTERFACE: SUBROUTINE SEAICE_READ_PICKUP ( myThid ) C !DESCRIPTION: \bv C *==========================================================* C | SUBROUTINE SEAICE_READ_PICKUP C | o Read in sea ice pickup file for restarting. C *==========================================================* C \ev C !USES: IMPLICIT NONE C == Global variables === #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "SEAICE_SIZE.h" #include "SEAICE_PARAMS.h" #include "SEAICE.h" #include "SEAICE_TRACER.h" C !INPUT/OUTPUT PARAMETERS: C == Routine arguments == C myThid :: My Thread Id. number INTEGER myThid C !LOCAL VARIABLES: C == Local variables == C fp :: pickup-file precision C fn :: Temp. for building file name. 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 nj :: record & field number C ioUnit :: temp for writing msg unit C msgBuf :: Informational/error message buffer C i,j,k :: loop indices C bi,bj :: tile indices INTEGER fp CHARACTER*(10) suff CHARACTER*(MAX_LEN_FNAM) fn INTEGER filePrec, nbFields INTEGER missFldDim, nMissing PARAMETER( missFldDim = 20 ) CHARACTER*(8) missFldList(missFldDim) INTEGER nj, ioUnit CHARACTER*(MAX_LEN_MBUF) msgBuf INTEGER i,j,k,bi,bj LOGICAL doMapTice #ifdef ALLOW_SITRACER CHARACTER*(8) fldName INTEGER iTrac #endif CEOP IF ( pickupSuff .EQ. ' ' ) THEN IF ( rwSuffixType.EQ.0 ) THEN WRITE(fn,'(A,I10.10)') 'pickup_seaice.', nIter0 ELSE CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid ) WRITE(fn,'(A,A)') 'pickup_seaice.', suff ENDIF ELSE WRITE(fn,'(A,A10)') 'pickup_seaice.', pickupSuff ENDIF fp = precFloat64 doMapTice = .FALSE. C Going to really do some IO. Make everyone except master thread wait. _BARRIER c IF ( seaice_pickup_read_mdsio ) THEN C-- Read meta file (if exist) and prepare for reading Multi-Fields file CALL READ_MFLDS_SET( I fn, O nbFields, filePrec, I nITD, nIter0, myThid ) _BEGIN_MASTER( myThid ) IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN WRITE(msgBuf,'(2A,I4)') 'SEAICE_READ_PICKUP: ', & 'pickup-file binary precision do not match !' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(A,2(A,I4))') 'SEAICE_READ_PICKUP: ', & 'file prec.=', filePrec, ' but expecting prec.=', fp CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R SEAICE_READ_PICKUP (data-prec Pb)' ENDIF _END_MASTER( myThid ) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| 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)') 'SEAICE_READ_PICKUP: ', & 'no field-list found in meta-file', & ' => cannot check for strict-matching' CALL PRINT_ERROR( msgBuf, myThid ) WRITE(msgBuf,'(4A)') 'SEAICE_READ_PICKUP: ', & 'try with " pickupStrictlyMatch=.FALSE.,"', & ' in file: "data", NameList: "PARM03"' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) STOP 'ABNORMAL END: S/R SEAICE_READ_PICKUP' ELSE WRITE(msgBuf,'(4A)') 'WARNING >> SEAICE_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 checkpoint59j (2007 Nov 25)' CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) ENDIF ENDIF ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C--- Old way to read seaice fields: IF ( nbFields.EQ.0 ) THEN C-- Read ice model fields nj = 1 IF (SEAICE_multDim.GT.1) THEN CALL READ_REC_3D_RL( fn,fp,nITD, TICES, nj,nIter0,myThid ) nj = nj + nITD ELSE doMapTice = .TRUE. CALL READ_REC_LEV_RL( fn, fp, nITD,1,1, TICES, I nj, nIter0, myThid ) nj = nj + 1 ENDIF nj = nj + 1 CALL READ_REC_3D_RL( fn, fp, 1, HSNOW , nj, nIter0, myThid ) nj = nj + 1 CALL READ_REC_3D_RL( fn, fp, 1, UICE , nj, nIter0, myThid ) nj = nj + 3 CALL READ_REC_3D_RL( fn, fp, 1, VICE , nj, nIter0, myThid ) nj = nj + 3 CALL READ_REC_3D_RL( fn, fp, 1, HEFF , nj, nIter0, myThid ) nj = nj + 3 CALL READ_REC_3D_RL( fn, fp, 1, AREA , nj, nIter0, myThid ) nj = nj + 3 #ifdef SEAICE_ITD C-- no ITD information available with old pickup files C use log-normal distribution based on mean thickness instead CALL SEAICE_ITD_PICKUP( nIter0, myThid ) #endif #if (defined(SEAICE_CGRID) defined(SEAICE_ALLOW_EVP)) IF ( SEAICEuseEVP .AND. SEAICEuseEVPpickup ) THEN CALL READ_REC_3D_RL(fn,fp,1,seaice_sigma1,nj, nIter0, myThid ) nj = nj + 1 CALL READ_REC_3D_RL(fn,fp,1,seaice_sigma2,nj, nIter0, myThid ) nj = nj + 1 CALL READ_REC_3D_RL(fn,fp,1,seaice_sigma12,nj,nIter0, myThid ) nj = nj + 1 ENDIF #endif /* SEAICE_ALLOW_EVP */ #ifdef SEAICE_VARIABLE_SALINITY CALL READ_REC_3D_RL( fn, fp, 1, HSALT , nj, nIter0, myThid ) nj = nj + 1 #endif ELSE C--- New way to read model fields: nj = 0 C-- read Sea-Ice Thermodynamics State variables, starting with 3-D fields: IF ( .NOT.useThSIce ) THEN IF (SEAICE_multDim.GT.1) THEN CALL READ_MFLDS_3D_RL( 'siTICES ', TICES, & nj, fp, nITD, nIter0, myThid ) nj = nj*nITD IF ( nj.EQ.0 ) THEN doMapTice = .TRUE. CALL READ_MFLDS_LEV_RL( 'siTICE ', TICES, & nj, fp, nITD,1,1, nIter0, myThid ) ENDIF ELSE C SEAICE_multDim.EQ.1 doMapTice = .TRUE. CALL READ_MFLDS_LEV_RL( 'siTICE ', TICES, & nj, fp, nITD,1,1, nIter0, myThid ) IF ( nj.EQ.0 ) THEN CALL READ_MFLDS_LEV_RL( 'siTICES ', TICES, & nj, fp, nITD,1,1, nIter0, myThid ) ENDIF ENDIF C-- continue with 2-D fields: #ifdef SEAICE_ITD CALL READ_MFLDS_3D_RL( 'siAREAn ', AREAITD, & nj, fp, nITD, nIter0, myThid ) IF ( nj.EQ.0 ) THEN C no multi-category fields available C -> read average fields ... #endif CALL READ_MFLDS_3D_RL( 'siAREA ', AREA, & nj, fp, 1, nIter0, myThid ) CALL READ_MFLDS_3D_RL( 'siHEFF ', HEFF, & nj, fp, 1, nIter0, myThid ) CALL READ_MFLDS_3D_RL( 'siHSNOW ', HSNOW, & nj, fp, 1, nIter0, myThid ) #ifdef SEAICE_ITD C ... and redistribute over categories C assuming a log-normal distribtuion CALL SEAICE_ITD_PICKUP( nIter0, myThid ) C ELSE C multi-category fields available, continue reading CALL READ_MFLDS_3D_RL( 'siHEFFn ', HEFFITD, & nj, fp, nITD, nIter0, myThid ) CALL READ_MFLDS_3D_RL( 'siHSNOWn ', HSNOWITD, & nj, fp, nITD, nIter0, myThid ) C update total ice area as well as mean ice and snow thickness DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) CALL SEAICE_ITD_SUM( bi, bj, startTime, nIter0, myThid ) ENDDO ENDDO ENDIF #endif #ifdef SEAICE_VARIABLE_SALINITY CALL READ_MFLDS_3D_RL( 'siHSALT ', HSALT, & nj, fp, 1, nIter0, myThid ) #endif #ifdef ALLOW_SITRACER DO iTrac = 1, SItrNumInUse WRITE(fldName,'(A6,I2.2)') 'siTrac', iTrac CALL READ_MFLDS_3D_RL( fldName, & SItracer(1-OLx,1-OLy,1,1,iTrac), & nj, fp, 1, nIter0, myThid ) _EXCH_XY_RL(SItracer(1-OLx,1-OLy,1,1,iTrac),myThid) ENDDO #endif /* ALLOW_SITRACER */ ENDIF C-- read Sea-Ice Dynamics variables (all 2-D fields): CALL READ_MFLDS_3D_RL( 'siUICE ', UICE, & nj, fp, 1, nIter0, myThid ) CALL READ_MFLDS_3D_RL( 'siVICE ', VICE, & nj, fp, 1, nIter0, myThid ) IF ( SEAICEuseBDF2 ) THEN CALL READ_MFLDS_3D_RL('siUicNm1', uIceNm1, & nj, fp, 1, nIter0, myThid ) CALL READ_MFLDS_3D_RL('siVicNm1', vIceNm1, & nj, fp, 1, nIter0, myThid ) ENDIF #if (defined(SEAICE_CGRID) defined(SEAICE_ALLOW_EVP)) IF ( SEAICEuseEVP ) THEN CALL READ_MFLDS_3D_RL( 'siSigm1 ', seaice_sigma1, & nj, fp, 1, nIter0, myThid ) CALL READ_MFLDS_3D_RL( 'siSigm2 ', seaice_sigma2, & nj, fp, 1, nIter0, myThid ) CALL READ_MFLDS_3D_RL( 'siSigm12', seaice_sigma12, & nj, fp, 1, nIter0, myThid ) ENDIF #endif /* SEAICE_CGRID & SEAICE_ALLOW_EVP */ 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 nIter0, myThid ) IF ( nMissing.GT.missFldDim ) THEN WRITE(msgBuf,'(2A,I4)') 'SEAICE_READ_PICKUP: ', & 'missing fields list has been truncated to', missFldDim CALL PRINT_ERROR( msgBuf, myThid ) STOP 'ABNORMAL END: S/R SEAICE_READ_PICKUP (list-size Pb)' ENDIF CALL SEAICE_CHECK_PICKUP( I missFldList, I nMissing, nbFields, I nIter0, myThid ) C-- end: seaice_pickup_read_mdsio c ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| IF ( doMapTice ) THEN C copy TICES(k=1) to TICES(k) DO bj=myByLo(myThid),myByHi(myThid) DO bi=myBxLo(myThid),myBxHi(myThid) DO k=2,nITD DO j=1,sNy DO i=1,sNx TICES(i,j,k,bi,bj) = TICES(i,j,1,bi,bj) ENDDO ENDDO ENDDO ENDDO ENDDO ENDIF C-- Update overlap regions CALL EXCH_UV_XY_RL( uIce, vIce,.TRUE.,myThid) _EXCH_XY_RL( HEFF, myThid ) _EXCH_XY_RL( AREA, myThid ) CALL EXCH_3D_RL( TICES, nITD, myThid ) _EXCH_XY_RL(HSNOW, myThid ) #if (defined(SEAICE_CGRID) defined(SEAICE_ALLOW_EVP)) IF ( SEAICEuseEVP ) THEN _EXCH_XY_RL(seaice_sigma1 , myThid ) _EXCH_XY_RL(seaice_sigma2 , myThid ) _EXCH_XY_RL(seaice_sigma12, myThid ) ENDIF #endif /* SEAICE_CGRID SEAICE_ALLOW_EVP */ #ifdef SEAICE_VARIABLE_SALINITY _EXCH_XY_RL(HSALT, myThid ) #endif #ifdef SEAICE_ITD CALL EXCH_3D_RL( HEFFITD, nITD, myThid ) CALL EXCH_3D_RL( AREAITD, nITD, myThid ) CALL EXCH_3D_RL( HSNOWITD, nITD, myThid ) #endif /* SEAICE_ITD */ RETURN END