1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
C--------------------------------------------------------------------------
subroutine ftdkey(iunit,keynam,status)
C delete a header keyword
C
C iunit i fortran output unit number
C keynam c keyword name ( 8 characters, cols. 1- 8)
C OUTPUT PARAMETERS:
C status i output error status (0 = ok)
C
C written by Wm Pence, HEASARC/GSFC, Feb 1992
character*(*) keynam
integer iunit,status,i,lenval,nkeys,keypos
character keybuf*80,strval*70,comm*8,value*70,bslash*1,kname*8
if (status .gt. 0)return
C have to use 2 \\'s because the SUN compiler treats 1 \ as an escape
bslash='\\'
C find the keyword to be deleted
call ftgcrd(iunit,keynam,keybuf,status)
if (status .eq. 202)then
kname=keynam
call ftpmsg('FTDKEY could not find the '//kname//
& ' keyword to be deleted.')
return
end if
C get the position of the keyword in the header
call ftghps(iunit,nkeys,keypos,status)
keypos=keypos-1
C get position of last character in value string to see if it is a \ or &
call ftpsvc(keybuf,strval,comm,status)
call ftc2s(strval,value,status)
do 10 i=70,1,-1
if (value(i:i) .ne. ' ')then
lenval=i
go to 20
end if
10 continue
C now delete this keyword
20 call ftdrec(iunit,keypos,status)
if (status .gt. 0)return
C test if this keyword was also continued
if (value(lenval:lenval) .eq. bslash .or.
& value(lenval:lenval) .eq. '&')then
call ftgnst(iunit,value,lenval,comm,status)
if (lenval .gt. 0)go to 20
end if
end
|
