	SUBROUTINE MICOM_LOCATE(TERMINAL,TX_CIRCUIT,TX_LOCATION)
	IMPLICIT INTEGER (A-Z)
	CHARACTER*7 TERMINAL
	CHARACTER*30 TX_CIRCUIT,TX_LOCATION
C  ask MICOM about a connection, return ???

	INCLUDE '($IODEF)/NOLIST'
	INCLUDE '($SSDEF)/NOLIST'

	PARAMETER ( PRMFLG = 1 )
	PARAMETER ( MAX_VAX_PORTS = 32 )  ! max chem switch ports

	LOGICAL PASS_ONE/.TRUE./
	INTEGER*4 EXIT_STATUS,DESBLK(4)
	CHARACTER*5 PORT_LINE_TABLE(73:104)
			! each VAX resource class MICOM channel
			! is numbered from 1/73 to 1/104 (MAX_VAX_PORTS of them)
			! table contains chem switch access group
			! Micom shelf/channel indexed by
			! the VAX resource class Micom channel 
			! it is connected to (shelf always 1)
	CHARACTER PID_MBX*14, COMMAND*80
 	CHARACTER*30 PORT_NAME(MAX_VAX_PORTS)
	CHARACTER*7 TEMP
	CHARACTER*30 CIRCUIT,LOCATION
	CHARACTER*40 CHARACTERISTICS

	INTEGER*2 PID_MBX_IOSB(4)
	CHARACTER PID_MBX_BUF*80
	COMMON/PID_MBX/PID_MBX_CHAN,PID_MBX_IOSB,PID_MBX_BUF

	COMMON/CTRL_MASK/OLDMASK

	EXTERNAL EXIT_HANDLER

C Ask MICOM for channel status to determine PHAST:: connections BUT..
C only on the first pass.  On the first pass build a table to
C match port names with terminal line number

	IF(.NOT.PASS_ONE) GOTO 1000
	PASS_ONE = .FALSE.
C
C Setup descriptor block for declaring exit handler
	DESBLK(2) = %LOC(EXIT_HANDLER)
	DESBLK(3) = 1
	DESBLK(4) = %LOC(EXIT_STATUS)

C Declare an exit handler
	ISTAT = SYS$DCLEXH(%REF(DESBLK))
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Create the return mailbox name from the PID
	WRITE(PID_MBX,'(6HMICOM_,Z8.8)') PID()

C Create the return mailbox
	ISTAT = SYS$CREMBX(%VAL(PRMFLG),PID_MBX_CHAN,,,,,PID_MBX)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Assign a channel to the detached process mailbox
	ISTAT = SYS$ASSIGN('MICOM_MBX',MICOM_MBX_CHAN,,)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Open debug output file ??? why
D	OPEN(UNIT=2,FILE='SYS$OUTPUT',TYPE='NEW',carriagecontrol='list')

C Set the old control mask
	CALL LIB$DISABLE_CTRL('02000000'X,OLDMASK)

C Send port status command to MICOM  only care about the ones on PHAST:: ???
	COMMAND = 'SHOW CH 1/73:104'
	LEN = 16

C Send MICOM command to detached process mailbox
	ISTAT = SYS$QIOW(,%VAL(MICOM_MBX_CHAN),%VAL(IO$_WRITEVBLK),
	1 MICOM_MBX_IOSB,,,%REF(COMMAND),%VAL(LEN),,,,)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Read MICOM reply lines from PID mailbox
	DO WHILE (.TRUE.)
	   ISTAT = SYS$QIOW(,%VAL(PID_MBX_CHAN),%VAL(IO$_READVBLK),
	1 PID_MBX_IOSB,,,%REF(PID_MBX_BUF),%VAL(80),,,,)
	   IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Look for end of file (end of response message)
	   IF (PID_MBX_IOSB(1) .EQ. SS$_ENDOFFILE) GOTO 100
C	   WRITE(2,'(19H PID_MBX_IOSB(2) = ,I2)')PID_MBX_IOSB(2)
D 	   WRITE(2,'(1H ,A)')PID_MBX_BUF(1:PID_MBX_IOSB(2))

C If the port is connected add the shelf/chan number to the table
c  position depends only on reply lines containing a resource name
	   IF(PID_MBX_BUF(33:36).EQ.'CONN') THEN
		READ(PID_MBX_BUF(5:7),'(I)') CHAN  ! terminal line #
		READ(PID_MBX_BUF(61:65),'(A)') PORT_LINE_TABLE(INDEX)
	   ENDIF
	ENDDO

100	CONTINUE
D	DO I=1,MAX_VAX_PORTS
D	TYPE *,'PORT',I,' CONNECTED TO LINE ',PORT_LINE_TABLE(I)
D	ENDDO


C  ???  following file handling must use indexed file  ????
C Open the MICOMLIST file to match VAX ports to MICOM ports
	OPEN(UNIT=10,FILE='SYS$SYSROOT:[SYSMGR.MICOM]MICOMLIST.DAT',
	1    RECORDTYPE='FIXED',ACCESS='DIRECT',TYPE='OLD',READONLY)

C Read the VAX physical device name into table ignoring characterist & location
	DO I=1,MAX_VAX_PORTS
	   READ(10,keyid=0,key=??)CHARACTERISTICS,CIRC,LOCATION
	ENDDO

1000	CONTINUE

C OK, PORT_LINE_TABLE contains MICOM line numbers vs line numbers
C PORT_NAME contains port numbers vs names

C Match the PORT_NAME, use index(I) for PORT_LINE_TABLE for line number,
C and read the terminal record from MICOMLIST.DAT

	DO I=1,MAX_VAX_PORTS
	   IF(PORT_NAME(I)(1:5).EQ.TERMINAL(1:5)) THEN
		IF(PORT_LINE_TABLE(I) .GT. ') THEN
		    WRITE(6,1010) PORT_LINE_TABLE(I)
1010	FORMAT(' Terminal record ',I3,' is out of range')
		ELSE
		   READ(4'PORT_LINE_TABLE(I))CHARACTERISTICS,
	1 			TX_CIRCUIT,TX_LOCATION      
D		   WRITE(6,'(1H ,A6,3H   ,A,A)')PORT_NAME(I),
D	1 			TX_CIRCUIT,TX_LOCATION
		   ENDIF
		GOTO 999
	   ENDIF
	ENDDO
C
C If we get here there's no match in the port_name table for this device
	TX_CIRCUIT = 'UNKNOWN'

999	CONTINUE	! SUCCESS

	END

	SUBROUTINE EXIT_HANDLER(ISTAT)
	IMPLICIT INTEGER (A-Z)
	INCLUDE '($SSDEF)/NOLIST'
	INTEGER*2 PID_MBX_IOSB(4)
	CHARACTER PID_MBX_BUF*80
	
	COMMON/PID_MBX/PID_MBX_CHAN,PID_MBX_IOSB,PID_MBX_BUF
	COMMON/CTRL_MASK/OLDMASK

C Delete the permanent mailbox 
	IF (PID_MBX_CHAN .NE. 0) THEN !a mailbox exists so delete it
	    STATUS = SYS$DELMBX(%VAL(PID_MBX_CHAN))
	    IF(STATUS.NE.SS$_NORMAL) CALL LIB$STOP(%VAL(STATUS))
	ENDIF
C Reset CTRL-Y
	CALL LIB$ENABLE_CTRL(OLDMASK)
	
C Call the condition handler for istat
	CALL EXIT(ISTAT)
	END
