-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
XCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
X`09PROGRAM XPLANET
X`09CHARACTER*5 COMENT*25,FILNAM*25,OPTION,
X`091RETRO(8),HOUSE5(7),BLAH*1
X`09LOGICAL HLP
X`09DOUBLE PRECISION T,AN1(9),XJD,CONV,GMT,XL,YL,XP,YP,XN,
X`091DAY,PI2,RULER(12),WEEK(7),WEEKR(7),PLANET(16),ASPTYP(9),
X`092YBES,DIGTYP(2,6),ZOD(12),HOUSE(2,9),DISP(15),TT
X`09INTEGER ASPECT(181),ASPDEG(9),EXDEG(10),DIG(10,12)
X`091,TAKEN(15)
X`09DIMENSION EC0(9),EC1(9),AN0(9),P0(9),P1(9),EC(9),
X`091TL(9),TB(9),TH0(9),TH1(9),XI(9),R(9),A(9),G(9),GE(9),
X`092X(9),Y(9),Z(9),XX(9),YY(9),ZZ(9),IH(4,3),H(4),
X`093ZOD1(12),P(120,14),ID(120,14),IM(120,14),IS(120,14),
X`094GLYPH(120,14),IASP(14,14),WHEEL(70,42),ROMAN(48)
X`095,PLAN2(2,14),IWX1(12),IWX2(12),IWY1(12),IWY2(12)
X`096,PLACE(24),ELEM(5,3,12),QUAD(5)
X`097,NDISP(15),LEVEL(15),NRULER(12),DBLANK(15)
X`098,MONTH(12),MOND(12),XNODE(2,10),YNODE(2,10)
XCCCCCCCCC
XC
XC`09P(I,J) VALUES CODED BY I AS FOLLOWS :`20
XC`091=LATITUDE
XC`092=DECLINATION `20
XC`093=HEL. LATITUDE `20
XC`094=HEL. DECLINATION
XC`095=`5BOPEN`5D `20
XC`096=HEL. LONGITUDE `20
XC`097-16=HOUSES
XC`09`09(CAMPANUS,MORINUS,PLACIDUS,REGIOMONTANUS,PORPHYRY,EQUAL,
XC`09`09ZARIEL,ALCIBITUS,`5BRESERVED FOR KOCH`5D,`5BOPEN`5D)
XC`0917=PLANETARY PARTS `20
XC`0918,19=N,S PLANETARY NODES `20
XC`0920=LONGITUDE `20
XC`0921-120=PROGRESSED LONGITUDE (TO 100 DAYS)
XC
XCCCCCCCCC
X`09DATA ASPDEG/0,30,45,60,72,90,120,150,180/
X`09DATA ASPECT/1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
X`0910,0,0,0,0,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,3,3,3,3,3,
X`0923,3,3,3,3,0,0,0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,5,5,5,
X`0935,5,5,5,5,5,5,0,0,0,0,0,0,0,0,6,6,6,6,6,6,6,6,6,6,
X`0940,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,7,7,7,7,
X`0957,7,7,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
X`0968,8,8,8,8,8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
X`0970,0,0,0,0,9,9,9,9,9,9/
X`09DATA ASPTYP/'Conjunct','Semisex.','Semisq. ','Sextile ',
X`091'Quintile','Square  ','Trine   ','Inconj. ','Opposed '/
X`09DATA DIG/1,0,4,3,0,2,6,0,5,0,0,6,3,4,5,0,0,0,4,1,
X`0916,3,0,0,4,0,1,2,0,0,0,0,0,2,1,4,0,5,0,3,3,2,6,5,0,
X`0924,4,0,1,0,0,3,2,0,4,5,0,4,0,6,2,0,3,4,0,1,5,0,6,0,
X`0930,5,4,3,6,0,0,0,3,2,5,4,0,0,3,0,2,1,0,0,0,0,0,1,2,
X`0943,0,6,0,4,4,1,5,6,0,3,3,0,2,0,0,4,1,0,3,6,0,3,0,5/
X`09DATA DIGTYP/'exalte','d     ','fallen','      ',
X`091'natura','l     ','detrim','ental ','harmon','ious  ',
X`092'inharm','onious'/
X`09DATA EXDEG/19,15,27,28,15,21,07,18,17,03/
X`09DATA HOUSE/'...CAMP','ANUS...','...MORI','NUS....',
X`091'...PLAC','IDUS...','REGIOMO','NTANUS ','...PORP',
X`092'HYRY...','....EQU','AL.....','....ZAR','IEL....',
X`093'..ALCIB','ITUS...','.....KO','CH.....'/
X`09DATA HOUSE5/'MORI','PLAC','REGI','PORF','EQUA',
X`091'ZARI','ALCI'/
X`09DATA MOND/31,0,31,30,31,30,31,31,30,31,30,31/
X`09DATA MONTH/'JA','FE','MR','AP','MY','JN','JL','AU',
X`091'SE','OC','NO','DE'/
X`09DATA NRULER/4,3,2,10,1,2,3,9,5,6,7,8/
X`09DATA PLANET/'Sun     ','Mercury ','Venus   ','Mars    ',
X`091'Jupiter ','Saturn  ','Uranus  ','Neptune ','Pluto   ',
X`092'Moon    ','Moonnode','Pars F. ','Ascend. ','M.C.    ',
X`093'        ','none    '/
X`09DATA PLAN2/'S','U','M','E','V','E','M','A','J','U',
X`091'S','A','U','R','N','E','P','L','M','O','M','N','P','F',
X`092'A','S','M','C'/
X`09DATA QUAD/'FIRE','ERTH','AIR ','WATR','    '/
X`09DATA ROMAN/' ',' ','I',' ',' ','I','I',' ',' ','I','I',
X`091'I',' ','I','V',' ',' ',' ','V',' ',' ','V','I',' ',
X`092' ','V','I','I','V','I','I','I',' ','I','X',' ',
X`093' ',' ','X',' ',' ','X','I',' ',' ','X','I','I'/
X`09DATA WEEK/'Monday  ','Tuesday ','Wednsday',
X`091'Thursday','Friday  ','Saturday','Sunday  '/
X`09DATA WEEKR/'Moon)   ','Mars)   ','Mercury)','Jupiter)',
X`091'Venus)  ','Saturn) ','Sun)    '/
X`09DATA ZOD/'Aries   ','Taurus  ','Gemini  ','Cancer  ',
X`091'Leo     ','Virgo   ','Libra   ','Scorpio ',
X`092'Sagtarus','Caprcorn','Aquarius','Pisces  '/
X`09DATA ZOD1/'A','T','G','C','L','V','=','S','/','K','Q','P'/
XCCCCCCCCC
XC
XC     PLUTO ELEMENTS FROM SHARAF (1964)
XC
XCCCCCCCCC
X`09DATA A/1.00000023,.387098599,.723331619,1.523688395,
X`0915.202802875,9.53884320,19.19097811,30.0706724,39.672599/
X`09DATA AN0/358.475833,102.279381,212.603222,319.529425,
X`091225.444651,175.758444,74.313628,41.269550,231.002308/
X`09DATA AN1/35999.049750D0,149472.515289D0,58517.803875D0,
X`09119139.858500D0,3034.906654D0,1222.116782D0,428.502578D0,
X`092218.466783D0,144.072477D0/
X`09DATA EC0/.01675104,.20561421,.00682069,.09331290,
X`091.04825382,.05606075,.04704433,.00853341,.24706226/
X`09DATA EC1/-.00004180,.00002046,-.00004774,.00009206,
X`091.0,.0,.0,.0,.0/
X`09DATA P0/101.220833,75.899697,130.163833,334.218203,
X`09111.907422,90.110981,169.048778,43.755611,221.592475/
X`09DATA P1/1.719175,1.555489,1.408036,1.840758,
X`091.0,.0,.0,.0,1.388888/
X`09DATA TH0/0.,47.145944,75.779647,48.786442,
X`09198.932822,112.347606,73.490250,130.678889,108.937165/
X`09DATA TH1/0.,1.185208,.899850,.770992,
X`091.0,.0,.509667,1.100972,1.358056/
X`09DATA XI/0.,7.002881,3.393630,1.850333,
X`0911.311614,2.494239,.7726658,1.779256,17.109816/
XCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
XC
XC Code
XC
XCCCCCCCCC
X`09TAN(DUMMY)=SIN(DUMMY)/COS(DUMMY)
X`09ARG(P,Q)=P-Q*INT(P/Q)-Q*INT(SIGN(.5,P-Q*INT(P/Q))-.5)
X`09HLP=.FALSE.
X`09LINEP=0
X`09PI=ATAN(1.0)
X`09PI2=6.283185307179586476D0
X`09CONV=PI2/360.D0
X`09CONVS=CONV
X`09DO 100 I=1,70
X`09DO 100 J=1,42
X100`09 WHEEL(I,J)=' '
X`09DO 110 I=1,220
X`09J=34.5*COS(I*.0285)+35.5
X`09K=20.5*SIN(I*.0285)+21.5
X110`09WHEEL(J,K)='.'
XCCCCCCCCC
XC
XC     FOLLOWING PUTS HOUSE ROMAN NUMERALS INTO WHEEL
XC
XCCCCCCCCC
X`09DO 120 I=4,48,4
X`09J=12.*COS((I+22)*.1308997)+34.
X`09K=-7.*SIN((I+22)*.1308997)+21.5
X`09WHEEL(J,K)=ROMAN(I-3)
X`09WHEEL(J+1,K)=ROMAN(I-2)
X`09WHEEL(J+2,K)=ROMAN(I-1)
X120`09WHEEL(J+3,K)=ROMAN(I)
X`09DO 130 I=1,120
X`09DO 130 J=1,14
X130`09P(I,J)=0.
X`09WRITE(6,8010)
X8010`09FORMAT('$Do you want to specify your birthday ',
X`091'(Y=yes,<RET>=actual date) ? ')
X`09READ(5,8011) BLAH
X8011`09FORMAT(A)
X`09IF (BLAH.NE.'Y'.AND.BLAH.NE.'y') GOTO 6010
X`09TYPE 10000
X10000`09FORMAT('$Sample input (Gregorian date,time',
X`091'conversion to GMT,latitude,longitude)'//
X`092' 1899/12/31 23:59 +08:00 34N59 122W59) : ')
XC`093' TYPE "TYPE ASTRO.HLP" FOR DETAILED EXPLANATIONS'/////
XC`094' A=ARIES  C=CANCER ==LIBRA       K=CAPRICORN  N=NORTH'/
XC`095' T=TAURUS L=LEO    S=SCORPIO     Q=AQUARIUS   S=SOUTH'/
XC`096' G=GEMINI V=VIRGO  /=SAGITTARIUS P=PISCES'//////////
XC`097' ENTER BIRTH DATA -------'//)
XCCCCCCCCC
XC
XC     HOROSCOPE LOOP STARTS HERE
XC
XCCCCCCCCC
X140     CONTINUE
X`09ACCEPT 11000,NY,CALEND,NM,ND,NH,NMI,NCH,NCM,LATD,LATS,
X`091LATM,LONGD,LONGS,LONGM
XC`09,OPTION,COMENT
X11000`09FORMAT(I4,A1,4(I2,1X),I3,2(1X,I2),A1,I2,1X,I3,A1,I2,1X)
XC`09,1A5,A25)
X`09GOTO 6011
X6010`09CONTINUE
X        CALL IDATE(NM,ND,NY)
X        NY=1900+NY
X`09CALEND='/'
X        NH=SECNDS(0.0)/3600
X        NMI=(SECNDS(0.0)/60)-60*NH
X        NCH=-1
X        NCM=0
X        LATD=48
X        LATS='N'
X        LATM=10
X        LONGD=11
X        LONGS='E'
X        LONGM=30
X6011`09CONTINUE
X        TYPE 11005
X11005`09format('$Do you care for a hardcopy ? ')
X        ACCEPT 11006,BLAH
X11006  `09FORMAT(A)
X        IF (BLAH.NE.'Y'.AND.BLAH.NE.'y') GO TO 11035
X        CONTINUE
X        TYPE 11003
X11003  `09FORMAT ('$Enter file name : ')
X        ACCEPT 11004,I,FILNAM
X11004  `09FORMAT (Q,A)
X        OPEN(FILE=FILNAM(1:I),UNIT=20,STATUS='NEW')
X        IOUT=20
X        GO TO 11008
X11035   IOUT=6
X11008   LINEP=1
X`09WRITE(IOUT,11500)NY,CALEND,NM,ND,NH,NMI,NCH,NCM,LATD,
X`091LATS,LATM,LONGD,LONGS,LONGM
X11500`09FORMAT('1'//' ---Date--- -Time -Zone- -Lat- -Long- ',
X`091'Comments--------'/' ',I4,A1,I2,'/',I2,I3,':',I2,
X`091I4,':',I2,I3,A1,I2,I4,A1,I2)
X144`09GMT=((NH+NCH-12)*60+NMI+SIGN(NCM*1.,NCH*1.))/1440.
X`09XJD=(ND-32075+1461*(NY+4800+(NM-14)/12)/4+367*(NM-2-
X`091(NM-14)/12*12)/12-3*((NY+4900+(NM-14)/12)/100)/4)+GMT
X`09IF(CALEND.NE.'B')GO TO 150
X`09NY=1-NY
X150`09IF(CALEND.NE.'J'.AND.CALEND.NE.'B')GO TO 160
X`09XJD=(ND-32075+1461*(NY+4800+(NM-14)/12)/4
X`091+367*(NM-2-(NM-14)/12*12)/12-38)+GMT
X160`09T=(XJD-2415020.D0)/36525.D0
XC
X`09JFINAL=2
X`09IF(OPTION.NE.'PROGR'.AND.OPTION.NE.'EPHEM')GO TO 170
X`09JFINAL=101
XCCCCCCCCC
XC
XC     Planetary Ephemerides computed below (Newcomb/Hill,1898)
XC     all values within 1.5' except Pluto --- Uranus/Neptune
XC     suffer for very ancient dates (error up to 3-4 degrees)
XC     comments after perturbations (below) give maximum
XC     effects of terms on geocentric longitude.
XC
XCCCCCCC
X170`09DO 270 J=1,JFINAL
X`09TT=T+(J-1)/36525.D0
X`09TP=TT+18262.D0/36525.D0
X`09W=TT
X`09DO 174 I=1,9
X`09EC(I)=EC0(I)+EC1(I)*W
X`09N=AN1(I)*TT/360.D0
X174`09G(I)=(AN1(I)*TT-N*360.D0+DBLE(AN0(I)))*CONV
X`09G5=G(5)
X`09G6=G(6)
X`09G7=(220.169542+428.49311*TP)*CONVS
X`09G(5)=G(5)+(.6506*SIN(2*G6-2*G5+336.9*CONVS)
X`091+(3.9987-.002213*36525./4332.58*TP)
X`092*SIN(5*G6-2*G5+(67.15-8197.0/3600.*TP)*CONVS)
X`093+.5380*SIN(5*G6-3*G5+176.5*CONVS)
X`094+.4112*SIN(2*G6-G5+1.4*CONVS)
X`094+.0399278*36525./4332.58*TP*SIN(-G5+227.46*CONVS)
X`095+.2763*SIN(3*G6-2*G5+127.4*CONVS)
X`096+.2669*SIN(G6-G5+79.2*CONVS)  )*299.12837/3600.*CONVS
XCCCCCCCCC
XC
XC`09250",1500"-7"T,202",154",126"T(PROBLEM?),104",100",
XC     (21",20",19",18",14",14",11",9",6"T)
XC
XCCCCCCCCC
X`09G(6)=G(6)+(24.153*SIN(5*G6-2*G5+(247.11-2.277*TP)*CONVS)
X`091+5.679*SIN(4*G6-2*G5+277.39*CONVS)
X`092+3.505*SIN(2*G6-G5+181.43*CONVS)
X`093+.657765*36525./10759.20*TP*SIN(G6+238.0*CONVS)
X`094+.278*SIN(3*G6-G5+121.2*CONVS)
X`095+.266*SIN(2*G6-2*G5+157.0*CONVS)
X`096+.238*SIN(6*G6-2*G5-3*G7+6.9*CONVS)
X`097+.223*SIN(10*G6-4*G5+(133.6-14814.5/3600.*W)*CONVS)
X`098+.234*SIN(3*G7-G6+321.7*CONVS)  )*120.455/3600.*CONVS
XCCCCCCCCC
XC
XC`093270",770",473",300"T(PROBLEM?),37",36",32",30",32",
XC     (29",26",19"T,16"T,14",13",10",9",9",8",7")
XC
XCCCCCCCCC
X`09G(7)=G(7)+33.086*W*W/3600.*CONVS
X`09G(8)=G(8)-22.401/3600.*W*W*CONVS
X`09DO 177 I=1,9
X`09GE(I)=G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(
X`091G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(G(I))))))
X177`09X(I)=2.*ATAN(SQRT((1.+EC(I))/(1.-EC(I)))*TAN(.5*GE(I)))
X`091+(P0(I)+P1(I)*W)*CONVS + (I/7-I/9)*W*5025.3/3600.*CONVS
X`09GT=(358.415+35998.928*W)*CONVS
X`09GJ=(225.209+3034.462*W+.332*SIN((134.4+38.5*W)*CONVS))
X`091*CONVS
X`09X(4)=X(4)+(25.384*COS(GJ-G(4)-48.9*CONVS)
X`091+52.490*SIN((47.48+19.771*W)*CONVS)-37.05-13.50*W
X`092+21.869*COS(2*GJ-G(4)-188.3*CONVS)
X`093+16.035*COS(2*GJ-2*G(4)-191.9*CONVS)
X`094+13.966*COS(-GT+2*G(4)-20.5*CONVS)
X`095+8.559*COS(-GT+G(4)-35.1*CONVS)  )/3600.*CONVS
XCCCCCCCCC
XC
XC`0992",191",80",58",51",31",(27",23",18",14",12")
XC
XCCCCCCCCC
X`09GN=(225.417+3034.904*W)*CONVS
X`09GG=(175.753+1222.113*W)*CONVS
X`09G1=(74.412+428.498*W)*CONVS
X`09GP=(74.320+428.498*W)*CONVS
X`09GPP=(41.339+218.467*W)*CONVS
X`09X(7)=X(7)+(142.938*SIN(GG-2*G1)+19.508*COS(GG-2*G1)
X`091+75.70*COS(3*G1-GG)-102.30*SIN(3*G1-GG)
X`092-48.623*SIN(GN-G1)-21.320*COS(GN-G1)
X`093-27.871*COS(GP-GPP)+19.869*SIN(GP-GPP)
X`094+28.793*COS(2*GP-2*GPP)+10.035*SIN(2*GP-2*GPP)
X`095+(18.37*SIN(3*GP-3*GPP)+8.91*COS(3*GP-3*GPP))*COS(G(7))
X`096+(8.35*SIN(3*GP-3*GPP)-16.44*COS(3*GP-3*GPP))*SIN(G(7))
X`097-18.585*COS(GG-G1)+12.603*SIN(GG-G1)
X`098+4.327*COS(3*GP-3*GPP)+14.280*SIN(3*GP-3*GPP)
X`099  )/3600.*CONVS
XCCCCCCCCC
XC
XC`09154",135",56",36",32",29"(2),24",15",(9",7",6")
XC
XCCCCCCCCC
X`09X(7)=X(7)+((112.317*W-1.551*W*W-.516*W*W*W)*SIN(G(7))
X`091-(68.339*W+9.721*W*W)*COS(G(7))+6.605*W*SIN(2*G(7))
X`092-(29.44-.410*W)*SIN((20.45-22.61*W)*CONVS) )/3600.*CONVS
XCCCCCCCCC
XC
XC     JUP/SAT TERM & QUADRATURES OF LONG PERIOD URA/NEP TERMS
XC
XCCCCCCCCC
X`09X(8)=X(8)+(  33.972*W*COS(G(8))
X`091+18.553*SIN((180.966+1004.034*W+.1403*W*W)*CONVS)
X`092+34.138*SIN((153.267+2816.296*W-.0573*W*W)*CONVS)
X`093+(26.50*W+3.92*W*W)*SIN(G(8))   )/3600.*CONVS
XCCCCCCCCC
XC
XC`0936"T,19",35",25"T+4"T*T,(15",9",6")
XC     FIRST/LAST TERMS (QUADRATURES) IMPROVE 1600-2000 VALUES
XC     BUT FOR VERY ANCIENT DATES ARE INVALID
XC
XCCCCCCCCC
X`09DO 185 I=1,9
X`09TH=(TH0(I)+TH1(I)*W)*CONVS
X`09DO 180 K=1,2
XCCCCCCCCC
XC
XC     MOTION OF JUP/SAT NODES FROM LEVERRIER
XC
XCCCCCCCCC
X`09TH2=TH+(I/5*3636.6-I/6*493.1-I/7*3143.5)/3600.*TP*CONVS
X`09R(I)=A(I)*(1.-EC(I)*COS(2.*ATAN(TAN((TH2+(K-1)*PI-(P0(I)
X`091+P1(I)*W)*CONVS)*.5)*SQRT((1.-EC(I))/(1.+EC(I))))))
X`09XNODE(K,I)=R(I)*COS(TH2+(K-1)*PI)
X180`09YNODE(K,I)=R(I)*SIN(TH2+(K-1)*PI)
X`09TL(I)=TH+ATAN2(SIN(X(I)-TH)*COS(XI(I)*CONVS),
X`091COS(X(I)-TH))+(I/5-I/7)*TP*5026.1/3600.*CONVS
X`09TB(I)=ASIN(SIN(XI(I)*CONVS)*SIN(X(I)-TH))
X185`09R(I)=A(I)*(1.-EC(I)*COS(GE(I)))
X`09TB(5)=TB(5)+4.37431*36525./4332.58*SIN(X(5)+23.62*CONVS)
X`091*TP/3600.*CONVS
X`09TB(6)=TB(6)+24.266*36525./10759.2*SIN(X(6)-13.05*CONVS)
X`091*TP/3600.*CONVS
XCCCCCCCCC
XC
XC     TB(5) EFFECTS LESS THAN 35"T, TB(6) LESS THAN 84"T
XC
XCCCCCCCCC
X`09R(5)=R(5)*10.**(.0002303*COS(2*G6-2*G5+336.9*CONVS)
X`091+.0001679*COS(5*G6-3*G5+176.4*CONVS)
X`092+.0000125634*36525./4332.58*TP*COS(-G5+227.4*CONVS)  )
XCCCCCCCCC
XC
XC`0922",16",10"T,(7",5",3")
XC
XCCCCCCCCC
X`09R(6)=R(6)*10.**(.0007005*COS(4*G6-2*G5+277.3*CONVS)
X`091+.0003783*COS(G6-G5+79.8*CONVS)
X`092+.000083491*36525./10759.20*TP*COS(G6+58.0*CONVS)
X`093+.0002443*COS(2*G6-G5+176.0*CONVS)  )
XCCCCCCCCC
XC
XC`0937",20",15"T,13",(10",6",3")
XC     R(7) TERMS EFFECT LESS THAN 5",3"T,2"T,.3"T*T
XC     R(8) TERMS ONLY EFFECT .02' MAXIMUM
XC
XCCCCCCCCC
X`09DO 190 I=1,9
X`09X(I)=R(I)*COS(TB(I))*COS(TL(I))
X`09Y(I)=R(I)*COS(TB(I))*SIN(TL(I))
X190`09Z(I)=R(I)*SIN(TB(I))
X`09DO 210 I=2,9
X`09DO 200 K=1,2
X`09XNODE(K,I)=XNODE(K,I)-X(1)
X`09YNODE(K,I)=YNODE(K,I)-Y(1)
X200`09P(K+17,I)=ARG(ATAN2(YNODE(K,I),XNODE(K,I))/6.2831853,1.)
X`09XX(I)=X(I)-X(1)
X`09YY(I)=Y(I)-Y(1)
X210`09ZZ(I)=Z(I)-Z(1)
X`09XX(1)=-X(1)
X`09YY(1)=-Y(1)
X`09ZZ(1)=-Z(1)
X`09XNUT=-17.2327/1296000.*SIN((259.18-1934.142*W)*CONVS)
X`09DO 230 I=1,9
X`09P(J+19,I)=ARG(ATAN2(YY(I),XX(I))/6.28318531+XNUT,1.)
X`09IF(J-1)230,220,230
X220`09DIST=SQRT(XX(I)*XX(I)+YY(I)*YY(I)+ZZ(I)*ZZ(I))
X`09P(1,I)=ASIN(ZZ(I)/DIST)/CONVS
X`09E=(23.4522944-.0130125*W+.002558*COS((259.18-1934.142
X`091*W)*CONVS))*CONVS
X`09P(2,I)=ASIN(COS(P(1,I)*CONVS)*SIN(P(20,I)*6.28318531)
X`091*SIN(E)+SIN(P(1,I)*CONVS)*COS(E))/CONVS
X`09P(6,I)=ARG(TL(I)/6.28318531,1.)
X`09P(3,I)=TB(I)/CONVS
X`09P(4,I)=ASIN(COS(TB(I))*SIN(TL(I))*SIN(E)
X`091+SIN(TB(I))*COS(E))/CONVS
X230`09CONTINUE
XCCCCCCCCC
XC
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-