Repatch (from linux) of OSX IRAF

1 files changed, 298 insertions, 0 deletions

diff --git a/math/slalib/dfltin.f b/math/slalib/dfltin.f
new file mode 100644
index 00000000..7d514f39
--- /dev/null
+++ b/math/slalib/dfltin.f
@@ -0,0 +1,298 @@
+      SUBROUTINE slDFLI (STRING, NSTRT, DRESLT, JFLAG)
+*+
+*     - - - - - - -
+*      D F L I
+*     - - - - - - -
+*
+*  Convert free-format input into double precision floating point
+*
+*  Given:
+*     STRING     c     string containing number to be decoded
+*     NSTRT      i     pointer to where decoding is to start
+*     DRESLT     d     current value of result
+*
+*  Returned:
+*     NSTRT      i      advanced to next number
+*     DRESLT     d      result
+*     JFLAG      i      status: -1 = -OK, 0 = +OK, 1 = null, 2 = error
+*
+*  Notes:
+*
+*     1     The reason DFLTIN has separate OK status values for +
+*           and - is to enable minus zero to be detected.   This is
+*           of crucial importance when decoding mixed-radix numbers.
+*           For example, an angle expressed as deg, arcmin, arcsec
+*           may have a leading minus sign but a zero degrees field.
+*
+*     2     A TAB is interpreted as a space, and lowercase characters
+*           are interpreted as uppercase.
+*
+*     3     The basic format is the sequence of fields #^.^@#^, where
+*           # is a sign character + or -, ^ means a string of decimal
+*           digits, and @, which indicates an exponent, means D or E.
+*           Various combinations of these fields can be omitted, and
+*           embedded blanks are permissible in certain places.
+*
+*     4     Spaces:
+*
+*             .  Leading spaces are ignored.
+*
+*             .  Embedded spaces are allowed only after +, -, D or E,
+*                and after the decomal point if the first sequence of
+*                digits is absent.
+*
+*             .  Trailing spaces are ignored;  the first signifies
+*                end of decoding and subsequent ones are skipped.
+*
+*     5     Delimiters:
+*
+*             .  Any character other than +,-,0-9,.,D,E or space may be
+*                used to signal the end of the number and terminate
+*                decoding.
+*
+*             .  Comma is recognized by DFLTIN as a special case;  it
+*                is skipped, leaving the pointer on the next character.
+*                See 13, below.
+*
+*     6     Both signs are optional.  The default is +.
+*
+*     7     The mantissa ^.^ defaults to 1.
+*
+*     8     The exponent @#^ defaults to D0.
+*
+*     9     The strings of decimal digits may be of any length.
+*
+*     10    The decimal point is optional for whole numbers.
+*
+*     11    A "null result" occurs when the string of characters being
+*           decoded does not begin with +,-,0-9,.,D or E, or consists
+*           entirely of spaces.  When this condition is detected, JFLAG
+*           is set to 1 and DRESLT is left untouched.
+*
+*     12    NSTRT = 1 for the first character in the string.
+*
+*     13    On return from DFLTIN, NSTRT is set ready for the next
+*           decode - following trailing blanks and any comma.  If a
+*           delimiter other than comma is being used, NSTRT must be
+*           incremented before the next call to DFLTIN, otherwise
+*           all subsequent calls will return a null result.
+*
+*     14    Errors (JFLAG=2) occur when:
+*
+*             .  a +, -, D or E is left unsatisfied;  or
+*
+*             .  the decimal point is present without at least
+*                one decimal digit before or after it;  or
+*
+*             .  an exponent more than 100 has been presented.
+*
+*     15    When an error has been detected, NSTRT is left
+*           pointing to the character following the last
+*           one used before the error came to light.  This
+*           may be after the point at which a more sophisticated
+*           program could have detected the error.  For example,
+*           DFLTIN does not detect that '1D999' is unacceptable
+*           (on a computer where this is so) until the entire number
+*           has been decoded.
+*
+*     16    Certain highly unlikely combinations of mantissa &
+*           exponent can cause arithmetic faults during the
+*           decode, in some cases despite the fact that they
+*           together could be construed as a valid number.
+*
+*     17    Decoding is left to right, one pass.
+*
+*     18    See also FLOTIN and INTIN
+*
+*  Called:  slICHF
+*
+*  P.T.Wallace   Starlink   18 March 1999
+*
+*  Copyright (C) 1999 Rutherford Appleton Laboratory
+*
+*  License:
+*    This program is free software; you can redistribute it and/or modify
+*    it under the terms of the GNU General Public License as published by
+*    the Free Software Foundation; either version 2 of the License, or
+*    (at your option) any later version.
+*
+*    This program is distributed in the hope that it will be useful,
+*    but WITHOUT ANY WARRANTY; without even the implied warranty of
+*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+*    GNU General Public License for more details.
+*
+*    You should have received a copy of the GNU General Public License
+*    along with this program (see SLA_CONDITIONS); if not, write to the
+*    Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+*    Boston, MA  02110-1301  USA
+*
+*  Copyright (C) 1995 Association of Universities for Research in Astronomy Inc.
+*-
+
+      IMPLICIT NONE
+
+      CHARACTER*(*) STRING
+      INTEGER NSTRT
+      DOUBLE PRECISION DRESLT
+      INTEGER JFLAG
+
+      INTEGER NPTR,MSIGN,NEXP,NDP,NVEC,NDIGIT,ISIGNX,J
+      DOUBLE PRECISION DMANT,DIGIT
+
+
+
+*  Current character
+      NPTR=NSTRT
+
+*  Set defaults: mantissa & sign, exponent & sign, decimal place count
+      DMANT=0D0
+      MSIGN=1
+      NEXP=0
+      ISIGNX=1
+      NDP=0
+
+*  Look for sign
+ 100  CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO ( 400,  100,  800,  500,  300,  200, 9110, 9100, 9110),NVEC
+*             0-9    SP   D/E    .     +     -     ,   ELSE   END
+
+*  Negative
+ 200  CONTINUE
+      MSIGN=-1
+
+*  Look for first leading decimal
+ 300  CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO ( 400, 300,  800,  500, 9200, 9200, 9200, 9200, 9210),NVEC
+*             0-9   SP   D/E    .     +     -     ,   ELSE   END
+
+*  Accept leading decimals
+ 400  CONTINUE
+      DMANT=DMANT*1D1+DIGIT
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO ( 400, 1310,  900,  600, 1300, 1300, 1300, 1300, 1310),NVEC
+*             0-9   SP    D/E    .     +     -     ,   ELSE   END
+
+*  Look for decimal when none preceded the point
+ 500  CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO ( 700, 500, 9200, 9200, 9200, 9200, 9200, 9200, 9210),NVEC
+*             0-9   SP   D/E    .     +     -     ,   ELSE   END
+
+*  Look for trailing decimals
+ 600  CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO ( 700, 1310,  900, 1300, 1300, 1300, 1300, 1300, 1310),NVEC
+*             0-9   SP    D/E    .     +     -     ,   ELSE   END
+
+*  Accept trailing decimals
+ 700  CONTINUE
+      NDP=NDP+1
+      DMANT=DMANT*1D1+DIGIT
+      GO TO 600
+
+*  Exponent symbol first in field: default mantissa to 1
+ 800  CONTINUE
+      DMANT=1D0
+
+*  Look for sign of exponent
+ 900  CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO (1200, 900, 9200, 9200, 1100, 1000, 9200, 9200, 9210),NVEC
+*             0-9   SP   D/E    .     +     -     ,   ELSE   END
+
+*  Exponent negative
+ 1000 CONTINUE
+      ISIGNX=-1
+
+*  Look for first digit of exponent
+ 1100 CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO (1200, 1100, 9200, 9200, 9200, 9200, 9200, 9200, 9210),NVEC
+*             0-9   SP    D/E    .     +     -     ,   ELSE   END
+
+*  Use exponent digit
+ 1200 CONTINUE
+      NEXP=NEXP*10+NDIGIT
+      IF (NEXP.GT.100) GO TO 9200
+
+*  Look for subsequent digits of exponent
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO (1200, 1310, 1300, 1300, 1300, 1300, 1300, 1300, 1310),NVEC
+*             0-9   SP    D/E    .     +     -     ,   ELSE   END
+
+*  Combine exponent and decimal place count
+ 1300 CONTINUE
+      NPTR=NPTR-1
+ 1310 CONTINUE
+      NEXP=NEXP*ISIGNX-NDP
+
+*  Skip if net exponent negative
+      IF (NEXP.LT.0) GO TO 1500
+
+*  Positive exponent: scale up
+ 1400 CONTINUE
+      IF (NEXP.LT.10) GO TO 1410
+      DMANT=DMANT*1D10
+      NEXP=NEXP-10
+      GO TO 1400
+ 1410 CONTINUE
+      IF (NEXP.LT.1) GO TO 1600
+      DMANT=DMANT*1D1
+      NEXP=NEXP-1
+      GO TO 1410
+
+*  Negative exponent: scale down
+ 1500 CONTINUE
+      IF (NEXP.GT.-10) GO TO 1510
+      DMANT=DMANT/1D10
+      NEXP=NEXP+10
+      GO TO 1500
+ 1510 CONTINUE
+      IF (NEXP.GT.-1) GO TO 1600
+      DMANT=DMANT/1D1
+      NEXP=NEXP+1
+      GO TO 1510
+
+*  Get result & status
+ 1600 CONTINUE
+      J=0
+      IF (MSIGN.EQ.1) GO TO 1610
+      J=-1
+      DMANT=-DMANT
+ 1610 CONTINUE
+      DRESLT=DMANT
+
+*  Skip to end of field
+ 1620 CONTINUE
+      CALL slICHF(STRING,NPTR,NVEC,NDIGIT,DIGIT)
+      GO TO (1720, 1620, 1720, 1720, 1720, 1720, 9900, 1720, 9900),NVEC
+*             0-9   SP    D/E    .     +     -     ,   ELSE   END
+
+ 1720 CONTINUE
+      NPTR=NPTR-1
+      GO TO 9900
+
+
+*  Exits
+
+*  Null field
+ 9100 CONTINUE
+      NPTR=NPTR-1
+ 9110 CONTINUE
+      J=1
+      GO TO 9900
+
+*  Errors
+ 9200 CONTINUE
+      NPTR=NPTR-1
+ 9210 CONTINUE
+      J=2
+
+*  Return
+ 9900 CONTINUE
+      NSTRT=NPTR
+      JFLAG=J
+
+      END