SPL,L,O,M 
!     NAME:   IN.IT 
!     SOURCE: 92067-18216 
!     RELOC:  92067-16185 
!     PGMR:   G.A.A., B.L.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
      NAME IN.IT(8) "92067-16185 REV.2026 800311" 
! 
!  MODIFICATION RECORD: 
! 
!      DATE     REASON
!  1) 780411    TO INITIALIZE GLOBALS 8P,9P FOR SESSION (BL)
!  2) 780512    TO USE 256-WORD CARTRIDGE DIRECTORY (BL)
!  3) 780524    TO SET UP THE INITIAL CARTRIDGE DIRECTORY AND 
!               ASSIGN TRACK WITH CARTRIDGE DIRECTORY TO D.RTR (BL) 
!  4) 780627    TO USE $OTAT,$OPRI INSTEAD OF IDSEG TEMP WORDS IN 
!               PICKING UP ORIGINAL TATLG, ORIGINAL FMGR PRTY (BL)
!  5) 780627    TO ALLOW NAMR IN RUN STRING 
!  6) 780630    TO POST LOGLU TO 0G IF FILE INPUT 
!  7) 780911    TO SCHEDULE ACCTS FOR SESSION MONITOR INITIALIZE
!  8) 780919    TO DEFAULT LIST DEVICE TO LU 1
!  9) 781010    TO STACK INPUT LU IF SCHEDULED W/ TRANSFER FILE 
! 10) 790122    TO SAVE MASKED SECURITY CODE IN $CES
!               TO ENTER INITIALIZATION LOOP ONLY IF "FMGR" 
! 11) 790125    TO DEFAULT LOG TO LOGLU IF ILLEGAL OR NOT TTY 
! 12) 790403    TO CLEAR LU2 OPEN FLAGS ON INITIAL BOOT AFTER SWTCH 
! 13) 790725    TO RESTORE OLD CRN FOR LU 2 FROM CARTRIDGE SPECIFICATION
!               ENTRY AFTER SWTCH 
! 14) 790802    TO SAVE MASKED SECURITY CODE ON DISC
! 15) 800311    TO HANDLE OPEN ERRORS ON INPUT DEVICE IF SVC > 3
! 
      LET CLOS.,                  \FMGR INTERNAL CLOSE ROUTINE
          D.RIO,                  \FMGR CARTRIDGE DIRECTORY READ/WRITE
          DR.RD,                  \FMGR FILE DIRECTORY READ/WRITE 
          EE..,                   \FMGR EXIT ROUTINE
          GETST,                  \GET RUN STRING ROUTINE 
          LOCK.,                  \CARTRIDGE LOCK ROUTINE 
          MSS.,                   \FMGR ERROR MESSAGE ROUTINE 
          NAMR,                   \NAMR PARSE ROUTINE 
          OPEN.,                  \FMGR INTERNAL OPEN ROUTINE 
          RMPAR                   \PARAMETER FETCH ROUTINE
             BE SUBROUTINE,EXTERNAL 
      LET .DFER                   \3-WORD MOVE ROUTINE
             BE SUBROUTINE,EXTERNAL,DIRECT
      LET KEYSM,                  \FORM INITIALIZATION KEY SUM
          OPFLG,                  \CLEAR OPEN FLAGS 
          SETCL,                  \SET UP INITIAL CARTRIDGE DIRECTORY 
          SETM3,                  \TEST & SET 003 MESSAGE FLAG
          TATPU,                  \WRITE TO TRACK ASSIGNMENT TABLE
          TATUP                   \SET UP THE TRACK ASSIGNMENT TABLE
             BE SUBROUTINE
      LET TTY.               BE INTEGER,EXTERNAL
      LET PK.DR,D.SDR        BE INTEGER,EXTERNAL
      LET FM.AB              BE LABEL,EXTERNAL
      LET GT.JB              BE LABEL,EXTERNAL
      LET INI1.              BE LABEL,EXTERNAL
      LET O.BUF,I.BUF,TMP.,.R.E.,.E.R.,G0..,NO.RD  BE INTEGER,EXTERNAL
      LET BUF.               BE INTEGER,EXTERNAL
      LET C.BUF,ECH.         BE INTEGER,EXTERNAL
      LET CAM.I,CAM.O,D.LT   BE INTEGER,EXTERNAL
      LET DS.DF              BE INTEGER,EXTERNAL        !CL IN-CORE FLAG
      LET S.TTY,S.CAP        BE INTEGER,EXTERNAL        !8P,9P
      LET CLOPN              BE INTEGER,EXTERNAL
      LET M3FLG              BE INTEGER,EXTERNAL        !003 MSG FLAG 
      LET EXEC,IPUT          BE SUBROUTINE,EXTERNAL 
      LET FD.CK              BE FUNCTION,EXTERNAL 
      LET FID.               BE FUNCTION,EXTERNAL 
      LET .OPSY           BE FUNCTION,EXTERNAL,DIRECT   !IDENTIFY OP-SYS
      LET .TTY               BE FUNCTION,EXTERNAL 
      LET ICAPS              BE FUNCTION,EXTERNAL        !GET SES CAPAB.
      LET LOGLU              BE FUNCTION,EXTERNAL        !GET TERM. LU
      LET LUTRU              BE FUNCTION,EXTERNAL        !GET TRUE LU 
      LET FM.AB              BE LABEL,EXTERNAL
      LET IFLG.              BE INTEGER,EXTERNAL
      LET D.                 BE INTEGER,EXTERNAL
      LET RUNP,LIST,SVCOD,LOG,IDMY  BE INTEGER
      LET IPBUF,X(3),FSECU(6) BE INTEGER                 !NAMR BUFFER 
      LET GASP(3),ACCTS(3) BE INTEGER 
      INITIALIZE GASP TO "GASP  " 
      INITIALIZE IPBUF,X,FSECU TO "WELCOM",3,0,-2 
      INITIALIZE ACCTS TO "ACCTS "
      LET RT                 BE CONSTANT(51124K)
      LET RNULL              BE CONSTANT(51000K)
      LET A                  BE CONSTANT(0    ) 
      LET B                  BE CONSTANT(1    ) 
      LET READI              BE CONSTANT(1    ) 
      LET TAT                BE CONSTANT(1656K) 
      LET TATLG              BE CONSTANT(1755K) 
      LET TATSD              BE CONSTANT(1756K) 
      LET SECT3              BE CONSTANT(1760K) 
      LET XEQT               BE CONSTANT(1717K) 
      LET WRIT               BE CONSTANT(2    ) 
      LET KEYWD              BE CONSTANT(1657K) 
      LET RTCOM              BE CONSTANT(1747K) 
      LET RTDRA              BE CONSTANT(1750K) 
      LET BGDRA              BE CONSTANT(1754K) 
      LET BPA1               BE CONSTANT(1742K) 
      LET XPRIO              BE CONSTANT(1726K) 
      LET DSCUN              BE CONSTANT(1764K) 
      LET SYSTY              BE CONSTANT(1     )
      LET EQTA               BE CONSTANT(1650K) 
      ASSEMBLE ["EXT $CL1";"EXT $CL2";"EXT $OTAT";"EXT $OPRI"]
      ASSEMBLE ["EXT $CES";"EXT IXPUT"] 
ADCES:ASSEMBLE ["DEF $CES"] 
IN.IT:SUBROUTINE GLOBAL 
      CALL RMPAR(RUNP)                     !GET THE PARAMETERS
      P4_[P3_[P2_[T1,T_@TMP.]+1]+1]+1 
      ASSEMBLE ["LDA $OTAT";"STA OTAT";"LDA $OPRI";"STA OPRI"]
      ASSEMBLE ["LDA $CL1";"STA CL1";"LDA $CL2";"STA CL2"]
      IF IFLG. THEN  GO TO INITL          !MID LOOP JUMP
! 
!     IF FILE NAME AS PRAM THEN FETCH IT IN 
! 
       IF RUNP > 20000K THEN[               \ONLY IT IS THERE 
          CALL EXEC(14,1,BUF.,-128);        \READ THE STRING
          ILOG _ .B.;                       \GET THE TLOG 
          IS _ 1;                           \SET CHAR START 
          REPEAT 3 TIMES DO[                \WE WANT THE THIRD ITEM 
             CALL NAMR(IPBUF,BUF.,ILOG,IS)]],\NAMR NOW IN IPBUF 
       ELSE                                 \IF NOT A NAME
          IPBUF _ RUNP                      !OTHER WISE SET LU IN IPBUF 
! 
!      SET UP THE SEVERITY CODE AND ERROR WORD
! 
      $@.E.R.,$@.R.E._0 
      $(@.E.R.+1),$(@.R.E.+1)_[IF SVCOD > 4 THEN 4, ELSE SVCOD] 
      CAM.O_401K  !SET OUT PUT LU FOR ERRORS
      $(T1+8)_0 
INITL:PKDR_@PK.DR 
! 
!     IS THE DIRECTORY TRACK ASSIGNED TO D.RTR? 
! 
      Y_$KEYWD      !SET UP TO SEARCH THE ID SEGS 
NEXT: D.RTR_$Y     !SET CURRENT ADDRESS 
      IF $(D.RTR+12)=D. THEN[\  !CHECK FOR D.RTR
         IF $(D.RTR+13)=RT THEN[\ 
             IF($(D.RTR+14) AND 177400K)=RNULL\ 
                  THEN GO TO FOUND ]] 
      IF $[Y_Y+1] THEN GO TO NEXT ! CHECK FOR NEXT ID SEG 
       IF $TATLG= -1 THEN IPUT(TATLG,OTAT)
      MSS.(2008)     ! D.RTR NOT FOUND  GIVE UP 
      GO TO EXITA   !TERMINATE
! 
FOUND:IF  $($TAT+$TATSD-1)=D.RTR\  !TRACK ASSIGNED TO D.RTR?? 
          THEN GO TO PLIST   !YES GO TO PLIST 
      PN3_[PN2_[PN1_$1717K+12]+1]+1 
      IF $PN1 = "FM" THEN [                   \ENTER INITIALIZATION 
         IF $PN2 = "GR" THEN [                \LOOP ONLY IF CURRENT 
            IF ($PN3 AND 177400K) OR 40K = "  " THEN \PGM IS "FMGR" 
               GO TO FIRST]]                  ! 
      GO TO PLIST 
! 
!     FIRST ENTRY AFTER DISC LOAD SO ASSIGN ALL TRACKS TO ME
! 
FIRST: T_$TAT-[IF $TATLG= -1 THEN $@OTAT,ELSE $TATLG]-1 
! 
      FOR ADD_$TAT TO T DO[IFNOT $ADD THEN\  ASSIGN 
          IPUT(ADD,$XEQT)] !ALL UNASSIGNED TRACKS 
      IPUT($TAT+CL1,$XEQT)             !ASSIGN TRACK W/ CL TO ME
!     ALL TRACKS ASSIGNED SO IF TATLG IS -1 
!       RESET IT
! 
       IF $TATLG= -1 THEN IPUT(TATLG,OTAT)
       IFNOT $$XPRIO THEN CALL IPUT($XPRIO,OPRI)  !RESET PRIORITY 
! 
!     READ THE DISC DIRECTORY 
! 
       D.RIO(READI) 
      OPEN.(CAM.I,SYSTY,0.0,410K)   !OPEN TO SYSTY
      CALL KEYSM                    !FORM THE KEY SUM 
      CD4_[CD3_[CD2_[CD1_[CD0_@D.SDR]+1]+1]+1]+1
      MS003_[MSCOD_[GENWD_[CD252_CD4+248]+1]+1]+1 
      IF IFLG. THEN GO TO INCH !IF MID OPERATION GO CHECK 
! 
!     WAS A SYSTEM SET UP ON THIS DISC? 
! 
      IF KSUM=$GENWD THEN [           \INITIALIZED, GO SET UP 
         CALL TATUP;GO TO RLTRK]      !TRACK ASSIGNMENT TABLE 
! 
! 
      CALL SETCL                      !SET UP THE CARTRIDGE DIRECTORY 
      IF O.BUF THEN [                 \IF FILES WERE SAVED, THEN
         CLOPN_1;                     \OPEN FLAGS TO BE CLEARED 
         CALL TATUP;                  \UPDATE TRACK ASSIGNMENT TABLE
         GO TO RLTRK]                 !AND CONTINUE (NO LU2 INITIALIZE) 
! 
!     FIRST ENTRY, NO FILES SAVED 
!     SET INITIALIZATION FLAGS ETC. 
! 
INIT0:IFLG._2        !SET UP FOR LU 2 
! 
! 
INIT1:GO TO INI1.   ! GO TO MAIN TO CONTINUE
! 
INCH: IF IFLG.=2 THEN[IF $TATLG+$TATSD THEN SETM3]
! 
!     INITIALIZED - SET UP THE DISC DIRECTORY 
! 
       CALL TATUP               !SET UP TRACK ASSIGNMENT TABLE
       D.RIO(READI)             !READ THE DISC DIRECTORY
       $GENWD_KSUM              !SET THE KEYSUM 
       IF M3FLG THEN            \IF SENT 003 MESSAGE
          $MS003_$MS003 OR 100000K !SET FLAG IN CARTRIDGE DIREC.
       D.RIO(WRIT)              !WRITE IT OUT AGAIN 
! 
! 
!     TAT IS SET UP - ASSIGN CL TRACK TO D.RTR AND RELEASE
!     ALL UNUSED TRACKS 
! 
RLTRK:IPUT($TAT+CL1,D.RTR)            !ASSIGN TRACK W/ CL TO D.RTR
      CALL EXEC(5,-1)                 !RELEASE UNUSED TRACKS
      IF CLOPN THEN CALL OPFLG        !CLEAR OPEN FLAGS IF 1ST TIME 
      CALL EXEC(100027K,GASP,-1)      !SCHEDULE GASP
      GO TO GOGO
GOGO: CALL EXEC(100027K,ACCTS,-1)           !SESSION MONITOR INITIALIZE 
      GO TO GOGO1 
GOGO1:RUNP,IPBUF _ "WE"                     !SET UP PRAMS FOR AUTO ON 
      IFLG.,LIST,SVCOD,LOG_0                !IFLG. HAS DONE ITS JOB 
! 
! 
PLIST: D.RIO(READI)                         !READ IN CARTRIDGE DIRECTORY
       CES_$(@D.SDR+254)                    !MASTER SECURITY CODE (MASKED)
       ASSEMBLE ["JSB IXPUT";               \SAVE IN $CES 
                 "DEF *+3";                 \ 
                 "DEF ADCES";               \ADDRESS OF $CES
                 "DEF CES"]                 !MASKED SECURITY CODE 
       IFNOT RUNP THEN IPBUF,RUNP _ LOGLU(IDMY)   !DEFAULT INPUT DEVICE.
       S.TTY,S.CAP_0                        !780411 BL
       IF RUNP < 0 THEN [                   \CHECK IF SCHEDULED 
          TMP._6;                           \FROM BEM.
          CAM.O _ SYSTY; GO TO GT.JB] 
       G01._@G0..+1 
       IF RUNP > 20000K THEN [              \FILE NAME GIVEN. 
          G0.._1;$G01._LOGLU(IDMY)],        \SET 0G (INPUT DEVICE)
       ELSE[                                \IF NOT A FILE
          G0.._1;$G01._RUNP]                !SET 0G (INPUT DEVICE)
       IF LOG THEN [                        \IF LOG DEVICE SPECIFIED, 
          IFNOT .TTY(LOG) THEN              \IF INVALID OR NOT TTY, 
             LOG_LOGLU(IDMY)]               !THEN USE LOGLU 
       IFNOT [CAM.O _ LOG    ] THEN         \SET LOG DEVICE (DEFAULT= 
          CAM.O _ [IF [TTY. _ .TTY($G01.)]   \INPUT DEV OR 1 IF NON-IA) 
             THEN $G01., ELSE LOGLU(IDMY)]
       IF [S.CAP _ ICAPS()] THEN            \9P=CAPAB. (0 IF NON-SESSION) 
          S.TTY_LUTRU(1),                   \8P=TRUE TERMINAL LU
       ELSE S.TTY_LOGLU(IDMY)               ! 
       TMP. _ LIST                          !SET THE LIST DEVICE
       IFNOT TMP. THEN TMP. _ LOGLU(IDMY)   !LIST DEVICE (DEFAULT=LOGLU)
       IF RUNP > 20000K THEN[               \IF SCHEDULED W/ XFER FILE, 
          OPEN.(CAM.I,$G01.,0.0,401K);      \STACK INPUT LU FIRST 
          IFNOT IPBUF THEN GO TO PL1]       !IF NAMR STRING FAILED SKIP 
       OPEN.(CAM.I,IPBUF,FSECU,401K)        !OPEN INPUT DEVICE. 
       IF $@.E.R. < 0 THEN                  \IF OPEN ERROR, 
          CALL OPEN.(CAM.I,CAM.O,0.0,410K)  !OPEN INPUT TO LOG DEVICE 
! 
PL1:   CALL EXEC(14,1,C.BUF,40)             !IF FILE CHECK FOR PASSED 
       ECH._.B.                             !STRING 
       IF ECH. THEN [                       \IF A STRING AND
         IF (C.BUF AND 177400K)=35000K THEN[ \IT STARTS WITH A ':'
             C.BUF_C.BUF+[NO.RD_-15000K]]]    !CLEAR THE ':' FOR
      GO TO FM.AB 
! 
EXITA: CALL EXEC(5,-1)                      !ERROR EXIT COULD NOT INITIALIZE
      CALL EXEC(6)                          !JUST DIE QUICKLY.
! 
      END 
! 
TATPU:SUBROUTINE(ID)
      IF $ADD#ID     THEN[IF $ADD#$XEQT THEN MSS.(1005,ADD-$TAT)\ 
          , ELSE IPUT(ADD,ID)]
      ADD_ADD+1 !SEND ERROR MESSAGE 
      RETURN
      END 
! 
SETM3:SUBROUTINE
      D.RIO(READI)                        !READ DISC DIRECTORY
      IFNOT $MS003<0 THEN [               \IF 003 MSG NEVER GIVEN 
        IFNOT M3FLG THEN [                \MS003 MIGHT NOT BE UPDATED 
          M3FLG_1;                        \SET MSG 003 FLAG 
          IFLG._3;                        \SET UP FOR LU 3
          GO TO INIT1]]                   !SEND MESSAGE 
      RETURN
      END 
! 
SETCL:SUBROUTINE
! 
!     SET UP THE INITIAL CARTRIDGE DIRECTORY
! 
      CALL EXEC(1,2,O.BUF,128,$TATSD-1,0)  !READ LAST TRK, 1ST 128 WDS. 
      IFNOT FD.CK(2) THEN [           \IF FILE SYSTEM EXISTS, THEN
         $CD0_2;                      \WRITE LU=2 
         $CD1_$TATSD-1;               \LAST TRK 
         $CD2_$(@O.BUF+3);            \GET CRN FROM SPECIFICATION ENTRY 
         $CD3_7777K;                  \SESSION ID = SYSTEM
         FOR ADD_CD4 TO CD252 DO      \ZERO THE REMAINING ENTRIES 
            [$ADD_0];                 \IN THE CARTRIDGE DIRECTORY BUFFER
         $GENWD_KSUM;                 \WRITE INITIALIZATION SUMMING WORD
         $MSCOD,$MS003_0],            \ZERO MASTER SECURITY CODE, MSG 3 WDS.
      ELSE                            \ 
         [IF O.BUF THEN[              \IF OLD CL IN LAST TRACK, THEN
            $CD0_$(@O.BUF);           \SAVE ENTRY FOR LU 2 IN WRITE BUFFER
            $CD1_$(@O.BUF+1);         \LAST TRACK 
            $CD2_$(@O.BUF+2);         \CRN
            $CD3_7777K;               \SESSION ID = SYSTEM
            FOR ADD_CD4 TO CD252 DO   \ZERO REMAINING ENTRIES IN THE
               [$ADD_0];              \CARTRIDGE DIRECTORY BUFFER 
            $GENWD_KSUM;              \WRITE INITIALIZATION SUMMING WORD
            $MSCOD_$(@O.BUF+126);     \COPY MSC FROM OLD CL 
            IF $MSCOD THEN            \IF MASTER SECURITY CODE EXISTS,
               $MSCOD_($MSCOD-1) XOR 31178;  \MASK AND SAVE IN NEW CL 
            $MS003_0;                 \ZERO THE MSG 003 FLAG
            T_@O.BUF;                 \PTR TO OLD CL
            T2_@BUF.;                 \PTR TO OLD SPECIFICATION ENTRY 
            CALL EXEC(1,2,BUF.,128,$TATSD-1,14); \READ SPECIFICATION ENT. 
            FOR ADD_T TO T+15 DO      \MOVE CARTRIDGE SPECIFICATION ENTRY 
               [$ADD_$T2;T2_T2+1];    \TO LAST TRACK, FIRST 16 WORDS
            FOR ADD_T+16 TO T+112 BY 16 DO \WRITE -1 OVER REST OF OLD CL
               [$ADD_ -1];            \ 
            $@BUF. _ -1;              \WRITE -1 OVER OLD SPECIFICATION
            CALL EXEC(2,2,O.BUF,128,$TATSD-1,0);  \REWRITE LAST TRACK 
            CALL EXEC(2,2,BUF.,128,$TATSD-1,14)], \WRITE OVER SP.ENTRY
         ELSE                         \ 
            [$CD0,$CD2_2;             \SET UP FOR INITIALIZE TO FOLLOW
            $CD1_$TATSD-1;            \LAST TRACK 
            $CD3_7777K;               \SESSION ID = SYSTEM
            FOR ADD_CD4 TO MS003 DO   \ZERO THE REMAINDER OF THE
               [$ADD_0]]]             !CARTRIDGE DIRECTORY BUFFER 
      CALL EXEC(2,2,D.SDR,256,CL1,CL2) !WRITE CL BUFFER TO CL TRACK 
      DS.DF_0                          !CLEAR CL IN-CORE FLAG 
      RETURN
      END 
! 
OPFLG:SUBROUTINE
! 
!     CLEARS OPEN FLAGS ON LU 2 
!     USED AFTER FIRST SWTCH TO INSURE REMOVAL OF OLD FORMAT OPEN 
!        FLAGS FROM THE OLD SYSTEM
! 
      PDIR_@PK.DR 
      BL_0;START_25 
      LOCK.(-2,3,LKER)                !LOCK LU 2
      SIFLG_IFLG.;IFLG._0             !CLEAR IFLG. FOR DR.RD WRITE
AGAIN:DR.RD(1,-2,BL)?[GO TO UNLCK]    !READ NEXT DIRECTORY BLOCK
      FOR X1_START TO 121 BY 16 DO    \FOR EACH DIR ENTRY IN THE BLOCK
         [FOR X2_0 TO 6 DO $(PDIR+X1+X2)_0] !ZERO LAST 7 WDS (OP FLGS)
      DR.RD(2,-2,BL)?[GO TO UNLCK]    !WRITE THE DIRECTORY BLOCK
      BL_BL+1;START_9                 !BUMP TO NEXT BLOCK NUMBER
      GO TO AGAIN                     !READ NEXT DIRECTORY BLOCK
UNLCK:IFLG._SIFLG                     !RESTORE STATE OF IFLG. 
      LOCK.(-2,5)                     !UNLOCK LU 2
      CLOPN_0                         !CLEAR "CLEAR OPEN FLAGS" FLAG
      RETURN
      END 
! 
TATUP:SUBROUTINE
! 
!     SET UP THE TRACK ASSIGNMENT TABLE 
! 
! 
!     SET UP THE TAT USING THE DISC DIRECTORIES TO
!     FIND WHICH TRACKS ARE TO BE ASSIGNED
! 
      DO[LU_-2;I_0]!LU2 FIRST 
TATU1:IF FID.(LU)THEN [IF LU= -2 THEN GO TO INIT0,ELSE RETURN]
        IF $SECT3 THEN SETM3              !IF LU3, SEND 003 MESSAGE 
        ADD_[T_$( PKDR +4)]+$TAT+I        !SET TAT ADDRESS
          REPEAT $( PKDR +7)-T TIMES DO   \SET TAT
             TATPU(77776K)                !FMP TRACKS 
         REPEAT -$( PKDR +8) TIMES DO     \SET TAT
          TATPU( D.RTR)                   !DIRECTORY TRACKS 
! 
       IF LU= -2 THEN [LU_-3;I_$TATSD;GOTO TATU1] 
      RETURN
      END 
! 
KEYSM:SUBROUTINE
! 
!     FORM THE KEY SUM
! 
! 
!   NOTE:RTE-IV KEY SUM=(1650B TO 1657B)+(1742B TO 1747B)+(1755B TO 1764B)
!       :RTE-II & III KEY SUM= ABOVE LOCATIONS + (1750B TO 1754B) 
! 
! 
      KSUM_0
      FOR ADD_EQTA TO KEYWD DO[KSUM_KSUM+$ADD]
      FOR ADD_BPA1 TO RTCOM DO[KSUM_KSUM+$ADD]   !780106 GLM
      FOR ADD_TATLG TO DSCUN DO[KSUM_KSUM+$ADD]  !780106 GLM
!                                                !780106 GLM
!                                                !780106 GLM
!                                                !780106 GLM
!     THE FOLLOWING WORK IS REQUIRED TO SUPPORT  !780106 GLM
!     RTE-II & III.                              !780106 GLM
!                                                !780106 GLM
      IF .OPSY # -9 THEN [\ 
         FOR ADD_RTDRA TO BGDRA DO[KSUM_KSUM+$ADD]]  !781006 GLM
! 
      RETURN
      END 
      END 
      END$
                                                                                                                                                                                              