*DECK DMLOPNR 
      PROC DMLOPNR (FITLIST,REALMORDLIST,MODE,ERRRTRN); 
  
 #
* *   DMLOPNR - OPEN RELATION INTERFACE ROUTINE 
*     J. G. SERPA                                      10/15/78 
* 
* DC  PURPOSE 
* 
*     ISSUE AN OPEN RELATION REQUEST TO CDCS
*     CHECK FOR AN ERROR CONDITION UPON RETURNING FROM CDCS.
*     ON ERROR, CAUSES A BRANCH TO AN ALTERNATE RETURN IN THE 
*     APPLICATION PROGRAM IF SPECIFIED, ELSE, RETURNS NORMALLY. 
*     RETURN THE FIT STATUS FIELD TO THE APPLICATION PROGRAM
* 
* DC  ENTRY CONDITIONS
* 
* DC  PARAMETERS
* 
*     FITLIST  -- FITLIST FOR RELATION TO BE OPENED 
* 
*     REALMORD -- LIST OF REALM ORDINALS IN RELATION TO BE OPENED 
* 
*     MODE     -- MODE IN WHICH THE RELATION IS TO BE OPENED
* 
*     ERRRTRN  --  (OPTIONAL) ALTERNATE RETURN ON ERROR (FTN 5 ONLY)
*                  WARNING:  DO NOT REFERENCE - MAY NOT BE PRESENT
* 
* DC  ASSUMPTIONS 
* 
*     COMMON BLOCK DB0000 HAS BEEN GENERATED AND INITIALIZED
* 
* 
* DC  EXIT CONDITIONS 
* 
*     UPON RETURN FROM CDCS, THE FIT ES FIELD IS STORED 
*     IN DBSTAT AND IN DBSXXXX AND DBREALM IS SET TO THE
*     NAME OF THE REALM IN WHICH AN ERROR OCCURRED, IF ANY. 
*     CONTROL IS RETURNED TO THE APPLICATION PROGRAM. 
*     THE RETURN POINT CAN BE ALTERED GIVEN AN *ON ERROR* 
*     LABEL AND THE DETECTION OF AN ERROR (FTN 5 ONLY). 
* 
* DC  CALLING ROUTINES
* 
*     DMLOPNR IS CALLED FROM THE APPLICATION PROGRAM
*     AS A RESULT OF A DML OPEN RELATION STATEMENT. 
* 
* DC  CALLED ROUTINES 
* 
*     DB$OPN  --     CDCS OPEN INTERFACE ROUTINE
* 
*     DMLRTRN  --  RETURN ROUTINE--SETS REGISTER TO RETURN PARAMETER
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB000 WHICH ARE MODIFIED ARE:    
*     DBSTAT, DBSXXXX, DBREALM
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLOPNR IS GENERATED BY THE PREPASS AS
*     A RESULT OF A DML OPEN RELATION STATEMENT. DMLOPNR
*     ISSUES THE OPEN REQUEST TO CDCS FOR EACH REALM IN THE 
*     FITLIST. RETURNS THE FIT STATUS FIELDS TO THE 
*     APPLICATION PROGRAM, AND RETURNS CONTROL TO THE 
*     APPLICATION PROGRAM.  WITH FORTRAN 5, AN ALTERNATE RETURN CAN BE
*     SPECIFIED.  IF AN ERROR IS DETECTED, CONTROL IS PASSED TO THIS
*     SPECIFIED LABEL IN THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;
      CONTROL INERT;
      CONTROL DISJOINT; 
  
                                   #---------------DEFS----------------#
  
      DEF RDNTOPN    #O"652"#;     # REDUNDANT OPEN CODE - CDCS        #
      DEF  FITLENGTH # 35#;        # LENGTH OF FIT IN WORDS            #
      DEF  WC        # 10#;        # LENGTH OF WORD IN CHARACTERS      #
  
#     PARAMETERS FROM THE "OPEN" CALLING SEQUENCE                      #
  
      ARRAY FITLIST;               # CONTAINS A LIST OF FIT ADDRESSES  #
          ITEM FITADDR ;           # OF REALMS IN RELATION             #
  
      ARRAY REALMORDLIST;          # CONTAINS ORDINALS OF REALMS       #
          ITEM REALMORD;           # IN RELATION                       #
  
      ITEM MODE C(WC);             # OPEN MODE                         #
                                   #    I - INPUT ONLY                 #
                                   #   IO - INPUT-OUTPUT               #
                                   #    O - OUTPUT ONLY - DISALLOWED   #
                                   #        FOR RELATIONS              #
  
      ITEM ERRRTRN;                # ERROR RETURN PARAMETER            #
                                   # WARNING: DO NOT REFERENCE         #
  
#     THE FOLLOWING COMMON BLOCK DESCRIBES VARIABLES CREATED IN THE    #
#     FORTRAN APPLICATIONS PROGRAM.                                    #
  
      COMMON DB0000;
*CALL DB0DCLS                      COMMOM BLOCK DB0000 DECLARATIONS 
  
      BASED ARRAY FIT [0:0] S(FITLENGTH);   # USER FIT                 #
  
*CALL FITDCLS                      STANDARD FIT DECLARATIONS
  
      STATUS PD              # VALUES FOR FITPD                        #
          ,                  # NULL                                    #
             INPUT           # INPUT ONLY                              #
          ,  OUTPUT          # OUTPUT ONLY                             #
          ,  IO              # INPUT-OUTPUT                            #
      ; 
  
                                        #------------XREFS-------------#
      XREF
        BEGIN 
        PROC DB$OPN;                    # OPEN INTERFACE ROUTINE       #
        PROC DMLRTRN;                   # SET RETURN REGISTER ROUTINE  #
        END 
  
                             #---------------LOCAL ITEMS---------------#
  
      ITEM RTNPARM;          # RETURN PARAMETER - DMLRTRN              #
      ITEM I;                # DUMMY INDEX VARIABLE                    #
      ITEM TEMPPD S:PD;      # CONTAINS FITPD EQUIVALENT TO MODE       #
  
      CONTROL EJECT;
  
      BEGIN 
  
#     STORE USER SPECIFIED MODE IN TEMPPD                              #
  
      IF MODE EQ "IO" 
      THEN TEMPPD = S"IO";
      ELSE IF MODE EQ "I" 
           THEN TEMPPD  = S"INPUT"; 
  
#     ISSUE DB$OPN CALLS FOR EACH REALM IN THE FITLIST                 #
      FOR I = 0 STEP 1 WHILE FITADDR[I] NQ 0 DO 
          BEGIN 
          P<FIT> = FITADDR[I];
          FITPD[0] = TEMPPD;
          DB$OPN (FIT, REALMORD[I]);
  
          IF FITES[0] EQ RDNTOPN        # IF REDUNDANT OPEN OCCURS     #
          THEN
            FITES[0] = 0;               # IGNORE IT                    #
  
          IF FITES[0] NQ 0                # OPEN NOT SUCCESSFUL        #
          THEN BEGIN
               DBSTAT = FITES[0];         # SET DBSTAT                 #
               P<REALMBLOCK> = FITADDR[I] - 4;
               DBREALM = DBRXXXX[0];
               DBSXXXX[0] = DBSTAT; 
               RTNPARM = 1;             # SET THE RETURN PARAMETER TO 1#
  
               DMLRTRN(RTNPARM);        # SET RETURN REGISTER TO ERROR #
  
               RETURN;                  # RETURN TO APPLICATION PGRM   #
  
               END
          END 
      DBSTAT = 0; 
      DBREALM = " ";
      RTNPARM = 0;                      # SET THE RETURN PARAMETER TO 0#
  
      DMLRTRN(RTNPARM);                 # SET RETURN REGISTER TO NORMAL#
  
      RETURN;                           # RETURN TO APPLICATION PGRM   #
  
      END 
      TERM
