Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:43:02 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
d217ad1db8 Oliv*0001 #include "GAD_OPTIONS.h"
785a077159 Alis*0002 #include "PTRACERS_OPTIONS.h"
                0003 
                0004 CBOP
33e25d6b04 Jean*0005 C     !ROUTINE: PTRACERS_READ_PICKUP
785a077159 Alis*0006 
d2825c6d08 Ed H*0007 C     !INTERFACE:
33e25d6b04 Jean*0008       SUBROUTINE PTRACERS_READ_PICKUP( myIter, myThid )
785a077159 Alis*0009 
d2825c6d08 Ed H*0010 C     !DESCRIPTION:
785a077159 Alis*0011 C     Reads current state of passive tracers from a pickup file
                0012 
d2825c6d08 Ed H*0013 C     !USES:
d217ad1db8 Oliv*0014 #include "PTRACERS_MOD.h"
785a077159 Alis*0015       IMPLICIT NONE
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
d217ad1db8 Oliv*0019 #include "GAD.h"
636477d15b Jean*0020 #include "PTRACERS_SIZE.h"
0a278985fd Jean*0021 #include "PTRACERS_PARAMS.h"
9b39915e34 Jean*0022 #include "PTRACERS_START.h"
0a278985fd Jean*0023 #include "PTRACERS_FIELDS.h"
785a077159 Alis*0024 
d2825c6d08 Ed H*0025 C     !INPUT PARAMETERS:
                0026 C     myIter            :: time-step number
                0027 C     myThid            :: thread number
785a077159 Alis*0028       INTEGER myIter
                0029       INTEGER myThid
                0030 
                0031 #ifdef ALLOW_PTRACERS
                0032 
d2825c6d08 Ed H*0033 C     !LOCAL VARIABLES:
804ee8c862 Jean*0034 C     iTracer     :: tracer index
                0035 C     iRec        :: record number
                0036 C     fn          :: character buffer for creating filename
                0037 C     prec        :: precision of pickup files
                0038 C     filePrec    :: pickup-file precision (read from meta file)
                0039 C     nbFields    :: number of fields in pickup file (read from meta file)
                0040 C     fldName     :: Name of the field to read
                0041 C     missFldList :: List of missing fields   (attempted to read but not found)
                0042 C     missFldDim  :: Dimension of missing fields list array: missFldList
                0043 C     nMissing    :: Number of missing fields (attempted to read but not found)
                0044 C     j           :: loop index
                0045 C     nj          :: record number
                0046 C     ioUnit      :: temp for writing msg unit
                0047 C     msgBuf      :: Informational/error message buffer
3ab6b68cec Jean*0048       INTEGER iTracer, iRec, prec
804ee8c862 Jean*0049       INTEGER filePrec, nbFields
                0050       INTEGER missFldDim, nMissing
                0051       INTEGER nj, ioUnit
                0052       PARAMETER( missFldDim = 2*PTRACERS_num )
af20bc5e19 Jean*0053       CHARACTER*(10) suff
d716b1e650 Jean*0054       CHARACTER*(MAX_LEN_FNAM) fn
804ee8c862 Jean*0055       CHARACTER*(8) fldName, missFldList(missFldDim)
                0056       CHARACTER*(MAX_LEN_MBUF) msgBuf
3ab6b68cec Jean*0057 #ifdef PTRACERS_ALLOW_DYN_STATE
d390b9846d Jean*0058       CHARACTER*(MAX_LEN_FNAM) filNam
                0059       LOGICAL useCurrentDir, fileExist
3ab6b68cec Jean*0060       INTEGER n
                0061 #endif
785a077159 Alis*0062 CEOP
                0063 
3ab6b68cec Jean*0064 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d197c88195 Jean*0065 
d2825c6d08 Ed H*0066 #ifdef ALLOW_MNC
50653b81f1 Ed H*0067       IF ( PTRACERS_pickup_read_mnc ) THEN
                0068 C       Read variables from the pickup file
5bc9611487 Ed H*0069         WRITE(fn,'(a)') 'pickup_ptracers'
                0070         CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
                0071         CALL MNC_CW_SET_UDIM(fn, 1, myThid)
                0072         CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
804ee8c862 Jean*0073         DO iTracer = 1, PTRACERS_numInUse
5bc9611487 Ed H*0074           CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
0a278985fd Jean*0075      &         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),myThid)
9b39915e34 Jean*0076           CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0077      &                     Nr, myThid )
a0c367ffaa Mart*0078         ENDDO
5bc9611487 Ed H*0079         CALL MNC_CW_SET_UDIM(fn, 2, myThid)
804ee8c862 Jean*0080         DO iTracer = 1, PTRACERS_numInUse
5bc9611487 Ed H*0081           CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
50653b81f1 Ed H*0082      &         pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)
9b39915e34 Jean*0083           CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0084      &                     Nr, myThid )
a0c367ffaa Mart*0085         ENDDO
50653b81f1 Ed H*0086       ENDIF
d217ad1db8 Oliv*0087       IF ( useMNC .AND. PTRACERS_pickup_read_mnc ) THEN
                0088        DO iTracer = 1, PTRACERS_numInUse
                0089         IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
                0090          WRITE(msgBuf,'(3A)')'PTRACERS_READ_PICKUP: MNC not yet coded',
                0091      &                       ' for SOM advection',
                0092      &                       ' => read bin file instead'
                0093          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0094      &                       SQUEEZE_RIGHT, myThid)
                0095         ENDIF
                0096        ENDDO
                0097       ENDIF
d2825c6d08 Ed H*0098 #endif /*  ALLOW_MNC  */
d197c88195 Jean*0099 
804ee8c862 Jean*0100 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0101 
d390b9846d Jean*0102       IF ( PTRACERS_pickup_read_mdsio ) THEN
                0103 
804ee8c862 Jean*0104        IF ( pickupSuff.EQ.' ' ) THEN
af20bc5e19 Jean*0105         IF ( rwSuffixType.EQ.0 ) THEN
                0106           WRITE(fn,'(A,I10.10)') 'pickup_ptracers.', myIter
                0107         ELSE
                0108           CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0109           WRITE(fn,'(A,A)') 'pickup_ptracers.', suff
                0110         ENDIF
804ee8c862 Jean*0111        ELSE
af20bc5e19 Jean*0112         WRITE(fn,'(A,A10)') 'pickup_ptracers.', pickupSuff
804ee8c862 Jean*0113        ENDIF
                0114        prec = precFloat64
                0115 
                0116        CALL READ_MFLDS_SET(
                0117      I                      fn,
                0118      O                      nbFields, filePrec,
                0119      I                      Nr, myIter, myThid )
                0120        _BEGIN_MASTER( myThid )
                0121 c      IF ( filePrec.NE.0 .AND. filePrec.NE.prec ) THEN
                0122        IF ( nbFields.GE.0 .AND. filePrec.NE.prec ) THEN
c875b0b8fc Jean*0123          WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
804ee8c862 Jean*0124      &    'pickup-file binary precision do not match !'
                0125          CALL PRINT_ERROR( msgBuf, myThid )
c875b0b8fc Jean*0126          WRITE(msgBuf,'(A,2(A,I4))') 'PTRACERS_READ_PICKUP: ',
804ee8c862 Jean*0127      &    'file prec.=', filePrec, ' but expecting prec.=', prec
                0128          CALL PRINT_ERROR( msgBuf, myThid )
c875b0b8fc Jean*0129          STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (data-prec Pb)'
804ee8c862 Jean*0130        ENDIF
                0131        _END_MASTER( myThid )
                0132 
                0133        IF ( nbFields.LE.0 ) THEN
                0134 C-      No meta-file or old meta-file without List of Fields
                0135         ioUnit = errorMessageUnit
                0136         IF ( pickupStrictlyMatch ) THEN
c875b0b8fc Jean*0137           WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
804ee8c862 Jean*0138      &      'no field-list found in meta-file',
                0139      &      ' => cannot check for strick-matching'
                0140           CALL PRINT_ERROR( msgBuf, myThid )
c875b0b8fc Jean*0141           WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
804ee8c862 Jean*0142      &      'try with " pickupStrictlyMatch=.FALSE.,"',
                0143      &      ' in file: "data", NameList: "PARM03"'
                0144           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
c875b0b8fc Jean*0145           STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP'
804ee8c862 Jean*0146         ELSE
c875b0b8fc Jean*0147           WRITE(msgBuf,'(4A)') 'WARNING >> PTRACERS_READ_PICKUP: ',
804ee8c862 Jean*0148      &      ' no field-list found'
                0149           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0150          IF ( nbFields.EQ.-1 ) THEN
                0151 C-      No meta-file
                0152           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0153      &      ' try to read pickup as currently written'
                0154           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0155          ELSE
                0156 C-      Old meta-file without List of Fields
                0157           WRITE(msgBuf,'(4A)') 'WARNING >> ',
                0158      &      ' try to read pickup as it used to be written'
                0159           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0160           WRITE(msgBuf,'(4A)') 'WARNING >> ',
52f7435232 Jean*0161      &      ' until checkpoint59l (2007 Dec 17)'
804ee8c862 Jean*0162           CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0163          ENDIF
                0164         ENDIF
                0165        ENDIF
d197c88195 Jean*0166 
804ee8c862 Jean*0167 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0168 
                0169 C---   Very Old way to read ptracer pickup:
                0170        IF ( nbFields.EQ.0 .AND. usePickupBeforeC54 ) THEN
d2825c6d08 Ed H*0171 C       Read fields as consecutive records
804ee8c862 Jean*0172         DO iTracer = 1, PTRACERS_numInUse
d2825c6d08 Ed H*0173           iRec = iTracer
d197c88195 Jean*0174           CALL READ_REC_3D_RL( fn, prec, Nr,
9b39915e34 Jean*0175      O         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
d197c88195 Jean*0176      I         iRec, myIter, myThid )
9b39915e34 Jean*0177           CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0178      &                     Nr, myThid )
d2825c6d08 Ed H*0179         ENDDO
                0180 
29fd21a3ae Jean*0181 C       Read historical tendencies as consecutive records
804ee8c862 Jean*0182 c       DO iTracer = 1,PTRACERS_numInUse
                0183 c         iRec = iTracer + PTRACERS_num
                0184 c         CALL READ_REC_3D_RL( fn, prec, Nr,
9b39915e34 Jean*0185 c    O         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0186 c    I         iRec, myIter, myThid )
9b39915e34 Jean*0187 c         CALL EXCH_3D_RL( gPtr(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0188 c    &                     Nr, myThid )
                0189 c       ENDDO
                0190         DO iTracer = 1, PTRACERS_numInUse
d2825c6d08 Ed H*0191           iRec = iTracer + PTRACERS_num*2
d197c88195 Jean*0192           CALL READ_REC_3D_RL( fn, prec, Nr,
9b39915e34 Jean*0193      O         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
d197c88195 Jean*0194      I         iRec, myIter, myThid )
9b39915e34 Jean*0195           CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0196      &                     Nr, myThid )
d2825c6d08 Ed H*0197         ENDDO
8795d57402 Jean*0198 
804ee8c862 Jean*0199        ELSEIF ( nbFields.EQ.0 ) THEN
                0200 C---   Old way to read ptracer pickup:
29fd21a3ae Jean*0201 C       Read fields & tendencies (needed for AB) as consecutive records,
d2825c6d08 Ed H*0202 C       one tracer after the other, only for tracers "InUse".  Note:
                0203 C       this allow to restart from a pickup with a different number of
                0204 C       tracers, with write_pickup dumping all of them (PTRACERS_num).
804ee8c862 Jean*0205         DO iTracer = 1, PTRACERS_numInUse
d197c88195 Jean*0206           iRec = 2*iTracer -1
                0207           CALL READ_REC_3D_RL( fn, prec, Nr,
9b39915e34 Jean*0208      O         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
d197c88195 Jean*0209      I         iRec, myIter, myThid )
d2825c6d08 Ed H*0210           iRec = 2*iTracer
d197c88195 Jean*0211           CALL READ_REC_3D_RL( fn, prec, Nr,
9b39915e34 Jean*0212      O         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
d197c88195 Jean*0213      I         iRec, myIter, myThid )
9b39915e34 Jean*0214           CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0215      &                     Nr, myThid )
9b39915e34 Jean*0216           CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0217      &                     Nr, myThid )
d2825c6d08 Ed H*0218         ENDDO
d197c88195 Jean*0219 
804ee8c862 Jean*0220        ELSE
                0221 C---   New way to read ptracer pickup:
                0222         nj = 0
                0223         DO iTracer = 1, PTRACERS_numInUse
                0224 C---    read pTracer 3-D fields for restart
                0225           fldName = 'pTr'//PTRACERS_ioLabel(iTracer)//'   '
                0226           CALL READ_MFLDS_3D_RL( fldName,
9b39915e34 Jean*0227      O                     pTracer(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0228      &                     nj, prec, Nr, myIter, myThid )
9b39915e34 Jean*0229           CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0230      &                     Nr, myThid )
                0231         ENDDO
                0232         DO iTracer = 1, PTRACERS_numInUse
                0233 C---    read pTracer 3-D tendencies for AB-restart
fc10d43a89 Jean*0234          IF ( PTRACERS_AdamsBashGtr(iTracer) .OR.
                0235      &        PTRACERS_AdamsBash_Tr(iTracer) ) THEN
                0236           IF ( PTRACERS_AdamsBashGtr(iTracer) )
                0237      &      fldName = 'gPtr'//PTRACERS_ioLabel(iTracer)//'m1'
                0238           IF ( PTRACERS_AdamsBash_Tr(iTracer) )
                0239      &      fldName = 'pTr'//PTRACERS_ioLabel(iTracer)//'Nm1'
804ee8c862 Jean*0240           CALL READ_MFLDS_3D_RL( fldName,
9b39915e34 Jean*0241      O                     gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0242      &                     nj, prec, Nr, myIter, myThid )
9b39915e34 Jean*0243           CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
804ee8c862 Jean*0244      &                     Nr, myThid )
                0245          ENDIF
                0246         ENDDO
785a077159 Alis*0247 
804ee8c862 Jean*0248 C--    end: new way to read pickup file
                0249        ENDIF
                0250 
                0251 C--    Check for missing fields:
                0252        nMissing = missFldDim
                0253        CALL READ_MFLDS_CHECK(
                0254      O                     missFldList,
                0255      U                     nMissing,
                0256      I                     myIter, myThid )
                0257        IF ( nMissing.GT.missFldDim ) THEN
c875b0b8fc Jean*0258          WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
804ee8c862 Jean*0259      &     'missing fields list has been truncated to', missFldDim
                0260          CALL PRINT_ERROR( msgBuf, myThid )
c875b0b8fc Jean*0261          STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (list-size Pb)'
804ee8c862 Jean*0262        ENDIF
                0263        CALL PTRACERS_CHECK_PICKUP(
                0264      I                     missFldList,
                0265      I                     nMissing, nbFields,
                0266      I                     myIter, myThid )
d217ad1db8 Oliv*0267 
d390b9846d Jean*0268 C--   end: pickup_read_mdsio
                0269       ENDIF
                0270 
                0271 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0272 
811d3e9bd3 Jean*0273 #ifdef PTRACERS_ALLOW_DYN_STATE
d390b9846d Jean*0274 c     IF ( PTRACERS_pickup_read_mdsio ) THEN
                0275 
d217ad1db8 Oliv*0276 C--   Read pickup file with 2nd.Order moment fields
d390b9846d Jean*0277        prec = precFloat64
d217ad1db8 Oliv*0278        DO iTracer = 1, PTRACERS_numInUse
                0279         IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
                0280 
af20bc5e19 Jean*0281          IF ( pickupSuff.EQ.' ' ) THEN
                0282            IF ( rwSuffixType.EQ.0 ) THEN
                0283              WRITE(fn,'(3A,I10.10)') 'pickup_somTRAC',
d217ad1db8 Oliv*0284      &                     PTRACERS_ioLabel(iTracer),'.', myIter
af20bc5e19 Jean*0285            ELSE
                0286              CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0287              WRITE(fn,'(3A,A)') 'pickup_somTRAC',
                0288      &                     PTRACERS_ioLabel(iTracer),'.', suff
                0289            ENDIF
d217ad1db8 Oliv*0290          ELSE
                0291            WRITE(fn,'(3A,A10)') 'pickup_somTRAC',
                0292      &                     PTRACERS_ioLabel(iTracer),'.', pickupSuff
                0293          ENDIF
d390b9846d Jean*0294          ioUnit = standardMessageUnit
811d3e9bd3 Jean*0295          WRITE(msgBuf,'(A,I3,A)')'PTRACERS_READ_PICKUP: iTracer = ',
d390b9846d Jean*0296      &            iTracer, ' : reading 2nd-order moments from file:'
                0297          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0298          CALL PRINT_MESSAGE( fn,     ioUnit, SQUEEZE_RIGHT, myThid )
                0299 
                0300 C-      First check if pickup file exist
                0301 #ifdef ALLOW_MDSIO
                0302          useCurrentDir = .FALSE.
                0303          CALL MDS_CHECK4FILE(
                0304      I                       fn, '.data', 'PTRACERS_READ_PICKUP',
                0305      O                       filNam, fileExist,
                0306      I                       useCurrentDir, myThid )
                0307 #else
                0308          STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP: Needs MDSIO pkg'
                0309 #endif
                0310 
                0311          IF ( fileExist ) THEN
                0312 C-       Read 2nd Order moments as consecutive records
                0313           DO n=1,nSOM
d217ad1db8 Oliv*0314            iRec = n
                0315            CALL READ_REC_3D_RL( fn, prec, Nr,
646c54e667 Jean*0316      O               _Ptracers_som(:,:,:,:,:,n,iTracer),
d217ad1db8 Oliv*0317      I               iRec, myIter, myThid )
d390b9846d Jean*0318           ENDDO
                0319           CALL GAD_EXCH_SOM( _Ptracers_som(:,:,:,:,:,:,iTracer),
                0320      &                       Nr, myThid )
                0321          ELSE
                0322           ioUnit = errorMessageUnit
                0323           IF ( pickupStrictlyMatch ) THEN
                0324             WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
                0325      &        'try with " pickupStrictlyMatch=.FALSE.,"',
                0326      &        ' in file: "data", NameList: "PARM03"'
                0327             CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0328             STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP'
                0329           ELSE
                0330             WRITE(msgBuf,'(2A)') 'WARNING >> PTRACERS_READ_PICKUP: ',
                0331      &        'approximated restart: reset Ptr_SOM to zero'
                0332             CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0333           ENDIF
                0334          ENDIF
d217ad1db8 Oliv*0335         ENDIF
                0336        ENDDO
804ee8c862 Jean*0337 
d390b9846d Jean*0338 C--   end: pickup_read_mdsio, SOM pickups
                0339 c     ENDIF
                0340 #endif /* PTRACERS_ALLOW_DYN_STATE */
d2825c6d08 Ed H*0341 
785a077159 Alis*0342 #endif /* ALLOW_PTRACERS */
                0343 
                0344       RETURN
                0345       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!