| 1 | #include "slalib.h"
|
|---|
| 2 | #include "slamac.h"
|
|---|
| 3 | #include <string.h>
|
|---|
| 4 | void slaDbjin ( char *string, int *nstrt,
|
|---|
| 5 | double *dreslt, int *jf1, int *jf2 )
|
|---|
| 6 | /*
|
|---|
| 7 | ** - - - - - - - - -
|
|---|
| 8 | ** s l a D b j i n
|
|---|
| 9 | ** - - - - - - - - -
|
|---|
| 10 | **
|
|---|
| 11 | ** Convert free-format input into double precision floating point,
|
|---|
| 12 | ** using slaDfltin but with special syntax extensions.
|
|---|
| 13 | **
|
|---|
| 14 | ** The purpose of the syntax extensions is to help cope with mixed
|
|---|
| 15 | ** FK4 and FK5 data. In addition to the syntax accepted by slaDfltin,
|
|---|
| 16 | ** the following two extensions are recognized by dbjin:
|
|---|
| 17 | **
|
|---|
| 18 | ** 1) A valid non-null field preceded by the character 'B'
|
|---|
| 19 | ** (or 'b') is accepted.
|
|---|
| 20 | **
|
|---|
| 21 | ** 2) A valid non-null field preceded by the character 'J'
|
|---|
| 22 | ** (or 'j') is accepted.
|
|---|
| 23 | **
|
|---|
| 24 | ** The calling program is notified of the incidence of either of these
|
|---|
| 25 | ** extensions through an supplementary status argument. The rest of
|
|---|
| 26 | ** the arguments are as for slaDfltin.
|
|---|
| 27 | **
|
|---|
| 28 | ** Given:
|
|---|
| 29 | ** *string char string containing field to be decoded
|
|---|
| 30 | ** *nstrt int where to start decode (1st = 1)
|
|---|
| 31 | **
|
|---|
| 32 | **
|
|---|
| 33 | ** Returned:
|
|---|
| 34 | ** *nstrt int incremented
|
|---|
| 35 | ** *dreslt double result
|
|---|
| 36 | ** *jf1 int dfltin status: -1 = -OK
|
|---|
| 37 | ** 0 = +OK
|
|---|
| 38 | ** +1 = null field
|
|---|
| 39 | ** +2 = error
|
|---|
| 40 | ** *jf2 int syntax flag: 0 = normal slaDfltin syntax
|
|---|
| 41 | ** +1 = 'B' or 'b'
|
|---|
| 42 | ** +2 = 'J' or 'j'
|
|---|
| 43 | **
|
|---|
| 44 | ** Called: slaDfltin
|
|---|
| 45 | **
|
|---|
| 46 | ** For details of the basic syntax, see slaDfltin.
|
|---|
| 47 | **
|
|---|
| 48 | ** Last revision: 22 December 1993
|
|---|
| 49 | **
|
|---|
| 50 | ** Copyright P.T.Wallace. All rights reserved.
|
|---|
| 51 | */
|
|---|
| 52 | {
|
|---|
| 53 | int j2a, lenstr, na, j1a, nb, j1b;
|
|---|
| 54 | char c;
|
|---|
| 55 |
|
|---|
| 56 | /* Preset syntax flag */
|
|---|
| 57 | j2a = 0;
|
|---|
| 58 |
|
|---|
| 59 | /* Length of string */
|
|---|
| 60 | lenstr = strlen ( string );
|
|---|
| 61 |
|
|---|
| 62 | /* Position of current character */
|
|---|
| 63 | na = *nstrt;
|
|---|
| 64 |
|
|---|
| 65 | /* Attempt normal decode */
|
|---|
| 66 | slaDfltin ( string, &na, dreslt, &j1a );
|
|---|
| 67 |
|
|---|
| 68 | /* Proceed only if pointer still within string */
|
|---|
| 69 | if ( ( na > 0 ) && ( na <= lenstr ) ) {
|
|---|
| 70 |
|
|---|
| 71 | /* See if slaDfltin reported a null field */
|
|---|
| 72 | if ( j1a == 1 ) {
|
|---|
| 73 |
|
|---|
| 74 | /* It did: examine character it stuck on */
|
|---|
| 75 | c = string[na-1];
|
|---|
| 76 | if ( c == 'B' || c == 'b' ) {
|
|---|
| 77 |
|
|---|
| 78 | /* 'B' or 'b' - provisionally note */
|
|---|
| 79 | j2a = 1;
|
|---|
| 80 |
|
|---|
| 81 | } else if ( c == 'J' || c == 'j' ) {
|
|---|
| 82 |
|
|---|
| 83 | /* 'J' or 'j' - provisionally note */
|
|---|
| 84 | j2a = 2;
|
|---|
| 85 | }
|
|---|
| 86 |
|
|---|
| 87 | /* Following B or J, attempt to decode a number */
|
|---|
| 88 | if ( j2a == 1 || j2a == 2 ) {
|
|---|
| 89 | nb = na + 1;
|
|---|
| 90 | slaDfltin ( string, &nb, dreslt, &j1b );
|
|---|
| 91 |
|
|---|
| 92 | /* If successful, copy pointer and status */
|
|---|
| 93 | if ( j1b <= 0 ) {
|
|---|
| 94 | na = nb;
|
|---|
| 95 | j1a = j1b;
|
|---|
| 96 |
|
|---|
| 97 | /* If not, forget about the B or J */
|
|---|
| 98 | } else {
|
|---|
| 99 | j2a = 0;
|
|---|
| 100 | }
|
|---|
| 101 | }
|
|---|
| 102 | }
|
|---|
| 103 | }
|
|---|
| 104 |
|
|---|
| 105 | /* Return argument values and exit */
|
|---|
| 106 | *nstrt = na;
|
|---|
| 107 | *jf1 = j1a;
|
|---|
| 108 | *jf2 = j2a;
|
|---|
| 109 | }
|
|---|
