*DECK DMLINV                                                            000220
      PROC DMLINV (NUMREALMS,FIRSTFIT,SSNAME1,SSNAME2,SSNAME3,CHECKSUM); F44B 
      BEGIN                                                             000240
 #
* *   DMLINV - INVOKE INTERFACE ROUTINE 
*     R. E. FOX                                      11/29/77 
* 
* DC  PURPOSE 
* 
*     ISSUE AN INVOKE OR SUBINVOKE REQUEST TO CDCS
* 
* DC  ENTRY CONDITIONS
* 
* DC  PARAMETERS
* 
*     NUMREALMS  --  NUMBER OF REALMS IN SUBSCHEMA
*     FIRSTFIT  --  ADDRESS OF FIT FOR REALM 1
*     SSNAME1  --  CHARS 1-10 OF SUBSCHEMA NAME 
*     SSNAME2  --  CHARS 11-20 OF SUBSCHEMA NAME
*     SSNAME3  --  CHARS 21-30 OF SUBSCHEMA NAME
*     DATETIME  --  DATE/TIME OF SUBSCHEMA COMPILATION
* 
* 
* DC  ASSUMPTIONS 
* 
*     COMMON BLOCK DB0000 HAS BEEN GENERATED AND INITIALIZED
* 
* 
* DC  EXIT CONDITIONS 
* 
*     UPON RETURN FROM CDCS FOR AN INVOKE, THE INVOKE FLAG IS 
*     SET TO TRUE AND CONTROL IS RETURNED TO THE APPLICATION PROGRAM. 
*     IN INVOKE, AN EXTERNAL ITEM IS SET TO INDICATE THE FTN VERSION. 
*     FOR A SUBINVOKE, CONTROL IS RETURNED TO THE PROGRAM.
*     IF AN ERROR OCCURS, CDCS DOES NOT RETURN CONTROL TO THIS ROUTINE. 
* 
* DC  CALLING ROUTINES
* 
*     DMLINV IS CALLED FROM THE APPLICATION PROGRAM 
*     AS A RESULT OF A DML INVOKE STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     DB$INV  --     CDCS INVOKE INTERFACE ROUTINE
* 
*     DB$INVS  --  CDCS SUBINVOKE INTERFACE ROUTINE 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     ARRAY DBTXXXX IS SET TO CONTAIN THE APPROPRIATE 
*     INFORMATION FOR EACH FIT. 
*     THE INVOKE FLAG (INVFLAG) IS SET TO TRUE. 
*     FOR A SUBINVOKE, THE KEY ADDRESS IS RESTORED IN EACH FIT
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLINV IS GENERATED BY THE PREPASS AS 
*     A RESULT OF A DML INVOKE STATEMENT.  IF THE INVOKE FLAG IS TRUE,
*     THE KEY ADDRESS IS RESTORED IN EACH FIT AND 
*     THE CDCS SUBINVOKE ROUTINE IS CALLED TO VERIFY THAT 
*     THE SAME SUBSCHEMA IS BEING USED IN EACH SUBPROGRAM.
*     FOR THE FIRST INVOKE (INVOKE FLAG IS FALSE), THE SAVE AREA FOR
*     EACH FIT FIELD IS SET TO THE INFORMATION IN EACH FIT, AND THE 
*     CDCS INVOKE ROUTINE IS CALLED TO CONNECT THE PROGRAM TO CDCS. 
*     UPON RETURN FROM CDCS, THE INVOKE FLAG IS SET TO TRUE AND 
*     CONTROL IS RETURNED TO THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;                                                    000250
      CONTROL DISJOINT;                                                 000260
      CONTROL INERT;                                                    000270
                                                                        000280
#     DEFS                                                             #000290
      DEF FITSIZE #35#;          # SIZE OF FIT IN WORDS                #000300
      DEF F4      #8#;           # FORTRAN VERSION 4                   #
      DEF F5      #9#;           # FORTRAN VERSION 5                   #
                                                                        000310
# THE FOLLOWING ARE PARAMETERS FROM THE CALLING SEQUENCE               #000320
                                                                        000330
      ITEM NUMREALMS;            # NUMBER OF REALMS IN SS              #000340
      ITEM FIRSTFIT;             # FIT FOR REALM 1                     #000350
      ITEM SSNAME1 C(10);        # SSNAME - CHARS 1-10 - BLANK FILL    #001000
      ITEM SSNAME2 C(10);        # SSNAME - CHARS 10-20                #001010
      ITEM SSNAME3 C(10);        # SSNAME - CHARS 20-30                #001020
      ITEM CHECKSUM U;           # SUB-SCHEMA CHECKSUM                 # F44B 
                                                                        000360
      BASED ARRAY FIT;           # MAP OF FIT                          #000370
*CALL FITDCLS                                                           000380
                                                                        000390
                                                                        000400
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #000410
# PROGRAM                                                              #000420
                                                                        000430
      COMMON DB0000;                                                    000440
*CALL DB0DCLS                                                           000450
      XREF                                                              000460
        BEGIN                                                           000470
          PROC DB$INV;           # INVOKE INTERFACE RTN              #  000480
          PROC DB$INVS;          # SUB-INVOKE INTERFACE ROUTINE        #001050
      ITEM VERCALL B ;             # FLAG TO INDICATE CALL BY DMLINV   #
      ITEM INVER B;                # FLAG TO INDICATE VERSION SUBINVOKE#
        END                                                             000490
  
                                 #--------------XDEFS------------------#
      XDEF
        BEGIN 
        ITEM FTNVER;             # FORTRAN VERSION (8=FTN4, 9=FTN5)    #
        ITEM INVFLAG B = FALSE;  # SET TRUE AFTER CDCS IS INVOKED      #
                                 # SET FALSE BY DMLEND AFTER TERMINATE #001080
                                 # LOCAL VARIABLES                     #000491
        ITEM SSNAME30 C(30);       # HOLDS SUBSCHEMA NAME              #
        END 
  
  
      ITEM FITPTR;               # PTR TO ADDRESS FITS                 #000492
      ITEM FIRSTINV B = TRUE;    # FIRST TIME INVOKED                  #
      ITEM I;                    # TEMPORARY VARIABLE                  #000493
      CONTROL EJECT;                                                    000500
                                                                        001120
                                 # SET UP SS NAME PARM FOR CDCS        #001130
      C<0,10>SSNAME30 = SSNAME1;                                        001140
      C<10,10>SSNAME30 = SSNAME2;                                       001150
      C<20,10>SSNAME30 = SSNAME3;                                       001160
                                 # IF CDCS HAS ALREADY BEEN INVOKED,   #001170
                                 # JUST DO SUB-INVOKE                  #001180
      IF INVFLAG                                                        001190
      OR INVER
      THEN                                                              001200
        BEGIN                                                           001210
                                 # RESTORE VALUE OF KA IN EACH FIT     #
#     SET UP POINTER TO FIT AND SAVE AREA FOR FIT FIELDS               #
          FITPTR = LOC(FIRSTFIT);# START WITH FIRST FIT                #
          P<FIT> = FITPTR;
          P<DBTXXXX> = FITPTR + FITSIZE;
          FOR I = 1 STEP 1 UNTIL NUMREALMS DO 
            BEGIN 
              FITKA = DBKA; 
              FITPTR = FITPTR + FITSIZE +6; # POINT TO NEXT FIT        #
              P<FIT> = FITPTR;
              P<DBTXXXX> = FITPTR + FITSIZE; # POINT TO NEXT SAVE AREA #
            END 
                 IF NOT VERCALL    # NOT CALLED BY DMLINVV             #
                 THEN              # DO CDCS SUBINVOKE                 #
                                 # PERFORM SUB-INVOKE                  #
                 DB$INVS(SSNAME30, DBSCNAM, DBRUID, CHECKSUM);
                                 # IF SUB-INVOKE ERROR, CDCS ISSUES    #001230
                                 # MESSAGE AND ABORTS USER JOB         #001240
          RETURN;                # RETURN TO USER PROGRAM              #001250
        END                                                             001260
                                                                        000510
# SET UP POINTER TO FIT AND SAVE AREA FOR FIT FIELDS                   #000520
                                                                        000530
      FITPTR = LOC(FIRSTFIT);    # START WITH FIRST FIT                #000540
      P<FIT> = FITPTR;                                                  000550
      P<DBTXXXX> = FITPTR + FITSIZE;                                    000560
      P<REALMBLOCK> = FITPTR - 4;                                       000350
                                                                        000570
  
                                 # RECORD FORTRAN VERSION              #
      IF FIRSTINV THEN           # ON THE FIRST INVOKE                 #
        BEGIN 
        IF DBVER EQ "FT5" 
        THEN
          FTNVER = F5;
        ELSE
          FTNVER = F4;           # IF NOT FTN 5 ASSUME FTN 4           #
  
        B<0,60>DBVER = 0;        # ZERO OUT FTN VERSION                #
        END 
                                                                        000630
# COPY FIT FIELDS TO SAVE AREA FOR EACH FIT IN SUBSCHEMA               #000640
                                                                        000650
      FOR I = 1 STEP 1 UNTIL NUMREALMS DO                               000660
        BEGIN                                                           000670
          IF FIRSTINV THEN
            BEGIN 
            DBMRL = FITMRL; 
            DBKEYFIELDS = FITKEYFIELDS; 
            DBWSA = FITWSA; 
            DBKA = FITKA; 
            DBKT = FITKT; 
            B<0,42>FITFW = C<0,7>DBRXXXX; 
            END 
                                                                        000750
# BLOCK FOR EACH REALM CONTAINS FIT + 6 WORDS FOR REALM                #000760
# NAME, ERROR STATUS, AND SAVE AREA.                                   #000770
          FITPTR = FITPTR + FITSIZE + 6;  # POINT TO NEXT FIT          #000780
          P<FIT> = FITPTR;                                              000790
          P<DBTXXXX> = FITPTR + FITSIZE; # POINT TO NEXT SAVE AREA     #000800
          P<REALMBLOCK> = FITPTR - 4;                                   000390
                                                                        000810
        END                                                             000820
      FIRSTINV = FALSE; 
                                                                        000830
# PERFORM INVOKE CALL TO CDCS                                          #000840
  
      IF NOT VERCALL             # NOT CALLED BY DMLINVV               #
      THEN                       # DO CDCS INVOKE                      #
        BEGIN 
          DB$INV(SSNAME30, DBSCNAM, DBRUID, CHECKSUM);
          INVFLAG = TRUE;        # SET TRUE TO INDICATE CDCS INVOKE    #
        END 
                                                                        000860
# IF THERE IS AN INVOKE ERROR, CDCS WRITES A MESSAGE TO                #000870
# THE DAYFILE AND ABORTS THE USER JOB.                                 #000880
                                                                        000890
      RETURN;                                                           000900
      END                                                               000910
TERM                                                                    000920
