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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
C----------------------------------------------------------------------
subroutine ftcopy(iunit,ounit,moreky,status)
C copies the CHDU from IUNIT to the CHDU of OUNIT.
C This will also reserve space in the header for MOREKY keywords
C if MOREKY > 0.
C iunit i fortran unit number of the input file to be copied
C ounit i fortran unit number of the output file to be copied to
C moreky i create space in header for this many more keywords
C status i output error status
C
C written by Wm Pence, HEASARC/GSFC, Jan, 1992
integer iunit,ounit,moreky,status
C COMMON BLOCK DEFINITIONS:--------------------------------------------
integer nb,ne
parameter (nb = 20)
parameter (ne = 200)
integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt
integer nxtfld
logical wrmode
common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb),
& wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld
C END OF COMMON BLOCK DEFINITIONS-----------------------------------
integer ibuff,obuff,i,nkeys,nadd
integer bitpix,naxis,naxes(99),pcount,gcount
character hrec*80
logical simple,extend
if (status .gt. 0)return
if (iunit .eq. ounit)then
status=101
return
end if
ibuff=bufnum(iunit)
obuff=bufnum(ounit)
C find out the number of keywords which exist in the input CHDU
call ftghsp(iunit,nkeys,nadd,status)
C copy the keywords one at a time to the output CHDU
if ( (chdu(ibuff) .eq. 1 .and. chdu(obuff) .ne. 1) .or.
& (chdu(ibuff) .ne. 1 .and. chdu(obuff) .eq. 1) )then
C copy primary array to image extension, or vise versa
C copy the required keywords:
simple=.true.
extend=.true.
call ftghpr(iunit,99,simple,bitpix,naxis,
& naxes,pcount,gcount,extend,status)
if (status .gt. 0)return
call ftphpr(ounit,simple,bitpix,naxis,
& naxes,pcount,gcount,extend,status)
if (status .gt. 0)return
C copy remaining keywords, excluding pcount, gcount and extend
do 10 i=naxis+4,nkeys
call ftgrec(iunit,i,hrec,status)
if (hrec(1:8) .ne. 'PCOUNT ' .and.
& hrec(1:8) .ne. 'GCOUNT ' .and.
& hrec(1:8) .ne. 'EXTEND ')then
call ftprec(ounit,hrec,status)
end if
10 continue
else
C just copy all the keys exactly from the input file to the output
do 20 i=1,nkeys
call ftgrec(iunit,i,hrec,status)
call ftprec(ounit,hrec,status)
20 continue
end if
C reserve space for more keywords (if moreky > 0)
call fthdef(ounit,moreky,status)
C now ccopy the data from the input CHDU to the output CHDU
call ftcpdt(iunit,ounit,status)
end
|
