C $Header: /u/gcmpack/MITgcm/pkg/sbo/sbo_writevector.F,v 1.5 2004/06/18 16:59:00 edhill Exp $
C $Name:  $

#include "SBO_OPTIONS.h"

#undef  SAFE_IO

#ifdef SAFE_IO
#define _NEW_STATUS 'new'
#else
#define _NEW_STATUS 'unknown'
#endif

#ifdef ALLOW_AUTODIFF_TAMC
#define _OLD_STATUS 'unknown'
#else
#define _OLD_STATUS 'old'
#endif

      SUBROUTINE SBO_WRITEVECTOR(
     I   fName,
     I   narr,
     I   arr,
     I   irecord,
     I   myIter,
     I   myThid )
C     /==========================================================\
C     | SUBROUTINE SBO_WRITEVECTOR                               |
C     | o Routine to write a vector to a direct access file.     |
C     |==========================================================|
C     | This is a rewrite of MDSWRITEVECTOR that outputs a       |
C     | single Real*8 vector from the master process and thread. |
C     \==========================================================/
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C     == Routine arguments ==
C
C fName		string	base name for file to written
C narr		integer	size of vector dimension
C arr		Real array to write, arr(narr)
C irecord	integer	record number to read
C myIter	integer	time step number
C myThid	integer thread identifier

C Routine arguments
      character*(*) fName
      integer narr
      Real*8  arr(narr)
      integer irecord
      integer myIter
      integer myThid

#ifdef ALLOW_SBO

C Functions
      integer ILNBLNK
      integer MDS_RECLEN

C Local variables
C filePrec	integer	number of bits per word in file (64)
      integer filePrec
      PARAMETER ( filePrec = 64 )
      character*(80) dataFName,metaFName
      integer dUnit,IL
      logical fileIsOpen
      integer dimList(3,3),ndims
      integer length_of_rec
      character*(max_len_mbuf) msgbuf

C Only do I/O if I am the master process
      IF( myProcId .EQ. 0 ) THEN

C Only do I/O if I am the master thread
         _BEGIN_MASTER( myThid )

C Record number must be >= 1
         if (irecord .LT. 1) then
            write(msgbuf,'(a,i9.8)')
     &           ' SBO_WRITEVECTOR: argument irecord = ',irecord
            call PRINT_MESSAGE( msgbuf, standardmessageunit,
     &           SQUEEZE_RIGHT , mythid)
            write(msgbuf,'(a)')
     &           ' SBO_WRITEVECTOR: invalid value for irecord'
            call PRINT_ERROR( msgbuf, mythid )
            stop 'ABNORMAL END: S/R SBO_WRITEVECTOR'
         endif

C Assume nothing
         fileIsOpen = .FALSE.
         IL=ILNBLNK( fName )

C Assign a free unit number as the I/O channel for this routine
         call MDSFINDUNIT( dUnit, mythid )

C Open file
         write(dataFname(1:80),'(2a)') fName(1:IL),'.data'
         if (irecord .EQ. 1) then
            length_of_rec = MDS_RECLEN( filePrec, narr, mythid )
            open( dUnit, file=dataFName, status=_NEW_STATUS,
     &           access='direct', recl=length_of_rec )
            fileIsOpen=.TRUE.
         else
            length_of_rec = MDS_RECLEN( filePrec, narr, mythid )
            open( dUnit, file=dataFName, status=_OLD_STATUS,
     &           access='direct', recl=length_of_rec )
            fileIsOpen=.TRUE.
         endif

C Write record
         if (fileIsOpen) then
            write(msgbuf,'(a,i9.8,2x,i9.8)')
     &           ' SBO_WRITEVECTOR: irec = ',irecord,narr
            call PRINT_MESSAGE( msgbuf, standardmessageunit,
     &           SQUEEZE_RIGHT , mythid)
            write(dUnit,rec=irecord) arr
         else
            write(msgbuf,'(a)')
     &           ' SBO_WRITEVECTOR: I should never get to this point'
            call PRINT_ERROR( msgbuf, mythid )
            stop 'ABNORMAL END: S/R SBO_WRITEVECTOR'
         endif

C Close file
         if (fileIsOpen) then
            close( dUnit )
            fileIsOpen = .FALSE.
         endif

C Create meta-file
         write(metaFName(1:80),'(2a)') fName(1:IL),'.meta'
         dimList(1,1) = narr
         dimList(2,1) = 1
         dimList(3,1) = narr
         dimList(1,2) = 1
         dimList(2,2) = 1
         dimList(3,2) = 1
         dimList(1,3) = 1
         dimList(2,3) = 1
         dimList(3,3) = 1
         ndims=1
         call MDSWRITEMETA( metaFName, dataFName,
     &        filePrec, ndims, dimList, irecord, myIter, mythid )

         _END_MASTER( myThid )

      ENDIF

#endif /* ALLOW_SBO */

      return
      end