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

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

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


Revision 1.16 - (hide annotations) (download)
Fri Jun 21 22:06:26 2013 UTC (10 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint65, checkpoint65b, checkpoint65a
Changes since 1.15: +52 -18 lines
allow to restart without SOM pickup (resetting SOM to zero).

1 jmc 1.16 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_read_pickup.F,v 1.15 2012/03/08 17:05:44 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4 jahn 1.11 #include "GAD_OPTIONS.h"
5 jmc 1.1 #include "PTRACERS_OPTIONS.h"
6    
7     CBOP
8     C !ROUTINE: PTRACERS_READ_PICKUP
9    
10     C !INTERFACE:
11     SUBROUTINE PTRACERS_READ_PICKUP( myIter, myThid )
12    
13     C !DESCRIPTION:
14     C Reads current state of passive tracers from a pickup file
15    
16     C !USES:
17 jahn 1.11 #include "PTRACERS_MOD.h"
18 jmc 1.1 IMPLICIT NONE
19     #include "SIZE.h"
20     #include "EEPARAMS.h"
21     #include "PARAMS.h"
22 jahn 1.11 #include "GAD.h"
23 jmc 1.1 #include "PTRACERS_SIZE.h"
24 jmc 1.5 #include "PTRACERS_PARAMS.h"
25 jmc 1.15 #include "PTRACERS_START.h"
26 jmc 1.5 #include "PTRACERS_FIELDS.h"
27 jmc 1.1
28     C !INPUT PARAMETERS:
29     C myIter :: time-step number
30     C myThid :: thread number
31     INTEGER myIter
32     INTEGER myThid
33    
34     #ifdef ALLOW_PTRACERS
35    
36     C !LOCAL VARIABLES:
37 jmc 1.6 C iTracer :: tracer index
38     C iRec :: record number
39     C fn :: character buffer for creating filename
40     C prec :: precision of pickup files
41     C filePrec :: pickup-file precision (read from meta file)
42     C nbFields :: number of fields in pickup file (read from meta file)
43     C fldName :: Name of the field to read
44     C missFldList :: List of missing fields (attempted to read but not found)
45     C missFldDim :: Dimension of missing fields list array: missFldList
46     C nMissing :: Number of missing fields (attempted to read but not found)
47     C j :: loop index
48     C nj :: record number
49     C ioUnit :: temp for writing msg unit
50     C msgBuf :: Informational/error message buffer
51 jmc 1.14 INTEGER iTracer, iRec, prec
52 jmc 1.6 INTEGER filePrec, nbFields
53     INTEGER missFldDim, nMissing
54     INTEGER nj, ioUnit
55     PARAMETER( missFldDim = 2*PTRACERS_num )
56 jmc 1.10 CHARACTER*(MAX_LEN_FNAM) fn
57 jmc 1.6 CHARACTER*(8) fldName, missFldList(missFldDim)
58     CHARACTER*(MAX_LEN_MBUF) msgBuf
59 jmc 1.14 #ifdef PTRACERS_ALLOW_DYN_STATE
60 jmc 1.16 CHARACTER*(MAX_LEN_FNAM) filNam
61     LOGICAL useCurrentDir, fileExist
62 jmc 1.14 INTEGER n
63     #endif
64 jmc 1.1 CEOP
65    
66 jmc 1.14 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
67 jmc 1.2
68 jmc 1.1 #ifdef ALLOW_MNC
69     IF ( PTRACERS_pickup_read_mnc ) THEN
70     C Read variables from the pickup file
71     WRITE(fn,'(a)') 'pickup_ptracers'
72     CALL MNC_FILE_CLOSE_ALL_MATCHING(fn, myThid)
73     CALL MNC_CW_SET_UDIM(fn, 1, myThid)
74     CALL MNC_CW_SET_CITER(fn, 3, 3, myIter, -1, myThid)
75 jmc 1.6 DO iTracer = 1, PTRACERS_numInUse
76 jmc 1.1 CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
77 jmc 1.5 & gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),myThid)
78 jmc 1.15 CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
79 jmc 1.6 & Nr, myThid )
80 jmc 1.1 ENDDO
81     CALL MNC_CW_SET_UDIM(fn, 2, myThid)
82 jmc 1.6 DO iTracer = 1, PTRACERS_numInUse
83 jmc 1.1 CALL MNC_CW_RL_R('D',fn,0,0, PTRACERS_names(iTracer),
84     & pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)
85 jmc 1.15 CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
86 jmc 1.6 & Nr, myThid )
87 jmc 1.1 ENDDO
88     ENDIF
89 jahn 1.11 IF ( useMNC .AND. PTRACERS_pickup_read_mnc ) THEN
90     DO iTracer = 1, PTRACERS_numInUse
91     IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
92     WRITE(msgBuf,'(3A)')'PTRACERS_READ_PICKUP: MNC not yet coded',
93     & ' for SOM advection',
94     & ' => read bin file instead'
95     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
96     & SQUEEZE_RIGHT, myThid)
97     ENDIF
98     ENDDO
99     ENDIF
100 jmc 1.1 #endif /* ALLOW_MNC */
101 jmc 1.2
102 jmc 1.16 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
103    
104 jmc 1.1 IF ( PTRACERS_pickup_read_mdsio ) THEN
105    
106 jmc 1.6 IF ( pickupSuff.EQ.' ' ) THEN
107 jmc 1.4 WRITE(fn,'(A,I10.10)') 'pickup_ptracers.',myIter
108 jmc 1.6 ELSE
109 jmc 1.4 WRITE(fn,'(A,A10)') 'pickup_ptracers.',pickupSuff
110 jmc 1.6 ENDIF
111     prec = precFloat64
112    
113     CALL READ_MFLDS_SET(
114     I fn,
115     O nbFields, filePrec,
116     I Nr, myIter, myThid )
117     _BEGIN_MASTER( myThid )
118     c IF ( filePrec.NE.0 .AND. filePrec.NE.prec ) THEN
119     IF ( nbFields.GE.0 .AND. filePrec.NE.prec ) THEN
120 jmc 1.9 WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
121 jmc 1.6 & 'pickup-file binary precision do not match !'
122     CALL PRINT_ERROR( msgBuf, myThid )
123 jmc 1.9 WRITE(msgBuf,'(A,2(A,I4))') 'PTRACERS_READ_PICKUP: ',
124 jmc 1.6 & 'file prec.=', filePrec, ' but expecting prec.=', prec
125     CALL PRINT_ERROR( msgBuf, myThid )
126 jmc 1.9 STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (data-prec Pb)'
127 jmc 1.6 ENDIF
128     _END_MASTER( myThid )
129    
130     IF ( nbFields.LE.0 ) THEN
131     C- No meta-file or old meta-file without List of Fields
132     ioUnit = errorMessageUnit
133     IF ( pickupStrictlyMatch ) THEN
134 jmc 1.9 WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
135 jmc 1.6 & 'no field-list found in meta-file',
136     & ' => cannot check for strick-matching'
137     CALL PRINT_ERROR( msgBuf, myThid )
138 jmc 1.9 WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
139 jmc 1.6 & 'try with " pickupStrictlyMatch=.FALSE.,"',
140     & ' in file: "data", NameList: "PARM03"'
141     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
142 jmc 1.9 STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP'
143 jmc 1.6 ELSE
144 jmc 1.9 WRITE(msgBuf,'(4A)') 'WARNING >> PTRACERS_READ_PICKUP: ',
145 jmc 1.6 & ' no field-list found'
146     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
147     IF ( nbFields.EQ.-1 ) THEN
148     C- No meta-file
149     WRITE(msgBuf,'(4A)') 'WARNING >> ',
150     & ' try to read pickup as currently written'
151     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
152     ELSE
153     C- Old meta-file without List of Fields
154     WRITE(msgBuf,'(4A)') 'WARNING >> ',
155     & ' try to read pickup as it used to be written'
156     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
157     WRITE(msgBuf,'(4A)') 'WARNING >> ',
158 jmc 1.7 & ' until checkpoint59l (2007 Dec 17)'
159 jmc 1.6 CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
160     ENDIF
161     ENDIF
162     ENDIF
163    
164     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
165 jmc 1.2
166 jmc 1.6 C--- Very Old way to read ptracer pickup:
167     IF ( nbFields.EQ.0 .AND. usePickupBeforeC54 ) THEN
168 jmc 1.1 C Read fields as consecutive records
169 jmc 1.6 DO iTracer = 1, PTRACERS_numInUse
170 jmc 1.1 iRec = iTracer
171 jmc 1.2 CALL READ_REC_3D_RL( fn, prec, Nr,
172 jmc 1.15 O pTracer(1-OLx,1-OLy,1,1,1,iTracer),
173 jmc 1.2 I iRec, myIter, myThid )
174 jmc 1.15 CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
175 jmc 1.6 & Nr, myThid )
176 jmc 1.1 ENDDO
177    
178 jmc 1.3 C Read historical tendencies as consecutive records
179 jmc 1.6 c DO iTracer = 1,PTRACERS_numInUse
180     c iRec = iTracer + PTRACERS_num
181     c CALL READ_REC_3D_RL( fn, prec, Nr,
182 jmc 1.15 c O gPtr(1-OLx,1-OLy,1,1,1,iTracer),
183 jmc 1.6 c I iRec, myIter, myThid )
184 jmc 1.15 c CALL EXCH_3D_RL( gPtr(1-OLx,1-OLy,1,1,1,iTracer),
185 jmc 1.6 c & Nr, myThid )
186     c ENDDO
187     DO iTracer = 1, PTRACERS_numInUse
188 jmc 1.1 iRec = iTracer + PTRACERS_num*2
189 jmc 1.2 CALL READ_REC_3D_RL( fn, prec, Nr,
190 jmc 1.15 O gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
191 jmc 1.2 I iRec, myIter, myThid )
192 jmc 1.15 CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
193 jmc 1.6 & Nr, myThid )
194 jmc 1.1 ENDDO
195    
196 jmc 1.6 ELSEIF ( nbFields.EQ.0 ) THEN
197     C--- Old way to read ptracer pickup:
198 jmc 1.3 C Read fields & tendencies (needed for AB) as consecutive records,
199 jmc 1.1 C one tracer after the other, only for tracers "InUse". Note:
200     C this allow to restart from a pickup with a different number of
201     C tracers, with write_pickup dumping all of them (PTRACERS_num).
202 jmc 1.6 DO iTracer = 1, PTRACERS_numInUse
203 jmc 1.2 iRec = 2*iTracer -1
204     CALL READ_REC_3D_RL( fn, prec, Nr,
205 jmc 1.15 O pTracer(1-OLx,1-OLy,1,1,1,iTracer),
206 jmc 1.2 I iRec, myIter, myThid )
207 jmc 1.1 iRec = 2*iTracer
208 jmc 1.2 CALL READ_REC_3D_RL( fn, prec, Nr,
209 jmc 1.15 O gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
210 jmc 1.2 I iRec, myIter, myThid )
211 jmc 1.15 CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
212 jmc 1.6 & Nr, myThid )
213 jmc 1.15 CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
214 jmc 1.6 & Nr, myThid )
215     ENDDO
216    
217     ELSE
218     C--- New way to read ptracer pickup:
219     nj = 0
220     DO iTracer = 1, PTRACERS_numInUse
221     C--- read pTracer 3-D fields for restart
222     fldName = 'pTr'//PTRACERS_ioLabel(iTracer)//' '
223     CALL READ_MFLDS_3D_RL( fldName,
224 jmc 1.15 O pTracer(1-OLx,1-OLy,1,1,1,iTracer),
225 jmc 1.6 & nj, prec, Nr, myIter, myThid )
226 jmc 1.15 CALL EXCH_3D_RL( pTracer(1-OLx,1-OLy,1,1,1,iTracer),
227 jmc 1.6 & Nr, myThid )
228     ENDDO
229     DO iTracer = 1, PTRACERS_numInUse
230     C--- read pTracer 3-D tendencies for AB-restart
231     IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN
232     fldName = 'gPtr'//PTRACERS_ioLabel(iTracer)//'m1'
233     CALL READ_MFLDS_3D_RL( fldName,
234 jmc 1.15 O gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
235 jmc 1.6 & nj, prec, Nr, myIter, myThid )
236 jmc 1.15 CALL EXCH_3D_RL( gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
237 jmc 1.6 & Nr, myThid )
238     ENDIF
239     ENDDO
240    
241     C-- end: new way to read pickup file
242     ENDIF
243    
244     C-- Check for missing fields:
245     nMissing = missFldDim
246     CALL READ_MFLDS_CHECK(
247     O missFldList,
248     U nMissing,
249     I myIter, myThid )
250     IF ( nMissing.GT.missFldDim ) THEN
251 jmc 1.9 WRITE(msgBuf,'(2A,I4)') 'PTRACERS_READ_PICKUP: ',
252 jmc 1.6 & 'missing fields list has been truncated to', missFldDim
253     CALL PRINT_ERROR( msgBuf, myThid )
254 jmc 1.9 STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP (list-size Pb)'
255 jmc 1.6 ENDIF
256     CALL PTRACERS_CHECK_PICKUP(
257     I missFldList,
258     I nMissing, nbFields,
259     I myIter, myThid )
260 jahn 1.11
261 jmc 1.16 C-- end: pickup_read_mdsio
262     ENDIF
263    
264     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
265    
266 jmc 1.12 #ifdef PTRACERS_ALLOW_DYN_STATE
267 jmc 1.16 c IF ( PTRACERS_pickup_read_mdsio ) THEN
268    
269 jahn 1.11 C-- Read pickup file with 2nd.Order moment fields
270 jmc 1.16 prec = precFloat64
271 jahn 1.11 DO iTracer = 1, PTRACERS_numInUse
272     IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
273    
274     IF (pickupSuff .EQ. ' ') THEN
275     WRITE(fn,'(3A,I10.10)') 'pickup_somTRAC',
276     & PTRACERS_ioLabel(iTracer),'.', myIter
277     ELSE
278     WRITE(fn,'(3A,A10)') 'pickup_somTRAC',
279     & PTRACERS_ioLabel(iTracer),'.', pickupSuff
280     ENDIF
281 jmc 1.16 ioUnit = standardMessageUnit
282 jmc 1.12 WRITE(msgBuf,'(A,I3,A)')'PTRACERS_READ_PICKUP: iTracer = ',
283 jmc 1.16 & iTracer, ' : reading 2nd-order moments from file:'
284     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
285     CALL PRINT_MESSAGE( fn, ioUnit, SQUEEZE_RIGHT, myThid )
286    
287     C- First check if pickup file exist
288     #ifdef ALLOW_MDSIO
289     useCurrentDir = .FALSE.
290     CALL MDS_CHECK4FILE(
291     I fn, '.data', 'PTRACERS_READ_PICKUP',
292     O filNam, fileExist,
293     I useCurrentDir, myThid )
294     #else
295     STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP: Needs MDSIO pkg'
296     #endif
297    
298     IF ( fileExist ) THEN
299     C- Read 2nd Order moments as consecutive records
300     DO n=1,nSOM
301 jahn 1.11 iRec = n
302     CALL READ_REC_3D_RL( fn, prec, Nr,
303 jmc 1.13 O _Ptracers_som(:,:,:,:,:,n,iTracer),
304 jahn 1.11 I iRec, myIter, myThid )
305 jmc 1.16 ENDDO
306     CALL GAD_EXCH_SOM( _Ptracers_som(:,:,:,:,:,:,iTracer),
307     & Nr, myThid )
308     ELSE
309     ioUnit = errorMessageUnit
310     IF ( pickupStrictlyMatch ) THEN
311     WRITE(msgBuf,'(4A)') 'PTRACERS_READ_PICKUP: ',
312     & 'try with " pickupStrictlyMatch=.FALSE.,"',
313     & ' in file: "data", NameList: "PARM03"'
314     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
315     STOP 'ABNORMAL END: S/R PTRACERS_READ_PICKUP'
316     ELSE
317     WRITE(msgBuf,'(2A)') 'WARNING >> PTRACERS_READ_PICKUP: ',
318     & 'approximated restart: reset Ptr_SOM to zero'
319     CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
320     ENDIF
321     ENDIF
322 jahn 1.11 ENDIF
323     ENDDO
324 jmc 1.16
325     C-- end: pickup_read_mdsio, SOM pickups
326     c ENDIF
327 jmc 1.12 #endif /* PTRACERS_ALLOW_DYN_STATE */
328 jmc 1.1
329     #endif /* ALLOW_PTRACERS */
330    
331     RETURN
332     END

  ViewVC Help
Powered by ViewVC 1.1.22