*DECK DB$BALR 
USETEXT BRGENTX 
      PROC DB$BALR; 
      BEGIN 
 #
* *   DB$BALR -                                  PAGE  1
* *   ALLOCATE THE RESTART IDENTIFIER FILE
* *   E. P. JOHNSON                              DATE  03/26/81 
* * 
* 
* DC  PURPOSE 
* 
*     TO ALLOCATE THE RESTART IDENTIFIER FILE.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
* 
*     NONE
* 
*     ASSUMPTIONS 
* 
*     MDSCDIR                MD SCHEMA DIRECTORY TABLE HAS BEEN READ IN.
*     MDSCINFO               MD SCHEMA INFORMATION TABLE HAS BEEN 
*                            READ IN. 
*     SDTINDEX               INDEX INTO THE SCHEMA DIRECTORY TABLE
*                            IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL - THE FILE HAS BEEN ALLOCATED WITHOUT ERROR. 
* 
*     ABNORMAL - ONE OF THE FOLLOWING ERRORS HAS OCCURRED:  
* 
*               (1) IF THE FILE WAS NOT SUCCESSFULLY ATTACHED, THEN 
*                  ISSUE ERROR MESSAGE DFERR05, AND RETURN TO 
*                  THE CALLER.
* 
*               (2) IF AN ERROR OCCURRED DURING THE OPEN OF THE 
*                  FILE, THEN ISSUE ERROR MESSAGE DFERR06, RETURN THE 
*                  FILE AND RETURN TO THE CALLER. 
* 
*               (3) IF AN ERROR OCCURRED WHILE WRITING THE HEADER 
*                  RECORD, THEN ISSUE ERROR MESSAGE DFERR07.
* 
*               (4) IF AN ERROR OCCURRED DURING THE CLOSE OF THE FILE,
*                  THEN ISSUE ERROR MESSAGE DFERR08 AND RETURN THE FILE.
* 
* DC  CALLING ROUTINES
* 
*     DB$BALL                ALLOCATE DIRECTIVE 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC CLOCK C(10);           # OBTAIN SYSTEM TIME.           #
      XREF PROC CLOSEM;                # CRM CLOSE - FTN INTERFACE.    #
      XREF FUNC DATE C(10);            # OBTAIN SYSTEM DATE.           #
      XREF PROC DB$ATWR;               # ATTACH PROCESSOR.             #
      XREF PROC DB$BERR;               # DBREC ERROR PROCESSOR.        #
      XREF PROC DB$BURP;               # USER REPORT GENERATOR.        #
      XREF FUNC DB$CDIS C(10);         # CONVERT NUMBER TO DISPLAY CODE#
      XREF PROC DB$RA0;                # PARAMETER LIST TERMINATOR.    #
      XREF PROC DB$RTN;                # CIO RETURN.                   #
      XREF PROC OPENM;                 # CRM OPEN - FTN INTERFACE.     #
      XREF PROC PUT;                   # CRM PUT - FTN INTERFACE.      #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
* 
*     FIT                    THE FIT USED FOR RIF I/0.
*     INSERTITEMI            SPECIAL MESSAGE TEXT FORMATTER INTEGER 
*                            INSERTION ITEM.
*     P<MDPIT>               PERMANENT FILE INFORMATION TABLE BASED 
*                            ARRAY POINTER. 
* 
* DC  DESCRIPTION 
* 
*     - SET THE BASED ARRAY POINTER OF THE RESTART IDENTIFIER 
*       PERMANENT FILE INFORMATION TABLE. 
* 
*     - TRY TO ATTACH THE FILE. 
* 
*     - IF THE FILE WAS NOT SUCCESSFULLY ATTACHED, THEN ISSUE AN
*       ERROR MESSAGE AND RETURN TO THE CALLER. 
* 
*     - INITIALIZE THE FIT USING THE MODEL RESTART IDENTIFIER FILE FIT. 
* 
*     - OPEN THE FILE.
* 
*     - IF AN ERROR OCCURRED DURING THE OPEN OF THE FILE, THEN
*       ISSUE AN ERROR MESSAGE, RETURN THE FILE AND RETURN TO 
*       THE CALLER. 
* 
*     - INITIALIZE THE HEADER RECORD. 
* 
*     - WRITE THE RECORD TO THE FILE. 
* 
*     - IF AN ERROR OCCURRED WHILE WRITING THE HEADER RECORD, THEN
*       ISSUE AN ERROR MESSAGE, SET THE ERROR FLAG, AND RESET THE 
*       FITES AND FITFNF FIELDS.
* 
*     - CLOSE AND RETURN THE FILE.
* 
*     - IF AN ERROR OCCURRED DURING THE CLOSE OF THE FILE, THEN 
*       ISSUE AN ERROR MESSAGE, RETURN THE FILE AND SET THE ERROR FLAG. 
* 
*     - IF THE ALLOCATION OF THE FILE WAS ERROR FREE, THEN PRINT A
*       SUCCESSFUL ALLOCATION MESSAGE ON THE DBREC OUTPUT FILE. 
* 
*     - RETURN TO THE CALLER. 
* 
 #
  
# LOCAL VARIABLES.                                                     #
  
      ITEM ATTACHSTATUS I;             # STATUS OF THE ATTACH.         #
      ITEM DATETIME C(10);             # FOR SYSTEM DATE AND TIME      #
                                       # REQUEST.                      #
      ITEM ERRFLG B = FALSE;           # ERROR FLAG.                   #
      ITEM INDEX  I;                   # LOOP VARIABLE.                #
  
      DEF DFDBREC #"DBREC     "#; 
      DEF DFNEW #O"16052700000000000000"#;
      DEF DFRETURN #O"22052400000000000000"#; 
      DEF DFRIDRL #60#;                # RESTART IDENTIFIER FILE       #
                                       # RECORD LENGTH.                #
  
  
      ARRAY RDREC [0:0] S(6); 
*CALL RSTIDDCLS 
  
# EXTERNALLY REFERENCED ARRAYS.                                        #
  
      XREF ARRAY DB$RFIT;              # MODEL RESTART IDENTIFIER FIT. #
        BEGIN 
        ITEM RDFITWD U(00,00,60); 
        END 
  
  
# S T A R T   O F   D B $ B A L R   E X E C U T A B L E   C O D E      #
  
  
# SET THE BASED ARRAY POINTER OF THE RESTART IDENTIFIER                #
# PERMANENT FILE INFORMATION TABLE.                                    #
  
      P<MDPIT> = LOC(MDSCINFO) + MDSIRIFP[0]; 
  
# TRY TO ATTACH THE FILE.                                              #
  
      DB$ATWR(B<0,42>MDPITNAME[0],MDPIT,ATTACHSTATUS);
  
# IF THE FILE WAS NOT SUCCESSFULLY ATTACHED, THEN ISSUE AN ERROR       #
# MESSAGE AND RETURN TO THE CALLER.                                    #
  
      IF ATTACHSTATUS NQ 0
      THEN
        BEGIN 
        INSERTITEMI = ATTACHSTATUS; 
        DB$BERR(DFERR05); 
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# INITIALIZE THE FIT USING THE MODEL RESTART IDENTIFIER FILE FIT.      #
  
      FOR INDEX = DFFITSIZE - 1 STEP - 1 UNTIL 0
      DO
        BEGIN 
        FITFW[INDEX] = RDFITWD[INDEX];
        END 
  
      FITLFN[0] = MDPITNAME[0]; 
      FITWSA[0] = LOC(RDREC); 
      FITKA[0] = LOC(RDID[0]);
      FITKL[0] = DFRIFKL; 
      FITRL[0] = DFRIDRL; 
  
# OPEN THE FILE.                                                       #
  
      OPENM(FIT,DFNEW,DB$RA0);
  
# IF AN ERROR OCCURRED DURING THE OPEN OF THE FILE, THEN ISSUE         #
# AN ERROR MESSAGE, RETURN THE FILE AND RETURN TO THE CALLER.          #
  
      IF FITES[0] NQ 0
      THEN
        BEGIN 
        DB$BERR(DFERR06); 
        DB$RTN(FITLFN[0]);
        RETURN;                        # RETURN TO THE CALLER.         #
  
        END 
  
# INITIALIZE THE HEADER RECORD.                                        #
  
      RDID[0] = "          "; 
      RDDATE[0] = DATE(DATETIME); 
      RDTIME[0] = CLOCK(DATETIME);
      RDJOBNAM[0] = DB$CDIS(MDSCIDNT[SDTINDX],10,10," "); 
      RDUSERID[0] = DFDBREC;
      RDTID[0] = " "; 
  
# WRITE THE HEADER RECORD TO THE FILE.                                 #
  
      PUT(FIT,DB$RA0);
  
# IF AN ERROR OCCURRED WHILE WRITING THE HEADER RECORD, THEN ISSUE     #
# AN ERROR MESSAGE, SET THE ERROR FLAG, AND RESET THE FITES AND        #
# FITFNF FIELDS.                                                       #
  
      IF FITES[0] NQ 0
      THEN
        BEGIN 
        DB$BERR(DFERR07); 
        ERRFLG = TRUE;
        FITES[0] = 0; 
        FITFNF[0] = FALSE;
        END 
  
# CLOSE AND RETURN THE FILE.                                           #
  
      CLOSEM(FIT,DFRETURN,DB$RA0);
  
# IF AN ERROR OCCURRED DURING THE CLOSE OF THE FILE, THEN ISSUE        #
# AN ERROR MESSAGE, RETURN THE FILE AND SET THE ERROR FLAG.            #
  
      IF FITES[0] NQ 0
      THEN
        BEGIN 
        DB$BERR(DFERR08); 
        DB$RTN(FITLFN[0]);
        ERRFLG = TRUE;
        END 
  
# IF THE ALLOCATION OF THE FILE WAS ERROR FREE, THEN PRINT A           #
# SUCCESSFUL ALLOCATION MESSAGE ON THE DBREC OUTPUT FILE.              #
  
      IF NOT ERRFLG 
      THEN
        BEGIN 
        DB$BURP(DFURP05); 
        END 
  
# RETURN TO THE CALLER.                                                #
  
      RETURN; 
  
      END 
      TERM
