FTN4,L
      SUBROUTINE SCNSU(ICHAN,IF),09580-16359 REV.2001 790927
C 
C  HP 3495 SCANNER DEVICE SUBROUTINE
C 
C                     09580-16359  RELOCATABLE
C                     09580-18359  SOURCE 
C 
C  !=================================================!
C  !                                                 !
C  ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979      !
C  !                ALL RIGHTS RESERVED              !
C  !                                                 !
C  ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,     !
C  ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM   !
C  ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF   !
C  ! THE HEWLETT-PACKARD COMPANY.                    !
C  !                                                 !
C  !-------------------------------------------------!
C  !                                                 !
C  ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETY    !
C  ! MATERIAL OF THE HEWLETT-PACKARD COMPANY.        !
C  !                                                 !
C  ! THIS SOURCE DATA SHALL BE USED SOLELY IN        !
C  ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS     !
C  ! SUPPLIED TO THE USER BY HEWLETT-PACKARD.        !
C  !                                                 !
C  ! THIS PROPRIETARY DATA SHALL NOT BE COPIED OR    !
C  ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN  !
C  ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE     !
C  ! COPY MAY BE MADE AND RETAINED BY THE USER FOR   !
C  ! ARCHIVE PURPOSES.                               !
C  !                                                 !
C  ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY    !
C  ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT !
C  ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL !
C  ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO    !
C  ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR      !
C  ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN  !
C  ! PROPRIETARY DATA.                               !
C  !                                                 !
C  !=================================================!
C 
C  GENERAL: 
C  -------- 
C 
C    THE FOLLOWING DEVICE SUBROUTINES ARE USED
C   TO PROGRAM THE HP3495A SCANNER. 
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP3495A SCANNER.
C    B. HP59310  BUS INTERFACE KIT. 
C 
C         JUMPER POSITION:
C          SW1-1 - 1
C          SW1-2 TO SW1-8 - 0 
C          SW2-1 - 0
C          SW2-2 - 0
C          SW2-3 - 0
C          SW2-4 - 0
C          SW2-5 - 1
C          SW2-6 - REN
C          SW2-7 - ICF
C          SW2-8 - CNX
C 
C    C. HP 21XX SERIES COMPUTER 
C 
C   CONFIGURATION TABLE ENTRIES:
C   ----------------------------
C 
C   R54,10,3
C   U1
C   0        LOWEST CHANNEL ASSIGNED TO THIS BOX
C   79       HIGHEST CHANNEL ASSIGNED TO THIS BOX 
C   -1       TEMPORARY STORAGE FOR INITIALIZATION FLAG
C 
C   U2
C   80
C   139 
C   -1
C 
C   U3
C   200 
C   279 
C   -1
C 
C   U4
C   . 
C   . 
C   . 
C 
C   UP TO 10 BOXES CAN BE PUT IN THE TABLE
C   FOR MORE INFORMATION SEE CALL STATEMENT EXPLANATION.
C 
C   TABLE ENTRIES:
C   --------------
C 
C   SCNSU(I,I),          OV=XX         ENT=SCNSU, FIL=%SCNSU
C 
C 
C 
C 
C     CALLING SEQUENCE: 
C 
C       CALL SCNSU(ICHAN,IF)
C      ---------------------- 
C 
C       ICHAN IS THE CHANNEL NUMBER TO BE CLOSED. 
C       IF IS THE FUNCTION: 
C        IF=0  OPEN ALL CHANNELS (ICHAN IS IGNORED).
C        IF=1  CLOSE CHANNEL ICHAN. 
C 
C     THE CHANNEL NUMBER ASSIGNMENTS MUST BE GIVEN IN THE 
C     CONFIGURATION FILE.  THE ENTRY MUST CONTAIN THREE 
C     WORDS FOR EACH UNIT.  A UNIT IS DEFINED AS ONE OR MORE
C     3495A BOX ASSIGNED TO AN HPIB ADDRESS.  ALL CHANNELS
C     WITHIN A UNIT MUST BE CONTIGUOUS.  MULTIPLE MODULES 
C     WITHIN A UNIT MAY HAVE THE SAME ADDRESS IF TWO OR MORE
C     SETS OF RELAYS ARE TO BE CLOSED SIMULTANEOUSLY.  EACH UNIT
C     IS INTERNALLY ADDRESSED BETWEEN 0 AND 79 (DECIMAL).  THE
C     ADDRESSING WITHIN THE SYSTEM SHOULD BE ASSIGNED SO THAT 
C     THERE ARE NO DUPLICATE CHANNEL NUMBERS.  (EXAMPLE:  UNIT
C     1 CONTAINS MODULES 0-9 AND 10-29.  UNIT 2 CONTAINS MODULES
C     0-19, 20-29, 30-39, AND 40-59.  UNIT 1 COULD BE ADDRESSED AS
C     CHANNELS 0-29, AND UNIT 2 COULD BE ADDRESSED AS CHANNELS 30-89. 
C     ADDRESSING CHANNEL 21 ACTIVATES SWITCH 21 IN UNIT 1.  ADDRESSING
C     CHANNEL 48 ACTIVATES SWITCH 9 IN UNIT 2.
C     A -1 IN BOTH CHANNEL NUMBERS INDICATES THAT THERE ARE NO SWITCHES 
C     ASSIGNED TO A PARTICULAR UNIT.  UP TO TEN UNITS MAY BE DEFINED. 
C     THE TABLE VALUES ARE AS FOLLOWS:
C       WORD 1:  LOW CHANNEL NUMBER OR -1.
C       WORD 2:  HIGH CHANNEL NUMBER OR -1. 
C       WORD 3:  -1.
C  -----------------------------------------------------
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HSC,2HNS,2HU / 
      DATA IDTN/54/ 
C 
C  SET UP DEFAULT ERROR CONDITION 
C 
      IERMS=10
C 
C  GET STATION NUMBER 
C 
      ISTN=ISN(IDUMY) 
C 
C  CHECK FOR A UNIT 1 OF THIS DEVICE TYPE 
C 
      LU=LUDV(ISTN,IDTN,1)
      IF(LU)800,800,10
C 
C  IF WE HAVE A REAL LOGICAL UNIT, CALL THE DEVICE SUBROUTINE 
C 
10    CALL XCNSU(ICHAN,IF,IERMS,ISTN) 
      IF(IERMS.EQ.0)RETURN
800   CALL ERROR(IERMS,IERMS(2))
      END 
      SUBROUTINE XCNSU(ICHAN,IF,IERMS,ISTN),09580-16359 REV.2001
     +790927
C 
C  THIS IS THE ROUTINE WHICH ACTUALLY DOES THE WORK.
C 
C  THE PARAMETERS ARE:
C    ICHAN = THE SYSTEM CHANNEL NUMBER TO BE OPERATED UPON
C            (ASSIGNED DURING CONFIGURATION). 
C    IF    = THE FUNCTION CODE: 
C         0= OPEN ALL CHANNELS (ICHAN IS IGNORED).
C         1= CLOSE CHANNEL ICHAN. 
C    IERMS = THE ERROR MESSAGE BUFFER.  ONLY THE FIRST
C            WORD IS CHANGED. 
C            0 = NO ERROR.
C            1 = PARAMETER ERROR
C            3 = UNDEFINED OR NON-EXISTENT CHANNEL NUMBER.
C            4 = TIM ERROR. 
C           10 = ZERO LOGICAL UNIT NUMBER FOR UNIT 1 OR THE 
C                LU FOR THE SELECTED CHANNEL DOES NOT EXIST.
C     ISTN = THE STATION NUMBER OF THE CURRENT PROGRAM. 
C 
      DIMENSION IBUF(3) 
      DATA IDTN/54/,ICLR/2HC /
C 
C  CHECK PARAMETERS 
C 
      IF(IF.LT.0.OR.IF.GT.1)GO TO 300 
C 
C   SET UNIT NUMBER FLAG
C 
      IUNIT=-1
C 
C   SEARCH THROUGH UP TO 10 UNITS 
C 
      DO 10 JUNIT=1,10
      CALL TIM(IDTN,JUNIT,1,IBUF,3,IERFG) 
C 
C   IF TIM ERROR IS -3, IGNORE IT ELSE RETURN ERROR MESSAGE.
C 
      IF(IERFG.EQ.-3)GO TO 10 
      IF(IERFG.NE.0)GO TO 400 
C 
C  SEE IF ANY CHANNELS DEFINED FOR THIS BOX 
C 
      IF(IBUF(1).LT.0.OR.IBUF(2).LT.0)GO TO 10
      IF(ICHAN.GE.IBUF(1).AND.ICHAN.LE.IBUF(2))17,20
C 
C  WE FOUND A UNIT - COMPUTE THE OFFSET (SWITCH NUMBER
C  WITHIN THE UNIT).
C 
17    IUNIT=JUNIT 
      IOFST=ICHAN-IBUF(1) 
C 
C  CHECK FOR LEGAL CHANNEL NUMBER 
C 
      IF(IOFST.GT.79)GO TO 990
C 
C  IF "IF" IS 0, OPEN ALL BOXES, ELSE OPEN ONLY THE 
C  LAST ONE CLOSED.  THIS IS STORED IN THE THIRD WORD 
C  OF THE "TIM" TABLE:
C    -1 = NEVER INITIALIZED 
C     0 = OPEN
C     1 = LAST BOX CLOSED.
C 
C  FAKE "NEVER INITIALIZED" IF OPEN ALL BOXES.
C 
20    IF(IF.EQ.0)IBUF(3)=-1 
C 
C  IF ALREADY OPEN, IGNORE IT 
C 
      IF(IBUF(3).EQ.0)GO TO 10
C 
C  GET LOGICAL UNIT NUMBER
C 
      LUN=LUDV(ISTN,IDTN,JUNIT) 
C 
C  CHECK FOR NON-EXISTENT LOGICAL UNIT NUMBER 
C 
      IF(LUN.LE.0)GO TO 10
C 
C  OPEN THE BOX 
C 
      CALL REIO(2,LUN,ICLR,-1)
C 
C  INDICATE THE BOX HAS BEEN OPENED.
C 
      IBUF(3)=0 
      CALL TIM(IDTN,JUNIT,2,IBUF,3,IERFG) 
      IF(IERFG.LT.0)GO TO 400 
10    CONTINUE
C 
C  IF FUNCTION IS "OPEN ALL BOXES", DON'T CLOSE ANY.
C 
      IF(IF.EQ.0)GO TO 2000 
C 
C  IF CHANNEL CLOSE REQUIRED, CHECK TO SEE IF A VALID 
C  CHANNEL WAS FOUND (IUNIT NOT -1).
C 
      IF(IUNIT.EQ.-1)GO TO 990
      CALL TIM(IDTN,IUNIT,1,IBUF,3,IERFG) 
      IF(IERFG.NE.0)GO TO 400 
C 
C  CHECK FOR LU 
C 
      LUN=LUDV(ISTN,IDTN,IUNIT) 
      IF(LUN.LE.0)GO TO 1000
C 
C  MUST BE OK - CONVERT ADDRESS TO ASCII
C 
      ITENS=IOFST/10
      IONES=IOFST-ITENS*10+60B
      IADDR=256*(ITENS+60B)+IONES 
      CALL REIO(2,LUN,IADDR,-2) 
C 
C  SET SWITCH CLOSED FLAG 
C 
      IBUF(3)=1 
      CALL TIM(IDTN,IUNIT,2,IBUF,3,IERFG) 
      IF(IERFG.EQ.0)GO TO 2000
C 
C  PARAMETER ERROR
C 
300   IERMS=1 
      GO TO 1000
C 
C  TIM ERROR
C 
400   IERMS=4 
      GO TO 1000
C 
C  NON-EXISTENT OR UNDEFINED CHANNEL OR LOGICAL UNIT
C 
990   IERMS=3 
C 
C  DEFAULT BAD RETURN - LEAVE ERROR CODE AT 10
C 
1000  RETURN
C 
C  GOOD COMPLETION RETURN - ERROR CODE = 0
C 
2000  IERMS=0 
      END 
      END$
                                                                                                                                                                                                                                