/[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.6 by heimbach, Wed Nov 17 03:04:36 2004 UTC revision 1.14 by jmc, Sun Nov 6 01:25:13 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "MDSIO_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
# Line 67  C Created: 03/16/99 adcroft@mit.edu Line 68  C Created: 03/16/99 adcroft@mit.edu
68  C Global variables / common blocks  C Global variables / common blocks
69  #include "SIZE.h"  #include "SIZE.h"
70  #include "EEPARAMS.h"  #include "EEPARAMS.h"
71    #include "EESUPPORT.h"
72  #include "PARAMS.h"  #include "PARAMS.h"
73    
74  C Routine arguments  C Routine arguments
# Line 81  C Functions Line 83  C Functions
83        integer ILNBLNK        integer ILNBLNK
84        integer MDS_RECLEN        integer MDS_RECLEN
85  C Local variables  C Local variables
86        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
87        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
88        logical exst        logical exst
89        _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)
90        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 90  C Local variables Line 92  C Local variables
92        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
93        integer length_of_rec        integer length_of_rec
94        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
95    cph-usesingle(
96          integer ii,jj
97    c     integer iG_IO,jG_IO,npe
98          integer x_size,y_size
99          PARAMETER ( x_size = Nx )
100          PARAMETER ( y_size = Ny )
101          Real*4 xy_buffer_r4(x_size,y_size)
102          Real*8 xy_buffer_r8(x_size,y_size)
103          Real*8 global(Nx,Ny)
104    c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
105    cph-usesingle)
106    
107  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
108    
109  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 129  C Assume nothing
129  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
130        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
131    
132          if ( useSingleCPUIO ) then
133    
134    #ifdef ALLOW_USE_MPI
135            IF( mpiMyId .EQ. 0 ) THEN
136    #else
137            IF ( .TRUE. ) THEN
138    #endif /* ALLOW_USE_MPI */
139    
140  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
141        dataFName = fName           dataFName = fName
142        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
143        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  
144    
145  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)
146        if (.NOT. globalFile) then           if (.NOT. globalFile) then
147         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
148              inquire( file=dataFname, exist=exst )
149              if (exst) globalFile = .TRUE.
150             endif
151    
152    C If global file is visible to process 0, then open it here.
153    C Otherwise stop program.
154             if ( globalFile) then
155              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
156              open( dUnit, file=dataFName, status='old',
157         &         access='direct', recl=length_of_rec )
158             else
159              write(msgbuf,'(2a)')
160         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
161              call print_message( msgbuf, standardmessageunit,
162         &                        SQUEEZE_RIGHT , mythid)
163              call print_error( msgbuf, mythid )
164              write(msgbuf,'(a)')
165         &      ' MDSREADFIELD: File does not exist'
166              call print_message( msgbuf, standardmessageunit,
167         &                        SQUEEZE_RIGHT , mythid)
168              call print_error( msgbuf, mythid )
169              stop 'ABNORMAL END: S/R MDSREADFIELD'
170             endif
171    
172            ENDIF
173    
174    c-- useSingleCpuIO
175          else
176    C Only do I/O if I am the master thread
177    
178    C Check first for global file with simple name (ie. fName)
179           dataFName = fName
180         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
181         if (exst) then         if (exst) then
182          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
183       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
184          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
185       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
186         endif         endif
187    
188    C If negative check for global file with MDS name (ie. fName.data)
189           if (.NOT. globalFile) then
190            write(dataFname,'(2a)') fName(1:IL),'.data'
191            inquire( file=dataFname, exist=exst )
192            if (exst) then
193             write(msgbuf,'(a,a)')
194         &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
195             call print_message( msgbuf, standardmessageunit,
196         &                       SQUEEZE_RIGHT , mythid)
197             globalFile = .TRUE.
198            endif
199           endif
200    
201    c-- useSingleCpuIO
202        endif        endif
203    
204          if ( .not. useSingleCpuIO ) then
205    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
206          if ( .not. ( globalFile ) ) then
207    
208    C If we are reading from a global file then we open it here
209          if (globalFile) then
210           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
211           open( dUnit, file=dataFName, status='old',
212         &      access='direct', recl=length_of_rec )
213           fileIsOpen=.TRUE.
214          endif
215    
216  C Loop over all processors      C Loop over all processors    
217        do jp=1,nPy        do jp=1,nPy
218        do ip=1,nPx        do ip=1,nPx
# Line 147  C If we are reading from a tiled MDS fil Line 223  C If we are reading from a tiled MDS fil
223          if (.NOT. globalFile) then          if (.NOT. globalFile) then
224           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
225           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
226           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
227       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
228           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
229  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
# Line 155  C (This is a place-holder for the active Line 231  C (This is a place-holder for the active
231           if (exst) then           if (exst) then
232            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
233             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
234       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
235             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
236       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
237            endif            endif
# Line 166  C (This is a place-holder for the active Line 242  C (This is a place-holder for the active
242           else           else
243            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
244            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
245       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
246            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
247       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
248            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 182  C (This is a place-holder for the active Line 258  C (This is a place-holder for the active
258          if (fileIsOpen) then          if (fileIsOpen) then
259           do k=1,Nr           do k=1,Nr
260            do j=1,sNy            do j=1,sNy
261               if (globalFile) then
262                iG=bi+(ip-1)*nsx
263                jG=bj+(jp-1)*nsy
264                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
265         &             + nSx*nPx*Ny*nNz*(irecord-1)
266               else
267              iG = 0              iG = 0
268              jG = 0              jG = 0
269              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)              irec=j + sNy*(k-1) + sNy*Nr*(irecord-1)
270               endif
271             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
272              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
273  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 247  C If global file was opened then close i Line 330  C If global file was opened then close i
330         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
331        endif        endif
332    
333    c      end of if ( .not. ( globalFile ) ) then
334          endif
335    
336    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
337          else
338    
339           DO k=1,nNz
340    
341    #ifdef ALLOW_USE_MPI
342             IF( mpiMyId .EQ. 0 ) THEN
343    #else
344             IF ( .TRUE. ) THEN
345    #endif /* ALLOW_USE_MPI */
346              irec = k+nNz*(irecord-1)
347              if (filePrec .eq. precFloat32) then
348               read(dUnit,rec=irec) xy_buffer_r4
349    #ifdef _BYTESWAPIO
350               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
351    #endif
352               DO J=1,Ny
353                DO I=1,Nx
354                 global(I,J) = xy_buffer_r4(I,J)
355                ENDDO
356               ENDDO
357              elseif (filePrec .eq. precFloat64) then
358               read(dUnit,rec=irec) xy_buffer_r8
359    #ifdef _BYTESWAPIO
360               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
361    #endif
362               DO J=1,Ny
363                DO I=1,Nx
364                 global(I,J) = xy_buffer_r8(I,J)
365                ENDDO
366               ENDDO
367              else
368               write(msgbuf,'(a)')
369         &            ' MDSREADFIELD: illegal value for filePrec'
370               call print_error( msgbuf, mythid )
371               stop 'ABNORMAL END: S/R MDSREADFIELD'
372              endif
373             ENDIF
374            DO jp=1,nPy
375             DO ip=1,nPx
376              DO bj = myByLo(myThid), myByHi(myThid)
377               DO bi = myBxLo(myThid), myBxHi(myThid)
378                DO J=1,sNy
379                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
380                 DO I=1,sNx
381                  II=((ip-1)*nSx+(bi-1))*sNx+I
382                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
383                 ENDDO
384                ENDDO
385               ENDDO
386              ENDDO
387             ENDDO
388            ENDDO
389    
390           ENDDO
391    c      ENDDO k=1,nNz
392    
393            close( dUnit )
394    
395          endif
396    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
397    
398        _END_MASTER( myThid )        _END_MASTER( myThid )
399    
400  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 305  C          open(dUnit, ..., status='old' Line 453  C          open(dUnit, ..., status='old'
453  C Global variables / common blocks  C Global variables / common blocks
454  #include "SIZE.h"  #include "SIZE.h"
455  #include "EEPARAMS.h"  #include "EEPARAMS.h"
456    #include "EESUPPORT.h"
457  #include "PARAMS.h"  #include "PARAMS.h"
458    
459  C Routine arguments  C Routine arguments
# Line 323  C Functions Line 472  C Functions
472        integer ILNBLNK        integer ILNBLNK
473        integer MDS_RECLEN        integer MDS_RECLEN
474  C Local variables  C Local variables
475        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
476        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
477        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
478        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
479        _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 332  C Local variables Line 481  C Local variables
481        integer length_of_rec        integer length_of_rec
482        logical fileIsOpen        logical fileIsOpen
483        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
484    cph-usesingle(
485    #ifdef ALLOW_USE_MPI
486          integer ii,jj
487    c     integer iG_IO,jG_IO,npe
488          integer x_size,y_size
489          PARAMETER ( x_size = Nx )
490          PARAMETER ( y_size = Ny )
491          Real*4 xy_buffer_r4(x_size,y_size)
492          Real*8 xy_buffer_r8(x_size,y_size)
493          Real*8 global(Nx,Ny)
494    #endif
495    cph-usesingle)
496    
497  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
498    
499  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 356  C Assume nothing Line 518  C Assume nothing
518  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
519        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
520    
521    cph-usesingle(
522    #ifdef ALLOW_USE_MPI
523          _END_MASTER( myThid )
524    C If option globalFile is desired but does not work or if
525    C globalFile is too slow, then try using single-CPU I/O.
526          if (useSingleCpuIO) then
527    
528    C Master thread of process 0, only, opens a global file
529           _BEGIN_MASTER( myThid )
530            IF( mpiMyId .EQ. 0 ) THEN
531             write(dataFname,'(2a)') fName(1:IL),'.data'
532             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
533             if (irecord .EQ. 1) then
534              open( dUnit, file=dataFName, status=_NEW_STATUS,
535         &        access='direct', recl=length_of_rec )
536             else
537              open( dUnit, file=dataFName, status=_OLD_STATUS,
538         &        access='direct', recl=length_of_rec )
539             endif
540            ENDIF
541           _END_MASTER( myThid )
542    
543    C Gather array and write it to file, one vertical level at a time
544           DO k=1,nNz
545    C Loop over all processors    
546            do jp=1,nPy
547            do ip=1,nPx
548            DO bj = myByLo(myThid), myByHi(myThid)
549             DO bi = myBxLo(myThid), myBxHi(myThid)
550              DO J=1,sNy
551               JJ=((jp-1)*nSy+(bj-1))*sNy+J
552               DO I=1,sNx
553                II=((ip-1)*nSx+(bi-1))*sNx+I
554                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
555               ENDDO
556              ENDDO
557             ENDDO
558            ENDDO
559            enddo
560            enddo
561            _BEGIN_MASTER( myThid )
562             IF( mpiMyId .EQ. 0 ) THEN
563              irec=k+nNz*(irecord-1)
564              if (filePrec .eq. precFloat32) then
565               DO J=1,Ny
566                DO I=1,Nx
567                 xy_buffer_r4(I,J) = global(I,J)
568                ENDDO
569               ENDDO
570    #ifdef _BYTESWAPIO
571               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
572    #endif
573               write(dUnit,rec=irec) xy_buffer_r4
574              elseif (filePrec .eq. precFloat64) then
575               DO J=1,Ny
576                DO I=1,Nx
577                 xy_buffer_r8(I,J) = global(I,J)
578                ENDDO
579               ENDDO
580    #ifdef _BYTESWAPIO
581               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
582    #endif
583               write(dUnit,rec=irec) xy_buffer_r8
584              else
585               write(msgbuf,'(a)')
586         &       ' MDSWRITEFIELD: illegal value for filePrec'
587               call print_error( msgbuf, mythid )
588               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
589              endif
590             ENDIF
591            _END_MASTER( myThid )
592           ENDDO
593    
594    C Close data-file and create meta-file
595           _BEGIN_MASTER( myThid )
596            IF( mpiMyId .EQ. 0 ) THEN
597             close( dUnit )
598             write(metaFName,'(2a)') fName(1:IL),'.meta'
599             dimList(1,1)=Nx
600             dimList(2,1)=1
601             dimList(3,1)=Nx
602             dimList(1,2)=Ny
603             dimList(2,2)=1
604             dimList(3,2)=Ny
605             dimList(1,3)=nNz
606             dimList(2,3)=1
607             dimList(3,3)=nNz
608             ndims=3
609             if (nNz .EQ. 1) ndims=2
610             call MDSWRITEMETA( metaFName, dataFName,
611         &     filePrec, ndims, dimList, irecord, myIter, mythid )
612            ENDIF
613           _END_MASTER( myThid )
614    C To be safe, make other processes wait for I/O completion
615           _BARRIER
616    
617          elseif ( .NOT. useSingleCpuIO ) then
618          _BEGIN_MASTER( myThid )
619    #endif /* ALLOW_USE_MPI */
620    cph-usesingle)
621    
622  C Loop over all processors      C Loop over all processors    
623        do jp=1,nPy        do jp=1,nPy
# Line 366  C Loop over all tiles Line 628  C Loop over all tiles
628  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
629           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
630           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
631           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
632       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
633           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
634            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 382  C If we are writing to a tiled MDS file Line 644  C If we are writing to a tiled MDS file
644          if (fileIsOpen) then          if (fileIsOpen) then
645           do k=1,Nr           do k=1,Nr
646            do j=1,sNy            do j=1,sNy
647               do ii=1,sNx               do i=1,sNx
648                  arr(ii,j,k,bi,bj)=arr_gl(ii,bi,ip,j,bj,jp,k)                  arr(i,j,k,bi,bj)=arr_gl(i,bi,ip,j,bj,jp,k)
649               enddo               enddo
650              iG = 0              iG = 0
651              jG = 0              jG = 0
# Line 442  C If we were writing to a tiled MDS file Line 704  C If we were writing to a tiled MDS file
704  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
705           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
706           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
707           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
708       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
709           dimList(1,1)=Nx           dimList(1,1)=Nx
710           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 464  C End of ip,jp loops Line 726  C End of ip,jp loops
726         enddo         enddo
727        enddo        enddo
728    
   
729        _END_MASTER( myThid )        _END_MASTER( myThid )
730    
731    cph-usesingle(
732    #ifdef ALLOW_USE_MPI
733    C endif useSingleCpuIO
734          endif
735    #endif /* ALLOW_USE_MPI */
736    cph-usesingle)
737    
738  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
739        return        return
740        end        end
# Line 513  C Created: 03/16/99 adcroft@mit.edu Line 781  C Created: 03/16/99 adcroft@mit.edu
781  C Global variables / common blocks  C Global variables / common blocks
782  #include "SIZE.h"  #include "SIZE.h"
783  #include "EEPARAMS.h"  #include "EEPARAMS.h"
784    #include "EESUPPORT.h"
785  #include "PARAMS.h"  #include "PARAMS.h"
786    
787  C Routine arguments  C Routine arguments
# Line 528  C Functions Line 797  C Functions
797        integer ILNBLNK        integer ILNBLNK
798        integer MDS_RECLEN        integer MDS_RECLEN
799  C Local variables  C Local variables
800        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
801        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
802        logical exst        logical exst
803        _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)
804        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 537  C Local variables Line 806  C Local variables
806        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
807        integer length_of_rec        integer length_of_rec
808        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
809    cph-usesingle(
810          integer ii,jj
811    c     integer iG_IO,jG_IO,npe
812          integer x_size,y_size
813          PARAMETER ( x_size = Nx )
814          PARAMETER ( y_size = Ny )
815          Real*4 xy_buffer_r4(x_size,y_size)
816          Real*8 xy_buffer_r8(x_size,y_size)
817          Real*8 global(Nx,Ny)
818    c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
819    cph-usesingle)
820    
821  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
822    
823  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 562  C Assume nothing Line 843  C Assume nothing
843  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
844        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
845    
846          if ( useSingleCPUIO ) then
847    
848    C master thread of process 0, only, opens a global file
849    #ifdef ALLOW_USE_MPI
850            IF( mpiMyId .EQ. 0 ) THEN
851    #else
852            IF ( .TRUE. ) THEN
853    #endif /* ALLOW_USE_MPI */
854    
855  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
856        dataFName = fName           dataFName = fName
857        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
858        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  
859    
860  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)
861        if (.NOT. globalFile) then           if (.NOT. globalFile) then
862         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
863              inquire( file=dataFname, exist=exst )
864              if (exst) globalFile = .TRUE.
865             endif
866    
867    C If global file is visible to process 0, then open it here.
868    C Otherwise stop program.
869             if ( globalFile) then
870              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
871              open( dUnit, file=dataFName, status='old',
872         &         access='direct', recl=length_of_rec )
873             else
874              write(msgbuf,'(2a)')
875         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
876              call print_message( msgbuf, standardmessageunit,
877         &                        SQUEEZE_RIGHT , mythid)
878              call print_error( msgbuf, mythid )
879              write(msgbuf,'(a)')
880         &      ' MDSREADFIELD: File does not exist'
881              call print_message( msgbuf, standardmessageunit,
882         &                        SQUEEZE_RIGHT , mythid)
883              call print_error( msgbuf, mythid )
884              stop 'ABNORMAL END: S/R MDSREADFIELD'
885             endif
886    
887            ENDIF
888    
889    c-- useSingleCpuIO
890          else
891    
892    C Check first for global file with simple name (ie. fName)
893           dataFName = fName
894         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
895         if (exst) then         if (exst) then
896          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
897       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
898          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
899       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
900         endif         endif
901    
902    C If negative check for global file with MDS name (ie. fName.data)
903           if (.NOT. globalFile) then
904            write(dataFname,'(2a)') fName(1:IL),'.data'
905            inquire( file=dataFname, exist=exst )
906            if (exst) then
907             write(msgbuf,'(a,a)')
908         &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
909             call print_message( msgbuf, standardmessageunit,
910         &                       SQUEEZE_RIGHT , mythid)
911             globalFile = .TRUE.
912            endif
913           endif
914    
915    c-- useSingleCpuIO
916          endif
917    
918          if ( .not. useSingleCpuIO ) then
919    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
920          if ( .not. ( globalFile ) ) then
921    
922    C If we are reading from a global file then we open it here
923          if (globalFile) then
924           length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
925           open( dUnit, file=dataFName, status='old',
926         &      access='direct', recl=length_of_rec )
927           fileIsOpen=.TRUE.
928        endif        endif
929    
930  C Loop over all processors      C Loop over all processors    
931        do jp=1,nPy        do jp=1,nPy
932        do ip=1,nPx        do ip=1,nPx
# Line 594  C If we are reading from a tiled MDS fil Line 937  C If we are reading from a tiled MDS fil
937          if (.NOT. globalFile) then          if (.NOT. globalFile) then
938           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
939           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
940           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
941       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
942           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
943  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
# Line 602  C (This is a place-holder for the active Line 945  C (This is a place-holder for the active
945           if (exst) then           if (exst) then
946            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
947             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
948       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
949             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
950       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
951            endif            endif
# Line 613  C (This is a place-holder for the active Line 956  C (This is a place-holder for the active
956           else           else
957            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
958            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
959       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
960            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
961       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
962            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 629  C (This is a place-holder for the active Line 972  C (This is a place-holder for the active
972          if (fileIsOpen) then          if (fileIsOpen) then
973           do k=1,nLocz           do k=1,nLocz
974            do j=1,sNy            do j=1,sNy
975               if (globalFile) then
976                iG=bi+(ip-1)*nsx
977                jG=bj+(jp-1)*nsy
978                irec=1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) + nSx*nPx*Ny*(k-1)
979         &             + nSx*nPx*Ny*nLocz*(irecord-1)
980               else
981              iG = 0              iG = 0
982              jG = 0              jG = 0
983              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)              irec=j + sNy*(k-1) + sNy*nLocz*(irecord-1)
984               endif
985             if (filePrec .eq. precFloat32) then             if (filePrec .eq. precFloat32) then
986              read(dUnit,rec=irec) r4seg              read(dUnit,rec=irec) r4seg
987  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 694  C If global file was opened then close i Line 1044  C If global file was opened then close i
1044         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
1045        endif        endif
1046    
1047    c      end of if ( .not. ( globalFile ) ) then
1048          endif
1049    
1050    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1051          else
1052    
1053           DO k=1,nLocz
1054    
1055    #ifdef ALLOW_USE_MPI
1056             IF( mpiMyId .EQ. 0 ) THEN
1057    #else
1058             IF ( .TRUE. ) THEN
1059    #endif /* ALLOW_USE_MPI */
1060              irec = k+nNz*(irecord-1)
1061              if (filePrec .eq. precFloat32) then
1062               read(dUnit,rec=irec) xy_buffer_r4
1063    #ifdef _BYTESWAPIO
1064               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1065    #endif
1066               DO J=1,Ny
1067                DO I=1,Nx
1068                 global(I,J) = xy_buffer_r4(I,J)
1069                ENDDO
1070               ENDDO
1071              elseif (filePrec .eq. precFloat64) then
1072               read(dUnit,rec=irec) xy_buffer_r8
1073    #ifdef _BYTESWAPIO
1074               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1075    #endif
1076               DO J=1,Ny
1077                DO I=1,Nx
1078                 global(I,J) = xy_buffer_r8(I,J)
1079                ENDDO
1080               ENDDO
1081              else
1082               write(msgbuf,'(a)')
1083         &            ' MDSREADFIELD: illegal value for filePrec'
1084               call print_error( msgbuf, mythid )
1085               stop 'ABNORMAL END: S/R MDSREADFIELD'
1086              endif
1087             ENDIF
1088            DO jp=1,nPy
1089             DO ip=1,nPx
1090              DO bj = myByLo(myThid), myByHi(myThid)
1091               DO bi = myBxLo(myThid), myBxHi(myThid)
1092                DO J=1,sNy
1093                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
1094                 DO I=1,sNx
1095                  II=((ip-1)*nSx+(bi-1))*sNx+I
1096                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
1097                 ENDDO
1098                ENDDO
1099               ENDDO
1100              ENDDO
1101             ENDDO
1102            ENDDO
1103    
1104           ENDDO
1105    c      ENDDO k=1,nNz
1106    
1107            close( dUnit )
1108    
1109          endif
1110    c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1111    
1112        _END_MASTER( myThid )        _END_MASTER( myThid )
1113    
1114  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 752  C          open(dUnit, ..., status='old' Line 1167  C          open(dUnit, ..., status='old'
1167  C Global variables / common blocks  C Global variables / common blocks
1168  #include "SIZE.h"  #include "SIZE.h"
1169  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1170    #include "EESUPPORT.h"
1171  #include "PARAMS.h"  #include "PARAMS.h"
1172    
1173  C Routine arguments  C Routine arguments
# Line 771  C Functions Line 1187  C Functions
1187        integer ILNBLNK        integer ILNBLNK
1188        integer MDS_RECLEN        integer MDS_RECLEN
1189  C Local variables  C Local variables
1190        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
1191        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
1192        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1193        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
1194        _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 780  C Local variables Line 1196  C Local variables
1196        integer length_of_rec        integer length_of_rec
1197        logical fileIsOpen        logical fileIsOpen
1198        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1199    cph-usesingle(
1200    #ifdef ALLOW_USE_MPI
1201          integer ii,jj
1202    c     integer iG_IO,jG_IO,npe
1203          integer x_size,y_size
1204          PARAMETER ( x_size = Nx )
1205          PARAMETER ( y_size = Ny )
1206          Real*4 xy_buffer_r4(x_size,y_size)
1207          Real*8 xy_buffer_r8(x_size,y_size)
1208          Real*8 global(Nx,Ny)
1209    #endif
1210    cph-usesingle)
1211    
1212  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1213    
1214  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 805  C Assign a free unit number as the I/O c Line 1234  C Assign a free unit number as the I/O c
1234        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
1235    
1236    
1237    cph-usesingle(
1238    #ifdef ALLOW_USE_MPI
1239          _END_MASTER( myThid )
1240    C If option globalFile is desired but does not work or if
1241    C globalFile is too slow, then try using single-CPU I/O.
1242          if (useSingleCpuIO) then
1243    
1244    C Master thread of process 0, only, opens a global file
1245           _BEGIN_MASTER( myThid )
1246            IF( mpiMyId .EQ. 0 ) THEN
1247             write(dataFname,'(2a)') fName(1:IL),'.data'
1248             length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1249             if (irecord .EQ. 1) then
1250              open( dUnit, file=dataFName, status=_NEW_STATUS,
1251         &        access='direct', recl=length_of_rec )
1252             else
1253              open( dUnit, file=dataFName, status=_OLD_STATUS,
1254         &        access='direct', recl=length_of_rec )
1255             endif
1256            ENDIF
1257           _END_MASTER( myThid )
1258    
1259    C Gather array and write it to file, one vertical level at a time
1260           DO k=1,nLocz
1261    C Loop over all processors    
1262            do jp=1,nPy
1263            do ip=1,nPx
1264            DO bj = myByLo(myThid), myByHi(myThid)
1265             DO bi = myBxLo(myThid), myBxHi(myThid)
1266              DO J=1,sNy
1267               JJ=((jp-1)*nSy+(bj-1))*sNy+J
1268               DO I=1,sNx
1269                II=((ip-1)*nSx+(bi-1))*sNx+I
1270                global(II,JJ) = arr_gl(i,bi,ip,j,bj,jp,k)
1271               ENDDO
1272              ENDDO
1273             ENDDO
1274            ENDDO
1275            enddo
1276            enddo
1277            _BEGIN_MASTER( myThid )
1278             IF( mpiMyId .EQ. 0 ) THEN
1279              irec=k+nLocz*(irecord-1)
1280              if (filePrec .eq. precFloat32) then
1281               DO J=1,Ny
1282                DO I=1,Nx
1283                 xy_buffer_r4(I,J) = global(I,J)
1284                ENDDO
1285               ENDDO
1286    #ifdef _BYTESWAPIO
1287               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1288    #endif
1289               write(dUnit,rec=irec) xy_buffer_r4
1290              elseif (filePrec .eq. precFloat64) then
1291               DO J=1,Ny
1292                DO I=1,Nx
1293                 xy_buffer_r8(I,J) = global(I,J)
1294                ENDDO
1295               ENDDO
1296    #ifdef _BYTESWAPIO
1297               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1298    #endif
1299               write(dUnit,rec=irec) xy_buffer_r8
1300              else
1301               write(msgbuf,'(a)')
1302         &       ' MDSWRITEFIELD: illegal value for filePrec'
1303               call print_error( msgbuf, mythid )
1304               stop 'ABNORMAL END: S/R MDSWRITEFIELD'
1305              endif
1306             ENDIF
1307            _END_MASTER( myThid )
1308           ENDDO
1309    
1310    C Close data-file and create meta-file
1311           _BEGIN_MASTER( myThid )
1312            IF( mpiMyId .EQ. 0 ) THEN
1313             close( dUnit )
1314             write(metaFName,'(2a)') fName(1:IL),'.meta'
1315             dimList(1,1)=Nx
1316             dimList(2,1)=1
1317             dimList(3,1)=Nx
1318             dimList(1,2)=Ny
1319             dimList(2,2)=1
1320             dimList(3,2)=Ny
1321             dimList(1,3)=nLocz
1322             dimList(2,3)=1
1323             dimList(3,3)=nLocz
1324             ndims=3
1325             if (nLocz .EQ. 1) ndims=2
1326             call MDSWRITEMETA( metaFName, dataFName,
1327         &     filePrec, ndims, dimList, irecord, myIter, mythid )
1328            ENDIF
1329           _END_MASTER( myThid )
1330    C To be safe, make other processes wait for I/O completion
1331           _BARRIER
1332    
1333          elseif ( .NOT. useSingleCpuIO ) then
1334          _BEGIN_MASTER( myThid )
1335    #endif /* ALLOW_USE_MPI */
1336    cph-usesingle)
1337    
1338  C Loop over all processors      C Loop over all processors    
1339        do jp=1,nPy        do jp=1,nPy
1340        do ip=1,nPx        do ip=1,nPx
# Line 814  C Loop over all tiles Line 1344  C Loop over all tiles
1344  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
1345           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1346           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1347           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
1348       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1349           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1350            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 830  C If we are writing to a tiled MDS file Line 1360  C If we are writing to a tiled MDS file
1360          if (fileIsOpen) then          if (fileIsOpen) then
1361           do k=1,nLocz           do k=1,nLocz
1362            do j=1,sNy            do j=1,sNy
1363               do ii=1,sNx               do i=1,sNx
1364                  arr(ii,j,k,bi,bj)=arr_gl(ii,bi,ip,j,bj,jp,k)                  arr(i,j,k,bi,bj)=arr_gl(i,bi,ip,j,bj,jp,k)
1365               enddo               enddo
1366              iG = 0              iG = 0
1367              jG = 0              jG = 0
# Line 890  C If we were writing to a tiled MDS file Line 1420  C If we were writing to a tiled MDS file
1420  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
1421           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1422           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1423           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
1424       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1425           dimList(1,1)=Nx           dimList(1,1)=Nx
1426           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 912  C End of ip,jp loops Line 1442  C End of ip,jp loops
1442         enddo         enddo
1443        enddo        enddo
1444    
   
1445        _END_MASTER( myThid )        _END_MASTER( myThid )
1446    
1447    #ifdef ALLOW_USE_MPI
1448    C endif useSingleCpuIO
1449          endif
1450    #endif /* ALLOW_USE_MPI */
1451    
1452  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1453        return        return
1454        end        end
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22