*DECK DMLRD                                                             001360
      PROC DMLRD (FIT,REALMORD,ERRFLAG,ENDFLAG,ERRRTRN,ENDRTRN);
  BEGIN                                                                 001380
 #
* *   DMLRD - READ SEQUENTIAL INTERFACE ROUTINE 
*     R. E. FOX                                      4/25/77
* 
* DC  PURPOSE 
* 
*     ISSUE A READ SEQUENTIAL REQUEST TO CDCS AND 
*     RETURN THE FIT STATUS FIELD TO THE APPLICATION PROGRAM
*     CHECK FOR AN ERROR OR EOF CONDITION UPON RETURNING FROM CDCS. 
*     IF ENCOUNTERED, CAUSES A BRANCH TO AN ALTERNATE RETURN IN THE 
*     APPLICATION PROGRAM IF SPECIFIED, ELSE, RETURNS NORMALLY. 
* 
* DC  ENTRY CONDITIONS
* 
* DC  PARAMETERS
* 
*     FIT  --    APPLICATION PROGRAM FIT FOR REALM TO BE READ 
* 
*     REALMORD  -- ORDINAL OF THE REALM TO BE READ
* 
*     ERRFLAG  --  ERR PARAMETER FLAG (FTN 5 ONLY)
* 
*     ENDFLAG  --  EOF PARAMETER FLAG (FTN 5 ONLY)
* 
*     ENDRTN  --  (OPTIONAL) ALTERNATE RETURN ON EOF (FTN 5 ONLY) 
*                  WARNING:  DO NOT REFERENCE - MAY NOT BE PRESENT
* 
*     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
*     FIT SAVE AREAS HAVE BEEN 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* OR *ON END* 
*     LABEL AND THE DETECTION OF SUCH A CONDITION (FTN 5 ONLY). 
* 
* DC  CALLING ROUTINES
* 
*     DMLRD IS CALLED FROM THE APPLICATION PROGRAM
*     AS A RESULT OF A DML READ SEQUENTIAL STATEMENT. 
* 
* DC  CALLED ROUTINES 
* 
*     DB$RD1  --     CDCS READ SEQUENTIAL INTERFACE ROUTINE 
* 
*     DMLRTRN  --  RETURN ROUTINE--SETS REGISTER TO RETURN PARAMETER
* 
* DC  NON-LOCAL VARIABLES 
* 
*     VARIABLES IN DB0000 WHICH ARE MODIFIED ARE: 
*     DBSTAT, DBSXXXX, DBREALM
*     THE WSA, RL, AND MRL FIELDS IN THE FIT ARE RESTORED TO
*     THE VALUES IN THE FIT SAVE AREA.
*     DMLINV CHECKS DBT0001 WHICH CONTAINS A VALUE SPECIFYING THE 
*     FORTRAN VERSION. THIS VALUE IS PASSED ON TO DMLRD IN *FTNVER*.
* 
* DC  DESCRIPTION 
* 
*     A CALL TO DMLRD IS GENERATED BY THE PREPASS AS
*     A RESULT OF A DML READ SEQUENTIAL STATEMENT. DMLRD RESTORES THE 
*     APPROPRIATE FIT FIELDS TO THE VALUES STORED IN THE FIT SAVE AREA
*     AND ISSUES THE READ SEQUENTIAL REQUEST TO CDCS. 
*     UPON RETURN FROM CDCS, THE FIT END OF INFORMATION FLAG IS CHECKED 
*     FOR END OF FILE STATUS.  IF THE FLAG IS TRUE, THE CRM END OF FILE 
*     CODE IS RETURNED IN THE STATUS FIELDS. IN ALL OTHER CASES, THE
*     FIT STATUS FIELD IS RETURNED AND CONTROL IS RETURNED TO THE 
*     APPLICATION PROGRAM.  WITH FORTRAN 5, AN ALTERNATE RETURN CAN BE
*     SPECIFIED.  IF AN EOF OR ERROR CONDITION IS DETECTED, CONTROL IS
*     PASSED TO THE SPECIFIED LABEL IN THE APPLICATION PROGRAM. 
* 
 #
      CONTROL EJECT;                                                    001390
      CONTROL DISJOINT;                                                 001400
      CONTROL INERT;                                                    001410
                                                                        001420
                                        #-------------DEFS-------------#
  
      DEF F4          #8#;              # FORTRAN VERSION 4            #
      DEF F5          #9#;              # FORTRAN VERSION 5            #
      DEF FITSIZE     #35#;             # SIZE OF FIT IN WORDS         #001450
      DEF EOFCODE #O"100"#;                                             000580
                                                                        001460
# THE FOLLOWING ARE PARAMETERS FROM THE "READ" CALLING SEQUENCE        #001470
                                                                        001480
      ARRAY FIT;                 # USER FIT                            #001490
*CALL FITDCLS                                                           001500
                                                                        001510
      ITEM REALMORD;                        # REALM ORDINAL            #001520
  
      ITEM ERRRTRN;                         # ERROR RETURN PARAMETER   #
                                            # WARNING: DO NOT REFERENCE#
  
      ITEM ENDRTRN;                         # END RETURN PARAMETER     #
                                            # WARNING: DO NOT REFERENCE#
                                                                        001530
# THE FOLLOWING DESCRIBES THE COMMON BLOCK CREATED IN THE FORTRAN      #001540
#     PROGRAM                                                          #001550
                                                                        001560
      COMMON DB0000;                                                    001570
*CALL DB0DCLS                                                           001580
                                                                        001590
                                        #------------XREFS-------------#
  
      XREF
        BEGIN 
        ITEM FTNVER;                    # FORTRAN VERSION              #
        PROC DB$RD1;                    # READ INTERFACE ROUTINE       #
        PROC DMLRTRN;                   # SET RETURN REGISTER ROUTINE  #
        END 
  
                                        #----------LOCAL ITEMS---------#
  
      ITEM ERRFLAG B;                   # ERROR RTRN PARAMETER FLAG    #
      ITEM ENDFLAG B;                   # EOF RTRN PARAMETER FLAG      #
      ITEM RTNPARM I;                   # RETURN PARAMETER - DMLRTN    #
      CONTROL EJECT;                                                    001640
                                                                        001650
# RESET FLAGS AND POINTERS                                             #
  
      RTNPARM = 0;
  
# SET UP POINTER TO REALMBLOCK   #                                      001660
                                                                        001670
      P<REALMBLOCK> = LOC(FIT) - 4;                                     001680
      P<DBTXXXX> = LOC(FIT) + FITSIZE;                                  000460
      FITWSA[0] = DBWSA[0];                                             000470
      FITRL[0]  = DBMRL[0];                                             000480
      FITMRL[0] = DBMRL[0];                                             000490
                                                                        001690
# PERFORM READ CALL AND PASS FIT AND REALM ORDINAL                     #001700
                                                                        001710
      DB$RD1(FIT,REALMORD);                                             001720
                                                                        001730
# COPY ERROR STATUS FIELD OF FIT TO DBSTAT                             #001740
                                                                        001750
      DBSTAT = FITES[0];                                                001760
      DBSXXXX = FITES[0];                                               000270
      DBREALM = DBRXXXX;                                                000280
      IF FITEOI[0]                                                      000510
      THEN                                                              000520
        BEGIN                                                           000530
          DBSTAT = EOFCODE;                                             000540
          DBSXXXX = EOFCODE;                                            000550
        END                                                             000560
                                                                        001790
# CHECK FOR ERROR OR EOF STATUS ON CDCS CALL                           #
  
      IF FTNVER EQ F5                   # ALT RETURN VALID ONLY FOR FT5#
      THEN
        BEGIN 
        IF ERRFLAG                      # IF ERR RTN SPECIFIED         #
        THEN
          BEGIN 
          IF (FITES[0] NQ 0)            # IF CDCS/CRM ERROR OCCURRED   #
          THEN
            RTNPARM = 1;                # SET THE RETURN PARAMETER TO 1#
          END 
  
        IF ENDFLAG                      # IF EOF RTN SPECIFIED         #
        THEN
          BEGIN 
          IF FITEOI[0]                  # IF EOF ENCOUNTERED           #
          THEN
            BEGIN 
            IF ERRFLAG                  # IF END AND ERR PARM SPECIFIED#
            THEN
              RTNPARM = 2;              # SET RETURN TO SIXTH PARM     #
            ELSE
              RTNPARM = 1;              # ELSE, SET RETURN TO FIFTH    #
            END 
          END 
        END 
  
# SET THE RETURN REGISTER                                              #
  
      DMLRTRN(RTNPARM); 
  
# RETURN TO THE APPLICATION PROGRAM                                    #
      RETURN;                                                           001800
      END                                                               001810
TERM                                                                    001820
