From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001
From: Joseph Hunkeler <jhunkeler@gmail.com>
Date: Wed, 8 Jul 2015 20:46:52 -0400
Subject: Initial commit

---
 pkg/tbtables/fitsio/ftd2f.f | 36 ++++++++++++++++++++++++++++++++++++
 1 file changed, 36 insertions(+)
 create mode 100644 pkg/tbtables/fitsio/ftd2f.f

(limited to 'pkg/tbtables/fitsio/ftd2f.f')

diff --git a/pkg/tbtables/fitsio/ftd2f.f b/pkg/tbtables/fitsio/ftd2f.f
new file mode 100644
index 00000000..2a8de134
--- /dev/null
+++ b/pkg/tbtables/fitsio/ftd2f.f
@@ -0,0 +1,36 @@
+C----------------------------------------------------------------------
+        subroutine ftd2f(val,dec,cval,status)
+
+C       convert double precision value to F20.* format character string
+C       NOTE: some precision may be lost
+C       val     d  input value to be converted 
+C       dec     i  number of decimal places to display in output string
+C       cval    c  output character string
+C       status  i  output error status (0 = OK)
+
+        double precision val
+        integer dec,status
+        character*20 cval,form*8
+
+        if (status .gt. 0)return
+
+        if (dec .ge. 0 .and. dec .le. 9)then
+                write(form,2000)dec
+2000            format('(f20.',i1,')')
+        else if (dec .ge. 10 .and. dec .lt.18)then
+                write(form,2001)dec
+2001            format('(f20.',i2,')')
+        else
+C               illegal number of decimal places were specified
+                status=411
+                call ftpmsg('Error in FTD2F: number of decimal places '
+     &                      //'is less than 0 or greater than 18.')
+                return
+        endif
+
+        write(cval,form,err=900)val
+        if (cval(1:1) .eq. '*')go to 900
+        return
+900     status=402
+        call ftpmsg('Error in FTD2F converting double to F20. string.')
+        end
-- 
cgit