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

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

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

revision 1.5 by heimbach, Thu Oct 14 18:43:39 2004 UTC revision 1.12 by heimbach, Fri Aug 19 18:27:51 2005 UTC
# Line 67  C Created: 03/16/99 adcroft@mit.edu Line 67  C Created: 03/16/99 adcroft@mit.edu
67  C Global variables / common blocks  C Global variables / common blocks
68  #include "SIZE.h"  #include "SIZE.h"
69  #include "EEPARAMS.h"  #include "EEPARAMS.h"
70    #include "EESUPPORT.h"
71  #include "PARAMS.h"  #include "PARAMS.h"
72    
73  C Routine arguments  C Routine arguments
# Line 82  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,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
87        logical exst        logical exst
88        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)
89        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 90  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
94    cph-usesingle(
95          integer ii,jj
96          integer x_size,y_size,iG_IO,jG_IO,npe
97          PARAMETER ( x_size = Nx )
98          PARAMETER ( y_size = Ny )
99          Real*4 xy_buffer_r4(x_size,y_size)
100          Real*8 xy_buffer_r8(x_size,y_size)
101          Real*8 global(Nx,Ny)
102          _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
103    cph-usesingle)
104    
105  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
106    
107  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 115  C Assume nothing Line 127  C Assume nothing
127  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
128        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
129    
130          if ( useSingleCPUIO ) then
131    
132    #ifdef ALLOW_USE_MPI
133            IF( mpiMyId .EQ. 0 ) THEN
134    #else
135            IF ( .TRUE. ) THEN
136    #endif /* ALLOW_USE_MPI */
137    
138  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
139        dataFName = fName           dataFName = fName
140        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
141        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
       endif  
142    
143  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
144        if (.NOT. globalFile) then           if (.NOT. globalFile) then
145         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
146              inquire( file=dataFname, exist=exst )
147              if (exst) globalFile = .TRUE.
148             endif
149    
150    C If global file is visible to process 0, then open it here.
151    C Otherwise stop program.
152             if ( globalFile) then
153              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
154              open( dUnit, file=dataFName, status='old',
155         &         access='direct', recl=length_of_rec )
156             else
157              write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName
158              call print_message( msgbuf, standardmessageunit,
159         &                        SQUEEZE_RIGHT , mythid)
160              call print_error( msgbuf, mythid )
161              write(msgbuf,'(a)')
162         &      ' MDSREADFIELD: File does not exist'
163              call print_message( msgbuf, standardmessageunit,
164         &                        SQUEEZE_RIGHT , mythid)
165              call print_error( msgbuf, mythid )
166              stop 'ABNORMAL END: S/R MDSREADFIELD'
167             endif
168    
169            ENDIF
170    
171    c-- useSingleCpuIO
172          else
173    C Only do I/O if I am the master thread
174    
175    C Check first for global file with simple name (ie. fName)
176           dataFName = fName
177         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
178         if (exst) then         if (exst) then
179          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
180       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName
181          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
182       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
183         endif         endif
184    
185    C If negative check for global file with MDS name (ie. fName.data)
186           if (.NOT. globalFile) then
187            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
188            inquire( file=dataFname, exist=exst )
189            if (exst) then
190             write(msgbuf,'(a,a)')
191         &     ' MDSREADFIELD_GL: opening global file: ',dataFName
192             call print_message( msgbuf, standardmessageunit,
193         &                       SQUEEZE_RIGHT , mythid)
194             globalFile = .TRUE.
195            endif
196           endif
197    
198    c-- useSingleCpuIO
199          endif
200    
201          if ( .not. useSingleCpuIO ) then
202    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
203          if ( .not. ( globalFile ) ) then
204    
205    C If we are reading from a global file then we open it here
206          if (globalFile) then
207           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
208           open( dUnit, file=dataFName, status='old',
209         &      access='direct', recl=length_of_rec )
210           fileIsOpen=.TRUE.
211        endif        endif
212    
213  C Loop over all processors      C Loop over all processors    
214        do jp=1,nPy        do jp=1,nPy
215        do ip=1,nPx        do ip=1,nPx
# Line 169  C (This is a place-holder for the active Line 242  C (This is a place-holder for the active
242       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName
243            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
244       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
245              call print_error( msgbuf, mythid )
246            write(msgbuf,'(a)')            write(msgbuf,'(a)')
247       &      ' MDSREADFIELD_GL: File does not exist'       &      ' MDSREADFIELD_GL: File does not exist'
248              call print_message( msgbuf, standardmessageunit,
249         &                        SQUEEZE_RIGHT , mythid)
250            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
251            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
252           endif           endif
# Line 179  C (This is a place-holder for the active Line 255  C (This is a place-holder for the active
255          if (fileIsOpen) then          if (fileIsOpen) then
256           do k=1,Nr           do k=1,Nr
257            do j=1,sNy            do j=1,sNy
258               if (globalFile) then
259                iG=bi+(ip-1)*nsx
260                jG=bj+(jp-1)*nsy
261                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
262         &             + nSx*nPx*Ny*nNz*(irecord-1)
263               else
264              iG = 0              iG = 0
265              jG = 0              jG = 0
266              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)
267               endif
268             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
269              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
270  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 244  C If global file was opened then close i Line 327  C If global file was opened then close i
327         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
328        endif        endif
329    
330    c      end of if ( .not. ( globalFile ) ) then
331          endif
332    
333    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
334          else
335    
336           DO k=1,nNz
337    
338    #ifdef ALLOW_USE_MPI
339             IF( mpiMyId .EQ. 0 ) THEN
340    #else
341             IF ( .TRUE. ) THEN
342    #endif /* ALLOW_USE_MPI */
343              irec = k+nNz*(irecord-1)
344              if (filePrec .eq. precFloat32) then
345               read(dUnit,rec=irec) xy_buffer_r4
346    #ifdef _BYTESWAPIO
347               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
348    #endif
349               DO J=1,Ny
350                DO I=1,Nx
351                 global(I,J) = xy_buffer_r4(I,J)
352                ENDDO
353               ENDDO
354              elseif (filePrec .eq. precFloat64) then
355               read(dUnit,rec=irec) xy_buffer_r8
356    #ifdef _BYTESWAPIO
357               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
358    #endif
359               DO J=1,Ny
360                DO I=1,Nx
361                 global(I,J) = xy_buffer_r8(I,J)
362                ENDDO
363               ENDDO
364              else
365               write(msgbuf,'(a)')
366         &            ' MDSREADFIELD: illegal value for filePrec'
367               call print_error( msgbuf, mythid )
368               stop 'ABNORMAL END: S/R MDSREADFIELD'
369              endif
370             ENDIF
371            DO jp=1,nPy
372             DO ip=1,nPx
373              DO bj = myByLo(myThid), myByHi(myThid)
374               DO bi = myBxLo(myThid), myBxHi(myThid)
375                DO J=1,sNy
376                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
377                 DO I=1,sNx
378                  II=((ip-1)*nSx+(bi-1))*sNx+I
379                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
380                 ENDDO
381                ENDDO
382               ENDDO
383              ENDDO
384             ENDDO
385            ENDDO
386    
387           ENDDO
388    c      ENDDO k=1,nNz
389    
390            close( dUnit )
391    
392          endif
393    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
394    
395        _END_MASTER( myThid )        _END_MASTER( myThid )
396    
397  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 302  C          open(dUnit, ..., status='old' Line 450  C          open(dUnit, ..., status='old'
450  C Global variables / common blocks  C Global variables / common blocks
451  #include "SIZE.h"  #include "SIZE.h"
452  #include "EEPARAMS.h"  #include "EEPARAMS.h"
453    #include "EESUPPORT.h"
454  #include "PARAMS.h"  #include "PARAMS.h"
455    
456  C Routine arguments  C Routine arguments
# Line 321  C Functions Line 470  C Functions
470        integer MDS_RECLEN        integer MDS_RECLEN
471  C Local variables  C Local variables
472        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
473        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
474        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
475        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
476        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)
# Line 329  C Local variables Line 478  C Local variables
478        integer length_of_rec        integer length_of_rec
479        logical fileIsOpen        logical fileIsOpen
480        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
481    cph-usesingle(
482          integer ii,jj
483          integer x_size,y_size,iG_IO,jG_IO,npe
484          PARAMETER ( x_size = Nx )
485          PARAMETER ( y_size = Ny )
486          Real*4 xy_buffer_r4(x_size,y_size)
487          Real*8 xy_buffer_r8(x_size,y_size)
488          Real*8 global(Nx,Ny)
489    cph-usesingle)
490    
491  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
492    
493  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 353  C Assume nothing Line 512  C Assume nothing
512  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
513        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
514    
515    cph-usesingle(
516    #ifdef ALLOW_USE_MPI
517          _END_MASTER( myThid )
518    C If option globalFile is desired but does not work or if
519    C globalFile is too slow, then try using single-CPU I/O.
520          if (useSingleCpuIO) then
521    
522    C Master thread of process 0, only, opens a global file
523           _BEGIN_MASTER( myThid )
524            IF( mpiMyId .EQ. 0 ) THEN
525             write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
526             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
527             if (irecord .EQ. 1) then
528              open( dUnit, file=dataFName, status=_NEW_STATUS,
529         &        access='direct', recl=length_of_rec )
530             else
531              open( dUnit, file=dataFName, status=_OLD_STATUS,
532         &        access='direct', recl=length_of_rec )
533             endif
534            ENDIF
535           _END_MASTER( myThid )
536    
537    C Gather array and write it to file, one vertical level at a time
538           DO k=1,nNz
539    C Loop over all processors    
540            do jp=1,nPy
541            do ip=1,nPx
542            DO bj = myByLo(myThid), myByHi(myThid)
543             DO bi = myBxLo(myThid), myBxHi(myThid)
544              DO J=1,sNy
545               JJ=((jp-1)*nSy+(bj-1))*sNy+J
546               DO I=1,sNx
547                II=((ip-1)*nSx+(bi-1))*sNx+I
548                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
549               ENDDO
550              ENDDO
551             ENDDO
552            ENDDO
553            enddo
554            enddo
555            _BEGIN_MASTER( myThid )
556             IF( mpiMyId .EQ. 0 ) THEN
557              irec=k+nNz*(irecord-1)
558              if (filePrec .eq. precFloat32) then
559               DO J=1,Ny
560                DO I=1,Nx
561                 xy_buffer_r4(I,J) = global(I,J)
562                ENDDO
563               ENDDO
564    #ifdef _BYTESWAPIO
565               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
566    #endif
567               write(dUnit,rec=irec) xy_buffer_r4
568              elseif (filePrec .eq. precFloat64) then
569               DO J=1,Ny
570                DO I=1,Nx
571                 xy_buffer_r8(I,J) = global(I,J)
572                ENDDO
573               ENDDO
574    #ifdef _BYTESWAPIO
575               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
576    #endif
577               write(dUnit,rec=irec) xy_buffer_r8
578              else
579               write(msgbuf,'(a)')
580         &       ' MDSWRITEFIELD: illegal value for filePrec'
581               call print_error( msgbuf, mythid )
582               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
583              endif
584             ENDIF
585            _END_MASTER( myThid )
586           ENDDO
587    
588    C Close data-file and create meta-file
589           _BEGIN_MASTER( myThid )
590            IF( mpiMyId .EQ. 0 ) THEN
591             close( dUnit )
592             write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'
593             dimList(1,1)=Nx
594             dimList(2,1)=1
595             dimList(3,1)=Nx
596             dimList(1,2)=Ny
597             dimList(2,2)=1
598             dimList(3,2)=Ny
599             dimList(1,3)=nNz
600             dimList(2,3)=1
601             dimList(3,3)=nNz
602             ndims=3
603             if (nNz .EQ. 1) ndims=2
604             call MDSWRITEMETA( metaFName, dataFName,
605         &     filePrec, ndims, dimList, irecord, myIter, mythid )
606            ENDIF
607           _END_MASTER( myThid )
608    C To be safe, make other processes wait for I/O completion
609           _BARRIER
610    
611          elseif ( .NOT. useSingleCpuIO ) then
612          _BEGIN_MASTER( myThid )
613    #endif /* ALLOW_USE_MPI */
614    cph-usesingle)
615    
616  C Loop over all processors      C Loop over all processors    
617        do jp=1,nPy        do jp=1,nPy
# Line 461  C End of ip,jp loops Line 720  C End of ip,jp loops
720         enddo         enddo
721        enddo        enddo
722    
   
723        _END_MASTER( myThid )        _END_MASTER( myThid )
724    
725    cph-usesingle(
726    #ifdef ALLOW_USE_MPI
727    C endif useSingleCpuIO
728          endif
729    #endif /* ALLOW_USE_MPI */
730    cph-usesingle)
731    
732  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
733        return        return
734        end        end
# Line 510  C Created: 03/16/99 adcroft@mit.edu Line 775  C Created: 03/16/99 adcroft@mit.edu
775  C Global variables / common blocks  C Global variables / common blocks
776  #include "SIZE.h"  #include "SIZE.h"
777  #include "EEPARAMS.h"  #include "EEPARAMS.h"
778    #include "EESUPPORT.h"
779  #include "PARAMS.h"  #include "PARAMS.h"
780    
781  C Routine arguments  C Routine arguments
# Line 526  C Functions Line 792  C Functions
792        integer MDS_RECLEN        integer MDS_RECLEN
793  C Local variables  C Local variables
794        character*(80) dataFName        character*(80) dataFName
795        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
796        logical exst        logical exst
797        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)
798        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 534  C Local variables Line 800  C Local variables
800        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
801        integer length_of_rec        integer length_of_rec
802        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
803    cph-usesingle(
804          integer ii,jj
805          integer x_size,y_size,iG_IO,jG_IO,npe
806          PARAMETER ( x_size = Nx )
807          PARAMETER ( y_size = Ny )
808          Real*4 xy_buffer_r4(x_size,y_size)
809          Real*8 xy_buffer_r8(x_size,y_size)
810          Real*8 global(Nx,Ny)
811          _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
812    cph-usesingle)
813    
814  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
815    
816  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 559  C Assume nothing Line 836  C Assume nothing
836  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
837        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
838    
839          if ( useSingleCPUIO ) then
840    
841    C master thread of process 0, only, opens a global file
842    #ifdef ALLOW_USE_MPI
843            IF( mpiMyId .EQ. 0 ) THEN
844    #else
845            IF ( .TRUE. ) THEN
846    #endif /* ALLOW_USE_MPI */
847    
848  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
849        dataFName = fName           dataFName = fName
850        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
851        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
       endif  
852    
853  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
854        if (.NOT. globalFile) then           if (.NOT. globalFile) then
855         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
856              inquire( file=dataFname, exist=exst )
857              if (exst) globalFile = .TRUE.
858             endif
859    
860    C If global file is visible to process 0, then open it here.
861    C Otherwise stop program.
862             if ( globalFile) then
863              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
864              open( dUnit, file=dataFName, status='old',
865         &         access='direct', recl=length_of_rec )
866             else
867              write(msgbuf,'(2a)') ' MDSREADFIELD: filename: ',dataFName
868              call print_message( msgbuf, standardmessageunit,
869         &                        SQUEEZE_RIGHT , mythid)
870              call print_error( msgbuf, mythid )
871              write(msgbuf,'(a)')
872         &      ' MDSREADFIELD: File does not exist'
873              call print_message( msgbuf, standardmessageunit,
874         &                        SQUEEZE_RIGHT , mythid)
875              call print_error( msgbuf, mythid )
876              stop 'ABNORMAL END: S/R MDSREADFIELD'
877             endif
878    
879            ENDIF
880    
881    c-- useSingleCpuIO
882          else
883    
884    C Check first for global file with simple name (ie. fName)
885           dataFName = fName
886         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
887         if (exst) then         if (exst) then
888          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
889       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName
890          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
891       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
892         endif         endif
893    
894    C If negative check for global file with MDS name (ie. fName.data)
895           if (.NOT. globalFile) then
896            write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
897            inquire( file=dataFname, exist=exst )
898            if (exst) then
899             write(msgbuf,'(a,a)')
900         &     ' MDSREADFIELD_GL: opening global file: ',dataFName
901             call print_message( msgbuf, standardmessageunit,
902         &                       SQUEEZE_RIGHT , mythid)
903             globalFile = .TRUE.
904            endif
905           endif
906    
907    c-- useSingleCpuIO
908          endif
909    
910          if ( .not. useSingleCpuIO ) then
911    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
912          if ( .not. ( globalFile ) ) then
913    
914    C If we are reading from a global file then we open it here
915          if (globalFile) then
916           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
917           open( dUnit, file=dataFName, status='old',
918         &      access='direct', recl=length_of_rec )
919           fileIsOpen=.TRUE.
920        endif        endif
921    
922  C Loop over all processors      C Loop over all processors    
923        do jp=1,nPy        do jp=1,nPy
924        do ip=1,nPx        do ip=1,nPx
# Line 613  C (This is a place-holder for the active Line 951  C (This is a place-holder for the active
951       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName
952            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
953       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
954              call print_error( msgbuf, mythid )
955            write(msgbuf,'(a)')            write(msgbuf,'(a)')
956       &      ' MDSREADFIELD_GL: File does not exist'       &      ' MDSREADFIELD_GL: File does not exist'
957              call print_message( msgbuf, standardmessageunit,
958         &                        SQUEEZE_RIGHT , mythid)
959            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
960            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'            stop 'ABNORMAL END: S/R MDSREADFIELD_GL'
961           endif           endif
# Line 623  C (This is a place-holder for the active Line 964  C (This is a place-holder for the active
964          if (fileIsOpen) then          if (fileIsOpen) then
965           do k=1,nLocz           do k=1,nLocz
966            do j=1,sNy            do j=1,sNy
967               if (globalFile) then
968                iG=bi+(ip-1)*nsx
969                jG=bj+(jp-1)*nsy
970                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
971         &             + nSx*nPx*Ny*nLocz*(irecord-1)
972               else
973              iG = 0              iG = 0
974              jG = 0              jG = 0
975              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)
976               endif
977             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
978              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
979  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 688  C If global file was opened then close i Line 1036  C If global file was opened then close i
1036         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
1037        endif        endif
1038    
1039    c      end of if ( .not. ( globalFile ) ) then
1040          endif
1041    
1042    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1043          else
1044    
1045           DO k=1,nLocz
1046    
1047    #ifdef ALLOW_USE_MPI
1048             IF( mpiMyId .EQ. 0 ) THEN
1049    #else
1050             IF ( .TRUE. ) THEN
1051    #endif /* ALLOW_USE_MPI */
1052              irec = k+nNz*(irecord-1)
1053              if (filePrec .eq. precFloat32) then
1054               read(dUnit,rec=irec) xy_buffer_r4
1055    #ifdef _BYTESWAPIO
1056               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1057    #endif
1058               DO J=1,Ny
1059                DO I=1,Nx
1060                 global(I,J) = xy_buffer_r4(I,J)
1061                ENDDO
1062               ENDDO
1063              elseif (filePrec .eq. precFloat64) then
1064               read(dUnit,rec=irec) xy_buffer_r8
1065    #ifdef _BYTESWAPIO
1066               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1067    #endif
1068               DO J=1,Ny
1069                DO I=1,Nx
1070                 global(I,J) = xy_buffer_r8(I,J)
1071                ENDDO
1072               ENDDO
1073              else
1074               write(msgbuf,'(a)')
1075         &            ' MDSREADFIELD: illegal value for filePrec'
1076               call print_error( msgbuf, mythid )
1077               stop 'ABNORMAL END: S/R MDSREADFIELD'
1078              endif
1079             ENDIF
1080            DO jp=1,nPy
1081             DO ip=1,nPx
1082              DO bj = myByLo(myThid), myByHi(myThid)
1083               DO bi = myBxLo(myThid), myBxHi(myThid)
1084                DO J=1,sNy
1085                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
1086                 DO I=1,sNx
1087                  II=((ip-1)*nSx+(bi-1))*sNx+I
1088                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
1089                 ENDDO
1090                ENDDO
1091               ENDDO
1092              ENDDO
1093             ENDDO
1094            ENDDO
1095    
1096           ENDDO
1097    c      ENDDO k=1,nNz
1098    
1099            close( dUnit )
1100    
1101          endif
1102    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1103    
1104        _END_MASTER( myThid )        _END_MASTER( myThid )
1105    
1106  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 746  C          open(dUnit, ..., status='old' Line 1159  C          open(dUnit, ..., status='old'
1159  C Global variables / common blocks  C Global variables / common blocks
1160  #include "SIZE.h"  #include "SIZE.h"
1161  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1162    #include "EESUPPORT.h"
1163  #include "PARAMS.h"  #include "PARAMS.h"
1164    
1165  C Routine arguments  C Routine arguments
# Line 766  C Functions Line 1180  C Functions
1180        integer MDS_RECLEN        integer MDS_RECLEN
1181  C Local variables  C Local variables
1182        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
1183        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
1184        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1185        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
1186        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)
# Line 774  C Local variables Line 1188  C Local variables
1188        integer length_of_rec        integer length_of_rec
1189        logical fileIsOpen        logical fileIsOpen
1190        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1191    cph-usesingle(
1192          integer ii,jj
1193          integer x_size,y_size,iG_IO,jG_IO,npe
1194          PARAMETER ( x_size = Nx )
1195          PARAMETER ( y_size = Ny )
1196          Real*4 xy_buffer_r4(x_size,y_size)
1197          Real*8 xy_buffer_r8(x_size,y_size)
1198          Real*8 global(Nx,Ny)
1199    cph-usesingle)
1200    
1201  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1202    
1203  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 799  C Assign a free unit number as the I/O c Line 1223  C Assign a free unit number as the I/O c
1223        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
1224    
1225    
1226    cph-usesingle(
1227    #ifdef ALLOW_USE_MPI
1228          _END_MASTER( myThid )
1229    C If option globalFile is desired but does not work or if
1230    C globalFile is too slow, then try using single-CPU I/O.
1231          if (useSingleCpuIO) then
1232    
1233    C Master thread of process 0, only, opens a global file
1234           _BEGIN_MASTER( myThid )
1235            IF( mpiMyId .EQ. 0 ) THEN
1236             write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
1237             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1238             if (irecord .EQ. 1) then
1239              open( dUnit, file=dataFName, status=_NEW_STATUS,
1240         &        access='direct', recl=length_of_rec )
1241             else
1242              open( dUnit, file=dataFName, status=_OLD_STATUS,
1243         &        access='direct', recl=length_of_rec )
1244             endif
1245            ENDIF
1246           _END_MASTER( myThid )
1247    
1248    C Gather array and write it to file, one vertical level at a time
1249           DO k=1,nLocz
1250    C Loop over all processors    
1251            do jp=1,nPy
1252            do ip=1,nPx
1253            DO bj = myByLo(myThid), myByHi(myThid)
1254             DO bi = myBxLo(myThid), myBxHi(myThid)
1255              DO J=1,sNy
1256               JJ=((jp-1)*nSy+(bj-1))*sNy+J
1257               DO I=1,sNx
1258                II=((ip-1)*nSx+(bi-1))*sNx+I
1259                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
1260               ENDDO
1261              ENDDO
1262             ENDDO
1263            ENDDO
1264            enddo
1265            enddo
1266            _BEGIN_MASTER( myThid )
1267             IF( mpiMyId .EQ. 0 ) THEN
1268              irec=k+nLocz*(irecord-1)
1269              if (filePrec .eq. precFloat32) then
1270               DO J=1,Ny
1271                DO I=1,Nx
1272                 xy_buffer_r4(I,J) = global(I,J)
1273                ENDDO
1274               ENDDO
1275    #ifdef _BYTESWAPIO
1276               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1277    #endif
1278               write(dUnit,rec=irec) xy_buffer_r4
1279              elseif (filePrec .eq. precFloat64) then
1280               DO J=1,Ny
1281                DO I=1,Nx
1282                 xy_buffer_r8(I,J) = global(I,J)
1283                ENDDO
1284               ENDDO
1285    #ifdef _BYTESWAPIO
1286               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1287    #endif
1288               write(dUnit,rec=irec) xy_buffer_r8
1289              else
1290               write(msgbuf,'(a)')
1291         &       ' MDSWRITEFIELD: illegal value for filePrec'
1292               call print_error( msgbuf, mythid )
1293               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
1294              endif
1295             ENDIF
1296            _END_MASTER( myThid )
1297           ENDDO
1298    
1299    C Close data-file and create meta-file
1300           _BEGIN_MASTER( myThid )
1301            IF( mpiMyId .EQ. 0 ) THEN
1302             close( dUnit )
1303             write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'
1304             dimList(1,1)=Nx
1305             dimList(2,1)=1
1306             dimList(3,1)=Nx
1307             dimList(1,2)=Ny
1308             dimList(2,2)=1
1309             dimList(3,2)=Ny
1310             dimList(1,3)=nLocz
1311             dimList(2,3)=1
1312             dimList(3,3)=nLocz
1313             ndims=3
1314             if (nLocz .EQ. 1) ndims=2
1315             call MDSWRITEMETA( metaFName, dataFName,
1316         &     filePrec, ndims, dimList, irecord, myIter, mythid )
1317            ENDIF
1318           _END_MASTER( myThid )
1319    C To be safe, make other processes wait for I/O completion
1320           _BARRIER
1321    
1322          elseif ( .NOT. useSingleCpuIO ) then
1323          _BEGIN_MASTER( myThid )
1324    #endif /* ALLOW_USE_MPI */
1325    cph-usesingle)
1326    
1327  C Loop over all processors      C Loop over all processors    
1328        do jp=1,nPy        do jp=1,nPy
1329        do ip=1,nPx        do ip=1,nPx
# Line 906  C End of ip,jp loops Line 1431  C End of ip,jp loops
1431         enddo         enddo
1432        enddo        enddo
1433    
   
1434        _END_MASTER( myThid )        _END_MASTER( myThid )
1435    
1436    #ifdef ALLOW_USE_MPI
1437    C endif useSingleCpuIO
1438          endif
1439    #endif /* ALLOW_USE_MPI */
1440    
1441  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1442        return        return
1443        end        end
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22