program offset_list C C C This program reads a file whose first line is the field C center coordinates, and whose subsequent lines are offsets C of objects in seconds of arc in RA and in Dec from the C field center. The output is a file with coordinates for C each object. C C Input file: C nn mm rr.r (centerfield RA) C +ii jj ll.l (centerfield Dec) C 123.4 567.8 n (offsets in RA and Dec in arc-sec from centerfield) C n is a number to identify the object C one line/object. C C Output file: C nn mm rr.r (centerfield ra) C +xx yy zz.z (centerfield dec) C mm rr zz.z +aa bb cc.c n (object coordinates and ID) C 1 line/object. C C The length of the input file is arbitrary, but cannot C exceed 1000 objects. C C J.Cohen/Caltech/March 1995 C C C The program uses routines from Pat Wallace's SLALIB library. C For convenience, the source code for the routines required C is included in this file. C implicit none integer infile,outfile, max_obj parameter (max_obj=1000) parameter(infile=10,outfile=12) real*8 pi PARAMETER (PI = 3.14159265358979324) C....These are the variables which contain the desired info C.. ra0, dec0 = coords of the center of the field C.. x, y = coords of selected objects (arrays) C.....nobj = number of objects C.....id = numerical ident. for objects (array) character*80 string,string_ra,string_dec character*1 cvalue_ra, cvalue_dec integer id(max_obj), eof, statio, int_array_ra(4) integer int_array_dec(4), i, j, nobj, nstart, istatus real x(max_obj),y(max_obj) real*8 ra0, dec0, rpas, dvalue, true_ra_obj, true_dec_obj logical more more=.true. eof=-1 rpas=pi/(180.0*3600.0) C....Open the input file write(*,*) : ' What is the name of the input file with objects etc. ?' read(*,150)string 150 format(a50) open (infile, file=string, + status='old', access='sequential', err=910) C C Read the centerfield info C read(infile,100)string_ra read(infile,100)string_dec 100 format(a80) i=1 do while (more) read(infile,*,iostat=statio)x(i),y(i),id(i) if (statio.eq.eof) then more=.false. else i=i+1 end if end do nobj=i-1 close(unit=infile) C C For parsing the RA and DEC, which are stored as C character strings, we use C Pat Wallace's Slalib library routine DAFIN, which converts a C free-format character string from deg, arcmin, sec to radians. C C This is fine for DEC. For RA we then need to multiply by 15.0 C C C Note that consecutive calls to DAFIN working on different strings C must use different values of the initial search parameter, otherwise C the string is searched for a second angle further into the string. C C nstart=1 call sla_dafin(string_ra,nstart,ra0,istatus) ra0=ra0*15.0d0 nstart=1 call sla_dafin(string_dec,nstart,dec0,istatus) write(*,*)' centerfield ra in radians (ra0) ',ra0 write(*,*)' centerfield dec in radians (dec0) ', dec0 write(*,*)' ' write(*,*)' ' C C C Calculate final coordinates. C C open(unit=outfile,file='output_list.out') write(*,*)' The output file is called output_list.out' write(outfile,100)string_ra write(outfile,100)string_dec dvalue=dcos(dec0) do i=1,nobj true_ra_obj= ra0 + x(i)*rpas/dvalue true_dec_obj = dec0 + y(i)*rpas C C Now convert final RA,DEC into strings, and write output file C Suitable for use with Autoslit. C C SLALIB routines used here: C sla_dr2tf, radians to hours/minutes/seconds C sla_dr2af, radians to degrees/ arc-minutes / arc-seconds C nstart=4 call sla_dr2tf(nstart,true_ra_obj,cvalue_ra,int_array_ra) call sla_dr2af(nstart,true_dec_obj,cvalue_dec, : int_array_dec) C C Write the output file for Autoslit. First step is to fix up C writing the sign of the DEC. The format I4.4 puts in leading C zeros as appropriate for the decimal fraction the RA and DEC C seconds (of arc and of time). The first line is for the C center of the field. We use the average RA and DEC for the C set of objects. C if (cvalue_dec .eq. '-') int_array_dec(1)=-int_array_dec(1) write(outfile,140)(int_array_ra(j),j=1,4), : (int_array_dec(j),j=1,4),id(i) 140 format(3x,i3,1x,i3,1x,i3,'.',i4.4,5x,i3,1x,i3,1x,i3,'.',i4.4, : 5x,i6) end do close(unit=outfile) stop C C Error exits C 910 write(*,*)' Problems opening input file.' end C NOTES: SUBROUTINE sla_DAFIN (STRING, IPTR, A, J) *+ * - - - - - - * D A F I N * - - - - - - * * Sexagesimal character string to angle (double precision) * * Given: * STRING c*(*) string containing deg, arcmin, arcsec fields * IPTR i pointer to start of decode (1st = 1) * * Returned: * IPTR i advanced past the decoded angle * A d angle in radians * J i status: 0 = OK * +1 = default, A unchanged * -1 = bad degrees ) * -2 = bad arcminutes ) (note 3) * -3 = bad arcseconds ) * * Example: * * argument before after * * STRING '-57 17 44.806 12 34 56.7' unchanged * IPTR 1 16 (points to 12...) * A ? -1.00000D0 * J ? 0 * * A further call to sla_DAFIN, without adjustment of IPTR, will * decode the second angle, 12deg 34min 56.7sec. * * Notes: * * 1) The first three "fields" in STRING are degrees, arcminutes, * arcseconds, separated by spaces or commas. The degrees field * may be signed, but not the others. The decoding is carried * out by the DFLTIN routine and is free-format. * * 2) Successive fields may be absent, defaulting to zero. For * zero status, the only combinations allowed are degrees alone, * degrees and arcminutes, and all three fields present. If all * three fields are omitted, a status of +1 is returned and A is * unchanged. In all other cases A is changed. * * 3) Range checking: * * The degrees field is not range checked. However, it is * expected to be integral unless the other two fields are absent. * * The arcminutes field is expected to be 0-59, and integral if * the arcseconds field is present. If the arcseconds field * is absent, the arcminutes is expected to be 0-59.9999... * * The arcseconds field is expected to be 0-59.9999... * * 4) Decoding continues even when a check has failed. Under these * circumstances the field takes the supplied value, defaulting * to zero, and the result A is computed and returned. * * 5) Further fields after the three expected ones are not treated * as an error. The pointer IPTR is left in the correct state * for further decoding with the present routine or with DFLTIN * etc. See the example, above. * * 6) If STRING contains hours, minutes, seconds instead of degrees * etc, or if the required units are turns (or days) instead of * radians, the result A should be multiplied as follows: * * for to obtain multiply * STRING A in A by * * d ' " radians 1 = 1D0 * d ' " turns 1/2pi = 0.1591549430918953358D0 * h m s radians 15 = 15D0 * h m s days 15/2pi = 2.3873241463784300365D0 * * Called: sla_DFLTIN * * P.T.Wallace Starlink 13 September 1990 *- IMPLICIT NONE CHARACTER*(*) STRING INTEGER IPTR DOUBLE PRECISION A INTEGER J DOUBLE PRECISION AS2R PARAMETER (AS2R=4.84813681109535993589914102358D-6) INTEGER JF,JD,JM,JS DOUBLE PRECISION DEG,ARCMIN,ARCSEC * Preset the status to OK JF=0 * Defaults DEG=0D0 ARCMIN=0D0 ARCSEC=0D0 * Decode degrees, arcminutes, arcseconds CALL sla_DFLTIN(STRING,IPTR,DEG,JD) IF (JD.GT.1) THEN JF=-1 ELSE CALL sla_DFLTIN(STRING,IPTR,ARCMIN,JM) IF (JM.LT.0.OR.JM.GT.1) THEN JF=-2 ELSE CALL sla_DFLTIN(STRING,IPTR,ARCSEC,JS) IF (JS.LT.0.OR.JS.GT.1) THEN JF=-3 * See if the combination of fields is credible ELSE IF (JD.GT.0) THEN * No degrees: arcmin, arcsec ought also to be absent IF (JM.EQ.0) THEN * Suspect arcmin JF=-2 ELSE IF (JS.EQ.0) THEN * Suspect arcsec JF=-3 ELSE * All three fields absent JF=1 END IF * Degrees present: if arcsec present so ought arcmin to be ELSE IF (JM.NE.0.AND.JS.EQ.0) THEN JF=-3 * Tests for range and integrality * Degrees ELSE IF (JM.EQ.0.AND.DINT(DEG).NE.DEG) THEN JF=-1 * Arcminutes ELSE IF ((JS.EQ.0.AND.DINT(ARCMIN).NE.ARCMIN).OR. : ARCMIN.GE.60D0) THEN JF=-2 * Arcseconds ELSE IF (JS.LT.0.OR.ARCSEC.GE.60D0) THEN JF=-3 END IF END IF END IF * Unless all three fields absent, compute angle value IF (JF.LE.0) THEN A=AS2R*(60D0*(60D0*ABS(DEG)+ARCMIN)+ARCSEC) IF (JD.LT.0) A=-A END IF * Return the status J=JF END SUBROUTINE sla_DD2TF (NDP, DAYS, SIGN, IHMSF) *+ * - - - - - - * D D 2 T F * - - - - - - * * Convert an interval in days into hours, minutes, seconds * (double precision) * * Given: * NDP int number of decimal places of seconds * DAYS dp interval in days * * Returned: * SIGN char '+' or '-' * IHMSF int(4) hours, minutes, seconds, fraction * * Notes: * * 1) NDP less than zero is interpreted as zero. * * 2) The largest useful value for NDP is determined by the size * of DAYS, the format of DOUBLE PRECISION floating-point numbers * on the target machine, and the risk of overflowing IHMSF(4). * For example, on the VAX, for DAYS up to 1D0, the available * floating-point precision corresponds roughly to NDP=12. * However, the practical limit is NDP=9, set by the capacity of * the 32-bit integer IHMSF(4). * * 3) The absolute value of DAYS may exceed 1D0. In cases where it * does not, it is up to the caller to test for and handle the * case where DAYS is very nearly 1D0 and rounds up to 24 hours, * by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero. * * P.T.Wallace Starlink 11 September 1990 *- IMPLICIT NONE INTEGER NDP DOUBLE PRECISION DAYS CHARACTER SIGN*(*) INTEGER IHMSF(4) * Days to seconds DOUBLE PRECISION D2S PARAMETER (D2S=86400D0) INTEGER NRS,N DOUBLE PRECISION RS,RM,RH,A,AH,AM,AS,AF * Handle sign IF (DAYS.GE.0D0) THEN SIGN='+' ELSE SIGN='-' END IF * Field units in terms of least significant figure NRS=1 DO N=1,NDP NRS=NRS*10 END DO RS=DBLE(NRS) RM=RS*60D0 RH=RM*60D0 * Round interval and express in smallest units required A=ANINT(RS*D2S*ABS(DAYS)) * Separate into fields AH=AINT(A/RH) A=A-AH*RH AM=AINT(A/RM) A=A-AM*RM AS=AINT(A/RS) AF=A-AS*RS * Return results IHMSF(1)=MAX(NINT(AH),0) IHMSF(2)=MAX(MIN(NINT(AM),59),0) IHMSF(3)=MAX(MIN(NINT(AS),59),0) IHMSF(4)=MAX(NINT(MIN(AF,RS-1D0)),0) END SUBROUTINE sla_DFLTIN (STRING, NSTRT, DRESLT, JFLAG) *+ * - - - - - - - * D F L T I N * - - - - - - - * * 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 * * Called: sla__IDCHF * * 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 recognised 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 the VAX) 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 * * P.T.Wallace Starlink 2 August 1993 *- 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 sla__IDCHF(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 sla__IDCHF(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 sla__IDCHF(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 sla__IDCHF(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 sla__IDCHF(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 sla__IDCHF(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 sla__IDCHF(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 sla__IDCHF(STRING,NPTR,NVEC,NDIGIT,DIGIT) GO TO (1200, 1310, 1310, 1310, 1310, 1310, 1310, 1310, 1300),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 sla__IDCHF(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 SUBROUTINE sla_DR2AF (NDP, ANGLE, SIGN, IDMSF) *+ * - - - - - - * D R 2 A F * - - - - - - * * Convert an angle in radians to degrees, arcminutes, arcseconds * (double precision) * * Given: * NDP int number of decimal places of arcseconds * ANGLE dp angle in radians * * Returned: * SIGN char '+' or '-' * IDMSF int(4) degrees, arcminutes, arcseconds, fraction * * Notes: * * 1) NDP less than zero is interpreted as zero. * * 2) The largest useful value for NDP is determined by the size * of ANGLE, the format of DOUBLE PRECISION floating-point * numbers on the target machine, and the risk of overflowing * IDMSF(4). For example, on the VAX, for ANGLE up to 2pi, the * available floating-point precision corresponds roughly to * NDP=12. However, the practical limit is NDP=9, set by the * capacity of the 32-bit integer IDMSF(4). * * 3) The absolute value of ANGLE may exceed 2pi. In cases where it * does not, it is up to the caller to test for and handle the * case where ANGLE is very nearly 2pi and rounds up to 360 deg, * by testing for IDMSF(1)=360 and setting IDMSF(1-4) to zero. * * Called: * sla_DD2TF * * P.T.Wallace Starlink 11 September 1990 *- IMPLICIT NONE INTEGER NDP DOUBLE PRECISION ANGLE CHARACTER SIGN*(*) INTEGER IDMSF(4) * Hours to degrees * radians to turns DOUBLE PRECISION F PARAMETER (F=15D0/6.283185307179586476925287D0) * Scale then use days to h,m,s routine CALL sla_DD2TF(NDP,ANGLE*F,SIGN,IDMSF) END SUBROUTINE sla_DR2TF (NDP, ANGLE, SIGN, IHMSF) *+ * - - - - - - * D R 2 T F * - - - - - - * * Convert an angle in radians to hours, minutes, seconds * (double precision) * * Given: * NDP int number of decimal places of seconds * ANGLE dp angle in radians * * Returned: * SIGN char '+' or '-' * IHMSF int(4) hours, minutes, seconds, fraction * * Notes: * * 1) NDP less than zero is interpreted as zero. * * 2) The largest useful value for NDP is determined by the size * of ANGLE, the format of DOUBLE PRECISION floating-point * numbers on the target machine, and the risk of overflowing * IHMSF(4). For example, on the VAX, for ANGLE up to 2pi, the * available floating-point precision corresponds roughly to * NDP=12. However, the practical limit is NDP=9, set by the * capacity of the 32-bit integer IHMSF(4). * * 3) The absolute value of ANGLE may exceed 2pi. In cases where it * does not, it is up to the caller to test for and handle the * case where ANGLE is very nearly 2pi and rounds up to 24 hours, * by testing for IHMSF(1)=24 and setting IHMSF(1-4) to zero. * * Called: * sla_DD2TF * * P.T.Wallace Starlink 11 September 1990 *- IMPLICIT NONE INTEGER NDP DOUBLE PRECISION ANGLE CHARACTER SIGN*(*) INTEGER IHMSF(4) * Turns to radians DOUBLE PRECISION T2R PARAMETER (T2R=6.283185307179586476925287D0) * Scale then use days to h,m,s routine CALL sla_DD2TF(NDP,ANGLE/T2R,SIGN,IHMSF) END SUBROUTINE sla__IDCHF (STRING, NPTR, NVEC, NDIGIT, DIGIT) *+ * - - - - - - * I D C H F * - - - - - - * * Internal routine used by DFLTIN * * Identify next character in string * * Given: * STRING char string * NPTR int pointer to character to be identified * * Returned: * NPTR int incremented unless end of field * NVEC int vector for identified character * NDIGIT int 0-9 if character was a numeral * DIGIT double equivalent of NDIGIT * * NVEC takes the following values: * * 1 0-9 * 2 space or TAB !!! n.b. ASCII TAB assumed !!! * 3 D,d,E or e * 4 . * 5 + * 6 - * 7 , * 8 else * 9 outside field * * If the character is not 0-9, NDIGIT and DIGIT are either not * altered or are set to arbitrary values. * * P.T.Wallace Starlink 22 December 1992 *- IMPLICIT NONE CHARACTER*(*) STRING INTEGER NPTR,NVEC,NDIGIT DOUBLE PRECISION DIGIT CHARACTER K INTEGER NCHAR * Character/vector tables INTEGER NCREC PARAMETER (NCREC=19) CHARACTER KCTAB(NCREC) INTEGER KVTAB(NCREC) DATA KCTAB/'0','1','2','3','4','5','6','7','8','9', : ' ','D','d','E','e','.','+','-',','/ DATA KVTAB/10*1,2,4*3,4,5,6,7/ * Handle pointer outside field IF (NPTR.LT.1.OR.NPTR.GT.LEN(STRING)) THEN NVEC=9 ELSE * Not end of field: identify the character K=STRING(NPTR:NPTR) DO NCHAR=1,NCREC IF (K.EQ.KCTAB(NCHAR)) THEN * Recognized NVEC=KVTAB(NCHAR) NDIGIT=NCHAR-1 DIGIT=DBLE(NDIGIT) GO TO 2300 END IF END DO * Not recognized: check for TAB !!! n.b. ASCII assumed !!! IF (K.EQ.CHAR(9)) THEN * TAB: treat as space NVEC=2 ELSE * Unrecognized NVEC=8 END IF * Increment pointer 2300 CONTINUE NPTR=NPTR+1 END IF END SUBROUTINE sla_FLOTIN (STRING, NSTRT, RESLT, JFLAG) *+ * - - - - - - - * F L O T I N * - - - - - - - * * Convert free-format input into single precision floating point * * Given: * STRING c string containing number to be decoded * NSTRT i pointer to where decoding is to start * RESLT r current value of result * * Returned: * NSTRT i advanced to next number * RESLT r result * JFLAG i status: -1 = -OK, 0 = +OK, 1 = null, 2 = error * * Called: sla_DFLTIN * * Notes: * * 1 The reason FLOTIN 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 recognised by FLOTIN 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 E0. * * 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 RESLT is left untouched. * * 12 NSTRT = 1 for the first character in the string. * * 13 On return from FLOTIN, 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 FLOTIN, 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, * FLOTIN does not detect that '1E999' is unacceptable * (on the VAX) 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 DFLTIN and INTIN * * P.T.Wallace Starlink 30 March 1990 *- IMPLICIT NONE CHARACTER*(*) STRING INTEGER NSTRT REAL RESLT INTEGER JFLAG DOUBLE PRECISION DRESLT * Call the double precision version CALL sla_DFLTIN(STRING,NSTRT,DRESLT,JFLAG) IF (JFLAG.LE.0) RESLT=REAL(DRESLT) END C+ SUBROUTINE sla_INTIN (STRING, NSTRT, IRESLT, JFLAG) *+ * - - - - - - * I N T I N * - - - - - - * * Convert free-format input into an integer * * Given: * STRING c string containing number to be decoded * NSTRT i pointer to where decoding is to start * IRESLT i current value of result * * Returned: * NSTRT i advanced to next number * IRESLT i result * JFLAG i status: -1 = -OK, 0 = +OK, 1 = null, 2 = error * * Called: sla__IDCHI * * Notes: * * 1 The reason INTIN 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. * * 3 The basic format is the sequence of fields #^, where * # is a sign character + or -, and ^ means a string of * decimal digits. * * 4 Spaces: * * . Leading spaces are ignored. * * . Spaces between the sign and the number are allowed. * * . Trailing spaces are ignored; the first signifies * end of decoding and subsequent ones are skipped. * * 5 Delimiters: * * . Any character other than +,-,0-9 or space may be * used to signal the end of the number and terminate * decoding. * * . Comma is recognised by INTIN as a special case; it * is skipped, leaving the pointer on the next character. * See 9, below. * * 6 The sign is optional. The default is +. * * 7 A "null result" occurs when the string of characters being * decoded does not begin with +,- or 0-9, or consists * entirely of spaces. When this condition is detected, JFLAG * is set to 1 and IRESLT is left untouched. * * 8 NSTRT = 1 for the first character in the string. * * 9 On return from INTIN, 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 INTIN, otherwise * all subsequent calls will return a null result. * * 10 Errors (JFLAG=2) occur when: * * . there is a + or - but no number; or * * . the number is greater than BIG (defined below). * * 11 When an error has been detected, NSTRT is left * pointing to the character following the last * one used before the error came to light. * * 12 See also FLOTIN and DFLTIN. * * P.T.Wallace Starlink 2 August 1993 *- IMPLICIT NONE CHARACTER*(*) STRING INTEGER NSTRT,IRESLT,JFLAG * Maximum allowed value DOUBLE PRECISION BIG PARAMETER (BIG=2147483647D0) INTEGER JPTR,MSIGN,NVEC,J DOUBLE PRECISION DRES,DIGIT * Current character JPTR=NSTRT * Set defaults DRES=0D0 MSIGN=1 * Look for sign 100 CONTINUE CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT) GO TO ( 400, 100, 300, 200, 9110, 9100, 9110),NVEC * 0-9 SP + - , ELSE END * Negative 200 CONTINUE MSIGN=-1 * Look for first decimal 300 CONTINUE CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT) GO TO ( 400, 300, 9200, 9200, 9200, 9200, 9210),NVEC * 0-9 SP + - , ELSE END * Accept decimals 400 CONTINUE DRES=DRES*1D1+DIGIT * Test for overflow IF (DRES.GT.BIG) GO TO 9200 * Look for subsequent decimals CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT) GO TO ( 400, 1610, 1600, 1600, 1600, 1600, 1610),NVEC * 0-9 SP + - , ELSE END * Get result & status 1600 CONTINUE JPTR=JPTR-1 1610 CONTINUE J=0 IF (MSIGN.EQ.1) GO TO 1620 J=-1 DRES=-DRES 1620 CONTINUE IRESLT=INT(DNINT(DRES)) * Skip to end of field 1630 CONTINUE CALL sla__IDCHI(STRING,JPTR,NVEC,DIGIT) GO TO (1720, 1630, 1720, 1720, 9900, 1720, 9900),NVEC * 0-9 SP + - , ELSE END 1720 CONTINUE JPTR=JPTR-1 GO TO 9900 * Exits * Null field 9100 CONTINUE JPTR=JPTR-1 9110 CONTINUE J=1 GO TO 9900 * Errors 9200 CONTINUE JPTR=JPTR-1 9210 CONTINUE J=2 * Return 9900 CONTINUE NSTRT=JPTR JFLAG=J END SUBROUTINE sla__IDCHI (STRING, NPTR, NVEC, DIGIT) *+ * - - - - - - * I D C H I * - - - - - - * * Internal routine used by INTIN * * Identify next character in string * * Given: * STRING char string * NPTR int pointer to character to be identified * * Returned: * NPTR int incremented unless end of field * NVEC int vector for identified character * DIGIT double double precision digit if 0-9 * * NVEC takes the following values: * * 1 0-9 * 2 space or TAB !!! n.b. ASCII TAB assumed !!! * 3 + * 4 - * 5 , * 6 else * 7 outside string * * If the character is not 0-9, DIGIT is either unaltered or * is set to an arbitrary value. * * P.T.Wallace Starlink 22 December 1992 *- IMPLICIT NONE CHARACTER*(*) STRING INTEGER NPTR,NVEC DOUBLE PRECISION DIGIT CHARACTER K INTEGER NCHAR * Character/vector tables INTEGER NCREC PARAMETER (NCREC=14) CHARACTER KCTAB(NCREC) INTEGER KVTAB(NCREC) DATA KCTAB/'0','1','2','3','4','5','6','7','8','9', : ' ', '+','-',','/ DATA KVTAB/10*1,2,3,4,5/ * Handle pointer outside field IF (NPTR.LT.1.OR.NPTR.GT.LEN(STRING)) THEN NVEC=7 ELSE * Not end of field: identify character K=STRING(NPTR:NPTR) DO NCHAR=1,NCREC IF (K.EQ.KCTAB(NCHAR)) THEN * Recognized NVEC=KVTAB(NCHAR) DIGIT=DBLE(NCHAR-1) GO TO 2300 END IF END DO * Not recognized: check for TAB !!! n.b. ASCII assumed !!! IF (K.EQ.CHAR(9)) THEN * TAB: treat as space NVEC=2 ELSE * Unrecognized NVEC=6 END IF * Increment pointer 2300 CONTINUE NPTR=NPTR+1 END IF END