pkg/streamice/streamice_read_pickup.F

97c7a8be8b Jean*0001 #include "STREAMICE_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: STREAMICE_READ_PICKUP
                0006
                0007 C     !INTERFACE:
eaf63fbcc2 Dani*0008       SUBROUTINE STREAMICE_READ_PICKUP( myThid )
97c7a8be8b Jean*0009
                0010 C     !DESCRIPTION:
                0011 C     Reads current state of STREAMICE 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 "STREAMICE.h"
                0019
                0020 C     !INPUT PARAMETERS:
                0021 C     myIter            :: time-step number
                0022 C     myThid            :: thread number
                0023       INTEGER myIter
                0024       INTEGER myThid
                0025
                0026 #ifdef ALLOW_STREAMICE
                0027 C     !LOCAL VARIABLES:
                0028 C     fn          :: character buffer for creating filename
                0029 C     fp          :: precision of pickup files
                0030 C     filePrec    :: pickup-file precision (read from meta file)
                0031 C     nbFields    :: number of fields in pickup file (read from meta file)
                0032 C     missFldList :: List of missing fields   (attempted to read but not found)
                0033 C     missFldDim  :: Dimension of missing fields list array: missFldList
                0034 C     nMissing    :: Number of missing fields (attempted to read but not found)
                0035 C     j           :: loop index
                0036 C     nj          :: record number
                0037 C     ioUnit      :: temp for writing msg unit
                0038 C     msgBuf      :: Informational/error message buffer
                0039       INTEGER fp
                0040       INTEGER filePrec, nbFields
                0041       INTEGER missFldDim, nMissing
                0042       INTEGER j, nj, ioUnit
                0043       PARAMETER( missFldDim = 12 )
                0044       CHARACTER*(MAX_LEN_FNAM) fn
                0045       CHARACTER*(8) missFldList(missFldDim)
                0046       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0047 CEOP
                0048
                0049 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0050
                0051        IF ( pickupSuff.EQ.' ' ) THEN
eaf63fbcc2 Dani*0052         WRITE(fn,'(A,I10.10)') 'pickup_streamice.',nIter0
97c7a8be8b Jean*0053        ELSE
                0054         WRITE(fn,'(A,A10)')    'pickup_streamice.',pickupSuff
                0055        ENDIF
                0056        fp = precFloat64
                0057
                0058        CALL READ_MFLDS_SET(
                0059      I                      fn,
                0060      O                      nbFields, filePrec,
eaf63fbcc2 Dani*0061      I                      Nr, nIter0, myThid )
                0062
97c7a8be8b Jean*0063        _BEGIN_MASTER( myThid )
                0064        IF ( nbFields.GE.0 .AND. filePrec.NE.fp ) THEN
                0065          WRITE(msgBuf,'(2A,I4)') 'STREAMICE_READ_PICKUP: ',
                0066      &    'pickup-file binary precision do not match !'
                0067          CALL PRINT_ERROR( msgBuf, myThid )
                0068          WRITE(msgBuf,'(A,2(A,I4))') 'STREAMICE_READ_PICKUP: ',
                0069      &    'file prec.=', filePrec, ' but expecting prec.=', fp
                0070          CALL PRINT_ERROR( msgBuf, myThid )
                0071          CALL ALL_PROC_DIE( 0 )
                0072          STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP (data-prec Pb)'
                0073        ENDIF
                0074        _END_MASTER( myThid )
                0075
                0076        IF ( nbFields.LE.0 ) THEN
                0077 C-      No meta-file or old meta-file without List of Fields
                0078         ioUnit = errorMessageUnit
                0079         IF ( pickupStrictlyMatch ) THEN
                0080           WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
                0081      &      'no field-list found in meta-file',
                0082      &      ' => cannot check for strick-matching'
                0083           CALL PRINT_ERROR( msgBuf, myThid )
                0084           WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
                0085      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0086      &      ' in file: "data", NameList: "PARM03"'
                0087           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0088           CALL ALL_PROC_DIE( myThid )
                0089           STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP'
                0090         ELSE
                0091           WRITE(msgBuf,'(4A)') 'WARNING >> STREAMICE_READ_PICKUP: ',
                0092      &      ' no field-list found'
                0093           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0094          IF ( nbFields.EQ.-1 ) THEN
                0095 C-      No meta-file
                0096           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0097      &      ' try to read pickup as currently written'
                0098           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0099          ELSE
                0100 C-      Old meta-file without List of Fields
                0101 c         WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0102 c    &      ' try to read pickup as it used to be written'
                0103 c         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0104 c         WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0105 c    &      ' until checkpoint59l (2007 Dec 17)'
                0106 c         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0107           WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
                0108      &      'no field-list found in meta-file'
                0109           CALL PRINT_ERROR( msgBuf, myThid )
                0110           CALL ALL_PROC_DIE( myThid )
                0111           STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP'
                0112          ENDIF
                0113         ENDIF
                0114        ENDIF
                0115
                0116 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0117
                0118        IF ( nbFields.EQ.0 ) THEN
                0119 C---   Old way to read pickup:
                0120
                0121        ELSE
                0122 C---   New way to read STREAMICE pickup:
                0123         nj = 0
                0124 C---    read STREAMICE 3-D fields for restart
                0125 #ifdef STREAMICE_HYBRID_STRESS
                0126         CALL READ_MFLDS_3D_RL( 'visc3d  ', visc_streamice_full,
                0127      &                                 nj, fp, Nr, myIter, myThid )
                0128 #endif /* STREAMICE_HYBRID_STRESS */
                0129         nj = nj*Nr
                0130 C---    read STREAMICE 2-D fields for restart
eaf63fbcc2 Dani*0131
97c7a8be8b Jean*0132         CALL READ_MFLDS_3D_RL( 'SI_area ', area_shelf_streamice,
                0133      &                                 nj, fp, 1 , myIter, myThid )
7360cc2681 Jean*0134         CALL READ_MFLDS_LEV_RS('SI_hmask', STREAMICE_hmask,
                0135      &                            nj, fp, 1, 1, 1, myIter, myThid )
                0136         CALL READ_MFLDS_3D_RL( 'SI_uvel ', U_streamice,
eaf63fbcc2 Dani*0137      &                                 nj, fp, 1 , myIter, myThid )
7360cc2681 Jean*0138         CALL READ_MFLDS_3D_RL( 'SI_vvel ', V_streamice,
eaf63fbcc2 Dani*0139      &                                 nj, fp, 1 , myIter, myThid )
7360cc2681 Jean*0140         CALL READ_MFLDS_3D_RL( 'SI_thick', H_streamice,
eaf63fbcc2 Dani*0141      &                                 nj, fp, 1 , myIter, myThid )
                0142         CALL READ_MFLDS_3D_RL( 'SI_betaF', tau_beta_eff_streamice,
                0143      &                                 nj, fp, 1 , myIter, myThid )
                0144         CALL READ_MFLDS_3D_RL( 'SI_visc ', visc_streamice,
                0145      &                                 nj, fp, 1 , myIter, myThid )
                0146
                0147 #ifdef STREAMICE_HYBRID_STRESS
                0148         CALL READ_MFLDS_3D_RL( 'SI_taubx', streamice_taubx,
                0149      &                                 nj, fp, 1 , myIter, myThid )
                0150         CALL READ_MFLDS_3D_RL( 'SI_tauby', streamice_tauby,
                0151      &                                 nj, fp, 1 , myIter, myThid )
                0152 #endif
                0153
97c7a8be8b Jean*0154 C--    end: new way to read pickup file
                0155        ENDIF
                0156
                0157 C--    Check for missing fields:
                0158        nMissing = missFldDim
                0159        CALL READ_MFLDS_CHECK(
                0160      O                     missFldList,
                0161      U                     nMissing,
                0162      I                     myIter, myThid )
                0163        IF ( nMissing.GT.missFldDim ) THEN
                0164          WRITE(msgBuf,'(2A,I4)') 'STREAMICE_READ_PICKUP: ',
                0165      &     'missing fields list has been truncated to', missFldDim
                0166          CALL PRINT_ERROR( msgBuf, myThid )
                0167          CALL ALL_PROC_DIE( myThid )
                0168          STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP (list-size Pb)'
                0169        ENDIF
                0170        IF ( nMissing.GE.1 ) THEN
                0171         ioUnit = errorMessageUnit
                0172         DO j=1,nMissing
                0173          WRITE(msgBuf,'(4A)') 'STREAMICE_READ_PICKUP: ',
                0174      &       'cannot restart without field "',missFldList(nj),'"'
                0175          CALL PRINT_ERROR( msgBuf, myThid )
                0176         ENDDO
                0177         CALL ALL_PROC_DIE( myThid )
                0178         STOP 'ABNORMAL END: S/R STREAMICE_READ_PICKUP'
                0179        ENDIF
                0180
                0181 C--    Update overlap regions:
                0182 #ifdef STREAMICE_HYBRID_STRESS
                0183         CALL EXCH_3D_RL( visc_streamice_full, Nr, myThid )
                0184 #endif /* STREAMICE_HYBRID_STRESS */
                0185         CALL EXCH_XY_RL( area_shelf_streamice, myThid )
eaf63fbcc2 Dani*0186         CALL EXCH_XY_RL( h_streamice, myThid )
                0187         CALL EXCH_XY_RL( u_streamice, myThid )
                0188         CALL EXCH_XY_RL( v_streamice, myThid )
                0189         CALL EXCH_XY_RS( streamice_hmask, myThid )
                0190         CALL EXCH_XY_RL( tau_beta_eff_streamice, myThid )
                0191         CALL EXCH_XY_RL( visc_streamice, myThid )
                0192
97c7a8be8b Jean*0193 c       CALL EXCH_XY_RL( myPa_Surf2, myThid )
                0194
                0195 #endif /* ALLOW_STREAMICE */
                0196
                0197       RETURN
                0198       END