/[MITgcm]/MITgcm/eesupp/src/mdsio.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/mdsio.F

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

revision 1.3 by adcroft, Mon May 17 14:40:36 1999 UTC revision 1.4 by adcroft, Wed Jul 28 17:39:17 1999 UTC
# Line 2  C $Header$ Line 2  C $Header$
2    
3  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
4    
5  C The three "public" routines supplied here are:  C The five "public" routines supplied here are:
6  C  C
7  C MDSREADFIELD  - read model field from direct access global or tiled MDS file  C MDSREADFIELD   - read model field from direct access global or tiled MDS file
8  C MDSWRITEFIELD - write model field to direct access global or tiled MDS file  C MDSWRITEFIELD  - write model field to direct access global or tiled MDS file
9  C MDSFINDUNIT   - returns an available (unused) I/O channel  C MDSFINDUNIT    - returns an available (unused) I/O channel
10  C MDSREADVECTOR - read vector from direct access global or tiled MDS file  C MDSREADVECTOR  - read vector from direct access global or tiled MDS file
11  C MDSWRITEVECTOR- write vector to direct access global or tiled MDS file  C MDSWRITEVECTOR - write vector to direct access global or tiled MDS file
12  C  C
13  C all other routines are "private" to these utilities and ought  C all other routines are "private" to these utilities and ought
14  C not be accessed directly from the main code.  C not be accessed directly from the main code.
# Line 18  C Modified: 03/23/99 adcroft@mit.edu Line 18  C Modified: 03/23/99 adcroft@mit.edu
18  C           To work with multiple records  C           To work with multiple records
19  C Modified: 03/29/99 eckert@mit.edu  C Modified: 03/29/99 eckert@mit.edu
20  C           Added arbitrary vector capability  C           Added arbitrary vector capability
21  C  C Modified: 07/27/99 eckert@mit.edu
22    C           Customized for state estimation (--> active_file_control.F)
23    C           this relates only to *mdsreadvector* and *mdswritevector*
24    C Modified: 07/28/99 eckert@mit.edu
25    C           inserted calls to *print_message* and *print_error*
26    C
27    C To be modified to work with MITgcmuv message routines.
28    
29  #undef  SAFE_IO  #undef  SAFE_IO
30    
# Line 90  C Local variables Line 96  C Local variables
96        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
97        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
98        integer length_of_rec        integer length_of_rec
99          character*(max_len_mbuf) msgbuf
100  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
101    
102  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 97  C Only do I/O if I am the master thread Line 104  C Only do I/O if I am the master thread
104    
105  C Record number must be >= 1  C Record number must be >= 1
106        if (irecord .LT. 1) then        if (irecord .LT. 1) then
107         write(0,'(a,i)') 'MDSREADFIELD: argument irecord = ',irecord         write(msgbuf,'(a,i9.8)')
108         stop 'MDSREADFIELD: *ERROR* Invalid value for irecord'       &   ' MDSREADFIELD: argument irecord = ',irecord
109           call print_message( msgbuf, standardmessageunit,
110         &                     SQUEEZE_RIGHT , mythid)
111           write(msgbuf,'(a)')
112         &   ' MDSREADFIELD: Invalid value for irecord'
113           call print_error( msgbuf, mythid )
114           stop 'ABNORMAL END: S/R MDSREADFIELD'
115        endif        endif
116    
117  C Assume nothing  C Assume nothing
# Line 107  C Assume nothing Line 120  C Assume nothing
120        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
121    
122  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
123        call MDSFINDUNIT( dUnit )        call MDSFINDUNIT( dUnit, mythid )
124    
125  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
126        dataFName = fName        dataFName = fName
127        inquire( file=dataFname, exist=exst )        inquire( file=dataFname, exist=exst )
128        if (exst) then        if (exst) then
129         write(0,'(2a)') 'MDSREADFIELD: opening global file: ',dataFName         write(msgbuf,'(a,a)')
130         &   ' MDSREADFIELD: opening global file: ',dataFName
131           call print_message( msgbuf, standardmessageunit,
132         &                     SQUEEZE_RIGHT , mythid)
133         globalFile = .TRUE.         globalFile = .TRUE.
134        endif        endif
135    
# Line 122  C If negative check for global file with Line 138  C If negative check for global file with
138         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
139         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
140         if (exst) then         if (exst) then
141          write(0,'(2a)') 'MDSREADFIELD: opening global file: ',dataFName          write(msgbuf,'(a,a)')
142         &    ' MDSREADFIELD: opening global file: ',dataFName
143            call print_message( msgbuf, standardmessageunit,
144         &                      SQUEEZE_RIGHT , mythid)
145          globalFile = .TRUE.          globalFile = .TRUE.
146         endif         endif
147        endif        endif
148    
149  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
150        if (globalFile) then        if (globalFile) then
151         length_of_rec=MDS_RECLEN( filePrec, sNx )         length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
152         open( dUnit, file=dataFName, status='old',         open( dUnit, file=dataFName, status='old',
153       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
154         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
# Line 148  C If we are reading from a tiled MDS fil Line 167  C If we are reading from a tiled MDS fil
167  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"
168  C (This is a place-holder for the active/passive mechanism  C (This is a place-holder for the active/passive mechanism
169           if (exst) then           if (exst) then
170            write(0,'(2a)') 'MDSREADFIELD: opening file: ',dataFName            write(msgbuf,'(a,a)')
171            length_of_rec=MDS_RECLEN( filePrec, sNx )       &      ' MDSREADFIELD: opening file: ',dataFName
172              call print_message( msgbuf, standardmessageunit,
173         &                        SQUEEZE_RIGHT , mythid)
174              length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
175            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
176       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
177            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
178           else           else
179            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
180            write(0,*) 'MDSREADFIELD: filename=',dataFName            write(msgbuf,'(a,a)')
181            stop 'MDSREADFIELD: File does not exist'       &      ' MDSREADFIELD: filename: ',dataFName
182  C         stop 'MDSREADFIELD: un-active tiles not implemented yet'            call print_message( msgbuf, standardmessageunit,
183         &                        SQUEEZE_RIGHT , mythid)
184              write(msgbuf,'(a)')
185         &      ' MDSREADFIELD: File does not exist'
186              call print_error( msgbuf, mythid )
187              stop 'ABNORMAL END: S/R MDSREADFIELD'
188           endif           endif
189          endif          endif
190    
# Line 184  C         stop 'MDSREADFIELD: un-active Line 211  C         stop 'MDSREADFIELD: un-active
211              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
212               call MDS_SEG4toRL( j,bi,bj,k,nNz, r4seg, .TRUE., arr )               call MDS_SEG4toRL( j,bi,bj,k,nNz, r4seg, .TRUE., arr )
213              else              else
214               stop 'MDSREADFIELD: illegal value for arrType'               write(msgbuf,'(a)')
215         &         ' MDSREADFIELD: illegal value for arrType'
216                 call print_error( msgbuf, mythid )
217                 stop 'ABNORMAL END: S/R MDSREADFIELD'
218              endif              endif
219             elseif (filePrec .eq. precFloat64) then             elseif (filePrec .eq. precFloat64) then
220              read(dUnit,rec=irec) r8seg              read(dUnit,rec=irec) r8seg
# Line 196  C         stop 'MDSREADFIELD: un-active Line 226  C         stop 'MDSREADFIELD: un-active
226              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
227               call MDS_SEG8toRL( j,bi,bj,k,nNz, r8seg, .TRUE., arr )               call MDS_SEG8toRL( j,bi,bj,k,nNz, r8seg, .TRUE., arr )
228              else              else
229               stop 'MDSREADFIELD: illegal value for arrType'               write(msgbuf,'(a)')
230         &         ' MDSREADFIELD: illegal value for arrType'
231                 call print_error( msgbuf, mythid )
232                 stop 'ABNORMAL END: S/R MDSREADFIELD'
233              endif              endif
234             else             else
235              stop 'MDSREADFIELD: illegal value for filePrec'              write(msgbuf,'(a)')
236         &        ' MDSREADFIELD: illegal value for filePrec'
237                call print_error( msgbuf, mythid )
238                stop 'ABNORMAL END: S/R MDSREADFIELD'
239             endif             endif
240  C End of j loop  C End of j loop
241            enddo            enddo
# Line 300  C Local variables Line 336  C Local variables
336        integer dimList(3,3),ndims        integer dimList(3,3),ndims
337        integer length_of_rec        integer length_of_rec
338        logical fileIsOpen        logical fileIsOpen
339          character*(max_len_mbuf) msgbuf
340  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
341    
342  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 307  C Only do I/O if I am the master thread Line 344  C Only do I/O if I am the master thread
344    
345  C Record number must be >= 1  C Record number must be >= 1
346        if (irecord .LT. 1) then        if (irecord .LT. 1) then
347         write(0,'(a,i)') 'MDSWRITEFIELD: argument irecord = ',irecord         write(msgbuf,'(a,i9.8)')
348         stop 'MDSWRITEFIELD: *ERROR* Invalid value for irecord'       &   ' MDSWRITEFIELD: argument irecord = ',irecord
349           call print_message( msgbuf, standardmessageunit,
350         &                     SQUEEZE_RIGHT , mythid)
351           write(msgbuf,'(a)')
352         &   ' MDSWRITEFIELD: invalid value for irecord'
353           call print_error( msgbuf, mythid )
354           stop 'ABNORMAL END: S/R MDSWRITEFIELD'
355        endif        endif
356    
357  C Assume nothing  C Assume nothing
# Line 316  C Assume nothing Line 359  C Assume nothing
359        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
360    
361  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
362        call MDSFINDUNIT( dUnit )        call MDSFINDUNIT( dUnit, mythid )
363    
364  C If we are writing to a global file then we open it here  C If we are writing to a global file then we open it here
365        if (globalFile) then        if (globalFile) then
366         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
367         if (irecord .EQ. 1) then         if (irecord .EQ. 1) then
368          length_of_rec=MDS_RECLEN( filePrec, sNx )          length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
369          open( dUnit, file=dataFName, status=_NEW_STATUS,          open( dUnit, file=dataFName, status=_NEW_STATUS,
370       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
371          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
372         else         else
373          length_of_rec=MDS_RECLEN( filePrec, sNx )          length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
374          open( dUnit, file=dataFName, status='old',          open( dUnit, file=dataFName, status='old',
375       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
376          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
# Line 344  C If we are writing to a tiled MDS file Line 387  C If we are writing to a tiled MDS file
387           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
388       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
389           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
390            length_of_rec=MDS_RECLEN( filePrec, sNx )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
391            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
392       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
393            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
394           else           else
395            length_of_rec=MDS_RECLEN( filePrec, sNx )            length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
396            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
397       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
398            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
# Line 374  C If we are writing to a tiled MDS file Line 417  C If we are writing to a tiled MDS file
417              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
418               call MDS_SEG4toRL( j,bi,bj,k,nNz, r4seg, .FALSE., arr )               call MDS_SEG4toRL( j,bi,bj,k,nNz, r4seg, .FALSE., arr )
419              else              else
420               stop 'MDSWRITEFIELD: illegal value for arrType'               write(msgbuf,'(a)')
421         &         ' MDSWRITEFIELD: illegal value for arrType'
422                 call print_error( msgbuf, mythid )
423                 stop 'ABNORMAL END: S/R MDSWRITEFIELD'
424              endif              endif
425  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
426              call MDS_BYTESWAPR4( sNx, r4seg )              call MDS_BYTESWAPR4( sNx, r4seg )
# Line 386  C If we are writing to a tiled MDS file Line 432  C If we are writing to a tiled MDS file
432              elseif (arrType .eq. 'RL') then              elseif (arrType .eq. 'RL') then
433               call MDS_SEG8toRL( j,bi,bj,k,nNz, r8seg, .FALSE., arr )               call MDS_SEG8toRL( j,bi,bj,k,nNz, r8seg, .FALSE., arr )
434              else              else
435               stop 'MDSWRITEFIELD: illegal value for arrType'               write(msgbuf,'(a)')
436         &         ' MDSWRITEFIELD: illegal value for arrType'
437                 call print_error( msgbuf, mythid )
438                 stop 'ABNORMAL END: S/R MDSWRITEFIELD'
439              endif              endif
440  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
441              call MDS_BYTESWAPR8( sNx, r8seg )              call MDS_BYTESWAPR8( sNx, r8seg )
442  #endif  #endif
443              write(dUnit,rec=irec) r8seg              write(dUnit,rec=irec) r8seg
444             else             else
445              stop 'MDSWRITEFIELD: illegal value for filePrec'              write(msgbuf,'(a)')
446         &        ' MDSWRITEFIELD: illegal value for filePrec'
447                call print_error( msgbuf, mythid )
448                stop 'ABNORMAL END: S/R MDSWRITEFIELD'
449             endif             endif
450  C End of j loop  C End of j loop
451            enddo            enddo
452  C End of k loop  C End of k loop
453           enddo           enddo
454          else          else
455           stop 'MDSWRITEFIELD: I should not ever get to this point'           write(msgbuf,'(a)')
456         &     ' MDSWRITEFIELD: I should never get to this point'
457             call print_error( msgbuf, mythid )
458             stop 'ABNORMAL END: S/R MDSWRITEFIELD'
459          endif          endif
460  C If we were writing to a tiled MDS file then we close it here  C If we were writing to a tiled MDS file then we close it here
461          if (fileIsOpen .AND. (.NOT. globalFile)) then          if (fileIsOpen .AND. (.NOT. globalFile)) then
# Line 425  C Create meta-file for each tile if we a Line 480  C Create meta-file for each tile if we a
480           ndims=3           ndims=3
481           if (nNz .EQ. 1) ndims=2           if (nNz .EQ. 1) ndims=2
482           call MDSWRITEMETA( metaFName, dataFName,           call MDSWRITEMETA( metaFName, dataFName,
483       &     filePrec, ndims, dimList, irecord, myIter )       &     filePrec, ndims, dimList, irecord, myIter, mythid )
484          endif          endif
485  C End of bi,bj loops  C End of bi,bj loops
486         enddo         enddo
# Line 443  C We can't do this operation using threa Line 498  C We can't do this operation using threa
498  C "barrier" at the next step. The barrier could be removed but  C "barrier" at the next step. The barrier could be removed but
499  C at the cost of "safe" distributed I/O.  C at the cost of "safe" distributed I/O.
500         if (nThreads.NE.1) then         if (nThreads.NE.1) then
501          write(0,*)          write(msgbuf,'(a,a)')
502       & 'MDSWRITEFIELD: A threads version of this routine does not exist'       &    ' MDSWRITEFIELD: A threads version of this routine',
503          write(0,*) 'MDSWRITEFIELD: This needs to be fixed...'       &    ' does not exist.'
504          write(0,*) 'MDSWRITEFIELD: nThreads = ',nThreads          call print_message( msgbuf, standardmessageunit,
505          stop 'MDSWRITEFIELD: Stopping because you are using threads'       &                      SQUEEZE_RIGHT , mythid)
506            write(msgbuf,'(a)')
507         &    ' MDSWRITEFIELD: This needs to be fixed...'
508            call print_message( msgbuf, standardmessageunit,
509         &                      SQUEEZE_RIGHT , mythid)
510            write(msgbuf,'(a,i3.2)')
511         &    ' MDSWRITEFIELD: nThreads = ',nThreads
512            call print_message( msgbuf, standardmessageunit,
513         &                      SQUEEZE_RIGHT , mythid)
514            write(msgbuf,'(a)')
515         &    ' MDSWRITEFIELD: Stopping because you are using threads'
516            call print_error( msgbuf, mythid )
517            stop 'ABNORMAL END: S/R MDSWRITEFIELD'
518         endif         endif
519  C We put a barrier here to ensure that all processes have finished  C We put a barrier here to ensure that all processes have finished
520  C writing their data before we update the meta-file  C writing their data before we update the meta-file
# Line 465  C writing their data before we update th Line 532  C writing their data before we update th
532         ndims=3         ndims=3
533         if (nNz .EQ. 1) ndims=2         if (nNz .EQ. 1) ndims=2
534         call MDSWRITEMETA( metaFName, dataFName,         call MDSWRITEMETA( metaFName, dataFName,
535       &   filePrec, ndims, dimList, irecord, myIter )       &   filePrec, ndims, dimList, irecord, myIter, mythid )
536         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
537        endif        endif
538    
# Line 635  C======================================= Line 702  C=======================================
702       I    ndims,       I    ndims,
703       I    dimList,       I    dimList,
704       I    nrecords,       I    nrecords,
705       I    myIter )       I    myIter,
706         I    mythid )
707    
708  C IN:  C IN:
709  C     mFileName string  - complete name of meta-file  C     mFileName string  - complete name of meta-file
# Line 644  C     ndims    integer - number of dimensio Line 712  C     ndims    integer - number of dimensio
712  C     dimList   integer - array of dimensions, etc.  C     dimList   integer - array of dimensions, etc.
713  C     nrecords  integer - record number  C     nrecords  integer - record number
714  C     myIter    integer - time-step number  C     myIter    integer - time-step number
715    C     mythid    integer - thread id
716  C OUT:  C OUT:
717  C  C
718  C Created: 03/20/99 adcroft@mit.edu  C Created: 03/20/99 adcroft@mit.edu
# Line 657  C Arguments Line 726  C Arguments
726        integer dimList(3,ndims)        integer dimList(3,ndims)
727        integer nrecords        integer nrecords
728        integer myIter        integer myIter
729          integer mythid
730    
731  C Global variables / common blocks  C Global variables / common blocks
732  #include "SIZE.h"  #include "SIZE.h"
# Line 668  C Functions Line 738  C Functions
738  C Local  C Local
739        integer i,ii,mUnit        integer i,ii,mUnit
740        logical ex        logical ex
741          character*(max_len_mbuf) msgbuf
742  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
743    
744  C We should *read* the met-file if it exists to check  C We should *read* the met-file if it exists to check
# Line 681  C and that the last record is written to Line 752  C and that the last record is written to
752  C last consecutive record in the file.  C last consecutive record in the file.
753    
754  C Assign a free unit number as the I/O channel for this subroutine  C Assign a free unit number as the I/O channel for this subroutine
755        call MDSFINDUNIT( mUnit )        call MDSFINDUNIT( mUnit, mythid )
756    
757  C Open meta-file  C Open meta-file
758        open( mUnit, file=mFileName, status='unknown',        open( mUnit, file=mFileName, status='unknown',
# Line 711  C Record the precision of the file Line 782  C Record the precision of the file
782        elseif (filePrec .EQ. precFloat64) then        elseif (filePrec .EQ. precFloat64) then
783         write(mUnit,'(x,a)') "format = [ 'float64' ];"         write(mUnit,'(x,a)') "format = [ 'float64' ];"
784        else        else
785         stop 'MDSWRITEMETA: invalid filePrec'         write(msgbuf,'(a)')
786         &   ' MDSWRITEMETA: invalid filePrec'
787           call print_error( msgbuf, mythid )
788           stop 'ABNORMAL END: S/R MDSWRITEMETA'
789        endif        endif
790    
791  C Record the current record number  C Record the current record number
# Line 738  C     ---------------------------------- Line 812  C     ----------------------------------
812  C=======================================================================  C=======================================================================
813    
814  C=======================================================================  C=======================================================================
815        subroutine MDSFINDUNIT( iounit )        subroutine MDSFINDUNIT( iounit, mythid )
816  C OUT:  C OUT:
817  C     iounit   integer - unit number  C     iounit   integer - unit number
818  C  C
# Line 749  C Line 823  C
823  C Created: 03/20/99 adcroft@mit.edu  C Created: 03/20/99 adcroft@mit.edu
824    
825        implicit none        implicit none
826    
827    #include "EEPARAMS.h"
828    
829  C Arguments  C Arguments
830        integer iounit        integer iounit
831          integer mythid
832  C Local  C Local
833        integer ii        integer ii
834        logical op        logical op
835        integer ios        integer ios
836          character*(max_len_mbuf) msgbuf
837  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
838    
839  C Sweep through a valid range of unit numbers  C Sweep through a valid range of unit numbers
# Line 763  C Sweep through a valid range of unit nu Line 842  C Sweep through a valid range of unit nu
842          if (iounit.eq.-1) then          if (iounit.eq.-1) then
843            inquire(unit=ii,iostat=ios,opened=op)            inquire(unit=ii,iostat=ios,opened=op)
844            if (ios.ne.0) then            if (ios.ne.0) then
845              write(0,*) 'MDSFINDUNIT: inquiring unit number =',ii              write(msgbuf,'(a,i2.2)')
846              stop 'MDSFINDUNIT: inquire statement failed!'       &        ' MDSFINDUNIT: inquiring unit number = ',ii
847                call print_message( msgbuf, standardmessageunit,
848         &                          SQUEEZE_RIGHT , mythid)
849                write(msgbuf,'(a)')
850         &        ' MDSFINDUNIT: inquire statement failed!'
851                call print_error( msgbuf, mythid )
852                stop 'ABNORMAL END: S/R MDSFINDUNIT'
853            endif            endif
854            if (.NOT. op) then            if (.NOT. op) then
855              iounit=ii              iounit=ii
# Line 774  C Sweep through a valid range of unit nu Line 859  C Sweep through a valid range of unit nu
859    
860  C Was there an available unit number  C Was there an available unit number
861        if (iounit.eq.-1) then        if (iounit.eq.-1) then
862          stop 'MDSFINDUNIT: could not find an available unit number!'          write(msgbuf,'(a)')
863         &    ' MDSFINDUNIT: could not find an available unit number!'
864            call print_error( msgbuf, mythid )
865            stop 'ABNORMAL END: S/R MDSFINDUNIT'
866        endif        endif
867    
868  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 783  C     ---------------------------------- Line 871  C     ----------------------------------
871  C=======================================================================  C=======================================================================
872    
873  C=======================================================================  C=======================================================================
874        integer function MDS_RECLEN( filePrec, nnn )        integer function MDS_RECLEN( filePrec, nnn, mythid )
875  C IN:  C IN:
876  C   filePrec    integer - precision of file in bits  C   filePrec    integer - precision of file in bits
877  C   nnn         integer - number of elements in record  C   nnn         integer - number of elements in record
# Line 796  C Created: 03/29/99 eckert@mit.edu + adc Line 884  C Created: 03/29/99 eckert@mit.edu + adc
884  C Arguments  C Arguments
885        integer filePrec        integer filePrec
886        integer nnn        integer nnn
887          integer mythid
888  C Global variables  C Global variables
889  #include "SIZE.h"  #include "SIZE.h"
890  #include "EEPARAMS.h"  #include "EEPARAMS.h"
891  #include "PARAMS.h"  #include "PARAMS.h"
892  C Local  C Local
893          character*(max_len_mbuf) msgbuf
894  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
895    
896        if (filePrec .EQ. precFloat32) then        if (filePrec .EQ. precFloat32) then
# Line 808  C     ---------------------------------- Line 898  C     ----------------------------------
898        elseif (filePrec .EQ. precFloat64) then        elseif (filePrec .EQ. precFloat64) then
899         MDS_RECLEN=nnn*WORDLENGTH*2         MDS_RECLEN=nnn*WORDLENGTH*2
900        else        else
901         write(0,*) 'MDS_RECLEN: filePrec = ',filePrec         write(msgbuf,'(a,i2.2)')
902         stop 'MDS_RECLEN: Illegal value for filePrec'       &   ' MDS_RECLEN: filePrec = ',filePrec
903           call print_message( msgbuf, standardmessageunit,
904         &                     SQUEEZE_RIGHT , mythid)
905           write(msgbuf,'(a)')
906         &   ' MDS_RECLEN: illegal value for filePrec'
907           call print_error( msgbuf, mythid )
908           stop 'ABNORMAL END: S/R MDS_RECLEN'
909        endif        endif
910    
911  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
# Line 824  C======================================= Line 920  C=======================================
920       I   arrType,       I   arrType,
921       I   narr,       I   narr,
922       O   arr,       O   arr,
923         I   bi,
924         I   bj,
925       I   irecord,       I   irecord,
926       I   myThid )       I   myThid )
927  C  C
# Line 834  C filePrec     integer number of bits per wo Line 932  C filePrec     integer number of bits per wo
932  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType       char(2) declaration of "arr": either "RS" or "RL"
933  C narr          integer size of third dimension: normally either 1 or Nr  C narr          integer size of third dimension: normally either 1 or Nr
934  C arr           RS/RL   array to read into, arr(narr)  C arr           RS/RL   array to read into, arr(narr)
935    ce bi           integer x tile index
936    ce bj           integer y tile index
937  C irecord       integer record number to read  C irecord       integer record number to read
938  C myThid        integer thread identifier  C myThid        integer thread identifier
939  C  C
940  C Created: 03/26/99 eckert@mit.edu  C Created: 03/26/99 eckert@mit.edu
941  C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu  C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu
942  C           Fixed to work work with _RS and _RL declarations  C           Fixed to work work with _RS and _RL declarations
943    C Modified: 07/27/99 eckert@mit.edu
944    C           Customized  for state estimation (--> active_file_control.F)
945    
946        implicit none        implicit none
947  C Global variables / common blocks  C Global variables / common blocks
# Line 855  C Routine arguments Line 957  C Routine arguments
957        Real arr(narr)        Real arr(narr)
958        integer irecord        integer irecord
959        integer myThid        integer myThid
960    ce
961          integer bi,bj
962    ce
963    
964  C Functions  C Functions
965        integer ILNBLNK        integer ILNBLNK
966        integer MDS_RECLEN        integer MDS_RECLEN
967  C Local variables  C Local variables
968        character*(80) dataFName        character*(80) dataFName
969        integer iG,jG,irec,bi,bj,dUnit,IL        integer iG,jG,irec,dUnit,IL
970        logical exst        logical exst
971        logical globalFile,fileIsOpen        logical globalFile,fileIsOpen
972        integer length_of_rec        integer length_of_rec
973          character*(max_len_mbuf) msgbuf
974  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
975    
976  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 871  C Only do I/O if I am the master thread Line 978  C Only do I/O if I am the master thread
978    
979  C Record number must be >= 1  C Record number must be >= 1
980        if (irecord .LT. 1) then        if (irecord .LT. 1) then
981         write(0,'(a,i)') 'MDSREADVECTOR: argument irecord = ',irecord         write(msgbuf,'(a,i9.8)')
982         stop 'MDSREADVECTOR: *ERROR* Invalid value for irecord'       &   ' MDSREADVECTOR: argument irecord = ',irecord
983           call print_message( msgbuf, standardmessageunit,
984         &                     SQUEEZE_RIGHT , mythid)
985           write(msgbuf,'(a)')
986         &   ' MDSREADVECTOR: invalid value for irecord'
987           call print_error( msgbuf, mythid )
988           stop 'ABNORMAL END: S/R MDSREADVECTOR'
989        endif        endif
990    
991  C Assume nothing  C Assume nothing
# Line 881  C Assume nothing Line 994  C Assume nothing
994        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
995    
996  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
997        call MDSFINDUNIT( dUnit )        call MDSFINDUNIT( dUnit, mythid )
998    
999  C Check first for global file with simple name (ie. fName)  C Check first for global file with simple name (ie. fName)
1000        dataFName = fName        dataFName = fName
1001        inquire( file=dataFname, exist=exst )        inquire( file=dataFname, exist=exst )
1002        if (exst) then        if (exst) then
1003         write(0,'(2a)') 'MDSREADVECTOR: opening global file: ',dataFName         write(msgbuf,'(a,a)')
1004         &   ' MDSREADVECTOR: opening global file: ',dataFName
1005           call print_message( msgbuf, standardmessageunit,
1006         &                     SQUEEZE_RIGHT , mythid)
1007         globalFile = .TRUE.         globalFile = .TRUE.
1008        endif        endif
1009    
# Line 896  C If negative check for global file with Line 1012  C If negative check for global file with
1012         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
1013         inquire( file=dataFname, exist=exst )         inquire( file=dataFname, exist=exst )
1014         if (exst) then         if (exst) then
1015          write(0,'(2a)') 'MDSREADVECTOR: opening global file: ',dataFName           write(msgbuf,'(a,a)')
1016         &     ' MDSREADVECTOR: opening global file: ',dataFName
1017             call print_message( msgbuf, standardmessageunit,
1018         &                       SQUEEZE_RIGHT , mythid)
1019          globalFile = .TRUE.          globalFile = .TRUE.
1020         endif         endif
1021        endif        endif
1022    
1023  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
1024        if (globalFile) then        if (globalFile) then
1025         length_of_rec=MDS_RECLEN( filePrec, narr )         length_of_rec=MDS_RECLEN( filePrec, narr, mythid )
1026         open( dUnit, file=dataFName, status='old',         open( dUnit, file=dataFName, status='old',
1027       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
1028         fileIsOpen=.TRUE.         fileIsOpen=.TRUE.
1029        endif        endif
1030    
1031  C Loop over all tiles  C Loop over all tiles
1032        do bj=1,nSy  ce      do bj=1,nSy
1033         do bi=1,nSx  ce       do bi=1,nSx
1034  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
1035          if (.NOT. globalFile) then          if (.NOT. globalFile) then
1036           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
# Line 922  C If we are reading from a tiled MDS fil Line 1041  C If we are reading from a tiled MDS fil
1041  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"
1042  C (This is a place-holder for the active/passive mechanism)  C (This is a place-holder for the active/passive mechanism)
1043           if (exst) then           if (exst) then
1044            write(0,'(2a)') 'MDSREADVECTOR: opening file: ',dataFName            write(msgbuf,'(a,a)')
1045            length_of_rec=MDS_RECLEN( filePrec, narr )       &      ' MDSREADVECTOR: opening file: ',dataFName
1046              call print_message( msgbuf, standardmessageunit,
1047         &                        SQUEEZE_RIGHT , mythid)
1048              length_of_rec=MDS_RECLEN( filePrec, narr, mythid )
1049            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
1050       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
1051            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
1052           else           else
1053            fileIsOpen=.FALSE.            fileIsOpen=.FALSE.
1054            stop 'MDSREADVECTOR: un-active tiles not implemented yet'            write(msgbuf,'(a)')
1055         &      ' MDSREADVECTOR: un-active tiles not implemented yet'
1056              call print_error( msgbuf, mythid )
1057              stop 'ABNORMAL END: S/R MDSREADVECTOR'
1058           endif           endif
1059          endif          endif
1060          if (fileIsOpen) then          if (fileIsOpen) then
# Line 948  C (This is a place-holder for the active Line 1073  C (This is a place-holder for the active
1073            elseif (filePrec .eq. precFloat64) then            elseif (filePrec .eq. precFloat64) then
1074             call MDS_READ_RL_VEC( dUnit, irec, narr, arr )             call MDS_READ_RL_VEC( dUnit, irec, narr, arr )
1075            else            else
1076              stop 'MDSREADVECTOR: illegal value for filePrec'              write(msgbuf,'(a)')
1077         &        ' MDSREADVECTOR: illegal value for filePrec'
1078                call print_error( msgbuf, mythid )
1079                stop 'ABNORMAL END: S/R MDSREADVECTOR'
1080            endif            endif
1081            if (.NOT. globalFile) then            if (.NOT. globalFile) then
1082              close( dUnit )              close( dUnit )
# Line 956  C (This is a place-holder for the active Line 1084  C (This is a place-holder for the active
1084            endif            endif
1085          endif          endif
1086  C End of bi,bj loops  C End of bi,bj loops
1087         enddo  ce       enddo
1088        enddo  ce      enddo
1089    
1090  C If global file was opened then close it  C If global file was opened then close it
1091        if (fileIsOpen .AND. globalFile) then        if (fileIsOpen .AND. globalFile) then
# Line 980  C======================================= Line 1108  C=======================================
1108       I   arrType,       I   arrType,
1109       I   narr,       I   narr,
1110       I   arr,       I   arr,
1111         I   bi,
1112         I   bj,
1113       I   irecord,       I   irecord,
1114       I   myIter,       I   myIter,
1115       I   myThid )       I   myThid )
# Line 991  C globalFile   logical selects between wri Line 1121  C globalFile   logical selects between wri
1121  C arrType       char(2) declaration of "arr": either "RS" or "RL"  C arrType       char(2) declaration of "arr": either "RS" or "RL"
1122  C narr          integer size of third dimension: normally either 1 or Nr  C narr          integer size of third dimension: normally either 1 or Nr
1123  C arr           RS/RL   array to write, arr(narr)  C arr           RS/RL   array to write, arr(narr)
1124    ce bi           integer x tile index
1125    ce bj           integer y tile index
1126  C irecord       integer record number to read  C irecord       integer record number to read
1127  C myIter        integer time step number  C myIter        integer time step number
1128  C myThid        integer thread identifier  C myThid        integer thread identifier
# Line 998  C Line 1130  C
1130  C Created: 03/26/99 eckert@mit.edu  C Created: 03/26/99 eckert@mit.edu
1131  C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu  C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu
1132  C           Fixed to work work with _RS and _RL declarations  C           Fixed to work work with _RS and _RL declarations
1133    C Modified: 07/27/99 eckert@mit.edu
1134    C           Customized  for state estimation (--> active_file_control.F)
1135    
1136        implicit none        implicit none
1137  C Global variables / common blocks  C Global variables / common blocks
# Line 1015  C Routine arguments Line 1149  C Routine arguments
1149        integer irecord        integer irecord
1150        integer myIter        integer myIter
1151        integer myThid        integer myThid
1152    ce
1153          integer bi,bj
1154    ce
1155    
1156  C Functions  C Functions
1157        integer ILNBLNK        integer ILNBLNK
1158        integer MDS_RECLEN        integer MDS_RECLEN
1159  C Local variables  C Local variables
1160        character*(80) dataFName,metaFName        character*(80) dataFName,metaFName
1161        integer iG,jG,irec,bi,bj,dUnit,IL        integer iG,jG,irec,dUnit,IL
1162        logical fileIsOpen        logical fileIsOpen
1163        integer dimList(3,3),ndims        integer dimList(3,3),ndims
1164        integer length_of_rec        integer length_of_rec
1165          character*(max_len_mbuf) msgbuf
1166  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1167    
1168  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
# Line 1031  C Only do I/O if I am the master thread Line 1170  C Only do I/O if I am the master thread
1170    
1171  C Record number must be >= 1  C Record number must be >= 1
1172        if (irecord .LT. 1) then        if (irecord .LT. 1) then
1173         write(0,'(a,i)') 'MDSWRITEVECTOR: argument irecord = ',irecord         write(msgbuf,'(a,i9.8)')
1174         stop 'MDSWRITEVECTOR: *ERROR* Invalid value for irecord'       &   ' MDSWRITEVECTOR: argument irecord = ',irecord
1175           call print_message( msgbuf, standardmessageunit,
1176         &                     SQUEEZE_RIGHT , mythid)
1177           write(msgbuf,'(a)')
1178         &   ' MDSWRITEVECTOR: invalid value for irecord'
1179           call print_error( msgbuf, mythid )
1180           stop 'ABNORMAL END: S/R MDSWRITEVECTOR'
1181        endif        endif
1182    
1183  C Assume nothing  C Assume nothing
# Line 1040  C Assume nothing Line 1185  C Assume nothing
1185        IL=ILNBLNK( fName )        IL=ILNBLNK( fName )
1186    
1187  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
1188        call MDSFINDUNIT( dUnit )        call MDSFINDUNIT( dUnit, mythid )
1189    
1190  C If we are writing to a global file then we open it here  C If we are writing to a global file then we open it here
1191        if (globalFile) then        if (globalFile) then
1192         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
1193         if (irecord .EQ. 1) then         if (irecord .EQ. 1) then
1194          length_of_rec = MDS_RECLEN( filePrec, narr )          length_of_rec = MDS_RECLEN( filePrec, narr, mythid )
1195          open( dUnit, file=dataFName, status=_NEW_STATUS,          open( dUnit, file=dataFName, status=_NEW_STATUS,
1196       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
1197          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
1198         else         else
1199          length_of_rec = MDS_RECLEN( filePrec, narr )          length_of_rec = MDS_RECLEN( filePrec, narr, mythid )
1200          open( dUnit, file=dataFName, status='old',          open( dUnit, file=dataFName, status='old',
1201       &      access='direct', recl=length_of_rec )       &      access='direct', recl=length_of_rec )
1202          fileIsOpen=.TRUE.          fileIsOpen=.TRUE.
# Line 1059  C If we are writing to a global file the Line 1204  C If we are writing to a global file the
1204        endif        endif
1205    
1206  C Loop over all tiles  C Loop over all tiles
1207        do bj=1,nSy  ce      do bj=1,nSy
1208         do bi=1,nSx  ce       do bi=1,nSx
1209  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
1210          if (.NOT. globalFile) then          if (.NOT. globalFile) then
1211           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles           iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
# Line 1068  C If we are writing to a tiled MDS file Line 1213  C If we are writing to a tiled MDS file
1213           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)')
1214       &              fName(1:IL),'.',iG,'.',jG,'.data'       &              fName(1:IL),'.',iG,'.',jG,'.data'
1215           if (irecord .EQ. 1) then           if (irecord .EQ. 1) then
1216            length_of_rec = MDS_RECLEN( filePrec, narr )            length_of_rec = MDS_RECLEN( filePrec, narr, mythid )
1217            open( dUnit, file=dataFName, status=_NEW_STATUS,            open( dUnit, file=dataFName, status=_NEW_STATUS,
1218       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
1219            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
1220           else           else
1221            length_of_rec = MDS_RECLEN( filePrec, narr )            length_of_rec = MDS_RECLEN( filePrec, narr, mythid )
1222            open( dUnit, file=dataFName, status='old',            open( dUnit, file=dataFName, status='old',
1223       &       access='direct', recl=length_of_rec )       &       access='direct', recl=length_of_rec )
1224            fileIsOpen=.TRUE.            fileIsOpen=.TRUE.
# Line 1095  C If we are writing to a tiled MDS file Line 1240  C If we are writing to a tiled MDS file
1240            elseif (filePrec .eq. precFloat64) then            elseif (filePrec .eq. precFloat64) then
1241             call MDS_WRITE_RL_VEC( dUnit, irec, narr, arr )             call MDS_WRITE_RL_VEC( dUnit, irec, narr, arr )
1242            else            else
1243              stop 'MDSWRITEVECTOR: illegal value for filePrec'             write(msgbuf,'(a)')
1244         &       ' MDSWRITEVECTOR: illegal value for filePrec'
1245               call print_error( msgbuf, mythid )
1246               stop 'ABNORMAL END: S/R MDSWRITEVECTOR'
1247            endif            endif
1248          else          else
1249           stop 'MDSWRITEVECTOR: I should not ever get to this point'           write(msgbuf,'(a)')
1250         &     ' MDSWRITEVECTOR: I should never get to this point'
1251             call print_error( msgbuf, mythid )
1252             stop 'ABNORMAL END: S/R MDSWRITEVECTOR'
1253          endif          endif
1254  C If we were writing to a tiled MDS file then we close it here  C If we were writing to a tiled MDS file then we close it here
1255          if (fileIsOpen .AND. (.NOT. globalFile)) then          if (fileIsOpen .AND. (.NOT. globalFile)) then
# Line 1112  C Create meta-file for each tile file Line 1263  C Create meta-file for each tile file
1263           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')           write(metaFname(1:80),'(2a,i3.3,a,i3.3,a)')
1264       &              fName(1:IL),'.',iG,'.',jG,'.meta'       &              fName(1:IL),'.',iG,'.',jG,'.meta'
1265           dimList(1,1) = nPx*nSx*narr           dimList(1,1) = nPx*nSx*narr
1266           dimList(2,1) = (int(myXGlobalLo/sNx)+(bi-1))*narr           dimList(2,1) = ((myXGlobalLo-1)/sNx + (bi-1))*narr + 1
1267           dimList(3,1) = (int(myXGlobalLo/sNx)+  bi  )*narr - 1           dimList(3,1) = ((myXGlobalLo-1)/sNx +   bi  )*narr
1268           dimList(1,2) = nPy*nSy           dimList(1,2) = nPy*nSy
1269           dimList(2,2) = int(myYGlobalLo/sNy) + bj - 1           dimList(2,2) = (myYGlobalLo-1)/sNy + bj
1270           dimList(3,2) = int(myYGlobalLo/sNy) + bj - 1           dimList(3,2) = (myYGlobalLo-1)/sNy + bj
1271           dimList(1,3) = 1           dimList(1,3) = 1
1272           dimList(2,3) = 1           dimList(2,3) = 1
1273           dimList(3,3) = 1           dimList(3,3) = 1
1274           ndims=1           ndims=1
1275           call MDSWRITEMETA( metaFName, dataFName,           call MDSWRITEMETA( metaFName, dataFName,
1276       &     filePrec, ndims, dimList, irecord, myIter )       &     filePrec, ndims, dimList, irecord, myIter, mythid )
1277          endif          endif
1278  C End of bi,bj loops  C End of bi,bj loops
1279         enddo  ce       enddo
1280        enddo  ce      enddo
1281    
1282  C If global file was opened then close it  C If global file was opened then close it
1283        if (fileIsOpen .AND. globalFile) then        if (fileIsOpen .AND. globalFile) then
# Line 1148  C Create meta-file for global file Line 1299  C Create meta-file for global file
1299         dimList(3,3) = 1         dimList(3,3) = 1
1300         ndims=1         ndims=1
1301         call MDSWRITEMETA( metaFName, dataFName,         call MDSWRITEMETA( metaFName, dataFName,
1302       &   filePrec, ndims, dimList, irecord, myIter )       &   filePrec, ndims, dimList, irecord, myIter, mythid )
1303        endif        endif
1304    
1305        _END_MASTER( myThid )        _END_MASTER( myThid )
# Line 1158  C     ---------------------------------- Line 1309  C     ----------------------------------
1309  C=======================================================================  C=======================================================================
1310    
1311  C=======================================================================  C=======================================================================
1312        subroutine MDS_WRITE_RS_VEC( dUnit, irec, narr, arr )        subroutine MDS_WRITE_RS_VEC( dUnit, irec, narr, arr, mythid )
1313  C IN:  C IN:
1314  C   dunit       integer - 'Opened' I/O channel  C   dunit       integer - 'Opened' I/O channel
1315  C   irec        integer - record number to write  C   irec        integer - record number to write
1316  C   narr        integer - dimension off array "arr"  C   narr        integer - dimension off array "arr"
1317  C   arr         _RS     - model tiled vector  C   arr         _RS     - model tiled vector
1318    C   mythid      integer - thread id
1319  C  C
1320  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu
1321    
1322        implicit none        implicit none
1323    
1324    #include "EEPARAMS.h"
1325    
1326  C Arguments  C Arguments
1327        integer dUnit        integer dUnit
1328        integer irec        integer irec
1329        integer narr        integer narr
1330          integer mythid
1331        _RS arr(narr)        _RS arr(narr)
1332  C Local  C Local
1333          character*(max_len_mbuf) msgbuf
1334  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1335        write(0,*) 'MDS_WRITE_RS_VEC: irec=',irec,narr        write(msgbuf,'(a,i9.8,2x,i9.8)')
1336         &  ' MDS_WRITE_RS_VEC: irec = ',irec,narr
1337          call print_message( msgbuf, standardmessageunit,
1338         &                    SQUEEZE_RIGHT , mythid)
1339        write(dUnit,rec=irec) arr        write(dUnit,rec=irec) arr
1340  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1341        return        return
# Line 1183  C     ---------------------------------- Line 1343  C     ----------------------------------
1343  C=======================================================================  C=======================================================================
1344    
1345  C=======================================================================  C=======================================================================
1346        subroutine MDS_WRITE_RL_VEC( dUnit, irec, narr, arr )        subroutine MDS_WRITE_RL_VEC( dUnit, irec, narr, arr, mythid )
1347  C IN:  C IN:
1348  C   dunit       integer - 'Opened' I/O channel  C   dunit       integer - 'Opened' I/O channel
1349  C   irec        integer - record number to write  C   irec        integer - record number to write
1350  C   narr        integer - dimension off array "arr"  C   narr        integer - dimension off array "arr"
1351  C   arr         _RL     - model tiled vector  C   arr         _RL     - model tiled vector
1352    C   mythid      integer - thread id
1353  C  C
1354  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu
1355    
1356        implicit none        implicit none
1357    
1358    #include "EEPARAMS.h"
1359    
1360  C Arguments  C Arguments
1361        integer dUnit        integer dUnit
1362        integer irec        integer irec
1363        integer narr        integer narr
1364          integer mythid
1365        _RL arr(narr)        _RL arr(narr)
1366  C Local  C Local
1367          character*(max_len_mbuf) msgbuf
1368  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1369        write(0,*) 'MDS_WRITE_RL_VEC: irec=',irec,narr        write(msgbuf,'(a,i9.8,2x,i9.8)')
1370         &  ' MDS_WRITE_RL_VEC: irec = ',irec,narr
1371          call print_message( msgbuf, standardmessageunit,
1372         &                    SQUEEZE_RIGHT , mythid)
1373        write(dUnit,rec=irec) arr        write(dUnit,rec=irec) arr
1374  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1375        return        return
# Line 1208  C     ---------------------------------- Line 1377  C     ----------------------------------
1377  C=======================================================================  C=======================================================================
1378    
1379  C=======================================================================  C=======================================================================
1380        subroutine MDS_READ_RS_VEC( dUnit, irec, narr, arr )        subroutine MDS_READ_RS_VEC( dUnit, irec, narr, arr, mythid )
1381  C IN:  C IN:
1382  C   dunit       integer - 'Opened' I/O channel  C   dunit       integer - 'Opened' I/O channel
1383  C   irec        integer - record number to write  C   irec        integer - record number to write
1384  C   narr        integer - dimension off array "arr"  C   narr        integer - dimension off array "arr"
1385    C   mythid      integer - thread id
1386  C OUT:  C OUT:
1387  C   arr         _RS     - model tiled vector  C   arr         _RS     - model tiled vector
1388  C  C
1389  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu
1390    
1391        implicit none        implicit none
1392    
1393    #include "EEPARAMS.h"
1394    
1395  C Arguments  C Arguments
1396        integer dUnit        integer dUnit
1397        integer irec        integer irec
1398        integer narr        integer narr
1399        _RS arr(narr)        _RS arr(narr)
1400          integer mythid
1401  C Local  C Local
1402          character*(max_len_mbuf) msgbuf
1403  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1404          write(msgbuf,'(a,i9.8,2x,i9.8)')
1405         &  ' MDS_READ_RS_VEC: irec = ',irec,narr
1406          call print_message( msgbuf, standardmessageunit,
1407         &                    SQUEEZE_RIGHT , mythid)
1408        read(dUnit,rec=irec) arr        read(dUnit,rec=irec) arr
1409  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1410        return        return
# Line 1233  C     ---------------------------------- Line 1412  C     ----------------------------------
1412  C=======================================================================  C=======================================================================
1413    
1414  C=======================================================================  C=======================================================================
1415        subroutine MDS_READ_RL_VEC( dUnit, irec, narr, arr )        subroutine MDS_READ_RL_VEC( dUnit, irec, narr, arr, mythid )
1416  C IN:  C IN:
1417  C   dunit       integer - 'Opened' I/O channel  C   dunit       integer - 'Opened' I/O channel
1418  C   irec        integer - record number to write  C   irec        integer - record number to write
1419  C   narr        integer - dimension off array "arr"  C   narr        integer - dimension off array "arr"
1420    C   mythid      integer - thread id
1421  C OUT:  C OUT:
1422  C   arr         _RL     - model tiled vector  C   arr         _RL     - model tiled vector
1423  C  C
1424  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu  C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu
1425    
1426        implicit none        implicit none
1427    
1428    #include "EEPARAMS.h"
1429    
1430  C Arguments  C Arguments
1431        integer dUnit        integer dUnit
1432        integer irec        integer irec
1433        integer narr        integer narr
1434        _RL arr(narr)        _RL arr(narr)
1435          integer mythid
1436  C Local  C Local
1437          character*(max_len_mbuf) msgbuf
1438  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1439          write(msgbuf,'(a,i9.8,2x,i9.8)')
1440         &  ' MDS_READ_RL_VEC: irec = ',irec,narr
1441          call print_message( msgbuf, standardmessageunit,
1442         &                    SQUEEZE_RIGHT , mythid)
1443        read(dUnit,rec=irec) arr        read(dUnit,rec=irec) arr
1444  C     ------------------------------------------------------------------  C     ------------------------------------------------------------------
1445        return        return
# Line 1324  C     ---------------------------------- Line 1513  C     ----------------------------------
1513        end        end
1514  C=======================================================================  C=======================================================================
1515  #endif  #endif
1516    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22