*DECK DA$OPSB 
  PROC DE$OPSB(FILENAME,SBNAME,DIT,SBFWB,SBBFS);
    BEGIN 
      XREF
        BEGIN 
        PROC DE$OPEN;        # COMPASS ROUTINE TO OPEN SUBSCH FILE.    #
        PROC DE$GET;         # COMPASS ROUTINE TO READ SUBSCH FILE.    #
        ITEM DE$EOI;         # ADDRESS OF EOI OF SUBSCH FILE.          #
        END 
      DEF BUFSIZE # 100 #;
      ARRAY BEGINZERO [0];
        ITEM ZEROOUT U(0,0,60); 
  
      XDEF
        BEGIN 
        PROC DE$READ; 
        ARRAY DE$SNAM [2] S(1);    # CONTAINS THE SUBSCH NAME PASSED BY#
          BEGIN 
          ITEM NAMESB U(0,0,60);  # CALLING ROUTINE  #
          ITEM NAMSB30 C(0,0,30); 
          END 
        BASED ARRAY DE$DIT [24] S(1); # CONTAINS THE CONTROL WORDS OF  #
          BEGIN                       # THE SUBSCH REQUESTED IN CALL   #
*CALL DITCOMSB
          ITEM SBENTRYWRDS U(0,0,3);      # SUBSCH NAME LENGTH IN WORDS#
          ITEM SBENTRYNAME U(0,0,60);     # SUBSCH NAME.               #
        END 
        ARRAY DE$ARL [100] S(1);
          BEGIN 
*CALL SBRLMLST
          ITEM ENDOFFILE U(0,0,60); # USED FOR INDEX TABLE SEARCH.     #
          ITEM SSNAM30 C(0,0,30);  # TEMPORARY STORAGE FOR SUBSCH NAME #
          ITEM SBADR U(3,0,30);  # SUBSCH ADDRESS AS IT RESIDES IN     #
                                  # THE SUBSCHEMA FILE.                #
          END 
        ITEM DE$ARLA;        # WORD ADDRESS OF REALM LIST # 
        ITEM DE$ARLL;        # LENGTH OF REALM LIST # 
        ITEM DE$PTR;         # DIRECTORY POINTER #
        END 
  
  
      ITEM I,J,K; 
      ITEM SIZESB;
      ITEM SBPTR; 
      ITEM CTLWORDADR;  # CONTAINS THE ADDRESS OF THE CONTROL WORD IN  #
                        # THE SUBSCH FILE.                             #
      ARRAY SBCNTRLWRD [0];  # CONTAINS THE CONTROL WORD INFO.         #
        BEGIN 
        ITEM SBCOUNT U(0,0,12);   # COUNT OF THE SUBSCHEMAS IN THE     #
                                  # SUBSCH FILE.                       #
        ITEM SBITADR U(0,12,48);  # CONTAINS THE ADDRESS OF THE INDEX  #
                                  # TABLE IN THE SUBSCHEMA FILE.       #
        END 
      ARRAY ENDZERO;; 
  
      ITEM FILENAME;
      ITEM SBBFS; 
      ARRAY SBFWB [0];; 
      ARRAY DIT [0];; 
      ARRAY SBNAME [2]; 
        ITEM SBNME U(0,0,60); 
  
      J = LOC(ENDZERO) - LOC(BEGINZERO);
      FOR I = 0 STEP 1 UNTIL J-1 DO 
        ZEROOUT[I] = 0; 
      NAMESB[0] = SBNME[0];       # STORE NAME OF SUBSCH PASSED IN CALL#
      NAMESB[1] = SBNME[1]; 
      NAMESB[2] = SBNME[2]; 
      SIZESB = 19;             #LENGTH OF CONTROL WORDS + SUBSCH HEADER#
      SBPTR = 0;
      K = 1;
      P<DE$DIT> = LOC(DIT); 
      DAENTAD[SBPTR] = 0; 
      DASTATE[SBPTR] = 0; 
      DANWRDS[SBPTR] = 0; 
      DAPART[SBPTR] = 0;
      CTLWORDADR = 0; 
  
      DE$OPEN( FILENAME, SBFWB, SBBFS );
      IF DE$EOI LQ 1 THEN 
        DASTATE[SBPTR] = 1;  # UNKNOWN LFN - ERROR #
      IF DASTATE[SBPTR] EQ 1 THEN 
        RETURN; 
  LOOP:      #    # 
      IF DE$EOI LQ 1 THEN 
        BEGIN 
        DE$GET( LOC(DE$DIT), SIZESB, 1 ); 
         IF DASTATE[SBPTR] EQ 1 THEN
            RETURN; 
        J = SBCWSBHDRPTR[SBPTR];   # SUBSCH HEADER ENTRY ADDRESS.      #
        FOR I = 0 STEP 1 UNTIL SBENTRYWRDS[J]-1 DO
          BEGIN 
          IF NAMESB[I] NQ SBENTRYNAME[J+1+I] THEN 
            BEGIN 
            DASTATE[SBPTR] = 1; 
            RETURN; 
            END 
          END 
        DE$PTR = 1; 
        GOTO COMPROC; 
        END 
#   CALL ROUTINE TO READ IN SPECIFIED WORDS INTO WSA                   #
      I = DE$EOI; 
      DE$READ( DE$ARL, I, DE$EOI, 1 );
      IF I LQ 0 THEN
        K = 0;         # NUMBER OF WORDS READ IS LESS THAN BUFFER SIZE #
  
#   SEARCH FOR END OF FILE MARKER # 
      FOR J = 0 STEP 1 UNTIL 99 DO
        BEGIN 
        IF ENDOFFILE[J] EQ O"05160417062323061114" THEN 
          BEGIN 
          CTLWORDADR = DE$EOI + J - K;
          J = 100;           # FORCE EXIT FROM LOOP.                   #
          TEST; 
          END 
        END 
      IF CTLWORDADR EQ 0 THEN 
        GOTO LOOP;                 # END OF FILE MARKER NOT FOUND.     #
      FOR I = 0 STEP 1 UNTIL 99 DO
        REALMLISTNME[I] = 0;       # ZERO OUT WORK BUFFER.             #
      DE$GET( LOC(SBCNTRLWRD), 1, CTLWORDADR ); # READ IN THE CONTROL  #
                                            # WORD. # 
      I = SBCOUNT[0] * 4;  # NUMBER OF WORDS IN INDEX TABLE.           #
      J = SBITADR[0]; # WORD ADDR OF THE INDEX TABLE IN SUBSCH FILE.   #
      FOR K = K WHILE I GR 0 DO  # SEARCH INDEX TABLE FOR SUBSCH NAME  #
        BEGIN                      # PASSED IN CALL.     #
        DE$READ(DE$ARL, I, J, 0);  # CALL TO READ IN INDEX TABLE       #
        FOR K = 0 STEP 4 UNTIL 99 DO # LOOP THROUGH INDEX TABLE TO     #
          BEGIN 
          IF NAMSB30[0] EQ SSNAM30[K] THEN
            BEGIN                  # SUB-SCHEMA NAME FOUND.            #
            DE$PTR = SBADR[K];     # SET POINTER TO ADDR OF SUB-SCHEMA #
            DE$GET( LOC(DE$DIT), SIZESB, DE$PTR ); # READ IN THE CON-  #
              # TROL WORDS OF THE FOUND SUBSCH INTO THE DIR. INF. TABLE#
  COMPROC:     #   #
            SBCWSBADDR[SBPTR] = DE$PTR;  #STORE SUB-SCHEMA ADDRESS IN  #
                                          # DIRECTORY INFO. TABLE.     #
            DASTATE[SBPTR] = 0; 
            DAENTAD[SBPTR] = 0; 
            DAPART[SBPTR] = 0;
            DANWRDS[SBPTR] = 0; 
            DE$ARLA = SBCWRLMLSTAD[SBPTR] + SBCWSBADDR[SBPTR];
            DE$ARLL = (SBCWNUMAREAS[SBPTR] + SBCWNUMRELS[SBPTR]) * 4; 
            FOR K = 0  STEP 1 UNTIL 99 DO 
              REALMLISTNME[K] = 0;
            RETURN; 
            END 
          END 
        END 
      DASTATE[SBPTR] = 1;   # SUBSCH NAME WAS NOT FOUND. SET STATE = 1 #
      RETURN; 
  PROC DE$READ(LOCATION,NUMWORDS,ADDRESS,TYPE); 
    BEGIN 
      DEF BUFSIZE #100#;
  
      ITEM ADDRESS;          # ADDRESS WHERE READ IS TO START          #
      ITEM LOCATION;         # LOCATION OF WSA.                        #
      ITEM NUMWORDS;         # NUMBER OF WORDS TO BE READ              #
      ITEM TYPE;             # 0 = FORWARD READ                        #
                             # 1 = BACKWARD READ                       #
      ITEM I1;               # SCRATCH VARIABLE                        #
  
#   COMPUTE NUMBER OF WORDS TO BE READ #
      IF NUMWORDS GR BUFSIZE THEN 
        I1 = BUFSIZE; 
      ELSE
        I1 = NUMWORDS;
  
#   COMPUTE NUMBER OF WORDS NOT READ #
      NUMWORDS = NUMWORDS - I1; 
  
#   COMPUTE ADDRESS FOR BACKWARD READ # 
      IF TYPE EQ 1 THEN 
        ADDRESS = ADDRESS - I1; 
  
#   CALL ROUTINE TO READ IN NUMBER OF WORDS INTO WSA #
      DE$GET(LOC(LOCATION), I1, ADDRESS); 
  
#   COMPUTE ADDRESS FOR NEXT FORWARD READ # 
      IF TYPE EQ 0 THEN 
      ADDRESS = ADDRESS + I1; 
      RETURN; 
    END          # END OF PROC #
    END 
    TERM; 
