ASMB,R,L,C
      HED "GTLU#" GET LOGICAL UNIT FROM PROGENITORS NAMES 9-76 (DLB)
*     NAM GTLU#,7 PRE-REL 9-6-76 (DLB)
*     NAM GTLU#,7 09570-16497 REV. A 761013 
*     NAM GTLU#,7 09570-16497 REV. B 761129 
      NAM GTLU#,7 PRE-REL (RTE-IV) 780327 (DLB) 
* 
*-------------------------------------------------------- 
* 
*     RELOC.       09570-16497
*     SOURCE       09570-18497
* 
*     D. BASKINS         13 OCT 76 REV. A 
* 
*---------------------------------------------------------
* 
      ENT GTLU#,ISN 
      EXT .XLB,.XLA 
      SPC 1 
A     EQU 0 
B     EQU 1 
KEYWD EQU 1657B 
XEQT  EQU 1717B 
      SPC 1 
*  PURPOSE: 
*    THIS ROUTINE WILL GET THE LOGICAL UNIT OF THE STATION TERMINAL.
*  METHOD:
*    THE LAST TWO CHARACTORS OF THE PROGRAMS PROGENITORS NAME 
*    ARE CHECKED FOR BEING NUMERIC FROM 1 TO 63 AND THE SESSION BIT SET.
*    IF THIS FAILS, THEN A LU = 0 IS RETURNED AND THE E-REG IS SET. 
*  CALLED:
*      LU = ISN(IDMY)   -OR-      JSB GTLU# 
*                                   <A-REG = LU>
*  WHERE: 
*    LU    = THE LOGICAL UNIT OF THE TERMINAL OF THE STATION. 
*    IDMY  = ANY OLD DUMMY VERIABLE TO TELL FTN IT IS A FUNCTION. 
*  NOTES: 
*    IF THE LU IS NOT FOUND, THEN LU = 0
*    IF LU IS NOT FOUND E-REG = 1, ELSE = 0 
*  TEST PROGRAM:
*FTN,L
*      PROGRAM TEST 
*      LU = ISN(LU) 
*      WRITE (LU,100) LU
*  100 FORMAT ("THE LOGICAL UNIT OF THIS MESSAGE IS "I2)
*      END
*      END$ 
      SPC 1 
ISN   NOP           FORTRAN ENTRY 
      JSB GTLU# 
      LDB ISN,I     GET RETURN ADDRESS
      JMP B,I       RETURN DONE 
      SPC 1 
GTLU# NOP           ASMB ENTRY
      LDB XEQT      GET ADDRESS OF THIS PROGRAM 
MORE1 ADB D13       BUMP TO ADDRESS OF 3&4 CHARS OF NAME
      STB GTLU1     SAVE ADDRESS OF CHARS 3 & 4 
      ADB O7        BUMP TO ID(21)
      JSB .XLA      GET FATHER POINTER WORD 
      OCT 100001    * LDA B,I 
      RAL,RAL       FATHER WAITING? 
      SLA,RSS 
      JMP CHECK     NO, NOW GO CHECK IF LU IS IN LAST 2 CHARS 
      JSB .XLA      YES, GET HIS ID NUMBER
      OCT 100001    * LDA B,I 
      AND O377      IN LO BYTE
      ADA OM1       SUBTRACT ONE
      ADA KEYWD     INDEX INTO KEYWORD TABLE
      JSB .XLB      GET ID ADDRESS OF FATHER
      OCT 100000    * LDB A,I 
      JMP MORE1     AND GO PROCESS
      SPC 1 
CHECK CLE,SSA,RSS   CHECK IF SESSION BIT IS SET?
      JMP NOFAT     NO, RETURN ERROR
      LDB GTLU1     GET ADDRESS OF CHARS 3 & 4
      JSB .XLA      GET 3 & 4 CHARS 
      OCT 100001    * LDA B,I 
      AND O377      MASK OFF TO LEAVE 4TH CHAR
      ADA OM72      CHECK IF > THAN 9 
      SEZ,CLE,RSS   LEAVE E=0 IF ERROR
      ADA D10       NOW CHECK => 0
      SEZ,CLE,INB,RSS OK? 
      JMP NOFAT     NO, RETURN A = 0
      STA GTLU1     YES, SAVE FOR LATER 
      JSB .XLA      GET 5TH CHARS 
      OCT 100001    * LDA B,I 
      ALF,ALF       POSTITION IN LOW BYTE 
      AND O377      MASK TO 5TH CHAR
      ADA OM72      CHECK IF 0 TO 9 
      SEZ,CLE,RSS   CHECK IF OK 
      ADA D10 
      SEZ,CLE,RSS   OK? 
      JMP NOFAT     NO, RETURN A=0
      LDB GTLU1     YES, GET MOST SIGNF CHAR
      BLF,RBR       MPY BY 8
      ADB GTLU1 
      ADB GTLU1     AND ADD IN 2
      ADA B         AND FORM NUMBER 
      STA B         NOW CHECK IF 0 TO 63 FOR LEGAL LU 
      AND O77       MASK OFF POSSIBLE BITS
      CPA B         NUMBER 0 - 63?
      CLE,SZA,RSS   YES, GOOD RETURN
NOFAT CLA,CCE       NO, BAD RETURN
      JMP GTLU#,I   RETRUN A-REG = ANSWER 
      SPC 1 
GTLU1 NOP           TEMP
OM72  OCT -72 
O7    OCT 7 
D10   DEC 10
D13   DEC 13
O77   OCT 77
O377  OCT 377 
OM1   OCT -1
      END 
                                                                                                              