C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_readvector.F,v 1.5 2004/11/30 16:11:10 heimbach Exp $
C $Name: $
#include "MDSIO_OPTIONS.h"
SUBROUTINE MDSREADVECTOR(
I fName,
I filePrec,
I arrType,
I narr,
O arr,
I bi,
I bj,
I irecord,
I myThid )
C
C Arguments:
C
C fName string base name for file to read
C filePrec integer number of bits per word in file (32 or 64)
C arrType char(2) declaration of "arr": either "RS" or "RL"
C narr integer size of third dimension: normally either 1 or Nr
C arr RS/RL array to read into, arr(narr)
ce bi integer x tile index
ce bj integer y tile index
C irecord integer record number to read
C myThid integer thread identifier
C
C Created: 03/26/99 eckert@mit.edu
C Modified: 03/29/99 adcroft@mit.edu + eckert@mit.edu
C Fixed to work work with _RS and _RL declarations
C Modified: 07/27/99 eckert@mit.edu
C Customized for state estimation (--> active_file_control.F)
implicit none
C Global variables / common blocks
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
C Routine arguments
character*(*) fName
integer filePrec
character*(2) arrType
integer narr
Real arr(narr)
integer irecord
integer myThid
ce
integer bi,bj
ce
C Functions
integer ILNBLNK
integer MDS_RECLEN
C Local variables
character*(128) dataFName,pfName
integer iG,jG,irec,dUnit,IL,pIL
logical exst
logical globalFile,fileIsOpen
integer length_of_rec
character*(max_len_mbuf) msgbuf
C ------------------------------------------------------------------
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)')
& ' MDSREADVECTOR: argument irecord = ',irecord
call PRINT_MESSAGE( msgbuf, standardmessageunit,
& SQUEEZE_RIGHT , mythid)
write(msgbuf,'(a)')
& ' MDSREADVECTOR: invalid value for irecord'
call PRINT_ERROR( msgbuf, mythid )
stop 'ABNORMAL END: S/R MDSREADVECTOR'
endif
C Assume nothing
globalFile = .FALSE.
fileIsOpen = .FALSE.
IL = ILNBLNK( fName )
pIL = ILNBLNK( mdsioLocalDir )
C Assign special directory
if ( mdsioLocalDir .NE. ' ' ) then
write(pFname(1:128),'(2a)')
& mdsioLocalDir(1:pIL), fName(1:IL)
else
pFname= fName
endif
pIL=ILNBLNK( pfName )
C Assign a free unit number as the I/O channel for this routine
call MDSFINDUNIT( dUnit, mythid )
C Check first for global file with simple name (ie. fName)
dataFName = fName
inquire( file=dataFname, exist=exst )
if (exst) then
if ( debugLevel .GE. debLevB ) then
write(msgbuf,'(a,a)')
& ' MDSREADVECTOR: opening global file: ',dataFName
call PRINT_MESSAGE( msgbuf, standardmessageunit,
& SQUEEZE_RIGHT , mythid)
endif
globalFile = .TRUE.
endif
C If negative check for global file with MDS name (ie. fName.data)
if (.NOT. globalFile) then
write(dataFname(1:128),'(2a)') fName(1:IL),'.data'
inquire( file=dataFname, exist=exst )
if (exst) then
if ( debugLevel .GE. debLevB ) then
write(msgbuf,'(a,a)')
& ' MDSREADVECTOR: opening global file: ',dataFName
call PRINT_MESSAGE( msgbuf, standardmessageunit,
& SQUEEZE_RIGHT , mythid)
endif
globalFile = .TRUE.
endif
endif
C If we are reading from a global file then we open it here
if (globalFile) then
length_of_rec=MDS_RECLEN( filePrec, narr, mythid )
open( dUnit, file=dataFName, status='old',
& access='direct', recl=length_of_rec )
fileIsOpen=.TRUE.
endif
C Loop over all tiles
ce do bj=1,nSy
ce do bi=1,nSx
C If we are reading from a tiled MDS file then we open each one here
if (.NOT. globalFile) then
iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles
jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles
write(dataFname(1:128),'(2a,i3.3,a,i3.3,a)')
& pfName(1:pIL),'.',iG,'.',jG,'.data'
inquire( file=dataFname, exist=exst )
C Of course, we only open the file if the tile is "active"
C (This is a place-holder for the active/passive mechanism)
if (exst) then
if ( debugLevel .GE. debLevB ) then
write(msgbuf,'(a,a)')
& ' MDSREADVECTOR: opening file: ',dataFName
call PRINT_MESSAGE( msgbuf, standardmessageunit,
& SQUEEZE_RIGHT , mythid)
endif
length_of_rec=MDS_RECLEN( filePrec, narr, mythid )
open( dUnit, file=dataFName, status='old',
& access='direct', recl=length_of_rec )
fileIsOpen=.TRUE.
else
fileIsOpen=.FALSE.
write(msgbuf,'(3a)')
& ' MDSREADVECTOR: opening file: ',dataFName,pfName
call PRINT_MESSAGE( msgbuf, standardmessageunit,
& SQUEEZE_RIGHT , mythid)
write(msgbuf,'(a)')
& ' MDSREADVECTOR: un-active tiles not implemented yet'
call PRINT_ERROR( msgbuf, mythid )
stop 'ABNORMAL END: S/R MDSREADVECTOR'
endif
endif
if (fileIsOpen) then
if (globalFile) then
iG = myXGlobalLo-1+(bi-1)*sNx
jG = myYGlobalLo-1+(bj-1)*sNy
irec = 1 + int(iG/sNx) + (jG/sNy)*nSx*nPx +
& (irecord-1)*nSx*nPx*nSy*nPy
else
iG = 0
jG = 0
irec = irecord
endif
if (filePrec .eq. precFloat32) then
call MDS_READ_RS_VEC( dUnit, irec, narr, arr, myThid )
elseif (filePrec .eq. precFloat64) then
call MDS_READ_RL_VEC( dUnit, irec, narr, arr, myThid )
else
write(msgbuf,'(a)')
& ' MDSREADVECTOR: illegal value for filePrec'
call PRINT_ERROR( msgbuf, mythid )
stop 'ABNORMAL END: S/R MDSREADVECTOR'
endif
if (.NOT. globalFile) then
close( dUnit )
fileIsOpen = .FALSE.
endif
endif
C End of bi,bj loops
ce enddo
ce enddo
C If global file was opened then close it
if (fileIsOpen .AND. globalFile) then
close( dUnit )
fileIsOpen = .FALSE.
endif
_END_MASTER( myThid )
C ------------------------------------------------------------------
return
end