Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50345/astro.f4
There are no other files named astro.f4 in the archive.
LOGICAL HLP
DOUBLE PRECISION T,AN1(9),XJD,CONV,GMT,XL,YL,XP,YP,XN,
1DAY,PI2,RULER(12),WEEK(7),WEEKR(7),PLANET(16),ASPTYP(9),
2YBES,DIGTYP(2,6),ZOD(12),HOUSE(2,9),DISP(15),TT
INTEGER ASPECT(181),ASPDEG(9),EXDEG(10),DIG(10,12)
1,TAKEN(15)
DIMENSION EC0(9),EC1(9),AN0(9),P0(9),P1(9),EC(9),
1TL(9),TB(9),TH0(9),TH1(9),XI(9),R(9),A(9),G(9),GE(9),
2X(9),Y(9),Z(9),XX(9),YY(9),ZZ(9),IH(4,3),H(4),
3ZOD1(12),P(120,14),ID(120,14),IM(120,14),IS(120,14),
4GLYPH(120,14),IASP(14,14),WHEEL(70,42),ROMAN(48)
5,PLAN2(2,14),IWX1(12),IWX2(12),IWY1(12),IWY2(12)
6,PLACE(24),ELEM(5,3,12),QUAD(5),HOUSE5(7),RETRO(8)
7,NDISP(15),LEVEL(15),NRULER(12),DBLANK(15),COMENT(5)
8,MONTH(12),MOND(12),XNODE(2,10),YNODE(2,10)
C P(I,J) VALUES CODED BY I AS FOLLOWS : 1=LATITUDE
C 2=DECLINATION 3=HEL. LATITUDE 4=HEL. DECLINATION
C 5=[OPEN] 6=HEL. LONGITUDE 7-16=HOUSES
C (CAMPANUS,MORINUS,PLACIDUS,REGIOMONTANUS,PORPHYRY,EQUAL,
C ZARIEL,ALCIBITUS,[RESERVED FOR KOCH],[OPEN])
C 17=PLANETARY PARTS 18,19=N,S PLANETARY NODES
C 20=LONGITUDE 21-120=PROGRESSED LONGITUDE (TO 100 DAYS)
C
TAN(DUMMY)=SIN(DUMMY)/COS(DUMMY)
ARG(P,Q)=P-Q*INT(P/Q)-Q*INT(SIGN(.5,P-Q*INT(P/Q))-.5)
HLP=.FALSE.
C
DATA ASPDEG/0,30,45,60,72,90,120,150,180/
DATA ASPECT/1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
10,0,0,0,0,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0,3,3,3,3,3,
23,3,3,3,3,0,0,0,0,0,4,4,4,4,4,4,4,4,4,4,0,0,5,5,5,
35,5,5,5,5,5,5,0,0,0,0,0,0,0,0,6,6,6,6,6,6,6,6,6,6,
40,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,7,7,7,7,
57,7,7,7,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
68,8,8,8,8,8,8,8,8,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
70,0,0,0,0,9,9,9,9,9,9/
DATA ASPTYP/'CONJUNCT','SEMISEX.','SEMISQ. ','SEXTILE ',
1'QUINTILE','SQUARE ','TRINE ','INCONJ. ','OPPOSED '/
DATA DIG/1,0,4,3,0,2,6,0,5,0,0,6,3,4,5,0,0,0,4,1,
16,3,0,0,4,0,1,2,0,0,0,0,0,2,1,4,0,5,0,3,3,2,6,5,0,
24,4,0,1,0,0,3,2,0,4,5,0,4,0,6,2,0,3,4,0,1,5,0,6,0,
30,5,4,3,6,0,0,0,3,2,5,4,0,0,3,0,2,1,0,0,0,0,0,1,2,
43,0,6,0,4,4,1,5,6,0,3,3,0,2,0,0,4,1,0,3,6,0,3,0,5/
DATA DIGTYP/'EXALTE','D ','FALLEN',' ',
1'NATURA','L ','DETRIM','ENTAL ','HARMON','IOUS ',
2'INHARM','ONIOUS'/
DATA EXDEG/19,15,27,28,15,21,07,18,17,03/
DATA HOUSE/'...CAMP','ANUS...','...MORI','NUS....',
1'...PLAC','IDUS...','REGIOMO','NTANUS ','...PORP',
2'HYRY...','....EQU','AL.....','....ZAR','IEL....',
3'..ALCIB','ITUS...','.....KO','CH.....'/
DATA HOUSE5/'MORIN','PLACI','REGIO','PORPH','EQUAL',
1'ZARIE','ALCIB'/
DATA MOND/31,0,31,30,31,30,31,31,30,31,30,31/
DATA MONTH/'JA','FE','MR','AP','MY','JN','JL','AU',
1'SE','OC','NO','DE'/
DATA NRULER/4,3,2,10,1,2,3,9,5,6,7,8/
DATA PLANET/'SUN ','MERCURY ','VENUS ','MARS ',
1'JUPITER ','SATURN ','URANUS ','NEPTUNE ','PLUTO ',
2'MOON ','MOONNODE','PARS F. ','ASCEND. ','M.C. ',
3' ','NONE '/
DATA PLAN2/'S','U','M','E','V','E','M','A','J','U',
1'S','A','U','R','N','E','P','L','M','O','M','N','P','F',
2'A','S','M','C'/
DATA QUAD/'FIRE ','EARTH','AIR ','WATER',' '/
DATA ROMAN/' ',' ','I',' ',' ','I','I',' ',' ','I','I',
1'I',' ','I','V',' ',' ',' ','V',' ',' ','V','I',' ',
2' ','V','I','I','V','I','I','I',' ','I','X',' ',
3' ',' ','X',' ',' ','X','I',' ',' ','X','I','I'/
DATA WEEK/'MONDAY ','TUESDAY ','WEDNESDAY',
1'THURSDAY ','FRIDAY ','SATURDAY ','SUNDAY '/
DATA WEEKR/'MOON) ','MARS) ','MERCURY)','JUPITER)',
1'VENUS) ','SATURN) ','SUN) '/
DATA ZOD/'ARIES ','TAURUS ','GEMINI ','CANCER ',
1'LEO ','VIRGO ','LIBRA ','SCORPIO ',
2'SAGITARIUS','CAPRICORN ','AQUARIUS ','PISCES '/
DATA ZOD1/'A','T','G','C','L','V','=','S','/','K','Q','P'/
C
C PLUTO ELEMENTS FROM SHARAF (1964)
DATA A/1.00000023,.387098599,.723331619,1.523688395,
15.202802875,9.53884320,19.19097811,30.0706724,39.672599/
DATA AN0/358.475833,102.279381,212.603222,319.529425,
1225.444651,175.758444,74.313628,41.269550,231.002308/
DATA AN1/35999.049750D0,149472.515289D0,58517.803875D0,
119139.858500D0,3034.906654D0,1222.116782D0,428.502578D0,
2218.466783D0,144.072477D0/
DATA EC0/.01675104,.20561421,.00682069,.09331290,
1.04825382,.05606075,.04704433,.00853341,.24706226/
DATA EC1/-.00004180,.00002046,-.00004774,.00009206,
1.0,.0,.0,.0,.0/
DATA P0/101.220833,75.899697,130.163833,334.218203,
111.907422,90.110981,169.048778,43.755611,221.592475/
DATA P1/1.719175,1.555489,1.408036,1.840758,
1.0,.0,.0,.0,1.388888/
DATA TH0/0.,47.145944,75.779647,48.786442,
198.932822,112.347606,73.490250,130.678889,108.937165/
DATA TH1/0.,1.185208,.899850,.770992,
1.0,.0,.509667,1.100972,1.358056/
DATA XI/0.,7.002881,3.393630,1.850333,
11.311614,2.494239,.7726658,1.779256,17.109816/
C
LINEP=0
PI=3.141592653
PI2=6.283185307179586476D0
CONV=PI2/360.D0
CONVS=CONV
DO 100 I=1,70
DO 100 J=1,42
100 WHEEL(I,J)=' '
DO 110 I=1,220
J=34.5*COS(I*.0285)+35.5
K=20.5*SIN(I*.0285)+21.5
110 WHEEL(J,K)='.'
C FOLLOWING PUTS HOUSE ROMAN NUMERALS INTO WHEEL
DO 120 I=4,48,4
J=12.*COS((I+22)*.1308997)+34.
K=-7.*SIN((I+22)*.1308997)+21.5
WHEEL(J,K)=ROMAN(I-3)
WHEEL(J+1,K)=ROMAN(I-2)
WHEEL(J+2,K)=ROMAN(I-1)
120 WHEEL(J+3,K)=ROMAN(I)
DO 130 I=1,120
DO 130 J=1,14
130 P(I,J)=0.
C
TYPE 10000
10000 FORMAT(' SAMPLE INPUT (GREGORIAN DATE,TIME,',
1'CONVERSION TO GMT,LATITUDE,LONGITUDE)'//
2' 1899/12/31 23:59 +08:00 34N59 122W59 COMMENTS,NAMES'//
3' TYPE "TYPE ASTRO.HLP" FOR DETAILED EXPLANATIONS'/////
4' A=ARIES C=CANCER ==LIBRA K=CAPRICORN N=NORTH'/
5' T=TAURUS L=LEO S=SCORPIO Q=AQUARIUS S=SOUTH'/
6' G=GEMINI V=VIRGO /=SAGITTARIUS P=PISCES'//////////
7' ENTER BIRTH DATA -------'//)
C HOROSCOPE LOOP STARTS HERE
140 IOUT=5
C THIS PARAMETER CONTROLS THE OUTPUT (5=TTY)
ACCEPT 11000,NY,CALEND,NM,ND,NH,NMI,NCH,NCM,LATD,LATS,
1LATM,LONGD,LONGS,LONGM,OPTION,COMENT
11000 FORMAT(I4,A1,4(I2,1X),I3,2(1X,I2),A1,I2,1X,I3,A1,I2,1X,
1A5,5X,5A5)
IF(OPTION.NE.'LINEP')GO TO 144
IF (HLP.EQ. .TRUE.)GOTO 7297
CALL OFILE(20,'CHART')
HLP=.TRUE.
7297 IOUT=20
LINEP=1
OPTION=COMENT(1)
WRITE(IOUT,11500)NY,CALEND,NM,ND,NH,NMI,NCH,NCM,LATD,
1LATS,LATM,LONGD,LONGS,LONGM,COMENT
11500 FORMAT('1'//' ---DATE--- -TIME -ZONE- -LAT- -LONG- ',
1'COMMENTS--------'/I5,A1,I2,'/',I2,I3,':',I2,I4,':',I2,
2I3,A1,I2,I4,A1,I2,1X,5A5)
144 GMT=((NH+NCH-12)*60+NMI+SIGN(NCM*1.,NCH*1.))/1440.
XJD=(ND-32075+1461*(NY+4800+(NM-14)/12)/4+367*(NM-2-
1(NM-14)/12*12)/12-3*((NY+4900+(NM-14)/12)/100)/4)+GMT
IF(CALEND.NE.'B')GO TO 150
NY=1-NY
150 IF(CALEND.NE.'J'.AND.CALEND.NE.'B')GO TO 160
XJD=(ND-32075+1461*(NY+4800+(NM-14)/12)/4
1+367*(NM-2-(NM-14)/12*12)/12-38)+GMT
160 T=(XJD-2415020.D0)/36525.D0
C
JFINAL=2
IF(OPTION.NE.'PROGR'.AND.OPTION.NE.'EPHEM')GO TO 170
JFINAL=101
C PLANETARY EPHEMERIDES COMPUTED BELOW (NEWCOMB/HILL,1898)
C ALL VALUES WITHIN 1.5' EXCEPT PLUTO --- URANUS/NEPTUNE
C SUFFER FOR VERY ANCIENT DATES (ERROR UP TO 3-4 DEGREES)
C COMMENTS AFTER PERTURBATIONS (BELOW) GIVE MAXIMUM
C EFFECTS OF TERMS ON GEOCENTRIC LONGITUDE
170 DO 270 J=1,JFINAL
TT=T+(J-1)/36525.D0
TP=TT+18262.D0/36525.D0
W=TT
DO 174 I=1,9
EC(I)=EC0(I)+EC1(I)*W
N=AN1(I)*TT/360.D0
174 G(I)=(AN1(I)*TT-N*360.D0+DBLE(AN0(I)))*CONV
G5=G(5)
G6=G(6)
G7=(220.169542+428.49311*TP)*CONVS
G(5)=G(5)+(.6506*SIN(2*G6-2*G5+336.9*CONVS)
1+(3.9987-.002213*36525./4332.58*TP)
2*SIN(5*G6-2*G5+(67.15-8197.0/3600.*TP)*CONVS)
3+.5380*SIN(5*G6-3*G5+176.5*CONVS)
4+.4112*SIN(2*G6-G5+1.4*CONVS)
4+.0399278*36525./4332.58*TP*SIN(-G5+227.46*CONVS)
5+.2763*SIN(3*G6-2*G5+127.4*CONVS)
6+.2669*SIN(G6-G5+79.2*CONVS) )*299.12837/3600.*CONVS
C 250",1500"-7"T,202",154",126"T(PROBLEM?),104",100",
C (21",20",19",18",14",14",11",9",6"T)
G(6)=G(6)+(24.153*SIN(5*G6-2*G5+(247.11-2.277*TP)*CONVS)
1+5.679*SIN(4*G6-2*G5+277.39*CONVS)
2+3.505*SIN(2*G6-G5+181.43*CONVS)
3+.657765*36525./10759.20*TP*SIN(G6+238.0*CONVS)
4+.278*SIN(3*G6-G5+121.2*CONVS)
5+.266*SIN(2*G6-2*G5+157.0*CONVS)
6+.238*SIN(6*G6-2*G5-3*G7+6.9*CONVS)
7+.223*SIN(10*G6-4*G5+(133.6-14814.5/3600.*W)*CONVS)
8+.234*SIN(3*G7-G6+321.7*CONVS) )*120.455/3600.*CONVS
C 3270",770",473",300"T(PROBLEM?),37",36",32",30",32",
C (29",26",19"T,16"T,14",13",10",9",9",8",7")
G(7)=G(7)+33.086*W*W/3600.*CONVS
G(8)=G(8)-22.401/3600.*W*W*CONVS
DO 177 I=1,9
GE(I)=G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(
1G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(G(I))))))
177 X(I)=2.*ATAN(SQRT((1.+EC(I))/(1.-EC(I)))*TAN(.5*GE(I)))
1+(P0(I)+P1(I)*W)*CONVS + (I/7-I/9)*W*5025.3/3600.*CONVS
GT=(358.415+35998.928*W)*CONVS
GJ=(225.209+3034.462*W+.332*SIN((134.4+38.5*W)*CONVS))
1*CONVS
X(4)=X(4)+(25.384*COS(GJ-G(4)-48.9*CONVS)
1+52.490*SIN((47.48+19.771*W)*CONVS)-37.05-13.50*W
2+21.869*COS(2*GJ-G(4)-188.3*CONVS)
3+16.035*COS(2*GJ-2*G(4)-191.9*CONVS)
4+13.966*COS(-GT+2*G(4)-20.5*CONVS)
5+8.559*COS(-GT+G(4)-35.1*CONVS) )/3600.*CONVS
C 92",191",80",58",51",31",(27",23",18",14",12")
GN=(225.417+3034.904*W)*CONVS
GG=(175.753+1222.113*W)*CONVS
G1=(74.412+428.498*W)*CONVS
GP=(74.320+428.498*W)*CONVS
GPP=(41.339+218.467*W)*CONVS
X(7)=X(7)+(142.938*SIN(GG-2*G1)+19.508*COS(GG-2*G1)
1+75.70*COS(3*G1-GG)-102.30*SIN(3*G1-GG)
2-48.623*SIN(GN-G1)-21.320*COS(GN-G1)
3-27.871*COS(GP-GPP)+19.869*SIN(GP-GPP)
4+28.793*COS(2*GP-2*GPP)+10.035*SIN(2*GP-2*GPP)
5+(18.37*SIN(3*GP-3*GPP)+8.91*COS(3*GP-3*GPP))*COS(G(7))
6+(8.35*SIN(3*GP-3*GPP)-16.44*COS(3*GP-3*GPP))*SIN(G(7))
7-18.585*COS(GG-G1)+12.603*SIN(GG-G1)
8+4.327*COS(3*GP-3*GPP)+14.280*SIN(3*GP-3*GPP)
9 )/3600.*CONVS
C 154",135",56",36",32",29"(2),24",15",(9",7",6")
X(7)=X(7)+((112.317*W-1.551*W*W-.516*W*W*W)*SIN(G(7))
1-(68.339*W+9.721*W*W)*COS(G(7))+6.605*W*SIN(2*G(7))
2-(29.44-.410*W)*SIN((20.45-22.61*W)*CONVS) )/3600.*CONVS
C JUP/SAT TERM & QUADRATURES OF LONG PERIOD URA/NEP TERMS
X(8)=X(8)+( 33.972*W*COS(G(8))
1+18.553*SIN((180.966+1004.034*W+.1403*W*W)*CONVS)
2+34.138*SIN((153.267+2816.296*W-.0573*W*W)*CONVS)
3+(26.50*W+3.92*W*W)*SIN(G(8)) )/3600.*CONVS
C 36"T,19",35",25"T+4"T*T,(15",9",6")
C FIRST/LAST TERMS (QUADRATURES) IMPROVE 1600-2000 VALUES
C BUT FOR VERY ANCIENT DATES ARE INVALID
DO 185 I=1,9
TH=(TH0(I)+TH1(I)*W)*CONVS
DO 180 K=1,2
C MOTION OF JUP/SAT NODES FROM LEVERRIER
TH2=TH+(I/5*3636.6-I/6*493.1-I/7*3143.5)/3600.*TP*CONVS
R(I)=A(I)*(1.-EC(I)*COS(2.*ATAN(TAN((TH2+(K-1)*PI-(P0(I)
1+P1(I)*W)*CONVS)*.5)*SQRT((1.-EC(I))/(1.+EC(I))))))
XNODE(K,I)=R(I)*COS(TH2+(K-1)*PI)
180 YNODE(K,I)=R(I)*SIN(TH2+(K-1)*PI)
TL(I)=TH+ATAN2(SIN(X(I)-TH)*COS(XI(I)*CONVS),
1COS(X(I)-TH))+(I/5-I/7)*TP*5026.1/3600.*CONVS
TB(I)=ASIN(SIN(XI(I)*CONVS)*SIN(X(I)-TH))
185 R(I)=A(I)*(1.-EC(I)*COS(GE(I)))
TB(5)=TB(5)+4.37431*36525./4332.58*SIN(X(5)+23.62*CONVS)
1*TP/3600.*CONVS
TB(6)=TB(6)+24.266*36525./10759.2*SIN(X(6)-13.05*CONVS)
1*TP/3600.*CONVS
C TB(5) EFFECTS LESS THAN 35"T, TB(6) LESS THAN 84"T
R(5)=R(5)*10.**(.0002303*COS(2*G6-2*G5+336.9*CONVS)
1+.0001679*COS(5*G6-3*G5+176.4*CONVS)
2+.0000125634*36525./4332.58*TP*COS(-G5+227.4*CONVS) )
C 22",16",10"T,(7",5",3")
R(6)=R(6)*10.**(.0007005*COS(4*G6-2*G5+277.3*CONVS)
1+.0003783*COS(G6-G5+79.8*CONVS)
2+.000083491*36525./10759.20*TP*COS(G6+58.0*CONVS)
3+.0002443*COS(2*G6-G5+176.0*CONVS) )
C 37",20",15"T,13",(10",6",3")
C R(7) TERMS EFFECT LESS THAN 5",3"T,2"T,.3"T*T
C R(8) TERMS ONLY EFFECT .02' MAXIMUM
DO 190 I=1,9
X(I)=R(I)*COS(TB(I))*COS(TL(I))
Y(I)=R(I)*COS(TB(I))*SIN(TL(I))
190 Z(I)=R(I)*SIN(TB(I))
DO 210 I=2,9
DO 200 K=1,2
XNODE(K,I)=XNODE(K,I)-X(1)
YNODE(K,I)=YNODE(K,I)-Y(1)
200 P(K+17,I)=ARG(ATAN2(YNODE(K,I),XNODE(K,I))/6.2831853,1.)
XX(I)=X(I)-X(1)
YY(I)=Y(I)-Y(1)
210 ZZ(I)=Z(I)-Z(1)
XX(1)=-X(1)
YY(1)=-Y(1)
ZZ(1)=-Z(1)
XNUT=-17.2327/1296000.*SIN((259.18-1934.142*W)*CONVS)
DO 230 I=1,9
P(J+19,I)=ARG(ATAN2(YY(I),XX(I))/6.28318531+XNUT,1.)
IF(J-1)230,220,230
220 DIST=SQRT(XX(I)*XX(I)+YY(I)*YY(I)+ZZ(I)*ZZ(I))
P(1,I)=ASIN(ZZ(I)/DIST)/CONVS
E=(23.4522944-.0130125*W+.002558*COS((259.18-1934.142
1*W)*CONVS))*CONVS
P(2,I)=ASIN(COS(P(1,I)*CONVS)*SIN(P(20,I)*6.28318531)
1*SIN(E)+SIN(P(1,I)*CONVS)*COS(E))/CONVS
P(6,I)=ARG(TL(I)/6.28318531,1.)
P(3,I)=TB(I)/CONVS
P(4,I)=ASIN(COS(TB(I))*SIN(TL(I))*SIN(E)
1+SIN(TB(I))*COS(E))/CONVS
230 CONTINUE
C
C LUNAR EPHEMERIDES COMPUTED TO WITHIN 1' (BROWN/I.L.E.)
DAY=XJD-2415020.D0+(J-1.D0)
XL=.751206D0+DAY*.0366011014634D0
YL=.776935D0+DAY*.0027379092649D0
XP=.928693D0+DAY*.0003094557786D0
YP=.781169D0+DAY*.0000001307457D0
XN=.719954D0-DAY*.0001470942283D0
AL=(XL-IDINT(XL))*PI2
BL=(YL-IDINT(YL))*PI2
AP=(XP-IDINT(XP))*PI2
BP=(YP-IDINT(YP))*PI2
AN=(XN-IDINT(XN))*PI2
U=AL-AP
V=BL-BP
F=AL-AN
D=AL-BL
DL=22639*SIN(U)-4586*SIN(U-D-D)+2370*SIN(D+D)+769*SIN(U+U)
1-668*SIN(V)-412*SIN(F+F)-212*SIN(U+U-D-D)-206*SIN(U+V-D-D)
2+192*SIN(U+D+D)-165*SIN(V-D-D)+148*SIN(U-V)-125*SIN(D)
3-110*SIN(U+V)-55*SIN(F+F-D-D)-45*SIN(U+F+F)+40*SIN(U-F-F)
4-38*SIN(U-4*D)+36*SIN(3*U)-31*SIN(U+U-4*D)+28*SIN(U-V-D-D)
5-24*SIN(V+D+D)+19*SIN(U-D)+18*SIN(V+D)+15*SIN(U-V+D+D)
6+14*SIN(4*D)+14*SIN(U+U+D+D)-13*SIN(3*U-D-D)
P(J+19,10)=ARG(XL-IDINT(XL)+DL/1296000.+XNUT,1.)
P(J+19,11)=ARG(AN/6.28318531,1.)
IF(J-1)270,260,270
260 P(1,10)=(18461*SIN(F)+1010*SIN(U+F)-1000*SIN(F-U)
1-624*SIN(F-2*D)-167*SIN(U+F-D-D)+199*SIN(F-U+D+D)
2+117*SIN(F+D+D)+62*SIN(U+U+F)-33*SIN(F-U-D-D)
3-32*SIN(F-U-U)-30*SIN(V+F-D-D)-16*SIN(U+U+F-D-D)
4+15*SIN(U+F+D+D)+12*SIN(F-V-D-D)+9*SIN(F-U-V+D+D))/3600.
P(2,10)=ASIN(COS(P(1,10)*CONVS)*SIN(P(20,10)*6.28318531)
1*SIN(E)+SIN(P(1,10)*CONVS)*COS(E))/CONVS
270 CONTINUE
C
E=(23.4522944-.0130125*T+.002558*DCOS((259.18-1934.142
1*T)*CONV))*CONVS
DO 277 I=2,9
RETRO(I-1)=' DIR '
IF(ARG(P(21,I)-P(20,I),1.)-.5)277,277,275
275 RETRO(I-1)='RETRO'
277 CONTINUE
C
XLW=(LONGD+LONGM/60.)/360.
XLN=(LATD+LATM/60.)*CONVS
IF(LATS.EQ.'N')GO TO 280
XLN=-XLN
280 IF(LONGS.EQ.'W')GO TO 290
XLW=-XLW
C H(1)=GMT H(2)=GST H(3)=LMT H(4)=LST
290 H(1)=ARG(SNGL(GMT)+.5,1.)
W=100.00213590D0*T-IDINT(100.D0*T)
H(2)=ARG(H(1)+.27691940+W,1.)
H(3)=ARG(H(1)-XLW,1.)
H(4)=ARG(H(2)-XLW,1.)
DO 300 I=1,4
W=24.*H(I)+.00013888888
IH(I,1)=W
W=60.*(W-IH(I,1))
IH(I,2)=W
300 IH(I,3)=60.*(W-IH(I,2))
IF(OPTION.EQ.'PROGR'.OR.OPTION.EQ.'EPHEM')GO TO 310
WRITE(IOUT,12000),((IH(I,J),J=1,3),I=1,4)
12000 FORMAT(/' GMT=',I2,2(':',I2),' GST=',I2,2(':',I2),
1' LMT=',I2,2(':',I2),' LST=',I2,2(':',I2))
JD1=XJD
XJD1=XJD-JD1
I=JD1+INT(XJD1+1.5-XLW)-(JD1-1+INT(XJD1+1.5-XLW))/7*7
YBES=1900.D0+(XJD-2415020.31351528D0)/365.24219878125D0
1-.00000107523D0*T*T
IYBES=YBES
YBES1=YBES-IYBES
WRITE(IOUT,13000)WEEK(I),WEEKR(I),JD1,XJD1,IYBES,YBES1
13000 FORMAT(' DAY OF THE WEEK (FROM LMT) IS ',A9,
1' (RULED BY ',A8/' JD=',I7,F7.6,7X,' BESSELIAN YEAR = ',
2I5,F10.9)
C
C HOUSE CUSP COMPUTATIONS (ACCURATE TO LAST DIGIT)
310 ITER=1+LATD/45
C "ITER" IS THE NUMBER OF PLACIDEAN ITERATIONS
RA=6.28318531*H(4)
DO 340 N=1,6
AA=6.28318531*(N+2)/12.
P(7,N)=ARG(ATAN2(SIN(RA)*COS(AA)+COS(RA)*COS(XLN)*
1SIN(AA),COS(E)*(COS(RA)*COS(AA)-SIN(RA)*COS(XLN)*
2SIN(AA))-SIN(E)*SIN(XLN)*SIN(AA))/6.28318531,1.)
P(8,N)=ARG(ATAN2(SIN(RA+AA)*COS(E),COS(RA+AA))
1/6.28318531,1.)
P(9,N)=ARG(ATAN2(SIN(RA+AA),COS(E)*COS(RA+AA)-SIN((3.-
1ABS(1.-N))/3.*ASIN(TAN(E)*TAN(XLN)))*COS(E))/PI*.5,1.)
DO 330 J=1,ITER
X(1)=P(9,N)*6.28318531
X(2)=X(1)+CONVS*.5
C INCREMENT "CONVS*.5" IS ARBITRARILY CHOSEN (=.5 DEG)
DO 320 K=1,2
AD=ASIN(TAN(XLN)*TAN(ASIN(SIN(X(K))*SIN(E))))
DRA=ARG(ATAN2(SIN(X(K))*COS(E),COS(X(K)))-RA-(N-1)*PI/6.
1,PI)-PI*.5
320 Y(K)=DRA-(4.-N)*AD/3.
330 P(9,N)=P(9,N)-Y(1)/(Y(2)-Y(1))*.5/360.
C THE ".5" CONSTANT HERE MUST AGREE WITH THE ONE ABOVE
P(10,N)=ARG(ATAN2(SIN(RA+AA),COS(E)*COS(RA+AA)-SIN(E)
1*TAN(XLN)*SIN(AA))/6.28318531,1.)
340 P(12,N)=ARG(P(7,1)+(N-1)/12.,1.)
DO 350 N=1,6
P(11,N)=ARG(P(7,1)+(N-1)/12.+(ARG(P(7,4)-P(7,1),1.)
1-.25)*(3.-ABS(3.-ABS(N-7.)))/3.,1.)
350 P(13,N)=ARG(P(7,4)+(N-4)/12.,1.)
W=ARG(ATAN2(SQRT((COS(XLN)/SIN(E))**2-SIN(P(7,4)*
16.28318531)**2),SIN(XLN)*SIN(P(7,4)*6.28318531)),PI)/3.
DO 351 N=1,3
351 P(14,N)=ARG(ATAN2(COS(RA+(N-1)*W),-SIN(RA+(N-1)*W)
1*COS(E)-SIN(E)*TAN(XLN))/6.28318531,1.)
W=ARG(ATAN2(SIN(P(7,1)*6.28318531)*COS(E),COS(P(7,1)*
16.28318531))-RA,PI)/3.
DO 352 N=4,6
352 P(14,N)=ARG(ATAN2(SIN(RA+(N-4)*W),COS(RA+(N-4)*W)*COS(E)
1)/6.28318531+.5,1.)
DO 355 J=7,14
DO 355 N=1,6
355 P(J,N+6)=ARG(P(J,N)+.5,1.)
C
C PARS FORTUNA & PLANETARY NODES FOLLOW
P(20,12)=ARG(P(20,10)-P(20,1)+P(11,1),1.)
DO 360 I=2,9
360 P(17,I)=ARG(P(20,I)-P(20,1)+P(11,1),1.)
C
C ARGUMENTS TRANSFORMED TO SIGNS/DEGREES/MINUTES
DO 390 I=1,4
DO 390 J=1,12
GLYPH(I,J)='N'
IF(P(I,J))370,380,380
370 GLYPH(I,J)='S'
380 DEG=ABS(P(I,J))+.0083333333
ID(I,J)=DEG
390 IM(I,J)=60.*(DEG-ID(I,J))
IFINAL=JFINAL+19
DO 400 I=6,IFINAL
DO 400 J=1,12
W=12.*P(I,J)+.00027777777
IS(I,J)=W
ISS=W+1.
GLYPH(I,J)=ZOD1(ISS)
W=30.*(W-IS(I,J))
ID(I,J)=W
400 IM(I,J)=60.*(W-ID(I,J))
C
C PROGRESSION & EPHEMERIS OUTPUT ROUTINE FOLLOWS
IF(OPTION.NE.'PROGR')GO TO 420
WRITE(IOUT,14000)
14000 FORMAT(/19X,'PROGRESSED (GEOCENTRIC) LONGITUDES'//
1' YEAR SUN MERC VENUS MARS JUPIT SATUR ',
2' URAN NEPT PLUTO MOON NODE')
DO 410 I=20,120
II=I-20
410 WRITE(IOUT,15000)II,(ID(I,J),GLYPH(I,J),IM(I,J),J=1,11)
15000 FORMAT(' ',I3,1X,11(1X,I2,A1,I2))
GO TO 9999
420 IF(OPTION.NE.'EPHEM')GO TO 470
WRITE(IOUT,16000)IH(1,1),IH(1,2),NY
16000 FORMAT(//19X,'DAILY EPHEMERIS FOR ',I2,':',I2,' GMT'//
1' DATE SUN MERC VENUS MARS JUPIT SATUR URAN',
2' NEPT PLUTO MOON NODE'/I6)
MY=NY+(NM+7)/10
MOND(2)=1461*(MY+4800)/4-1461*(MY+4799)/4-337
IF(CALEND.EQ.'J')GO TO 430
MOND(2)=MOND(2)-(MY+4900)/100*3/4+(MY+4899)/100*3/4
430 DO 460 I=20,120
WRITE(IOUT,17000)MONTH(NM),ND,(ID(I,J),GLYPH(I,J),
1IM(I,J),J=1,11)
17000 FORMAT(' ',A2,I2,11(1X,I2,A1,I2))
ND=ND+1
IF(ND-MOND(NM))460,460,440
440 ND=ND-MOND(NM)
NM=NM+1
IF(NM-12)460,460,450
450 NM=1
NY=NY+1
WRITE(IOUT,18000)NY
18000 FORMAT(I6)
460 CONTINUE
GO TO 9999
C
470 WRITE(IOUT,19000),(ID(20,I),GLYPH(20,I),IM(20,I),I=1,12)
1,RETRO,((ID(I,J),GLYPH(I,J),IM(I,J),J=1,10),I=1,2)
19000 FORMAT(//8X,'GEOCENTRIC PLANET POSITIONS (LONGITUDE,',
1'LATITUDE,DECLINATION)'/' SUN MERC VENUS MARS',
2' JUPIT SATUR URAN NEPT PLUTO MOON NODE P.F.'/
31X,12(I3,A1,I2)/7X,8(1X,A5)/1X,10(I3,A1,I2)/
41X,10(I3,A1,I2)//)
WRITE(IOUT,19500),((ID(I,J),GLYPH(I,J),IM(I,J),J=1,12),
1I=7,14),(ID(7,J),GLYPH(7,J),IM(7,J),J=1,10,3)
19500 FORMAT(24X,'HOUSE CUSPS IN SYSTEMS OF'/
1' CAMPANUS,MORINUS,PLACIDUS,REGIOMONTANUS,PORPHYRY,',
2'EQUAL,ZARIEL,ALCIBITIUS'/' 1 2 3 ',
2' 4 5 6 7 8 9 10 11 12'/
31X,12(I3,A1,I2)/1X,12(I3,A1,I2)/1X,12(I3,A1,I2)/
41X,12(I3,A1,I2)/1X,12(I3,A1,I2)/1X,12(I3,A1,I2)/
51X,12(I3,A1,I2)/1X,12(I3,A1,I2)/
6' RISING',14X,'I.C.',13X,'DESC.',14X,'M.C.'/
71X,4(I3,A1,I2,12X)///////)
C
C RULING,SIGNIFICATING,RISING PLANETS
I=IS(20,1)+1
J=IS(7,1)+1
I=NRULER(I)
J=NRULER(J)
DISP(1)=PLANET(16)
K=0
DO 490 L=1,12
IF(ABS(ARG(P(7,1)-P(20,L)+1.5,1.)-.5)-.03333)480,480,490
480 K=K+1
DISP(K)=PLANET(L)
490 CONTINUE
K=K+(K+.101)/(K+.050)-1
WRITE(IOUT,20000)PLANET(I),PLANET(J),(DISP(L),L=1,K)
20000 FORMAT(' RULING PLANET IS ',A8/
1' SIGNIFICATOR (PLANET RULING THE RISING SIGN) IS ',A8/
2' RISING PLANETS :',6(1X,A8)/17X,6(1X,A8))
C
C QUADRUPLICITIES/TRIPLICITIES TABULATED
IS(20,13)=IS(7,1)
IS(20,14)=IS(7,10)
P(20,13)=P(7,1)
P(20,14)=P(7,10)
WRITE(IOUT,21000)
21000 FORMAT(/' DISTRIBUTION OF ELEMENTS IS AS FOLLOWS:'//
18X,'.-----CARDINAL------.-------FIXED-------.',
2'------MUTABLE------.')
DO 500 I=1,5
DO 500 J=1,3
DO 500 K=1,12
500 ELEM(I,J,K)=' '
I5=0
DO 530 I=1,14
K=IS(20,I)-IS(20,I)/4*4+1
L=IS(20,I)-IS(20,I)/3*3+1
510 DO 520 J=1,11,2
IF(ELEM(K,L,J).NE.' ')GO TO 520
ELEM(K,L,J)=PLAN2(1,I)
ELEM(K,L,J+1)=PLAN2(2,I)
GO TO 530
520 CONTINUE
I5=K
K=5
GO TO 510
530 CONTINUE
DO 550 I=1,4
WRITE(IOUT,22000)QUAD(I),((ELEM(I,J,K),K=1,12),J=1,3)
22000 FORMAT(1X,A5,' .',6(1X,2A1),' .',6(1X,2A1),' .',
16(1X,2A1),' .')
IF(I5-I)550,540,550
540 WRITE(IOUT,22000)QUAD(5),((ELEM(5,J,K),K=1,12),J=1,3)
550 CONTINUE
WRITE(IOUT,23000)
23000 FORMAT(8X,'.-------------------.-------------------',
1'.-------------------.')
C
C ASPECTS
DO 560 I=1,14
DO 560 J=1,14
560 IASP(I,J)=360.*(.5-ABS(.5-ABS(P(20,I)-P(20,J))))+.5
WRITE(IOUT,24000),((IASP(I,J),I=1,14),J=1,14)
24000 FORMAT(/' ALL PLANETARY ANGLES ARE TABULATED BELOW'//
15X,'SUN MER VEN MAR JUP SAT URA NEP PLU MOO NOD PF. AS',
2'C MC.'/' SUN',14I4/' MER',14I4/' VEN',14I4/' MAR',14I4/
3' JUP',14I4/' SAT',14I4/' URA',14I4/' NEP',14I4/
4' PLU',14I4/' MOO',14I4/' NOD',14I4/' PF.',14I4/
5' ASC',14I4/' MC.',14I4/)
WRITE(IOUT,25000)
25000 FORMAT(' IMPORTANT ASPECTS ARE AS FOLLOWS ("EXACT" ',
1'ORBS PERTAIN TO THE '/' TRUE ANGLE BETWEEN OBJECTS ',
2' #1 AND #2)'//
3' OBJECT#1 OBJECT#2 ASPECT (DEG) ORB(EXACT)',
4' APPLYING/WANING'/)
C
DO 660 I=1,13
II=I+1
DO 660 J=II,14
DIF=360.*(.5-ABS(.5-ABS(P(20,I)-P(20,J))))
N=DIF+1
IF(ASPECT(N))570,660,570
570 K=ASPECT(N)
DIF1=ABS(DIF-ASPDEG(K))
DIF=ARG(ACOS(COS(P(1,I)*CONVS)*COS(P(1,J)*CONVS)*COS
1((P(20,I)-P(20,J))*6.28318531)+SIN(P(1,I)*CONVS)*
2SIN(P(1,J)*CONVS))/CONVS,180.)
DIF2=ABS(DIF-ASPDEG(K))
APPLY=' '
IF(I/12+J/12)610,610,580
580 IF(I/12-J/12)590,650,600
590 P(21,J)=P(20,J)+ABS(ARG(P(21,I)-P(20,I)+.5,1.)-.5)*1.1
GO TO 610
600 P(21,I)=P(20,I)+ABS(ARG(P(21,J)-P(20,J)+.5,1.)-.5)*1.1
610 APPLY='A'
W=(ARG(P(20,I)-P(20,J),1.)-ASPDEG(K)/360.)/
1(ARG(P(21,I)-P(21,J),1.)-ASPDEG(K)/360.)
IF(ARG(P(20,I)-P(20,J),1.)-.5)630,630,620
620 W=(ARG(P(20,J)-P(20,I),1.)-ASPDEG(K)/360.)/
1(ARG(P(21,J)-P(21,I),1.)-ASPDEG(K)/360.)
630 IF(W-1.)640,650,650
640 APPLY='W'
650 WRITE(IOUT,26000)PLANET(I),PLANET(J),ASPTYP(K),ASPDEG(K)
1,DIF1,DIF2,APPLY
26000 FORMAT(1X,2(A8,2X),A8,'(',I3,')',F7.2,'(',F5.2,')',5X,A1)
660 CONTINUE
C
C PARALLEL ASPECTS
WRITE(IOUT,27000)
27000 FORMAT(/' PARALLEL ASPECTS (IF ANY) ARE AS FOLLOWS:'/)
DO 680 I=1,9
II=I+1
DO 680 J=II,10
DIF=60.*ABS(ABS(P(2,I))-ABS(P(2,J)))
IF(DIF-60.)670,670,680
670 WRITE(IOUT,28000)PLANET(I),PLANET(J),DIF
1,ID(2,I),GLYPH(2,I),IM(2,I),ID(2,J),GLYPH(2,J),IM(2,J)
28000 FORMAT(6X,A8,' PARALLEL ',A8,' WITHIN ',F4.1,3H' (,
1I2,A1,I2,' & ',I2,A1,I2,')')
680 CONTINUE
C
C ESSENTIAL DIGNITIES
WRITE(IOUT,29000)
29000 FORMAT(/' ESSENTIAL DIGNITIES (IF ANY) FOLLOW :'/)
DO 720 I=1,10
N=IS(20,I)+1
IF(DIG(I,N))690,720,690
690 J=DIG(I,N)
WRITE(IOUT,30000)PLANET(I),DIGTYP(1,J),DIGTYP(2,J),ZOD(N)
30000 FORMAT(6X,A8,' IS ',2A6,' IN ',A10)
IF(DIG(I,N)-3)700,720,720
700 IF(EXDEG(I)-ID(20,I))720,710,720
710 WRITE(IOUT,31000)EXDEG(I)
31000 FORMAT('+',43X,' (BY EXACT DEGREE , ',I2,')')
720 CONTINUE
C
C MUTUAL RECEPTION CHECK
WRITE(IOUT,32000)
32000 FORMAT(/' MUTUAL RECEPTIONS (IF ANY) FOLLOW :'/)
DO 760 I=1,9
M=IS(20,I)+1
II=I+1
DO 760 J=II,10
N=IS(20,J)+1
IF(DIG(J,M)*DIG(I,N)-1.)740,730,740
730 WRITE(IOUT,33000)PLANET(I),PLANET(J)
33000 FORMAT(6X,A8,'AND ',A8,'ARE MUTUALLY RECEPTIVE BY ',
1'EXALTED SIGNS')
GO TO 760
740 IF((DIG(J,M)-2.)*(DIG(I,N)-2.)-1.)760,750,760
750 WRITE(IOUT,34000)PLANET(I),PLANET(J)
34000 FORMAT(6X,A8,'AND ',A8,'ARE MUTUALLY RECEPTIVE BY ',
1'NATURAL SIGNS')
760 CONTINUE
C
C DISPOSITORS
WRITE(IOUT,35000)
35000 FORMAT(/' DISPOSITORSHIPS FOLLOW ("D" MEANS "IS THE ',
1'DISPOSITOR OF")'/)
DO 770 I=1,14
TAKEN(I)=0
ISS=IS(20,I)+1
NDISP(I)=NRULER(ISS)
770 DISP(I)=PLANET(15)
TAKEN(15)=2
I=1
IPRINT=0
780 J=NDISP(I)
DO 790 K=1,9
790 J=NDISP(J)
K=1
LEVEL(1)=J
TAKEN(J)=1
IF(IPRINT)820,820,800
800 WRITE(IOUT,36000),(DBLANK(M),DISP(M),M=1,IPRINT)
DO 810 M=1,14
810 DISP(M)=PLANET(15)
IPRINT=0
820 DISP(1)=PLANET(J)
DBLANK(1)=' '
830 K=K+1
LEVEL(K)=I
840 II=LEVEL(K)
IF(NDISP(II)-LEVEL(K-1))850,880,850
850 LEVEL(K)=LEVEL(K)+1
IF(LEVEL(K)-15)840,860,840
860 K=K-1
IF(K-1)850,870,850
870 I=I+1
IF(TAKEN(I)-1)780,870,920
880 TAKEN(II)=1
IF(K-IPRINT)890,890,910
890 WRITE(IOUT,36000),(DBLANK(M),DISP(M),M=1,IPRINT)
36000 FORMAT(3X,12(A2,A8))
DISP(15)=DISP(K)
DO 900 M=1,14
DISP(M)=PLANET(15)
900 DBLANK(M)=' '
IPRINT=0
IF(DISP(15).NE.PLANET(II))GO TO 910
IF(II-J)830,850,830
910 DISP(K)=PLANET(II)
IPRINT=K
DBLANK(K)='D '
IF(II-J)830,890,830
920 IF(II-J)930,940,930
930 WRITE(IOUT,36000),(DBLANK(M),DISP(M),M=1,IPRINT)
940 CONTINUE
C
C HELIOCENTRIC COORDINATES, PLANETARY PARTS & NODES
WRITE(IOUT,37000),(ID(6,J),GLYPH(6,J),IM(6,J),J=2,9),
1((ID(I,J),GLYPH(I,J),IM(I,J),J=2,9),I=3,4),
2((ID(I,J),GLYPH(I,J),IM(I,J),J=2,9),I=17,19)
37000 FORMAT(//23X,'MERC VENUS MARS JUPIT SATUR URAN NEPT',
1' PLUTO'/' HELIOCENTRIC--------'/
2' LONGITUDE',11X,8(1X,I2,A1,I2)
3/' LATITUDE',12X,8(1X,I2,A1,I2)/' DECLINATION',9X,
48(1X,I2,A1,I2)/' GEOCENTRIC----------'/' PARTS',15X,
58(1X,I2,A1,I2)/' NORTH PLANETARY NODE',8(1X,I2,A1,I2)/
6' SOUTH PLANETARY NODE',8(1X,I2,A1,I2))
C
W=(84038.55+5025.640*T+1.1118*T*T)/3600.
WRITE(IOUT,38000)W
38000 FORMAT(/' TO GET SIDEREAL LONGITUDES SUBTRACT ',F8.4,
1' DEG. FROM ALL LONGITUDES')
C
C HOROSCOPE "WHEEL" OUTPUT ROUTINE
NH=7
DO 950 I=1,5
IF(OPTION.NE.HOUSE5(I))GO TO 950
NH=I+11
950 CONTINUE
WRITE(IOUT,39000)HOUSE(1,NH-6),HOUSE(2,NH-6)
39000 FORMAT(//' CHART BELOW USES TROPICAL GEOCENTRIC ',2A7,
1' HOUSE SYSTEM',/,'1')
P(NH,13)=P(NH,1)
C FOLLOWING PUTS SPOKES INTO WHEEL
DO 960 I=1,6
W=34.5*COS((I-1)*.5235988)
WW=20.5*SIN((I-1)*.5235988)
M=SQRT(W*W+WW*WW)+1.
M2=M+M
DO 960 II=1,M2
J=W-W*II/M+35.6
K=WW-WW*II/M+21.5
960 WHEEL(J,K)='.'
WHEEL(35,21)='+'
C
C FOLLOWING PUTS PLANETS INTO WHEEL
DO 1040 I=1,12
J=1
970 W=ARG(P(20,I)-P(NH,J),1.)/ARG(P(NH,J+1)-P(NH,J),1.)
IF(W-1.)990,980,980
980 J=J+1
GO TO 970
990 PLACE(I)=(J+W+5.)*PI/6.
IWX1(I)=32.*COS(PLACE(I))
IWY1(I)=18.*SIN(PLACE(I))
NDIF1=1.99*COS(PLACE(I))
NDIF2=1.99*SIN(PLACE(I))
IWX2(I)=IWX1(I)-NDIF1
IWY2(I)=IWY1(I)-NDIF2
GO TO 1010
1000 IWX1(I)=IWX1(I)-4.*COS(PLACE(I))
IWY1(I)=IWY1(I)-3.*SIN(PLACE(I))
IWX2(I)=IWX1(I)-NDIF1
IWY2(I)=IWY1(I)-NDIF2
1010 J=IWX1(I)+35.5
K=-IWY1(I)+21.5
JJ=IWX2(I)+35.5
KK=-IWY2(I)+21.5
IF(((WHEEL(J,K).NE.'.').AND.(WHEEL(J,K).NE.' '))
1.OR.((WHEEL(JJ,KK).NE.'.').AND.(WHEEL(JJ,KK).NE.' ')))
2GO TO 1000
IF(IWX1(I))1020,1020,1030
1020 WHEEL(J,K)=PLAN2(1,I)
WHEEL(JJ,KK)=PLAN2(2,I)
GO TO 1040
1030 WHEEL(J,K)=PLAN2(2,I)
WHEEL(JJ,KK)=PLAN2(1,I)
1040 CONTINUE
C
C FOLLOWING PUTS ZODIACAL CUSPS INTO WHEEL
DO 1080 I=13,24
J=1
1050 W=ARG((I-1)/12.-P(NH,J),1.)/ARG(P(NH,J+1)-P(NH,J),1.)
IF(W-1.)1070,1060,1060
1060 J=J+1
GO TO 1050
1070 PLACE(I)=(J+W+5.)*PI/6.
J=34.5*COS(PLACE(I))+35.5
K=-20.5*SIN(PLACE(I))+21.5
1080 WHEEL(J,K)=ZOD1(I-12)
C
DO 1090 I=1,42
1090 WRITE(IOUT,40000),(WHEEL(J,I),J=1,70)
40000 FORMAT(' ',70A1)
C
C FOLLOWING DELETES PLANETS FROM WHEEL
DO 1100 I=1,12
J=IWX1(I)+35.5
K=-IWY1(I)+21.5
JJ=IWX2(I)+35.5
KK=-IWY2(I)+21.5
JJJ=34.5*COS(PLACE(I+12))+35.5
KKK=-20.5*SIN(PLACE(I+12))+21.5
WHEEL(JJJ,KKK)='.'
WHEEL(J,K)=' '
1100 WHEEL(JJ,KK)=' '
C
C INTERCEPTED SIGNS
WRITE(IOUT,41000)
41000 FORMAT(/' INTERCEPTED SIGNS (IF ANY) FOLLOW')
DO 1120 I=13,18
IF(INT(PLACE(I)*6/PI)-INT(PLACE(I+1)*6/PI))1120,1110,1120
1110 WRITE(IOUT,42000)ZOD(I-12),ZOD(I-6)
42000 FORMAT(6X,A10,4X,A10)
1120 CONTINUE
C
9999 TYPE 97000
97000 FORMAT(/////////' DO YOU WANT ANOTHER HOROSCOPE ? ',
1'(TYPE YES OR NO) -----'/)
ACCEPT 98000,OPTION
98000 FORMAT(A3)
IF(OPTION.EQ.'NO ')GO TO 9998
TYPE 99000
99000 FORMAT(' ENTER ANOTHER SET OF BIRTH DATA ........'/)
GO TO 140
9998 IF(LINEP)9997,9997,9996
9996 TYPE 96000
96000 FORMAT(' AFTER EXIT TYPE "Q CHART.DATA/DISPOSE:RENAME"'/
1' TO LINEPRINT HOROSCOPES WITH OPTION "LINEPRINT" ')
9997 END