/[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.3 by heimbach, Tue Jul 8 15:00:27 2003 UTC revision 1.11 by heimbach, Tue Sep 30 22:39:25 2008 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,pfName        character*(MAX_LEN_FNAM) dataFName,pfName
59        integer iG,jG,irec,dUnit,IL,pIL        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 85  C Assume nothing Line 101  C Assume nothing
101    
102  C Assign special directory  C Assign special directory
103        if ( mdsioLocalDir .NE. ' ' ) then        if ( mdsioLocalDir .NE. ' ' ) then
104         write(pFname(1:80),'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)         write(pFname,'(2a)')
105         &  mdsioLocalDir(1:pIL), fName(1:IL)
106        else        else
107         pFname= fName         pFname= fName
108        endif        endif
# Line 94  C Assign special directory Line 111  C Assign special directory
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         if ( debugLevel .GE. debLevA ) then         if ( debugLevel .GE. debLevB ) then
121          write(msgbuf,'(a,a)')          write(msgbuf,'(a,a)')
122       &   ' MDSREADVECTOR: opening global file: ',dataFName       &   ' MDSREADVECTOR: opening global file: ',dataFName(1:IL)
123          call print_message( msgbuf, standardmessageunit,          call print_message( msgbuf, standardmessageunit,
124       &                     SQUEEZE_RIGHT , mythid)       &                     SQUEEZE_RIGHT , mythid)
125         endif         endif
# Line 109  C Check first for global file with simpl Line 128  C Check first for global file with simpl
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. debLevA ) then          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          endif
# Line 137  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       &              pfName(1:pIL),'.',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            if ( debugLevel .GE. debLevA ) then            if ( debugLevel .GE. debLevB ) then
166             write(msgbuf,'(a,a)')             write(msgbuf,'(a,a)')
167       &      ' MDSREADVECTOR: opening file: ',dataFName       &      ' MDSREADVECTOR: opening file: ',dataFName(1:pIL+13)
168             call print_message( msgbuf, standardmessageunit,             call print_message( msgbuf, standardmessageunit,
169       &                        SQUEEZE_RIGHT , mythid)       &                        SQUEEZE_RIGHT , mythid)
170            endif            endif
# Line 155  C (This is a place-holder for the active Line 174  C (This is a place-holder for the active
174            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
175           else           else
176            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
177            write(msgbuf,'(3a)')            write(msgbuf,'(4a)')
178       &      ' MDSREADVECTOR: opening file: ',dataFName,pfName       &      ' 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 203  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    cph#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
293    c
294    cph#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    cph#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    cph#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
305    c
306    cph#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    cph#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.3  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22