Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
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