
      SUBROUTINE rmvdky(lun, status)

      IMPLICIT NONE

      INTEGER lun, status

c Subroutine to remove duplicate keywords from the header of a FITS
c extension

      INTEGER MAXKEYS
      PARAMETER (MAXKEYS=5000)

      INTEGER i, j, nkeys, nmore, ipt

      CHARACTER*80 record(MAXKEYS)
      CHARACTER*80 current, contxt

      LOGICAL match, qstr

      INTEGER lenact
      EXTERNAL lenact

c Get the number of keywords

      CALL ftghsp(lun, nkeys, nmore, status) 
      contxt = 'Failed to get number of keywords'
      IF ( status .NE. 0 ) GOTO 999

      nkeys = MIN(nkeys, MAXKEYS)

c Loop over the keywords

      call ftgrec(lun, 1, current, status)
      WRITE(contxt, '(a,i5)') 'Failed to get keyword # 1'
      IF ( status .NE. 0 ) GOTO 999
      record(1) = current

      i = 2
      DO WHILE ( i .GT. 0 .AND. i .LE. nkeys .AND. nkeys .GT. 0 )

c Get the next record

         call ftgrec(lun, i, current, status)
         WRITE(contxt, '(a,i5)') 'Failed to get keyword # ', i
         IF ( status .NE. 0 ) GOTO 999

c Strip off the comment if this keyword is not HISTORY or COMMENT

         IF ( current(1:7) .NE. 'COMMENT' .AND. 
     &        current(1:7) .NE. 'HISTORY') THEN
            ipt = -1
            qstr = .FALSE.
            DO j = 1, lenact(current)
               IF ( current(j:j) .EQ. char(39) ) qstr = .NOT.qstr
               IF ( current(j:j) .EQ. char(47) .AND. .NOT.qstr ) THEN
                  ipt = j
                  GOTO 100
               ENDIF
            ENDDO
 100        CONTINUE
            IF ( ipt .GT. 0 ) current(ipt:) = ' '
         ENDIF

c Compare it with previous records

         match = .FALSE.
         j = 1
         DO WHILE ( .NOT.match .AND. j .LE. i-1 )
            IF ( current .EQ. record(j) ) THEN
               match = .TRUE.
            ELSE
               j = j + 1
            ENDIF
         ENDDO

c If a match was found then delete the current record

         IF ( match ) THEN
            CALL ftdrec(lun, i, status)
            contxt = 'Failed to delete keyword '//current(1:8)
            IF ( status .NE. 0 ) GOTO 999
            nkeys = nkeys - 1
         ELSE
            record(i) = current
            i = i + 1
         ENDIF

      ENDDO

 999  CONTINUE
      IF ( status .NE. 0 ) THEN
         CALL fcerr(contxt)
         CALL fcerrm(status)
      ENDIF

      RETURN
      END
