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