61 subroutine planet_position(jd,pl, lat,lon,hgt, LBaccur,Raccur, ltime,aber,to_fk5,assume_jde, &
62 lunar_theory,nutat,magmdl, verbosity)
64 use sufr_kinds,
only: double
65 use sufr_constants,
only: pi,pi2, r2d,r2h, au,earthr,pland, enpname, jd2000
66 use sufr_system,
only: warn, quit_program_error
67 use sufr_angles,
only: rev, rev2
68 use sufr_dummy,
only: dumdbl1,dumdbl2
69 use sufr_text,
only: d2s
70 use sufr_numerics,
only: deq0
86 real(double),
intent(in) :: jd
87 integer,
intent(in) :: pl
88 real(double),
intent(in),
optional :: lat,lon,hgt, LBaccur,Raccur
89 logical,
intent(in),
optional :: ltime,aber,to_fk5, assume_jde
90 integer,
intent(in),
optional :: lunar_theory, nutat,magmdl, verbosity
92 integer :: j, llunar_theory, lnutat,lmagmdl, lverb
93 real(double) :: jdl,jde,jde_lt, tjm,tjm0, llat,llon,lhgt, lLBaccur,lRaccur, dpsi,eps0,deps,eps,tau,tau1
94 real(double) :: hcl0,hcb0,hcr0, hcl,hcb,hcr, hcl00,hcb00,hcr00, sun_gcl,sun_gcb, gcx,gcy,gcz, gcx0,gcy0,gcz0, dhcr
95 real(double) :: gcl,gcb,delta,gcl0,gcb0,delta0
96 real(double) :: ra,dec,gmst,agst,lst,hh,az,alt,elon, topra,topdec,topl,topb,topdiam,topdelta,tophh,topaz,topalt
97 real(double) :: diam,illfr,pa,magn, parang,parang_ecl,hp, rES1,rES2
98 logical :: lltime,laber,lto_fk5
101 gcl0 = 0.d0; gcb0 = 0.d0; hcr00 = 0.d0
102 gcx = 0.d0; gcy = 0.d0; gcz = 0.d0
103 gcx0 = 0.d0; gcy0 = 0.d0; gcz0 = 0.d0
104 topdelta = 0.d0; delta0 = 0.d0
116 if(
present(lat)) llat = lat
117 if(
present(lon)) llon = lon
118 if(
present(hgt)) lhgt = hgt
123 if(
present(lbaccur)) llbaccur = lbaccur
124 if(
present(raccur)) lraccur = raccur
128 if(
present(ltime)) lltime = ltime
131 if(
present(aber)) laber = aber
134 if(
present(to_fk5)) lto_fk5 = to_fk5
139 if(
present(lunar_theory)) llunar_theory = lunar_theory
140 if(llunar_theory.lt.1 .or. llunar_theory.gt.3) &
141 call quit_program_error(
'planet_position(): lunar_theory must be 1, 2 or 3', 1)
145 if(
present(nutat))
then
147 if(lnutat.ne.1980 .and. lnutat.ne.2000 .and. lnutat.ne.0) &
148 call quit_program_error(
'planet_position(): nutat must be 2000, 1980 or 0', 1)
153 if(
present(magmdl))
then
155 if(lmagmdl.lt.1 .or. lmagmdl.gt.4) &
156 call quit_program_error(
'planet_position(): magmdl must be 1-4', 1)
161 if(
present(verbosity)) lverb = verbosity
170 if(
present(assume_jde) .and. assume_jde)
then
172 jdl = jde -
deltat/86400.d0
174 jde = jdl +
deltat/86400.d0
177 tjm = (jde-jd2000)/365250.d0
180 print*,
'JD: ', d2s(jdl,8)
181 print*,
'DeltaT: ', d2s(
deltat,3)
182 print*,
'JDE: ', d2s(jde,8)
183 print*,
't_jm: ', d2s(tjm,10)
186 call vsop87d_lbr(tjm,3, hcl0,hcb0,hcr0, llbaccur,lraccur)
195 print*,
't_jm: ', d2s(tjm, 10)
196 print*,
'Heliocentric longitude Earth: ', d2s(modulo(hcl0,pi2)*r2d, 9),
' deg'
197 print*,
'Heliocentric latitude Earth: ', d2s(hcb0*r2d, 9),
' deg'
198 print*,
'Heliocentric distance Earth: ', d2s(hcr0, 9),
' au'
203 tau = 0.d0; tau1 = 0.d0
205 do while(deq0(tau1) .or. abs((tau1-tau)/tau1).gt.1.d-10)
208 tjm = tjm0 - tau/365250.d0
209 jde_lt = jd2000 + tjm*365250
210 hcl = 0.d0; hcb = 0.d0; hcr = 0.d0
214 if(pl.gt.0.and.pl.lt.9)
call vsop87d_lbr(tjm,pl, hcl,hcb,hcr, llbaccur,lraccur)
215 if(pl.eq.9)
call plutolbr(tjm*10.d0, hcl,hcb,hcr)
216 if(pl.gt.10000)
call asteroid_lbr(tjm,pl-10000, hcl,hcb,hcr)
218 call vsop87d_lbr(tjm,3, hcl,hcb,hcr, llbaccur,lraccur)
220 select case(llunar_theory)
235 select case(llunar_theory)
245 if(pl.ne.0.and.pl.lt.10 .or. pl.gt.10000)
then
252 if(pl.eq.3) delta = hcr
256 if(pl.gt.10.and.pl.lt.10000) &
257 call cometgc(tjm,tjm0, pl, hcr,gcl,gcb,delta)
262 if(abs(tau).gt.1.d-10)
call warn(
'planet_position(): tau != 0 on first light-time iteration', 0)
277 tau1 = 5.77551830441d-3 * delta
282 print*,
'Iteration: ', j
290 print*,
't_jm: ', d2s(tjm, 10)
291 print*,
'Heliocentric longitude: ', d2s(modulo(hcl,pi2)*r2d, 9),
' deg'
292 print*,
'Heliocentric latitude: ', d2s(hcb*r2d, 9),
' deg'
293 print*,
'Heliocentric distance: ', d2s(hcr, 9),
' au'
295 print*,
'Geocentric x: ', d2s(gcx, 9),
' au'
296 print*,
'Geocentric y: ', d2s(gcy, 9),
' au'
297 print*,
'Geocentric z: ', d2s(gcz, 9),
' au'
299 print*,
'Geocentric longitude: ', d2s(modulo(gcl,pi2)*r2d, 9),
' deg'
300 print*,
'Geocentric latitude: ', d2s(gcb*r2d, 9),
' deg'
301 print*,
'True geocentric distance: ', d2s(delta0, 9),
' au'
302 print*,
'Apparent geocentric distance: ', d2s(delta, 9),
' au'
304 print*,
'JDE_i: ', d2s(jde_lt, 9)
305 print*,
't_jm: ', d2s(tjm, 10)
306 print*,
'Light time: ', d2s(tau,9),
' day'
307 print*,
'Light time1: ', d2s(tau1,9),
' day'
316 call warn(
'planet_position(): Light time failed to converge for '//trim(enpname(pl)), 0)
327 print*,
'Number of iterations: ', j
328 print*,
'Final light time: ', d2s(tau, 9)
329 print*,
'Final t_Jm: ', d2s(tjm, 10)
334 select case(llunar_theory)
365 print*,
'Planet after light-time iterations, before correction for nutation, aberration, FK5:'
366 print*,
'Final t_jm: ', d2s(tjm, 10)
367 print*,
'Final heliocentric longitude: ', d2s(modulo(hcl,pi2)*r2d, 9),
' deg'
368 print*,
'Final heliocentric latitude: ', d2s(hcb*r2d, 9),
' deg'
369 print*,
'Final heliocentric distance: ', d2s(hcr, 9),
' au'
371 print*,
'Final geocentric x: ', d2s(gcx, 9),
' au'
372 print*,
'Final geocentric y: ', d2s(gcy, 9),
' au'
373 print*,
'Final geocentric z: ', d2s(gcz, 9),
' au'
375 print*,
'Final geocentric longitude: ', d2s(modulo(gcl,pi2)*r2d, 9),
' deg'
376 print*,
'Final geocentric latitude: ', d2s(gcb*r2d, 9),
' deg'
377 print*,
'Final (true) geocentric distance: ', d2s(delta, 9),
' au'
379 print*,
'Final jde_i: ', d2s(jde_lt, 9)
380 print*,
'Final t_jm: ', d2s(tjm, 10)
381 print*,
'Final light time: ', d2s(tau,9),
' day'
382 print*,
'Final light time1: ', d2s(tau1,9),
' day'
387 if(lnutat.eq.1980)
then
403 if(lto_fk5)
call fk5(tjm, gcl,gcb)
408 sun_gcl = rev(hcl0+pi)
413 if(lto_fk5)
call fk5(tjm, sun_gcl,sun_gcb)
414 sun_gcl = sun_gcl + dpsi
418 call fk5(tjm, hcl,hcb)
419 call fk5(tjm, hcl0,hcb0)
420 call fk5(tjm, hcl00,hcb00)
425 print*,
'Convert to the FK5 system: ', lto_fk5
426 print*,
'True heliocentric longitude, FK5: ', d2s(modulo(hcl00,pi2)*r2d, 9),
' deg'
427 print*,
'True heliocentric latitude, FK5: ', d2s(hcb00*r2d, 9),
' deg'
428 print*,
'True heliocentric distance: ', d2s(hcr00, 9),
' au'
439 agst = rev(gmst + dpsi*cos(eps))
440 lst = rev(agst + llon)
444 if(pl.ge.0.and.pl.lt.10) diam = atan(pland(pl)/(delta*au))
452 call geoc2topoc_ecl(gcl,gcb, delta,diam/2.d0, eps,lst, topl,topb,topdiam, lat=llat,hgt=lhgt)
453 if(pl.eq.-1) topdiam = res2
455 if(pl.ge.0.and.pl.lt.10) topdelta = pland(pl)/tan(topdiam)/au
459 call eq2horiz(ra,dec,agst, hh,az,alt, lat=llat,lon=llon)
463 elon = acos(cos(gcb)*cos(hcb0)*cos(gcl-rev(hcl0+pi)))
464 if(pl.gt.10) elon = acos((hcr0**2 + delta**2 - hcr**2)/(2*hcr0*delta))
468 call ecl_2_eq(topl,topb,eps, topra,topdec)
469 call eq2horiz(topra,topdec,agst, tophh,topaz,topalt, lat=llat,lon=llon)
474 pa = atan2( hcr0*sin(elon) , delta - hcr0*cos(elon) )
475 else if(pl.gt.0)
then
476 pa = acos( (hcr**2 + delta**2 - hcr0**2) / (2*hcr*delta) )
478 illfr = 0.5d0*(1.d0 + cos(pa))
482 if(pl.gt.0.and.pl.lt.10)
then
484 if(pl.eq.6) magn = magn +
dsatmagn(tjm*10., gcl,gcb)
487 if(pl.eq.0) magn =
moonmagn(pa,delta)
491 if(pl.gt.10 .and. pl.lt.10000)
then
505 parang = atan2(sin(tophh),tan(llat)*cos(topdec) - sin(topdec)*cos(tophh))
506 parang_ecl = atan( (cos(topl)*tan(eps)) / (sin(topl)*sin(topb)*tan(eps) - cos(topb)) )
509 hp = asin(earthr/(delta*au))
513 if(pl.eq.0) hcr = 0.d0
547 print*,
'Final apparent geocentric longitude: ', d2s(rev(gcl)*r2d, 9),
' deg'
548 print*,
'Final apparent geocentric latitude: ', d2s(rev2(gcb)*r2d, 9),
' deg'
549 print*,
'Final apparent geocentric distance: ', d2s(delta, 9),
' au'
550 print*,
'Final apparent heliocentric distance: ', d2s(hcr, 9),
' au'
552 print*,
'Final apparent geocentric right ascension: ', d2s(rev(ra)*r2h, 9),
' hr'
553 print*,
'Final apparent geocentric declination: ', d2s(dec*r2d, 9),
' deg'
595 planpos(41) = rev(hcl0+pi+dpsi)
61 subroutine planet_position(jd,pl, lat,lon,hgt, LBaccur,Raccur, ltime,aber,to_fk5,assume_jde, &
…
644 use sufr_kinds,
only: double
645 use sufr_constants,
only: d2r
649 real(double),
intent(in) :: t
650 real(double),
intent(out) :: l,b,r
652 real(double) :: j,s,p,a, cosa,sina
654 j = 34.35d0 + 3034.9057d0 * t
655 s = 50.08d0 + 1222.1138 * t
656 p = 238.96d0 + 144.96d0 * t
666 l = l +
plul(i,1)*sina +
plul(i,2)*cosa
667 b = b +
plub(i,1)*sina +
plub(i,2)*cosa
668 r = r +
plur(i,1)*sina +
plur(i,2)*cosa
671 l = ( l*1.d-6 + 238.958116d0 + 144.96d0*t ) * d2r
672 b = ( b*1.d-6 - 3.908239d0 ) * d2r
673 r = r*1.d-7 + 40.7241346d0
701 use sufr_kinds,
only: double
702 use sufr_constants,
only: d2r, jd2000
703 use sufr_system,
only: quit_program_error
704 use sufr_angles,
only: rev
705 use sufr_numerics,
only: deq0
712 real(double),
intent(in) :: jd
714 real(double) :: jde,tm,tms(0:3)
716 if(deq0(
plelemdata(1,1,1,1)))
call quit_program_error(
'planetelements(): did you forget to call readplanetelements()?', 0)
719 jde = jd +
deltat/86400.d0
720 tm = (jde-jd2000)/36525.d0
740 if(el.ne.2.and.el.ne.3)
then
772 use sufr_kinds,
only: double
773 use sufr_constants,
only: r2d
774 use sufr_system,
only: quit_program_error
777 integer,
intent(in) :: pl
778 integer,
intent(in),
optional :: model
779 integer :: lpl, lmodel
780 real(double),
intent(in) :: hc_dist,gc_dist,phang
785 if(
present(model)) lmodel = model
789 if(lmodel.eq.1 .and. pl.eq.1) pa = pa - 50.d0
797 a0 = [-1.16d0, 4.d0, 0.d0, 1.3d0, 8.93d0, 8.68d0, 6.85d0, 7.05d0, 1.d0] * (-1)
798 a1 = [ 2.838d0, 1.322d0, 0.d0, 1.486d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-2
799 a2 = [ 1.023d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-4
800 a3 = [ 0.d0, 0.4247d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-6
802 else if(lmodel.eq.2)
then
804 a0 = [ 0.42d0, 4.40d0, 0.d0, 1.52d0, 9.40d0, 8.88d0, 7.19d0, 6.87d0, 1.00d0] * (-1)
805 a1 = [ 3.80d0, 0.09d0, 0.d0, 1.6d0, 0.5d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-2
806 a2 = [-2.73d0, 2.39d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-4
807 a3 = [ 2.d0, -0.65d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-6
809 else if(lmodel.eq.3)
then
811 a0 = [ 0.36d0, 4.29d0, 0.d0, 1.52d0, 9.25d0, 8.88d0, 7.19d0, 6.87d0, 1.00d0] * (-1)
812 a1 = [ 3.80d0, 0.09d0, 0.d0, 1.6d0, 0.5d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-2
813 a2 = [-2.73d0, 2.39d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-4
814 a3 = [ 2.d0, -0.65d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-6
816 else if(lmodel.eq.4)
then
818 a0 = [ 0.60d0, 4.47d0, -0.98d0, 1.52d0, 9.40d0, 8.88d0, 7.19d0, 6.87d0, 1.01d0] * (-1)
819 a1 = [ 4.98d0, 1.03d0, -1.02d0, 1.6d0, 0.5d0, 4.4d0, 0.2d0, 0.d0, 0.d0] * 1.d-2
820 a2 = [-4.88d0, 0.57d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-4
821 a3 = [ 3.02d0, 0.13d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0, 0.d0] * 1.d-6
823 if(pl.eq.2 .and. pa.gt.163.6d0) lpl = 3
825 call quit_program_error(
'planet_magnitude(): model must be 1-4', 0)
828 planet_magnitude = 5*log10(hc_dist*gc_dist) + a0(lpl) + a1(lpl)*pa + a2(lpl)*pa2 + a3(lpl)*pa3
858 use sufr_kinds,
only: double
859 use sufr_constants,
only: d2r,r2d
860 use sufr_angles,
only: rev2
863 real(double),
intent(in) :: t, gl,gb,d, l,b,r
864 integer,
intent(in),
optional :: magmdl
865 real(double) ::
satmagn, in,om,bbb,n,ll,bb,u1,u2,du
869 if(
present(magmdl)) lmagmdl = magmdl
871 in = 0.490005d0 - 2.2686d-4*t + 7.d-8*t**2
872 om = 2.9584809d0 + 0.0243418d0*t + 7.19d-6*t**2
874 bbb = asin( sin(in)*cos(gb)*sin(gl-om) - cos(in)*sin(gb) )
875 n = (113.6655d0 + 0.8771d0*t)*d2r
876 ll = l - 0.01759d0*d2r/r
877 bb = b - 7.64d-4*d2r * cos(l-n)/r
879 u1 = atan2( sin(in)*sin(bb) + cos(in)*cos(bb)*sin(ll-om) , cos(bb)*cos(ll-om) )
880 u2 = atan2( sin(in)*sin(gb) + cos(in)*cos(gb)*sin(gl-om) , cos(gb)*cos(gl-om) )
881 du = abs(rev2(u1-u2))
883 if(lmagmdl.eq.1)
then
885 satmagn = -8.68d0 + 5.d0*log10(d*r) + 0.044d0*abs(du)*r2d - 2.60d0*sin(abs(bbb)) + 1.25d0*(sin(bbb))**2
888 satmagn = -8.88d0 + 5.d0*log10(d*r) + 0.044d0*abs(du)*r2d - 2.60d0*sin(abs(bbb)) + 1.25d0*(sin(bbb))**2
908 use sufr_kinds,
only: double
909 use sufr_angles,
only: rev2
912 real(double),
intent(in) :: tjc, glon,glat
913 real(double) ::
dsatmagn, inc,omg, bbb
915 inc = 0.490005d0 - 2.2686d-4*tjc + 7.d-8*tjc**2
916 omg = 2.9584809d0 + 0.0243418d0*tjc + 7.19d-6*tjc**2
918 bbb = asin( sin(inc)*cos(glat)*sin(glon-omg) - cos(inc)*sin(glat) )
920 dsatmagn = -2.60d0*sin(abs(bbb)) + 1.25d0*(sin(bbb))**2
938 use sufr_kinds,
only: double
939 use sufr_constants,
only: au, earthr,planr
942 real(double),
intent(in) :: dm0,ds0
943 real(double),
intent(out) :: r1,r2
944 real(double) :: rs,re,ds,dm,p1,ps,ss
952 p1 = asin(re/dm) * 0.998340d0
956 r1 = 1.02d0 * (p1 + ps - ss)
957 r2 = 1.02d0 * (p1 + ps + ss)
981 use sufr_kinds,
only: double
982 use sufr_constants,
only: d2r, pi, jd1900
983 use sufr_angles,
only: rev
991 real(double),
intent(in) :: jd
992 real(double),
intent(out) :: de,ds, omg1,omg2, dphase, pa, in,om
993 real(double) :: jde,d,t1,t2,t3
994 real(double) :: alp0,del0,w1,w2,x,y,z,eps0,eps,dpsi,l,b,alps,dels, r,r0,l0
995 real(double) :: u,v,alp,del,dze,delta,l1,b1
1006 jde = jd +
deltat/86400.d0
1009 d = jde - 2433282.5d0
1012 t2 = (jde - jd1900)/36525.d0
1013 in = (3.120262d0 + 0.0006d0 * t2) * d2r
1015 t3 = jde - 2443000.5d0 -
planpos(7)
1016 om = (316.518203d0 - 2.08362d-6*t3) * d2r
1017 om = om + (1.3966626d0*t1 + 3.088d-4*t1**2)*d2r
1019 alp0 = rev((268.d0 + 0.1061d0*t1)*d2r)
1020 del0 = rev((64.5d0 - 0.0164d0*t1)*d2r)
1023 w1 = rev((17.710d0 + 877.90003539d0*d)*d2r)
1024 w2 = rev((16.838d0 + 870.27003539d0*d)*d2r)
1047 ds = -sin(del0)*sin(dels) - cos(del0)*cos(dels)*cos(alp0-alps)
1050 u = y*cos(eps0) - z*sin(eps0)
1051 v = y*sin(eps0) + z*cos(eps0)
1053 alp = rev(atan2(u,x))
1054 del = atan2(v,sqrt(x**2+u**2))
1055 dze = rev( atan2( sin(del0)*cos(del)*cos(alp0-alp) - sin(del)*cos(del0) , cos(del)*sin(alp0-alp) ) )
1058 de = -sin(del0)*sin(del) - cos(del0)*cos(del)*cos(alp0-alp)
1061 dphase = abs( (2*r*delta + r0**2 - r**2 - delta**2)/(4*r*delta) ) * sin(l-l0)/abs(sin(l-l0))
1064 omg1 = rev(w1 - dze - 5.07033d0*d2r * delta + dphase)
1065 omg2 = rev(w2 - dze - 5.02626d0*d2r * delta + dphase)
1068 call eq_2_ecl(alp0,del0,eps0, l1,b1)
1069 call ecl_2_eq(l1+dpsi,b1,eps, alp0,del0)
1072 pa = atan2( cos(del0)*sin(alp0-alp) , sin(del0)*cos(del) - cos(del0)*sin(del)*cos(alp0-alp) )
1104 subroutine saturnphys(jd, be,bs, pa, in,om, ar,br, du, pa_s, ar_s,br_s)
1105 use sufr_kinds,
only: double
1106 use sufr_constants,
only: pi, as2r,d2r
1107 use sufr_angles,
only: rev
1113 real(double),
intent(in) :: jd
1114 real(double),
intent(out) :: be,bs, pa, in,om, ar,br, du, pa_s, ar_s,br_s
1116 real(double) :: t, lam,bet, d,l,b,r, l0,b0,r0, x,y,z, dpsi,eps, ascn
1117 real(double) :: l2,b2, u1,u2, lam0,bet0, dl,db, ra,dec, ra0,dec0, sinbe
1150 in = (28.075216d0 - 0.012998d0*t + 4.d-6 * t**2) * d2r
1151 om = (169.508470d0 + 1.394681d0*t + 4.12d-4 * t**2) * d2r
1154 sinbe = sin(in)*cos(bet)*sin(lam-om) - cos(in)*sin(bet)
1155 ar = 375.35d0*as2r/d
1163 l2 = l - 0.01759d0*d2r / r
1164 b2 = b - 7.64d-4*d2r * cos(l-ascn) / r
1167 bs = asin(sin(in)*cos(b2)*sin(l2-om) - cos(in)*sin(b2))
1170 u1 = atan2(sin(in)*sin(b2) + cos(in)*cos(b2)*sin(l2-om), cos(b2)*cos(l2-om))
1171 u2 = atan2(sin(in)*sin(bet) + cos(in)*cos(bet)*sin(lam-om), cos(bet)*cos(lam-om))
1181 dl = 0.005693d0*d2r * cos(l0-lam)/cos(bet)
1182 db = 0.005693d0*d2r * sin(l0-lam)*sin(bet)
1193 call ecl_2_eq(lam0,bet0,eps, ra0,dec0)
1196 pa = atan2(cos(dec0)*sin(ra0-ra),sin(dec0)*cos(dec) - cos(dec0)*sin(dec)*cos(ra0-ra))
1104 subroutine saturnphys(jd, be,bs, pa, in,om, ar,br, du, pa_s, ar_s,br_s)
…
1227 use sufr_kinds,
only: double
1228 use sufr_angles,
only: rev,rev2
1237 real(double),
intent(in) :: jd
1238 integer,
intent(in) :: pl
1239 integer,
intent(in),
optional :: calc,nt
1240 real(double),
intent(in),
optional :: lat,lon
1242 integer :: lcalc,lnt
1243 real(double) :: dh_ref, parAng, dRA_ref
1246 if(
present(calc)) lcalc = calc
1248 if(
present(lat))
lat0 = lat
1249 if(
present(lon))
lon0 = lon
1259 if(
present(nt)) lnt = nt
1268 call planet_position(jd,pl, lbaccur=1.d-6,raccur=1.d-4, ltime=.false.)
1274 if(pl.eq.0 .or. pl.eq.3)
then
1299 dra_ref = dh_ref / cos(
planpos(26)) * sin(parang)
1320 use sufr_kinds,
only: double
1321 use sufr_constants,
only: pi
1322 use sufr_angles,
only: rev2
1325 real(double),
intent(in) :: phaseang
1328 theta = rev2(pi - phaseang)
1335 phi = d90/(1+d90) * (k*((1+gf**2)/(1+gf**2 - 2*gf*cos(theta)))**1.5d0 + &
1336 k*((1+gb**2)/(1+gb**2 - 2*gb*cos(theta)))**1.5d0 + 1.d0/d90)
Procedures for asteroids.
subroutine asteroid_lbr(t, as, l, b, r)
Calculate heliocentric ecliptical coordinates l,b,r for asteroid as at time t (Julian Millennia after...
real(double) function asteroid_magn(as, delta, r, pa)
Calculate asteroid magnitude for asteroid AS.
Data to compute comet positions.
logical, dimension(ncometsmax) cometdiedatp
This comet died at perihelion (true/false)
real(double), dimension(ncometsmax, 9) cometelems
Orbital elements of the comets: 1: JD of epoch (often J2000), 2: Perihelion distance (AU?...
subroutine cometgc(t, t0, comid, r, l, b, d)
Calc geocentric lbr coordinates for comet com at t1 (in Julian millennia Dynamical Time)
Procedures for coordinates.
real(double) function refract(alt, press, temp)
Compute the atmospheric refraction for a given true altitude. You should add the result to the uncorr...
subroutine eq2horiz(ra, dec, agst, hh, az, alt, lat, lon)
Convert spherical equatorial coordinates (RA, dec, agst) to spherical horizontal coordinates (hh,...
subroutine eq_2_ecl(ra, dec, eps, l, b)
Convert (geocentric) spherical equatorial coordinates RA, Dec (and eps) to spherical ecliptical coord...
subroutine rect_2_spher(x, y, z, l, b, r)
Convert rectangular coordinates x,y,z to spherical coordinates l,b,r.
subroutine ecl_2_eq(l, b, eps, ra, dec)
Convert (geocentric) spherical ecliptical coordinates l,b (and eps) to spherical equatorial coordinat...
subroutine fk5(t, l, b)
Convert coordinates to the FK5 system.
subroutine hc_spher_2_gc_rect(l, b, r, l0, b0, r0, x, y, z)
Compute the geocentric rectangular coordinates of a planet, from its and the Earth's heliocentric sph...
subroutine aberration_ecl(t, l0, l, b)
Correct ecliptic longitude and latitiude for annual aberration.
subroutine precess_ecl(jd1, jd2, l, b)
Compute the precession of the equinoxes in geocentric ecliptical coordinates.
subroutine geoc2topoc_eq(gcra, gcd, gcr, gch, tcra, tcd, lat, hgt)
Convert geocentric equatorial coordinates to topocentric.
subroutine geoc2topoc_ecl(gcl, gcb, gcr, gcs, eps, lst, tcl, tcb, tcs, lat, hgt)
Convert spherical ecliptical coordinates from the geocentric to the topocentric system.
Date and time procedures.
real(double) function calc_gmst(jd, deltat)
Calculate Greenwich Mean Sidereal Time for any instant, in radians.
real(double) function calc_deltat(jd, force_recompute)
Compute DeltaT for a given JD.
Local parameters for libTheSky: location, date, time.
real(double) height
Altitude of the observer above sea level (m)
real(double) lon0
Longitude of the observer (rad)
real(double) deltat
Current value of DeltaT (s)
real(double) lat0
Latitude of the observer (rad)
subroutine elp82b_lbr(tjj, ll, bb, rr)
Calculate the apparent geocentric ecliptical position of the Moon, using the Lunar Solution ELP 2000-...
real(double) function moonmagn(pa, delta)
Calculate the magnitude of the Moon.
subroutine elp_mpp02_lbr(jd, mode, lon, lat, rad, precess)
Compute the spherical lunar coordinates using the ELP2000/MPP02 lunar theory in the dynamical mean ec...
subroutine moonpos_la(jd, calc, nt)
Quick, lower-accuracy lunar coordinates; ~600x faster than ELP.
subroutine nutation(t, dpsi, eps0, deps)
Calculate nutation - cheap routine from Meeus - as well as the mean obliquity of the ecliptic.
subroutine nutation2000(jd, dpsi_tot, deps_tot, eps0)
Compute nutation using the IAU 2000 model. Add the mean obliquity of the ecliptic by Laskar (1986).
Planet data, needed to compute planet positions.
integer, dimension(43, 2) plub
Constants for the latitude of Pluto.
real(double), dimension(8, 6) plelems
Planet orbital elements for Equation of Data.
integer pl0
Remember a special planet.
real(double), dimension(nplanpos) planpos
Planpos[] is an array with many different types of coordinates and related variables:
real(double), dimension(8, 6) plelems2000
Planet orbital elements for J2000.
integer, dimension(43, 2) plur
Constants for the distance of Pluto.
real(double), dimension(2, 8, 6, 0:3) plelemdata
Data to compute planet orbital elements.
integer, dimension(43, 3) pluc
Constants for the periodic terms for the position of Pluto.
integer, dimension(43, 2) plul
Constants for the longitude of Pluto.
subroutine earthshadow(dm0, ds0, r1, r2)
Calculate the umbra and penumbra geocentric radii of the Earth's shadow.
subroutine planet_position(jd, pl, lat, lon, hgt, lbaccur, raccur, ltime, aber, to_fk5, assume_jde, lunar_theory, nutat, magmdl, verbosity)
Compute the position, distance, etc of a planet.
real(double) function satmagn(t, gl, gb, d, l, b, r, magmdl)
Calculate Saturn's magnitude.
subroutine planet_position_la(jd, pl, calc, nt, lat, lon)
Compute low-accuracy planet positions. Sun and Moon have dedicated routines, for planets abridged VSO...
subroutine planetelements(jd)
Calculate orbital elements for the planets.
subroutine jupiterphys(jd, de, ds, omg1, omg2, dphase, pa, in, om)
Compute physical data for Jupiter.
real(double) function dsatmagn(tjc, glon, glat)
Calculate a correction to Saturn's magnitude due to its rings.
subroutine saturnphys(jd, be, bs, pa, in, om, ar, br, du, pa_s, ar_s, br_s)
Compute physical data for Saturn.
real(double) function comet_scatter_magnitude_correction(phaseang)
Correction for comet magnitude due to forward and backscattering.
real(double) function planet_magnitude(pl, hc_dist, gc_dist, phang, model)
Calculate planet magnitude.
subroutine plutolbr(t, l, b, r)
Calculate Pluto's position l,b,r at time t.
Low-accuracy procedures for the Sun.
real(double) function sunmagn(dist)
Calculate Sun magnitude.
subroutine sunpos_la(jd, calc, lat, lon)
Low-accuracy solar coordinates.
subroutine vsop87d_lbr(tm, pl, lon, lat, rad, lbaccur, raccur)
Calculate true heliocentric ecliptic coordinates l,b,r for planet pl and the mean ecliptic and equino...