/[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.2 by jmc, Thu Oct 26 00:29:33 2006 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.h"  #include "PTRACERS_PARAMS.h"
26    #include "PTRACERS_RESTART.h"
27    #include "PTRACERS_FIELDS.h"
28    
29  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
30  C     myIter            :: time-step number  C     myIter            :: time-step number
# Line 30  C     myThid            :: thread number Line 35  C     myThid            :: thread number
35  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
36    
37  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
38  C     iTracer           :: loop indices  C     iTracer     :: tracer index
39  C     iRec              :: record number  C     iRec        :: record number
40  C     fn                :: character buffer for creating filename  C     fn          :: character buffer for creating filename
41  C     prec              :: precision of pickup files  C     prec        :: precision of pickup files
42        INTEGER iTracer,prec,iRec  C     filePrec    :: pickup-file precision (read from meta file)
43        CHARACTER*(MAX_LEN_MBUF) fn  C     nbFields    :: number of fields in pickup file (read from meta file)
44    C     fldName     :: Name of the field to read
45    C     missFldList :: List of missing fields   (attempted to read but not found)
46    C     missFldDim  :: Dimension of missing fields list array: missFldList
47    C     nMissing    :: Number of missing fields (attempted to read but not found)
48    C     j           :: loop index
49    C     nj          :: record number
50    C     ioUnit      :: temp for writing msg unit
51    C     msgBuf      :: Informational/error message buffer
52          INTEGER iTracer, iRec, prec, n
53          INTEGER filePrec, nbFields
54          INTEGER missFldDim, nMissing
55          INTEGER nj, ioUnit
56          PARAMETER( missFldDim = 2*PTRACERS_num )
57          CHARACTER*(MAX_LEN_FNAM) fn
58          CHARACTER*(8) fldName, missFldList(missFldDim)
59          CHARACTER*(MAX_LEN_MBUF) msgBuf
60  CEOP  CEOP
61    
62        _BARRIER        _BARRIER
# Line 47  C       Read variables from the pickup f Line 68  C       Read variables from the pickup f
68          CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)          CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
69          CALL MNC_CW_SET_UDIM(fn, 1, myThid)          CALL MNC_CW_SET_UDIM(fn, 1, myThid)
70          CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)          CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
71          DO iTracer = 1,PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
72            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
73       &         gPtrNm1(1-OLx,1-OLy,1,1,1,iTracer),myThid)       &         gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),myThid)
74        _EXCH_XYZ_R8(gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),myThid)            CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
75         &                     Nr, myThid )
76          ENDDO          ENDDO
77          CALL MNC_CW_SET_UDIM(fn, 2, myThid)          CALL MNC_CW_SET_UDIM(fn, 2, myThid)
78          DO iTracer = 1,PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
79            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),            CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
80       &         pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)       &         pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)
81        _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),
82         &                     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
99    
100        WRITE(fn,'(A,I10.10)') 'pickup_ptracers.',myIter  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
101        prec = precFloat64  
102           IF ( pickupSuff.EQ.' ' ) THEN
103            WRITE(fn,'(A,I10.10)') 'pickup_ptracers.',myIter
104           ELSE
105            WRITE(fn,'(A,A10)')    'pickup_ptracers.',pickupSuff
106           ENDIF
107           prec = precFloat64
108    
109           CALL READ_MFLDS_SET(
110         I                      fn,
111         O                      nbFields, filePrec,
112         I                      Nr, myIter, myThid )
113           _BEGIN_MASTER( myThid )
114    c      IF ( filePrec.NE.0 .AND. filePrec.NE.prec ) THEN
115           IF ( nbFields.GE.0 .AND. filePrec.NE.prec ) THEN
116             WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
117         &    'pickup-file binary precision do not match !'
118             CALL PRINT_ERROR( msgBuf, myThid )
119             WRITE(msgBuf,'(A,2(A,I4))') 'PTRACERS_READ_PICKUP: ',
120         &    'file prec.=', filePrec, ' but expecting prec.=', prec
121             CALL PRINT_ERROR( msgBuf, myThid )
122             STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (data-prec Pb)'
123           ENDIF
124           _END_MASTER( myThid )
125    
126           IF ( nbFields.LE.0 ) THEN
127    C-      No meta-file or old meta-file without List of Fields
128            ioUnit = errorMessageUnit
129            IF ( pickupStrictlyMatch ) THEN
130              WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
131         &      'no field-list found in meta-file',
132         &      ' => cannot check for strick-matching'
133              CALL PRINT_ERROR( msgBuf, myThid )
134              WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
135         &      'try with " pickupStrictlyMatch=.FALSE.,"',
136         &      ' in file: "data", NameList: "PARM03"'
137              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
138              STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP'
139            ELSE
140              WRITE(msgBuf,'(4A)') 'WARNING >> PTRACERS_READ_PICKUP: ',
141         &      ' no field-list found'
142              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
143             IF ( nbFields.EQ.-1 ) THEN
144    C-      No meta-file
145              WRITE(msgBuf,'(4A)') 'WARNING >> ',
146         &      ' try to read pickup as currently written'
147              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
148             ELSE
149    C-      Old meta-file without List of Fields
150              WRITE(msgBuf,'(4A)') 'WARNING >> ',
151         &      ' try to read pickup as it used to be written'
152              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
153              WRITE(msgBuf,'(4A)') 'WARNING >> ',
154         &      ' until checkpoint59l (2007 Dec 17)'
155              CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
156             ENDIF
157            ENDIF
158           ENDIF
159    
160        IF ( usePickupBeforeC54 ) THEN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
161    
162    C---   Very Old way to read ptracer pickup:
163           IF ( nbFields.EQ.0 .AND. usePickupBeforeC54 ) THEN
164  C       Read fields as consecutive records  C       Read fields as consecutive records
165          DO iTracer=1,PTRACERS_num          DO iTracer = 1, PTRACERS_numInUse
166            iRec = iTracer            iRec = iTracer
167            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
168       O         pTracer(1-Olx,1-Oly,1,1,1,iTracer),       O         pTracer(1-Olx,1-Oly,1,1,1,iTracer),
169       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
170        _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),
171         &                     Nr, myThid )
172          ENDDO          ENDDO
173    
174  C       Read historical tendancies as consecutive records  C       Read historical tendencies as consecutive records
175          DO iTracer=1,PTRACERS_num  c       DO iTracer = 1,PTRACERS_numInUse
176            iRec = iTracer + PTRACERS_num  c         iRec = iTracer + PTRACERS_num
177            CALL READ_REC_3D_RL( fn, prec, Nr,  c         CALL READ_REC_3D_RL( fn, prec, Nr,
178       O         gPtr(1-Olx,1-Oly,1,1,1,iTracer),  c    O         gPtr(1-Olx,1-Oly,1,1,1,iTracer),
179       I         iRec, myIter, myThid )  c    I         iRec, myIter, myThid )
180        _EXCH_XYZ_R8(gPtr(1-Olx,1-Oly,1,1,1,iTracer),myThid)  c         CALL EXCH_3D_RL( gPtr(1-Olx,1-Oly,1,1,1,iTracer),
181          ENDDO  c    &                     Nr, myThid )
182          DO iTracer=1,PTRACERS_num  c       ENDDO
183            DO iTracer = 1, PTRACERS_numInUse
184            iRec = iTracer + PTRACERS_num*2            iRec = iTracer + PTRACERS_num*2
185            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
186       O         gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),       O         gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
187       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
188        _EXCH_XYZ_R8(gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),myThid)            CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
189         &                     Nr, myThid )
190          ENDDO          ENDDO
191    
192        ELSE         ELSEIF ( nbFields.EQ.0 ) THEN
193  C       Read fields & tendancies (needed for AB) as consecutive records,  C---   Old way to read ptracer pickup:
194    C       Read fields & tendencies (needed for AB) as consecutive records,
195  C       one tracer after the other, only for tracers "InUse".  Note:  C       one tracer after the other, only for tracers "InUse".  Note:
196  C       this allow to restart from a pickup with a different number of  C       this allow to restart from a pickup with a different number of
197  C       tracers, with write_pickup dumping all of them (PTRACERS_num).  C       tracers, with write_pickup dumping all of them (PTRACERS_num).
198          DO iTracer=1,PTRACERS_numInUse          DO iTracer = 1, PTRACERS_numInUse
199            iRec = 2*iTracer -1            iRec = 2*iTracer -1
200            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
201       O         pTracer(1-Olx,1-Oly,1,1,1,iTracer),       O         pTracer(1-Olx,1-Oly,1,1,1,iTracer),
202       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
203            iRec = 2*iTracer            iRec = 2*iTracer
204            CALL READ_REC_3D_RL( fn, prec, Nr,            CALL READ_REC_3D_RL( fn, prec, Nr,
205       O         gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),       O         gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
206       I         iRec, myIter, myThid )       I         iRec, myIter, myThid )
207        _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,iTracer),myThid)            CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),
208        _EXCH_XYZ_R8(gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),myThid)       &                     Nr, myThid )
209              CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
210         &                     Nr, myThid )
211          ENDDO          ENDDO
212    
213        ENDIF         ELSE
214    C---   New way to read ptracer pickup:
215            nj = 0
216            DO iTracer = 1, PTRACERS_numInUse
217    C---    read pTracer 3-D fields for restart
218              fldName = 'pTr'//PTRACERS_ioLabel(iTracer)//'   '
219              CALL READ_MFLDS_3D_RL( fldName,
220         O                     pTracer(1-Olx,1-Oly,1,1,1,iTracer),
221         &                     nj, prec, Nr, myIter, myThid )
222              CALL EXCH_3D_RL( pTracer(1-Olx,1-Oly,1,1,1,iTracer),
223         &                     Nr, myThid )
224            ENDDO
225            DO iTracer = 1, PTRACERS_numInUse
226    C---    read pTracer 3-D tendencies for AB-restart
227             IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN
228              fldName = 'gPtr'//PTRACERS_ioLabel(iTracer)//'m1'
229              CALL READ_MFLDS_3D_RL( fldName,
230         O                     gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
231         &                     nj, prec, Nr, myIter, myThid )
232              CALL EXCH_3D_RL( gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
233         &                     Nr, myThid )
234             ENDIF
235            ENDDO
236    
237    C--    end: new way to read pickup file
238           ENDIF
239    
240    C--    Check for missing fields:
241           nMissing = missFldDim
242           CALL READ_MFLDS_CHECK(
243         O                     missFldList,
244         U                     nMissing,
245         I                     myIter, myThid )
246           IF ( nMissing.GT.missFldDim ) THEN
247             WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
248         &     'missing fields list has been truncated to', missFldDim
249             CALL PRINT_ERROR( msgBuf, myThid )
250             STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (list-size Pb)'
251           ENDIF
252           CALL PTRACERS_CHECK_PICKUP(
253         I                     missFldList,
254         I                     nMissing, nbFields,
255         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
292        ENDIF        ENDIF
293    
294  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22