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

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

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

revision 1.7 by heimbach, Fri Aug 19 18:01:29 2005 UTC revision 1.8 by heimbach, Fri Aug 19 18:27:51 2005 UTC
# Line 69  C Global variables / common blocks Line 69  C Global variables / common blocks
69  #include "SIZE.h"  #include "SIZE.h"
70  #include "EEPARAMS.h"  #include "EEPARAMS.h"
71  #include "PARAMS.h"  #include "PARAMS.h"
 #include "EESUPPORT.h"  
72    
73  C Routine arguments  C Routine arguments
74        character*(*) fName        character*(*) fName
# Line 84  C Functions Line 83  C Functions
83        integer MDS_RECLEN        integer MDS_RECLEN
84  C Local variables  C Local variables
85        character*(80) dataFName        character*(80) dataFName
86        integer ip,jp,iG,jG,irec,bi,bj,i,ii,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,ii,k,dUnit,IL
87        logical exst        logical exst
88        _RL arr(1-oLx:sNx+oLx,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,Nr,nSx,nSy)
89        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 92  C Local variables Line 91  C Local variables
91        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
92        integer length_of_rec        integer length_of_rec
93        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
 cph-usesingle(  
       integer x_size  
       PARAMETER ( x_size = Nx )  
       Real*4 x_buffer_r4(x_size)  
       Real*8 x_buffer_r8(x_size)  
       Real*8 global(Nx)  
       _RL    local(1-OLx:sNx+OLx,nSx,nSy)  
 cph-usesingle)  
94  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
95    
96  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 125  C Assume nothing Line 116  C Assume nothing
116  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
117        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
118    
       if ( useSingleCPUIO ) then  
   
 #ifdef ALLOW_USE_MPI  
         IF( mpiMyId .EQ. 0 ) THEN  
 #else  
         IF ( .TRUE. ) THEN  
 #endif /* ALLOW_USE_MPI */  
   
 C Check first for global file with simple name (ie. fName)  
          dataFName = fName  
          inquire( file=dataFname, exist=exst )  
          if (exst) globalFile = .TRUE.  
   
 C If negative check for global file with MDS name (ie. fName.data)  
          if (.NOT. globalFile) then  
           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'  
           inquire( file=dataFname, exist=exst )  
           if (exst) globalFile = .TRUE.  
          endif  
   
 C If global file is visible to process 0, then open it here.  
 C Otherwise stop program.  
          if ( globalFile) then  
           length_of_rec=MDS_RECLEN( filePrec, x_size, mythid )  
           open( dUnit, file=dataFName, status='old',  
      &         access='direct', recl=length_of_rec )  
          else  
           write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName  
           call print_message( msgbuf, standardmessageunit,  
      &                        SQUEEZE_RIGHT , mythid)  
           call print_error( msgbuf, mythid )  
           write(msgbuf,'(a)')  
      &      ' MDSREADFIELD: File does not exist'  
           call print_message( msgbuf, standardmessageunit,  
      &                        SQUEEZE_RIGHT , mythid)  
           call print_error( msgbuf, mythid )  
           stop 'ABNORMAL END: S/R MDSREADFIELD'  
          endif  
   
         ENDIF  
   
 c-- useSingleCpuIO  
       else  
 C Only do I/O if I am the master thread  
   
119  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
120        dataFName = fName        dataFName = fName
121        inquire( file=dataFname, exist=exst )        inquire( file=dataFname, exist=exst )
# Line 193  C If negative check for global file with Line 139  C If negative check for global file with
139         endif         endif
140        endif        endif
141    
 c-- useSingleCpuIO  
       endif  
   
       if ( .not. useSingleCpuIO ) then  
       if ( .not. ( globalFile ) ) then  
   
 C If we are reading from a global file then we open it here  
       if (globalFile) then  
        length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )  
        open( dUnit, file=dataFName, status='old',  
      &      access='direct', recl=length_of_rec )  
        fileIsOpen=.TRUE.  
       endif  
   
142  C Loop over all processors      C Loop over all processors    
143        do jp=1,nPy        do jp=1,nPy
144        do ip=1,nPx        do ip=1,nPx
# Line 311  C If global file was opened then close i Line 243  C If global file was opened then close i
243         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
244        endif        endif
245    
 c      end of if ( .not. ( globalFile ) ) then  
       endif  
   
 c      else of if ( .not. ( useSingleCPUIO ) ) then  
       else  
   
        DO k=1,nNz  
   
 #ifdef ALLOW_USE_MPI  
          IF( mpiMyId .EQ. 0 ) THEN  
 #else  
          IF ( .TRUE. ) THEN  
 #endif /* ALLOW_USE_MPI */  
           irec = k+nNz*(irecord-1)  
           if (filePrec .eq. precFloat32) then  
            read(dUnit,rec=irec) x_buffer_r4  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR4( x_size, x_buffer_r4 )  
 #endif  
             DO I=1,Nx  
              global(I) = x_buffer_r4(I)  
             ENDDO  
           elseif (filePrec .eq. precFloat64) then  
            read(dUnit,rec=irec) x_buffer_r8  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR8( x_size, x_buffer_r8 )  
 #endif  
             DO I=1,Nx  
              global(I) = x_buffer_r8(I)  
             ENDDO  
           else  
            write(msgbuf,'(a)')  
      &            ' MDSREADFIELD: illegal value for filePrec'  
            call print_error( msgbuf, mythid )  
            stop 'ABNORMAL END: S/R MDSREADFIELD'  
           endif  
          ENDIF  
         DO jp=1,nPy  
          DO ip=1,nPx  
           DO bj = myByLo(myThid), myByHi(myThid)  
            DO bi = myBxLo(myThid), myBxHi(myThid)  
              DO I=1,sNx  
               II=((ip-1)*nSx+(bi-1))*sNx+I  
               arr_gl(i,bi,ip,bj,jp,k) = global(II)  
              ENDDO  
            ENDDO  
           ENDDO  
          ENDDO  
         ENDDO  
   
        ENDDO  
 c      ENDDO k=1,nNz  
   
         close( dUnit )  
   
       endif  
 c     end of if ( .not. ( useSingleCPUIO ) ) then  
   
246        _END_MASTER( myThid )        _END_MASTER( myThid )
247    
248  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 418  C Global variables / common blocks Line 292  C Global variables / common blocks
292  #include "SIZE.h"  #include "SIZE.h"
293  #include "EEPARAMS.h"  #include "EEPARAMS.h"
294  #include "PARAMS.h"  #include "PARAMS.h"
 #include "EESUPPORT.h"  
295    
296  C Routine arguments  C Routine arguments
297        character*(*) fName        character*(*) fName
# Line 433  C Functions Line 306  C Functions
306        integer MDS_RECLEN        integer MDS_RECLEN
307  C Local variables  C Local variables
308        character*(80) dataFName        character*(80) dataFName
309        integer ip,jp,iG,jG,irec,bi,bj,j,jj,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,jj,k,dUnit,IL
310        logical exst        logical exst
311        _RL arr(1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLy:sNy+oLy,Nr,nSx,nSy)
312        Real*4 r4seg(sNy)        Real*4 r4seg(sNy)
# Line 441  C Local variables Line 314  C Local variables
314        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
315        integer length_of_rec        integer length_of_rec
316        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
 cph-usesingle(  
       integer y_size  
       PARAMETER ( y_size = Ny )  
       Real*4 y_buffer_r4(y_size)  
       Real*8 y_buffer_r8(y_size)  
       Real*8 global(Ny)  
       _RL    local(1-OLy:sNy+OLy,nSx,nSy)  
 cph-usesingle)  
317  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
318    
319  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 474  C Assume nothing Line 339  C Assume nothing
339  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
340        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
341    
       if ( useSingleCPUIO ) then  
   
 #ifdef ALLOW_USE_MPI  
         IF( mpiMyId .EQ. 0 ) THEN  
 #else  
         IF ( .TRUE. ) THEN  
 #endif /* ALLOW_USE_MPI */  
   
 C Check first for global file with simple name (ie. fName)  
          dataFName = fName  
          inquire( file=dataFname, exist=exst )  
          if (exst) globalFile = .TRUE.  
   
 C If negative check for global file with MDS name (ie. fName.data)  
          if (.NOT. globalFile) then  
           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'  
           inquire( file=dataFname, exist=exst )  
           if (exst) globalFile = .TRUE.  
          endif  
   
 C If global file is visible to process 0, then open it here.  
 C Otherwise stop program.  
          if ( globalFile) then  
           length_of_rec=MDS_RECLEN( filePrec, y_size, mythid )  
           open( dUnit, file=dataFName, status='old',  
      &         access='direct', recl=length_of_rec )  
          else  
           write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName  
           call print_message( msgbuf, standardmessageunit,  
      &                        SQUEEZE_RIGHT , mythid)  
           call print_error( msgbuf, mythid )  
           write(msgbuf,'(a)')  
      &      ' MDSREADFIELD: File does not exist'  
           call print_message( msgbuf, standardmessageunit,  
      &                        SQUEEZE_RIGHT , mythid)  
           call print_error( msgbuf, mythid )  
           stop 'ABNORMAL END: S/R MDSREADFIELD'  
          endif  
   
         ENDIF  
   
 c-- useSingleCpuIO  
       else  
 C Only do I/O if I am the master thread  
   
342  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
343        dataFName = fName        dataFName = fName
344        inquire( file=dataFname, exist=exst )        inquire( file=dataFname, exist=exst )
# Line 541  C If negative check for global file with Line 361  C If negative check for global file with
361          globalFile = .TRUE.          globalFile = .TRUE.
362         endif         endif
363        endif        endif
   
 c-- useSingleCpuIO  
       endif  
   
       if ( .not. useSingleCpuIO ) then  
       if ( .not. ( globalFile ) ) then  
   
 C If we are reading from a global file then we open it here  
       if (globalFile) then  
        length_of_rec=MDS_RECLEN( filePrec, sNy, mythid )  
        open( dUnit, file=dataFName, status='old',  
      &      access='direct', recl=length_of_rec )  
        fileIsOpen=.TRUE.  
       endif  
   
364  C Loop over all processors      C Loop over all processors    
365        do jp=1,nPy        do jp=1,nPy
366        do ip=1,nPx        do ip=1,nPx
# Line 660  C If global file was opened then close i Line 465  C If global file was opened then close i
465         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
466        endif        endif
467    
 c      end of if ( .not. ( globalFile ) ) then  
       endif  
   
 c      else of if ( .not. ( useSingleCPUIO ) ) then  
       else  
   
        DO k=1,nNz  
   
 #ifdef ALLOW_USE_MPI  
          IF( mpiMyId .EQ. 0 ) THEN  
 #else  
          IF ( .TRUE. ) THEN  
 #endif /* ALLOW_USE_MPI */  
           irec = k+nNz*(irecord-1)  
           if (filePrec .eq. precFloat32) then  
            read(dUnit,rec=irec) y_buffer_r4  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR4( y_size, y_buffer_r4 )  
 #endif  
             DO J=1,Ny  
              global(J) = y_buffer_r4(J)  
             ENDDO  
           elseif (filePrec .eq. precFloat64) then  
            read(dUnit,rec=irec) y_buffer_r8  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR8( y_size, y_buffer_r8 )  
 #endif  
             DO J=1,Ny  
              global(J) = y_buffer_r8(J)  
             ENDDO  
           else  
            write(msgbuf,'(a)')  
      &            ' MDSREADFIELD: illegal value for filePrec'  
            call print_error( msgbuf, mythid )  
            stop 'ABNORMAL END: S/R MDSREADFIELD'  
           endif  
          ENDIF  
         DO jp=1,nPy  
          DO ip=1,nPx  
           DO bj = myByLo(myThid), myByHi(myThid)  
            DO bi = myBxLo(myThid), myBxHi(myThid)  
             DO J=1,sNy  
               JJ=((jp-1)*nSy+(bj-1))*sNy+J  
               arr_gl(bi,ip,j,bj,jp,k) = global(JJ)  
             ENDDO  
            ENDDO  
           ENDDO  
          ENDDO  
         ENDDO  
   
        ENDDO  
 c      ENDDO k=1,nNz  
   
         close( dUnit )  
   
       endif  
 c     end of if ( .not. ( useSingleCPUIO ) ) then  
   
468        _END_MASTER( myThid )        _END_MASTER( myThid )
469    
470  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 777  C Global variables / common blocks Line 524  C Global variables / common blocks
524  #include "SIZE.h"  #include "SIZE.h"
525  #include "EEPARAMS.h"  #include "EEPARAMS.h"
526  #include "PARAMS.h"  #include "PARAMS.h"
 #include "EESUPPORT.h"  
527    
528  C Routine arguments  C Routine arguments
529        character*(*) fName        character*(*) fName
# Line 796  C Functions Line 542  C Functions
542        integer MDS_RECLEN        integer MDS_RECLEN
543  C Local variables  C Local variables
544        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
545        integer ip,jp,iG,jG,irec,bi,bj,i,ii,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,ii,k,dUnit,IL
546        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
547        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
548        _RL arr(1-oLx:sNx+oLx,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,Nr,nSx,nSy)
# Line 804  C Local variables Line 550  C Local variables
550        integer length_of_rec        integer length_of_rec
551        logical fileIsOpen        logical fileIsOpen
552        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
 cph-usesingle(  
       integer x_size  
       PARAMETER ( x_size = Nx )  
       Real*4 x_buffer_r4(x_size)  
       Real*8 x_buffer_r8(x_size)  
       Real*8 global(Nx)  
 cph-usesingle)  
553  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
554    
555  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 835  C Assume nothing Line 574  C Assume nothing
574  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
575        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
576    
 cph-usesingle(  
 #ifdef ALLOW_USE_MPI  
       _END_MASTER( myThid )  
 C If option globalFile is desired but does not work or if  
 C globalFile is too slow, then try using single-CPU I/O.  
       if (useSingleCpuIO) then  
   
 C Master thread of process 0, only, opens a global file  
        _BEGIN_MASTER( myThid )  
         IF( mpiMyId .EQ. 0 ) THEN  
          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'  
          length_of_rec=MDS_RECLEN(filePrec,x_size,mythid)  
          if (irecord .EQ. 1) then  
           open( dUnit, file=dataFName, status=_NEW_STATUS,  
      &        access='direct', recl=length_of_rec )  
          else  
           open( dUnit, file=dataFName, status=_OLD_STATUS,  
      &        access='direct', recl=length_of_rec )  
          endif  
         ENDIF  
        _END_MASTER( myThid )  
   
 C Gather array and write it to file, one vertical level at a time  
        DO k=1,nNz  
 C Loop over all processors      
         do jp=1,nPy  
         do ip=1,nPx  
         DO bj = myByLo(myThid), myByHi(myThid)  
          DO bi = myBxLo(myThid), myBxHi(myThid)  
            DO I=1,sNx  
             II=((ip-1)*nSx+(bi-1))*sNx+I  
             global(II) = arr_gl(i,bi,ip,bj,jp,k)  
            ENDDO  
          ENDDO  
         ENDDO  
         enddo  
         enddo  
         _BEGIN_MASTER( myThid )  
          IF( mpiMyId .EQ. 0 ) THEN  
           irec=k+nNz*(irecord-1)  
           if (filePrec .eq. precFloat32) then  
             DO I=1,Nx  
              x_buffer_r4(I) = global(I)  
             ENDDO  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR4( x_size, x_buffer_r4 )  
 #endif  
            write(dUnit,rec=irec) x_buffer_r4  
           elseif (filePrec .eq. precFloat64) then  
             DO I=1,Nx  
              x_buffer_r8(I) = global(I)  
             ENDDO  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR8( x_size, x_buffer_r8 )  
 #endif  
            write(dUnit,rec=irec) x_buffer_r8  
           else  
            write(msgbuf,'(a)')  
      &       ' MDSWRITEFIELD: illegal value for filePrec'  
            call print_error( msgbuf, mythid )  
            stop 'ABNORMAL END: S/R MDSWRITEFIELD'  
           endif  
          ENDIF  
         _END_MASTER( myThid )  
        ENDDO  
   
 C Close data-file and create meta-file  
        _BEGIN_MASTER( myThid )  
         IF( mpiMyId .EQ. 0 ) THEN  
          close( dUnit )  
          write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'  
          dimList(1,1)=Nx  
          dimList(2,1)=1  
          dimList(3,1)=Nx  
          dimList(1,2)=1  
          dimList(2,2)=1  
          dimList(3,2)=1  
          dimList(1,3)=nNz  
          dimList(2,3)=1  
          dimList(3,3)=nNz  
          ndims=3  
          if (nNz .EQ. 1) ndims=2  
          call MDSWRITEMETA( metaFName, dataFName,  
      &     filePrec, ndims, dimList, irecord, myIter, mythid )  
         ENDIF  
        _END_MASTER( myThid )  
 C To be safe, make other processes wait for I/O completion  
        _BARRIER  
   
       elseif ( .NOT. useSingleCpuIO ) then  
       _BEGIN_MASTER( myThid )  
 #endif /* ALLOW_USE_MPI */  
 cph-usesingle)  
577    
578  C Loop over all processors      C Loop over all processors    
579        do jp=1,nPy        do jp=1,nPy
# Line 1033  C End of ip,jp loops Line 679  C End of ip,jp loops
679         enddo         enddo
680        enddo        enddo
681    
       _END_MASTER( myThid )  
682    
683  cph-usesingle(        _END_MASTER( myThid )
 #ifdef ALLOW_USE_MPI  
 C endif useSingleCpuIO  
       endif  
 #endif /* ALLOW_USE_MPI */  
 cph-usesingle)  
684    
685  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
686        return        return
# Line 1099  C Global variables / common blocks Line 739  C Global variables / common blocks
739  #include "SIZE.h"  #include "SIZE.h"
740  #include "EEPARAMS.h"  #include "EEPARAMS.h"
741  #include "PARAMS.h"  #include "PARAMS.h"
 #include "EESUPPORT.h"  
742    
743  C Routine arguments  C Routine arguments
744        character*(*) fName        character*(*) fName
# Line 1118  C Functions Line 757  C Functions
757        integer MDS_RECLEN        integer MDS_RECLEN
758  C Local variables  C Local variables
759        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
760        integer ip,jp,iG,jG,irec,bi,bj,j,jj,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,jj,k,dUnit,IL
761        Real*4 r4seg(sNy)        Real*4 r4seg(sNy)
762        Real*8 r8seg(sNy)        Real*8 r8seg(sNy)
763        _RL arr(1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLy:sNy+oLy,Nr,nSx,nSy)
# Line 1126  C Local variables Line 765  C Local variables
765        integer length_of_rec        integer length_of_rec
766        logical fileIsOpen        logical fileIsOpen
767        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
 cph-usesingle(  
       integer y_size  
       PARAMETER ( y_size = Ny )  
       Real*4 y_buffer_r4(y_size)  
       Real*8 y_buffer_r8(y_size)  
       Real*8 global(Ny)  
 cph-usesingle)  
768  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
769    
770  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 1157  C Assume nothing Line 789  C Assume nothing
789  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
790        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
791    
 cph-usesingle(  
 #ifdef ALLOW_USE_MPI  
       _END_MASTER( myThid )  
 C If option globalFile is desired but does not work or if  
 C globalFile is too slow, then try using single-CPU I/O.  
       if (useSingleCpuIO) then  
   
 C Master thread of process 0, only, opens a global file  
        _BEGIN_MASTER( myThid )  
         IF( mpiMyId .EQ. 0 ) THEN  
          write(dataFname(1:80),'(2a)') fName(1:IL),'.data'  
          length_of_rec=MDS_RECLEN(filePrec,y_size,mythid)  
          if (irecord .EQ. 1) then  
           open( dUnit, file=dataFName, status=_NEW_STATUS,  
      &        access='direct', recl=length_of_rec )  
          else  
           open( dUnit, file=dataFName, status=_OLD_STATUS,  
      &        access='direct', recl=length_of_rec )  
          endif  
         ENDIF  
        _END_MASTER( myThid )  
   
 C Gather array and write it to file, one vertical level at a time  
        DO k=1,nNz  
 C Loop over all processors      
         do jp=1,nPy  
         do ip=1,nPx  
         DO bj = myByLo(myThid), myByHi(myThid)  
          DO bi = myBxLo(myThid), myBxHi(myThid)  
           DO J=1,sNy  
             JJ=((jp-1)*nSy+(bj-1))*sNy+J  
             global(JJ) = arr_gl(bi,ip,j,bj,jp,k)  
           ENDDO  
          ENDDO  
         ENDDO  
         enddo  
         enddo  
         _BEGIN_MASTER( myThid )  
          IF( mpiMyId .EQ. 0 ) THEN  
           irec=k+nNz*(irecord-1)  
           if (filePrec .eq. precFloat32) then  
             DO J=1,Ny  
              y_buffer_r4(J) = global(J)  
             ENDDO  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR4( y_size, y_buffer_r4 )  
 #endif  
            write(dUnit,rec=irec) y_buffer_r4  
           elseif (filePrec .eq. precFloat64) then  
             DO J=1,Ny  
              y_buffer_r8(J) = global(J)  
             ENDDO  
 #ifdef _BYTESWAPIO  
            call MDS_BYTESWAPR8( y_size, y_buffer_r8 )  
 #endif  
            write(dUnit,rec=irec) y_buffer_r8  
           else  
            write(msgbuf,'(a)')  
      &       ' MDSWRITEFIELD: illegal value for filePrec'  
            call print_error( msgbuf, mythid )  
            stop 'ABNORMAL END: S/R MDSWRITEFIELD'  
           endif  
          ENDIF  
         _END_MASTER( myThid )  
        ENDDO  
   
 C Close data-file and create meta-file  
        _BEGIN_MASTER( myThid )  
         IF( mpiMyId .EQ. 0 ) THEN  
          close( dUnit )  
          write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'  
          dimList(1,1)=1  
          dimList(2,1)=1  
          dimList(3,1)=1  
          dimList(1,2)=Ny  
          dimList(2,2)=1  
          dimList(3,2)=Ny  
          dimList(1,3)=nNz  
          dimList(2,3)=1  
          dimList(3,3)=nNz  
          ndims=3  
          if (nNz .EQ. 1) ndims=2  
          call MDSWRITEMETA( metaFName, dataFName,  
      &     filePrec, ndims, dimList, irecord, myIter, mythid )  
         ENDIF  
        _END_MASTER( myThid )  
 C To be safe, make other processes wait for I/O completion  
        _BARRIER  
   
       elseif ( .NOT. useSingleCpuIO ) then  
       _BEGIN_MASTER( myThid )  
 #endif /* ALLOW_USE_MPI */  
 cph-usesingle)  
792    
793  C Loop over all processors      C Loop over all processors    
794        do jp=1,nPy        do jp=1,nPy
# Line 1358  C End of ip,jp loops Line 897  C End of ip,jp loops
897    
898        _END_MASTER( myThid )        _END_MASTER( myThid )
899    
 cph-usesingle(  
 #ifdef ALLOW_USE_MPI  
 C endif useSingleCpuIO  
       endif  
 #endif /* ALLOW_USE_MPI */  
 cph-usesingle)  
   
900  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
901        return        return
902        end        end
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22