aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/fitsio/ftpknd.f
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /pkg/tbtables/fitsio/ftpknd.f
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'pkg/tbtables/fitsio/ftpknd.f')
-rw-r--r--pkg/tbtables/fitsio/ftpknd.f45
1 files changed, 45 insertions, 0 deletions
diff --git a/pkg/tbtables/fitsio/ftpknd.f b/pkg/tbtables/fitsio/ftpknd.f
new file mode 100644
index 00000000..289fc370
--- /dev/null
+++ b/pkg/tbtables/fitsio/ftpknd.f
@@ -0,0 +1,45 @@
+C--------------------------------------------------------------------------
+ subroutine ftpknd(ounit,keywrd,nstart,nkey,dval,decim,comm,
+ & status)
+
+C write an array of real*8 values to header records in E format
+C
+C ounit i fortran output unit number
+C keywrd c keyword name ( 8 characters, cols. 1- 8)
+C nstart i starting sequence number (usually 1)
+C nkey i number of keywords to write
+C dval d array of keyword values
+C decim i number of decimal places to display in the value field
+C comm c array of keyword comments (47 characters, cols. 34-80)
+C OUTPUT PARAMETERS:
+C status i output error status (0 = ok)
+C
+C written by Wm Pence, HEASARC/GSFC, June 1991
+
+ character*(*) keywrd,comm(*)
+ integer nstart,nkey,decim,ounit,status,i,j
+ double precision dval(*)
+ character keynam*8,comm1*48
+ logical repeat
+
+ if (status .gt. 0)return
+
+C check if the first comment string is to be repeated for all keywords
+C (if the last non-blank character is '&', then it is to be repeated)
+ call ftcrep(comm(1),comm1,repeat)
+
+ j=nstart
+ do 10 i=1,nkey
+C construct keyword name:
+ call ftkeyn(keywrd,j,keynam,status)
+
+C write the keyword record
+ if (repeat)then
+ call ftpkyd(ounit,keynam,dval(i),decim,comm1,status)
+ else
+ call ftpkyd(ounit,keynam,dval(i),decim,comm(i),status)
+ end if
+ if (status .gt. 0)return
+ j=j+1
+10 continue
+ end