void palEqecl ( double dr, double dd, double date, double *dl, double *db ) {
double v1[3], v2[3];
double rmat[3][3];
/* Spherical to Cartesian */
eraS2c( dr, dd, v1 );
/* Mean J2000 to mean of date */
palPrec( 2000.0, palEpj(date), rmat );
eraRxp( rmat, v1, v2 );
/* Equatorial to ecliptic */
palEcmat( date, rmat );
eraRxp( rmat, v2, v1 );
/* Cartesian to spherical */
eraC2s( v1, dl, db );
/* Express in conventional range */
*dl = eraAnp( *dl );
*db = palDrange( *db );
}
void palRefro( double zobs, double hm, double tdk, double pmb,
double rh, double wl, double phi, double tlr,
double eps, double * ref ) {
/*
* Fixed parameters
*/
/* 93 degrees in radians */
const double D93 = 1.623156204;
/* Universal gas constant */
const double GCR = 8314.32;
/* Molecular weight of dry air */
const double DMD = 28.9644;
/* Molecular weight of water vapour */
const double DMW = 18.0152;
/* Mean Earth radius (metre) */
const double S = 6378120.;
/* Exponent of temperature dependence of water vapour pressure */
const double DELTA = 18.36;
/* Height of tropopause (metre) */
const double HT = 11000.;
/* Upper limit for refractive effects (metre) */
const double HS = 80000.;
/* Numerical integration: maximum number of strips. */
const int ISMAX=16384l;
/* Local variables */
int is, k, n, i, j;
int optic, loop; /* booleans */
double zobs1,zobs2,hmok,tdkok,pmbok,rhok,wlok,alpha,
tol,wlsq,gb,a,gamal,gamma,gamm2,delm2,
tdc,psat,pwo,w,
c1,c2,c3,c4,c5,c6,r0,tempo,dn0,rdndr0,sk0,f0,
rt,tt,dnt,rdndrt,sine,zt,ft,dnts,rdndrp,zts,fts,
rs,dns,rdndrs,zs,fs,refold,z0,zrange,fb,ff,fo,fe,
h,r,sz,rg,dr,tg,dn,rdndr,t,f,refp,reft;
/* The refraction integrand */
#define refi(DN,RDNDR) RDNDR/(DN+RDNDR)
/* Transform ZOBS into the normal range. */
zobs1 = palDrange(zobs);
zobs2 = DMIN(fabs(zobs1),D93);
/* keep other arguments within safe bounds. */
hmok = DMIN(DMAX(hm,-1e3),HS);
tdkok = DMIN(DMAX(tdk,100.0),500.0);
pmbok = DMIN(DMAX(pmb,0.0),10000.0);
rhok = DMIN(DMAX(rh,0.0),1.0);
wlok = DMAX(wl,0.1);
alpha = DMIN(DMAX(fabs(tlr),0.001),0.01);
/* tolerance for iteration. */
tol = DMIN(DMAX(fabs(eps),1e-12),0.1)/2.0;
/* decide whether optical/ir or radio case - switch at 100 microns. */
optic = wlok < 100.0;
/* set up model atmosphere parameters defined at the observer. */
wlsq = wlok*wlok;
gb = 9.784*(1.0-0.0026*cos(phi+phi)-0.00000028*hmok);
if (optic) {
a = (287.6155+(1.62887+0.01360/wlsq)/wlsq) * 273.15e-6/1013.25;
} else {
a = 77.6890e-6;
}
gamal = (gb*DMD)/GCR;
gamma = gamal/alpha;
gamm2 = gamma-2.0;
delm2 = DELTA-2.0;
tdc = tdkok-273.15;
psat = pow(10.0,(0.7859+0.03477*tdc)/(1.0+0.00412*tdc)) *
(1.0+pmbok*(4.5e-6+6.0e-10*tdc*tdc));
if (pmbok > 0.0) {
pwo = rhok*psat/(1.0-(1.0-rhok)*psat/pmbok);
} else {
pwo = 0.0;
}
w = pwo*(1.0-DMW/DMD)*gamma/(DELTA-gamma);
c1 = a*(pmbok+w)/tdkok;
if (optic) {
c2 = (a*w+11.2684e-6*pwo)/tdkok;
} else {
c2 = (a*w+6.3938e-6*pwo)/tdkok;
}
c3 = (gamma-1.0)*alpha*c1/tdkok;
c4 = (DELTA-1.0)*alpha*c2/tdkok;
if (optic) {
c5 = 0.0;
c6 = 0.0;
} else {
c5 = 375463e-6*pwo/tdkok;
c6 = c5*delm2*alpha/(tdkok*tdkok);
}
/* conditions at the observer. */
r0 = S+hmok;
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,c1,c2,c3,c4,c5,c6,
r0,&tempo,&dn0,&rdndr0);
sk0 = dn0*r0*sin(zobs2);
f0 = refi(dn0,rdndr0);
/* conditions in the troposphere at the tropopause. */
rt = S+DMAX(HT,hmok);
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,c1,c2,c3,c4,c5,c6,
rt,&tt,&dnt,&rdndrt);
sine = sk0/(rt*dnt);
zt = atan2(sine,sqrt(DMAX(1.0-sine*sine,0.0)));
ft = refi(dnt,rdndrt);
/* conditions in the stratosphere at the tropopause. */
pal1Atms(rt,tt,dnt,gamal,rt,&dnts,&rdndrp);
sine = sk0/(rt*dnts);
zts = atan2(sine,sqrt(DMAX(1.0-sine*sine,0.0)));
fts = refi(dnts,rdndrp);
/* conditions at the stratosphere limit. */
rs = S+HS;
pal1Atms(rt,tt,dnt,gamal,rs,&dns,&rdndrs);
sine = sk0/(rs*dns);
zs = atan2(sine,sqrt(DMAX(1.0-sine*sine,0.0)));
fs = refi(dns,rdndrs);
/* variable initialization to avoid compiler warning. */
reft = 0.0;
/* integrate the refraction integral in two parts; first in the
* troposphere (k=1), then in the stratosphere (k=2). */
for (k=1; k<=2; k++) {
/* initialize previous refraction to ensure at least two iterations. */
refold = 1.0;
/* start off with 8 strips. */
is = 8;
/* start z, z range, and start and end values. */
if (k==1) {
z0 = zobs2;
zrange = zt-z0;
fb = f0;
ff = ft;
} else {
z0 = zts;
zrange = zs-z0;
fb = fts;
ff = fs;
}
/* sums of odd and even values. */
fo = 0.0;
fe = 0.0;
/* first time through the loop we have to do every point. */
n = 1;
/* start of iteration loop (terminates at specified precision). */
loop = 1;
while (loop) {
/* strip width. */
h = zrange/((double)is);
/* initialize distance from earth centre for quadrature pass. */
if (k == 1) {
r = r0;
} else {
r = rt;
}
/* one pass (no need to compute evens after first time). */
for (i=1; i<is; i+=n) {
/* sine of observed zenith distance. */
sz = sin(z0+h*(double)(i));
/* find r (to the nearest metre, maximum four iterations). */
if (sz > 1e-20) {
w = sk0/sz;
rg = r;
dr = 1.0e6;
j = 0;
while ( fabs(dr) > 1.0 && j < 4 ) {
j++;
if (k==1) {
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,
c1,c2,c3,c4,c5,c6,rg,&tg,&dn,&rdndr);
} else {
pal1Atms(rt,tt,dnt,gamal,rg,&dn,&rdndr);
}
dr = (rg*dn-w)/(dn+rdndr);
rg = rg-dr;
}
r = rg;
}
/* find the refractive index and integrand at r. */
if (k==1) {
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,
c1,c2,c3,c4,c5,c6,r,&t,&dn,&rdndr);
} else {
pal1Atms(rt,tt,dnt,gamal,r,&dn,&rdndr);
}
f = refi(dn,rdndr);
/* accumulate odd and (first time only) even values. */
if (n==1 && i%2 == 0) {
fe += f;
} else {
fo += f;
}
}
/* evaluate the integrand using simpson's rule. */
refp = h*(fb+4.0*fo+2.0*fe+ff)/3.0;
/* has the required precision been achieved (or can't be)? */
if (fabs(refp-refold) > tol && is < ISMAX) {
/* no: prepare for next iteration.*/
/* save current value for convergence test. */
refold = refp;
/* double the number of strips. */
is += is;
/* sum of all current values = sum of next pass's even values. */
fe += fo;
/* prepare for new odd values. */
fo = 0.0;
/* skip even values next time. */
n = 2;
} else {
/* yes: save troposphere component and terminate the loop. */
if (k==1) reft = refp;
loop = 0;
}
}
}
/* result. */
*ref = reft+refp;
if (zobs1 < 0.0) *ref = -(*ref);
}
