FTN4
      INTEGER FUNCTION ISUPB(IBUF,LEN),. 92903-16001 REV.1805  770123 
C 
C     SOURCE 92903-18030
C 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C     **********************************************
C     * THIS FUNCTION CONTRACTS A CHARACTER STRING *
C     * CONTAINED IN A BUFFER WHOSE NAME IS GIVEN  *
C     * IN FIRST PARAMETER. LENGTH OF THIS STRING  *
C     * IS GIVEN IN THE SECOND PARAMETER. FUNCTION *
C     * RETURNS THE NEW LENGTH OF THE CONTRACTED   *
C     * STRING.  (ALL LENGTH ARE IN WORDS)         *
C     **********************************************
C 
C     REV. 770123  CORRECT A BUG !   FG 
C 
      DIMENSION IBUF(1) 
C 
C 
      LENC=2*LEN
      K=0 
      I=1 
10    IF(IGET1(IBUF,I).EQ.1H ) GOTO 30
15    I=I+1 
      IF(I.LE.LENC) GOTO 10 
      CALL BLAN(IBUF,LENC+1,K)
      ISUPB=(LENC+1)/2
      RETURN
30    J=I 
40    K=K+1 
      J=J+1 
      IF(J.GT.LENC) GOTO 60 
      IF(IGET1(IBUF,J).EQ.1H ) GOTO 40
      CALL MOVCA(IBUF,J,IBUF,I,LENC-J+1)
60    LENC=LENC+I-J 
      GOTO 15 
      END 
      END$
                                                              