From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- unix/boot/spp/rpp/ratlibf/sctabl.f | 54 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 unix/boot/spp/rpp/ratlibf/sctabl.f (limited to 'unix/boot/spp/rpp/ratlibf/sctabl.f') diff --git a/unix/boot/spp/rpp/ratlibf/sctabl.f b/unix/boot/spp/rpp/ratlibf/sctabl.f new file mode 100644 index 00000000..1ba16897 --- /dev/null +++ b/unix/boot/spp/rpp/ratlibf/sctabl.f @@ -0,0 +1,54 @@ + integer function sctabl (table, sym, info, posn) + integer table, posn + integer sym (100) + integer info (100) + integer mem( 1) + common/cdsmem/mem + integer bucket, walker + integer dsget + integer nodsiz, i, j + if (.not.(posn .eq. 0))goto 23000 + posn = dsget (2) + mem (posn) = 1 + mem (posn + 1) = mem (table + 1) +23000 continue + bucket = mem (posn) + walker = mem (posn + 1) + nodsiz = mem (table) +23002 continue + if (.not.(walker .ne. 0))goto 23005 + i = walker + 1 + nodsiz + j = 1 +23007 if (.not.(mem (i) .ne. -2))goto 23008 + sym (j) = mem (i) + i = i + 1 + j = j + 1 + goto 23007 +23008 continue + sym (j) = -2 + i = 1 +23009 if (.not.(i .le. nodsiz))goto 23011 + j = walker + 1 + i - 1 + info (i) = mem (j) +23010 i = i + 1 + goto 23009 +23011 continue + mem (posn) = bucket + mem (posn + 1) = mem (walker + 0) + sctabl = 1 + return +23005 continue + bucket = bucket + 1 + if (.not.(bucket .gt. 43))goto 23012 + goto 23004 +23012 continue + j = table + bucket + walker = mem (j) +23006 continue +23003 goto 23002 +23004 continue + call dsfree (posn) + posn = 0 + sctabl = -1 + return + end -- cgit