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 | }
|
---|