FTN77
      PROGRAM DISP(3),SET BLOCK DISPLACEMENT
C
C  RU,DISP,<ADDR>,<DISPHI>,<DISPLO>,<DOCICLEAR>
C
      INTEGER LU, ADDR, COMP (24), BUF (200), PARAM (5)
C
      CALL RMPAR (PARAM)
C
      LU = 21
      ADDR = PARAM (1)
C
      DO 10 I=1,24
10    COMP (I) = -1
C
      IF (PARAM (4).EQ.0) GO TO 15
C
      COMP (1) = 15
      CALL XCICL (LU, ADDR, COMP, BUF)
C
15    CONTINUE
C
      COMP (1) = 0
      COMP (2) = 0
C
      COMP (7) = 1
      COMP (8) = PARAM (2)
      COMP (9) = PARAM (3)
C
      CALL XCOMP (LU, ADDR, COMP, BUF)
C
      WRITE (1,20) ADDR, BUF (60)
20    FORMAT ("SET BLOCK DISPLACEMENT ADDRESS ",I1," QSTAT ",I1)
C
      END
      END$
