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