PDP-10 Archive: decus/20-0125/addopt.for from decuslib20-04

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0125/addopt.for

There is 1 other file named addopt.for in the archive. Click here to see a list.

	SUBROUTINE ADDOPT(OPTNO, OPSTR, OPCT)
C************************************************************
C
C  THIS ROUTINE IS USED TO CHANGE AN OPTION IN
C  THE OPTION LIST. NOTE THAT THE CHANGE WILL
C  NOT APPEAR IN THE GT40 UNTIL THE ROUTINE
C  SNDOPT HAS BEEN CALLED
C
C  POSSIBLE ERRORS:
C	%INVALID OPTION NUMBER
C
C  ROUTINES CALLED:
C	ERROR  - ERROR LOGGING ROUTINE
C	GFIELD - BYTE FETCH ROUTINE
C	SFIELD - BYTE STORAGE ROUTINE
C
C************************************************************
	IMPLICIT INTEGER (A - Z)
	INTEGER OPTION(10, 3), OPSTR(3)
	COMMON /OPTBLK/ OPTION, OPMSG, OPPTR, OPLIST

	IF(OPTNO .GT. 0 .AND. OPTNO .LE. 10) GO TO 100
	CALL ERROR('%INVALID OPTION NUMBER =', OPTNO)
	RETURN

100	CT = OPCT
	IF(OPCT .GT. 15) CT = 15
	DO 200 I = 1, 3
	  OPTION(OPTNO, I) = '     '
200	CONTINUE

	DO 300 I = 1, CT
	  WPOS = I / 5
	  IF(MOD(I, 5) .NE. 0) WPOS = WPOS + 1
	  BPOS = MOD(I, 5)
	  IF(BPOS .EQ. 0) BPOS = 5
	  BPOS = (BPOS - 1) * 7
	  CHAR = GFIELD(OPSTR(WPOS), BPOS, 7)
	  CALL SFIELD(OPTION(OPTNO, WPOS), BPOS, 7, CHAR)
300	CONTINUE
	RETURN
	END