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/fts2c.f | 57 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 pkg/tbtables/fitsio/fts2c.f

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

diff --git a/pkg/tbtables/fitsio/fts2c.f b/pkg/tbtables/fitsio/fts2c.f
new file mode 100644
index 00000000..2bceee6b
--- /dev/null
+++ b/pkg/tbtables/fitsio/fts2c.f
@@ -0,0 +1,57 @@
+C----------------------------------------------------------------------
+        subroutine fts2c(in,cval,lenval,status)
+C       convert an input string to a left justified quoted string
+C               The minimum length FITS string is 8 characters, so
+C               pad the quoted string with spaces if necessary.
+C       cval = returned quoted string
+C       lenval = length of the cval string, including the 2 quote characters
+        character*(*) in,cval
+        integer length,i,j,i1,i2,lenval,status
+
+        if (status .gt. 0)return
+
+        i1=1
+        i2=1
+C       test for blank input string
+        if (in .eq. ' ')then
+                cval='''        '''
+                lenval=10
+                return
+        end if
+
+        length=len(in)
+C       find first and last non-blank characters
+
+C       modified 29 Nov 1994 to treat leading spaces as significant
+C        do 5 i=1,length
+C                i1=i
+C                if (in(i:i) .ne. ' ')go to 10
+C5       continue
+C10      continue
+
+        do 15 i=length,1,-1
+                i2=i
+                if (in(i:i) .ne. ' ')go to 20
+15      continue
+20      continue
+
+        cval=''''//in(i1:i2)
+
+C       test if there are any single quotes in the string;  if so, replace
+C       them with two successive single quotes
+        lenval=i2-i1+2
+        do 30 i=lenval,2,-1
+                if (cval(i:i) .eq. '''')then
+C                  shift all the characters over 1 space
+                   do 40 j=len(cval),i+1,-1
+                      cval(j:j)=cval(j-1:j-1)
+40                 continue
+                   i2=i2+1
+                end if
+30      continue
+
+C       find location of closing quote
+        lenval=max(10,i2-i1+3)  
+        lenval=min(lenval,len(cval))
+        cval(lenval:lenval)=''''
+        end
-- 
cgit