pkg/seaice/seaice_read_pickup.F

ae125ba74b Jean*0001 #include "SEAICE_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: SEAICE_READ_PICKUP
                0005 C     !INTERFACE:
                0006       SUBROUTINE SEAICE_READ_PICKUP ( myThid )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE SEAICE_READ_PICKUP
                0011 C     | o Read in sea ice pickup file for restarting.
                0012 C     *==========================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017
                0018 C     == Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
ccaa3c61f4 Patr*0022 #include "SEAICE_SIZE.h"
ae125ba74b Jean*0023 #include "SEAICE_PARAMS.h"
                0024 #include "SEAICE.h"
ccaa3c61f4 Patr*0025 #include "SEAICE_TRACER.h"
ae125ba74b Jean*0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine arguments ==
                0029 C     myThid :: My Thread Id. number
                0030       INTEGER myThid
                0031
                0032 C     !LOCAL VARIABLES:
                0033 C     == Local variables ==
                0034 C     fp          :: pickup-file precision
                0035 C     fn          :: Temp. for building file name.
                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     nj          :: record & field number
                0042 C     ioUnit      :: temp for writing msg unit
                0043 C     msgBuf      :: Informational/error message buffer
                0044 C     i,j,k       :: loop indices
                0045 C     bi,bj       :: tile indices
                0046       INTEGER fp
af20bc5e19 Jean*0047       CHARACTER*(10) suff
ae125ba74b Jean*0048       CHARACTER*(MAX_LEN_FNAM) fn
                0049       INTEGER filePrec, nbFields
                0050       INTEGER missFldDim, nMissing
                0051       PARAMETER( missFldDim = 20 )
edfdf5fa1d Jean*0052       CHARACTER*(8) missFldList(missFldDim)
ae125ba74b Jean*0053       INTEGER nj, ioUnit
                0054       CHARACTER*(MAX_LEN_MBUF) msgBuf
f5282c5b03 Gael*0055       INTEGER i,j,k,bi,bj
2d5ef26c04 Jean*0056       LOGICAL doMapTice
e54fe3e1f9 Gael*0057 #ifdef ALLOW_SITRACER
edfdf5fa1d Jean*0058       CHARACTER*(8) fldName
db9e76d550 Jean*0059       INTEGER iTrac
edfdf5fa1d Jean*0060 #endif
ae125ba74b Jean*0061 CEOP
                0062
af20bc5e19 Jean*0063       IF ( pickupSuff .EQ. ' ' ) THEN
                0064         IF ( rwSuffixType.EQ.0 ) THEN
                0065           WRITE(fn,'(A,I10.10)') 'pickup_seaice.', nIter0
                0066         ELSE
                0067           CALL RW_GET_SUFFIX( suff, startTime, nIter0, myThid )
                0068           WRITE(fn,'(A,A)') 'pickup_seaice.', suff
                0069         ENDIF
ae125ba74b Jean*0070       ELSE
af20bc5e19 Jean*0071         WRITE(fn,'(A,A10)') 'pickup_seaice.', pickupSuff
ae125ba74b Jean*0072       ENDIF
                0073       fp = precFloat64
2d5ef26c04 Jean*0074       doMapTice = .FALSE.
ae125ba74b Jean*0075
                0076 C     Going to really do some IO. Make everyone except master thread wait.
                0077       _BARRIER
                0078
                0079 c     IF ( seaice_pickup_read_mdsio ) THEN
                0080
                0081 C--    Read meta file (if exist) and prepare for reading Multi-Fields file
                0082        CALL READ_MFLDS_SET(
                0083      I                      fn,
                0084      O                      nbFields, filePrec,
f913c5a485 Mart*0085      I                      nITD, nIter0, myThid )
ae125ba74b Jean*0086
                0087        _BEGIN_MASTER( myThid )
                0088        IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
                0089          WRITE(msgBuf,'(2A,I4)') 'SEAICE_READ_PICKUP: ',
                0090      &    'pickup-file binary precision do not match !'
                0091          CALL PRINT_ERROR( msgBuf, myThid )
                0092          WRITE(msgBuf,'(A,2(A,I4))') 'SEAICE_READ_PICKUP: ',
                0093      &    'file prec.=', filePrec, ' but expecting prec.=', fp
                0094          CALL PRINT_ERROR( msgBuf, myThid )
                0095          STOP 'ABNORMAL END: S/R SEAICE_READ_PICKUP (data-prec Pb)'
                0096        ENDIF
                0097        _END_MASTER( myThid )
                0098
                0099 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0100
                0101        IF ( nbFields.LE.0 ) THEN
                0102 C-      No meta-file or old meta-file without List of Fields
                0103         ioUnit = errorMessageUnit
                0104         IF ( pickupStrictlyMatch ) THEN
                0105           WRITE(msgBuf,'(4A)') 'SEAICE_READ_PICKUP: ',
                0106      &      'no field-list found in meta-file',
737e70e679 Mart*0107      &      ' => cannot check for strict-matching'
ae125ba74b Jean*0108           CALL PRINT_ERROR( msgBuf, myThid )
                0109           WRITE(msgBuf,'(4A)') 'SEAICE_READ_PICKUP: ',
                0110      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0111      &      ' in file: "data", NameList: "PARM03"'
                0112           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0113           STOP 'ABNORMAL END: S/R SEAICE_READ_PICKUP'
                0114         ELSE
                0115           WRITE(msgBuf,'(4A)') 'WARNING >> SEAICE_READ_PICKUP: ',
                0116      &      ' no field-list found'
                0117           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0118          IF ( nbFields.EQ.-1 ) THEN
                0119 C-      No meta-file
                0120           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0121      &      ' try to read pickup as currently written'
                0122           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0123          ELSE
                0124 C-      Old meta-file without List of Fields
                0125           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0126      &      ' try to read pickup as it used to be written'
                0127           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0128           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0129      &      ' until checkpoint59j (2007 Nov 25)'
                0130           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0131          ENDIF
                0132         ENDIF
                0133        ENDIF
                0134
                0135 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0136
                0137 C---   Old way to read seaice fields:
                0138        IF ( nbFields.EQ.0 ) THEN
                0139
                0140 C--    Read ice model fields
                0141         nj = 1
f5282c5b03 Gael*0142         IF (SEAICE_multDim.GT.1) THEN
f913c5a485 Mart*0143          CALL READ_REC_3D_RL( fn,fp,nITD, TICES, nj,nIter0,myThid )
                0144          nj = nj + nITD
f5282c5b03 Gael*0145         ELSE
2d5ef26c04 Jean*0146          doMapTice = .TRUE.
f913c5a485 Mart*0147          CALL READ_REC_LEV_RL( fn, fp, nITD,1,1, TICES,
2d5ef26c04 Jean*0148      I                         nj, nIter0, myThid )
f5282c5b03 Gael*0149          nj = nj + 1
                0150         ENDIF
ae125ba74b Jean*0151         nj = nj + 1
                0152         CALL READ_REC_3D_RL( fn, fp, 1, HSNOW    , nj, nIter0, myThid )
                0153         nj = nj + 1
772590b63c Mart*0154         CALL READ_REC_3D_RL( fn, fp, 1, UICE    , nj, nIter0, myThid )
1627bd241d Oliv*0155         nj = nj + 3
772590b63c Mart*0156         CALL READ_REC_3D_RL( fn, fp, 1, VICE    , nj, nIter0, myThid )
1627bd241d Oliv*0157         nj = nj + 3
772590b63c Mart*0158         CALL READ_REC_3D_RL( fn, fp, 1, HEFF    , nj, nIter0, myThid )
1627bd241d Oliv*0159         nj = nj + 3
772590b63c Mart*0160         CALL READ_REC_3D_RL( fn, fp, 1, AREA    , nj, nIter0, myThid )
1627bd241d Oliv*0161         nj = nj + 3
86b84a92fc Patr*0162 #ifdef SEAICE_ITD
                0163 C--     no ITD information available with old pickup files
                0164 C       use log-normal distribution based on mean thickness instead
                0165         CALL SEAICE_ITD_PICKUP( nIter0, myThid )
                0166 #endif
ae125ba74b Jean*0167 #if (defined(SEAICE_CGRID) && defined(SEAICE_ALLOW_EVP))
                0168         IF ( SEAICEuseEVP .AND. SEAICEuseEVPpickup ) THEN
                0169          CALL READ_REC_3D_RL(fn,fp,1,seaice_sigma1,nj, nIter0, myThid )
                0170          nj = nj + 1
                0171          CALL READ_REC_3D_RL(fn,fp,1,seaice_sigma2,nj, nIter0, myThid )
                0172          nj = nj + 1
                0173          CALL READ_REC_3D_RL(fn,fp,1,seaice_sigma12,nj,nIter0, myThid )
                0174          nj = nj + 1
                0175         ENDIF
                0176 #endif /* SEAICE_ALLOW_EVP */
a98c4b8072 Ian *0177 #ifdef SEAICE_VARIABLE_SALINITY
ae125ba74b Jean*0178         CALL READ_REC_3D_RL( fn, fp, 1, HSALT    , nj, nIter0, myThid )
f681b7f5d4 Dimi*0179         nj = nj + 1
                0180 #endif
ae125ba74b Jean*0181
                0182        ELSE
                0183 C---   New way to read model fields:
                0184          nj = 0
                0185 C--    read Sea-Ice Thermodynamics State variables, starting with 3-D fields:
                0186         IF ( .NOT.useThSIce ) THEN
5e0369b6fa Mart*0187          IF (SEAICE_multDim.GT.1) THEN
                0188           CALL READ_MFLDS_3D_RL( 'siTICES ', TICES,
f913c5a485 Mart*0189      &                                nj, fp, nITD, nIter0, myThid )
                0190           nj = nj*nITD
5e0369b6fa Mart*0191           IF ( nj.EQ.0 ) THEN
2d5ef26c04 Jean*0192            doMapTice = .TRUE.
                0193            CALL READ_MFLDS_LEV_RL( 'siTICE  ', TICES,
f913c5a485 Mart*0194      &                            nj, fp, nITD,1,1, nIter0, myThid )
5e0369b6fa Mart*0195           ENDIF
                0196          ELSE
                0197 C     SEAICE_multDim.EQ.1
2d5ef26c04 Jean*0198           doMapTice = .TRUE.
                0199           CALL READ_MFLDS_LEV_RL( 'siTICE  ', TICES,
f913c5a485 Mart*0200      &                            nj, fp, nITD,1,1, nIter0, myThid )
5e0369b6fa Mart*0201           IF ( nj.EQ.0 ) THEN
2d5ef26c04 Jean*0202            CALL READ_MFLDS_LEV_RL( 'siTICES ', TICES,
f913c5a485 Mart*0203      &                            nj, fp, nITD,1,1, nIter0, myThid )
5e0369b6fa Mart*0204           ENDIF
ae125ba74b Jean*0205          ENDIF
                0206 C--    continue with 2-D fields:
86b84a92fc Patr*0207 #ifdef SEAICE_ITD
                0208          CALL READ_MFLDS_3D_RL( 'siAREAn ', AREAITD,
                0209      &                                   nj, fp, nITD, nIter0, myThid )
346a7f9e71 Jean*0210          IF ( nj.EQ.0 ) THEN
                0211 C        no multi-category fields available
86b84a92fc Patr*0212 C        -> read average fields ...
                0213 #endif
772590b63c Mart*0214          CALL READ_MFLDS_3D_RL( 'siAREA  ', AREA,
                0215      &                                      nj, fp, 1, nIter0, myThid )
                0216          CALL READ_MFLDS_3D_RL( 'siHEFF  ', HEFF,
                0217      &                                      nj, fp, 1, nIter0, myThid )
ae125ba74b Jean*0218          CALL READ_MFLDS_3D_RL( 'siHSNOW ', HSNOW,
                0219      &                                      nj, fp, 1, nIter0, myThid )
86b84a92fc Patr*0220 #ifdef SEAICE_ITD
                0221 C        ... and redistribute over categories
                0222 C            assuming a log-normal distribtuion
                0223           CALL SEAICE_ITD_PICKUP( nIter0, myThid )
                0224 C
346a7f9e71 Jean*0225          ELSE
                0226 C        multi-category fields available, continue reading
86b84a92fc Patr*0227           CALL READ_MFLDS_3D_RL( 'siHEFFn ', HEFFITD,
                0228      &                                   nj, fp, nITD, nIter0, myThid )
                0229           CALL READ_MFLDS_3D_RL( 'siHSNOWn ', HSNOWITD,
                0230      &                                   nj, fp, nITD, nIter0, myThid )
                0231 C        update total ice area as well as mean ice and snow thickness
                0232           DO bj=myByLo(myThid),myByHi(myThid)
                0233            DO bi=myBxLo(myThid),myBxHi(myThid)
ec3fe6af4c Jean*0234             CALL SEAICE_ITD_SUM( bi, bj, startTime, nIter0, myThid )
86b84a92fc Patr*0235            ENDDO
                0236           ENDDO
346a7f9e71 Jean*0237          ENDIF
86b84a92fc Patr*0238 #endif
a98c4b8072 Ian *0239 #ifdef SEAICE_VARIABLE_SALINITY
ae125ba74b Jean*0240          CALL READ_MFLDS_3D_RL( 'siHSALT ', HSALT,
                0241      &                                      nj, fp, 1, nIter0, myThid )
                0242 #endif
c284306958 Patr*0243 #ifdef ALLOW_SITRACER
38cfb58d85 Gael*0244          DO iTrac = 1, SItrNumInUse
c284306958 Patr*0245           WRITE(fldName,'(A6,I2.2)') 'siTrac', iTrac
                0246           CALL READ_MFLDS_3D_RL( fldName,
db9e76d550 Jean*0247      &         SItracer(1-OLx,1-OLy,1,1,iTrac),
c284306958 Patr*0248      &         nj, fp, 1, nIter0, myThid )
db9e76d550 Jean*0249           _EXCH_XY_RL(SItracer(1-OLx,1-OLy,1,1,iTrac),myThid)
c284306958 Patr*0250          ENDDO
                0251 #endif /* ALLOW_SITRACER */
                0252
ae125ba74b Jean*0253         ENDIF
                0254
                0255 C--    read Sea-Ice Dynamics variables (all 2-D fields):
772590b63c Mart*0256          CALL READ_MFLDS_3D_RL( 'siUICE  ', UICE,
                0257      &                                      nj, fp, 1, nIter0, myThid )
                0258          CALL READ_MFLDS_3D_RL( 'siVICE  ', VICE,
                0259      &                                      nj, fp, 1, nIter0, myThid )
e501eee760 Mart*0260          IF ( SEAICEuseBDF2 ) THEN
6cbc659de0 Mart*0261           CALL READ_MFLDS_3D_RL('siUicNm1', uIceNm1,
                0262      &                                      nj, fp, 1, nIter0, myThid )
                0263           CALL READ_MFLDS_3D_RL('siVicNm1', vIceNm1,
                0264      &                                      nj, fp, 1, nIter0, myThid )
                0265          ENDIF
ae125ba74b Jean*0266 #if (defined(SEAICE_CGRID) && defined(SEAICE_ALLOW_EVP))
                0267         IF ( SEAICEuseEVP ) THEN
                0268          CALL READ_MFLDS_3D_RL( 'siSigm1 ', seaice_sigma1,
                0269      &                                      nj, fp, 1, nIter0, myThid )
                0270          CALL READ_MFLDS_3D_RL( 'siSigm2 ', seaice_sigma2,
                0271      &                                      nj, fp, 1, nIter0, myThid )
                0272          CALL READ_MFLDS_3D_RL( 'siSigm12', seaice_sigma12,
                0273      &                                      nj, fp, 1, nIter0, myThid )
                0274         ENDIF
                0275 #endif /* SEAICE_CGRID & SEAICE_ALLOW_EVP */
                0276
                0277 C---   end: new way to read pickup file
                0278        ENDIF
                0279
                0280 C--    Check for missing fields:
                0281        nMissing = missFldDim
                0282        CALL READ_MFLDS_CHECK(
                0283      O                    missFldList,
                0284      U                    nMissing,
                0285      I                    nIter0, myThid )
                0286        IF ( nMissing.GT.missFldDim ) THEN
                0287          WRITE(msgBuf,'(2A,I4)') 'SEAICE_READ_PICKUP: ',
                0288      &     'missing fields list has been truncated to', missFldDim
                0289          CALL PRINT_ERROR( msgBuf, myThid )
                0290          STOP 'ABNORMAL END: S/R SEAICE_READ_PICKUP (list-size Pb)'
                0291        ENDIF
                0292        CALL SEAICE_CHECK_PICKUP(
                0293      I                    missFldList,
                0294      I                    nMissing, nbFields,
                0295      I                    nIter0, myThid )
                0296
                0297 C--   end: seaice_pickup_read_mdsio
                0298 c     ENDIF
                0299
                0300 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0301
2d5ef26c04 Jean*0302        IF ( doMapTice ) THEN
                0303 C      copy TICES(k=1) to TICES(k)
                0304          DO bj=myByLo(myThid),myByHi(myThid)
                0305           DO bi=myBxLo(myThid),myBxHi(myThid)
f913c5a485 Mart*0306            DO k=2,nITD
2d5ef26c04 Jean*0307             DO j=1,sNy
                0308              DO i=1,sNx
                0309                TICES(i,j,k,bi,bj) = TICES(i,j,1,bi,bj)
                0310              ENDDO
                0311             ENDDO
                0312            ENDDO
                0313           ENDDO
                0314          ENDDO
                0315        ENDIF
                0316
ae125ba74b Jean*0317 C--    Update overlap regions
772590b63c Mart*0318        CALL EXCH_UV_XY_RL( uIce, vIce,.TRUE.,myThid)
                0319        _EXCH_XY_RL( HEFF, myThid )
                0320        _EXCH_XY_RL( AREA, myThid )
f913c5a485 Mart*0321        CALL EXCH_3D_RL( TICES, nITD, myThid )
7163a40534 Jean*0322        _EXCH_XY_RL(HSNOW, myThid )
ae125ba74b Jean*0323 #if (defined(SEAICE_CGRID) && defined(SEAICE_ALLOW_EVP))
                0324        IF ( SEAICEuseEVP ) THEN
7163a40534 Jean*0325           _EXCH_XY_RL(seaice_sigma1 , myThid )
                0326           _EXCH_XY_RL(seaice_sigma2 , myThid )
                0327           _EXCH_XY_RL(seaice_sigma12, myThid )
ae125ba74b Jean*0328        ENDIF
                0329 #endif /* SEAICE_CGRID SEAICE_ALLOW_EVP */
a98c4b8072 Ian *0330 #ifdef SEAICE_VARIABLE_SALINITY
7163a40534 Jean*0331        _EXCH_XY_RL(HSALT, myThid )
ae125ba74b Jean*0332 #endif
96c0cb3f00 Mart*0333 #ifdef SEAICE_ITD
                0334        CALL EXCH_3D_RL( HEFFITD,  nITD, myThid )
                0335        CALL EXCH_3D_RL( AREAITD,  nITD, myThid )
                0336        CALL EXCH_3D_RL( HSNOWITD, nITD, myThid )
                0337 #endif /* SEAICE_ITD */
ae125ba74b Jean*0338
                0339       RETURN
                0340       END