/[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.7 by heimbach, Wed Jan 12 19:15:03 2005 UTC revision 1.13 by jmc, Sat Nov 5 01:05:14 2005 UTC
# Line 82  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 91  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 116  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        endif
202    
203        if ( .not. ( globalFile .and. useSingleCPUIO ) ) then        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  C If we are reading from a global file then we open it here
208        if (globalFile) then        if (globalFile) then
# Line 159  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 167  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 178  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 )            call print_error( msgbuf, mythid )
# Line 266  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        endif
395  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
396    
# Line 346  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,i,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)
# Line 356  C Local variables Line 481  C Local variables
481        logical fileIsOpen        logical fileIsOpen
482        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
483  cph-usesingle(  cph-usesingle(
484    #ifdef ALLOW_USE_MPI
485        integer ii,jj        integer ii,jj
486        integer x_size,y_size,iG_IO,jG_IO,length_of_rec,npe        integer x_size,y_size,iG_IO,jG_IO,npe
487        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
488        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
489        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
490        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
491        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
492    #endif
493  cph-usesingle)  cph-usesingle)
494    
495  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 399  C globalFile is too slow, then try using Line 526  C globalFile is too slow, then try using
526  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
527         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
528          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
529           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
530           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
531           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
532            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 466  C Close data-file and create meta-file Line 593  C Close data-file and create meta-file
593         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
594          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
595           close( dUnit )           close( dUnit )
596           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
597           dimList(1,1)=Nx           dimList(1,1)=Nx
598           dimList(2,1)=1           dimList(2,1)=1
599           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 499  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 515  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 575  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 668  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 677  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 702  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. ( globalFile .and. useSingleCPUIO ) ) then        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  C If we are reading from a global file then we open it here
921        if (globalFile) then        if (globalFile) then
# Line 745  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 753  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 764  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 )            call print_error( msgbuf, mythid )
# Line 852  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        endif
1108  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1109    
# Line 933  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,i,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)
# Line 943  C Local variables Line 1195  C Local variables
1195        logical fileIsOpen        logical fileIsOpen
1196        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1197  cph-usesingle(  cph-usesingle(
1198    #ifdef ALLOW_USE_MPI
1199        integer ii,jj        integer ii,jj
1200        integer x_size,y_size,iG_IO,jG_IO,length_of_rec,npe        integer x_size,y_size,iG_IO,jG_IO,npe
1201        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1202        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1203        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
1204        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
1205        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
1206    #endif
1207  cph-usesingle)  cph-usesingle)
1208    
1209  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 987  C globalFile is too slow, then try using Line 1241  C globalFile is too slow, then try using
1241  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
1242         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1243          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1244           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
1245           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1246           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1247            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
# Line 1054  C Close data-file and create meta-file Line 1308  C Close data-file and create meta-file
1308         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1309          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1310           close( dUnit )           close( dUnit )
1311           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
1312           dimList(1,1)=Nx           dimList(1,1)=Nx
1313           dimList(2,1)=1           dimList(2,1)=1
1314           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 1087  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 1103  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 1163  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
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22