C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/flt/Attic/flt_mdsreadvector.F,v 1.1 2001/09/13 17:43:56 adcroft Exp $ C $Name: checkpoint51c_post $ #include "FLT_CPPOPTIONS.h" #undef SAFE_IO #ifdef SAFE_IO #define _NEW_STATUS 'new' #else #define _NEW_STATUS 'unknown' #endif SUBROUTINE MDSREADVECTOR_flt( I fName, O globalFile, 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) c Modified: 09/29/00 abiastoch@ucsd.edu c based on mdsreadvector c Checks first for local files and then for global 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*(80) dataFName integer iG,jG,irec,dUnit,IL 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 = .TRUE. fileIsOpen = .FALSE. IL=ILNBLNK( fName ) C Assign a free unit number as the I/O channel for this routine call MDSFINDUNIT( dUnit, mythid ) C Check first for local file iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)') & fName(1:IL),'.',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 write(msgbuf,'(a,a)') & ' MDSREADVECTOR: opening file: ',dataFName call print_message( msgbuf, standardmessageunit, & SQUEEZE_RIGHT , mythid) globalFile = .FALSE. endif C If no local file is available check for global files if (globalFile) then C Check first for global file with simple name (ie. fName) dataFName = fName inquire( file=dataFname, exist=exst ) if (exst) then write(msgbuf,'(a,a)') & ' MDSREADVECTOR: opening global file: ',dataFName call print_message( msgbuf, standardmessageunit, & SQUEEZE_RIGHT , mythid) else write(dataFname(1:80),'(2a)') fName(1:IL),'.data' inquire( file=dataFname, exist=exst ) if (exst) then write(msgbuf,'(a,a)') & ' MDSREADVECTOR: opening global file: ',dataFName call print_message( msgbuf, standardmessageunit, & SQUEEZE_RIGHT , mythid) endif endif globalFile = .TRUE. 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:80),'(2a,i3.3,a,i3.3,a)') & fName(1:IL),'.',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 write(msgbuf,'(a,a)') & ' MDSREADVECTOR: opening file: ',dataFName call print_message( msgbuf, standardmessageunit, & SQUEEZE_RIGHT , mythid) 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,'(a)') & ' MDSREADVECTOR: un-active tiles not implemented yet' call print_error( msgbuf, mythid ) stop 'ABNORMAL END: S/R MDSREADVECTOR' endif endif if (fileIsOpen) then irec = irecord 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