/[MITgcm]/MITgcm/pkg/ptracers/ptracers_read_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/ptracers/ptracers_read_pickup.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.6 by jmc, Mon Dec 17 22:05:48 2007 UTC revision 1.12 by jmc, Fri May 9 21:44:31 2008 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "GAD_OPTIONS.h"
5  #include "PTRACERS_OPTIONS.h"  #include "PTRACERS_OPTIONS.h"
6    
7  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 14  C     !DESCRIPTION: Line 15  C     !DESCRIPTION:
15  C     Reads current state of passive tracers from a pickup file  C     Reads current state of passive tracers from a pickup file
16    
17  C     !USES:  C     !USES:
18    #include "PTRACERS_MOD.h"
19        IMPLICIT NONE        IMPLICIT NONE
20  #include "SIZE.h"  #include "SIZE.h"
21  #include "EEPARAMS.h"  #include "EEPARAMS.h"
22  #include "PARAMS.h"  #include "PARAMS.h"
23    #include "GAD.h"
24  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
25  #include "PTRACERS_PARAMS.h"  #include "PTRACERS_PARAMS.h"
26  #include "PTRACERS_RESTART.h"  #include "PTRACERS_RESTART.h"
# Line 46  C     j           :: loop index Line 49  C     j           :: loop index
49  C     nj          :: record number  C     nj          :: record number
50  C     ioUnit      :: temp for writing msg unit  C     ioUnit      :: temp for writing msg unit
51  C     msgBuf      :: Informational/error message buffer  C     msgBuf      :: Informational/error message buffer
52        INTEGER iTracer, iRec, prec        INTEGER iTracer, iRec, prec, n
53        INTEGER filePrec, nbFields        INTEGER filePrec, nbFields
54        INTEGER missFldDim, nMissing        INTEGER missFldDim, nMissing
55        INTEGER nj, ioUnit        INTEGER nj, ioUnit
56        PARAMETER( missFldDim = 2*PTRACERS_num )        PARAMETER( missFldDim = 2*PTRACERS_num )
57        CHARACTER*(MAX_LEN_MBUF) fn        CHARACTER*(MAX_LEN_FNAM) fn
58        CHARACTER*(8) fldName, missFldList(missFldDim)        CHARACTER*(8) fldName, missFldList(missFldDim)
59        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
60  CEOP  CEOP
# Line 79  C       Read variables from the pickup f Line 82  C       Read variables from the pickup f
82       &                     Nr, myThid )       &                     Nr, myThid )
83          ENDDO          ENDDO
84        ENDIF        ENDIF
85          IF ( useMNC .AND. PTRACERS_pickup_read_mnc ) THEN
86           DO iTracer = 1, PTRACERS_numInUse
87            IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
88             WRITE(msgBuf,'(3A)')'PTRACERS_READ_PICKUP: MNC not yet coded',
89         &                       ' for SOM advection',
90         &                       ' => read bin file instead'
91             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
92         &                       SQUEEZE_RIGHT, myThid)
93            ENDIF
94           ENDDO
95          ENDIF
96  #endif /*  ALLOW_MNC  */  #endif /*  ALLOW_MNC  */
97    
98        IF ( PTRACERS_pickup_read_mdsio ) THEN        IF ( PTRACERS_pickup_read_mdsio ) THEN
# Line 99  C---+----1----+----2----+----3----+----4 Line 113  C---+----1----+----2----+----3----+----4
113         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
114  c      IF ( filePrec.NE.0 .AND. filePrec.NE.prec ) THEN  c      IF ( filePrec.NE.0 .AND. filePrec.NE.prec ) THEN
115         IF ( nbFields.GE.0 .AND. filePrec.NE.prec ) THEN         IF ( nbFields.GE.0 .AND. filePrec.NE.prec ) THEN
116           WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',           WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
117       &    'pickup-file binary precision do not match !'       &    'pickup-file binary precision do not match !'
118           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
119           WRITE(msgBuf,'(A,2(A,I4))') 'READ_PICKUP: ',           WRITE(msgBuf,'(A,2(A,I4))') 'PTRACERS_READ_PICKUP: ',
120       &    'file prec.=', filePrec, ' but expecting prec.=', prec       &    'file prec.=', filePrec, ' but expecting prec.=', prec
121           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
122           STOP 'ABNORMAL END: S/R READ_PICKUP (data-prec Pb)'           STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (data-prec Pb)'
123         ENDIF         ENDIF
124         _END_MASTER( myThid )         _END_MASTER( myThid )
125    
# Line 113  c      IF ( filePrec.NE.0 .AND. filePrec Line 127  c      IF ( filePrec.NE.0 .AND. filePrec
127  C-      No meta-file or old meta-file without List of Fields  C-      No meta-file or old meta-file without List of Fields
128          ioUnit = errorMessageUnit          ioUnit = errorMessageUnit
129          IF ( pickupStrictlyMatch ) THEN          IF ( pickupStrictlyMatch ) THEN
130            WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',            WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
131       &      'no field-list found in meta-file',       &      'no field-list found in meta-file',
132       &      ' => cannot check for strick-matching'       &      ' => cannot check for strick-matching'
133            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
134            WRITE(msgBuf,'(4A)') 'READ_PICKUP: ',            WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
135       &      'try with " pickupStrictlyMatch=.FALSE.,"',       &      'try with " pickupStrictlyMatch=.FALSE.,"',
136       &      ' in file: "data", NameList: "PARM03"'       &      ' in file: "data", NameList: "PARM03"'
137            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
138            STOP 'ABNORMAL END: S/R READ_PICKUP'            STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP'
139          ELSE          ELSE
140            WRITE(msgBuf,'(4A)') 'WARNING >> READ_PICKUP: ',            WRITE(msgBuf,'(4A)') 'WARNING >> PTRACERS_READ_PICKUP: ',
141       &      ' no field-list found'       &      ' no field-list found'
142            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
143           IF ( nbFields.EQ.-1 ) THEN           IF ( nbFields.EQ.-1 ) THEN
# Line 137  C-      Old meta-file without List of Fi Line 151  C-      Old meta-file without List of Fi
151       &      ' try to read pickup as it used to be written'       &      ' try to read pickup as it used to be written'
152            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
153            WRITE(msgBuf,'(4A)') 'WARNING >> ',            WRITE(msgBuf,'(4A)') 'WARNING >> ',
154       &      ' until checkpoint59k (2007 Dec 18)'       &      ' until checkpoint59l (2007 Dec 17)'
155            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
156           ENDIF           ENDIF
157          ENDIF          ENDIF
# Line 230  C--    Check for missing fields: Line 244  C--    Check for missing fields:
244       U                     nMissing,       U                     nMissing,
245       I                     myIter, myThid )       I                     myIter, myThid )
246         IF ( nMissing.GT.missFldDim ) THEN         IF ( nMissing.GT.missFldDim ) THEN
247           WRITE(msgBuf,'(2A,I4)') 'READ_PICKUP: ',           WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
248       &     'missing fields list has been truncated to', missFldDim       &     'missing fields list has been truncated to', missFldDim
249           CALL PRINT_ERROR( msgBuf, myThid )           CALL PRINT_ERROR( msgBuf, myThid )
250           STOP 'ABNORMAL END: S/R READ_PICKUP (list-size Pb)'           STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (list-size Pb)'
251         ENDIF         ENDIF
252         CALL PTRACERS_CHECK_PICKUP(         CALL PTRACERS_CHECK_PICKUP(
253       I                     missFldList,       I                     missFldList,
254       I                     nMissing, nbFields,       I                     nMissing, nbFields,
255       I                     myIter, myThid )       I                     myIter, myThid )
256    
257    #ifdef PTRACERS_ALLOW_DYN_STATE
258    C--   Read pickup file with 2nd.Order moment fields
259           DO iTracer = 1, PTRACERS_numInUse
260            IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
261    
262             IF (pickupSuff .EQ. ' ') THEN
263               WRITE(fn,'(3A,I10.10)') 'pickup_somTRAC',
264         &                     PTRACERS_ioLabel(iTracer),'.', myIter
265             ELSE
266               WRITE(fn,'(3A,A10)') 'pickup_somTRAC',
267         &                     PTRACERS_ioLabel(iTracer),'.', pickupSuff
268             ENDIF
269             WRITE(msgBuf,'(A,I3,A)')'PTRACERS_READ_PICKUP: iTracer = ',
270         &                      iTracer,
271         &                      ' : reading 2nd-order moments from file '
272             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
273         &                      SQUEEZE_RIGHT, myThid)
274             CALL PRINT_MESSAGE( fn, standardMessageUnit,
275         &                      SQUEEZE_RIGHT, myThid)
276             prec = precFloat64
277    C        Read 2nd Order moments as consecutive records
278             DO n=1,nSOM
279               iRec = n
280               CALL READ_REC_3D_RL( fn, prec, Nr,
281         O               _Ptracers_som(1-Olx,1-Oly,1,1,1,n,iTracer),
282         I               iRec, myIter, myThid )
283             ENDDO
284             CALL GAD_EXCH_SOM( _Ptracers_som(1-Olx,1-Oly,1,1,1,1,iTracer),
285         &                      Nr, myThid )
286            ENDIF
287           ENDDO
288    #endif /* PTRACERS_ALLOW_DYN_STATE */
289           _BARRIER
290    
291  C--   end: pickup_read_mdsio  C--   end: pickup_read_mdsio
292        ENDIF        ENDIF
293    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22