/**********************************************************
function nacalc ()
calculates an array of planet longitudes and speeds,
as needed for complete nathan data records.
The function knows itself how many planets and in which mode
they have to be calculated for Nathan.
return OK or ERR
The returned positions are in centiseconds, our standard
coordinate format for fast mathematics with planetary positions.
This function is just a template of how the calc() package
can be used.
**********************************************************/
int nacalc (double jd_ad, /* universal time relative julian date */
centisec *plon, /* returned longitudes */
centisec *pspe /* returned speeds, if not NULL pointer */
)
{
char err[AS_MAXCH];
int planet, flag;
double rlng, rrad, rlat, rspeed;
int result = OK;
flag = CALC_BIT_SPEED; /* same, with speed */
jd_ad += deltat( jd_ad ); /* ET = UT + Delta_T */
for (planet = SUN; planet <= MAXPL_NACALC; planet++) {
if (calc (planet, jd_ad, flag, &rlng, &rrad, &rlat, &rspeed) == OK) {
plon [planet] = swe_csnorm(swe_d2l (rlng * DEG));
if (pspe != NULL) pspe [planet] = swe_d2l (rspeed * DEG);
} else {
plon [planet] = -1;
if (pspe != NULL) pspe [planet] = 0;
if (result != ERR) { /* save first error message */
strcpy(err, placalc_get_errtext());
}
result = ERR;
}
}
if (result == ERR)
strcpy(perrtx, err);
return result;
} /* end nacalc */
void robot::Disabled()
{
while (IsDisabled()) {
dt = deltat(t);
feed();
Wait(0.005);
}
}
/******************************************************************
* calculation server
* delivers positions in string format which can be sent easily
* over a communication line to the calculation client.
* if plalist = 0, only SUN .. CHIRON are delivered, no LILITH
******************************************************************/
int calcserv(int id, /* request id, random number to prevent phase err */
double jd_ad, /* time as relative Astrodienst julian date */
int flag, /* a set of CALC_BIT_ bitflags */
int plalist,/* bit list of planets to be computed, 0 = all */
char *so) /* output string, MUST BE LONG ENOUGH (800 bytes)*/
{
int p, planet, so_len;
double rlng, rrad, rlat, rspeed, rau[CALC_N];
centisec lcs[CALC_N], lpcs[CALC_N], betcs[CALC_N];
char s[AS_MAXCH];
if (plalist == 0) plalist = (1 << 13) - 1; /* sun .. chiron */;
/*
* flag determines whether deltat is added to t;
* if CALC_BIT_EPHE is set, jd_ad is considered as ephemeris time,
* otherwise as universal time.
*/
if ((flag & CALC_BIT_EPHE) == 0) {
jd_ad += deltat (jd_ad);
}
for (p = SUN; p < CALC_N; p++) {
if (! check_bit(plalist, p)) continue;
if (calc (p, jd_ad, flag, &rlng, &rrad, &rlat, &rspeed) == OK) {
lcs [p] = swe_d2l (rlng * DEG);
lpcs [p] = swe_d2l (rspeed * DEG);
betcs [p] = swe_d2l (rlat * DEG);
rau [p] = rrad;
} else {
sprintf(so,"error at planet %d", p);
return ( ERR);
}
}
/*
* format comma separated list: id,teph,flag,plalist,ekl,nut
* double is given with 8 digits precision after decimal point,
* all angles are given in centiseconds.
* then for each requested planet: longitude (csec)
* then for each requested planet, if wanted: speed (csec/day)
* then for each requested planet, if wanted: latitude (csec)
* then for each requested planet, if wanted: rgeo (units 0..999)
* then for each requested planet, if wanted: rau (A.U.)
*/
sprintf (so, "%d,%.8f,%d,%d,%d,%d", id, jd_ad, flag, plalist,
swe_d2l(ekl * DEG), swe_d2l (nut * DEG) );
so_len = strlen (so);
for (planet = SUN; planet < CALC_N; planet++) {
if (! check_bit(plalist, planet)) continue;
sprintf (s ,",%d", lcs[planet]);
strcat (so + so_len, s);
so_len += strlen (s);
}
if (flag & CALC_BIT_SPEED) {
for (planet = SUN; planet < CALC_N; planet++) {
if (! check_bit(plalist, planet)) continue;
sprintf (s ,",%d", lpcs[planet]);
strcat (so + so_len, s);
so_len += strlen (s);
}
}
if (flag & CALC_BIT_BETA) {
for (planet = SUN; planet < CALC_N; planet++) {
if (! check_bit(plalist, planet)) continue;
sprintf (s ,",%d", betcs[planet]);
strcat (so + so_len, s);
so_len += strlen (s);
}
}
if (flag & CALC_BIT_RGEO) {
for (planet = SUN; planet < CALC_N; planet++) {
if (! check_bit(plalist, planet)) continue;
sprintf (s ,",%d", rel_geo(planet,rau[planet]));
strcat (so + so_len, s);
so_len += strlen (s);
}
}
if (flag & CALC_BIT_RAU) {
for (planet = SUN; planet < CALC_N; planet++) {
if (! check_bit(plalist, planet)) continue;
sprintf (s ,",%.8f", rau[planet]);
strcat (so + so_len, s);
so_len += strlen (s);
}
}
return (OK);
} /* end calcserv */
int main(int argc, char* argv[])
{
bool verb;
char *what;
int nz, nx, na, iz, ix, ia, order, jx, ja, scheme;
float x, dx, x0, a, da, a0, dz, dz2, t, sx, sa;
float amax, xmax, x2, a1, a2, s2, tn;
float **next, **vxz, s, grad[2], grad2[2];
sf_eno2 prev, slow;
sf_file vel, out;
sf_init(argc,argv);
vel = sf_input("in");
out = sf_output("out");
if (!sf_histint(vel,"n2",&nx)) sf_error("No n2=");
if (!sf_histfloat(vel,"d2",&dx)) sf_error("No d2=");
if (!sf_histfloat(vel,"o2",&x0)) sf_error("No o2=");
if (!sf_histint(vel,"n1",&nz)) sf_error("No n2=");
if (!sf_histfloat(vel,"d1",&dz)) sf_error("No d2=");
if (!sf_getint("na",&na)) sf_error("Need na=");
/* angle samples */
if (!sf_getfloat("da",&da)) sf_error("Need da=");
/* angle sampling */
if (!sf_getfloat("a0",&a0)) sf_error("Need a0=");
/* starting velocity */
sf_putint(out,"n1",na);
sf_putint(out,"n2",nx);
sf_putint(out,"n3",nz);
sf_putfloat(out,"d1",da);
sf_putfloat(out,"d2",dx);
sf_putfloat(out,"d3",dz);
sf_putfloat(out,"o1",a0);
sf_putfloat(out,"o2",x0);
sf_putfloat(out,"o3",0.);
sf_putstring(out,"label1","Angle");
sf_putstring(out,"unit1","\\^o\\_");
/* convert to radians */
a0 *= SF_PI/180.;
da *= SF_PI/180.;
amax = a0 + (na-1)*da;
xmax = x0 + (nx-1)*dx;
if (!sf_getint("order",&order)) order=3;
/* interpolation order */
if (!sf_getint("scheme",&scheme)) scheme=2;
/* finite-difference order */
if (!sf_getbool("verb",&verb)) verb=false;
/* verbosity */
what = sf_getstring("what");
/* what to compute (t,x,z,a) */
if (NULL == what) {
what = "time";
} else {
if (what[0] != 't' &&
what[0] != 'x' &&
what[0] != 'z' &&
what[0] != 'a')
sf_error("Need what=t|x|z|a");
}
slow = sf_eno2_init (order,nz,nx);
vxz = sf_floatalloc2(nz,nx);
sf_floatread(vxz[0],nz*nx,vel);
/* convert velocity to slowness */
for (ix=0; ix < nx; ix++) {
for (iz=0; iz < nz; iz++) {
vxz[ix][iz] = 1./vxz[ix][iz];
}
}
sf_eno2_set(slow,vxz);
free(*vxz);
free(vxz);
prev = sf_eno2_init(order,na,nx);
next = sf_floatalloc2(na,nx);
for (ix=0; ix < nx; ix++) {
x = x0+ix*dx;
for (ia=0; ia < na; ia++) {
switch (what[0]) {
case 't':
case 'z':
next[ix][ia] = 0.;
break;
case 'x':
next[ix][ia] = x;
break;
case 'a':
a = a0+ia*da;
next[ix][ia] = a*180./SF_PI;
}
}
}
sf_eno2_set(prev,next);
sf_floatwrite(next[0],na*nx,out);
for (iz=1; iz < nz; iz++) {
if (verb) sf_warning("depth %d of %d",iz,nz);
for (ix=0; ix < nx; ix++) {
x = x0+ix*dx;
/* slowness and gradient at starting point */
sf_eno2_apply (slow,iz,ix,0.,0.,&s,grad,BOTH);
for (ia=0; ia < na; ia++) {
a = a0+ia*da;
if (scheme > 1) {
/* half a step in a */
a1 = a + 0.5*(grad[1]/dx+
grad[0]*tanf(a)/dz)*dz/s;
/* check if angle is in range */
if (a1 < a0) {
a1=a0;
} else if (a1 > amax) {
a1=amax;
}
} else {
a1 = a;
}
tn = tanf(a1);
/* full step in x */
x2 = x + tn*dz;
/* check if space is in range */
if (x2 < x0) {
x2 = x0;
jx = 0;
sx = 0.;
dz2 = (x0-x)/tn;
} else if (x2 > xmax) {
x2 = xmax;
jx = nx-1;
sx = 0.;
dz2 = (xmax-x)/tn;
} else {
sx = (x2-x0)/dx;
jx=floorf(sx);
sx -= jx;
dz2 = dz;
}
/* slowness and gradient at new location */
sf_eno2_apply (slow,iz-1,jx,1.-dz2/dz,sx,
&s2,grad2,BOTH);
if (scheme > 1) {
/* half a step in a */
a2 = a1 + 0.5*(grad2[1]/dx+
grad2[0]*tn/dz)*dz2/s2;
} else {
/* full step in a */
a2 = a1 + (grad2[1]/dx+
grad2[0]*tn/dz)*dz2/s2;
}
/* check if angle is in range */
if (a2 < a0) {
a2=a0;
} else if (a2 > amax) {
a2=amax;
}
if (dz2 != dz) { /* exit from the side */
switch (what[0]) {
case 't':
t = deltat(scheme,dz,dz,dx,
s,s2,a,a2,grad,grad2);
break;
case 'x':
t = x2;
break;
case 'z':
t = iz*dz-dz2;
break;
case 'a':
t = a2*180./SF_PI;
break;
}
} else { /* exit to the previous level */
sa = (a2-a0)/da;
ja=floorf(sa);
sa -= ja;
sf_eno2_apply (prev,ja,jx,sa,sx,
&t,NULL,FUNC);
if ('t'==what[0])
t += deltat(scheme,dz,dz,dx,
s,s2,a,a2,grad,grad2);
}
next[ix][ia] = t;
}
}
sf_eno2_set(prev,next);
sf_floatwrite(next[0],na*nx,out);
}
exit(0);
}
