Google
 
Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0083/astro.for
There are no other files named astro.for 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