C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_rd_rec_rs.F,v 1.3 2011/08/31 21:28:18 jmc Exp $
C $Name: $
#include "MDSIO_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C !ROUTINE: MDS_RD_REC_RS
C !INTERFACE:
SUBROUTINE MDS_RD_REC_RS(
O arr,
O r4Buf, r8Buf,
I fPrec, dUnit, iRec, nArr, myThid )
C !DESCRIPTION:
C Read one reccord from already opened io-unit "dUnit", into RS array "arr"
C !USES:
IMPLICIT NONE
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
C !INPUT PARAMETERS:
C fPrec integer :: file precision
C dUnit integer :: 'Opened' I/O channel
C iRec integer :: record number to WRITE
C nArr integer :: dimension off array "arr"
C myThid integer :: my Thread Id number
C !OUTPUT PARAMETERS:
C arr RS :: vector array to read in
C r4Buf real*4 :: buffer array
C r8Buf real*8 :: buffer array
INTEGER fPrec
INTEGER dUnit
INTEGER iRec
INTEGER nArr
INTEGER myThid
_RS arr(nArr)
Real*4 r4Buf(nArr)
Real*8 r8Buf(nArr)
CEOP
C !LOCAL VARIABLES:
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER k
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( debugLevel.GE.debLevC ) THEN
WRITE(msgBuf,'(A,I9,2x,I9)')
& ' MDS_RD_REC_RS: iRec,Dim = ', iRec, nArr
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT , myThid )
ENDIF
IF ( fPrec.EQ.precFloat32 ) THEN
READ( dUnit, rec=iRec ) r4Buf
#ifdef _BYTESWAPIO
CALL MDS_BYTESWAPR4( nArr, r4Buf )
#endif
DO k=1,nArr
arr(k) = r4Buf(k)
ENDDO
ELSEIF ( fPrec.EQ.precFloat64 ) THEN
READ( dUnit, rec=iRec ) r8Buf
#ifdef _BYTESWAPIO
CALL MDS_BYTESWAPR8( nArr, r8Buf )
#endif
DO k=1,nArr
arr(k) = r8Buf(k)
ENDDO
ELSE
WRITE(msgBuf,'(A,I9)')
& ' MDS_RD_REC_RS: illegal value for fPrec=',fPrec
CALL PRINT_ERROR( msgBuf, myThid )
STOP 'ABNORMAL END: S/R MDS_RD_REC_RS'
ENDIF
RETURN
END