aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/fitsio/ftxiou.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/ftxiou.f
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'pkg/tbtables/fitsio/ftxiou.f')
-rw-r--r--pkg/tbtables/fitsio/ftxiou.f37
1 files changed, 37 insertions, 0 deletions
diff --git a/pkg/tbtables/fitsio/ftxiou.f b/pkg/tbtables/fitsio/ftxiou.f
new file mode 100644
index 00000000..f75a1808
--- /dev/null
+++ b/pkg/tbtables/fitsio/ftxiou.f
@@ -0,0 +1,37 @@
+C------------------------------------------------------------------------------
+ subroutine ftxiou(iounit,status)
+
+C generic routine to manage logical unit numbers in the range 50-99
+
+ integer iounit,status,i
+ integer*2 array(50)
+ save array
+ data array/50*0/
+
+ if (iounit .eq. 0)then
+C get an unused logical unit number
+ do 10 i=50,1,-1
+ if (array(i) .eq. 0)then
+ array(i)=1
+ iounit=i+49
+ return
+ end if
+10 continue
+C error: all units are allocated
+ iounit=-1
+ status=114
+ call ftpmsg('FTGIOU has no more available unit numbers.')
+
+ else if (iounit .eq. -1)then
+C deallocate all the unit numbers
+ do 20 i=1,50
+ array(i)=0
+20 continue
+
+ else
+C deallocat a specific unit number
+ if (iounit .ge. 50 .and. iounit .le. 99)then
+ array(iounit-49)=0
+ end if
+ endif
+ end