SUBROUTINE ADDHISTORY(BUFFER)
C
C----------------------------------------------------------------------
C
C.IDENTIFICATION: Subroutine ADDHISTORY 
C.LIBRARY:        XASLIB  
C.AUTHOR:         L.Chiappetti - IFCTR Milano
C.VERSIONS:       1.0 - 07 Feb 94 - Original version
C                 1.1 - 08 Jun 94 - collapses multiple blanks
C.PURPOSE:        write a XAS HISTORY keyword in more records
C.METHOD:         parse blank-separated words in buffer    
C.SYNTAX:         CALL ADDHISTORY(BUFFER)          
C.PARAMETERS:     CHARACTER*(*) buffer  the entire HISTORY string
C.RESTRICTIONS:   none 
C.NOTES:          none
C.FILES:          none
C.REFERENCES:     noen
C
C----------------------------------------------------------------------
C
      CHARACTER*(*) BUFFER
      INTEGER       I,TRUE_LENGTH
      INTEGER       K,L,J
C
      I=TRUE_LENGTH(BUFFER)
C
C     collapsing duplicate blanks
 10   CONTINUE
      J=INDEX(BUFFER(:I),'  ') 
      IF(J.NE.0)THEN
        BUFFER(J+1:I)=BUFFER(J+2:I)
        I=I-1
        GOTO 10
      ENDIF
*     write(*,*)'writing ',i,' chars in history '
      IF(I.LE.68)THEN
C        entire history fits into one record
         CALL H_ADD_KEYWORD ('HISTORY',BUFFER(1:I),1)
         RETURN
      ELSE
C        need to split into continuation lines
         L=1
         K=68
 1       CONTINUE
C        find the end of the last full word fitting into 1-68 char
         DO 2 J=K,L,-1
         IF(BUFFER(J:J).EQ.' ')GOTO 3
 2       CONTINUE
 3       CONTINUE
         IF(L.EQ.1)THEN
C          first part 
           CALL H_ADD_KEYWORD('HISTORY',BUFFER(L:J-1),0)
         ELSE
C          continuation 
           CALL H_ADD_KEYWORD('HISTORY','+'//BUFFER(L:J-1),0)
         ENDIF
         L=J
         K=J+66
         IF(K.GE.I)THEN
C           is the last record, finish
            CALL H_ADD_KEYWORD('HISTORY','+'//BUFFER(L:I),1)
            RETURN
         ENDIF
         GOTO 1
      ENDIF
      END