/[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.12 by jahn, Tue Dec 30 00:14:05 2008 UTC revision 1.13 by jmc, Tue Dec 30 02:07:01 2008 UTC
# Line 13  C $Name$ Line 13  C $Name$
13       I   bj,       I   bj,
14       I   irecord,       I   irecord,
15       I   myThid )       I   myThid )
16  C  
17  C Arguments:  C Arguments:
18  C  C
19  C fName         string  base name for file to read  C fName    string  :: base name for file to read
20  C filePrec      integer number of bits per word in file (32 or 64)  C filePrec integer :: number of bits per word in file (32 or 64)
21  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType  char(2) :: declaration of "arr": either "RS" or "RL"
22  C narr          integer size of third dimension: normally either 1 or Nr  C narr     integer :: size of third dimension: normally either 1 or Nr
23  C arr           RS/RL   array to read into, arr(narr)  C arr       RS/RL  :: array to read into, arr(narr)
24  ce bi           integer x tile index  c bi       integer :: x tile index
25  ce bj           integer y tile index  c bj       integer :: y tile index
26  C irecord       integer record number to read  C irecord  integer :: record number to read
27  C myThid        integer thread identifier  C myThid   integer :: thread identifier
28  C  C
29  C Created: 03/26/99 eckert@mit.edu  C Created: 03/26/99 eckert@mit.edu
30  C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu  C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu
# Line 32  C           Fixed to work work with _RS Line 32  C           Fixed to work work with _RS
32  C Modified: 07/27/99 eckert@mit.edu  C Modified: 07/27/99 eckert@mit.edu
33  C           Customized  for state estimation (--> active_file_control.F)  C           Customized  for state estimation (--> active_file_control.F)
34    
35        implicit none        IMPLICIT NONE
36  C Global variables / common blocks  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"  #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        _RL arr(narr)        _RL arr(narr)
48        integer irecord        INTEGER bi,bj
49        integer myThid        INTEGER irecord
50  ce        INTEGER myThid
       integer bi,bj  
 ce  
51    
52  #if defined(ALLOW_AUTODIFF) || defined(ALLOW_FLT)  #if defined(ALLOW_AUTODIFF) || defined(ALLOW_FLT)
53    
54  C Functions  C Functions
55        integer ILNBLNK        INTEGER ILNBLNK
56        integer MDS_RECLEN        INTEGER MDS_RECLEN
57  C Local variables  C Local variables
58        character*(MAX_LEN_FNAM) 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(  cph(
66  cph Deal with useSingleCpuIO  cph Deal with useSingleCpuIO
67  cph Not extended here for EXCH2  cph Not extended here for EXCH2
68        integer k,l        INTEGER k,l
69        integer nNz        INTEGER vec_size
       integer vec_size  
70        Real*4 xy_buffer_r4(narr*nPx*nPy)        Real*4 xy_buffer_r4(narr*nPx*nPy)
71        Real*8 xy_buffer_r8(narr*nPx*nPy)        Real*8 xy_buffer_r8(narr*nPx*nPy)
72        Real*8 global   (narr*nPx*nPy)        Real*8 global   (narr*nPx*nPy)
# Line 78  cph) Line 75  cph)
75  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
76    
77        vec_size = narr*nPx*nPy        vec_size = narr*nPx*nPy
78        nNz = 1  
79          C Only DO I/O IF I am the master thread
 C Only do I/O if I am the master thread  
80        _BEGIN_MASTER( myThid )        _BEGIN_MASTER( myThid )
81    
82  C Record number must be >= 1  C Record number must be >= 1
83        if (irecord .LT. 1) then        IF (irecord .LT. 1) THEN
84         write(msgbuf,'(a,i9.8)')         WRITE(msgBuf,'(A,I9.8)')
85       &   ' MDSREADVECTOR: argument irecord = ',irecord       &   ' MDSREADVECTOR: argument irecord = ',irecord
86         call print_message( msgbuf, standardmessageunit,         CALL PRINT_ERROR( msgBuf, myThid )
87       &                     SQUEEZE_RIGHT , mythid)         WRITE(msgBuf,'(A)')
        write(msgbuf,'(a)')  
88       &   ' MDSREADVECTOR: invalid value for irecord'       &   ' MDSREADVECTOR: invalid value for irecord'
89         call print_error( msgbuf, mythid )         CALL PRINT_ERROR( msgBuf, myThid )
90         stop 'ABNORMAL END: S/R MDSREADVECTOR'         STOP 'ABNORMAL END: S/R MDSREADVECTOR'
91        endif        ENDIF
92    
93  C Assume nothing  C Assume nothing
94        globalFile = .FALSE.        globalFile = .FALSE.
# Line 102  C Assume nothing Line 97  C Assume nothing
97        pIL = ILNBLNK( mdsioLocalDir )        pIL = ILNBLNK( mdsioLocalDir )
98    
99  C Assign special directory  C Assign special directory
100        if ( mdsioLocalDir .NE. ' ' ) then        IF ( mdsioLocalDir .NE. ' ' ) THEN
101         write(pFname,'(2a)')         WRITE(pfName,'(2A)')
102       &  mdsioLocalDir(1:pIL), fName(1:IL)       &  mdsioLocalDir(1:pIL), fName(1:IL)
103        else        ELSE
104         pFname= fName         pfName= fName
105        endif        ENDIF
106        pIL=ILNBLNK( pfName )        pIL=ILNBLNK( pfName )
107    
108  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
109        call MDSFINDUNIT( dUnit, mythid )        CALL MDSFINDUNIT( dUnit, myThid )
110    
111        if ( .not. useSingleCPUIO ) then        IF ( .not. useSingleCPUIO ) THEN
112    
113  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
114        dataFName = fName        dataFName = fName
115        inquire( file=dataFname, exist=exst )        INQUIRE( file=dataFName, exist=exst )
116        if (exst) then        IF (exst) THEN
117         if ( debugLevel .GE. debLevB ) then         IF ( debugLevel .GE. debLevB ) THEN
118          write(msgbuf,'(a,a)')          WRITE(msgBuf,'(A,A)')
119       &   ' MDSREADVECTOR: opening global file: ',dataFName(1:IL)       &   ' MDSREADVECTOR: opening global file: ',dataFName(1:IL)
120          call print_message( msgbuf, standardmessageunit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
121       &                     SQUEEZE_RIGHT , mythid)       &                      SQUEEZE_RIGHT , myThid )
122         endif         ENDIF
123         globalFile = .TRUE.         globalFile = .TRUE.
124        endif        ENDIF
125    
126  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)
127        if (.NOT. globalFile) then        IF (.NOT. globalFile) THEN
128         write(dataFname,'(2a)') fName(1:IL),'.data'         WRITE(dataFName,'(2A)') fName(1:IL),'.data'
129         inquire( file=dataFname, exist=exst )         INQUIRE( file=dataFName, exist=exst )
130         if (exst) then         IF (exst) THEN
131          if ( debugLevel .GE. debLevB ) then          IF ( debugLevel .GE. debLevB ) THEN
132           write(msgbuf,'(a,a)')           WRITE(msgBuf,'(A,A)')
133       &     ' MDSREADVECTOR: opening global file: ',dataFName(1:IL+5)       &     ' MDSREADVECTOR: opening global file: ',dataFName(1:IL+5)
134           call print_message( msgbuf, standardmessageunit,           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
135       &                       SQUEEZE_RIGHT , mythid)       &                       SQUEEZE_RIGHT , myThid )
136          endif          ENDIF
137          globalFile = .TRUE.          globalFile = .TRUE.
138         endif         ENDIF
139        endif        ENDIF
140    
141  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
142        if (globalFile) then        IF (globalFile) THEN
143         length_of_rec=MDS_RECLEN( filePrec, narr, mythid )         length_of_rec=MDS_RECLEN( filePrec, narr, myThid )
144         open( dUnit, file=dataFName, status='old',         OPEN( dUnit, file=dataFName, status='old',
145       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
146         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
147        endif        ENDIF
148    
149  C Loop over all tiles  C Loop over all tiles
150  ce      do bj=1,nSy  c     DO bj=1,nSy
151  ce       do bi=1,nSx  c      DO bi=1,nSx
152  C If we are reading from a tiled MDS file then we open each one here  C If we are reading from a tiled MDS file then we open each one here
153          if (.NOT. globalFile) then          IF (.NOT. globalFile) THEN
154           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
155           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles           jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
156           write(dataFname,'(2a,i3.3,a,i3.3,a)')           WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
157       &              pfName(1:pIL),'.',iG,'.',jG,'.data'       &              pfName(1:pIL),'.',iG,'.',jG,'.data'
158           inquire( file=dataFname, exist=exst )           INQUIRE( file=dataFName, exist=exst )
159  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"
160  C (This is a place-holder for the active/passive mechanism)  C (This is a place-holder for the active/passive mechanism)
161           if (exst) then           IF (exst) THEN
162            if ( debugLevel .GE. debLevB ) then            IF ( debugLevel .GE. debLevB ) THEN
163             write(msgbuf,'(a,a)')             WRITE(msgBuf,'(A,A)')
164       &      ' MDSREADVECTOR: opening file: ',dataFName(1:pIL+13)       &      ' MDSREADVECTOR: opening file: ',dataFName(1:pIL+13)
165             call print_message( msgbuf, standardmessageunit,             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
166       &                        SQUEEZE_RIGHT , mythid)       &                         SQUEEZE_RIGHT , myThid )
167            endif            ENDIF
168            length_of_rec=MDS_RECLEN( filePrec, narr, mythid )            length_of_rec=MDS_RECLEN( filePrec, narr, myThid )
169            open( dUnit, file=dataFName, status='old',            OPEN( dUnit, file=dataFName, status='old',
170       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
171            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
172           else           ELSE
173            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
174            write(msgbuf,'(4a)')            WRITE(msgBuf,'(4A)')
175       &      ' MDSREADVECTOR: opening file: ',fName(1:IL),       &      ' MDSREADVECTOR: opening file: ',fName(1:IL),
176       &                                 ' , ',dataFName(1:pIL+13)       &                                 ' , ',dataFName(1:pIL+13)
177            call print_message( msgbuf, standardmessageunit,            CALL PRINT_ERROR( msgBuf, myThid )
178       &                        SQUEEZE_RIGHT , mythid)            WRITE(msgBuf,'(A)')
           write(msgbuf,'(a)')  
179       &      ' MDSREADVECTOR: un-active tiles not implemented yet'       &      ' MDSREADVECTOR: un-active tiles not implemented yet'
180            call print_error( msgbuf, mythid )            CALL PRINT_ERROR( msgBuf, myThid )
181            stop 'ABNORMAL END: S/R MDSREADVECTOR'            STOP 'ABNORMAL END: S/R MDSREADVECTOR'
182           endif           ENDIF
183          endif          ENDIF
184          if (fileIsOpen) then          IF (fileIsOpen) THEN
185            if (globalFile) then            IF (globalFile) THEN
186              iG   = myXGlobalLo-1+(bi-1)*sNx              iG   = myXGlobalLo-1+(bi-1)*sNx
187              jG   = myYGlobalLo-1+(bj-1)*sNy              jG   = myYGlobalLo-1+(bj-1)*sNy
188              irec = 1 + int(iG/sNx) + (jG/sNy)*nSx*nPx +              irec = 1 + int(iG/sNx) + (jG/sNy)*nSx*nPx +
189       &             (irecord-1)*nSx*nPx*nSy*nPy       &             (irecord-1)*nSx*nPx*nSy*nPy
190            else            ELSE
191              iG   = 0              iG   = 0
192              jG   = 0              jG   = 0
193              irec = irecord              irec = irecord
194            endif            ENDIF
195            if (filePrec .eq. precFloat32) then            IF ( arrType.EQ.'RS' ) THEN
196             call MDS_READ_RS_VEC( dUnit, irec, narr, arr, myThid )              CALL MDS_RD_REC_RS( arr, xy_buffer_r4, xy_buffer_r8,
197            elseif (filePrec .eq. precFloat64) then       I                          filePrec, dUnit, irec, narr, myThid )
198             call MDS_READ_RL_VEC( dUnit, irec, narr, arr, myThid )            ELSEIF ( arrType.EQ.'RL' ) THEN
199            else              CALL MDS_RD_REC_RL( arr, xy_buffer_r4, xy_buffer_r8,
200              write(msgbuf,'(a)')       I                          filePrec, dUnit, irec, narr, myThid )
201       &        ' MDSREADVECTOR: illegal value for filePrec'            ELSE
202              call print_error( msgbuf, mythid )              WRITE(msgBuf,'(A)')
203              stop 'ABNORMAL END: S/R MDSREADVECTOR'       &          ' MDSREADVECTOR: illegal value for arrType'
204            endif              CALL PRINT_ERROR( msgBuf, myThid )
205            if (.NOT. globalFile) then              STOP 'ABNORMAL END: S/R MDSREADVECTOR'
206              close( dUnit )            ENDIF
207              IF (.NOT. globalFile) THEN
208                CLOSE( dUnit )
209              fileIsOpen = .FALSE.              fileIsOpen = .FALSE.
210            endif            ENDIF
211          endif          ENDIF
212  C End of bi,bj loops  C End of bi,bj loops
213  ce       enddo  c      ENDDO
214  ce      enddo  c     ENDDO
215    
216  C If global file was opened then close it  C If global file was opened then close it
217        if (fileIsOpen .AND. globalFile) then        IF (fileIsOpen .AND. globalFile) THEN
218          close( dUnit )          CLOSE( dUnit )
219          fileIsOpen = .FALSE.          fileIsOpen = .FALSE.
220        endif        ENDIF
221    
222        _END_MASTER( myThid )        _END_MASTER( myThid )
223    
224        endif        ENDIF
225  c     endif ( .not. useSingleCPUIO )  C     end-if ( .not. useSingleCPUIO )
226    
227    
228  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
229    
230    
231        if ( useSingleCPUIO ) then        IF ( useSingleCPUIO ) THEN
232    
233  C master thread of process 0, only, opens a global file  C master thread of process 0, only, opens a global file
234         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
# Line 244  C master thread of process 0, only, open Line 240  C master thread of process 0, only, open
240    
241  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
242           dataFName = fName           dataFName = fName
243           inquire( file=dataFname, exist=exst )           INQUIRE( file=dataFName, exist=exst )
244           if (exst) globalFile = .TRUE.           IF (exst) globalFile = .TRUE.
245    
246  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)
247           if (.NOT. globalFile) then           IF (.NOT. globalFile) THEN
248            write(dataFname,'(2a)') fName(1:IL),'.data'            WRITE(dataFName,'(2a)') fName(1:IL),'.data'
249            inquire( file=dataFname, exist=exst )            INQUIRE( file=dataFName, exist=exst )
250            if (exst) globalFile = .TRUE.            IF (exst) globalFile = .TRUE.
251           endif           ENDIF
252    
253  C If global file is visible to process 0, then open it here.  C If global file is visible to process 0, then open it here.
254  C Otherwise stop program.  C Otherwise stop program.
255           if ( globalFile) then           IF ( globalFile) THEN
256            length_of_rec=MDS_RECLEN( filePrec, vec_size, mythid )            length_of_rec=MDS_RECLEN( filePrec, vec_size, myThid )
257            open( dUnit, file=dataFName, status='old',            OPEN( dUnit, file=dataFName, status='old',
258       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
259           else           ELSE
260            write(msgbuf,'(2a)')            WRITE(msgBuf,'(2A)')
261       &      ' MDSREADFIELD: filename: ',dataFName(1:IL)       &      ' MDSREADVECTOR: filename: ',dataFName(1:IL)
262            call print_message( msgbuf, standardmessageunit,  C-jmc: why double print (stdout + stderr) ?
263       &                        SQUEEZE_RIGHT , mythid)            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
264            call print_error( msgbuf, mythid )       &                        SQUEEZE_RIGHT , myThid )
265            write(msgbuf,'(a)')            CALL PRINT_ERROR( msgBuf, myThid )
266       &      ' MDSREADFIELD: File does not exist'            WRITE(msgBuf,'(A)')
267            call print_message( msgbuf, standardmessageunit,       &      ' MDSREADVECTOR: File does not exist'
268       &                        SQUEEZE_RIGHT , mythid)            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
269            call print_error( msgbuf, mythid )       &                        SQUEEZE_RIGHT , myThid )
270            stop 'ABNORMAL END: S/R MDSREADFIELD'            CALL PRINT_ERROR( msgBuf, myThid )
271           endif            STOP 'ABNORMAL END: S/R MDSREADVECTOR'
272             ENDIF
273    
274          ENDIF          ENDIF
275         _END_MASTER( myThid )         _END_MASTER( myThid )
# Line 286  C Otherwise stop program. Line 283  C Otherwise stop program.
283           IF ( .TRUE. ) THEN           IF ( .TRUE. ) THEN
284  #endif /* ALLOW_USE_MPI */  #endif /* ALLOW_USE_MPI */
285            irec = irecord            irec = irecord
286            if (filePrec .eq. precFloat32) then            IF (filePrec .EQ. precFloat32) THEN
287             read(dUnit,rec=irec) xy_buffer_r4             READ(dUnit,rec=irec) xy_buffer_r4
288  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
289             call MDS_BYTESWAPR4( vec_size, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( vec_size, xy_buffer_r4 )
290  #endif  #endif
291  cph#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  cph#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
292  c  c
# Line 298  cph#else /* defined(ALLOW_EXCH2) && !def Line 295  cph#else /* defined(ALLOW_EXCH2) && !def
295              global(L) = xy_buffer_r4(L)              global(L) = xy_buffer_r4(L)
296             ENDDO             ENDDO
297  cph#endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  cph#endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
298            elseif (filePrec .eq. precFloat64) then            ELSEIF (filePrec .EQ. precFloat64) THEN
299             read(dUnit,rec=irec) xy_buffer_r8             READ(dUnit,rec=irec) xy_buffer_r8
300  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
301             call MDS_BYTESWAPR8( vec_size, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( vec_size, xy_buffer_r8 )
302  #endif  #endif
303  cph#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)  cph#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)
304  c  c
# Line 310  cph#else /* defined(ALLOW_EXCH2) && !def Line 307  cph#else /* defined(ALLOW_EXCH2) && !def
307              global(L) = xy_buffer_r8(L)              global(L) = xy_buffer_r8(L)
308             ENDDO             ENDDO
309  cph#endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */  cph#endif /* defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) */
310            else            ELSE
311             write(msgbuf,'(a)')             WRITE(msgBuf,'(A)')
312       &            ' MDSREADFIELD: illegal value for filePrec'       &            ' MDSREADVECTOR: illegal value for filePrec'
313             call print_error( msgbuf, mythid )             CALL PRINT_ERROR( msgBuf, myThid )
314             stop 'ABNORMAL END: S/R MDSREADFIELD'             STOP 'ABNORMAL END: S/R MDSREADVECTOR'
315            endif            ENDIF
316           ENDIF           ENDIF
317          _END_MASTER( myThid )          _END_MASTER( myThid )
318          CALL SCATTER_VECTOR( narr,global,local,mythid )          CALL SCATTER_VECTOR( narr,global,local,myThid )
319          if (arrType .eq. 'RS') then          IF ( arrType.EQ.'RS' ) THEN
320             call PASStoRSvector( local,arr,narr,k,nNz,mythid )             CALL MDS_BUFFERtoRS( local, arr, narr, .TRUE., myThid )
321          elseif (arrType .eq. 'RL') then          ELSEIF ( arrType.EQ.'RL' ) THEN
322             call PASStoRLvector( local,arr,narr,k,nNz,mythid )             CALL MDS_BUFFERtoRL( local, arr, narr, .TRUE., myThid )
323          else          ELSE
324             write(msgbuf,'(a)')             WRITE(msgBuf,'(A)')
325       &          ' MDSREADFIELD: illegal value for arrType'       &          ' MDSREADVECTOR: illegal value for arrType'
326             call print_error( msgbuf, mythid )             CALL PRINT_ERROR( msgBuf, myThid )
327             stop 'ABNORMAL END: S/R MDSREADFIELD'             STOP 'ABNORMAL END: S/R MDSREADVECTOR'
328          endif          ENDIF
329    
330         ENDDO         ENDDO
331  c      ENDDO k=1,nNz  C      end-do k=1,1
332    
333         _BEGIN_MASTER( myThid )         _BEGIN_MASTER( myThid )
334          close( dUnit )          CLOSE( dUnit )
335         _END_MASTER( myThid )         _END_MASTER( myThid )
336    
337        endif        ENDIF
338  c     endif ( useSingleCPUIO )  C     end-if ( useSingleCPUIO )
339    
340  #endif /* defined(ALLOW_AUTODIFF) || defined(ALLOW_FLT) */  #endif /* defined(ALLOW_AUTODIFF) || defined(ALLOW_FLT) */
341    
342        return        RETURN
343        end        END
   
   
 C     ==================================================================  
   
       subroutine passToRSvector(local,arr,narr,k,nNz,mythid)  
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
   
       integer narr  
       _RL local(narr)  
       _RS arr(narr)  
       integer k,nNz  
       integer mythid  
   
       integer L  
   
       DO L=1,narr  
          arr(L) = local(L)  
       ENDDO  
   
       return  
       end  
   
       subroutine passToRLvector(local,arr,narr,k,nNz,mythid)  
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
   
       integer narr  
       _RL local(narr)  
       _RL arr(narr)  
       integer k,nNz  
       integer mythid  
   
       integer L  
   
       DO L=1,narr  
          arr(L) = local(L)  
       ENDDO  
   
       return  
       end  
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22