*DECK RELSTAT 
USETEXT TSBTBL                                                          005330
  PROC RELSTAT; 
    BEGIN 
      DEF CWPTR # 0 #;
      DEF F4 #8#;                  # DDLCOMP VALUE FOR FTN4-MATCHES DDL#
      DEF F5 #9#;                  # DDLCOMP VALUE FOR FTN5-MATCHES DDL#
  
      XREF ITEM SBSCHMA;           # CONTAINS THE FIRST WORD ADDRESS   #
                                   # OF THE SUB-SCHEMA IN CORE.        #
      XREF ITEM DDLCOMP;           # CONTAINS CODE FOR FTN4 OR FTN5    #
      XREF PROC DDLPRNT;           # PRINTS INFORMATION TO OUTPUT.     #
      XREF PROC WSSOUT2;           # WRITES TO SSOUT (ZZZZZS2)         #002300
  
# DECLARATIONS BETWEEN $BEGIN AND $END BLOCKS ARE SATISFIED BY SYMPL   #005350
# TEXTS AS INDICATED IN THE USETEXT DIRECTIVE.                         #005360
                                                                        005370
      $BEGIN     # SYMPL TEXT * TSBTBL * USED                          #005380
                                                                        005390
      BASED ARRAY CBWORKBUF [0] S(1); 
        BEGIN 
*CALL SBCWDECLS 
*CALL SUBDECLS
*CALL SBRLHDDCL 
*CALL SBRLDBDCL 
*CALL SBRQHDDCL                                                         002680
        END                                                             005402
                                                                        005410
      $END                                                              005420
      BASED ARRAY RQT[0] S;                                             005422
        BEGIN                                                           005424
*CALL SBRQSTDCL                                                         002690
*CALL SBRQATDCL                                                         002500
        END 
      ITEM AREAADR;                # AREA ADDRESS.                     #
      ITEM BLANKLINE C(10) = "          ";
      ITEM CHARCNT;                # KEEPS A COUNT OF CHARACTERS TRANS-#
                                   # FERRED TO PRINT BUFFER.           #
      ITEM DBIWRDS;                # NUMBER OF WORDS OCCUPIED BY DBI   #
                                   # ENTRIES IN A RST.                 #
      ITEM DISPVAL C(10);          # DISPLAY CODE VALUE FOR A NUMBER   #002170
      ITEM DISPVA2 C(10); 
      ITEM DISPVA3 C(10); 
                                                                        002180
                                   # SOURCE LINE TEMPLATES FOR USE     #002190
                                   # IN GENERATING SSOUT FILE.         #002200
                                                                        002210
      ITEM F4IRELFITL C(70) =                                          "001150
      INTEGER DBNXXXX(XXXX)                                           ";002230
                                                                        002240
      ITEM F4IRELORD C(70) =                                           "
      INTEGER DBAXXXX(XXXX)                                           ";
  
      ITEM F4DRELORD1 C(70) =                                          "
      DATA DBAXXXX/                                                   ";
  
      ITEM F4DRELORD2 C(20) =                                          "
     +             ,";
      ITEM F4DRELORD3 C(10) =                                          "
     +0/  ";
      ITEM F4CRELFITL C(70) =                                          "001170
      COMMON/DB0000/DBNXXXX                                           ";002260
                                                                        001110
      ITEM F4DRELFITL C(70) =                                          "001120
      DATA DBNXXXX/XXXX*0,0/                                          ";001130
                                                                        002270
      ITEM F4IREL C(70) =                                              "000980
      INTEGER DBRELST(XXXX)                                           ";000990
                                                                        001000
                                                                        001030
                                   # FORTRAN 4 REL DATA STMT SKELETONS #
  
      ITEM F4DREL2 C(70) =                                             "001040
      DATA DBRELST(0000)/77777000000000007777B/                       ";
                                                                        001060
      ITEM F4DREL3 C(70) =                                             "001070
      DATA DBRELST(0000)/00000037000000000000B/                       ";
      ITEM F4DREL4 C(70) =                                             "000170
      DATA DBRELST(0000)/0/                                           ";
                                                                        001090
      ITEM F5TEMPVAL C(70) =                                           "
      INTEGER DBTEMP                                                  ";
  
                                   # FORTRAN 5 REL DATA STMT SKELETONS #
  
      ITEM F5DREL2 C(70) =                                             "
      DATA DBRELST(0000)/O""77777000000000007777""/                   ";
  
      ITEM F5DREL3 C(70) =                                             "
      DATA DBRELST(0000)/O""00000037000000000000""/                   ";
  
      ITEM ESUB;                   # ELEMENT SUBSCRIPT IN DBRELST      #
      ITEM F4IRELDIM;              # DIMENSION FOR F4 REL.U.LIST ENTRY #002280
      ITEM I,J,K;                  # SCRATCH VARIABLES.                #
      ITEM L;                      # TEMPORARY SCRATCH VARIABLE        #
      ITEM L1;                     # TEMPORARY SCRATCH VARIABLE        #
      ITEM ITEMPTR;                # PTR TO ITEM COMPARED W/ DATA NAME #001400
      ITEM LASTNAME;               # COUNT OF NAMES(VALID FOR LAST REL)#001410
      ITEM OFFSET;                 # OFFSET TO STORE IN REL.U.LIST DATA#001420
      ITEM ORDNUM C(10);           # RELATION ORDINAL NUMBER.          #
      ITEM RSTPTR;                 # VARIABLE POINTER FOR ACCESSING    #
                                   # RELATION SEARCH TABLE -           #002330
                                   # RELATION INFORMATION IN SUBSCHEMA #
                                   # DIRECTORY.                        #
      ITEM RQTPTR;                 # VARIABLE POINTER FOR ACCESSING    #002350
                                   # RELATION QUALIFICATION TABLE -    #002360
                                   # RESTRICT INFORMATION IN SUBSCHEMA #002370
                                   # DIRECTORY.                        #002380
      ITEM RELPTR;               # SAVES STARTING ADDR OF RST          #000290
      ITEM STACKLEN;               # LENGTH OF RQT STACK(RESTR) ENTRIES#002390
      ITEM STATLINE C(120);        # PRINT BUFFER FOR RELATION STAT-   #
                                   # ISTICS INFORMATION.               #
      ITEM STATHDR C(80) = "               *****                 RELATIO
N   STATISTICS                 *****";
      ITEM TEMPCNT;                # TEMPORARY STORE FOR CHARACTER CNT.#
  
      CONTROL EJECT;                                                    000310
FUNC XCDD(NUMBER) C(10);                                                000320
      BEGIN                                                             000330
#**********************************************************************#000340
#                                                                      #000350
#                  X C D D                                             #000360
#                                                                      #000370
#     THIS FUNCTION CONVERTS A BINARY INTEGER INTO DECIMAL DISPLAY     #000380
#       CODE                                                           #000390
#                                                                      #000400
#**********************************************************************#000410
      ITEM NUMBER;               # NUMBER TO BE CONVERTED              #000420
      ITEM WORK C (10);                                                 000430
      ITEM I,J,K;                                                       000440
                                 # ZERO FILL                           #000445
      WORK = "0000000000";                                              000450
      I = NUMBER;                                                       000460
      FOR K = 54 STEP -6 WHILE I GR 0 DO                                000470
        BEGIN                                                           000480
          J = I / 10;                                                   000490
          B<K,6>WORK = I - J*10 + O"33";                                000500
          I = J;                                                        000510
        END                                                             000520
      XCDD = WORK;                                                      000530
      RETURN;                                                           000540
      END                                                               000550
      CONTROL EJECT;                                                    000560
FUNC XCOD(NUMBER) C(10);                                                000570
      BEGIN                                                             000580
#**********************************************************************#000590
#                                                                      #000600
#                  X C O D                                             #000610
#                                                                      #000620
#     THIS FUNCTION CONVERTS A BINARY INTEGER INTO OCTAL DISPLAY CODE  #000630
#                                                                      #000640
#**********************************************************************#000650
      ITEM NUMBER;               # NUMBER TO BE CONVERTED              #000660
      ITEM WORK C(10);                                                  000670
      ITEM I,J;                                                         000680
      WORK = "0000000000";       # ZERO FILL                           #000690
      I = NUMBER;                                                       000700
      FOR J = 3 STEP 3 UNTIL 30 DO                                      000710
        B<60-J*2,6>WORK = B<60-J,3>NUMBER + O"33";                      000720
      XCOD = WORK;                                                      000730
      RETURN;                                                           000740
      END                                                               000750
CONTROL EJECT;                                                          000755
                                                                        002710
#**********************************************************************#002720
#         START OF PROC                                                #002730
#**********************************************************************#002740
                                                                        002750
      P<CBWORKBUF> = SBSCHMA;      # POINTS TO SUBSCHEMA IN CORE.      #
      P<RQT> = SBSCHMA;          # BASE RQT ARRAY ON SUBSCHEMA ADDR    #007915
      DDLPRNT( BLANKLINE, 10 );    # OUTPUT BLANK LINE.                #
      DDLPRNT( STATHDR, 80 );      # OUTPUT HEADER.                    #
      RSTPTR = SBCWFRSTRELA[CWPTR];  # ADDRESS OF FIRST RELATION ENTRY #
      STATLINE = " "; 
      F4IRELDIM = SBCWNUMRELS[CWPTR];  # INITIALIZE RELATION USAGE LIST#
                                       # DIMENSION                     #
  
    # STEP THRU RELATION ENTRIES.                                      #
      FOR I = 1 STEP 1 UNTIL SBCWNUMRELS[CWPTR] DO
        BEGIN    # BEGIN OF LOOP--1 # 
        CHARCNT = 0;
        K = RSTPTR + RSTNXTRSTPTR[RSTPTR];   # ADDRESS OF NEXT RELATION#
                                             # ENTRY                   #
        AREAADR = 0;
        C<1,9>STATLINE = "RELATION "; 
        CHARCNT = CHARCNT + 10; 
        J = I;
        CONVORDNUM(J);
        C<CHARCNT,3>STATLINE = C<7,3>ORDNUM;  # TRANSFER ORDINAL NO.   #
        CHARCNT = 27; 
        C<CHARCNT,RSTRELNMELC[RSTPTR]>STATLINE =
                         C<0,RSTRELNMELC[RSTPTR]>RSTRELNAME30[RSTPTR];
        CHARCNT = CHARCNT + RSTRELNMELC[RSTPTR];
        C<CHARCNT,7>STATLINE = " JOINS "; 
        CHARCNT = CHARCNT + 7;
        CHARCNT = CHARCNT + 11; 
        DBIWRDS = (RSTHIGHRANK[RSTPTR]-2)*4 + 4; # NUMBER OF WORDS     #
                             # OCCUPIED BY DBIS IN RELATION ENTRY.     #
                                    # SAVE ADDR OF RELATION ENTRY      #000130
        RELPTR = RSTPTR;                                                000140
        RSTPTR = RSTPTR + RSTRELNMELW[RSTPTR] + 2;  # POINTS TO THE    #
                             # START OF THE DBI ENTRIES.               #
        DBIWRDS = RSTPTR + DBIWRDS;      # LAST WORD ADDRESS OF THE    #
                                         # PRESENT RELATION ENTRY.     #
    # LOOP FOR AREA NAMES IN SUBJECT RELATION ENTRY.                   #
        FOR J = RSTPTR STEP 2 UNTIL DBIWRDS - 1 DO
          BEGIN  # BEGIN OF LOOP--2  #
          TEMPCNT = CHARCNT;   # POSITION WHERE "AREA" AND AREA-NAMES  #
                             # ARE TO BE PLACED IN PRINT BUFFER.       #
          IF RSTAREAADR[J] EQ AREAADR THEN   # IF PRESENT AREA IS THE  #
            TEST J;                # SAME AS THE PREVIOUS AREA, SKIP TO#
          ELSE                     # NEXT AREA ADDRESS.                #
            AREAADR = RSTAREAADR[J];
          C<TEMPCNT,7>STATLINE = "AREA - "; 
          TEMPCNT = TEMPCNT + 7;
          C<TEMPCNT,SBARLENGCHAR[AREAADR]>STATLINE =
          C<0,SBARLENGCHAR[AREAADR]>SBARNAME30[AREAADR+ 
                                    SBARNAMEPTR[AREAADR]];
          DDLPRNT( STATLINE, 120 ); 
          STATLINE = " "; 
          END    # END OF LOOP--2  #
                                                                        002410
                                       # BUILD F4 STMTS FOR REL FIT LST#001220
                                                                        001230
        DISPVAL = XCDD(I);             # CONVERT REL. ORD TO DEC. DISP #002430
        DISPVAL = C<6,4>DISPVAL;       #   SHIFT TO FIRST 4 CHARS      #002440
        C<17,4>F4IRELFITL = DISPVAL;   # STORE ORDINALS INTO TEMPLATES #001250
        C<23,4>F4CRELFITL = DISPVAL;                                    001260
        C<17,4>F4IRELORD = DISPVAL; 
                                       # DIM. IS AREAS IN RELATION + 1 #001270
        J = RSTHIGHRANK[RELPTR] + 1;                                    000160
        DISPVAL = XCDD(J);                                              001290
        DISPVAL = C<6,4>DISPVAL;                                        001300
        C<22,4>F4IRELFITL = DISPVAL;   # STORE DIM. INTO TEMPLATE      #001310
        C<22,4>F4IRELORD = DISPVAL; 
                                                                        001320
        WSSOUT2(F4IRELFITL,70);        # WRITE REL FIT LIST DECL. AND  #001330
        WSSOUT2(F4CRELFITL,70);        # COMMON TO SSOUT               #001340
        WSSOUT2(F4IRELORD,70);         # WRITE RELATION REALM ORINAL   #
                                       # LIST DECLARATIONS TO SSOUT    #
                                                                        001350
                                       # GET ADDR OF RESTRICT ENTRIES  #002470
      RQTPTR = RELPTR + RSTRQTPTR[RELPTR];                              000180
    # LOOP FOR COUNTING RESTRICT NON-DB DATA NAMES IN RELATION ENTRY.  #002500
                                    # IF PTRS ARE NOT EQUAL, THERE ARE #000200
                                    #    RESTRICTS SO COUNT DATA NAMES #000210
      IF RQTPTR NQ RELPTR THEN                                          000220
        BEGIN                                                           002520
          STACKLEN = RQTATTRIBPTR[RQTPTR] - 1;  # GET NO. RESTR. ITEMS #002530
          FOR J = 1 STEP 1 UNTIL STACKLEN DO                            002540
          BEGIN  # BEGIN OF LOOP--3  #                                  002550
                                       # IF REST.STACK ENT.IS DATA NAME#002560
            IF RQTSTACKTYPE [ RQTPTR + 1 + J ] EQ 3                     002570
            THEN F4IRELDIM = F4IRELDIM + 1;  # ADD 1 TO DIMENSION      #002580
          END    # END OF LOOP--3  #                                    002590
        END                                                             002600
                                                                        002660
        RSTPTR = K; 
        END      # END OF LOOP--1  #
                                                                        001440
                                       # BUILD F4 STMT FOR RELATION    #001450
                                       # USAGE LIST                    #001460
      IF SBCWFRSTRELA[CWPTR] NQ 0                                       000130
      THEN                                                              000140
        F4IRELDIM = F4IRELDIM + 1;                                      000150
  
      IF SBCWSSTYPE[0] EQ "FT5"        # IF FTN5 AND DATA NAMES ARE IN #
        AND SBCWDNSBUFSZ[0] NQ 0       # THE SS,                       #
      THEN
        WSSOUT2(F5TEMPVAL,70);         # WRITE DECL. OF TEMP. ITEM.    #
  
                                                                        001470
      DISPVAL = XCDD(F4IRELDIM);                                        001480
      DISPVAL = C<6,4>DISPVAL;                                          001490
      C<22,4>F4IREL = DISPVAL;         # STORE DIMENSION INTO TEMPLATE #001500
                                                                        001510
      WSSOUT2(F4IREL,70);              # WRITE REL.U.LIST DECL TO SSOUT#001520
                                                                        001530
                                       # BUILD F4 DATA FOR REL FIT LIST#001540
                                       # ONE LIST FOR EACH RELATION    #001550
                                                                        001560
      RSTPTR = SBCWFRSTRELA[CWPTR];    # ADDR OF FIRST RELATION ENTRY  #001570
      FOR I = 1 STEP 1 UNTIL SBCWNUMRELS[CWPTR] DO                      001580
        BEGIN                                                           001590
        DISPVAL = XCDD(I);                                              001620
        DISPVAL = C<6,4>DISPVAL;                                        001630
        C<14,4>F4DRELFITL = DISPVAL;                                    001640
        C<14,4>F4DRELORD1 = DISPVAL;
                                       # REPEAT FACTOR IS AREAS IN REL #001650
        J = RSTHIGHRANK[RSTPTR];                                        001660
        DISPVAL = XCDD(J);                                              001670
        DISPVAL = C<6,4>DISPVAL;                                        001680
        C<19,4>F4DRELFITL = DISPVAL;                                    001690
                                                                        001700
        WSSOUT2(F4DRELFITL,70);        # WRITE REL FIT LIST DATA TO    #001710
                                       # SSOUT                         #001720
                                                                        001730
  
        WSSOUT2(F4DRELORD1,70);        # WRITE RELATION REALM ORDINAL  #
                                       # DATA STATEMENT TO SSOUT       #
  
                                       # LENGHT OF DBI ENTRY IS 2 WORDS#
                                       # FOR FIRST AND LAST AREA, AND  #
                                       # 4 WORDS FOR ALL OTHER ENTRIES #
        K = (J - 2) * 4 + 2 * 2;
        L = RSTPTR + RSTRELNMELW[RSTPTR] + 2; 
        FOR L1 = L STEP 2 UNTIL L+K-1 DO
          BEGIN 
            IF L1 NQ L
            THEN
              BEGIN 
                IF RSTAREAORD[L1] EQ RSTAREAORD[L1-2] 
                THEN
                  TEST L1;
  
              END 
            DISPVAL = XCDD(RSTAREAORD[L1]); 
            C<6,4>F4DRELORD2 = C<6,4>DISPVAL; 
            WSSOUT2(F4DRELORD2,20); 
          END 
        WSSOUT2(F4DRELORD3,10); 
                                   # ADDRESS OF NEXT RELATION          #
                                   # ENTRY                             #
        RSTPTR = RSTPTR + RSTNXTRSTPTR[RSTPTR]; 
        END                                                             001750
                                                                        001760
                                       # BUILD DATA STMTS FOR RELATION #
                                       # USAGE LIST, WITH RESTRICT DATA#001780
      ESUB = 1; 
      RSTPTR = SBCWFRSTRELA[CWPTR];    # LOOP THROUGH RELATIONS        #001820
      FOR I = 1 STEP 1 UNTIL SBCWNUMRELS[CWPTR] DO                      001830
        BEGIN                                                           001840
        K = RSTPTR + RSTNXTRSTPTR[RSTPTR];                              001850
                                       # RELATION NO.                  #001860
        DISPVAL = XCOD(I);             # CONVERT TO OCTAL DISPLAY CODE #001870
                                                                        001890
                                       # OFFSET TO NEXT ENTRY          #001900
        OFFSET = 1;                    # MIN = 1 FOR RELATION WORD     #001910
                                       # GET ADDR OF RESTRICT ENTRIES  #001920
        RQTPTR = RSTPTR + RSTRQTPTR[RSTPTR];                            000240
        IF RQTPTR NQ RSTPTR THEN # IF ANY RESTR,COUNT DATA NAMES       #000250
          BEGIN                                                         001950
          STACKLEN = RQTATTRIBPTR[RQTPTR] - 1;  # GET NO. RESTR. ITEMS #001960
          LASTNAME = 0;                                                 001970
          FOR J = 1 STEP 1 UNTIL STACKLEN DO                            001980
            BEGIN                      # IF REST.STACK ENT.IS DATA NAME#001990
            IF RQTSTACKTYPE [ RQTPTR + 1 + J ] EQ 3                     002000
            THEN OFFSET = OFFSET + 1;  # ADD 1 TO OFFSET               #002010
            LASTNAME = LASTNAME + 1;   # COUNT DATA NAMES(IN LAST REL.)#002020
            END                                                         002030
          END                                                           002040
                                                                        002100
                                                                        002130
        DISPVA2 = XCOD(OFFSET);        # CONVERT OFFSET TO OCTAL DISP. #
        DISPVA3 = XCDD(ESUB); 
        ESUB = ESUB + 1;
  
        IF DDLCOMP EQ F4           # IF FTN4 USE FTN4 DATA SKELETON    #
        THEN
          BEGIN 
          C<41,4>F4DREL2 = C<6,4>DISPVAL;  # STORE RELATION NUMBER     #
          C<25,5>F4DREL2 = C<5,5>DISPVA2;  # STORE OFFSET TO NEXT ENTRY#
          C<19,4>F4DREL2 = C<6,4>DISPVA3;  # STORE THE DBRELST SUBSCR  #
          WSSOUT2(F4DREL2,70);     # WRITE RELATION HEADER DATA        #
          END 
        ELSE                       # ELSE ASSUME FTN5-USE FTN5 SKELETON#
          BEGIN 
          C<43,4>F5DREL2 = C<6,4>DISPVAL;  # STORE RELATION NUMBER     #
          C<27,5>F5DREL2 = C<5,5>DISPVA2;  # STORE OFFSET TO NEXT ENTRY#
          C<19,4>F5DREL2 = C<6,4>DISPVA3;  # STORE THE DBRELST SUBSCR  #
          WSSOUT2(F5DREL2,70);     # WRITE RELATION HEADER DATA        #
          END 
                                                                        002180
        IF RQTPTR NQ RSTPTR THEN       # IF ANY RESTR, COUNT DATA NAMES#
          BEGIN                        # BUILD DATA NAME WORDS         #002200
          STACKLEN = RQTATTRIBPTR[RQTPTR] - 1;  # GET NO. RESTR. ITEMS #002210
          LASTNAME = 0;                                                 002220
          FOR J = 1 STEP 1 UNTIL STACKLEN DO                            002230
           BEGIN                                                        002240
                                       # IF REST.STACK ENT.IS DATA NAME#002250
            IF RQTSTACKTYPE [ RQTPTR + 1 + J ] EQ 3                     002260
            THEN                                                        002270
            BEGIN                      # GET ITEM PTR                  #002280
              ITEMPTR = RQTPTR - RQTITEMPTR[RQTPTR+1+J];
                                       # GET ITEM SIZE                 #002300
              DISPVAL = XCOD(SBITMUSESIZE[ITEMPTR]);
              DISPVA3 = XCDD(ESUB); 
              ESUB = ESUB + 1;
  
              IF DDLCOMP EQ F4     # IF FTN4 USE FTN4 DATA SKELETON    #
              THEN
                BEGIN 
                C<31,2>F4DREL3 = C<8,2>DISPVAL;  # STORE DATA NAME     #
                C<19,4>F4DREL3 = C<6,4>DISPVA3;  # AND THE SUBSCRIPT   #
                WSSOUT2(F4DREL3,70);  # WRITE DATA NAME WORD TO SSOUT  #
                END 
              ELSE                 # ELSE USE FTN5 DATA STMT SKELETON  #
                BEGIN 
                C<33,2>F5DREL3 = C<8,2>DISPVAL;  # STORE DATA NAME     #
                C<19,4>F5DREL3 = C<6,4>DISPVA3;  # AND THE SUBSCRIPT   #
                WSSOUT2(F5DREL3,70);  # WRITE DATA NAME WORD TO SSOUT  #
                END 
            END                                                         002410
           END                                                          002430
          END                                                           002440
                                                                        002450
        RSTPTR = K;                                                     002460
        END                                                             002470
                                                                        000220
      IF SBCWFRSTRELA [CWPTR] NQ 0                                      000230
      THEN                                                              000240
        BEGIN 
        DISPVAL = XCDD(ESUB); 
        C<19,4>F4DREL4 = C<6,4>DISPVAL; 
        WSSOUT2(F4DREL4,70);       # WRITE WORD OF ZEROS TO END LIST   #
        END 
                                                                        002480
      RETURN; 
CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#                            CONVORDNUM                                #
#                                                                      #
#     CONVERTS BINARY ORDINAL NUMBERS TO DISPLAY DECIMAL               #
#                                                                      #
#**********************************************************************#
  PROC CONVORDNUM(ONUM);     # CONVERTS THE BINARY ORDINAL NUMBER TO   #
    BEGIN                    # DISPLAY DECIMAL.                        #
      ITEM ONUM;             # CONTAINS THE BINARY ORDINAL NUMBER.     #
      ITEM C1,C2;            # SCRATCH VARIABLES.                      #
      ORDNUM = "          ";
      FOR C1 = 9 STEP -1 UNTIL 7 DO 
        BEGIN 
        C2 = ONUM/10; 
        C<C1>ORDNUM = ONUM - C2 * 10 + O"33"; 
        ONUM = C2;
        END 
      RETURN; 
    END 
    END 
    TERM; 
