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
|
C--------------------------------------------------------------------------
subroutine ftirec(ounit,pos,record,status)
C insert a 80-char keyword record into the header at the pos-th keyword
C position (i.e., immediately before the current keyword at position POS.
C
C ounit i fortran output unit number
C pos i keyword will be inserted at this position (1 = 1st keyword)
C record c*80 keyword record
C OUTPUT PARAMETERS
C status i output error status (0 = ok)
C
C written by Wm Pence, HEASARC/GSFC, Jan 1995
character*(*) record
integer ounit,pos,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:------- -----------------------------
character*80 outrec, inrec
integer ibuff, fkey, lkey, i, nexthd, nkey
if (status .gt. 0)return
C get the number of the data buffer used for this unit
ibuff=bufnum(ounit)
C calculate number of existing keywords
nkey=(hdend(ibuff)-hdstrt(ibuff,chdu(ibuff)))/80
if (pos .eq. nkey+1)then
C simply append the record to the header
call ftprec(ounit,record,status)
return
else if (pos .lt. 1 .or. pos .gt. nkey)then
status=203
return
end if
outrec=record
C move to the insert position
nexthd=hdstrt(ibuff,chdu(ibuff))+(pos-1)*80
call ftmbyt(ounit,nexthd,.false.,status)
nxthdr(ibuff)=nexthd
C calculated the first and last keyword to be rewritten
fkey=pos
lkey=fkey + (hdend(ibuff)-nexthd)/80 - 1
C now sequentially read each keyword and overwrite it with the previous
do 10 i=fkey,lkey
call ftgrec(ounit,i,inrec,status)
call ftmodr(ounit,outrec,status)
outrec=inrec
10 continue
C finally, write the last keyword
call ftprec(ounit,outrec,status)
C reset the next keyword pointer to follow the inserted keyword
nxthdr(ibuff)=nexthd+80
end
|
