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