aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/tbfckn.x
blob: cf5e94f75a04c40597bfa1e2b54dff8e464d3e44 (plain) (blame)
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
include <tbset.h>
include "tbtables.h"

# tbfckn -- change keyword name for FITS table
# This routine changes the name of a keyword without changing either
# the data type, value, or comment.
#
# Phil Hodge, 22-May-1996  Subroutine created.

procedure tbfckn (tp, oldkey, parnum, newkey)

pointer tp			# i: pointer to table descriptor
char	oldkey[ARB]		# i: current keyword name
int	parnum			# i: number of current keyword
char	newkey[ARB]		# i: new keyword name
#--
pointer sp
pointer par			# buffer for parameter record
char	uc_oldkey[SZ_KEYWORD]	# old keyword converted to upper case
char	uc_newkey[SZ_KEYWORD]
int	status
int	k
int	i
int	len, strlen()
errchk	tbffkw, tbferr

begin
	status = 0

	call smark (sp)
	call salloc (par, SZ_PARREC, TY_CHAR)

	call strcpy (oldkey, uc_oldkey, SZ_KEYWORD)
	call strcpy (newkey, uc_newkey, SZ_KEYWORD)
	call strupr (uc_oldkey)
	call strupr (uc_newkey)

	if (parnum > 0) {	# current parameter was specified by number

	    k = parnum

	} else {		# current parameter was specified by name

	    call tbffkw (tp, uc_oldkey, k)	# find old keyword

	    if (k <= 0) {
		call sprintf (Memc[par], SZ_PARREC,
			    "tbhckn:  keyword `%s' not found")
		    call pargstr (oldkey)
		call error (1, Memc[par])
	    }
	}

	call fsgrec (TB_FILE(tp), k, Memc[par], status)
	if (status != 0)
	    call tbferr (status)

	len = strlen (newkey)
	do i = 1, len				# replace old with new
	    Memc[par+i-1] = uc_newkey[i]
	do i = len+1, SZ_KEYWORD
	    Memc[par+i-1] = ' '

	call fsmrec (TB_FILE(tp), k, Memc[par], status)
	if (status != 0)
	    call tbferr (status)

	call sfree (sp)
end