Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0083/astro.lst
There is 1 other file named astro.lst in the archive. Click here to see a list.
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:28 PAGE 1
1 LOGICAL HLP
2 DOUBLE PRECISION T,AN1(9),XJD,CONV,GMT,XL,YL,XP,YP,XN,
3 1DAY,PI2,RULER(12),WEEK(7),WEEKR(7),PLANET(16),ASPTYP(9),
4 2YBES,DIGTYP(2,6),ZOD(12),HOUSE(2,9),DISP(15),TT
5 INTEGER ASPECT(181),ASPDEG(9),EXDEG(10),DIG(10,12)
6 1,TAKEN(15)
7 DIMENSION EC0(9),EC1(9),AN0(9),P0(9),P1(9),EC(9),
8 1TL(9),TB(9),TH0(9),TH1(9),XI(9),R(9),A(9),G(9),GE(9),
9 2X(9),Y(9),Z(9),XX(9),YY(9),ZZ(9),IH(4,3),H(4),
10 3ZOD1(12),P(120,14),ID(120,14),IM(120,14),IS(120,14),
11 4GLYPH(120,14),IASP(14,14),WHEEL(70,42),ROMAN(48)
12 5,PLAN2(2,14),IWX1(12),IWX2(12),IWY1(12),IWY2(12)
13 6,PLACE(24),ELEM(5,3,12),QUAD(5),HOUSE5(7),RETRO(8)
14 7,NDISP(15),LEVEL(15),NRULER(12),DBLANK(15),COMENT(5)
15 8,MONTH(12),MOND(12),XNODE(2,10),YNODE(2,10)
16 C P(I,J) VALUES CODED BY I AS FOLLOWS : 1=LATITUDE
17 C 2=DECLINATION 3=HEL. LATITUDE 4=HEL. DECLINATION
18 C 5=^OPEN^ 6=HEL. LONGITUDE 7-16=HOUSES
19 C (CAMPANUS,MORINUS,PLACIDUS,REGIOMONTANUS,PORPHYRY,EQUAL,
20 C ZARIEL,ALCIBITUS,^RESERVED FOR KOCH^,^OPEN^)
21 C 17=PLANETARY PARTS 18,19=N,S PLANETARY NODES
22 C 20=LONGITUDE 21-120=PROGRESSED LONGITUDE (TO 100 DAYS)
23 C
24 TAN(DUMMY)=SIN(DUMMY)/COS(DUMMY)
25 ARG(P,Q)=P-Q*INT(P/Q)-Q*INT(SIGN(.5,P-Q*INT(P/Q))-.5)
26 HLP=.FALSE.
27 C
28 DATA ASPDEG/0,30,45,60,72,90,120,150,180/
29 DATA ASPECT/1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
30 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,
31 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,
32 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,
33 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,
34 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,
35 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,
36 70,0,0,0,0,9,9,9,9,9,9/
37 DATA ASPTYP/'CONJUNCT','SEMISEX.','SEMISQ. ','SEXTILE ',
38 1'QUINTILE','SQUARE ','TRINE ','INCONJ. ','OPPOSED '/
39 DATA DIG/1,0,4,3,0,2,6,0,5,0,0,6,3,4,5,0,0,0,4,1,
40 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,
41 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,
42 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 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/
44 DATA DIGTYP/'EXALTE','D ','FALLEN',' ',
45 1'NATURA','L ','DETRIM','ENTAL ','HARMON','IOUS ',
46 2'INHARM','ONIOUS'/
47 DATA EXDEG/19,15,27,28,15,21,07,18,17,03/
48 DATA HOUSE/'...CAMP','ANUS...','...MORI','NUS....',
49 1'...PLAC','IDUS...','REGIOMO','NTANUS ','...PORP',
50 2'HYRY...','....EQU','AL.....','....ZAR','IEL....',
51 3'..ALCIB','ITUS...','.....KO','CH.....'/
52 DATA HOUSE5/'MORIN','PLACI','REGIO','PORPH','EQUAL',
53 1'ZARIE','ALCIB'/
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:28 PAGE 2
54 DATA MOND/31,0,31,30,31,30,31,31,30,31,30,31/
55 DATA MONTH/'JA','FE','MR','AP','MY','JN','JL','AU',
56 1'SE','OC','NO','DE'/
57 DATA NRULER/4,3,2,10,1,2,3,9,5,6,7,8/
58 DATA PLANET/'SUN ','MERCURY ','VENUS ','MARS ',
59 1'JUPITER ','SATURN ','URANUS ','NEPTUNE ','PLUTO ',
60 2'MOON ','MOONNODE','PARS F. ','ASCEND. ','M.C. ',
61 3' ','NONE '/
62 DATA PLAN2/'S','U','M','E','V','E','M','A','J','U',
63 1'S','A','U','R','N','E','P','L','M','O','M','N','P','F',
64 2'A','S','M','C'/
65 DATA QUAD/'FIRE ','EARTH','AIR ','WATER',' '/
66 DATA ROMAN/' ',' ','I',' ',' ','I','I',' ',' ','I','I',
67 1'I',' ','I','V',' ',' ',' ','V',' ',' ','V','I',' ',
68 2' ','V','I','I','V','I','I','I',' ','I','X',' ',
69 3' ',' ','X',' ',' ','X','I',' ',' ','X','I','I'/
70 DATA WEEK/'MONDAY ','TUESDAY ','WEDNESDAY',
71 1'THURSDAY ','FRIDAY ','SATURDAY ','SUNDAY '/
72 DATA WEEKR/'MOON) ','MARS) ','MERCURY)','JUPITER)',
73 1'VENUS) ','SATURN) ','SUN) '/
74 DATA ZOD/'ARIES ','TAURUS ','GEMINI ','CANCER ',
75 1'LEO ','VIRGO ','LIBRA ','SCORPIO ',
76 2'SAGITARIUS','CAPRICORN ','AQUARIUS ','PISCES '/
77 DATA ZOD1/'A','T','G','C','L','V','=','S','/','K','Q','P'/
78 C
79 C PLUTO ELEMENTS FROM SHARAF (1964)
80 DATA A/1.00000023,.387098599,.723331619,1.523688395,
81 15.202802875,9.53884320,19.19097811,30.0706724,39.672599/
82 DATA AN0/358.475833,102.279381,212.603222,319.529425,
83 1225.444651,175.758444,74.313628,41.269550,231.002308/
84 DATA AN1/35999.049750D0,149472.515289D0,58517.803875D0,
85 119139.858500D0,3034.906654D0,1222.116782D0,428.502578D0,
86 2218.466783D0,144.072477D0/
87 DATA EC0/.01675104,.20561421,.00682069,.09331290,
88 1.04825382,.05606075,.04704433,.00853341,.24706226/
89 DATA EC1/-.00004180,.00002046,-.00004774,.00009206,
90 1.0,.0,.0,.0,.0/
91 DATA P0/101.220833,75.899697,130.163833,334.218203,
92 111.907422,90.110981,169.048778,43.755611,221.592475/
93 DATA P1/1.719175,1.555489,1.408036,1.840758,
94 1.0,.0,.0,.0,1.388888/
95 DATA TH0/0.,47.145944,75.779647,48.786442,
96 198.932822,112.347606,73.490250,130.678889,108.937165/
97 DATA TH1/0.,1.185208,.899850,.770992,
98 1.0,.0,.509667,1.100972,1.358056/
99 DATA XI/0.,7.002881,3.393630,1.850333,
100 11.311614,2.494239,.7726658,1.779256,17.109816/
101 C
102 LINEP=0
103 PI=3.141592653
104 PI2=6.283185307179586476D0
105 CONV=PI2/360.D0
106 CONVS=CONV
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:28 PAGE 3
107 DO 100 I=1,70
108 DO 100 J=1,42
109 100 WHEEL(I,J)=' '
110 DO 110 I=1,220
111 J=34.5*COS(I*.0285)+35.5
112 K=20.5*SIN(I*.0285)+21.5
113 110 WHEEL(J,K)='.'
114 C FOLLOWING PUTS HOUSE ROMAN NUMERALS INTO WHEEL
115 DO 120 I=4,48,4
116 J=12.*COS((I+22)*.1308997)+34.
117 K=-7.*SIN((I+22)*.1308997)+21.5
118 WHEEL(J,K)=ROMAN(I-3)
119 WHEEL(J+1,K)=ROMAN(I-2)
120 WHEEL(J+2,K)=ROMAN(I-1)
121 120 WHEEL(J+3,K)=ROMAN(I)
122 DO 130 I=1,120
123 DO 130 J=1,14
124 130 P(I,J)=0.
125 C
126 TYPE 10000
127 10000 FORMAT(' SAMPLE INPUT (GREGORIAN DATE,TIME,',
128 1'CONVERSION TO GMT,LATITUDE,LONGITUDE)'//
129 2' 1899/12/31 23:59 +08:00 34N59 122W59 COMMENTS,NAMES'//
130 3' TYPE "TYPE ASTRO.HLP" FOR DETAILED EXPLANATIONS'/////
131 4' A=ARIES C=CANCER ==LIBRA K=CAPRICORN N=NORTH'/
132 5' T=TAURUS L=LEO S=SCORPIO Q=AQUARIUS S=SOUTH'/
133 6' G=GEMINI V=VIRGO /=SAGITTARIUS P=PISCES'//////////
134 7' ENTER BIRTH DATA -------'//)
135 C HOROSCOPE LOOP STARTS HERE
136 140 IOUT=5
137 C THIS PARAMETER CONTROLS THE OUTPUT (5=TTY)
138 ACCEPT 11000,NY,CALEND,NM,ND,NH,NMI,NCH,NCM,LATD,LATS,
139 1LATM,LONGD,LONGS,LONGM,OPTION,COMENT
140 11000 FORMAT(I4,A1,4(I2,1X),I3,2(1X,I2),A1,I2,1X,I3,A1,I2,1X,
141 1A5,5X,5A5)
142 IF(OPTION.NE.'LINEP')GO TO 144
143 IF (HLP.EQ. .TRUE.)GOTO 7297
144 CALL OFILE(20,'CHART')
145 HLP=.TRUE.
146 7297 IOUT=20
147 LINEP=1
148 OPTION=COMENT(1)
149 WRITE(IOUT,11500)NY,CALEND,NM,ND,NH,NMI,NCH,NCM,LATD,
150 1LATS,LATM,LONGD,LONGS,LONGM,COMENT
151 11500 FORMAT('1'//' ---DATE--- -TIME -ZONE- -LAT- -LONG- ',
152 1'COMMENTS--------'/I5,A1,I2,'/',I2,I3,':',I2,I4,':',I2,
153 2I3,A1,I2,I4,A1,I2,1X,5A5)
154 144 GMT=((NH+NCH-12)*60+NMI+SIGN(NCM*1.,NCH*1.))/1440.
155 XJD=(ND-32075+1461*(NY+4800+(NM-14)/12)/4+367*(NM-2-
156 1(NM-14)/12*12)/12-3*((NY+4900+(NM-14)/12)/100)/4)+GMT
157 IF(CALEND.NE.'B')GO TO 150
158 NY=1-NY
159 150 IF(CALEND.NE.'J'.AND.CALEND.NE.'B')GO TO 160
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:28 PAGE 4
160 XJD=(ND-32075+1461*(NY+4800+(NM-14)/12)/4
161 1+367*(NM-2-(NM-14)/12*12)/12-38)+GMT
162 160 T=(XJD-2415020.D0)/36525.D0
163 C
164 JFINAL=2
165 IF(OPTION.NE.'PROGR'.AND.OPTION.NE.'EPHEM')GO TO 170
166 JFINAL=101
167 C PLANETARY EPHEMERIDES COMPUTED BELOW (NEWCOMB/HILL,1898)
168 C ALL VALUES WITHIN 1.5' EXCEPT PLUTO --- URANUS/NEPTUNE
169 C SUFFER FOR VERY ANCIENT DATES (ERROR UP TO 3-4 DEGREES)
170 C COMMENTS AFTER PERTURBATIONS (BELOW) GIVE MAXIMUM
171 C EFFECTS OF TERMS ON GEOCENTRIC LONGITUDE
172 170 DO 270 J=1,JFINAL
173 TT=T+(J-1)/36525.D0
174 TP=TT+18262.D0/36525.D0
175 W=TT
176 DO 174 I=1,9
177 EC(I)=EC0(I)+EC1(I)*W
178 N=AN1(I)*TT/360.D0
179 174 G(I)=(AN1(I)*TT-N*360.D0+DBLE(AN0(I)))*CONV
180 G5=G(5)
181 G6=G(6)
182 G7=(220.169542+428.49311*TP)*CONVS
183 G(5)=G(5)+(.6506*SIN(2*G6-2*G5+336.9*CONVS)
184 1+(3.9987-.002213*36525./4332.58*TP)
185 2*SIN(5*G6-2*G5+(67.15-8197.0/3600.*TP)*CONVS)
186 3+.5380*SIN(5*G6-3*G5+176.5*CONVS)
187 4+.4112*SIN(2*G6-G5+1.4*CONVS)
188 4+.0399278*36525./4332.58*TP*SIN(-G5+227.46*CONVS)
189 5+.2763*SIN(3*G6-2*G5+127.4*CONVS)
190 6+.2669*SIN(G6-G5+79.2*CONVS) )*299.12837/3600.*CONVS
191 C 250",1500"-7"T,202",154",126"T(PROBLEM?),104",100",
192 C (21",20",19",18",14",14",11",9",6"T)
193 G(6)=G(6)+(24.153*SIN(5*G6-2*G5+(247.11-2.277*TP)*CONVS)
194 1+5.679*SIN(4*G6-2*G5+277.39*CONVS)
195 2+3.505*SIN(2*G6-G5+181.43*CONVS)
196 3+.657765*36525./10759.20*TP*SIN(G6+238.0*CONVS)
197 4+.278*SIN(3*G6-G5+121.2*CONVS)
198 5+.266*SIN(2*G6-2*G5+157.0*CONVS)
199 6+.238*SIN(6*G6-2*G5-3*G7+6.9*CONVS)
200 7+.223*SIN(10*G6-4*G5+(133.6-14814.5/3600.*W)*CONVS)
201 8+.234*SIN(3*G7-G6+321.7*CONVS) )*120.455/3600.*CONVS
202 C 3270",770",473",300"T(PROBLEM?),37",36",32",30",32",
203 C (29",26",19"T,16"T,14",13",10",9",9",8",7")
204 G(7)=G(7)+33.086*W*W/3600.*CONVS
205 G(8)=G(8)-22.401/3600.*W*W*CONVS
206 DO 177 I=1,9
207 GE(I)=G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(
208 1G(I)+EC(I)*SIN(G(I)+EC(I)*SIN(G(I))))))
209 177 X(I)=2.*ATAN(SQRT((1.+EC(I))/(1.-EC(I)))*TAN(.5*GE(I)))
210 1+(P0(I)+P1(I)*W)*CONVS + (I/7-I/9)*W*5025.3/3600.*CONVS
211 GT=(358.415+35998.928*W)*CONVS
212 GJ=(225.209+3034.462*W+.332*SIN((134.4+38.5*W)*CONVS))
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:29 PAGE 5
213 1*CONVS
214 X(4)=X(4)+(25.384*COS(GJ-G(4)-48.9*CONVS)
215 1+52.490*SIN((47.48+19.771*W)*CONVS)-37.05-13.50*W
216 2+21.869*COS(2*GJ-G(4)-188.3*CONVS)
217 3+16.035*COS(2*GJ-2*G(4)-191.9*CONVS)
218 4+13.966*COS(-GT+2*G(4)-20.5*CONVS)
219 5+8.559*COS(-GT+G(4)-35.1*CONVS) )/3600.*CONVS
220 C 92",191",80",58",51",31",(27",23",18",14",12")
221 GN=(225.417+3034.904*W)*CONVS
222 GG=(175.753+1222.113*W)*CONVS
223 G1=(74.412+428.498*W)*CONVS
224 GP=(74.320+428.498*W)*CONVS
225 GPP=(41.339+218.467*W)*CONVS
226 X(7)=X(7)+(142.938*SIN(GG-2*G1)+19.508*COS(GG-2*G1)
227 1+75.70*COS(3*G1-GG)-102.30*SIN(3*G1-GG)
228 2-48.623*SIN(GN-G1)-21.320*COS(GN-G1)
229 3-27.871*COS(GP-GPP)+19.869*SIN(GP-GPP)
230 4+28.793*COS(2*GP-2*GPP)+10.035*SIN(2*GP-2*GPP)
231 5+(18.37*SIN(3*GP-3*GPP)+8.91*COS(3*GP-3*GPP))*COS(G(7))
232 6+(8.35*SIN(3*GP-3*GPP)-16.44*COS(3*GP-3*GPP))*SIN(G(7))
233 7-18.585*COS(GG-G1)+12.603*SIN(GG-G1)
234 8+4.327*COS(3*GP-3*GPP)+14.280*SIN(3*GP-3*GPP)
235 9 )/3600.*CONVS
236 C 154",135",56",36",32",29"(2),24",15",(9",7",6")
237 X(7)=X(7)+((112.317*W-1.551*W*W-.516*W*W*W)*SIN(G(7))
238 1-(68.339*W+9.721*W*W)*COS(G(7))+6.605*W*SIN(2*G(7))
239 2-(29.44-.410*W)*SIN((20.45-22.61*W)*CONVS) )/3600.*CONVS
240 C JUP/SAT TERM & QUADRATURES OF LONG PERIOD URA/NEP TERMS
241 X(8)=X(8)+( 33.972*W*COS(G(8))
242 1+18.553*SIN((180.966+1004.034*W+.1403*W*W)*CONVS)
243 2+34.138*SIN((153.267+2816.296*W-.0573*W*W)*CONVS)
244 3+(26.50*W+3.92*W*W)*SIN(G(8)) )/3600.*CONVS
245 C 36"T,19",35",25"T+4"T*T,(15",9",6")
246 C FIRST/LAST TERMS (QUADRATURES) IMPROVE 1600-2000 VALUES
247 C BUT FOR VERY ANCIENT DATES ARE INVALID
248 DO 185 I=1,9
249 TH=(TH0(I)+TH1(I)*W)*CONVS
250 DO 180 K=1,2
251 C MOTION OF JUP/SAT NODES FROM LEVERRIER
252 TH2=TH+(I/5*3636.6-I/6*493.1-I/7*3143.5)/3600.*TP*CONVS
253 R(I)=A(I)*(1.-EC(I)*COS(2.*ATAN(TAN((TH2+(K-1)*PI-(P0(I)
254 1+P1(I)*W)*CONVS)*.5)*SQRT((1.-EC(I))/(1.+EC(I))))))
255 XNODE(K,I)=R(I)*COS(TH2+(K-1)*PI)
256 180 YNODE(K,I)=R(I)*SIN(TH2+(K-1)*PI)
257 TL(I)=TH+ATAN2(SIN(X(I)-TH)*COS(XI(I)*CONVS),
258 1COS(X(I)-TH))+(I/5-I/7)*TP*5026.1/3600.*CONVS
259 TB(I)=ASIN(SIN(XI(I)*CONVS)*SIN(X(I)-TH))
260 185 R(I)=A(I)*(1.-EC(I)*COS(GE(I)))
261 TB(5)=TB(5)+4.37431*36525./4332.58*SIN(X(5)+23.62*CONVS)
262 1*TP/3600.*CONVS
263 TB(6)=TB(6)+24.266*36525./10759.2*SIN(X(6)-13.05*CONVS)
264 1*TP/3600.*CONVS
265 C TB(5) EFFECTS LESS THAN 35"T, TB(6) LESS THAN 84"T
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:29 PAGE 6
266 R(5)=R(5)*10.**(.0002303*COS(2*G6-2*G5+336.9*CONVS)
267 1+.0001679*COS(5*G6-3*G5+176.4*CONVS)
268 2+.0000125634*36525./4332.58*TP*COS(-G5+227.4*CONVS) )
269 C 22",16",10"T,(7",5",3")
270 R(6)=R(6)*10.**(.0007005*COS(4*G6-2*G5+277.3*CONVS)
271 1+.0003783*COS(G6-G5+79.8*CONVS)
272 2+.000083491*36525./10759.20*TP*COS(G6+58.0*CONVS)
273 3+.0002443*COS(2*G6-G5+176.0*CONVS) )
274 C 37",20",15"T,13",(10",6",3")
275 C R(7) TERMS EFFECT LESS THAN 5",3"T,2"T,.3"T*T
276 C R(8) TERMS ONLY EFFECT .02' MAXIMUM
277 DO 190 I=1,9
278 X(I)=R(I)*COS(TB(I))*COS(TL(I))
279 Y(I)=R(I)*COS(TB(I))*SIN(TL(I))
280 190 Z(I)=R(I)*SIN(TB(I))
281 DO 210 I=2,9
282 DO 200 K=1,2
283 XNODE(K,I)=XNODE(K,I)-X(1)
284 YNODE(K,I)=YNODE(K,I)-Y(1)
285 200 P(K+17,I)=ARG(ATAN2(YNODE(K,I),XNODE(K,I))/6.2831853,1.)
286 XX(I)=X(I)-X(1)
287 YY(I)=Y(I)-Y(1)
288 210 ZZ(I)=Z(I)-Z(1)
289 XX(1)=-X(1)
290 YY(1)=-Y(1)
291 ZZ(1)=-Z(1)
292 XNUT=-17.2327/1296000.*SIN((259.18-1934.142*W)*CONVS)
293 DO 230 I=1,9
294 P(J+19,I)=ARG(ATAN2(YY(I),XX(I))/6.28318531+XNUT,1.)
295 IF(J-1)230,220,230
296 220 DIST=SQRT(XX(I)*XX(I)+YY(I)*YY(I)+ZZ(I)*ZZ(I))
297 P(1,I)=ASIN(ZZ(I)/DIST)/CONVS
298 E=(23.4522944-.0130125*W+.002558*COS((259.18-1934.142
299 1*W)*CONVS))*CONVS
300 P(2,I)=ASIN(COS(P(1,I)*CONVS)*SIN(P(20,I)*6.28318531)
301 1*SIN(E)+SIN(P(1,I)*CONVS)*COS(E))/CONVS
302 P(6,I)=ARG(TL(I)/6.28318531,1.)
303 P(3,I)=TB(I)/CONVS
304 P(4,I)=ASIN(COS(TB(I))*SIN(TL(I))*SIN(E)
305 1+SIN(TB(I))*COS(E))/CONVS
306 230 CONTINUE
307 C
308 C LUNAR EPHEMERIDES COMPUTED TO WITHIN 1' (BROWN/I.L.E.)
309 DAY=XJD-2415020.D0+(J-1.D0)
310 XL=.751206D0+DAY*.0366011014634D0
311 YL=.776935D0+DAY*.0027379092649D0
312 XP=.928693D0+DAY*.0003094557786D0
313 YP=.781169D0+DAY*.0000001307457D0
314 XN=.719954D0-DAY*.0001470942283D0
315 AL=(XL-IDINT(XL))*PI2
316 BL=(YL-IDINT(YL))*PI2
317 AP=(XP-IDINT(XP))*PI2
318 BP=(YP-IDINT(YP))*PI2
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:29 PAGE 7
319 AN=(XN-IDINT(XN))*PI2
320 U=AL-AP
321 V=BL-BP
322 F=AL-AN
323 D=AL-BL
324 DL=22639*SIN(U)-4586*SIN(U-D-D)+2370*SIN(D+D)+769*SIN(U+U)
325 1-668*SIN(V)-412*SIN(F+F)-212*SIN(U+U-D-D)-206*SIN(U+V-D-D)
326 2+192*SIN(U+D+D)-165*SIN(V-D-D)+148*SIN(U-V)-125*SIN(D)
327 3-110*SIN(U+V)-55*SIN(F+F-D-D)-45*SIN(U+F+F)+40*SIN(U-F-F)
328 4-38*SIN(U-4*D)+36*SIN(3*U)-31*SIN(U+U-4*D)+28*SIN(U-V-D-D)
329 5-24*SIN(V+D+D)+19*SIN(U-D)+18*SIN(V+D)+15*SIN(U-V+D+D)
330 6+14*SIN(4*D)+14*SIN(U+U+D+D)-13*SIN(3*U-D-D)
331 P(J+19,10)=ARG(XL-IDINT(XL)+DL/1296000.+XNUT,1.)
332 P(J+19,11)=ARG(AN/6.28318531,1.)
333 IF(J-1)270,260,270
334 260 P(1,10)=(18461*SIN(F)+1010*SIN(U+F)-1000*SIN(F-U)
335 1-624*SIN(F-2*D)-167*SIN(U+F-D-D)+199*SIN(F-U+D+D)
336 2+117*SIN(F+D+D)+62*SIN(U+U+F)-33*SIN(F-U-D-D)
337 3-32*SIN(F-U-U)-30*SIN(V+F-D-D)-16*SIN(U+U+F-D-D)
338 4+15*SIN(U+F+D+D)+12*SIN(F-V-D-D)+9*SIN(F-U-V+D+D))/3600.
339 P(2,10)=ASIN(COS(P(1,10)*CONVS)*SIN(P(20,10)*6.28318531)
340 1*SIN(E)+SIN(P(1,10)*CONVS)*COS(E))/CONVS
341 270 CONTINUE
342 C
343 E=(23.4522944-.0130125*T+.002558*DCOS((259.18-1934.142
344 1*T)*CONV))*CONVS
345 DO 277 I=2,9
346 RETRO(I-1)=' DIR '
347 IF(ARG(P(21,I)-P(20,I),1.)-.5)277,277,275
348 275 RETRO(I-1)='RETRO'
349 277 CONTINUE
350 C
351 XLW=(LONGD+LONGM/60.)/360.
352 XLN=(LATD+LATM/60.)*CONVS
353 IF(LATS.EQ.'N')GO TO 280
354 XLN=-XLN
355 280 IF(LONGS.EQ.'W')GO TO 290
356 XLW=-XLW
357 C H(1)=GMT H(2)=GST H(3)=LMT H(4)=LST
358 290 H(1)=ARG(SNGL(GMT)+.5,1.)
359 W=100.00213590D0*T-IDINT(100.D0*T)
360 H(2)=ARG(H(1)+.27691940+W,1.)
361 H(3)=ARG(H(1)-XLW,1.)
362 H(4)=ARG(H(2)-XLW,1.)
363 DO 300 I=1,4
364 W=24.*H(I)+.00013888888
365 IH(I,1)=W
366 W=60.*(W-IH(I,1))
367 IH(I,2)=W
368 300 IH(I,3)=60.*(W-IH(I,2))
369 IF(OPTION.EQ.'PROGR'.OR.OPTION.EQ.'EPHEM')GO TO 310
370 WRITE(IOUT,12000),((IH(I,J),J=1,3),I=1,4)
371 12000 FORMAT(/' GMT=',I2,2(':',I2),' GST=',I2,2(':',I2),
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:30 PAGE 8
372 1' LMT=',I2,2(':',I2),' LST=',I2,2(':',I2))
373 JD1=XJD
374 XJD1=XJD-JD1
375 I=JD1+INT(XJD1+1.5-XLW)-(JD1-1+INT(XJD1+1.5-XLW))/7*7
376 YBES=1900.D0+(XJD-2415020.31351528D0)/365.24219878125D0
377 1-.00000107523D0*T*T
378 IYBES=YBES
379 YBES1=YBES-IYBES
380 WRITE(IOUT,13000)WEEK(I),WEEKR(I),JD1,XJD1,IYBES,YBES1
381 13000 FORMAT(' DAY OF THE WEEK (FROM LMT) IS ',A9,
382 1' (RULED BY ',A8/' JD=',I7,F7.6,7X,' BESSELIAN YEAR = ',
383 2I5,F10.9)
384 C
385 C HOUSE CUSP COMPUTATIONS (ACCURATE TO LAST DIGIT)
386 310 ITER=1+LATD/45
387 C "ITER" IS THE NUMBER OF PLACIDEAN ITERATIONS
388 RA=6.28318531*H(4)
389 DO 340 N=1,6
390 AA=6.28318531*(N+2)/12.
391 P(7,N)=ARG(ATAN2(SIN(RA)*COS(AA)+COS(RA)*COS(XLN)*
392 1SIN(AA),COS(E)*(COS(RA)*COS(AA)-SIN(RA)*COS(XLN)*
393 2SIN(AA))-SIN(E)*SIN(XLN)*SIN(AA))/6.28318531,1.)
394 P(8,N)=ARG(ATAN2(SIN(RA+AA)*COS(E),COS(RA+AA))
395 1/6.28318531,1.)
396 P(9,N)=ARG(ATAN2(SIN(RA+AA),COS(E)*COS(RA+AA)-SIN((3.-
397 1ABS(1.-N))/3.*ASIN(TAN(E)*TAN(XLN)))*COS(E))/PI*.5,1.)
398 DO 330 J=1,ITER
399 X(1)=P(9,N)*6.28318531
400 X(2)=X(1)+CONVS*.5
401 C INCREMENT "CONVS*.5" IS ARBITRARILY CHOSEN (=.5 DEG)
402 DO 320 K=1,2
403 AD=ASIN(TAN(XLN)*TAN(ASIN(SIN(X(K))*SIN(E))))
404 DRA=ARG(ATAN2(SIN(X(K))*COS(E),COS(X(K)))-RA-(N-1)*PI/6.
405 1,PI)-PI*.5
406 320 Y(K)=DRA-(4.-N)*AD/3.
407 330 P(9,N)=P(9,N)-Y(1)/(Y(2)-Y(1))*.5/360.
408 C THE ".5" CONSTANT HERE MUST AGREE WITH THE ONE ABOVE
409 P(10,N)=ARG(ATAN2(SIN(RA+AA),COS(E)*COS(RA+AA)-SIN(E)
410 1*TAN(XLN)*SIN(AA))/6.28318531,1.)
411 340 P(12,N)=ARG(P(7,1)+(N-1)/12.,1.)
412 DO 350 N=1,6
413 P(11,N)=ARG(P(7,1)+(N-1)/12.+(ARG(P(7,4)-P(7,1),1.)
414 1-.25)*(3.-ABS(3.-ABS(N-7.)))/3.,1.)
415 350 P(13,N)=ARG(P(7,4)+(N-4)/12.,1.)
416 W=ARG(ATAN2(SQRT((COS(XLN)/SIN(E))**2-SIN(P(7,4)*
417 16.28318531)**2),SIN(XLN)*SIN(P(7,4)*6.28318531)),PI)/3.
418 DO 351 N=1,3
419 351 P(14,N)=ARG(ATAN2(COS(RA+(N-1)*W),-SIN(RA+(N-1)*W)
420 1*COS(E)-SIN(E)*TAN(XLN))/6.28318531,1.)
421 W=ARG(ATAN2(SIN(P(7,1)*6.28318531)*COS(E),COS(P(7,1)*
422 16.28318531))-RA,PI)/3.
423 DO 352 N=4,6
424 352 P(14,N)=ARG(ATAN2(SIN(RA+(N-4)*W),COS(RA+(N-4)*W)*COS(E)
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:30 PAGE 9
425 1)/6.28318531+.5,1.)
426 DO 355 J=7,14
427 DO 355 N=1,6
428 355 P(J,N+6)=ARG(P(J,N)+.5,1.)
429 C
430 C PARS FORTUNA & PLANETARY NODES FOLLOW
431 P(20,12)=ARG(P(20,10)-P(20,1)+P(11,1),1.)
432 DO 360 I=2,9
433 360 P(17,I)=ARG(P(20,I)-P(20,1)+P(11,1),1.)
434 C
435 C ARGUMENTS TRANSFORMED TO SIGNS/DEGREES/MINUTES
436 DO 390 I=1,4
437 DO 390 J=1,12
438 GLYPH(I,J)='N'
439 IF(P(I,J))370,380,380
440 370 GLYPH(I,J)='S'
441 380 DEG=ABS(P(I,J))+.0083333333
442 ID(I,J)=DEG
443 390 IM(I,J)=60.*(DEG-ID(I,J))
444 IFINAL=JFINAL+19
445 DO 400 I=6,IFINAL
446 DO 400 J=1,12
447 W=12.*P(I,J)+.00027777777
448 IS(I,J)=W
449 ISS=W+1.
450 GLYPH(I,J)=ZOD1(ISS)
451 W=30.*(W-IS(I,J))
452 ID(I,J)=W
453 400 IM(I,J)=60.*(W-ID(I,J))
454 C
455 C PROGRESSION & EPHEMERIS OUTPUT ROUTINE FOLLOWS
456 IF(OPTION.NE.'PROGR')GO TO 420
457 WRITE(IOUT,14000)
458 14000 FORMAT(/19X,'PROGRESSED (GEOCENTRIC) LONGITUDES'//
459 1' YEAR SUN MERC VENUS MARS JUPIT SATUR ',
460 2' URAN NEPT PLUTO MOON NODE')
461 DO 410 I=20,120
462 II=I-20
463 410 WRITE(IOUT,15000)II,(ID(I,J),GLYPH(I,J),IM(I,J),J=1,11)
464 15000 FORMAT(' ',I3,1X,11(1X,I2,A1,I2))
465 GO TO 9999
466 420 IF(OPTION.NE.'EPHEM')GO TO 470
467 WRITE(IOUT,16000)IH(1,1),IH(1,2),NY
468 16000 FORMAT(//19X,'DAILY EPHEMERIS FOR ',I2,':',I2,' GMT'//
469 1' DATE SUN MERC VENUS MARS JUPIT SATUR URAN',
470 2' NEPT PLUTO MOON NODE'/I6)
471 MY=NY+(NM+7)/10
472 MOND(2)=1461*(MY+4800)/4-1461*(MY+4799)/4-337
473 IF(CALEND.EQ.'J')GO TO 430
474 MOND(2)=MOND(2)-(MY+4900)/100*3/4+(MY+4899)/100*3/4
475 430 DO 460 I=20,120
476 WRITE(IOUT,17000)MONTH(NM),ND,(ID(I,J),GLYPH(I,J),
477 1IM(I,J),J=1,11)
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:30 PAGE 10
478 17000 FORMAT(' ',A2,I2,11(1X,I2,A1,I2))
479 ND=ND+1
480 IF(ND-MOND(NM))460,460,440
481 440 ND=ND-MOND(NM)
482 NM=NM+1
483 IF(NM-12)460,460,450
484 450 NM=1
485 NY=NY+1
486 WRITE(IOUT,18000)NY
487 18000 FORMAT(I6)
488 460 CONTINUE
489 GO TO 9999
490 C
491 470 WRITE(IOUT,19000),(ID(20,I),GLYPH(20,I),IM(20,I),I=1,12)
492 1,RETRO,((ID(I,J),GLYPH(I,J),IM(I,J),J=1,10),I=1,2)
493 19000 FORMAT(//8X,'GEOCENTRIC PLANET POSITIONS (LONGITUDE,',
494 1'LATITUDE,DECLINATION)'/' SUN MERC VENUS MARS',
495 2' JUPIT SATUR URAN NEPT PLUTO MOON NODE P.F.'/
496 31X,12(I3,A1,I2)/7X,8(1X,A5)/1X,10(I3,A1,I2)/
497 41X,10(I3,A1,I2)//)
498 WRITE(IOUT,19500),((ID(I,J),GLYPH(I,J),IM(I,J),J=1,12),
499 1I=7,14),(ID(7,J),GLYPH(7,J),IM(7,J),J=1,10,3)
500 19500 FORMAT(24X,'HOUSE CUSPS IN SYSTEMS OF'/
501 1' CAMPANUS,MORINUS,PLACIDUS,REGIOMONTANUS,PORPHYRY,',
502 2'EQUAL,ZARIEL,ALCIBITIUS'/' 1 2 3 ',
503 2' 4 5 6 7 8 9 10 11 12'/
504 31X,12(I3,A1,I2)/1X,12(I3,A1,I2)/1X,12(I3,A1,I2)/
505 41X,12(I3,A1,I2)/1X,12(I3,A1,I2)/1X,12(I3,A1,I2)/
506 51X,12(I3,A1,I2)/1X,12(I3,A1,I2)/
507 6' RISING',14X,'I.C.',13X,'DESC.',14X,'M.C.'/
508 71X,4(I3,A1,I2,12X)///////)
509 C
510 C RULING,SIGNIFICATING,RISING PLANETS
511 I=IS(20,1)+1
512 J=IS(7,1)+1
513 I=NRULER(I)
514 J=NRULER(J)
515 DISP(1)=PLANET(16)
516 K=0
517 DO 490 L=1,12
518 IF(ABS(ARG(P(7,1)-P(20,L)+1.5,1.)-.5)-.03333)480,480,490
519 480 K=K+1
520 DISP(K)=PLANET(L)
521 490 CONTINUE
522 K=K+(K+.101)/(K+.050)-1
523 WRITE(IOUT,20000)PLANET(I),PLANET(J),(DISP(L),L=1,K)
524 20000 FORMAT(' RULING PLANET IS ',A8/
525 1' SIGNIFICATOR (PLANET RULING THE RISING SIGN) IS ',A8/
526 2' RISING PLANETS :',6(1X,A8)/17X,6(1X,A8))
527 C
528 C QUADRUPLICITIES/TRIPLICITIES TABULATED
529 IS(20,13)=IS(7,1)
530 IS(20,14)=IS(7,10)
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:31 PAGE 11
531 P(20,13)=P(7,1)
532 P(20,14)=P(7,10)
533 WRITE(IOUT,21000)
534 21000 FORMAT(/' DISTRIBUTION OF ELEMENTS IS AS FOLLOWS:'//
535 18X,'.-----CARDINAL------.-------FIXED-------.',
536 2'------MUTABLE------.')
537 DO 500 I=1,5
538 DO 500 J=1,3
539 DO 500 K=1,12
540 500 ELEM(I,J,K)=' '
541 I5=0
542 DO 530 I=1,14
543 K=IS(20,I)-IS(20,I)/4*4+1
544 L=IS(20,I)-IS(20,I)/3*3+1
545 510 DO 520 J=1,11,2
546 IF(ELEM(K,L,J).NE.' ')GO TO 520
547 ELEM(K,L,J)=PLAN2(1,I)
548 ELEM(K,L,J+1)=PLAN2(2,I)
549 GO TO 530
550 520 CONTINUE
551 I5=K
552 K=5
553 GO TO 510
554 530 CONTINUE
555 DO 550 I=1,4
556 WRITE(IOUT,22000)QUAD(I),((ELEM(I,J,K),K=1,12),J=1,3)
557 22000 FORMAT(1X,A5,' .',6(1X,2A1),' .',6(1X,2A1),' .',
558 16(1X,2A1),' .')
559 IF(I5-I)550,540,550
560 540 WRITE(IOUT,22000)QUAD(5),((ELEM(5,J,K),K=1,12),J=1,3)
561 550 CONTINUE
562 WRITE(IOUT,23000)
563 23000 FORMAT(8X,'.-------------------.-------------------',
564 1'.-------------------.')
565 C
566 C ASPECTS
567 DO 560 I=1,14
568 DO 560 J=1,14
569 560 IASP(I,J)=360.*(.5-ABS(.5-ABS(P(20,I)-P(20,J))))+.5
570 WRITE(IOUT,24000),((IASP(I,J),I=1,14),J=1,14)
571 24000 FORMAT(/' ALL PLANETARY ANGLES ARE TABULATED BELOW'//
572 15X,'SUN MER VEN MAR JUP SAT URA NEP PLU MOO NOD PF. AS',
573 2'C MC.'/' SUN',14I4/' MER',14I4/' VEN',14I4/' MAR',14I4/
574 3' JUP',14I4/' SAT',14I4/' URA',14I4/' NEP',14I4/
575 4' PLU',14I4/' MOO',14I4/' NOD',14I4/' PF.',14I4/
576 5' ASC',14I4/' MC.',14I4/)
577 WRITE(IOUT,25000)
578 25000 FORMAT(' IMPORTANT ASPECTS ARE AS FOLLOWS ("EXACT" ',
579 1'ORBS PERTAIN TO THE '/' TRUE ANGLE BETWEEN OBJECTS ',
580 2' #1 AND #2)'//
581 3' OBJECT#1 OBJECT#2 ASPECT (DEG) ORB(EXACT)',
582 4' APPLYING/WANING'/)
583 C
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:31 PAGE 12
584 DO 660 I=1,13
585 II=I+1
586 DO 660 J=II,14
587 DIF=360.*(.5-ABS(.5-ABS(P(20,I)-P(20,J))))
588 N=DIF+1
589 IF(ASPECT(N))570,660,570
590 570 K=ASPECT(N)
591 DIF1=ABS(DIF-ASPDEG(K))
592 DIF=ARG(ACOS(COS(P(1,I)*CONVS)*COS(P(1,J)*CONVS)*COS
593 1((P(20,I)-P(20,J))*6.28318531)+SIN(P(1,I)*CONVS)*
594 2SIN(P(1,J)*CONVS))/CONVS,180.)
595 DIF2=ABS(DIF-ASPDEG(K))
596 APPLY=' '
597 IF(I/12+J/12)610,610,580
598 580 IF(I/12-J/12)590,650,600
599 590 P(21,J)=P(20,J)+ABS(ARG(P(21,I)-P(20,I)+.5,1.)-.5)*1.1
600 GO TO 610
601 600 P(21,I)=P(20,I)+ABS(ARG(P(21,J)-P(20,J)+.5,1.)-.5)*1.1
602 610 APPLY='A'
603 W=(ARG(P(20,I)-P(20,J),1.)-ASPDEG(K)/360.)/
604 1(ARG(P(21,I)-P(21,J),1.)-ASPDEG(K)/360.)
605 IF(ARG(P(20,I)-P(20,J),1.)-.5)630,630,620
606 620 W=(ARG(P(20,J)-P(20,I),1.)-ASPDEG(K)/360.)/
607 1(ARG(P(21,J)-P(21,I),1.)-ASPDEG(K)/360.)
608 630 IF(W-1.)640,650,650
609 640 APPLY='W'
610 650 WRITE(IOUT,26000)PLANET(I),PLANET(J),ASPTYP(K),ASPDEG(K)
611 1,DIF1,DIF2,APPLY
612 26000 FORMAT(1X,2(A8,2X),A8,'(',I3,')',F7.2,'(',F5.2,')',5X,A1)
613 660 CONTINUE
614 C
615 C PARALLEL ASPECTS
616 WRITE(IOUT,27000)
617 27000 FORMAT(/' PARALLEL ASPECTS (IF ANY) ARE AS FOLLOWS:'/)
618 DO 680 I=1,9
619 II=I+1
620 DO 680 J=II,10
621 DIF=60.*ABS(ABS(P(2,I))-ABS(P(2,J)))
622 IF(DIF-60.)670,670,680
623 670 WRITE(IOUT,28000)PLANET(I),PLANET(J),DIF
624 1,ID(2,I),GLYPH(2,I),IM(2,I),ID(2,J),GLYPH(2,J),IM(2,J)
625 28000 FORMAT(6X,A8,' PARALLEL ',A8,' WITHIN ',F4.1,3H' (,
626 1I2,A1,I2,' & ',I2,A1,I2,')')
627 680 CONTINUE
628 C
629 C ESSENTIAL DIGNITIES
630 WRITE(IOUT,29000)
631 29000 FORMAT(/' ESSENTIAL DIGNITIES (IF ANY) FOLLOW :'/)
632 DO 720 I=1,10
633 N=IS(20,I)+1
634 IF(DIG(I,N))690,720,690
635 690 J=DIG(I,N)
636 WRITE(IOUT,30000)PLANET(I),DIGTYP(1,J),DIGTYP(2,J),ZOD(N)
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:31 PAGE 13
637 30000 FORMAT(6X,A8,' IS ',2A6,' IN ',A10)
638 IF(DIG(I,N)-3)700,720,720
639 700 IF(EXDEG(I)-ID(20,I))720,710,720
640 710 WRITE(IOUT,31000)EXDEG(I)
641 31000 FORMAT('+',43X,' (BY EXACT DEGREE , ',I2,')')
642 720 CONTINUE
643 C
644 C MUTUAL RECEPTION CHECK
645 WRITE(IOUT,32000)
646 32000 FORMAT(/' MUTUAL RECEPTIONS (IF ANY) FOLLOW :'/)
647 DO 760 I=1,9
648 M=IS(20,I)+1
649 II=I+1
650 DO 760 J=II,10
651 N=IS(20,J)+1
652 IF(DIG(J,M)*DIG(I,N)-1.)740,730,740
653 730 WRITE(IOUT,33000)PLANET(I),PLANET(J)
654 33000 FORMAT(6X,A8,'AND ',A8,'ARE MUTUALLY RECEPTIVE BY ',
655 1'EXALTED SIGNS')
656 GO TO 760
657 740 IF((DIG(J,M)-2.)*(DIG(I,N)-2.)-1.)760,750,760
658 750 WRITE(IOUT,34000)PLANET(I),PLANET(J)
659 34000 FORMAT(6X,A8,'AND ',A8,'ARE MUTUALLY RECEPTIVE BY ',
660 1'NATURAL SIGNS')
661 760 CONTINUE
662 C
663 C DISPOSITORS
664 WRITE(IOUT,35000)
665 35000 FORMAT(/' DISPOSITORSHIPS FOLLOW ("D" MEANS "IS THE ',
666 1'DISPOSITOR OF")'/)
667 DO 770 I=1,14
668 TAKEN(I)=0
669 ISS=IS(20,I)+1
670 NDISP(I)=NRULER(ISS)
671 770 DISP(I)=PLANET(15)
672 TAKEN(15)=2
673 I=1
674 IPRINT=0
675 780 J=NDISP(I)
676 DO 790 K=1,9
677 790 J=NDISP(J)
678 K=1
679 LEVEL(1)=J
680 TAKEN(J)=1
681 IF(IPRINT)820,820,800
682 800 WRITE(IOUT,36000),(DBLANK(M),DISP(M),M=1,IPRINT)
683 DO 810 M=1,14
684 810 DISP(M)=PLANET(15)
685 IPRINT=0
686 820 DISP(1)=PLANET(J)
687 DBLANK(1)=' '
688 830 K=K+1
689 LEVEL(K)=I
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:31 PAGE 14
690 840 II=LEVEL(K)
691 IF(NDISP(II)-LEVEL(K-1))850,880,850
692 850 LEVEL(K)=LEVEL(K)+1
693 IF(LEVEL(K)-15)840,860,840
694 860 K=K-1
695 IF(K-1)850,870,850
696 870 I=I+1
697 IF(TAKEN(I)-1)780,870,920
698 880 TAKEN(II)=1
699 IF(K-IPRINT)890,890,910
700 890 WRITE(IOUT,36000),(DBLANK(M),DISP(M),M=1,IPRINT)
701 36000 FORMAT(3X,12(A2,A8))
702 DISP(15)=DISP(K)
703 DO 900 M=1,14
704 DISP(M)=PLANET(15)
705 900 DBLANK(M)=' '
706 IPRINT=0
707 IF(DISP(15).NE.PLANET(II))GO TO 910
708 IF(II-J)830,850,830
709 910 DISP(K)=PLANET(II)
710 IPRINT=K
711 DBLANK(K)='D '
712 IF(II-J)830,890,830
713 920 IF(II-J)930,940,930
714 930 WRITE(IOUT,36000),(DBLANK(M),DISP(M),M=1,IPRINT)
715 940 CONTINUE
716 C
717 C HELIOCENTRIC COORDINATES, PLANETARY PARTS & NODES
718 WRITE(IOUT,37000),(ID(6,J),GLYPH(6,J),IM(6,J),J=2,9),
719 1((ID(I,J),GLYPH(I,J),IM(I,J),J=2,9),I=3,4),
720 2((ID(I,J),GLYPH(I,J),IM(I,J),J=2,9),I=17,19)
721 37000 FORMAT(//23X,'MERC VENUS MARS JUPIT SATUR URAN NEPT',
722 1' PLUTO'/' HELIOCENTRIC--------'/
723 2' LONGITUDE',11X,8(1X,I2,A1,I2)
724 3/' LATITUDE',12X,8(1X,I2,A1,I2)/' DECLINATION',9X,
725 48(1X,I2,A1,I2)/' GEOCENTRIC----------'/' PARTS',15X,
726 58(1X,I2,A1,I2)/' NORTH PLANETARY NODE',8(1X,I2,A1,I2)/
727 6' SOUTH PLANETARY NODE',8(1X,I2,A1,I2))
728 C
729 W=(84038.55+5025.640*T+1.1118*T*T)/3600.
730 WRITE(IOUT,38000)W
731 38000 FORMAT(/' TO GET SIDEREAL LONGITUDES SUBTRACT ',F8.4,
732 1' DEG. FROM ALL LONGITUDES')
733 C
734 C HOROSCOPE "WHEEL" OUTPUT ROUTINE
735 NH=7
736 DO 950 I=1,5
737 IF(OPTION.NE.HOUSE5(I))GO TO 950
738 NH=I+11
739 950 CONTINUE
740 WRITE(IOUT,39000)HOUSE(1,NH-6),HOUSE(2,NH-6)
741 39000 FORMAT(//' CHART BELOW USES TROPICAL GEOCENTRIC ',2A7,
742 1' HOUSE SYSTEM',/,'1')
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:32 PAGE 15
743 P(NH,13)=P(NH,1)
744 C FOLLOWING PUTS SPOKES INTO WHEEL
745 DO 960 I=1,6
746 W=34.5*COS((I-1)*.5235988)
747 WW=20.5*SIN((I-1)*.5235988)
748 M=SQRT(W*W+WW*WW)+1.
749 M2=M+M
750 DO 960 II=1,M2
751 J=W-W*II/M+35.6
752 K=WW-WW*II/M+21.5
753 960 WHEEL(J,K)='.'
754 WHEEL(35,21)='+'
755 C
756 C FOLLOWING PUTS PLANETS INTO WHEEL
757 DO 1040 I=1,12
758 J=1
759 970 W=ARG(P(20,I)-P(NH,J),1.)/ARG(P(NH,J+1)-P(NH,J),1.)
760 IF(W-1.)990,980,980
761 980 J=J+1
762 GO TO 970
763 990 PLACE(I)=(J+W+5.)*PI/6.
764 IWX1(I)=32.*COS(PLACE(I))
765 IWY1(I)=18.*SIN(PLACE(I))
766 NDIF1=1.99*COS(PLACE(I))
767 NDIF2=1.99*SIN(PLACE(I))
768 IWX2(I)=IWX1(I)-NDIF1
769 IWY2(I)=IWY1(I)-NDIF2
770 GO TO 1010
771 1000 IWX1(I)=IWX1(I)-4.*COS(PLACE(I))
772 IWY1(I)=IWY1(I)-3.*SIN(PLACE(I))
773 IWX2(I)=IWX1(I)-NDIF1
774 IWY2(I)=IWY1(I)-NDIF2
775 1010 J=IWX1(I)+35.5
776 K=-IWY1(I)+21.5
777 JJ=IWX2(I)+35.5
778 KK=-IWY2(I)+21.5
779 IF(((WHEEL(J,K).NE.'.').AND.(WHEEL(J,K).NE.' '))
780 1.OR.((WHEEL(JJ,KK).NE.'.').AND.(WHEEL(JJ,KK).NE.' ')))
781 2GO TO 1000
782 IF(IWX1(I))1020,1020,1030
783 1020 WHEEL(J,K)=PLAN2(1,I)
784 WHEEL(JJ,KK)=PLAN2(2,I)
785 GO TO 1040
786 1030 WHEEL(J,K)=PLAN2(2,I)
787 WHEEL(JJ,KK)=PLAN2(1,I)
788 1040 CONTINUE
789 C
790 C FOLLOWING PUTS ZODIACAL CUSPS INTO WHEEL
791 DO 1080 I=13,24
792 J=1
793 1050 W=ARG((I-1)/12.-P(NH,J),1.)/ARG(P(NH,J+1)-P(NH,J),1.)
794 IF(W-1.)1070,1060,1060
795 1060 J=J+1
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:32 PAGE 16
796 GO TO 1050
797 1070 PLACE(I)=(J+W+5.)*PI/6.
798 J=34.5*COS(PLACE(I))+35.5
799 K=-20.5*SIN(PLACE(I))+21.5
800 1080 WHEEL(J,K)=ZOD1(I-12)
801 C
802 DO 1090 I=1,42
803 1090 WRITE(IOUT,40000),(WHEEL(J,I),J=1,70)
804 40000 FORMAT(' ',70A1)
805 C
806 C FOLLOWING DELETES PLANETS FROM WHEEL
807 DO 1100 I=1,12
808 J=IWX1(I)+35.5
809 K=-IWY1(I)+21.5
810 JJ=IWX2(I)+35.5
811 KK=-IWY2(I)+21.5
812 JJJ=34.5*COS(PLACE(I+12))+35.5
813 KKK=-20.5*SIN(PLACE(I+12))+21.5
814 WHEEL(JJJ,KKK)='.'
815 WHEEL(J,K)=' '
816 1100 WHEEL(JJ,KK)=' '
817 C
818 C INTERCEPTED SIGNS
819 WRITE(IOUT,41000)
820 41000 FORMAT(/' INTERCEPTED SIGNS (IF ANY) FOLLOW')
821 DO 1120 I=13,18
822 IF(INT(PLACE(I)*6/PI)-INT(PLACE(I+1)*6/PI))1120,1110,1120
823 1110 WRITE(IOUT,42000)ZOD(I-12),ZOD(I-6)
824 42000 FORMAT(6X,A10,4X,A10)
825 1120 CONTINUE
826 C
827 9999 TYPE 97000
828 97000 FORMAT(/////////' DO YOU WANT ANOTHER HOROSCOPE ? ',
829 1'(TYPE YES OR NO) -----'/)
830 ACCEPT 98000,OPTION
831 98000 FORMAT(A3)
832 IF(OPTION.EQ.'NO ')GO TO 9998
833 TYPE 99000
834 99000 FORMAT(' ENTER ANOTHER SET OF BIRTH DATA ........'/)
835 GO TO 140
836 9998 IF(LINEP)9997,9997,9996
837 9996 TYPE 96000
838 96000 FORMAT(' AFTER EXIT TYPE "Q CHART.DATA/DISPOSE:RENAME"'/
839 1' TO LINEPRINT HOROSCOPES WITH OPTION "LINEPRINT" ')
840 9997 END
CONSTANTS
0 200400000000 1 202622077325 2 203622077325 3 150042055061 4 211550000000
5 000000000000 6 201004020100 7 173722743247 10 271004020100 11 176414052221
12 462231642640 13 777777777777 14 000000000024 15 416210151250 16 000000000000
17 213550000000 20 411004020100 21 451004020100 22 777777701217 23 226446632600
24 000000000000 25 220435264000 26 000000000000 27 426411042632 30 502451743644
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:32 PAGE 17
31 217435260000 32 000000000000 33 211654374361 34 210670255470 35 211520714631
36 200515066705 37 173461524161 40 202777652633 41 202443345652 42 207414463146
43 200423351361 44 201546314631 45 177645043163 46 177530535253 47 210706727024
50 207775463146 51 177432734614 52 207474631463 53 177421234357 54 211453101563
55 214702000000 56 202443351361 57 210756160507 60 205602345300 61 211425307534
62 203553351361 63 210552670243 64 202700507534 65 202435643223 66 207744631463
67 177434530040 70 177420304467 71 203671463146 72 176747331055 73 203407274676
74 210413146314 75 176710550345 76 211501546314 77 176737166621 100 207741643656
101 206410540203 102 171627630347 103 215472051463 104 220431173554 105 211546324365
106 214573235442 107 210702326010 110 210414631463 111 177523757473 112 206607146314
113 205626111564 114 206450314631 115 205474254020 116 206573656050 117 206643727024
120 210570463146 121 205535716662 122 210577631463 123 205400436560 124 204676722743
125 206430631463 126 204421706517 127 214573271666 130 210702653004 131 213461416355
132 210537403044 133 211654376763 134 207451513615 135 207451217270 136 210664736152
137 206512554426 140 210435700406 141 205470101422 142 207456631463 143 207631146314
144 206604767635 145 205525075341 146 205675737166 147 205475716662 150 205714540203
151 204501075341 152 205445727024 153 204435075341 154 204413146314 155 205407024365
156 205451270243 157 204623227432 160 203424733105 161 204710753412 162 207701211156
163 201615034530 164 200410142233 165 207421266213 166 204467044672 167 203646560507
170 177643656050 171 205727024365 172 205551605075 173 205507146314 174 206417615237
175 212766010550 176 210551735136 177 176437253154 200 205450662132 201 214540022743
202 210462421320 203 174725315475 204 206421065176 205 202765605075 206 214706446314
207 211755063146 210 214610740000 211 215472103146 212 205571727024 213 206447007271
214 204641463146 215 207511405033 216 164742762573 217 210540631463 220 164540071201
221 163674167200 222 210706631463 223 211425231463 224 166557207022 225 207477146314
226 165614532210 227 165451146603 230 165400125440 231 203622077324 232 201400000000
233 213743422132 234 211403134121 235 160676125721 236 172652311413 237 205567171144
240 170517220362 241 201400000000 242 000000000000 243 174453654112 244 141710325575
245 200600474112 246 145450743103 247 170546671766 250 135010663571 251 200615624662
252 145401704541 253 165504371634 254 132555151552 255 200733373230 256 145360305520
257 152430614325 260 117563160034 261 200617752610 262 145272304634 263 164464365163
264 131145007303 265 200560473476 266 145111772750 267 217541570000 270 215436500000
271 214450200000 272 212600400000 273 225474320000 274 217440350000 275 172652311413
276 137701573224 277 205567171144 300 152154051760 301 213743422132 302 160071260102
303 211403134121 304 156727024366 305 170517220362 306 135575473352 307 202111151100
310 512132451236 311 206740000000 312 471004020100 313 535004020100 314 207620004277
315 154516451342 316 207620000000 317 000000000000 320 177433441411 321 164443212631
322 226446632612 323 173020504622 324 211555174002 325 156752111462 326 213733000000
327 000000000000 330 155440502370 331 122632546561 332 204600000000 333 202600000000
334 203600000000 335 515004020100 336 172421042103 337 165443212634 340 174421024115
341 174631463146 342 175635544264 343 210550000000 344 201431463146 345 405004020100
346 421004020100 347 215472064365 350 162605075341 351 221510215063 352 166146314632
353 201434475662 354 146775425553 355 214702000000 356 000000000000 357 200414052221
360 206434631463 361 255004020100 362 201775341217 363 472364020100
SUBPROGRAMS
FORSE. .JBFF SIN COS INT SIGN FLOAT DFD.2 IFIX INTO. INTI. ALPHO. ALPHI. OFILE DFLOAT
DFA.0 DFS.2 DFD.0 DFA.2 DFM.2 IDINT DBLE DFM.0 DFS.0 ATAN SQRT ATAN2 ASIN EXP3.6 DCOS
DFM.4 DFS.4 SNGL FLOUT. FLIRT. ABS ACOS EXIT
SCALARS
ASTRO.F4 F40 V26A(352) 6-NOV-75 12:32 PAGE 18
HLP 13571 LINEP 13572 PI 13573 PI2 13574 CONV 13576
CONVS 13600 I 13601 J 13602 K 13603 IOUT 13604
NY 13605 CALEND 13606 NM 13607 ND 13610 NH 13611
NMI 13612 NCH 13613 NCM 13614 LATD 13615 LATS 13616
LATM 13617 LONGD 13620 LONGS 13621 LONGM 13622 OPTION 13623
GMT 13624 XJD 13626 T 13630 JFINAL 13632 TT 13633
TP 13635 W 13636 N 13637 G5 13640 G6 13641
G7 13642 GT 13643 GJ 13644 GN 13645 GG 13646
G1 13647 GP 13650 GPP 13651 TH 13652 TH2 13653
XNUT 13654 DIST 13655 E 13656 DAY 13657 XL 13661
YL 13663 XP 13665 YP 13667 XN 13671 AL 13673
BL 13674 AP 13675 BP 13676 AN 13677 U 13700
V 13701 F 13702 D 13703 DL 13704 XLW 13705
XLN 13706 JD1 13707 XJD1 13710 YBES 13711 IYBES 13713
YBES1 13714 ITER 13715 RA 13716 AA 13717 AD 13720
DRA 13721 DEG 13722 IFINAL 13723 ISS 13724 II 13725
MY 13726 L 13727 I5 13730 DIF 13731 DIF1 13732
DIF2 13733 APPLY 13734 M 13735 IPRINT 13736 WW 13737
M2 13740 NDIF1 13741 NDIF2 13742 JJ 13743 KK 13744
JJJ 13745 KKK 13746
ARRAYS
AN1 13747 RULER 13771 WEEK 14021 WEEKR 14037 PLANET 14055
ASPTYP 14115 DIGTYP 14137 ZOD 14167 HOUSE 14217 DISP 14263
ASPECT 14321 ASPDEG 14606 EXDEG 14617 DIG 14631 TAKEN 15021
EC0 15040 EC1 15051 AN0 15062 P0 15073 P1 15104
EC 15115 TL 15126 TB 15137 TH0 15150 TH1 15161
XI 15172 R 15203 A 15214 G 15225 GE 15236
X 15247 Y 15260 Z 15271 XX 15302 YY 15313
ZZ 15324 IH 15335 H 15351 ZOD1 15355 P 15371
ID 20611 IM 24031 IS 27251 GLYPH 32471 IASP 35711
WHEEL 36215 ROMAN 44011 PLAN2 44071 IWX1 44125 IWX2 44141
IWY1 44155 IWY2 44171 PLACE 44205 ELEM 44235 QUAD 44521
HOUSE5 44526 RETRO 44535 NDISP 44545 LEVEL 44564 NRULER 44603
DBLANK 44617 COMENT 44636 MONTH 44643 MOND 44657 XNODE 44673
YNODE 44717
A 7 80 253 260
AA 390 391 394 396 409
ABS 396 413 441 518 569 587 591 595 599 601 621
ACOS 592
AD 403 406
AL 315 320 322 323
AN 319 322 332
AN0 7 82 179
AN1 2 84 178 179
AP 317 320
APPLY 596 602 609 610
ARG 25 285 294 302 331 332 347 358 360 361 362 391 394 396
404 409 411 413 415 416 419 421 424 428 431 433 518 592
599 601 603 605 606 759 793
ASIN 259 297 300 304 339 396 403
ASPDEG 5 28 591 595 603 606 610
ASPECT 5 29 589 590
ASPTYP 2 37 610
ATAN 209 253
ATAN2 257 285 294 391 394 396 404 409 416 419 421 424
BL 316 321 323
BP 318 321
CALEND 138 149 157 159 473
COMENT 7 138 148 149
CONV 2 105 106 179 343
CONVS 106 182 183 193 204 205 209 211 212 214 221 222 223 224
225 226 237 241 249 252 253 257 259 261 263 266 270 292
297 298 300 303 304 339 343 352 400 592
COS 24 111 116 214 226 237 241 253 255 257 260 266 270 278
279 298 300 304 339 391 394 396 404 409 416 419 421 424
592 746 764 766 771 798 812
D 323 324 334
DAY 2 309 310 311 312 313 314
DBLANK 7 682 687 700 705 711 714
DBLE 179
DCOS 343
DEG 441 442 443
DIF 587 588 591 592 595 621 622 623
DIF1 591 610
DIF2 595 610
DIG 5 39 634 635 638 652 657
DIGTYP 2 44 636
DISP 2 515 520 523 671 682 684 686 700 702 704 707 709 714
DIST 296 297
DL 324 331
DRA 404 406
DUMMY 24
E 298 300 304 339 343 391 394 396 403 404 409 416 419 421
424
EC 7 177 207 209 253 260
EC0 7 87 177
EC1 7 89 177
ELEM 7 540 546 547 548 556 560
EXDEG 5 47 639 640
F 322 324 334
G 7 179 180 181 183 193 204 205 207 214 226 237 241
G1 223 226
G5 180 183 193 266 270
G6 181 183 193 266 270
G7 182 193
GE 7 207 209 260
GG 222 226
GJ 212 214
GLYPH 7 438 440 450 463 476 491 498 623 718
GMT 2 154 155 160 358
GN 221 226
GP 224 226
GPP 225 226
GT 211 214
H 7 358 360 361 362 364 388
HLP 1 26 143 145
HOUSE 2 48 740
HOUSE5 7 52 737
I 107 109 110 111 112 115 116 117 118 119 120 121 122 124
176 177 178 179 206 207 209 248 249 252 253 255 256 257
259 260 277 278 279 280 281 283 284 285 286 287 288 293
294 296 297 300 302 303 304 345 346 347 348 363 364 365
366 367 368 370 375 380 432 433 436 438 439 440 441 442
443 445 447 448 450 451 452 453 461 462 463 475 476 491
498 511 513 523 537 540 542 543 544 547 548 555 556 559
567 569 570 584 585 587 592 597 598 599 601 603 605 606
610 618 619 621 623 632 633 634 635 636 638 639 640 647
648 649 652 653 657 658 667 668 669 670 671 673 675 689
696 697 718 736 737 738 745 746 747 757 759 763 764 765
766 767 768 769 771 772 773 774 775 776 777 778 782 783
784 786 787 791 793 797 798 799 800 802 803 807 808 809
810 811 812 813 821 822 823
I5 541 551 559
IASP 7 569 570
ID 7 442 443 452 453 463 476 491 498 623 639 718
IDINT 315 316 317 318 319 331 359
IFINAL 444 445
IH 7 365 366 367 368 370 467
II 462 463 585 586 619 620 649 650 690 691 698 707 708 709
712 713 750 751 752
IM 7 443 453 463 476 491 498 623 718
INT 25 375 822
IOUT 136 146 149 370 380 457 463 467 476 486 491 498 523 533
556 560 562 570 577 610 616 623 630 636 640 645 653 658
664 682 700 714 718 730 740 803 819 823
IPRINT 674 681 682 685 699 700 706 710 714
IS 7 448 451 511 512 529 530 543 544 633 648 651 669
ISS 449 450 669 670
ITER 386 398
IWX1 7 764 768 771 773 775 782 808
IWX2 7 768 773 777 810
IWY1 7 765 769 772 774 776 809
IWY2 7 769 774 778 811
IYBES 378 379 380
J 108 109 111 113 116 118 119 120 121 123 124 172 173 294
295 309 331 332 333 370 398 426 428 437 438 439 440 441
442 443 446 447 448 450 451 452 453 463 476 491 498 512
514 523 538 540 545 546 547 548 556 560 568 569 570 586
587 592 597 598 599 601 603 605 606 610 620 621 623 635
636 650 651 652 653 657 658 675 677 679 680 686 708 712
713 718 751 753 758 759 761 763 775 779 783 786 792 793
795 797 798 800 803 808 815
JD1 373 374 375 380
JFINAL 164 166 172 444
JJ 777 779 784 787 810 816
JJJ 812 814
K 112 113 117 118 119 120 121 250 253 255 256 282 283 284
285 402 403 404 406 516 519 520 522 523 539 540 543 546
547 548 551 552 556 560 590 591 595 603 606 610 676 678
688 689 690 691 692 693 694 695 699 702 709 710 711 752
753 776 779 783 786 799 800 809 815
KK 778 779 784 787 811 816
KKK 813 814
L 517 518 520 523 544 546 547 548
LATD 138 149 352 386
LATM 138 149 352
LATS 138 149 353
LEVEL 7 679 689 690 691 692 693
LINEP 102 147 836
LONGD 138 149 351
LONGM 138 149 351
LONGS 138 149 355
M 648 652 657 682 683 684 700 703 704 705 714 748 749 751
752
M2 749 750
MOND 7 54 472 474 480 481
MONTH 7 55 476
MY 471 472 474
N 178 179 389 390 391 394 396 399 404 406 407 409 411 412
413 415 418 419 423 424 427 428 588 589 590 633 634 635
636 638 651 652 657
NCH 138 149 154
NCM 138 149 154
ND 138 149 155 160 476 479 480 481
NDIF1 766 768 773
NDIF2 767 769 774
NDISP 7 670 675 677 691
NH 138 149 154 735 738 740 743 759 793
NM 138 149 155 160 471 476 480 481 482 483 484
NMI 138 149 154
NRULER 7 57 513 514 670
NY 138 149 155 158 160 467 471 485 486
OFILE 144
OPTION 138 142 148 165 369 456 466 737 830 832
P 7 25 124 285 294 297 300 302 303 304 331 332 334 339
347 391 394 396 399 407 409 411 413 415 416 419 421 424
428 431 433 439 441 447 518 531 532 569 587 592 599 601
603 605 606 621 743 759 793
P0 7 91 209 253
P1 7 93 209 253
PI 103 253 255 256 396 404 416 421 763 797 822
PI2 2 104 105 315 316 317 318 319
PLACE 7 763 764 765 766 767 771 772 797 798 799 812 813 822
PLAN2 7 62 547 548 783 784 786 787
PLANET 2 58 515 520 523 610 623 636 653 658 671 684 686 704
707 709
Q 25
QUAD 7 65 556 560
R 7 253 255 256 260 266 270 278 279 280
RA 388 391 394 396 404 409 419 421 424
RETRO 7 346 348 491
ROMAN 7 66 118 119 120 121
RULER 2
SIGN 25 154
SIN 24 112 117 183 193 207 212 214 226 237 241 256 257 259
261 263 279 280 292 300 304 324 334 339 391 394 396 403
404 409 416 419 421 424 592 747 765 767 772 799 813
SNGL 358
SQRT 209 253 296 416 748
T 2 162 173 343 359 376 729
TAKEN 5 668 672 680 697 698
TAN 24 209 253 396 403 409 419
TB 7 259 261 263 278 279 280 303 304
TH 249 252 257 259
TH0 7 95 249
TH1 7 97 249
TH2 252 253 255 256
TL 7 257 278 279 302 304
TP 174 182 183 193 252 257 261 263 266 270
TT 2 173 174 175 178 179
U 320 324 334
V 321 324 334
W 175 177 193 204 205 209 211 212 214 221 222 223 224 225
237 241 249 253 292 298 359 360 364 365 366 367 368 416
419 421 424 447 448 449 451 452 453 603 606 608 729 730
746 748 751 759 760 763 793 794 797
WEEK 2 70 380
WEEKR 2 72 380
WHEEL 7 109 113 118 119 120 121 753 754 779 783 784 786 787
800 803 814 815 816
WW 747 748 752
X 7 209 214 226 237 241 257 259 261 263 278 283 286 289
399 400 403 404
XI 7 99 257 259
XJD 2 155 160 162 309 373 374 376
XJD1 374 375 380
XL 2 310 315 331
XLN 352 354 391 396 403 409 416 419
XLW 351 356 361 362 375
XN 2 314 319
XNODE 7 255 283 285
XNUT 292 294 331
XP 2 312 317
XX 7 286 289 294 296
Y 7 279 284 287 290 406 407
YBES 2 376 378 379
YBES1 379 380
YL 2 311 316
YNODE 7 256 284 285
YP 2 313 318
YY 7 287 290 294 296
Z 7 280 288 291
ZOD 2 74 636 823
ZOD1 7 77 450 800
ZZ 7 288 291 296 297
100P 107 108 109
110P 110 113
120P 115 121
130P 122 123 124
140P 136 835
144P 142 154
150P 157 159
160P 159 162
170P 165 172
174P 176 179
177P 206 209
180P 250 256
185P 248 260
190P 277 280
200P 282 285
210P 281 288
220P 295 296
230P 293 295 306
260P 333 334
270P 172 333 341
275P 347 348
277P 345 347 349
280P 353 355
290P 355 358
300P 363 368
310P 369 386
320P 402 406
330P 398 407
340P 389 411
350P 412 415
351P 418 419
352P 423 424
355P 426 427 428
360P 432 433
370P 439 440
380P 439 441
390P 436 437 443
400P 445 446 453
410P 461 463
420P 456 466
430P 473 475
440P 480 481
450P 483 484
460P 475 480 483 488
470P 466 491
480P 518 519
490P 517 518 521
500P 537 538 539 540
510P 545 553
520P 545 546 550
530P 542 549 554
540P 559 560
550P 555 559 561
560P 567 568 569
570P 589 590
580P 597 598
590P 598 599
600P 598 601
610P 597 600 602
620P 605 606
630P 605 608
640P 608 609
650P 598 608 610
660P 584 586 589 613
670P 622 623
680P 618 620 622 627
690P 634 635
700P 638 639
710P 639 640
720P 632 634 638 639 642
730P 652 653
740P 652 657
750P 657 658
760P 647 650 656 657 661
770P 667 671
780P 675 697
790P 676 677
800P 681 682
810P 683 684
820P 681 686
830P 688 708 712
840P 690 693
850P 691 692 695 708
860P 693 694
870P 695 696 697
880P 691 698
890P 699 700 712
900P 703 705
910P 699 707 709
920P 697 713
930P 713 714
940P 713 715
950P 736 737 739
960P 745 750 753
970P 759 762
980P 760 761
990P 760 763
1000P 771 779
1010P 770 775
1020P 782 783
1030P 782 786
1040P 757 785 788
1050P 793 796
1060P 794 795
1070P 794 797
1080P 791 800
1090P 802 803
1100P 807 816
1110P 822 823
1120P 821 822 825
7297P 143 146
9996P 836 837
9997P 836 840
9998P 832 836
9999P 465 489 827
10000P 126 127
11000P 138 140
11500P 149 151
12000P 370 371
13000P 380 381
14000P 457 458
15000P 463 464
16000P 467 468
17000P 476 478
18000P 486 487
19000P 491 493
19500P 498 500
20000P 523 524
21000P 533 534
22000P 556 557 560
23000P 562 563
24000P 570 571
25000P 577 578
26000P 610 612
27000P 616 617
28000P 623 625
29000P 630 631
30000P 636 637
31000P 640 641
32000P 645 646
33000P 653 654
34000P 658 659
35000P 664 665
36000P 682 700 701 714
37000P 718 721
38000P 730 731
39000P 740 741
40000P 803 804
41000P 819 820
42000P 823 824
96000P 837 838
97000P 827 828
98000P 830 831
99000P 833 834