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

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

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

revision 1.9 by jmc, Sat May 16 13:37:38 2009 UTC revision 1.10 by jmc, Mon Jun 1 14:20:31 2009 UTC
# Line 117  C !LOCAL VARIABLES: Line 117  C !LOCAL VARIABLES:
117        INTEGER length_of_rec        INTEGER length_of_rec
118        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
119        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
120          Real*4 r4loc(sNx,sNy)
121          Real*8 r8loc(sNx,sNy)
122        INTEGER tNx, tNy, global_nTx        INTEGER tNx, tNy, global_nTx
123        INTEGER tBx, tBy, iGjLoc, jGjLoc        INTEGER tBx, tBy, iGjLoc, jGjLoc
124  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
# Line 199  C globalFile is too slow, then try using Line 201  C globalFile is too slow, then try using
201  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
202         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
203           WRITE(dataFName,'(2a)') fName(1:IL),'.data'           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
204           length_of_rec=MDS_RECLEN(filePrec,xSize*ySize,myThid)           length_of_rec = MDS_RECLEN( filePrec, xSize*ySize, myThid )
205           IF (irecord .EQ. 1) THEN           IF (irecord .EQ. 1) THEN
206            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
207       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
# Line 215  C Gather array and WRITE it to file, one Line 217  C Gather array and WRITE it to file, one
217  C-      copy from arr(level=k) to 2-D "local":  C-      copy from arr(level=k) to 2-D "local":
218          IF ( filePrec.EQ.precFloat32 ) THEN          IF ( filePrec.EQ.precFloat32 ) THEN
219            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
220              CALL MDS_PASS_R4toRS( sharedLocBuf_r4,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
221       &                            arr, k, kSize, .FALSE., myThid )       I                            k, kSize, 0,0, .FALSE., myThid )
222            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
223              CALL MDS_PASS_R4toRL( sharedLocBuf_r4,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
224       &                            arr, k, kSize, .FALSE., myThid )       I                            k, kSize, 0,0, .FALSE., myThid )
225            ELSE            ELSE
226              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
227       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 233  C-      copy from arr(level=k) to 2-D "l Line 235  C-      copy from arr(level=k) to 2-D "l
235       I                       useExch2ioLayOut, zeroBuff, myThid )       I                       useExch2ioLayOut, zeroBuff, myThid )
236          ELSEIF ( filePrec.EQ.precFloat64 ) THEN          ELSEIF ( filePrec.EQ.precFloat64 ) THEN
237            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
238              CALL MDS_PASS_R8toRS( sharedLocBuf_r8,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
239       &                            arr, k, kSize, .FALSE., myThid )       I                            k, kSize, 0,0, .FALSE., myThid )
240            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
241              CALL MDS_PASS_R8toRL( sharedLocBuf_r8,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
242       &                            arr, k, kSize, .FALSE., myThid )       I                            k, kSize, 0,0, .FALSE., myThid )
243            ELSE            ELSE
244              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
245       &         ' MDS_WRITE_FIELD: illegal value for arrType'       &         ' MDS_WRITE_FIELD: illegal value for arrType'
# Line 257  C-      copy from arr(level=k) to 2-D "l Line 259  C-      copy from arr(level=k) to 2-D "l
259          ENDIF          ENDIF
260    
261          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
262            irec=k+1-kLo+nNz*(irecord-1)            irec = 1 + k-kLo + (irecord-1)*nNz
263            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
264  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
265             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
# Line 294  C Only do I/O if I am the master thread Line 296  C Only do I/O if I am the master thread
296  C If we are writing to a global file then we open it here  C If we are writing to a global file then we open it here
297          IF (globalFile) THEN          IF (globalFile) THEN
298           WRITE(dataFName,'(2a)') fName(1:IL),'.data'           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
299             length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
300           IF (irecord .EQ. 1) THEN           IF (irecord .EQ. 1) THEN
           length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )  
301            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,            OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
302       &            access='direct', recl=length_of_rec )       &            access='direct', recl=length_of_rec )
           fileIsOpen=.TRUE.  
303           ELSE           ELSE
           length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )  
304            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,            OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
305       &            access='direct', recl=length_of_rec )       &            access='direct', recl=length_of_rec )
           fileIsOpen=.TRUE.  
306           ENDIF           ENDIF
307             fileIsOpen=.TRUE.
308          ENDIF          ENDIF
309    
310  C Loop over all tiles  C Loop over all tiles
311          DO bj=1,nSy          DO bj=1,nSy
312           DO bi=1,nSx           DO bi=1,nSx
 C If we are writing to a tiled MDS file then we open each one here  
           IF (.NOT. globalFile) THEN  
            iG=bi+(myXGlobalLo-1)/sNx  
            jG=bj+(myYGlobalLo-1)/sNy  
            WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')  
      &              pfName(1:pIL),'.',iG,'.',jG,'.data'  
            IF (irecord .EQ. 1) THEN  
             length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )  
             OPEN( dUnit, file=dataFName, status=_NEW_STATUS,  
      &            access='direct', recl=length_of_rec )  
             fileIsOpen=.TRUE.  
            ELSE  
             length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )  
             OPEN( dUnit, file=dataFName, status=_OLD_STATUS,  
      &            access='direct', recl=length_of_rec )  
             fileIsOpen=.TRUE.  
            ENDIF  
           ENDIF  
313    
314            IF (fileIsOpen) THEN            tNx = sNx
315             tNx = sNx            tNy = sNy
316             tNy = sNy            global_nTx = xSize/sNx
317             global_nTx = xSize/sNx            tBx = myXGlobalLo-1 + (bi-1)*sNx
318             tBx = myXGlobalLo-1 + (bi-1)*sNx            tBy = myYGlobalLo-1 + (bj-1)*sNy
            tBy = myYGlobalLo-1 + (bj-1)*sNy  
319  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
320             IF ( useExch2ioLayOut ) THEN            IF ( useExch2ioLayOut ) THEN
321               tN = W2_myTileList(bi)              tN = W2_myTileList(bi)
322  c            tNx = exch2_tNx(tN)  c           tNx = exch2_tNx(tN)
323  c            tNy = exch2_tNy(tN)  c           tNy = exch2_tNy(tN)
324  c            global_nTx = exch2_global_Nx/tNx  c           global_nTx = exch2_global_Nx/tNx
325               tBx = exch2_txGlobalo(tN) - 1              tBx = exch2_txGlobalo(tN) - 1
326               tBy = exch2_tyGlobalo(tN) - 1              tBy = exch2_tyGlobalo(tN) - 1
327               IF   ( exch2_mydNx(tN) .GT. xSize ) THEN              IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
328  C-           face x-size larger than glob-size : fold it  C-          face x-size larger than glob-size : fold it
329                 iGjLoc = 0                iGjLoc = 0
330                 jGjLoc = exch2_mydNx(tN) / xSize                jGjLoc = exch2_mydNx(tN) / xSize
331               ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN              ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
332  C-           tile y-size larger than glob-size : make a long line  C-          tile y-size larger than glob-size : make a long line
333                 iGjLoc = exch2_mydNx(tN)                iGjLoc = exch2_mydNx(tN)
334                 jGjLoc = 0                jGjLoc = 0
335               ELSE              ELSE
336  C-           default (face fit into global-IO-array)  C-          default (face fit into global-IO-array)
337                 iGjLoc = 0                iGjLoc = 0
338                 jGjLoc = 1                jGjLoc = 1
339               ENDIF              ENDIF
340             ENDIF            ENDIF
341  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
342             DO k=1,nNz  
343              IF (globalFile) THEN
344    C--- Case of 1 Global file:
345    
346               DO k=kLo,kHi
347              DO j=1,tNy              DO j=1,tNy
348               IF (globalFile) THEN               irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx
349                irec = 1 + ( tBx + (j-1)*iGjLoc )/tNx       &                + ( tBy + (j-1)*jGjLoc )*global_nTx
350       &                 + ( tBy + (j-1)*jGjLoc )*global_nTx       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
      &             +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize  
              ELSE  
               irec = j + ( k-kLo + (irecord-1)*nNz )*sNy  
              ENDIF  
351               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
352                IF (arrType .EQ. 'RS') THEN                IF (arrType .EQ. 'RS') THEN
353                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )                 CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg,.FALSE.,arr )
# Line 407  C End of j loop Line 388  C End of j loop
388              ENDDO              ENDDO
389  C End of k loop  C End of k loop
390             ENDDO             ENDDO
391    
392            ELSE            ELSE
393  C fileIsOpen=F  C--- Case of 1 file per tile (globalFile=F):
394             WRITE(msgBuf,'(A)')  
395       &       ' MDS_WRITE_FIELD: I should never get to this point'  C If we are writing to a tiled MDS file then we open each one here
396             CALL PRINT_ERROR( msgBuf, myThid )             iG=bi+(myXGlobalLo-1)/sNx
397             STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'             jG=bj+(myYGlobalLo-1)/sNy
398            ENDIF             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
399  C If we were writing to a tiled MDS file then we close it here       &              pfName(1:pIL),'.',iG,'.',jG,'.data'
400            IF (fileIsOpen .AND. (.NOT. globalFile)) THEN             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy, myThid )
401             CLOSE( dUnit )             IF (irecord .EQ. 1) THEN
402             fileIsOpen = .FALSE.              OPEN( dUnit, file=dataFName, status=_NEW_STATUS,
403         &            access='direct', recl=length_of_rec )
404               ELSE
405                OPEN( dUnit, file=dataFName, status=_OLD_STATUS,
406         &            access='direct', recl=length_of_rec )
407               ENDIF
408               fileIsOpen=.TRUE.
409    
410               DO k=kLo,kHi
411    
412                 irec = 1 + k-kLo + (irecord-1)*nNz
413                 IF (filePrec .EQ. precFloat32) THEN
414                  IF ( arrType.EQ.'RS' ) THEN
415                   CALL MDS_PASS_R4toRS( r4loc, arr,
416         I                           k, kSize, bi,bj,.FALSE., myThid )
417                  ELSEIF ( arrType.EQ.'RL' ) THEN
418                   CALL MDS_PASS_R4toRL( r4loc, arr,
419         I                           k, kSize, bi,bj,.FALSE., myThid )
420                  ELSE
421                   WRITE(msgBuf,'(A)')
422         &           ' MDS_WRITE_FIELD: illegal value for arrType'
423                   CALL PRINT_ERROR( msgBuf, myThid )
424                   STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
425                  ENDIF
426    #ifdef _BYTESWAPIO
427                  CALL MDS_BYTESWAPR4( sNx*sNy, r4loc )
428    #endif
429                  WRITE(dUnit,rec=irec) r4loc
430                 ELSEIF (filePrec .EQ. precFloat64) THEN
431                  IF ( arrType.EQ.'RS' ) THEN
432                   CALL MDS_PASS_R8toRS( r8loc, arr,
433         I                           k, kSize, bi,bj,.FALSE., myThid )
434                  ELSEIF ( arrType.EQ.'RL' ) THEN
435                   CALL MDS_PASS_R8toRL( r8loc, arr,
436         I                           k, kSize, bi,bj,.FALSE., myThid )
437                  ELSE
438                   WRITE(msgBuf,'(A)')
439         &           ' MDS_WRITE_FIELD: illegal value for arrType'
440                   CALL PRINT_ERROR( msgBuf, myThid )
441                   STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
442                  ENDIF
443    #ifdef _BYTESWAPIO
444                  CALL MDS_BYTESWAPR8( sNx*sNy, r8loc )
445    #endif
446                  WRITE(dUnit,rec=irec) r8loc
447                 ELSE
448                  WRITE(msgBuf,'(A)')
449         &          ' MDS_WRITE_FIELD: illegal value for filePrec'
450                  CALL PRINT_ERROR( msgBuf, myThid )
451                  STOP 'ABNORMAL END: S/R MDS_WRITE_FIELD'
452                 ENDIF
453    
454    C End of k loop
455               ENDDO
456    
457    C here We close the tiled MDS file
458               IF ( fileIsOpen ) THEN
459                CLOSE( dUnit )
460                fileIsOpen = .FALSE.
461               ENDIF
462    
463    C--- End Global File / tile-file cases
464            ENDIF            ENDIF
465    
466  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
467            IF ( .NOT.globalFile .AND. writeMetaF ) THEN            IF ( .NOT.globalFile .AND. writeMetaF ) THEN
468             iG=bi+(myXGlobalLo-1)/sNx             iG=bi+(myXGlobalLo-1)/sNx
# Line 434  C Create meta-file for each tile if we a Line 478  C Create meta-file for each tile if we a
478             dimList(1,3) = nNz             dimList(1,3) = nNz
479             dimList(2,3) = 1             dimList(2,3) = 1
480             dimList(3,3) = nNz             dimList(3,3) = nNz
481    c          dimList(1,3) = kSize
482    c          dimList(2,3) = kLo
483    c          dimList(3,3) = kHi
484             nDims = 3             nDims = 3
485             IF ( nNz.EQ.1 ) nDims = 2             IF ( nNz.EQ.1 ) nDims = 2
486             map2gl(1) = iGjLoc             map2gl(1) = iGjLoc
# Line 443  C Create meta-file for each tile if we a Line 490  C Create meta-file for each tile if we a
490       I              filePrec, nDims,dimList,map2gl, 0,  ' ',       I              filePrec, nDims,dimList,map2gl, 0,  ' ',
491       I              0, UNSET_RL, irecord, myIter, myThid )       I              0, UNSET_RL, irecord, myIter, myThid )
492            ENDIF            ENDIF
493    
494  C End of bi,bj loops  C End of bi,bj loops
495           ENDDO           ENDDO
496          ENDDO          ENDDO
# Line 472  C Create meta-file for the global-file ( Line 520  C Create meta-file for the global-file (
520           dimList(1,3) = nNz           dimList(1,3) = nNz
521           dimList(2,3) = 1           dimList(2,3) = 1
522           dimList(3,3) = nNz           dimList(3,3) = nNz
523    c        dimList(1,3) = kSize
524    c        dimList(2,3) = kLo
525    c        dimList(3,3) = kHi
526           nDims = 3           nDims = 3
527           IF ( nNz.EQ.1 ) nDims = 2           IF ( nNz.EQ.1 ) nDims = 2
528           map2gl(1) = 0           map2gl(1) = 0
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22