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