Fortsetzung 

.
.
.
PROCEDURE netz
  COLOR 1
  FOR ll1=0 TO PI*2 STEP RAD(10)
    n=1
    FOR ll2=PI/2 TO -PI/2-0.05 STEP -0.05
      IF numr=1 THEN
        GOSUB hoh
        d=ho
        ar=az
      ELSE
        d=ll2
        ar=ll1
      ENDIF
      GOSUB mat
      IF n=1 THEN
        n=0
        c=POINT(xx,yy)
        COLOR 0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      COLOR 1
      IF h>=0 THEN
        DRAW  TO xx,yy
      ENDIF
    NEXT ll2
  NEXT ll1
  FOR ll2=PI/2 TO -PI/2 STEP -RAD(10)
    n=1
    FOR ll1=0 TO PI*2+0.05 STEP 0.05
      IF numr=1 THEN
        GOSUB hoh
        d=ho
        ar=az
      ELSE
        d=ll2
        ar=ll1
      ENDIF
      GOSUB mat
      IF n=1 THEN
        n=0
        c=POINT(xx,yy)
        COLOR 0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      COLOR 1
      IF h>=0 THEN
        DRAW  TO xx,yy
      ENDIF
    NEXT ll1
  NEXT ll2
RETURN
PROCEDURE ekl
  FOR el=0 TO PI*2 STEP RAD(30)
    n=1
    FOR eb=PI/2 TO -PI/2-0.05 STEP -0.05
      GOSUB ekli
      IF numr=1 THEN
        GOSUB hoh
        d=ho
        ar=az
      ELSE
        d=ll2
        ar=ll1
      ENDIF
      GOSUB mat
      IF n=1 THEN
        n=0
        c=POINT(xx,yy)
        COLOR 0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      COLOR 1
      IF h>=0 THEN
        DRAW  TO xx,yy
      ENDIF
    NEXT eb
  NEXT el
  FOR eb=PI/2 TO -PI/2 STEP -RAD(30)
    n=1
    FOR el=0 TO PI*2+0.05 STEP 0.05
      GOSUB ekli
      IF numr=1 THEN
        GOSUB hoh
        d=ho
        ar=az
      ELSE
        d=ll2
        ar=ll1
      ENDIF
      GOSUB mat
      IF n=1 THEN
        n=0
        c=POINT(xx,yy)
        COLOR 0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      COLOR 1
      IF h>=0 THEN
        DRAW  TO xx,yy
      ENDIF
    NEXT el
  NEXT eb
RETURN
PROCEDURE gal
  FOR gl=0 TO PI*2 STEP RAD(30)
    n=1
    FOR gbr=PI/2 TO -PI/2-0.05 STEP -0.05
      gaeql(gbr,gl,jd,ll2,ll1)
      IF numr=1 THEN
        GOSUB hoh
        d=ho
        ar=az
      ELSE
        d=ll2
        ar=ll1
      ENDIF
      GOSUB mat
      IF n=1 THEN
        n=0
        c=POINT(xx,yy)
        COLOR 0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      COLOR 1
      IF h>=0 THEN
        DRAW  TO xx,yy
      ENDIF
    NEXT gbr
  NEXT gl
  FOR gbr=PI/2 TO -PI/2 STEP -RAD(30)
    n=1
    FOR gl=0 TO PI*2+0.05 STEP 0.05
      gaeql(gbr,gl,jd,ll2,ll1)
      IF numr=1 THEN
        GOSUB hoh
        d=ho
        ar=az
      ELSE
        d=ll2
        ar=ll1
      ENDIF
      GOSUB mat
      IF n=1 THEN
        n=0
        c=POINT(xx,yy)
        COLOR 0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      COLOR 1
      IF h>=0 THEN
        DRAW  TO xx,yy
      ENDIF
    NEXT gl
  NEXT gbr
RETURN
PROCEDURE gaeql(gbr,gl,jd,VAR ll2,ll1)
  GOSUB prae
  ll2=ASIN(SIN(gp1)*SIN(gbr)+COS(gp1)*COS(gbr)*SIN(gl-ln1))
  y=(COS(gbr)*COS(gl-ln1))/COS(ll2)
  x=(COS(gp1)*SIN(gbr)-SIN(gp1)*COS(gbr)*SIN(gl-ln1))/COS(ll2)
  IF x<-0.9999999999 THEN
    ll1=PI
  ELSE
    ll1=FN z(ATN(y/(1+x))*2+gp2)
  ENDIF
RETURN
PROCEDURE prae
  ln=RAD(32.94)
 zo=RAD(60.18679)
  llo=RAD(270.02)
  kn=RAD(333.452)
  no=0.0002278765*t
  th1=3.052168685-0.00421695255*t
  th=0.02438175*t
  ii=ACOS(COS(zo)*COS(no)+SIN(zo)*SIN(no)*COS(llo-th1))
  y=(SIN(zo)*SIN(llo-th1))/SIN(ii)
  x=(-SIN(no)*COS(zo)+COS(no)*SIN(zo)*COS(llo-th1))/SIN(ii)
  kn1=FN z(ATN(y/(1+x))*2+th1+th)
  y=(-SIN(no)*SIN(llo-th1))/SIN(ii)
  x=(SIN(zo)*COS(no)-COS(zo)*SIN(no)*COS(llo-th1))/SIN(ii)
  ww=FN z(kn-ATN(y/(1+x))*2)
  d=FN z(5.198467+7771.377*t)
  f=FN z(1.62791+8433.466*t)
  af=FN z(2.18244-33.757*t)
  REM NUTATION IN BREITE (AUSZUG)
  nu1=(92000*COS(af)+5740*COS(-2*d+2*f+2*af)+980*COS(2*f+2*af)-890*COS(2*af))/10000
  f7=0.4090928042223 !Mittl. Ekliptikschiefe
  e=f7+RAD(nu1/3600)
  j=ACOS(COS(ii)*COS(e)-SIN(ii)*SIN(e)*COS(kn1))
  gp1=PI/2-j
  y=(SIN(ii)*SIN(kn1))/SIN(j)
  x=(COS(ii)*SIN(e)+SIN(ii)*COS(e)*COS(kn1))/SIN(j)
  wo=FN z(ATN(y/(1+x))*2)
  wo=PI*2-wo
  gp2=PI*2-FN z(wo+PI/2)
  y=(SIN(e)*SIN(kn1))/SIN(j)
  x=(SIN(ii)*COS(e)+COS(ii)*SIN(e)*COS(kn1))/SIN(j)
  wow=FN z(ATN(y/(1+x))*2)
  IF wow>=0 AND wow<PI THEN
    wow=wow+PI*2
  ENDIF
  kl=wow-ww
  ln1=FN z(ln-kl)
RETURN
PROCEDURE ekli
  ll2=COS(ec)*SIN(eb)+SIN(ec)*COS(eb)*SIN(el)
  IF ABS(ll2)>=1 THEN
    ll2=0.9999999999*SGN(ll2)
  ENDIF
  ll2=ASIN(ll2)
  x=(COS(eb)*COS(el))/COS(ll2)
  y=(COS(ec)*COS(eb)*SIN(el)-SIN(ec)*SIN(eb))/COS(ll2)
  IF x<=-0.9999999999 THEN
    ll1=PI
  ELSE
    ll1=FN z(ATN(y/(1+x))*2)
  ENDIF
RETURN
PROCEDURE ta
  IF numr=1 THEN
    n=145
  ELSE
    n=135
  ENDIF
  GET 1,1,300,n,o$
  DEFFILL 0,2,8
  PBOX 1,1,300,n
  COLOR 1
  BOX 1,1,300,n
  n=0
  PRINT AT(2,2);"Taste >E< - Ekliptikales Gradnetz"
  PRINT AT(2,3);"Taste >G< - Galaktisches Gradnetz"
  IF numr=1 THEN
    n=1
    PRINT AT(2,4);"Taste >H< - Horizontales Gradnetz"
  ENDIF
  PRINT AT(2,4+n);"Taste >I< - Information"
  PRINT AT(2,5+n);"Taste >K< - Koordinatenanzeige"
  PRINT AT(2,6+n);"Taste >N< - Äquatoriales Gradnetz"
  PRINT AT(2,7+n);"Taste >S< - Neustart"
  PRINT "LEERTASTE"
  REPEAT
  UNTIL UPPER$(INKEY$)=" "
  PUT 1,1,o$,3
  o$=""
RETURN
PROCEDURE stern
  r1=0
  DEFFILL 1,2,8
  REM mm=ANZAHL STERNE,L1=AR,L2=DEKLIN., L4,L3=EIGENBWEUNG PRO JAHR, c=Nr. Sternbild, d=Nr. griech. Alphabet, e$=Name, f$=mag, g$=Entf., rx=Radialgeschwindigkeit
  REM  OPEN "I",#1,"DAT.C" !DATA- DISKETTE HINTERGRUNGSTERNE
  REM  FOR o1%=1 TO 115
  REM  INPUT #1,j1,mm,l1,l2,l4,l3,c,d,e$,f$,g$,rx
  REM  f=VAL(f$)
  REM  g=VAL(g$)
  REM  GOSUB st
  REM  FOR pu%=2 TO mm
  REM  INPUT #1,l1,l2,l4,l3,c,d,e$,f$,g$,rx
  REM  f=VAL(f$)
  REM  g=VAL(g$)
  REM  GOSUB st
  REM NEXT pu%
  REM NEXT o1%
  REM   CLOSE #1
  REM ODER -------
  RESTORE sterndat  !DATA-DATEI HINTERGRUNDSTERNE
  FOR o1%=1 TO 2
    READ j1,mm,l1,l2,l4,l3,c,d,f,g,rx,s$,e$
    GOSUB st
    FOR pu%=2 TO mm
      READ l1,l2,l4,l3,c,d,f,g,rx,s$,e$
      GOSUB st
    NEXT pu%
  NEXT o1%
RETURN
PROCEDURE st
  l4=(l4/1000)/rab
  l3=(l3/100)/raa
  l1=RAD(l1)
  l2=RAD(l2)
  ent=g/lya
  xx1=ent*COS(l2)*COS(l1)
  yy1=ent*COS(l2)*SIN(l1)
  zz1=ent*SIN(l2)
  rdi=rx/rac
  xax=(xx1/ent)*rdi-zz1*l3*COS(l1)-yy1*l4
  yay=(yy1/ent)*rdi-zz1*l3*SIN(l1)+xx1*l4
  zaz=(zz1/ent)*rdi+ent*l3*COS(l2)
  x1=xx1+xax*f62
  y1=yy1+yay*f62
  z1=zz1+zaz*f62
  ent1=SQR(x1*x1+y1*y1+z1*z1)
  l2=z1/ent1
  IF ABS(l2)>=1 THEN
    l2=0.999999999*SGN(l2)
  ENDIF
  l2=ASIN(l2)
  x1=x1/(ent1*COS(l2))
  y1=y1/(ent1*COS(l2))
  IF x1<-0.999999999 THEN
    l1=PI
  ELSE
    l1=FN z(ATN(y1/(1+x1))*2)
  ENDIF
  hlk=f+5-5*LOG10(ent)
  up1=hlk-5+5*LOG10(ent1)
  IF ABS(a4)<3000 THEN
    GOSUB praez1
  ELSE
    GOSUB eklpr
  ENDIF
  IF numr=1 THEN
    GOSUB hoh
    d=ho
    ar=az
  ELSE
    d=ll2
    ar=ll1
  ENDIF
  GOSUB mat
  IF h>=0 AND xx>=0 AND xx<=640 AND yy>=0 AND yy<=400 THEN
    ADD r1,1
    xx(r1)=INT(xx)
    yy(r1)=INT(yy)
    ll2(r1)=ll2
    ll1(r1)=ll1
    up1(r1)=up1
    e$(r1)=e$
    ent1(r1)=ent1
    ent(r1)=ent
    c1(r1)=c
    d(r1)=d
    rx(r1)=rx
    s$(r1)=s$
    xx1(r1)=xx1
    yy1(r1)=yy1
    zz1(r1)=zz1
    xax(r1)=xax
    yay(r1)=yay
    zaz(r1)=zaz
    IF alig=0 THEN
      IF numr=1 THEN
        ho(r1)=ho
        az(r1)=FN z(PI*2-az)
      ENDIF
      PCIRCLE xx,yy,4.5-up1
    ELSE
      IF j1=1 THEN
        j1=0
        PLOT xx,yy
      ENDIF
      IF xx<-10 OR xx>650 OR yy<-10 OR yy>420 THEN
        PLOT xx,yy
      ENDIF
      DRAW  TO xx,yy
    ENDIF
  ENDIF
RETURN
PROCEDURE sternz
  d=FN z(5.198467+7771.3771*t)  !Delaunay-Elemente
  f=FN z(1.62791+8433.4662*t)
  af=FN z(2.18244-33.757045*t)
  REM NUTATION IN LÄNGE UND BREITE (AUSZUG)
  nu=(-17200*SIN(af)-13190*SIN(-2*d+2*f+2*af)-2270*SIN(2*f+2*af))/10000
  nu1=(92000*COS(af)+5740*COS(-2*d+2*f+2*af)+980*COS(2*f+2*af))/10000
  f7=0.4090928042223 !Mittl. Ekliptikschiefe
  ec=f7+RAD(nu1/3600)
  f8=6.697374558333+0.05133690722222*t3
  fa8=2400*t3
  f8=f8+fa8-INT(fa8/24)*24
  f8=f8-INT(f8/24)*24
  f9=f8+ut*1.002737909+((nu*COS(fa7))/15)/3600+lgeo/15
  ru=f9-INT(f9/24)*24
RETURN
PROCEDURE mil  !Milchstrasse
RESTORE mil
FOR o1%=1 TO 7
  READ j1,mm,l1,l2
  l1=RAD(l1)
  l2=RAD(l2)
  IF ABS(a4)<3000 THEN
    GOSUB praez1
  ELSE
    GOSUB eklpr
  ENDIF
  IF numr=1 THEN
    GOSUB hoh
    d=ho
    ar=az
  ELSE
    d=ll2
    ar=ll1
  ENDIF
  GOSUB mat
  GOSUB plot
  FOR pu%=2 TO mm
    READ l1,l2
    l1=RAD(l1)
    l2=RAD(l2)
    IF ABS(a4)<3000 THEN
      GOSUB praez1
    ELSE
      GOSUB eklpr
    ENDIF
    IF numr=1 THEN
      GOSUB hoh
      d=ho
      ar=az
    ELSE
      d=ll2
      ar=ll1
    ENDIF
    GOSUB mat
    GOSUB plot
  NEXT pu%
NEXT o1%
RETURN
PROCEDURE plot
  COLOR 1
  IF j1=1 THEN
    j1=0
    c=POINT(xx,yy)
    COLOR 0
    PLOT xx,yy
  ENDIF
  IF xx<0 OR xx>620 OR yy<0 OR yy>400 THEN
    PLOT xx,yy
  ENDIF
  COLOR 1
  IF h>=0 THEN
    DRAW  TO xx,yy
  ENDIF
RETURN
PROCEDURE j
  j9=FN z(0.011181*t)
  j4=FN z(0.011181*t)
  j3=FN z(0.009717173*t)
  tha=FN z(3.0521687-0.0042169526*t)
  pia=0.0002278765*t
  pps=FN z(0.02438175*t)
RETURN
PROCEDURE eklpr
  br=SIN(l2)*COS(ec)-COS(l2)*SIN(ec)*SIN(l1)
  IF ABS(br)>=1 THEN
    br=0.9999999999*SGN(br)
  ENDIF
  br=ASIN(br)
  x=(COS(l2)*COS(l1))/COS(br)
  y=(SIN(l2)*SIN(ec)+COS(l2)*COS(ec)*SIN(l1))/COS(br)
  IF x<=-0.999999999999 THEN
    el=PI
  ELSE
    el=FN z(ATN(y/(1+x))*2)
  ENDIF
  br1=SIN(pia)*COS(br)*SIN(tha-el)+COS(pia)*SIN(br)
  IF ABS(br1)>=1 THEN
    br1=0.99999999999*SGN(br1)
  ENDIF
  br1=ASIN(br1)
  x=(COS(br)*COS(tha-el))/COS(br1)
  y=(COS(pia)*COS(br)*SIN(tha-el)-SIN(pia)*SIN(br))/COS(br1)
  IF x<=-0.999999999999 THEN
    el1=PI
  ELSE
    el1=FN z(ATN(y/(1+x))*2)
  ENDIF
  el1=FN z(tha+pps-el1)
  ll2=SIN(br1)*COS(ec)+COS(br1)*SIN(ec)*SIN(el1)
  IF ABS(ll2)>=1 THEN
    ll2=0.9999999999*SGN(ll2)
  ENDIF
  ll2=ASIN(ll2)
  x=(COS(br1)*COS(el1))/COS(ll2)
  y=(COS(br1)*COS(ec)*SIN(el1)-SIN(br1)*SIN(ec))/COS(ll2)
  IF x<=-0.999999999999 THEN
    ll1=PI
  ELSE
    ll1=FN z(ATN(y/(1+x))*2)
  ENDIF
RETURN
PROCEDURE praez1
  ll2=SIN(j3)*COS(l2)*COS(l1+j9)+COS(j3)*SIN(l2)
  IF ABS(ll2)>=1 THEN
    ll2=0.9999999999*SGN(ll2)
  ENDIF
  ll2=ASIN(ll2)
  y=(COS(l2)*SIN(l1+j9))/COS(ll2)
  x=(COS(j3)*COS(l2)*COS(l1+j9)-SIN(j3)*SIN(l2))/COS(ll2)
  IF x<=-0.999999999999 THEN
    ll1=FN z(PI+j4)
  ELSE
    ll1=FN z(ATN(y/(1+x))*2+j4)
  ENDIF
RETURN
PROCEDURE exit
  GET 160,150,460,185,o$
  DEFFILL 0,2,8
  PBOX 160,150,460,185
  COLOR 1
  BOX 160,150,460,185
  PRINT AT(30,11);"Taste >R< - Ausgang"
  FOR o=0 TO 30000
  NEXT o
  PUT 160,150,o$,3
  o$=""
RETURN
PROCEDURE info1
  GOSUB exit
  SHOWM
  DO
    FOR r2=1 TO r1
      SHOWM
      x=MOUSEX
      y=MOUSEY
      z=MOUSEK
      IF x=xx(r2) AND y=yy(r2) THEN
        SHOWM
        GOSUB infor
      ENDIF
      SHOWM
    NEXT r2
    w$=UPPER$(INKEY$)
    IF w$="R" THEN
      GOTO en1
    ENDIF
  LOOP
  en1:
  HIDEM
RETURN
PROCEDURE infor
  HIDEM
  IF numr=1 THEN
    n=205
  ELSE
    n=170
  ENDIF
  GET 1,1,290,n,o$
  DEFFILL 0,2,8
  PBOX 1,1,290,n
  COLOR 1
  BOX 1,1,290,n
  n=0
  PRINT AT(2,2);"Bezeichnung: ";h2$(d(r2));" ";h4$(c1(r2))
  PRINT AT(2,3);"Name: ";e$(r2)
  PRINT AT(2,4);"Sternbild: ";h3$(c1(r2))
  PRINT AT(2,5);"Rektaszension: ";ROUND(DEG(ll1(r2))/15,5);" h"
  PRINT AT(2,6);"Deklination..: ";ROUND(DEG(ll2(r2)),6);CHR$(248)
  IF numr=1 THEN
    n=2
    PRINT AT(2,7);"H”he.........: ";ROUND(DEG(ho(r2)),5);CHR$(248)
    PRINT AT(2,8);"Azimut.......: ";ROUND(DEG(az(r2)),4);CHR$(248)
  ENDIF
  PRINT AT(2,7+n);"Entfernung...: ";ROUND(ent1(r2)*lya,1);" Lichtjahre"
  PRINT AT(2,8+n);"Helligkeit...: ";ROUND(up1(r2),2);" mag"
  PRINT AT(2,9+n);"Spektraltyp..: ";s$(r2)
  PRINT AT(2,10+n);"Radial.......: ";rx(r2);" km/s"
PROCEDURE prae
  ln=RAD(32.94)
  DO
    x=MOUSEX
    y=MOUSEY
    IF x<>xx(r2) OR y<>yy(r2) THEN
      GOTO en
    ENDIF
  LOOP
  en:
  PUT 1,1,o$,3
  o$=""
RETURN
PROCEDURE koo
  GOSUB exit
  GET 130,150,525,185,o$
  DEFFILL 0,2,8
  PBOX 130,150,525,185
  COLOR 1
  BOX 130,150,525,185
  PRINT AT(20,11);"LINIEN ZIEHEN MIT LINKER UND RECHTER MAUSTASTE"
  FOR o=0 TO 30000
  NEXT o
  PUT 130,150,o$,3
  o$=""
  DO
    SHOWM
    x=MOUSEX
    y=MOUSEY
    zo=MOUSEK
    x1=x-xo
    y1=y-yo
    IF x1=0 THEN
      x1=1
    ENDIF
    IF y1=0 THEN
      y1=1
    ENDIF
    IF nr1=1         !INVERSE SPHÄRISCHE PROJEKTION
    x2=x1/(32*ska)
    y2=y1/(32*ska)
    z2=SQR(x2^2+y2^2)
    x2=x2/-z2*SIN(RAD(z2))
    y2=y2/-z2*SIN(RAD(z2))
    z2=COS(RAD(z2))
    z=y2*COS(do)+z2*SIN(do)
    yy=-y2*SIN(do)+z2*COS(do)
    ro=SQR(x2*x2+yy*yy+z*z)
    d=ASIN(z/ro)
    x2=x2/(ro*COS(d))
    yy=yy/(ro*COS(d))
    ar=FN z(ATN(x2/(1+yy))*2+aro)
  ELSE
    q=do+ATN(y1/(-r*ska))  !INVERSE GNOMONISCHE PROJEKTION
    ar=FN z(aro+ATN(x1*COS(q-do)/(-r*ska*COS(q))))
    d=ATN(TAN(q)*COS(ar-aro))
    IF zo=1 THEN  !LINIEN ZIEHEN
    xx2=x       !LINKE MAUSTASTE ANKLICKEN
    yy2=y       !NUR GONOMISCHE PROJEKTION
  ENDIF
  IF zo=2 THEN  !RECHTE UND LINKE MAUSTASTE ANKLICKEN
  LINE xx2,yy2,x,y
ENDIF
ENDIF
IF numr=1 THEN
REM DEKLIN. und AR ------------
ar1=FN z(PI*2-ar)
d2=ASIN(SIN(bo)*SIN(d)-COS(bo)*COS(d)*COS(ar1))
x=(COS(bo)*SIN(d)+SIN(bo)*COS(d)*COS(ar1))/COS(d2)
y=(COS(d)*SIN(ar1))/COS(d2)
ar2=FN z(zm-ATN(y/(1+x))*2)
REM EKL. BREITE UND LÄNGE
b2=ASIN(SIN(d2)*COS(ec)-COS(d2)*SIN(ec)*SIN(ar2))
x=(COS(d2)*COS(ar2))/COS(b2)
y=(SIN(d2)*SIN(ec)+COS(d2)*COS(ec)*SIN(ar2))/COS(b2)
l2=FN z(ATN(y/(1+x))*2)
ELSE
REM DEKLIN./AR
d2=d
ar2=ar
REM EKL. BREITE / LÄNGE
b2=ASIN(SIN(d2)*COS(ec)-COS(d2)*SIN(ec)*SIN(ar2))
x=(COS(d2)*COS(ar2))/COS(b2)
y=(SIN(d2)*SIN(ec)+COS(d2)*COS(ec)*SIN(ar2))/COS(b2)
l2=FN z(ATN(y/(1+x))*2)
REM H™HE / AZIMUT
d=ASIN(SIN(bo)*SIN(d2)+COS(bo)*COS(d2)*COS(zm-ar2))
x=(-COS(bo)*SIN(d2)+SIN(bo)*COS(d2)*COS(zm-ar2))/COS(d)
y=(COS(d2)*SIN(zm-ar2))/COS(d)
ar1=FN z(ATN(y/(1+x))*2)
ENDIF
PRINT AT(1,1);"DEK...: ";ROUND(DEG(d2),4)
PRINT AT(1,2);"AR....: ";ROUND(DEG(ar2),4)
PRINT AT(1,3);"BREITE: ";ROUND(DEG(b2),4)
PRINT AT(1,4);"L¥NGE.: ";ROUND(DEG(l2),4)
PRINT AT(1,5);"H”he..: ";ROUND(DEG(d),4)
PRINT AT(1,6);"Azimut: ";ROUND(DEG(ar1),4)
IF nr1=1 THEN
IF zo=1 THEN  !LINKE MAUSTASTE
i(1)=d2
ia(1)=ar2
ENDIF
IF zo=2 THEN !RECHTE MAUSTASTE
i(2)=d2
ia(2)=ar2
GOSUB ortho !GROSSKREISBOGEN DURCH ANFANG/ENDE DER METEORSPUR
PRINT AT(1,7);"kn: ";ROUND(DEG(kn),4)  !KNOTEN GROSSKREIS ÄQUAT. ODER HORIZONT
PRINT AT(1,8);"bn: ";ROUND(DEG(ABS(bn)),4) !NÖRDL. BAHNPUNKT ÜBER ÄQUATOR ODER HORIZONT
ENDIF
ENDIF
w$=UPPER$(INKEY$)
IF w$="R" THEN
GOTO en2
ENDIF
IF w$="P" THEN
BSAVE "f",XBIOS(2),32000
ENDIF
LOOP
en2:
HIDEM
RETURN
PROCEDURE ortho  !GROSSKREISBOGEN DURCH ZWEI ANGEGKLICKTE PUNKTE DER SPHÄRISCHEN PROJEKTION
dw=SIN(i(1))*SIN(i(2))+COS(i(1))*COS(i(2))*COS(ia(1)-ia(2))
IF ABS(dw)>=1 THEN
dw=0.999999999*SGN(dw)
ENDIF
IF dw==0 THEN
dw=1.0E-08
ENDIF
dw=ACOS(dw)
REM ----------------
f=(SIN(i(2))-SIN(i(1))*COS(dw))/(SIN(dw)*COS(i(1)))
IF ABS(f)>=1 THEN
f=0.9999999*SGN(f)
ENDIF
IF f==0 THEN
f=1.0E-10
ENDIF
f=ACOS(f)
IF SIN(ia(2)-ia(1))<0 THEN
f=PI*2-f
ENDIF
bn=SIN(f)*COS(i(1))
IF ABS(bn)>=1 THEN
bn=0.9999999*SGN(bn)
ENDIF
IF bn==0 THEN
bn=1.0E-08
ENDIF
bn=FN aco(bn)
n7=SIN(i(1))/SIN(bn)
IF ABS(n7)>=1 THEN
n7=0.9999999*SGN(n7)
ENDIF
IF n7==0 THEN
n7=1.0E-08
ENDIF
n7=ACOS(n7)
n8=COS(f)/SIN(bn)
n9=SIN(f)*COS(n7)
n8=FN z(ATN(n8/(1+n9))*2)
kn=FN z(ia(1)+n8+PI)  !KNOTEN GROSSKREIS ÄQUATOR ODER HORIZONT
np=PI/2-ABS(bn)       !POLDISTANZ GROSSKREIS NORDPOL ODER ZENIT =
j1=1                  !SCHNITTWINKEL GROSSKREIS MIT DEM ÄQUATOR ODER HORIZONT
FOR l=0 TO PI*2+0.05 STEP 0.05
ll2=COS(np)*SIN(l)
ip=0
IF ABS(ll2)>=1 THEN
ll2=0.9999999*SGN(ll2)
ip=1
ENDIF
ll2=ASIN(ll2)
x=COS(l)/COS(ll2)
y=(-SIN(np)*SIN(l))/COS(ll2)
IF y<-0.9999999 THEN
ll1=FN z(PI+kn)
ELSE
ll1=FN z(ATN(x/(1+y))*2+kn)
ENDIF
IF numr=1 THEN
GOSUB hoh
d=ho
ar=az
ELSE
d=ll2
ar=ll1
ENDIF
GOSUB mat
IF ip=1 THEN
j1=1
ENDIF
IF j1=1 THEN
j1=0
PLOT xx,yy
ENDIF
IF xx<-10 OR xx>640 OR yy<-10 OR yy>410 THEN
PLOT xx,yy
ENDIF
IF h>0 THEN
DRAW  TO xx,yy
ENDIF
NEXT l
RETURN
PROCEDURE sternb
  RESTORE alp
  FOR n=1 TO 162
    READ h1$
    h2$(n)=h1$
  NEXT n
  RESTORE sternn
  FOR n=1 TO 89
    READ h1$
    h3$(n)=h1$
  NEXT n
  RESTORE sternna
  FOR n=1 TO 89
    READ h1$
    h4$(n)=h1$
  NEXT n
RETURN
PROCEDURE mat
  IF nr1=1 THEN
    z=SIN(d)*SIN(do)+COS(d)*COS(do)*COS(ar-aro)
    IF ABS(z)>=1 THEN
      z=0.999999999*SGN(z)
    ENDIF
    h=ASIN(z)
    z=ACOS(z)
    x1=(COS(d)*SIN(ar-aro))/SIN(z)   !Sphärische Projektion
    y1=(SIN(d)*COS(do)-COS(d)*SIN(do)*COS(ar-aro))/SIN(z)
    z=DEG(z)
    xx=xo-z*x1*32*ska   !1 cm = 32 Pixel
    yy=yo-z*y1*32*ska
  ELSE
    co=COS(ar-aro)
    IF co=0 THEN
      co=1.0E-40
    ENDIF
    h=SIN(d)*SIN(do)+COS(do)*COS(d)*co
    IF ABS(h)>=1 THEN
      h=0.999999999*SGN(h)
    ENDIF
    h=ASIN(h)
    q=ATN(TAN(d)/co)
    IF q=0 THEN
      q=1.0E-10
      ENDIF          !Gnomonische Projektion
      xx=xo-r*ska*COS(q)*TAN(ar-aro)/COS(q-do)
      IF ABS(xx)>650 THEN
        yy=1000
        xx=1000
      ENDIF
      yy=yo-r*ska*TAN(q-do)
      IF ABS(xx)>650 THEN
        xx=1000
        yy=1000
      ENDIF
      IF ABS(yy)>410 THEN
        xx=1000
        yy=1000
      ENDIF
    ENDIF
  RETURN
  PROCEDURE um !KREIS UM RADIANTEN ZEICHNEN
  aro1=arr+1.0E-07  !REKTASZENSION RADIANT
  do1=dr   !DEKLINATION RADIANT
  s=RAD(1)    !EINTRAG KREISRADIUS RADIANT 0.5 GRAD
  FOR i=0 TO PI*2 STEP 0.05
    x=s*COS(i)
    y=s*SIN(i)
    ll1=aro1-x/COS(do1)  !Kartenkoordinaten Kreis - Abb. A Fig. 113,114
    ll2=do1+y
    IF numr=1 THEN
      GOSUB hoh
      d=ho
      ar=az
    ELSE
      d=ll2
      ar=ll1
    ENDIF
    GOSUB mat
    IF h>0 THEN
      PLOT xx,yy
    ENDIF
  NEXT i
RETURN
PROCEDURE hoh
  ho=SIN(bo)*SIN(ll2)+COS(bo)*COS(ll2)*COS(ll1-zm)
  IF ABS(ho)>=1 THEN
    ho=0.9999999999*SGN(ho)
  ENDIF
  ho=ASIN(ho)
  y=(COS(ll2)*SIN(ll1-zm))/COS(ho)
  x=(-COS(bo)*SIN(ll2)+SIN(bo)*COS(ll2)*COS(ll1-zm))/COS(ho)
  IF x<=-0.9999999999 THEN
    az=PI
  ELSE
    az=FN z(ATN(y/(1+x))*2)
  ENDIF
RETURN
PROCEDURE elim
  FOR j=1 TO n-1     !GAUSS ELIMINATION
  nr=j
  no=ABS(p(j,j))
  FOR i=j+1 TO n    STEP !ZEILENPIVOT
    noo=ABS(p(i,j))
    EXIT IF (noo-no)<0
    no=noo
    nr=i
  NEXT i
  IF nr=j THEN
    GOTO jum1
  ENDIF
  FOR i=j TO m+1
    no=p(nr,i)
    p(nr,i)=p(j,i)
    p(j,i)=no
  NEXT i
  jum1:
  FOR i=j+1 TO m+1   STEP !ELIMINATION
    p(j,i)=p(j,i)/p(j,j)
  NEXT i
  FOR i=j+1 TO n
    FOR k=j+1 TO m+1
      p(i,k)=p(i,k)-p(j,k)*p(i,j)
    NEXT k
  NEXT i
NEXT j
ko(n)=p(n,n+1)/p(n,n)  !RÜCKSUBSTITUTION
FOR j=n-1 TO 1 STEP -1
  ko(j)=p(j,n+1)
  FOR i=j+1 TO n
    ko(j)=ko(j)-p(j,i)*ko(i)
  NEXT i
NEXT j
RETURN
mil:  !MILCHSTRASSE
DATA 1,108,94,3,93,6,91,8,88,9,86,11,84,14,82,14,81,15,79,16,80,18,82,19,85,22,82,25,80,28,78,30,77,34,75,35,74,38,67,40,62,39,58,43,55,44,40,45,39,49,33,52,30,52 ,28,51,24,53,22,54,19,55,16,55,13,54,6,51,2,52,357,46,355,46,347,48
DATA 342,47,334,45,328,42,327,40,320,32,310,25,305,19,304,16
DATA 303,15,303,14,301,12,298,10,296,5,294,3,289,-2,288,-6,291,-9,290,-14,291,-17,287,-25,284,-25,284,-26,286,-27,287,-30,284,-37,281,-41,269,-45,267,-55,260,-58 ,256,-66,252,-68,245,-70,235,-70,226,-69,220,-68,214,-68,205,-70
DATA 200,-74,195,-74,181,-70,175,-75,165,-72,150,-69,144,-63,135,-60,132,-57,130,-50,127,-49,124,-48,121,-50,119,-49,118,-47,119,-40,119,-37,122,-37,122,-35,121, -34,118,-29,115,-28,114,-25,113,-22,110,-20,104,-18,105,-16,103,-12,105,-9,104,-5
DATA 102,-2,100,-2,96,-1,94,3,1,223,112,1,111,2,109,1,108,3,110,5,110,7,107,7,106,5,105,6,106,9,104,11,102,10,101,11,102,13,104,14,104,15,101,16,101,18,103,19,1 01,21,98,23,99,26,94,29,93,25,91,25,91,29,92,32,89,40,84,42,80,45
DATA 74,45,70,44,66,45,65,47,65,51,61,52,61,46,59,44,55,49
DATA 50,51,49,47,46,48,40,51,40,55,47,57,39,59,32,60,28,61,26,62,30,63,40,61,45,59,51,58,50,61,42,65,35,65,26,65,15,66,14,63,15,61,9,61,6,65,1,65,354,60,350,57,3 46,57,350,61,352,64,345,62,340,57,335,57,333,60,335,62,335,65,341,66
DATA 337,68,335,68,330,69,330,65,326,62,325,57,321,55,321,53,323,53,324,52,320,50,319,46,314,51,309,54,309,56,305,56,304,54,300,52,294,45,293,41,289,40,289,3 8,290,35,287,32,286,33,284,31,285,28,281,20,281,15,278,13,274,11,273,9,272,7,267,4
DATA 268,2,269,-2,271,1,277,5,280,4,282,6,281,8,283,10,284,11,286,15,288,16,287,18,286,19,284,21,287,23,288,26,294,25,295,26,298,24,300,30,305,38,304,44,306,4 5,312,42,310,38,308,37,303,31,304,26,302,24,298,22,295,19,294,18,293,17,294,15,290,11
DATA 287,10,284,2,278,1,278,-2,279,-10,274,-14,271,-16,271,-19,272,-20,268,-16,267,-14,265,-15,263,-14,255,-16,253,-18,251,-24,247,-27,248,-30,249,-34,246,-37,24 9,-41,248,-43,245,-44,242,-46,236,-56,226,-58,223,-59
DATA 220,-60,220,-57,225,-55,235,-54,237,-49,237,-44,241,-39,239,-38
DATA 234,-41,231,-39,229,-37,226,-42,229,-45,227,-48,223,-50,217,-45,216,-45,215,-47,218,-51,215,-52,215,-54,213,-54,207,-52,197,-54,186,-55,183,-56,184,-54,186, -52,182,-50,177,-50,171,-52,170,-51,166,-48,165,-48,158,-51,156,-47,150,-45,143,-47
DATA 140,-50,135,-50,136,-46,133,-45,134,-40,132,-33,132,-27,130,-25,125,-25,123,-17,119,-15,115,-14,115,-5,112,1,1,9,88,-70,85,-71,80,-71,76,-70,73,-68,79,-67,83, -67,88,-69,88,-70,1,7,16,-73,10,-74,8,-74,7,-73,11,-72,14,-71
DATA 16,-73,1,10,10.2,40.5,9.7,40.5,9.7,40.8,10.2,41,10.4,41.3,10.9,41.6,11.2,41.5,10.9,41.3,10.7,40.8,10.2,40.5,1,11,84.11,-5.47,84,-5.37,83.9,-5.3,84.1,-5.3,83.9,-5.12 ,83.52,-5.27,83.36,-5.47,83.6,-5.66,83.6,-5.76,83.91,-5.8,84.11,-5.47
DATA 1,9,84,-4.97,83.77,-4.84,83.72,-4.94,83.67,-4.84,83.8,-4.77,84.02,-4.74,83.92,-4.67,84.02,-4.85,84,-4.97,1,12,-169.2,-62.3,-173.3,-64.3,-173.3,-66.3,-171.3,-67.3
DATA -167.2,-66.3,-164.2,-65.3,-161.2,-62.3,-162.2,-61.3,-163.2,-60.3,-166.3,-59.3,-168.3,-60.3,-169.3,-62.3
alp:
DATA Alpha,Beta,Gamma,Delta,Epsilon,Zeta,Eta,Theta,Jota,Kappa,Lambda,My,Ny,Xi,Omikron,Pi,Rho,Sigma,Tau,Ypsilon,Phi,Chi,Psi,Omega,23,16,pi-2,Sig ma-2,24,38,Pi6,Pi5,Pi4,Pi3,Pi2,Pi1,6,Omega-2,Omega-1,30,68,71
DATA Theta-2,19,20,17,23,27,37,1,64,65,26,Jota-1,104,Alpha-2,Xi-1/2, Beta-1,My-1,Zeta-2,G
DATA Rho-2,43,Xi-2,62,59,52,Chi-1,Beta-2,Alpha-1,36,Zeta-2,Tau-2,c-2,b-1,Psi-1,7,82,Gamma-2,41,q,xi-1,xi-2,Omikron-2,15,i,Delta-1,3,Theta-1,67,70,Epsilon-2 ,Zeta-1,Ny-2,32H,24H,22H,2H,34,4,5,2,6,1,38,10,35,31,21,15,12,2,10,1,30,-,Omikron-1
DATA Omikron-2,54,Tau-1,Tau-2,Tau-3,Tau-4,Tau-5,Tau-6,Tau-7,Tau-8,Tau-9,Ypsilon-1,Ypsilon-2,Ypsilon-3,Ypsilon-4,g,f,h,y,e,13,Phi-1,50,51,52,58,54,N,A ,q,p,Delta-2,Eta-1,Eta-2,My1,My-2,Delta-1,Delta-2,Psi-1,Gamma-1,Gamma-2,Beta-2,80g,61,Epsilon-1
sternn:
DATA Andromeda,Widder,Fuhrmann,Bärenhtöter,Giraffe,Jagdhunde,Krebs,Kleiner Hund,Cassiopeia,Cepheus,Haar der Berenike,Nördliche Krone,Schwan,Delphin,Drache,Füllen,Zwillinge,Herkules,Eidechse,Löwe,Kleiner Löwe
DATA Luchs,Leier,Pegasus,Fische,Pfeil,Stier,Dreieck,Grosser Bär,Kleiner Bär,Fuchs,Luftpumpe,Paradisvogel,Wassermann,Adler
DATA Altar,Grabstichel,Grosser Hund,Steinbock,Schiffskiel,Centaurus,Walfisch,Chamaeleon,Zirkel,Taube,Südliche Krone,Rabe,Becher,Kreuz des Südens,Goldfisch,Eridanus,Chemischer Ofen,Kranich,Pendeluhr,Wasserschlange,Kleine Wasserschlange
DATA Inder,Hase,Waage,Wolf,Tafelberg,Mikroskop,Einhorn,Fliege,Winkelma¥,Oktant,Schlangenträger,Orion,Pfau,Phoenix,Maler,Südlicher Fisch,Schiff Argo,Schiffskompass,Netz,Schütze,Skorpion,Bildhauer,Schild des Sobieski,Kopf der Schlange
DATA Ende der Schlange,Sextant,Fernrohr,Südliches Dreieck,Tukan,Segel,Jungfrau,Fliegender Fisch,Perseus
sternna:
DATA Andromedae,Arietis,Aurigae,Bootis,Cameloparadalis,Canum Venaticorum,Cancri,Canis Minoris,Cassiopeiae,Cephei,Comae Berenices,Coronae Borealis,Cygni,Delphini,Draconis,Equulei,Geminorum,Herculis
DATA Lacertae,Leonis,Leonis Minoris,Lyncis,Lyrae,Pegasi,Piscium,Sagittae,Tauri,Trianguli
DATA Ursae Maioris,Ursae Minoris,Vulpeculae,Antliae,Apudis,Aquarii,Aquilae,Arae,Caeli,Canis Maioris,Capricorni,Carinae,Centauri,Ceti,Chamaeleontis,Circini,Columbae,Coronae Australis,Corvi,Crateris,Crucis,Doradus,Eridani,Fornacis
DATA Gruis,Horologii,Hydrae,Hydri,Indi,Leporis,Librae,Lupi,Mensae,Micorscopii,Monocerotis,Muscae,Normae,Octantis,Ophiuchi,Orionis,Pavonis,Phoe nicis,Pictoris,Picis Austrini,Puppis,Pyxidis,Reticuli,Sagittarii,Scorpii,Sculptoris,Scuti
DATA Caput Serpentis,Cauda Serpentis,Sextantis,Telescopii,Trianguli Australis,Tucanae,Velorum,Virginis,Volantis,Persei
sterndat:
REM UMa - Grosser Bär
DATA 1,9,206.8851417,49.31331944,125,-11,29,7,1.86,108,-11,B3V,Benernash/Alkaid
DATA 201.3064042,54.98810556,135,-9,29,160,4.01,82,-8,A5V,Alcor
DATA 200.9814125,54.92538333,141,-20,29,6,2.27,59,-9,A2V,Mizar
DATA 193.5072833,55.95985278,133,-6,29,5,1.77,62,-9,A0p,Alioth
DATA 183.8565,57.03261667,127,9,29,4,3.31,65,-13,A3V,Megrez
DATA 178.45765,53.69475833,107,12,29,3,2.84,75,-13,A0V,Phecda
DATA 165.4603417,56.38240278,99,34,29,2,2.37,62,-12,A1V,Merak
DATA 165.9319417,61.75089444,167,-66,29,1,1.79,75,-9,K0III,Dubhe
DATA 183.8565,57.03261667,127,9,29,4,3.31,65,-13,A3V,Megrez
REM UMi - Kleiner Bär
DATA 1,8,37.9529333,89.26408889,1988,-15,30,1,2.02,650,-17,F8Ib,Polaris J2000
DATA 263.0536333,86.58647778,97,56,30,4,4.36,144,-8,A1V,Pherkard
DATA 251.4922583,82.03728333,82,5,30,5,4.23,200,-11,G5III,-
DATA 236.0145917,77.794475,62,-1,30,6,4.32,108,-16,A3V,-
DATA 222.6764417,74.15549444,-76,12,30,2,2.08,95,17,K4III,Kochab
DATA 230.1821375,71.834025,-40,20,30,3,3.05,225,-4,A3III,Pherkad
DATA 244.3763458,75.75526111,-229,252,30,7,4.95,91,-10,dF0,-
DATA 236.0145917,77.794475,62,-1,30,6,4.32,108,-16,A3V,-

Alle Rechte vorbehalten (all rights reserved), auch die der fotomechanischen Wiedergabe und der Speicherung in elektronischen Medien, Translation usw. Dasselbe gilt für das Recht der öffentlichen Wiedergabe. Copyright © by H. Schumacher, Spaceglobe
 

Sternbeobachter - Sterntagebuch - Produktinformation - www.spaceglobe.de