*DECK DMLUNL                                                            000560
      PROC DMLUNL (FIT,REALMORD,ERRRTRN); 
  BEGIN                                                                 000580
 #
* *   DMLUNL - UNLOCK INTERFACE ROUTINE 
*     W. REHLING                                      10/25/77
* 
* DC  PURPOSE 
* 
*     ISSUE AN UNLOCK REQUEST TO CDCS AND 
*     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
* 
*     FIT  --    APPLICATION PROGRAM FIT FOR REALM
* 
*     REALMORD  --  ORDINAL OF REALM TO BE UNLOCKED 
* 
*     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 THE DML STATEMENT. 
*     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
* 
*     DMLUNL IS CALLED FROM THE APPLICATION PROGRAM 
*     AS A RESULT OF A DML UNLOCK STATEMENT.
* 
* DC  CALLED ROUTINES 
* 
*     DB$UNLK  --     CDCS UNLOCK INTERFACE ROUTINE 
* 
*     DMLRTRN  --  RETURN ROUTINE--SETS REGISTER TO RETURN PARAMETER
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     DBSTAT, DBSXXXX, DBREALM
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLUNL IS GENERATED BY THE PREPASS AS 
*     A RESULT OF A DML UNLOCK STATEMENT. DMLUNL ISSUES THE UNLOCK
*     REQUEST TO CDCS, 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 THE SPECIFIED LABEL 
*     IN THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;                                                    000590
      CONTROL DISJOINT;                                                 000600
      CONTROL INERT;                                                    000610
                                                                        000620
                                        #-------------DEFS-------------#
  
      DEF FITSIZE     # 35 #;           # SIZE OF FIT IN WORDS         #000650
                                                                        000660
# THE FOLLOWING ARE PARAMETERS FROM THE "UNLOCK" CALLING SEQUENCE      #000670
                                                                        000680
      ARRAY FIT;                 # USER FIT                            #000690
*CALL FITDCLS                                                           000700
                                                                        000710
      ITEM REALMORD;                        # REALM ORDINAL            #000720
  
      ITEM ERRRTRN;                         # ERROR RETURN PARAMETER   #
                                            # WARNING: DO NOT REFERENCE#
                                                                        000730
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #000740
#     PROGRAM                                                          #000750
                                                                        000760
      COMMON DB0000;                                                    000770
*CALL DB0DCLS                                                           000780
                                                                        000790
                                        #------------XREFS-------------#
  
      XREF
        BEGIN 
        PROC DB$UNLK;                   # UNLOCK INTERFACE ROUTINE     #
        PROC DMLRTRN;                   # SET RETURN REGISTER ROUTINE  #
        END 
  
                                        #----------LOCAL ITEMS---------#
  
      ITEM RTNPARM;                     # RETURN PARAMETER - DMLRTRN   #
  
      CONTROL EJECT;                                                    000830
                                                                        000840
# SET UP POINTER TO REALMBLOCK   #                                      000850
      P<REALMBLOCK> = LOC(FIT) - 4;                                     000860
                                                                        000870
# ISSUE UNLOCK REQUEST PASSING THE FIT AND REALM ORDINAL               #000880
                                                                        000890
      DB$UNLK(FIT,REALMORD);                                            000900
                                                                        000910
# RETURN ERROR STATUS FIELD OF FIT                                     #000920
                                                                        000930
      DBSTAT = FITES[0];                                                000940
      DBSXXXX = FITES[0];                                               000650
      DBREALM = DBRXXXX;                                                000660
                                                                        000970
# CHECK ERROR STATUS ON CDCS CALL                                      #
  
      IF (FITES[0] NQ 0)                # IF CDCS/CRM ERROR OCCURRED   #
      THEN
        RTNPARM = 1;                    # SET THE RETURN PARAMETER TO 1#
      ELSE                              #             ELSE             #
        RTNPARM = 0;                    # SET THE RETURN PARAMETER TO 0#
  
# SET THE RETURN REGISTER                                              #
  
      DMLRTRN(RTNPARM); 
  
# RETURN TO THE APPLICATION PROGRAM                                    #
  
      RETURN;                                                           000980
      END                                                               000990
TERM                                                                    001000
