;      SUBROUTINE DSOPEN (IFU,LUN,FNAME,LRECX,ISIZE,IACC,IR)RC_TITLE  DSOPEN  Group of routines that are responsible for I/O in  XG data systemC_ARGUMENTS 	INTEGER IFU		! [I] Fortran unit5	INTEGER*2 LUN		! [I] Disk device containing the file#	INTEGER*2 FNAME(3)	! [I] File name4	INTEGER LRECX		! [I] Record size in INTEGER*2 words:	INTEGER ISIZE		! [I] Initial file size in logical records 	INTEGER IACC		! [I] Access mode&	INTEGER IR		! [O] Returns status codeEC_DESCRIPTION  DSOPEN is a group of routines that are responsible forOC input/output in the XG data system, routines to read,  write, open, and closeC are in DSOPEN.C/C  This version allows use of the optical disk:CDC   Dsopen/dsclos/dsread/dswrit: direct access i/o routine for filesGC   with logical records which are whole blocks or fractions of blocks.EC   records are padded to integral fractions of a block, and there isHC   no spanning of records across blocks.  a block is the 'natural' unitOC   of the disk device.  record sizes are measured in 16-bit words (integer*2).C=C   CALL DSOPEN(IFU,LUN,FNAME,LREC,ISIZE,IACC,IR) to open andC   (optionally) create file.@C   CALL DSREAD(IFU,IREC,IBUF,LREC,IR) to read a logical record.AC   CALL DSWRIT(IFU,IREC,IBUF,LREC,IR) to write a logical record.FC   CALL DSCLOS(IFU,KEOF,IR) to close and optionally delete file where.C   IFU is the Logical Fortran Unit (INTEGER).@C   LUN specifies the disk device containing the file (INTEGER).C   LUN = 10 for optical disk.C2C   (ignored in some systems)                     C      2C   FNAME is file name: a 6 character ascii stringIC   If FNAME is a VAX character variable, use %REF(FNAME) in the call.   4C   LREC is record size in INTEGER*2 words (integer);C   ISIZE is initial file size in logical records (INTEGER)CQC    If = 0, File is assumed to exist ('OLD') and will be READONLY and SHAREABLE.7C    If > 0, File is created ('NEW') and NOT SHAREABLE.@C    If < 0, File exists but will be written to (NOT SHAREABLE).BC   IACC is access mode: 0 for direct, 1 for sequential (INTEGER).EC   IREC is logical record position (sequentially in file) (INTEGER).:C   IBUF is array of sufficient length for logical record.EC   KEOF is current end-of-file or negative to delete file (INTEGER)./C   (positive keof ignored on VAX/VMS, enter 0)C6CC             *** UCLA SEISMOLOGY VAX/VMS VERSION ***FCC  This version uses LUN to tell whether to read from optical disk orECC  magnetic disk. lun of 10 ls a flag for reading from optical disk.?CC  sequential I/O may be done with ordinary FORTRAN read/write#CC  after opening file with DSOPEN.BC_CALLS  DSOPEN  DSREAD  DSWRIT  DSCLOS  A2AN  ASCII XXBRK  XXSUBS&C GET_DV_READ_PARAMS  GET_SREC  XXCONV=C OPEN, CLOSE, INQUIRE, A2AN, ALSO uses DV_READ , and DV_OPEN
C_MESSAGES9C   IR is return code:  -2: Open parameter error (dsopen)7C                       -1: End of file (dsread,dswrit)"C                        0: Normal2C			 2: When using optical disk, error in disksideC				or, dvread status was 0/C                       >0: Fortran error code.=C_HISTORY  83Jan19  R.Mehlman  UCLA  From  XXOPEN of 82Sept09%C  READONLY and shared option 2/22/83@C  This version last updated on 5/8/85 for use with optical diskC_PAUSEE      COMMON /DVPARS/ SEGMENT,STARTREC,NUMRECS,RECSZE,DISKSIDE,IF_LUN       CHARACTER REPRMPT,VNAME*12      CHARACTER*2 KK1      CHARACTER*10 ACC(2) /'DIRECT','SEQUENTIAL'/+      CHARACTER*6 DISP(2) /'KEEP','DELETE'/'      CHARACTER*3 STAT(2) /'OLD','NEW'/      BYTE TEST(16)      INTEGER*2 LREC)      INTEGER*2 IBUF(LREC),ZNAME(6) /6*0/      INTEGER*2 DISKSIDE'      INTEGER LBLK2 /256/ , LBLK4 /128/      INTEGER MAXLUN /10/F      INTEGER*4 LUNTAB(10) /4H    ,4HDA1:,4HDA2:,4HDA3:,4HDA4:,4HDA5:,:     1                        4HDA6:,4HDA7:,4HDA8:,4HDA9:/      INTEGER IREC,KEOF$      INTEGER JSIZE,ISTAT,LRECL,NRPB      INTEGER*2 IF_LUN(256)      INTEGER*4 i,nnn#      INTEGER*4 DISK_RECORD,DV_READ%      INTEGER*4 SIDESEGSUB,SEG,SUBSEG5      INTEGER*4 SEGMENT,STARTREC,NUMRECS,NRECS,RECSZE      EXTERNAL DV_READ      LOGICAL IOPENBC  OPEN ENTRY: actual record size made integral fraction of block.      IR=-2>C  IF_LUN is used LUN the other DS-- procedures to tell which CC  logical unit is being read from , this is only needed if reading!C  is done from the optical disk.      IF_LUN(IFU) = LUN	6      IF (LRECX.LE.0.OR.IACC.LT.0.OR.IACC.GT.1) RETURN+      IF (LUN.LT.0.OR.LUN.GT.MAXLUN) RETURN$C	IF LUN = 10 THEN OPTICAL DISK READ      IF (LUN.EQ.10) GOTO 103     CONTINUE&      CALL A2AN(LUNTAB(LUN+1),ZNAME,2)!      CALL A2AN(FNAME,ZNAME(3),3)      NRPB=LBLK2/LRECX      LRECL=LBLK4/NRPB&	CALL ASCII_ZNAME(%DESCR(ZNAME),VNAME)      IF (ISIZE.NE.0) GO TO 5)C-----Open for read: readonly and shared.8       OPEN (IFU,FILE=VNAME,STATUS='OLD',READONLY,SHARED?     1 ,ORGANIZATION='SEQUENTIAL',ACCESS=ACC(IACC+1),RECL=LRECL8     2 ,FORM='UNFORMATTED',RECORDTYPE='FIXED',IOSTAT=IR)      RETURN&C-----Open for write, optional create.
 5    ISTAT=1
      JSIZE=0      IF (ISIZE.LT.0) GO TO 6
      ISTAT=2      JSIZE=(ISIZE+NRPB-1)/NRPB8 6    OPEN (IFU,FILE=VNAME,STATUS=STAT(ISTAT),RECL=LRECL4     2 ,ORGANIZATION='SEQUENTIAL',ACCESS=ACC(IACC+1)-     3 ,FORM='UNFORMATTED',RECORDTYPE='FIXED'$     4 ,INITIALSIZE=JSIZE,IOSTAT=IR)      RETURN10	CONTINUE@	IF (DISKSIDE.EQ.0) PRINT *, 'NOTE: Optical disk is being used.'"C-------Check diskside for side 1.20	IR = DV_READ(TEST,0,4,1,16)6	IF ((TEST(3) .EQ. 179) .OR. (TEST(3) .EQ. -77)) THEN 	 DISKSIDE = 29	ELSEIF ((TEST(3) .EQ. 180) .OR. (TEST(3) .EQ. -76)) THEN	 DISKSIDE = 1	ELSE	 DISKSIDE = 07	 PRINT *,' ERROR in DISKREAD, Check Optical disk and-'25	 TYPE 30>30	 FORMAT ('       ENTER "r" to REread ,   <CR> to exit: ',$)	 ACCEPT 40, REPRMPT40	 FORMAT (A)7	 IF ((REPRMPT .EQ. 'R') .OR. (REPRMPT .EQ. 'r')) THEN 
	  GOTO 20	 ELSE		  RETURN	 ENDIF 	ENDIF	IF (DISKSIDE .EQ. 2) THENF	 PRINT *,'You will need to turn the disk over to side 1 to continue.'	 IR = 2		 GOTO 25	ENDIF     )C     Break File NAME into KK,i,nnn parts&	CALL XXBRK(%DESCR(FNAME),KK,i,nnn,IR)        C	Find subseg# from KK,i,nnn		IF (IR.EQ.-2) RETURN!	CALL XXSUBS(KK,i,nnn,SEG,SUBSEG)%	SIDESEGSUB = 1000000+SEG*1000+SUBSEG=	CALL GET_DV_READ_PARAMS(SIDESEGSUB,SEGMENT,STARTREC,NUMRECS,
	1 RECSZE,IR)A        IF(SEGMENT.EQ.137)CALL GET_STREC(I,NNN, STARTREC,NUMRECS)B        IF(SEGMENT.EQ.138)CALL GET_STREC1(I,NNN, STARTREC,NUMRECS)B        IF(SEGMENT.EQ.139)CALL GET_STREC2(I,NNN, STARTREC,NUMRECS)	IF (.NOT. IR) THEN 	 IF (IR.EQ.0) IR = 2	ELSE	 IR = 0	ENDIF	RETURN&CC_TITLE  DSREAD  Reads data from diskCC_ARGUMENTS"CC	INTEGER IFU  ! [I] Fortran unitDCC	INTEGER IREC ! [I] Logical record position (sequentially in file)CCC	INTEGER IBUF ! [O] Array of sufficient length for logical record4CC	INTEGER LREC ! [O] Record size in INTEGER*2 words)CC	INTEGER IR   ! [O] Returns status code7CC_DESCRIPTION  DSREAD reads data from the disk.  It is(CC part of the DSOPEN group of routines.CC_HISTORY  R.Mehlman  UCLACC_PAUSEC-----DSREAD ENTRY)      ENTRY DSREAD(IFU,IREC,IBUF,LREC,IR)$      IF (IF_LUN(IFU).EQ.10) GOTO 50$      READ (IFU'IREC,IOSTAT=IR) IBUF      RETURN50	CONTINUE%C-----Check Diskside for correct side  	IF (DISKSIDE .EQ. 1) GOTO 51	IF (DISKSIDE .EQ. 0) THEN D	 PRINT *,'You will need to CALL DSOPEN successfully before DSREAD.'	 IR = 2	 RETURN	ENDIF	IF (DISKSIDE .NE. 1) THENF	 PRINT *,'You will need to turn the disk over to side 1 to continue.'	 IR = 2	 RETURN	ENDIF51	CONTINUE;C NRECS only allows you to take the highest whole number ofC LRECords divisible by 240	DISK_RECORD = STARTREC+IREC-1	NRECS = LREC*2/2402	IF ((IREC .GE. 0) .AND. (IREC .LT. NUMRECS)) THEN5	 IR = DV_READ(IBUF,SEGMENT,DISK_RECORD,NRECS,RECSZE)	 IF (.NOT. IR) THEN	  TYPE 52, IR,IRD52	  FORMAT(' Status from DV_READ 52 CALL - hex ', Z10, ' int ',I10)	  IF (IR.EQ.0) IR = 2		  RETURN	 ENDIF	ELSE		 IR = -2	ENDIF	CALL XXCONV(IBUF,IREC)	IR = 0	RETURNCC  DSWRIT ENTRY%CC_TITLE  DSWRIT  Writes data to diskCC_ARGUMENTS"CC	INTEGER IFU  ! [I] Fortran unitDCC	INTEGER IREC ! [I] Logical record position (sequentially in file)CCC	INTEGER IBUF ! [O] Array of sufficient length for logical record4CC	INTEGER LREC ! [O] Record size in INTEGER*2 words)CC	INTEGER IR   ! [O] Returns status codeBCC_DESCRIPTION  DSWRIT writes data to the disk.  It is part of theCC DSOPEN group of routines.CC_HISTORY  R.Mehlman  UCLACC_PAUSE)      ENTRY DSWRIT(IFU,IREC,IBUF,LREC,IR)$      IF (IF_LUN(IFU).EQ.10) GOTO 60%      WRITE (IFU'IREC,IOSTAT=IR) IBUF      RETURN60	CONTINUE,	PRINT *,' ERROR: Attempt to write to disk.'	IR = 47	RETURN"CC_TITLE  DSCLOS  Closes data fileCC_ARGUMENTS"CC	INTEGER IFU  ! [I] Fortran unitDCC	INTEGER KEOF ! [I] Current end-of-file or negative to delete file)CC	INTEGER IR   ! [O] Returns status codeCCC_DESCRIPTION  DSCLOS will close the data file.  It is part of theCC DSOPEN group of routines. CC_HISTORY  R.Mehlman  UCLACC_ENDC  DSCLOS ENTRY      ENTRY DSCLOS(IFU,KEOF,IR)$      IF (IF_LUN(IFU).EQ.10) GOTO 70       INQUIRE (IFU,OPENED=IOPEN)
      IR=0      IF (.NOT.IOPEN) RETURN	      I=1      IF (KEOF.LT.0) I=2*      CLOSE (IFU,IOSTAT=IR,STATUS=DISP(I))      RETURN70	CONTINUE	IR = 0	RETURN	      END(	SUBROUTINE XXSUBS (KK,i,nnn,SEG,SUBSEG)VC_TITLE  XXSUBS  Given a file name of the form KKinnn, finds segment # on optical diskC_ARGUMENTS=	CHARACTER*2 KK	! [I] A given file name is of the form KKinnn>	INTEGER*4 i     ! [I] A given file name is of the form KKinnn>	INTEGER*4 nnn   ! [I] A given file name is of the form KKinnn%	INTEGER*4 SEG   ! [O] Segment number)	INTEGER*4 SUBSEG ! [O] Subsegment number
C_DESCRIPTIONC4C	GIVEN A FILENAME OF THE FORM KKinnn this will findEC       the segment number and subsegment number on the optical disk.C_CALLS NONE C_HISTORY  R.Mehlman  1983  UCLAC_PAUSE*	IF (KK .EQ. 'TS') THEN			! It's IRTM DATA	 SEG = 137	 IF (i .EQ. 1) THEN		  SUBSEG = nnn	 ELSE 	  SUBSEG = 66+nnn	 ENDIF-	ELSEIF (KK .EQ. 'MW') THEN		! It's MAWD DATA	 SEG = 138	 IF (i .EQ. 1) THEN	  SUBSEG = nnn	 ELSE 	  SUBSEG = 5+nnn	 ENDIF	ELSE					! It's IRR DATA	 SEG = 139	 SUBSEG = nnn	ENDIF	RETURN	END%	SUBROUTINE XXBRK (FNAME,KK,i,nnn,IR)7C_TITLE  XXBRK  Breaks a file name into parts  KK,i,nnnC_ARGUMENTS$	CHARACTER*6 FNAME  ! [I] File name.B	CHARACTER*2 KK     ! [I] A given file name is of the form KKinnn.F	INTEGER*4 i        ! [I] A given file name is of the form KKinnn.    B	INTEGER*4 nnn      ! [I] A given file name is of the form KKinnn.-	INTEGER*4 IR       ! [O] Returns status code
C_DESCRIPTION<C	This subroutine will break a filename into its appropriateC parts KK,i,nnnC     Example :/C     MW1002 for a FNAME would be broken into :	C	KK = MWC	i  = 1C       nnn = 002C0C	If FNAME is not of the above form then IR = -2
C else IR = 0C	C_CALLS 0 C_HISTORY  R.Mehlman  UCLA  1983C_PAUSE4	IF (FNAME(3:3).GT.'9'.OR.FNAME(3:3).LT.'0') GOTO 104	IF (FNAME(4:4).GT.'9'.OR.FNAME(4:4).LT.'0') GOTO 104	IF (FNAME(5:5).GT.'9'.OR.FNAME(5:5).LT.'0') GOTO 104	IF (FNAME(6:6).GT.'9'.OR.FNAME(6:6).LT.'0') GOTO 105	READ (UNIT = FNAME(1:6),FMT = '(A2,I1,I3)') KK,i,nnn	IR = 0	RETURNH10	PRINT *, 'ERROR: FNAME-"',FNAME,'" is illegal in using optical disk.'	IR = -2        RETURN	END%	SUBROUTINE ASCII_ZNAME (ZNAME,VNAME)8C_TITLE ASCII_ZNAME  Equates second array to first arrawC_ARGUMENTS'	CHARACTER*12 ZNAME  ! [I] Input array.3	CHARACTER*12 VNAME  ! [O] Equivalent output array.6C_DESCRIPTION Equates second array to the first array.C_CALLS none C_HISTORY  R.Mehlman  UCLA  1983C_PAUSE
	DO I=1,12	 VNAME(I:I) = ZNAME(I:I)	ENDDO	RETURN	END	<	SUBROUTINE GET_DV_READ_PARAMS (SIDESEGSUB,SEGMENT,STARTREC,	1  NUMRECS,RECSZE,IR)9C_TITLE  GET_DV_READ_PARAMS  Gets all  DV_READ parameters	IMPLICIT NONEC_ARGUMENTS4	INTEGER*4 SIDESEGSUB  ! [I] See description below  2	INTEGER*4 SEGMENT     ! [I] See description below	INTEGER*4 STARTREC    ! [I] .	INTEGER*4 NUMRECS     ! [O] Number of records(	INTEGER*4 RECSZE      ! [O] Record size8	INTEGER*4 IR          ! [O] Return status from DV_READ 
C_DESCRIPTIONC2C	This subroutine will get all DV_READ parameters.C C	PARAMETERS PASSED IN:%C 		SIDESEGSUB : A number of the formC			ABBBCCCC			Where A = side #C			    BBB = seg #C			    CCC = subseg #C			example : 2143002 CCC	PARAMETERS PASSED OUT:C		SEGMENT  : BBB  aboveC		STARTREC : 
C		NUMRECS  :C	        RECSZE	 : *C	        IR	 : RETURN STATUS FROM DV_READC C 	C_CALLS   C_HISTORY  R.Mehlman  1983  UCLAC_PAUSE?	INTEGER*4 SUBSEG_DIR,SEGMENT_DIR,SIDE,SUBS,SEG_START,SUB_START 	INTEGER*4 DISKSIDE,SUBSEGINCR,I0	INTEGER*4 SUBSEG_DIR_POS,SEG_DIR_POS,MAXSEGSIDE	INTEGER*4 DV_READ	EXTERNAL  DV_READ	CHARACTER SEL*1,RECVAR*80	BYTE	  TEST(16)+	PARAMETER (SUBSEG_DIR=131,SEGMENT_DIR=129)
	DISKSIDE = 020	IR = DV_READ(TEST,0,4,1,16)	IF (TEST(3).EQ.-77) THEN	 DISKSIDE = 2	ELSEIF (TEST(3).EQ.-76) THEN	 DISKSIDE = 1	ELSE 	 DISKSIDE = 0<	 PRINT *,' ERROR (20) in DISKREAD, Check Optical Disk and-'		 TYPE 30B30	 FORMAT ('           ENTER "r" to REread ,   <CR> to exit: ',$)	 READ(5,'(A)') SEL(	 IF ((SEL.EQ.'R').OR.(SEL.EQ.'r')) THEN
	  GOTO 20	 ELSE		  RETURN	 ENDIF	ENDIF	SIDE = SIDESEGSUB/1000000	IF (SIDE.EQ.0) THEN	 SEGMENT = SIDESEGSUB/1000	ELSE*	 SEGMENT = (SIDESEGSUB-1000000*SIDE)/1000	ENDIF,	SUBS = SIDESEGSUB-1000000*SIDE-1000*SEGMENT	IF (SEGMENT.LT.134) THEN
	 SIDE = 0	ELSEIF (SIDE.EQ.0) THEN 	 SIDE=DISKSIDE	ENDIF?C	The following variables have the following meanings dependingC       on side.4C	SEG_START	: Record number in the Segment directory,C			  where information on this side starts.<C	SUB_START	: Same as above except for Subsegment directory.4C	MAXSEGSIDE	: Maximum segment number for this side.9C			  129 is minimum, 134 is minimum for non-directories.BC	SEG_DIR_POS	: Record number in the Segment directory where this C			  Segment starts.AC	SUBSEG_DIR_POS	: Same as above except for Subsegment directory.	IF (SIDE.LT.2) THEN	 SEG_START = 1	 SUB_START = 1	 MAXSEGSIDE = 161!	 IF (SEGMENT.GT.MAXSEGSIDE) THEN	  SEGMENT = MAXSEGSIDE	 ELSEIF (SEGMENT.LT.129) THEN	  SEGMENT = 129	 ENDIF	 SEG_DIR_POS = SEGMENT-128	ELSE	 SEG_START = 34	 SUB_START = 214	 MAXSEGSIDE = 251!	 IF (SEGMENT.GT.MAXSEGSIDE) THEN	  SEGMENT = MAXSEGSIDE	 ELSEIF (SEGMENT.LT.129) THEN	  SEGMENT = 129	 ENDIF	 SEG_DIR_POS = SEGMENT-100	ENDIF	SUBSEG_DIR_POS = SUB_START-1#C	Correct SIDESEGSUB if neccessary.,	SIDESEGSUB = SIDE*1000000+SEGMENT*1000+SUBS=C Since Segment number 149 on side 2 is a very large segment,DC the calculation of SUBSEG_DIR_POS is done in order to increase the@C speed of this procedure; it should be noted that the following<C IF statement is not needed for any other reason than this. 	IF (SIDESEGSUB.GE.2149001) THEN6	  SUBSEG_DIR_POS = SUBSEG_DIR_POS+209+(SEGMENT-149)*3	ELSE	  DO I=SEG_START,SEG_DIR_POS-10	  IR = DV_READ(%REF(RECVAR),SEGMENT_DIR,I,1,80)	   IF (.NOT. IR) THEN	    TYPE 40, IR, IRF40	    FORMAT(' Status from DV_READ 40 CALL - hex ', Z10, ' int ',I10)	    RETURN		   ENDIF1	  READ(UNIT=RECVAR(45:47),FMT='(I3)') SUBSEGINCR	:C	Columns 45-47 of the Segment directory are the number of!C subsegments in a given Segment.-	  SUBSEG_DIR_POS = SUBSEG_DIR_POS+SUBSEGINCR	 ENDDO	ENDIF8	IR = DV_READ(%REF(RECVAR),SEGMENT_DIR,SEG_DIR_POS,1,80)	 IF (.NOT. IR) THEN	 	TYPE 50, IR, IRD50	 	FORMAT(' Status from DV_READ 50 CALL - hex ', Z10, ' int ',I10)		 	RETURN	 ENDIFAC	Columns 50-53 are the record size corresponding to a particularC       Segment.+	READ(UNIT=RECVAR(50:53),FMT='(I4)') RECSZER%	SUBSEG_DIR_POS=SUBSEG_DIR_POS + SUBSE:	IR = DV_READ(%REF(RECVAR),SUBSEG_DIR,SUBSEG_DIR_POS,1,80)	 IF (.NOT. IR) THEN	 	TYPE 60, IR, IRD60	 	FORMAT(' Status from DV_READ 60 CALL - hex ', Z10, ' int ',I10)	    RETURNi	 ENDIFlC	Subsegment directory:I:C	Columns 36-41 are the number of records in a subsegment.+C	Columns 66-73 is the start record number.z:	READ(UNIT=RECVAR(36:),FMT='(I6,24X,I8)') NUMRECS,STARTREC!	STARTREC = STARTREC-1u        STARTREC = 0	RETURNs	END!	INTEGER*4 FUNCTION DV_OPEN (SEG)oCCC_TITLE  DV_OPEN  Assigns a channel if one is not already assignednCC_ARGUMENTS	INTEGER*4 SEG  ! [I] SegmenteCC_DESCRIPTION,C Assigns a channel if not already assigned.?C Sends a write segment offset command to the RTI video disk toc1C establish a segment number for subsequent read.lCC_CALLS  0e!CC_HISTORY  R.Mehlman  UCLA  1983oCC_PAUSE	COMMON /DVCOM/CHAN 	INTEGER*4 CHANc1	PARAMETER B_SIZE = 14		!LENGTH OF COMMAND BUFFER 	EXTERNAL IO$_READLBLK	INTEGER*2 IOSB(4)	INTEGER*4 STATUS,MSGLEN*	INTEGER*4 SYS$QIOW,SYS$ASSIGN,DV_REQSENSE1	BYTE CMDBUF(B_SIZE)		!COMMAND BUFFER FOR RTI CMDe1	CHARACTER*80 MESSAGE		!BUFFER FOR SYSTEM MESSAGEt'	DATA CMDBUF(1),CMDBUF(3) /'0D'X,'E0'X/FC-------Assign a channel. 	IF (CHAN .EQ. 0) +     1		STATUS = SYS$ASSIGN('DSA0:',CHAN,,)n	IF (.NOT. STATUS) THEN 7		ISTATUS = LIB$SYS_GETMSG(STATUS,MSGLEN,MESSAGE,'F'X,)c		TYPE *,MESSAGE(1:MSGLEN)		DV_OPEN=STATUS		RETURN	END IF0	DV_OPEN=STATUS	RETURNn	END;	INTEGER*4 FUNCTION DV_READ (BUF,SEG,RECNBR,NBRRECS,RECLEN)lFCC_TITLE  DV_READ  Sends an extended read command to disk and returns !C                 requested data. CC_ARGUMENTS$	BYTE BUF(1)       ! [O] User buffer'	INTEGER*4 SEG     ! [I] Segment numbero&	INTEGER*4 RECNBR  ! [I] Record number+	INTEGER*4 NBRRECS ! [I] Number of records b'	INTEGER*4 RECLEN  ! [I] Record length FCC_DESCRIPTIONDC DV_READ sends an EXTENDED READ COMMAND to the disk and returns theDC data requested to the user buffer (BUF).  If the data requested isDC larger than 65535 bytes, multiple read requests are sent until allC the data is returned.  B
CC_CALLS 0!CC_HISTORY  R.Mehlman  UCLA  1983cCC_END	INTEGER*2 IOSB(4)	INTEGER*4 II,MSGLEN,SYS$QIOWi&	INTEGER*4 SEGMENT,DV_OPEN,DV_REQSENSE	CHARACTER*80 MESSAGE	BYTE ITMP(4),NN(4)* 	EQUIVALENCE (ITMP,II),(NN,NREC)	DATA IFIRST /1/	EXTERNAL IO$_READLBLK	COMMON /DVCOM/CHANc	INTEGER*4 CHANa(C-------CALL DV_OPEN IF FIRST TIME THRU.	IF (IFIRST) THEN	    ISTAT=DV_OPEN(SEG) 	    IF (.NOT. ISTAT) THEN	        DV_READ=ISTAT	        RETURNS	    END IFL
	    IFIRST=0A	END IF !	IX = 1			!INDEX INTO USER BUFFER#	II=RECNBR		!STARTING RECORD NUMBERV4	NBRBYTES = RECLEN*NBRRECS	!NBR OF BYTES TO TRANSFER	NREC = NBRRECSS&	JJ=1				!STARTING INDEX OF DATA ARRAY	DO WHILE (NBRBYTES .GT. 0) 	    NB = NBRBYTES"	    IF (NBRBYTES .GT. 65510) THEN		NREC = 65510/RECLEN 4	 	NB = NREC * RECLEN	!COMPUTE NBR BYTES TO TRANSFER		    ELSEo		NREC=NBRBYTES/RECLEN	    END IF C-------READ DATA FROM DISKe6	    ISTAT = SYS$QIOW(,%VAL(CHAN),IO$_READLBLK,IOSB,,,<     1		BUF(JJ),%VAL(NREC),%VAL(II),%VAL(SEG),%VAL(RECLEN),)	    IF (.NOT. IOSB(1)) THEN		TYPE 25,IOSB(1)i"25		FORMAT (' DISK READ ERROR',Z8)		DV_READ=IOSB(1)		!DRIVE ERROR,	        RETURN	    END IFE+C	    SET UP FOR NEXT TRANSFER IF NECESSARY )	    JJ=JJ+NB			!INCR INDEX OF DATA ARRAY?	    II = II + NREC		!CALCULATE ADDRESS OF NEXT REC TO TRANSFERTD	    NBRBYTES = NBRBYTES - NB !CALCULATE REMAINING BYTES TO TRANSFER	END DO %	DV_READ = 1			!RETURN A SUCCESS CODEE	RETURNE	END