/[MITgcm]/MITgcm/pkg/mdsio/mdsio_readvector.F
ViewVC logotype

Diff of /MITgcm/pkg/mdsio/mdsio_readvector.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by heimbach, Fri Mar 7 04:30:08 2003 UTC revision 1.10 by heimbach, Wed Jun 7 21:13:46 2006 UTC
# Line 37  C Global variables / common blocks Line 37  C Global variables / common blocks
37  #include "SIZE.h"  #include "SIZE.h"
38  #include "EEPARAMS.h"  #include "EEPARAMS.h"
39  #include "PARAMS.h"  #include "PARAMS.h"
40    #include "EESUPPORT.h"
41    
42  C Routine arguments  C Routine arguments
43        character*(*) fName        character*(*) fName
44        integer filePrec        integer filePrec
45        character*(2) arrType        character*(2) arrType
46        integer narr        integer narr
47        Real arr(narr)        _RL arr(narr)
48        integer irecord        integer irecord
49        integer myThid        integer myThid
50  ce  ce
# Line 54  C Functions Line 55  C Functions
55        integer ILNBLNK        integer ILNBLNK
56        integer MDS_RECLEN        integer MDS_RECLEN
57  C Local variables  C Local variables
58        character*(80) dataFName        character*(MAX_LEN_FNAM) dataFName,pfName
59        integer iG,jG,irec,dUnit,IL        integer iG,jG,irec,dUnit,IL,pIL
60        logical exst        logical exst
61        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
62        integer length_of_rec        integer length_of_rec
63        character*(max_len_mbuf) msgbuf        character*(max_len_mbuf) msgbuf
64    
65    cph(
66    cph Deal with useSingleCpuIO
67    cph Not extended here for EXCH2
68          integer k,l
69          integer nNz
70          integer vec_size
71          Real*4 xy_buffer_r4(narr*nPx*nPy)
72          Real*8 xy_buffer_r8(narr*nPx*nPy)
73          Real*8 global   (narr*nPx*nPy)
74          _RL    local(narr)
75    cph)
76  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
77    
78          vec_size = narr*nPx*nPy
79          nNz = 1
80          
81  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
82        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
83    
# Line 80  C Record number must be >= 1 Line 96  C Record number must be >= 1
96  C Assume nothing  C Assume nothing
97        globalFile = .FALSE.        globalFile = .FALSE.
98        fileIsOpen = .FALSE.        fileIsOpen = .FALSE.
99        IL=ILNBLNK( fName )        IL  = ILNBLNK( fName )
100          pIL = ILNBLNK( mdsioLocalDir )
101    
102    C Assign special directory
103          if ( mdsioLocalDir .NE. ' ' ) then
104           write(pFname,'(2a)')
105         &  mdsioLocalDir(1:pIL), fName(1:IL)
106          else
107           pFname= fName
108          endif
109          pIL=ILNBLNK( pfName )
110    
111  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
112        call MDSFINDUNIT( dUnit, mythid )        call MDSFINDUNIT( dUnit, mythid )
113    
114          if ( .not. useSingleCPUIO ) then
115    
116  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
117        dataFName = fName        dataFName = fName
118        inquire( file=dataFname, exist=exst )        inquire( file=dataFname, exist=exst )
119        if (exst) then        if (exst) then
120         write(msgbuf,'(a,a)')         if ( debugLevel .GE. debLevB ) then
121       &   ' MDSREADVECTOR: opening global file: ',dataFName          write(msgbuf,'(a,a)')
122         call print_message( msgbuf, standardmessageunit,       &   ' MDSREADVECTOR: opening global file: ',dataFName(1:IL)
123            call print_message( msgbuf, standardmessageunit,
124       &                     SQUEEZE_RIGHT , mythid)       &                     SQUEEZE_RIGHT , mythid)
125           endif
126         globalFile = .TRUE.         globalFile = .TRUE.
127        endif        endif
128    
129  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)
130        if (.NOT. globalFile) then        if (.NOT. globalFile) then
131         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname,'(2a)') fName(1:IL),'.data'
132         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
133         if (exst) then         if (exst) then
134            if ( debugLevel .GE. debLevB ) then
135           write(msgbuf,'(a,a)')           write(msgbuf,'(a,a)')
136       &     ' MDSREADVECTOR: opening global file: ',dataFName       &     ' MDSREADVECTOR: opening global file: ',dataFName(1:IL+5)
137           call print_message( msgbuf, standardmessageunit,           call print_message( msgbuf, standardmessageunit,
138       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , mythid)
139            endif
140          globalFile = .TRUE.          globalFile = .TRUE.
141         endif         endif
142        endif        endif
# Line 124  C If we are reading from a tiled MDS fil Line 156  C If we are reading from a tiled MDS fil
156          if (.NOT. globalFile) then          if (.NOT. globalFile) then
157           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
158           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
159           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname,'(2a,i3.3,a,i3.3,a)')
160       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              pfName(1:pIL),'.',iG,'.',jG,'.data'
161           inquire( file=dataFname, exist=exst )           inquire( file=dataFname, exist=exst )
162  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"
163  C (This is a place-holder for the active/passive mechanism)  C (This is a place-holder for the active/passive mechanism)
164           if (exst) then           if (exst) then
165            write(msgbuf,'(a,a)')            if ( debugLevel .GE. debLevB ) then
166       &      ' MDSREADVECTOR: opening file: ',dataFName             write(msgbuf,'(a,a)')
167            call print_message( msgbuf, standardmessageunit,       &      ' MDSREADVECTOR: opening file: ',dataFName(1:pIL+13)
168               call print_message( msgbuf, standardmessageunit,
169       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
170              endif
171            length_of_rec=MDS_RECLEN( filePrec, narr, mythid )            length_of_rec=MDS_RECLEN( filePrec, narr, mythid )
172            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
173       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
174            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
175           else           else
176            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
177            write(msgbuf,'(a,a)')            write(msgbuf,'(4a)')
178       &      ' MDSREADVECTOR: opening file: ',dataFName       &      ' MDSREADVECTOR: opening file: ',fName(1:IL),
179         &                                 ' , ',dataFName(1:pIL+13)
180            call print_message( msgbuf, standardmessageunit,            call print_message( msgbuf, standardmessageunit,
181       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
182            write(msgbuf,'(a)')            write(msgbuf,'(a)')
# Line 188  C If global file was opened then close i Line 223  C If global file was opened then close i
223    
224        _END_MASTER( myThid )        _END_MASTER( myThid )
225    
226          endif
227    c     endif ( .not. useSingleCPUIO )
228    
229    
230  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
231    
232    
233          if ( useSingleCPUIO ) then
234    
235    C master thread of process 0, only, opens a global file
236           _BEGIN_MASTER( myThid )
237    #ifdef ALLOW_USE_MPI
238            IF( mpiMyId .EQ. 0 ) THEN
239    #else
240            IF ( .TRUE. ) THEN
241    #endif /* ALLOW_USE_MPI */
242    
243    C Check first for global file with simple name (ie. fName)
244             dataFName = fName
245             inquire( file=dataFname, exist=exst )
246             if (exst) globalFile = .TRUE.
247    
248    C If negative check for global file with MDS name (ie. fName.data)
249             if (.NOT. globalFile) then
250              write(dataFname,'(2a)') fName(1:IL),'.data'
251              inquire( file=dataFname, exist=exst )
252              if (exst) globalFile = .TRUE.
253             endif
254    
255    C If global file is visible to process 0, then open it here.
256    C Otherwise stop program.
257             if ( globalFile) then
258              length_of_rec=MDS_RECLEN( filePrec, vec_size, mythid )
259              open( dUnit, file=dataFName, status='old',
260         &         access='direct', recl=length_of_rec )
261             else
262              write(msgbuf,'(2a)')
263         &      ' MDSREADFIELD: filename: ',dataFName(1:IL)
264              call print_message( msgbuf, standardmessageunit,
265         &                        SQUEEZE_RIGHT , mythid)
266              call print_error( msgbuf, mythid )
267              write(msgbuf,'(a)')
268         &      ' MDSREADFIELD: File does not exist'
269              call print_message( msgbuf, standardmessageunit,
270         &                        SQUEEZE_RIGHT , mythid)
271              call print_error( msgbuf, mythid )
272              stop 'ABNORMAL END: S/R MDSREADFIELD'
273             endif
274    
275            ENDIF
276           _END_MASTER( myThid )
277    
278           DO k=1,1
279    
280            _BEGIN_MASTER( myThid )
281    #ifdef ALLOW_USE_MPI
282             IF( mpiMyId .EQ. 0 ) THEN
283    #else
284             IF ( .TRUE. ) THEN
285    #endif /* ALLOW_USE_MPI */
286              irec = irecord
287              if (filePrec .eq. precFloat32) then
288               read(dUnit,rec=irec) xy_buffer_r4
289    #ifdef _BYTESWAPIO
290               call MDS_BYTESWAPR4( vec_size, xy_buffer_r4 )
291    #endif
292    #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
293    c
294    #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
295               DO L=1,narr*nPx*nPy
296                global(L) = xy_buffer_r4(L)
297               ENDDO
298    #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
299              elseif (filePrec .eq. precFloat64) then
300               read(dUnit,rec=irec) xy_buffer_r8
301    #ifdef _BYTESWAPIO
302               call MDS_BYTESWAPR8( vec_size, xy_buffer_r8 )
303    #endif
304    #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
305    c
306    #else /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
307               DO L=1,narr*nPx*nPy
308                global(L) = xy_buffer_r8(L)
309               ENDDO
310    #endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
311              else
312               write(msgbuf,'(a)')
313         &            ' MDSREADFIELD: illegal value for filePrec'
314               call print_error( msgbuf, mythid )
315               stop 'ABNORMAL END: S/R MDSREADFIELD'
316              endif
317             ENDIF
318            _END_MASTER( myThid )
319            CALL SCATTER_VECTOR( narr,global,local,mythid )
320            if (arrType .eq. 'RS') then
321               call PASStoRSvector( local,arr,narr,k,nNz,mythid )
322            elseif (arrType .eq. 'RL') then
323               call PASStoRLvector( local,arr,narr,k,nNz,mythid )
324            else
325               write(msgbuf,'(a)')
326         &          ' MDSREADFIELD: illegal value for arrType'
327               call print_error( msgbuf, mythid )
328               stop 'ABNORMAL END: S/R MDSREADFIELD'
329            endif
330    
331           ENDDO
332    c      ENDDO k=1,nNz
333    
334           _BEGIN_MASTER( myThid )
335            close( dUnit )
336           _END_MASTER( myThid )
337    
338          endif
339    c     endif ( useSingleCPUIO )
340    
341          return
342          end
343    
344    
345    C     ==================================================================
346    
347          subroutine passToRSvector(local,arr,narr,k,nNz,mythid)
348          implicit none
349    #include "EEPARAMS.h"
350    #include "SIZE.h"
351    
352          integer narr
353          _RL local(narr)
354          _RS arr(narr)
355          integer k,nNz
356          integer mythid
357    
358          integer L
359    
360          DO L=1,narr
361             arr(L) = local(L)
362          ENDDO
363    
364          return
365          end
366    
367          subroutine passToRLvector(local,arr,narr,k,nNz,mythid)
368          implicit none
369    #include "EEPARAMS.h"
370    #include "SIZE.h"
371    
372          integer narr
373          _RL local(narr)
374          _RL arr(narr)
375          integer k,nNz
376          integer mythid
377    
378          integer L
379    
380          DO L=1,narr
381             arr(L) = local(L)
382          ENDDO
383    
384        return        return
385        end        end
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22