Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-07 - 43,50446/addopt.f4
There are no other files named addopt.f4 in the archive.
	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