/[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.14 by jmc, Sun Nov 6 01:25:13 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "MDSIO_OPTIONS.h"  #include "MDSIO_OPTIONS.h"
5    
# Line 82  C Functions Line 83  C Functions
83        integer ILNBLNK        integer ILNBLNK
84        integer MDS_RECLEN        integer MDS_RECLEN
85  C Local variables  C Local variables
86        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
87        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
88        logical exst        logical exst
89        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,Nr,nSx,nSy)
90        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 91  C Local variables Line 92  C Local variables
92        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
93        integer length_of_rec        integer length_of_rec
94        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
95    cph-usesingle(
96          integer ii,jj
97    c     integer iG_IO,jG_IO,npe
98          integer x_size,y_size
99          PARAMETER ( x_size = Nx )
100          PARAMETER ( y_size = Ny )
101          Real*4 xy_buffer_r4(x_size,y_size)
102          Real*8 xy_buffer_r8(x_size,y_size)
103          Real*8 global(Nx,Ny)
104    c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
105    cph-usesingle)
106    
107  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
108    
109  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 116  C Assume nothing Line 129  C Assume nothing
129  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
130        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
131    
132          if ( useSingleCPUIO ) then
133    
134    #ifdef ALLOW_USE_MPI
135            IF( mpiMyId .EQ. 0 ) THEN
136    #else
137            IF ( .TRUE. ) THEN
138    #endif /* ALLOW_USE_MPI */
139    
140  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
141        dataFName = fName           dataFName = fName
142        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
143        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
       endif  
144    
145  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
146        if (.NOT. globalFile) then           if (.NOT. globalFile) then
147         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
148              inquire( file=dataFname, exist=exst )
149              if (exst) globalFile = .TRUE.
150             endif
151    
152    C If global file is visible to process 0, then open it here.
153    C Otherwise stop program.
154             if ( globalFile) then
155              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
156              open( dUnit, file=dataFName, status='old',
157         &         access='direct', recl=length_of_rec )
158             else
159              write(msgbuf,'(2a)')
160         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
161              call print_message( msgbuf, standardmessageunit,
162         &                        SQUEEZE_RIGHT , mythid)
163              call print_error( msgbuf, mythid )
164              write(msgbuf,'(a)')
165         &      ' MDSREADFIELD: File does not exist'
166              call print_message( msgbuf, standardmessageunit,
167         &                        SQUEEZE_RIGHT , mythid)
168              call print_error( msgbuf, mythid )
169              stop 'ABNORMAL END: S/R MDSREADFIELD'
170             endif
171    
172            ENDIF
173    
174    c-- useSingleCpuIO
175          else
176    C Only do I/O if I am the master thread
177    
178    C Check first for global file with simple name (ie. fName)
179           dataFName = fName
180         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
181         if (exst) then         if (exst) then
182          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
183       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
184          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
185       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
186         endif         endif
187    
188    C If negative check for global file with MDS name (ie. fName.data)
189           if (.NOT. globalFile) then
190            write(dataFname,'(2a)') fName(1:IL),'.data'
191            inquire( file=dataFname, exist=exst )
192            if (exst) then
193             write(msgbuf,'(a,a)')
194         &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
195             call print_message( msgbuf, standardmessageunit,
196         &                       SQUEEZE_RIGHT , mythid)
197             globalFile = .TRUE.
198            endif
199           endif
200    
201    c-- useSingleCpuIO
202        endif        endif
203    
204        if ( .not. ( globalFile .and. useSingleCPUIO ) ) then        if ( .not. useSingleCpuIO ) then
205    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
206          if ( .not. ( globalFile ) ) then
207    
208  C If we are reading from a global file then we open it here  C If we are reading from a global file then we open it here
209        if (globalFile) then        if (globalFile) then
# Line 159  C If we are reading from a tiled MDS fil Line 223  C If we are reading from a tiled MDS fil
223          if (.NOT. globalFile) then          if (.NOT. globalFile) then
224           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
225           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
226           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
227       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
228           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
229  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
# Line 167  C (This is a place-holder for the active Line 231  C (This is a place-holder for the active
231           if (exst) then           if (exst) then
232            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
233             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
234       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
235             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
236       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
237            endif            endif
# Line 178  C (This is a place-holder for the active Line 242  C (This is a place-holder for the active
242           else           else
243            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
244            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
245       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
246            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
247       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
248            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 266  C If global file was opened then close i Line 330  C If global file was opened then close i
330         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
331        endif        endif
332    
333    c      end of if ( .not. ( globalFile ) ) then
334          endif
335    
336    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
337          else
338    
339           DO k=1,nNz
340    
341    #ifdef ALLOW_USE_MPI
342             IF( mpiMyId .EQ. 0 ) THEN
343    #else
344             IF ( .TRUE. ) THEN
345    #endif /* ALLOW_USE_MPI */
346              irec = k+nNz*(irecord-1)
347              if (filePrec .eq. precFloat32) then
348               read(dUnit,rec=irec) xy_buffer_r4
349    #ifdef _BYTESWAPIO
350               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
351    #endif
352               DO J=1,Ny
353                DO I=1,Nx
354                 global(I,J) = xy_buffer_r4(I,J)
355                ENDDO
356               ENDDO
357              elseif (filePrec .eq. precFloat64) then
358               read(dUnit,rec=irec) xy_buffer_r8
359    #ifdef _BYTESWAPIO
360               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
361    #endif
362               DO J=1,Ny
363                DO I=1,Nx
364                 global(I,J) = xy_buffer_r8(I,J)
365                ENDDO
366               ENDDO
367              else
368               write(msgbuf,'(a)')
369         &            ' MDSREADFIELD: illegal value for filePrec'
370               call print_error( msgbuf, mythid )
371               stop 'ABNORMAL END: S/R MDSREADFIELD'
372              endif
373             ENDIF
374            DO jp=1,nPy
375             DO ip=1,nPx
376              DO bj = myByLo(myThid), myByHi(myThid)
377               DO bi = myBxLo(myThid), myBxHi(myThid)
378                DO J=1,sNy
379                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
380                 DO I=1,sNx
381                  II=((ip-1)*nSx+(bi-1))*sNx+I
382                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
383                 ENDDO
384                ENDDO
385               ENDDO
386              ENDDO
387             ENDDO
388            ENDDO
389    
390           ENDDO
391    c      ENDDO k=1,nNz
392    
393            close( dUnit )
394    
395        endif        endif
396  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
397    
# Line 346  C Functions Line 472  C Functions
472        integer ILNBLNK        integer ILNBLNK
473        integer MDS_RECLEN        integer MDS_RECLEN
474  C Local variables  C Local variables
475        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
476        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
477        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
478        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 356  C Local variables Line 482  C Local variables
482        logical fileIsOpen        logical fileIsOpen
483        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
484  cph-usesingle(  cph-usesingle(
485    #ifdef ALLOW_USE_MPI
486        integer ii,jj        integer ii,jj
487        integer x_size,y_size,iG_IO,jG_IO,length_of_rec,npe  c     integer iG_IO,jG_IO,npe
488          integer x_size,y_size
489        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
490        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
491        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
492        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
493        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
494    #endif
495  cph-usesingle)  cph-usesingle)
496    
497  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 399  C globalFile is too slow, then try using Line 528  C globalFile is too slow, then try using
528  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
529         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
530          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
531           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
532           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
533           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
534            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 595  C Close data-file and create meta-file
595         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
596          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
597           close( dUnit )           close( dUnit )
598           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
599           dimList(1,1)=Nx           dimList(1,1)=Nx
600           dimList(2,1)=1           dimList(2,1)=1
601           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 499  C Loop over all tiles Line 628  C Loop over all tiles
628  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
629           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
630           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
631           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
632       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
633           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
634            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 515  C If we are writing to a tiled MDS file Line 644  C If we are writing to a tiled MDS file
644          if (fileIsOpen) then          if (fileIsOpen) then
645           do k=1,Nr           do k=1,Nr
646            do j=1,sNy            do j=1,sNy
647               do ii=1,sNx               do i=1,sNx
648                  arr(ii,j,k,bi,bj)=arr_gl(ii,bi,ip,j,bj,jp,k)                  arr(i,j,k,bi,bj)=arr_gl(i,bi,ip,j,bj,jp,k)
649               enddo               enddo
650              iG = 0              iG = 0
651              jG = 0              jG = 0
# Line 575  C If we were writing to a tiled MDS file Line 704  C If we were writing to a tiled MDS file
704  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
705           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
706           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
707           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
708       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
709           dimList(1,1)=Nx           dimList(1,1)=Nx
710           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
# Line 668  C Functions Line 797  C Functions
797        integer ILNBLNK        integer ILNBLNK
798        integer MDS_RECLEN        integer MDS_RECLEN
799  C Local variables  C Local variables
800        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName
801        integer ip,jp,iG,jG,irec,bi,bj,ii,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
802        logical exst        logical exst
803        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)        _RL arr(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nLocz,nSx,nSy)
804        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
# Line 677  C Local variables Line 806  C Local variables
806        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
807        integer length_of_rec        integer length_of_rec
808        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
809    cph-usesingle(
810          integer ii,jj
811    c     integer iG_IO,jG_IO,npe
812          integer x_size,y_size
813          PARAMETER ( x_size = Nx )
814          PARAMETER ( y_size = Ny )
815          Real*4 xy_buffer_r4(x_size,y_size)
816          Real*8 xy_buffer_r8(x_size,y_size)
817          Real*8 global(Nx,Ny)
818    c     _RL    local(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
819    cph-usesingle)
820    
821  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
822    
823  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 702  C Assume nothing Line 843  C Assume nothing
843  C Assign a free unit number as the I/O channel for this routine  C Assign a free unit number as the I/O channel for this routine
844        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
845    
846          if ( useSingleCPUIO ) then
847    
848    C master thread of process 0, only, opens a global file
849    #ifdef ALLOW_USE_MPI
850            IF( mpiMyId .EQ. 0 ) THEN
851    #else
852            IF ( .TRUE. ) THEN
853    #endif /* ALLOW_USE_MPI */
854    
855  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
856        dataFName = fName           dataFName = fName
857        inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
858        if (exst) then           if (exst) globalFile = .TRUE.
        write(msgbuf,'(a,a)')  
      &   ' MDSREADFIELD: opening global file: ',dataFName  
        call print_message( msgbuf, standardmessageunit,  
      &                     SQUEEZE_RIGHT , mythid)  
       endif  
859    
860  C If negative check for global file with MDS name (ie. fName.data)  C If negative check for global file with MDS name (ie. fName.data)
861        if (.NOT. globalFile) then           if (.NOT. globalFile) then
862         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'            write(dataFname,'(2a)') fName(1:IL),'.data'
863              inquire( file=dataFname, exist=exst )
864              if (exst) globalFile = .TRUE.
865             endif
866    
867    C If global file is visible to process 0, then open it here.
868    C Otherwise stop program.
869             if ( globalFile) then
870              length_of_rec=MDS_RECLEN( filePrec, x_size*y_size, mythid )
871              open( dUnit, file=dataFName, status='old',
872         &         access='direct', recl=length_of_rec )
873             else
874              write(msgbuf,'(2a)')
875         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
876              call print_message( msgbuf, standardmessageunit,
877         &                        SQUEEZE_RIGHT , mythid)
878              call print_error( msgbuf, mythid )
879              write(msgbuf,'(a)')
880         &      ' MDSREADFIELD: File does not exist'
881              call print_message( msgbuf, standardmessageunit,
882         &                        SQUEEZE_RIGHT , mythid)
883              call print_error( msgbuf, mythid )
884              stop 'ABNORMAL END: S/R MDSREADFIELD'
885             endif
886    
887            ENDIF
888    
889    c-- useSingleCpuIO
890          else
891    
892    C Check first for global file with simple name (ie. fName)
893           dataFName = fName
894         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
895         if (exst) then         if (exst) then
896          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
897       &    ' MDSREADFIELD_GL: opening global file: ',dataFName       &    ' MDSREADFIELD: opening global file: ',dataFName(1:IL)
898          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
899       &                      SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , mythid)
         globalFile = .TRUE.  
900         endif         endif
901    
902    C If negative check for global file with MDS name (ie. fName.data)
903           if (.NOT. globalFile) then
904            write(dataFname,'(2a)') fName(1:IL),'.data'
905            inquire( file=dataFname, exist=exst )
906            if (exst) then
907             write(msgbuf,'(a,a)')
908         &     ' MDSREADFIELD_GL: opening global file: ',dataFName(1:IL+5)
909             call print_message( msgbuf, standardmessageunit,
910         &                       SQUEEZE_RIGHT , mythid)
911             globalFile = .TRUE.
912            endif
913           endif
914    
915    c-- useSingleCpuIO
916        endif        endif
917    
918        if ( .not. ( globalFile .and. useSingleCPUIO ) ) then        if ( .not. useSingleCpuIO ) then
919    cph      if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
920          if ( .not. ( globalFile ) ) then
921    
922  C If we are reading from a global file then we open it here  C If we are reading from a global file then we open it here
923        if (globalFile) then        if (globalFile) then
# Line 745  C If we are reading from a tiled MDS fil Line 937  C If we are reading from a tiled MDS fil
937          if (.NOT. globalFile) then          if (.NOT. globalFile) then
938           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
939           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
940           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
941       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
942           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
943  C Of course, we only open the file if the tile is "active"  C Of course, we only open the file if the tile is "active"
# Line 753  C (This is a place-holder for the active Line 945  C (This is a place-holder for the active
945           if (exst) then           if (exst) then
946            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevA ) then
947             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
948       &      ' MDSREADFIELD_GL: opening file: ',dataFName       &      ' MDSREADFIELD_GL: opening file: ',dataFName(1:IL+13)
949             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
950       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
951            endif            endif
# Line 764  C (This is a place-holder for the active Line 956  C (This is a place-holder for the active
956           else           else
957            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
958            write(msgbuf,'(a,a)')            write(msgbuf,'(a,a)')
959       &      ' MDSREADFIELD_GL: filename: ',dataFName       &      ' MDSREADFIELD_GL: filename: ',dataFName(1:IL+13)
960            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
961       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
962            call print_error( msgbuf, mythid )            call print_error( msgbuf, mythid )
# Line 852  C If global file was opened then close i Line 1044  C If global file was opened then close i
1044         fileIsOpen = .FALSE.         fileIsOpen = .FALSE.
1045        endif        endif
1046    
1047    c      end of if ( .not. ( globalFile ) ) then
1048          endif
1049    
1050    c      else of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1051          else
1052    
1053           DO k=1,nLocz
1054    
1055    #ifdef ALLOW_USE_MPI
1056             IF( mpiMyId .EQ. 0 ) THEN
1057    #else
1058             IF ( .TRUE. ) THEN
1059    #endif /* ALLOW_USE_MPI */
1060              irec = k+nNz*(irecord-1)
1061              if (filePrec .eq. precFloat32) then
1062               read(dUnit,rec=irec) xy_buffer_r4
1063    #ifdef _BYTESWAPIO
1064               call MDS_BYTESWAPR4( x_size*y_size, xy_buffer_r4 )
1065    #endif
1066               DO J=1,Ny
1067                DO I=1,Nx
1068                 global(I,J) = xy_buffer_r4(I,J)
1069                ENDDO
1070               ENDDO
1071              elseif (filePrec .eq. precFloat64) then
1072               read(dUnit,rec=irec) xy_buffer_r8
1073    #ifdef _BYTESWAPIO
1074               call MDS_BYTESWAPR8( x_size*y_size, xy_buffer_r8 )
1075    #endif
1076               DO J=1,Ny
1077                DO I=1,Nx
1078                 global(I,J) = xy_buffer_r8(I,J)
1079                ENDDO
1080               ENDDO
1081              else
1082               write(msgbuf,'(a)')
1083         &            ' MDSREADFIELD: illegal value for filePrec'
1084               call print_error( msgbuf, mythid )
1085               stop 'ABNORMAL END: S/R MDSREADFIELD'
1086              endif
1087             ENDIF
1088            DO jp=1,nPy
1089             DO ip=1,nPx
1090              DO bj = myByLo(myThid), myByHi(myThid)
1091               DO bi = myBxLo(myThid), myBxHi(myThid)
1092                DO J=1,sNy
1093                 JJ=((jp-1)*nSy+(bj-1))*sNy+J
1094                 DO I=1,sNx
1095                  II=((ip-1)*nSx+(bi-1))*sNx+I
1096                  arr_gl(i,bi,ip,j,bj,jp,k) = global(II,JJ)
1097                 ENDDO
1098                ENDDO
1099               ENDDO
1100              ENDDO
1101             ENDDO
1102            ENDDO
1103    
1104           ENDDO
1105    c      ENDDO k=1,nNz
1106    
1107            close( dUnit )
1108    
1109        endif        endif
1110  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then  c      end of if ( .not. ( globalFile .and. useSingleCPUIO ) ) then
1111    
# Line 933  C Functions Line 1187  C Functions
1187        integer ILNBLNK        integer ILNBLNK
1188        integer MDS_RECLEN        integer MDS_RECLEN
1189  C Local variables  C Local variables
1190        character*(80) dataFName,metaFName        character*(MAX_LEN_FNAM) dataFName,metaFName
1191        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL        integer ip,jp,iG,jG,irec,bi,bj,i,j,k,dUnit,IL
1192        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
1193        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
# Line 943  C Local variables Line 1197  C Local variables
1197        logical fileIsOpen        logical fileIsOpen
1198        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
1199  cph-usesingle(  cph-usesingle(
1200    #ifdef ALLOW_USE_MPI
1201        integer ii,jj        integer ii,jj
1202        integer x_size,y_size,iG_IO,jG_IO,length_of_rec,npe  c     integer iG_IO,jG_IO,npe
1203          integer x_size,y_size
1204        PARAMETER ( x_size = Nx )        PARAMETER ( x_size = Nx )
1205        PARAMETER ( y_size = Ny )        PARAMETER ( y_size = Ny )
1206        Real*4 xy_buffer_r4(x_size,y_size)        Real*4 xy_buffer_r4(x_size,y_size)
1207        Real*8 xy_buffer_r8(x_size,y_size)        Real*8 xy_buffer_r8(x_size,y_size)
1208        Real*8 global(Nx,Ny)        Real*8 global(Nx,Ny)
1209    #endif
1210  cph-usesingle)  cph-usesingle)
1211    
1212  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 987  C globalFile is too slow, then try using Line 1244  C globalFile is too slow, then try using
1244  C Master thread of process 0, only, opens a global file  C Master thread of process 0, only, opens a global file
1245         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1246          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1247           write(dataFname(1:80),'(2a)') fName(1:IL),'.data'           write(dataFname,'(2a)') fName(1:IL),'.data'
1248           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)           length_of_rec=MDS_RECLEN(filePrec,x_size*y_size,mythid)
1249           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1250            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 1311  C Close data-file and create meta-file
1311         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
1312          IF( mpiMyId .EQ. 0 ) THEN          IF( mpiMyId .EQ. 0 ) THEN
1313           close( dUnit )           close( dUnit )
1314           write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'           write(metaFName,'(2a)') fName(1:IL),'.meta'
1315           dimList(1,1)=Nx           dimList(1,1)=Nx
1316           dimList(2,1)=1           dimList(2,1)=1
1317           dimList(3,1)=Nx           dimList(3,1)=Nx
# Line 1087  C Loop over all tiles Line 1344  C Loop over all tiles
1344  C If we are writing to a tiled MDS file then we open each one here  C If we are writing to a tiled MDS file then we open each one here
1345           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1346           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1347           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
1348       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1349           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1350            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
# Line 1103  C If we are writing to a tiled MDS file Line 1360  C If we are writing to a tiled MDS file
1360          if (fileIsOpen) then          if (fileIsOpen) then
1361           do k=1,nLocz           do k=1,nLocz
1362            do j=1,sNy            do j=1,sNy
1363               do ii=1,sNx               do i=1,sNx
1364                  arr(ii,j,k,bi,bj)=arr_gl(ii,bi,ip,j,bj,jp,k)                  arr(i,j,k,bi,bj)=arr_gl(i,bi,ip,j,bj,jp,k)
1365               enddo               enddo
1366              iG = 0              iG = 0
1367              jG = 0              jG = 0
# Line 1163  C If we were writing to a tiled MDS file Line 1420  C If we were writing to a tiled MDS file
1420  C Create meta-file for each tile if we are tiling  C Create meta-file for each tile if we are tiling
1421           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles           iG=bi+(ip-1)*nsx ! Kludge until unstructered tiles
1422           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles           jG=bj+(jp-1)*nsy ! Kludge until unstructered tiles
1423           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname,'(2a,i3.3,a,i3.3,a)')
1424       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1425           dimList(1,1)=Nx           dimList(1,1)=Nx
1426           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1           dimList(2,1)=((ip-1)*nSx+(bi-1))*sNx+1
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22