<      SUBROUTINE DBSOPEN (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.BC_CALLS  DSOPEN  DSREAD  DSWRIT  DSCLOS  A2AN  ASCII XXBRK  XXSUBS'C  GET_DV_READ_PARAMS  GET_SREC  XXCONV=C_HISTORY  83Jan19  R.Mehlman  UCLA  From  XXOPEN of 82Sept09#C  READONLY & shared option 2/22/83@C  This version last updated on 5/8/85 for use with optical diskC_PAUSE
C_DESCRIPTION/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 RECORDE      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,IBUF(LREC),IBUF2(10240),BIGBUF(10240)      INTEGER*2 ZNAME(6) /6*0/      INTEGER*2 DISKSIDE+      INTEGER LBLK2 /20480/ , LBLK4 /10240/      INTEGER MAXLUN /12/F      INTEGER*4 LUNTAB(12) /4H    ,4HDA1:,4HDA2:,4HDA3:,4HDA4:,4HDA5:,:     1          4HDA6:,4HDA7:,4HDA8:,4HDA9:,4HD10:,4H    /      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 IOPENAC  OPEN ENTRY: ACTUAL RECORD SIZE MADE INTEGRAL FRACTION OF BLOCK	      ISTART=0	!Start flag.      IR=-2=C  IF_LUN IS USED IN 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 READ6      IF (LUN.EQ.-10) GOTO 10		!TEMP PATCH TO FIX THIS3     CONTINUE&      CALL A2AN(LUNTAB(LUN+1),ZNAME,2)!      CALL A2AN(FNAME,ZNAME(3),3)        NRPB=LBLK2/LRECX        LRECL=5120&	CALL ASCII_ZNAME(%DESCR(ZNAME),VNAME)      IF (ISIZE.NE.0) GO TO 5&C-----OPEN FOR READ: READONLY & SHARED7      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    CONTINUE
      ISTAT=1      IF (ISIZE.LT.0) GO TO 6
      ISTAT=2!     JSIZE=(ISIZE+NRPB-1)/NRPB      JSIZE= ISIZE8 6    OPEN (IFU,FILE=VNAME,STATUS=STAT(ISTAT),RECL=LRECL     1  ,BLOCKSIZE=204804     2 ,ORGANIZATION='SEQUENTIAL',ACCESS=ACC(IACC+1)-     3 ,FORM='UNFORMATTED',RECORDTYPE='FIXED'+     4 ,INITIALSIZE=JSIZE,IOSTAT=IR,SHARED)      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%C_TITLE  DSREAD  Reads data from diskC_ARGUMENTS!C	INTEGER IFU  ! [I] Fortran unitCC	INTEGER IREC ! [I] Logical record position (sequentially in file)BC	INTEGER IBUF ! [O] Array of sufficient length for logical record3C	INTEGER LREC ! [O] Record size in INTEGER*2 words(C	INTEGER IR   ! [O] Returns status code6C_DESCRIPTION  DSREAD reads data from the disk.  It is'C part of the DSOPEN group of routines.C_HISTORY  R.Mehlman  UCLAC_PAUSEMC-----DSREAD ENTRY---This fellow now reads 240 byte records, lets change thisKC to 20480 byte records, thus 83 logical records are in one physical block.*      ENTRY DBSREAD(IFU,IREC,IBUF,LREC,IR)      !-----Calculate IREC,		IF(ISTART.EQ.0)THEN
	  INDEX=1	  IOLD =0				!Last Index read	  ISTART=1	ENDIF	IF(IREC.LE.83)THEN
	   INDEX = 1 	   IFRAC = (IREC - 1) * 120 + 1	ELSE IF(IREC.GT.83)THEN/	   INDEX = IREC/83 + 1			!Which physical blockC	   IFRAC = JMOD(IREC,83)         	!What fraction of physical block!	   IFRAC = (IFRAC - 1) * 120 + 1	   IF(IFRAC.LE.0)IFRAC=1	ENDIF	IF(IOLD.NE.INDEX)THEN+          READ (IFU'INDEX,IOSTAT=IR) BIGBUF
	  IOLD=INDEX	ENDIF	3D        TYPE*, 'INDEX,IFRAC,IREC',INDEX,IFRAC,IREC+        CALL I2I(BIGBUF(IFRAC),IBUF(1),120)      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,IFLAG)	IR = 0	RETURNC  DSWRIT ENTRY$C_TITLE  DSWRIT  Writes data to diskC_ARGUMENTS!C	INTEGER IFU  ! [I] Fortran unitCC	INTEGER IREC ! [I] Logical record position (sequentially in file)BC	INTEGER IBUF ! [O] Array of sufficient length for logical record3C	INTEGER LREC ! [O] Record size in INTEGER*2 words(C	INTEGER IR   ! [O] Returns status codeAC_DESCRIPTION  DSWRIT writes data to the disk.  It is part of theC DSOPEN group of routines.C_HISTORY  R.Mehlman  UCLAC_PAUSE+      ENTRY DBSWRIT(IFU,IREC,IBUF2,LREC,IR)&      WRITE (IFU'IREC,IOSTAT=IR) IBUF2      RETURN	      END