/[MITgcm]/MITgcm/pkg/mdsio/mdsio_write_field.F
ViewVC logotype

Annotation of /MITgcm/pkg/mdsio/mdsio_write_field.F

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

Revision 1.11 - (hide annotations) (download)
Mon Jun 8 03:32:33 2009 UTC (16 years ago) by jmc
Branch: MAIN
Changes since 1.10: +149 -142 lines 
 - do tiled IO in 1 piece (all levels at a time)
 - multi-threaded: allow to read/write local (non-shared) array
   (was already working with singleCpuIO ; now works also without);
 - move barrier calls outside gather/scatter_2d to mds_read/write field
1 jmc 1.11 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_field.F,v 1.10 2009/06/01 14:20:31 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "MDSIO_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: MDS_WRITE_FIELD
8     C !INTERFACE:
9     SUBROUTINE MDS_WRITE_FIELD(
10     I fName,
11     I filePrec,
12     I globalFile,
13     I useCurrentDir,
14     I arrType,
15 jmc 1.4 I kSize,kLo,kHi,
16 jmc 1.1 I arr,
17     I jrecord,
18     I myIter,
19     I myThid )
20    
21     C !DESCRIPTION:
22     C Arguments:
23     C
24     C fName (string) :: base name for file to write
25     C filePrec (integer) :: number of bits per word in file (32 or 64)
26     C globalFile (logical):: selects between writing a global or tiled file
27     C useCurrentDir(logic):: always write to the current directory (even if
28     C "mdsioLocalDir" is set)
29     C arrType (char(2)) :: declaration of "arr": either "RS" or "RL"
30 jmc 1.4 C kSize (integer) :: size of third dimension: normally either 1 or Nr
31     C kLo (integer) :: 1rst vertical level (of array "arr") to write
32     C kHi (integer) :: last vertical level (of array "arr") to write
33     C arr ( RS/RL ) :: array to write, arr(:,:,kSize,:,:)
34 jmc 1.1 C irecord (integer) :: record number to write
35     C myIter (integer) :: time step number
36     C myThid (integer) :: thread identifier
37     C
38     C MDS_WRITE_FIELD creates either a file of the form "fName.data" and
39 jmc 1.4 C "fName.meta" if the logical flag "globalFile" is set true. Otherwise
40     C it creates MDS tiled files of the form "fName.xxx.yyy.data" and
41     C "fName.xxx.yyy.meta". If jrecord > 0, a meta-file is created.
42 jmc 1.1 C Currently, the meta-files are not read because it is difficult
43 jmc 1.4 C to parse files in fortran. We should read meta information before
44     C adding records to an existing multi-record file.
45 jmc 1.1 C The precision of the file is decsribed by filePrec, set either
46 jmc 1.4 C to floatPrec32 or floatPrec64. The precision or declaration of
47     C the array argument must be consistently described by the char*(2)
48     C string arrType, either "RS" or "RL".
49     C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with
50     C the option to only write a sub-set of consecutive vertical levels (from
51     C kLo to kHi); (kSize,kLo,kHi)=(1,1,1) implies a 2-D model field and
52     C (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field.
53     C irecord=|jrecord| is the record number to be written and must be >= 1.
54     C NOTE: It is currently assumed that the highest record number in the file
55     C was the last record written. Nor is there a consistency check between the
56     C routine arguments and file, i.e., if you write record 2 after record 4
57     C the meta information will record the number of records to be 2. This,
58     C again, is because we have read the meta information. To be fixed.
59 jmc 1.1 C
60     C Created: 03/16/99 adcroft@mit.edu
61     C Changed: 01/06/02 menemenlis@jpl.nasa.gov
62     C added useSingleCpuIO hack
63     C changed: 1/23/04 afe@ocean.mit.edu
64     C added exch2 handling -- yes, the globalfile logic is nuts
65     CEOP
66    
67     C !USES:
68     IMPLICIT NONE
69     C Global variables / common blocks
70     #include "SIZE.h"
71     #include "EEPARAMS.h"
72     #include "PARAMS.h"
73     #ifdef ALLOW_EXCH2
74 jmc 1.8 #include "W2_EXCH2_SIZE.h"
75 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.h"
76 jmc 1.9 #include "W2_EXCH2_PARAMS.h"
77 jmc 1.1 #endif /* ALLOW_EXCH2 */
78 jmc 1.9 #include "EEBUFF_SCPU.h"
79 jmc 1.11 #include "MDSIO_BUFF_3D.h"
80 jmc 1.1
81     C !INPUT PARAMETERS:
82     CHARACTER*(*) fName
83     INTEGER filePrec
84     LOGICAL globalFile
85     LOGICAL useCurrentDir
86     CHARACTER*(2) arrType
87 jmc 1.4 INTEGER kSize, kLo, kHi
88 jmc 1.1 cph(
89     cph Real arr(*)
90 jmc 1.4 _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,kSize,nSx,nSy)
91 jmc 1.1 cph)
92     INTEGER jrecord
93     INTEGER myIter
94     INTEGER myThid
95     C !OUTPUT PARAMETERS:
96    
97     C !FUNCTIONS
98     INTEGER ILNBLNK
99     INTEGER MDS_RECLEN
100     LOGICAL MASTER_CPU_IO
101     EXTERNAL ILNBLNK
102     EXTERNAL MDS_RECLEN
103     EXTERNAL MASTER_CPU_IO
104    
105     C !LOCAL VARIABLES:
106 jmc 1.11 C bBij :: base shift in Buffer index for tile bi,bj
107 jmc 1.1 CHARACTER*(MAX_LEN_FNAM) dataFName,metaFName,pfName
108     CHARACTER*(MAX_LEN_MBUF) msgBuf
109     LOGICAL fileIsOpen
110     LOGICAL iAmDoingIO
111     LOGICAL writeMetaF
112 jmc 1.9 LOGICAL useExch2ioLayOut
113 jmc 1.6 LOGICAL zeroBuff
114     INTEGER xSize, ySize
115 jmc 1.1 INTEGER irecord
116 jmc 1.11 INTEGER iG,jG,bi,bj
117     INTEGER i1,i2,i,j,k,nNz
118 jmc 1.4 INTEGER irec,dUnit,IL,pIL
119 jmc 1.2 INTEGER dimList(3,3), nDims, map2gl(2)
120 jahn 1.5 INTEGER length_of_rec
121 jmc 1.11 INTEGER bBij
122 jmc 1.9 INTEGER tNx, tNy, global_nTx
123     INTEGER tBx, tBy, iGjLoc, jGjLoc
124 jmc 1.1 #ifdef ALLOW_EXCH2
125 jmc 1.9 INTEGER tN
126 jmc 1.1 #endif /* ALLOW_EXCH2 */
127    
128     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
129 jmc 1.6 C Set dimensions:
130     xSize = Nx
131     ySize = Ny
132 jmc 1.9 useExch2ioLayOut = .FALSE.
133     #ifdef ALLOW_EXCH2
134     IF ( W2_useE2ioLayOut ) THEN
135     xSize = exch2_global_Nx
136     ySize = exch2_global_Ny
137     useExch2ioLayOut = .TRUE.
138     ENDIF
139     #endif /* ALLOW_EXCH2 */
140 jmc 1.1
141 jmc 1.2 C- default:
142     iGjLoc = 0
143     jGjLoc = 1
144    
145 jmc 1.1 C Assume nothing
146     fileIsOpen = .FALSE.
147     IL = ILNBLNK( fName )
148     pIL = ILNBLNK( mdsioLocalDir )
149 jmc 1.4 nNz = 1 + kHi - kLo
150 jmc 1.1 irecord = ABS(jrecord)
151     writeMetaF = jrecord.GT.0
152    
153     C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):
154     iAmDoingIO = MASTER_CPU_IO(myThid)
155    
156     C Record number must be >= 1
157 jmc 1.11 IF (irecord .LT. 1) THEN
158     WRITE(msgBuf,'(A,I9.8)')
159     & ' MDS_WRITE_FIELD: argument irecord = ',irecord
160     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
161     & SQUEEZE_RIGHT , myThid)
162 jmc 1.1 WRITE(msgBuf,'(A)')
163 jmc 1.11 & ' MDS_WRITE_FIELD: invalid value for irecord'
164     CALL PRINT_ERROR( msgBuf, myThid )
165     CALL ALL_PROC_DIE( myThid )
166     STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
167     ENDIF
168 jmc 1.4 C check for valid sub-set of levels:
169 jmc 1.11 IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
170     WRITE(msgBuf,'(3(A,I6))')
171     & ' MDS_WRITE_FIELD: arguments kSize=', kSize,
172     & ' , kLo=', kLo, ' , kHi=', kHi
173     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
174     & SQUEEZE_RIGHT , myThid)
175     WRITE(msgBuf,'(A)')
176     & ' MDS_WRITE_FIELD: invalid sub-set of levels'
177     CALL PRINT_ERROR( msgBuf, myThid )
178     CALL ALL_PROC_DIE( myThid )
179     STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
180     ENDIF
181     C check for 3-D Buffer size:
182     IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
183     WRITE(msgBuf,'(3(A,I6))')
184     & ' MDS_WRITE_FIELD: Nb Lev to write =', nNz,
185     & ' >', size3dBuf, ' = buffer 3rd Dim'
186     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
187     & SQUEEZE_RIGHT , myThid)
188     WRITE(msgBuf,'(A)')
189     & ' MDS_WRITE_FIELD: buffer 3rd Dim. too small'
190     CALL PRINT_ERROR( msgBuf, myThid )
191     WRITE(msgBuf,'(A)')
192     & ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
193     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
194     & SQUEEZE_RIGHT , myThid)
195     CALL ALL_PROC_DIE( myThid )
196     STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
197     ENDIF
198    
199     C Only do I/O if I am the master thread
200     IF ( iAmDoingIO ) THEN
201 jmc 1.1
202     C Assign special directory
203     IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
204     pfName = fName
205     ELSE
206     WRITE(pfName,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL)
207     ENDIF
208     pIL=ILNBLNK( pfName )
209    
210     C Assign a free unit number as the I/O channel for this routine
211     CALL MDSFINDUNIT( dUnit, myThid )
212    
213     C- endif iAmDoingIO
214     ENDIF
215    
216     C If option globalFile is desired but does not work or if
217     C globalFile is too slow, then try using single-CPU I/O.
218     IF (useSingleCpuIO) THEN
219    
220     C Master thread of process 0, only, opens a global file
221     IF ( iAmDoingIO ) THEN
222     WRITE(dataFName,'(2a)') fName(1:IL),'.data'
223 jmc 1.10 length_of_rec = MDS_RECLEN( filePrec, xSize*ySize, myThid )
224 jmc 1.1 IF (irecord .EQ. 1) THEN
225     OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
226     & access='direct', recl=length_of_rec )
227     ELSE
228     OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
229     & access='direct', recl=length_of_rec )
230     ENDIF
231     ENDIF
232    
233 jmc 1.11 C Gather array and write it to file, one vertical level at a time
234 jmc 1.4 DO k=kLo,kHi
235 jmc 1.7 zeroBuff = k.EQ.kLo
236 jmc 1.1 C- copy from arr(level=k) to 2-D "local":
237 jmc 1.7 IF ( filePrec.EQ.precFloat32 ) THEN
238     IF ( arrType.EQ.'RS' ) THEN
239 jmc 1.10 CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
240 jmc 1.11 I 1, k, kSize, 0, 0, .FALSE., myThid )
241 jmc 1.7 ELSEIF ( arrType.EQ.'RL' ) THEN
242 jmc 1.10 CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
243 jmc 1.11 I 1, k, kSize, 0, 0, .FALSE., myThid )
244 jmc 1.7 ELSE
245     WRITE(msgBuf,'(A)')
246     & ' MDS_WRITE_FIELD: illegal value for arrType'
247     CALL PRINT_ERROR( msgBuf, myThid )
248 jmc 1.11 CALL ALL_PROC_DIE( myThid )
249 jmc 1.7 STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
250     ENDIF
251 jmc 1.11 C Wait for all threads to finish filling shared buffer
252     CALL BAR2( myThid )
253 jmc 1.7 CALL GATHER_2D_R4(
254 jmc 1.9 O xy_buffer_r4,
255     I sharedLocBuf_r4,
256 jmc 1.7 I xSize, ySize,
257 jmc 1.9 I useExch2ioLayOut, zeroBuff, myThid )
258 jmc 1.7 ELSEIF ( filePrec.EQ.precFloat64 ) THEN
259     IF ( arrType.EQ.'RS' ) THEN
260 jmc 1.10 CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
261 jmc 1.11 I 1, k, kSize, 0, 0, .FALSE., myThid )
262    
263 jmc 1.7 ELSEIF ( arrType.EQ.'RL' ) THEN
264 jmc 1.10 CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
265 jmc 1.11 I 1, k, kSize, 0, 0, .FALSE., myThid )
266 jmc 1.7 ELSE
267     WRITE(msgBuf,'(A)')
268     & ' MDS_WRITE_FIELD: illegal value for arrType'
269     CALL PRINT_ERROR( msgBuf, myThid )
270 jmc 1.11 CALL ALL_PROC_DIE( myThid )
271 jmc 1.7 STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
272     ENDIF
273 jmc 1.11 C Wait for all threads to finish filling shared buffer
274     CALL BAR2( myThid )
275 jmc 1.7 CALL GATHER_2D_R8(
276 jmc 1.9 O xy_buffer_r8,
277     I sharedLocBuf_r8,
278 jmc 1.7 I xSize, ySize,
279 jmc 1.9 I useExch2ioLayOut, zeroBuff, myThid )
280 jmc 1.1 ELSE
281 jmc 1.7 WRITE(msgBuf,'(A)')
282     & ' MDS_WRITE_FIELD: illegal value for filePrec'
283     CALL PRINT_ERROR( msgBuf, myThid )
284 jmc 1.11 CALL ALL_PROC_DIE( myThid )
285 jmc 1.7 STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
286 jmc 1.1 ENDIF
287 jmc 1.11 C Make other threads wait for "gather" completion so that after this,
288     C shared buffer can again be modified by any thread
289     CALL BAR2( myThid )
290 jmc 1.1
291     IF ( iAmDoingIO ) THEN
292 jmc 1.10 irec = 1 + k-kLo + (irecord-1)*nNz
293 jmc 1.11 IF ( filePrec.EQ.precFloat32 ) THEN
294 jmc 1.2 #ifdef _BYTESWAPIO
295 jmc 1.6 CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
296 jmc 1.2 #endif
297 jmc 1.6 WRITE(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
298 jmc 1.11 ELSE
299 jmc 1.1 #ifdef _BYTESWAPIO
300 jmc 1.6 CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
301 jmc 1.1 #endif
302 jmc 1.6 WRITE(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
303 jmc 1.1 ENDIF
304 jmc 1.2 C- end if iAmDoingIO
305 jmc 1.1 ENDIF
306 jmc 1.2 C- end of k loop
307 jmc 1.1 ENDDO
308    
309     C Close data-file
310     IF ( iAmDoingIO ) THEN
311     CLOSE( dUnit )
312     ENDIF
313    
314     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
315     C--- else .NOT.useSingleCpuIO
316     ELSE
317    
318 jmc 1.11 C--- Copy from arr to 3-D buffer (multi-threads):
319     IF ( filePrec.EQ.precFloat32 ) THEN
320     IF ( arrType.EQ.'RS' ) THEN
321     CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,
322     I nNz, kLo, kSize, 0,0, .FALSE., myThid )
323     ELSEIF ( arrType.EQ.'RL' ) THEN
324     CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
325     I nNz, kLo, kSize, 0,0, .FALSE., myThid )
326     ELSE
327     WRITE(msgBuf,'(A)')
328     & ' MDS_WRITE_FIELD: illegal value for arrType'
329     CALL PRINT_ERROR( msgBuf, myThid )
330     CALL ALL_PROC_DIE( myThid )
331     STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
332     ENDIF
333     ELSEIF ( filePrec.EQ.precFloat64 ) THEN
334     IF ( arrType.EQ.'RS' ) THEN
335     CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,
336     I nNz, kLo, kSize, 0,0, .FALSE., myThid )
337     ELSEIF ( arrType.EQ.'RL' ) THEN
338     CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
339     I nNz, kLo, kSize, 0,0, .FALSE., myThid )
340     ELSE
341     WRITE(msgBuf,'(A)')
342     & ' MDS_WRITE_FIELD: illegal value for arrType'
343     CALL PRINT_ERROR( msgBuf, myThid )
344     CALL ALL_PROC_DIE( myThid )
345     STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
346     ENDIF
347     ELSE
348     WRITE(msgBuf,'(A)')
349     & ' MDS_WRITE_FIELD: illegal value for filePrec'
350     CALL PRINT_ERROR( msgBuf, myThid )
351     CALL ALL_PROC_DIE( myThid )
352     STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
353     ENDIF
354    
355     C Wait for all threads to finish filling shared buffer
356     CALL BAR2( myThid )
357    
358 jmc 1.1 C Only do I/O if I am the master thread
359     IF ( iAmDoingIO ) THEN
360    
361 jmc 1.11 #ifdef _BYTESWAPIO
362     IF ( filePrec.EQ.precFloat32 ) THEN
363     CALL MDS_BYTESWAPR4( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r4 )
364     ELSE
365     CALL MDS_BYTESWAPR8( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r8 )
366     ENDIF
367     #endif
368    
369 jmc 1.1 C If we are writing to a global file then we open it here
370     IF (globalFile) THEN
371 jmc 1.11 WRITE(dataFName,'(2a)') fName(1:IL),'.data'
372     length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
373     IF (irecord .EQ. 1) THEN
374     OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
375     & access='direct', recl=length_of_rec )
376     ELSE
377     OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
378     & access='direct', recl=length_of_rec )
379     ENDIF
380     fileIsOpen=.TRUE.
381 jmc 1.1 ENDIF
382    
383     C Loop over all tiles
384     DO bj=1,nSy
385     DO bi=1,nSx
386 jmc 1.11 bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
387 jmc 1.2
388 jmc 1.10 tNx = sNx
389     tNy = sNy
390     global_nTx = xSize/sNx
391     tBx = myXGlobalLo-1 + (bi-1)*sNx
392     tBy = myYGlobalLo-1 + (bj-1)*sNy
393 jmc 1.1 #ifdef ALLOW_EXCH2
394 jmc 1.10 IF ( useExch2ioLayOut ) THEN
395     tN = W2_myTileList(bi)
396     c tNx = exch2_tNx(tN)
397     c tNy = exch2_tNy(tN)
398     c global_nTx = exch2_global_Nx/tNx
399     tBx = exch2_txGlobalo(tN) - 1
400     tBy = exch2_tyGlobalo(tN) - 1
401     IF ( exch2_mydNx(tN) .GT. xSize ) THEN
402     C- face x-size larger than glob-size : fold it
403     iGjLoc = 0
404     jGjLoc = exch2_mydNx(tN) / xSize
405     ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
406     C- tile y-size larger than glob-size : make a long line
407     iGjLoc = exch2_mydNx(tN)
408     jGjLoc = 0
409     ELSE
410     C- default (face fit into global-IO-array)
411     iGjLoc = 0
412     jGjLoc = 1
413     ENDIF
414     ENDIF
415 jmc 1.1 #endif /* ALLOW_EXCH2 */
416 jmc 1.10
417     IF (globalFile) THEN
418     C--- Case of 1 Global file:
419    
420     DO k=kLo,kHi
421 jmc 1.1 DO j=1,tNy
422 jmc 1.10 irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
423     & + ( tBy + (j-1)*jGjLoc )*global_nTx
424     & +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
425 jmc 1.11 i1 = bBij + 1 + (j-1)*sNx + (k-kLo)*sNx*sNy
426     i2 = bBij + j*sNx + (k-kLo)*sNx*sNy
427     IF ( filePrec.EQ.precFloat32 ) THEN
428     WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
429 jmc 1.1 ELSE
430 jmc 1.11 WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
431 jmc 1.1 ENDIF
432 jmc 1.11 C End of j,k loops
433 jmc 1.1 ENDDO
434     ENDDO
435 jmc 1.10
436 jmc 1.1 ELSE
437 jmc 1.10 C--- Case of 1 file per tile (globalFile=F):
438    
439     C If we are writing to a tiled MDS file then we open each one here
440     iG=bi+(myXGlobalLo-1)/sNx
441     jG=bj+(myYGlobalLo-1)/sNy
442     WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
443 jmc 1.11 & pfName(1:pIL),'.',iG,'.',jG,'.data'
444     length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
445 jmc 1.10 IF (irecord .EQ. 1) THEN
446     OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
447     & access='direct', recl=length_of_rec )
448     ELSE
449     OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
450     & access='direct', recl=length_of_rec )
451     ENDIF
452     fileIsOpen=.TRUE.
453    
454 jmc 1.11 irec = irecord
455     i1 = bBij + 1
456     i2 = bBij + sNx*sNy*nNz
457     IF ( filePrec.EQ.precFloat32 ) THEN
458     WRITE(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
459     ELSE
460     WRITE(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
461     ENDIF
462 jmc 1.10
463     C here We close the tiled MDS file
464     IF ( fileIsOpen ) THEN
465 jmc 1.11 CLOSE( dUnit )
466     fileIsOpen = .FALSE.
467 jmc 1.10 ENDIF
468    
469     C--- End Global File / tile-file cases
470 jmc 1.1 ENDIF
471 jmc 1.10
472 jmc 1.1 C Create meta-file for each tile if we are tiling
473     IF ( .NOT.globalFile .AND. writeMetaF ) THEN
474     iG=bi+(myXGlobalLo-1)/sNx
475     jG=bj+(myYGlobalLo-1)/sNy
476     WRITE(metaFname,'(2A,I3.3,A,I3.3,A)')
477     & pfName(1:pIL),'.',iG,'.',jG,'.meta'
478 jmc 1.6 dimList(1,1) = xSize
479 jmc 1.9 dimList(2,1) = tBx + 1
480     dimList(3,1) = tBx + tNx
481 jmc 1.6 dimList(1,2) = ySize
482 jmc 1.9 dimList(2,2) = tBy + 1
483     dimList(3,2) = tBy + tNy
484 jmc 1.6 dimList(1,3) = nNz
485     dimList(2,3) = 1
486     dimList(3,3) = nNz
487 jmc 1.10 c dimList(1,3) = kSize
488     c dimList(2,3) = kLo
489     c dimList(3,3) = kHi
490 jmc 1.6 nDims = 3
491     IF ( nNz.EQ.1 ) nDims = 2
492 jmc 1.2 map2gl(1) = iGjLoc
493     map2gl(2) = jGjLoc
494 jmc 1.1 CALL MDS_WRITE_META(
495     I metaFName, dataFName, the_run_name, ' ',
496 jmc 1.2 I filePrec, nDims,dimList,map2gl, 0, ' ',
497 jmc 1.1 I 0, UNSET_RL, irecord, myIter, myThid )
498     ENDIF
499 jmc 1.10
500 jmc 1.1 C End of bi,bj loops
501     ENDDO
502     ENDDO
503    
504     C If global file was opened then close it
505     IF (fileIsOpen .AND. globalFile) THEN
506 jmc 1.11 CLOSE( dUnit )
507     fileIsOpen = .FALSE.
508 jmc 1.1 ENDIF
509    
510     C- endif iAmDoingIO
511     ENDIF
512    
513 jmc 1.11 C Make other threads wait for I/O completion so that after this,
514     C 3-D buffer can again be modified by any thread
515     CALL BAR2( myThid )
516    
517 jmc 1.1 C if useSingleCpuIO / else / end
518     ENDIF
519    
520     C Create meta-file for the global-file (also if useSingleCpuIO)
521     IF ( writeMetaF .AND. iAmDoingIO .AND.
522     & (globalFile .OR. useSingleCpuIO) ) THEN
523     WRITE(metaFName,'(2A)') fName(1:IL),'.meta'
524 jmc 1.6 dimList(1,1) = xSize
525     dimList(2,1) = 1
526     dimList(3,1) = xSize
527     dimList(1,2) = ySize
528     dimList(2,2) = 1
529     dimList(3,2) = ySize
530     dimList(1,3) = nNz
531     dimList(2,3) = 1
532     dimList(3,3) = nNz
533 jmc 1.10 c dimList(1,3) = kSize
534     c dimList(2,3) = kLo
535     c dimList(3,3) = kHi
536 jmc 1.6 nDims = 3
537     IF ( nNz.EQ.1 ) nDims = 2
538 jmc 1.3 map2gl(1) = 0
539     map2gl(2) = 1
540 jmc 1.1 CALL MDS_WRITE_META(
541     I metaFName, dataFName, the_run_name, ' ',
542 jmc 1.2 I filePrec, nDims,dimList,map2gl, 0, ' ',
543 jmc 1.1 I 0, UNSET_RL, irecord, myIter, myThid )
544     c I metaFName, dataFName, the_run_name, titleLine,
545 jmc 1.2 c I filePrec, nDims, dimList, map2gl, nFlds, fldList,
546 jmc 1.1 c I nTimRec, timList, irecord, myIter, myThid )
547     ENDIF
548    
549     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
550     RETURN
551     END
  ViewVC Help
Powered by ViewVC 1.1.22