CHARACTER*4 PLAN(14),NAME(6)
REAL LONG(14),VAR(7),XM(12),DECL(7),CHEST(7)
INTEGER IR(8),IP(3,14),DATE(3)
DATA PLAN/'SURY','CHAN','KUJA','BUDH','GURU','SUKR','SANI',
1 'RAHU','KETU','LAGN','URAN','NEPT','PLUT','GULI'/
OPEN(3,FILE='CON')
OPEN(1,FILE='CON')
OPEN(2,FILE='LPT1')
10 CALL FIRST(PLAN,DATE,AYN,LONG,T,ZEN,NAME,IF1,IF2,DQ
1 ,XLMT,ITHRI,NW,IHOR,DECL(1))
CALL LONGIT(T,LONG,AYN,IR,DECL,CHEST)
CALL STAAR(PLAN,LONG,IR,IP,IF1,IF2)
CALL BHAVA(PLAN,LONG,ZEN,IP,XM,IF1,IF2)
CALL CHART(PLAN,IP,IF1,IF2)
CALL DASAS(PLAN,DATE,LONG(2),IF1)
IF(IF1.LE.2)GO TO 10
CALL VARGA(PLAN,LONG,IP,NAME,VAR)
CALL ASHTA(PLAN,IP)
CALL SHADBL(PLAN,LONG,IP,XM,VAR,DQ,XLMT,ITHRI,NW,IHOR,DECL,CHEST)
GO TO 10
END
SUBROUTINE FIRST(PLAN,DATE,AYN,LONG,T,ZEN,NAME,IF1,IF2,DQ,
1 XLMT,ITHRI,NW,IHOR,DECL)
C****************************** SUB 1-A
CHARACTER*4 PLAN(14),WEEK(2,7),NAME(6),PLACE(4)
REAL LAT,GULI(7,2),LON,LONG(14)
INTEGER DATE(3),DAY(12)
COMMON/INTRIO/INTIO
DATA GULI/26.,22.,18.,14.,10.,6.,2.,10.,6.,2.,26.,22.,18.,14./
DATA DAY/31,0,31,30,31,30,31,31,30,31,30,31/
DATA WEEK/'SUND','AY ','MOND','AY ','TUES','DAY ',
1'WEDN','SDAY','THUR','SDAY','FRID','AY ','SATU','RDAY'/
C
5 WRITE(3,870)
870 FORMAT(1x,'This Packages Prints Horoscope in Various Models',
1/1x,'Key in Name ( 24 CHARACTERS MAXIMUM)')
READ(1,871,END=70)NAME
871 FORMAT(6A4)
WRITE(3,872)
872 FORMAT(' Place Of Birth ( 16 CHARACTERS MAX)')
READ(1,871)PLACE
WRITE(3,873)
873 FORMAT(' Date Of Birth (DDMMYYYY)')
READ(1,874)DATE,INTIO
874 FORMAT(2I2,I4,I1)
WRITE(3,875)
875 FORMAT(' TIME OF BIRTH-0000 TO 2400- (HHMM)'/
1 ' OR NAZHI,VINADI,FOLLOWED BY 99 (NNVV99)'/
2' IF1 = 0,1,3 then A4,A3,Full Size Paper Output'/
3' IF2 = 0 then 9 Planets; 1 then Uran,Nept,Plut,Guli Added'/
4' IF3 = 0 or 1 or 2 then Lahiri or Raman or KP Ayanamsa '/
5' The format is HHMMSSNNN '/)
READ(1,8744)I1,I2,IF0,IF1,IF2,IF3
8744 FORMAT(3I2,3I1)
TIME=I1+I2/60.0
C IF0=0 INPUT IN HR/MN IF0=99 INPUT IN NAZHI/VINADI
C IF1=0 OUTPUT IN A4; =1 IN A3; >1 IN 2A3(FULL)
C IF2=0 ONLY 9 PLANETS; IF2>0 URAN,NEPT,PLUT,MAANDHI ADDDED
C IF3=0 LAHIRI AYANAMSA; IF3>0 RAMAN AYANAMSA
WRITE(3,876)
876 FORMAT(' LATITUDE&LONGITUDE(DEG & MIN):DDDDMMDDDDMM ',/
1' Agra 2709,7800; Amalapur 1636,8203; Amaravati 1635,8020'/
2' Bapatla 1556,8032; Banglore 1258,7735; Bezwada 1634,8040'/
3' Bhimavaram 1634,8135; Bhongiri 1733,7855; Bidar 1756,7735'/
4' Bobbili 1832,8329; Bombay 1856,7251; B Lanka 1628,8203'/
5' Calcutta 2235,8821; Chirala 1552,8026; Cudapah 1430,7850'/
6' Cuttack 2026,8556; Delhi 2840,7714; Dharmpuri 1211,7807'/
7' Durgapur 2330,8720; Eluru 1645,8110; Gadwal 1615,7750'/
8' Golconda 1724,7826; Gudivada 1628,8103; Guntur 1620,8027'/
9' Hyderbad 1722,7826; J.S.Pur 2247,8612; Kakinada 1659,8220'/
!' Kotipalli 1644,8203; Kurnool 1551,7801; Madras 1305,8018'/
@' Masula 1613,8112; M. Nagar 1645,7757; Nandyal 1530,7828'/
^' Nanded 1911,7721; Narsapur 1903,7810; Nellore 1429,8000'/)
WRITE(3,111)
111 FORMAT(' '/
#' Nidavolu 1656,8142; Nizambad 1840,7805; Nuzividu 1647,8053'/
$' Palkollu 1634,8148; Produtur 1445,7834; R.C.Puram 1654,8203'/
%' Rajhmundry 1701,8152; Repalli 1603,8054; SecBad 1727,7827'/
&' Tanuku 1648,8145; Tanjur 1046,7909; Tenali 1613,8036'/
*' Tiruchy 1050,7843; Tirupati 1339,7925; Tiruchend 829,7807'/
(' Trivandrum 841,7657; Poona 1834,7358; Vizag 1742,8324'/
)' Vizinagram 1807,8330; Waltair 1745,8325; Warangal 1800,7935'/
+' Srikakulam 1819,8400; Yanam 1645,8216; '/
?' For Ex Bezwada Key in 001634008040')
READ(1,877)I3,I4,I5,I6
877 FORMAT(2(I4,I2))
C WRITE(3,8766)
8766 FORMAT(' Please Key in Displayed Number = ',I4,/)
C READ(1,874)IC
N=DATE(1)+I1+I2
N=N-N/100*100
N1=N/10
N2=N-N1*10
N=N2*10+N1
WRITE(3,8766)N
READ(1,874)IC
IF(IC.EQ.N)GO TO 7
WRITE(3,8767)
8767 FORMAT(' SORRY,CHECK CODE WRONG. TRY AGAIN')
GO TO 5
7 CONTINUE
C
C LEAP YEAR?
C
83 K=0
IY=DATE(3)
IF(IY.NE.IY/100*100.AND.IY.EQ.IY/4*4.OR.IY.EQ.IY/400*400)K=1
DAY(2)=28+K
C
C DATA VALIDATION
C
M=DATE(2)
IF(M.LT.1.OR.M.GT.12) GO TO 50
IF(DATE(1).LT.1.OR.DATE(1).GT.DAY(M)) GO TO 50
IF(DATE(3).LT.1800.OR.DATE(3).GT.2000) GO TO 50
IF(I1.LT.0.OR.IF0.EQ.0.AND.I1.GE.24) GO TO 50
IF(I2.LT.0.OR.I2.GT.59) GO TO 50
IF(IABS(I3).GT.66.OR.IABS(I5).GT.179) GO TO 50
IF(I4.LT.0.OR.I4.GT.59)GO TO 50
IF(I6.LT.0.OR.I6.GT.59)GO TO 50
IF(IF0.NE.0.AND.IF0.NE.99)GO TO 50
C
LAT =IABS(I3)+I4/60.0
IF(I3.LT.0)LAT=-LAT
LON=IABS(I5)+I6/60.0
IF(I5.LT.0)LON=-LON
C
C CALCULATION OF SUNRISE
C
CALL RISE(DATE(1),DATE(2),DATE(3),LAT,SRISE,SSET,DECL)
CALL CONV(SRISE,IR1,IR2,IX)
CALL CONV(SSET ,IS1,IS2,IX)
C
C IF TIME IS GIVEN IN GHATIS,VIGHATIS
C
IF(IF0.EQ.0)GO TO27
IF(I1.GT.60)GO TO 50
TIME=SRISE+(I2/60.0+I1)/2.5+(82.5-LON)/15.0
IF(TIME.LT.24.)GO TO 25
TIME=TIME-24.
DATE(1)=DATE(1)+1
IF(DATE(1).LE.MDAY)GO TO 25
DATE(1)=1
DATE(2)=DATE(2)+1
IF(DATE(2).LE.12)GO TO 25
DATE(2)=1
DATE(3)=DATE(3)+1
25 CALL CONV(TIME,I1,I2,IX)
C
C CALCULATION OF WEEK DAYS AND T (CENTURIES FROM 1-1-1900)
C
27 CALL CENTUR(DATE(1),DATE(2),DATE(3),0.0,TTT,NW)
C
C CALCULATE GMT TIME AND LOCAL MEAN TIME
C
GMT= TIME -5.5
XLMT=GMT+LON/15.
IF(XLMT.LT.0.)XLMT=XLMT+24.
IF(XLMT.GT.24.)XLMT=XLMT-24.
C
C CALCULATION OF AYANAMSA
C
X=DATE(3)+(DATE(2)-1+DATE(1)/30.0)/12.0
IF(IF3.EQ.0)AYN=AYNLAH(DATE(1),DATE(2),DATE(3))
IF(IF3.EQ.1)AYN=AYNRAM(DATE(1),DATE(2),DATE(3))
IF(IF3.EQ.2)AYN=(AYNLAH(DATE(1),DATE(2),DATE(3))-.1)
CALL CONV(AYN,I3,I4,I5)
C
C CALCULATION OF SIDEREAL TIME
C
SID=0.276 919 398 + 100.002 1359 * TTT + 0.000 001 075*TTT*TTT
1 +( 1.002 737 908 * GMT +LON/15.0)/24.0
SID=(SID-IFIX(SID))*24.0
IF(SID.LT.0.0)SID=SID+24.0
CALL CONV(SID,I6,I7,I8)
C
C CALCULATION OF LAGNA & ZENITH
C
EPS=(23.452294-0.0130125*TT)
LONG(10)=ASCEND(SID,EPS,LAT)
X=SID*15.
ZEN=ATAN2D(TAND(X),COSD(EPS))
IF(ZEN.LT.0.)ZEN=ZEN+360.0
IF(ABS(X-ZEN).GT.90.)ZEN=ZEN+180.
ZEN=RATNL(ZEN-AYN)
C
C POSITION OF MAANDHI
C
J=1
IF(TIME.LT.SRISE.OR.TIME.GT.SSET)J=2
GUL=GULI(NW,J)/2.5
IF(J.EQ.1)GULT=SRISE+GUL
IF(J.EQ.2)GULT=SSET+GUL
X=SID+(GULT-TIME)*1.000 737 908
LONG(14)=ASCEND(X,EPS,LAT)
C
C WRITE TITLE
C
WRITE(3,797)
797 FORMAT(1X,'ALIGN THE TOP OF THE PAGE WITH THE PRINT HEAD &',
1 ' PRESS ANY KEY')
READ(1,798)
798 FORMAT(A1)
IF(IF1.EQ.0)WRITE(2,20)NAME,DATE,WEEK(1,NW),WEEK(2,NW),I1,I2,
1 PLACE,I3,I4,I5,IR1,IR2,IS1,IS2,I6,I7,I8
IF(IF1.GT.0)WRITE(2,21)NAME,DATE,WEEK(1,NW),WEEK(2,NW),I1,I2,
1 PLACE,I3,I4,I5,IR1,IR2,IS1,IS2,I6,I7,I8
20 FORMAT(26X,'HOROSCOPE OF ',6A4//' DATE OF BIRTH : ',2(I2,'-'),
1I4,1X,2A4,4X,'TIME : ',I2,':',I2,' HRS(IST)'/' PLACE',9X,': ',
2 4A4,7X,'AYANAMSA : ',I2,2(':',I2)/' SUNRISE/SUNSET: ',I2,':',I2,
3 '/',I2,':',I2,'(LMT)',7X,'SID.TIME : ',I2,2(':',I2))
21 FORMAT(56X,'HOROSCOPE OF ',6A4//' DATE OF BIRTH : ',2(I2,'-'),
1I4,1X,2A4,11X,'TIME',7X,':',I3,':',I2,' HRS(IST)',16X,'PLACE',10X,
2 ': ',4A4/1X,'AYANAMSA : ',I2,2(':',I2),22X,'SUNRISE/SET: ',
3 I2,':',I2,'/',I2,':',I2,'(LMT)',13X,' SIDEREAL TIME : ',I2,
4 2(':',I2),' HRS')
C
T=TTT+GMT/24.0/36525.0
DQ=TTT*36525.0+26543.0
C
C THRIBAGHA AND HORA CALCULATIONS
C
Y=XLMT
IF(XLMT.LT.SRISE)Y=Y+24.
X=(SSET-SRISE)/3.
ITHRI=(XLMT-SRISE)/X+1.
IF(Y.LT.SSET) GO TO 254
X=8.0-X
ITHRI=(Y-SSET)/X+4.
254 X=(NW-1)*24+Y-SRISE+1.
IHOR=MEET(X,7)
RETURN
50 WRITE(2,60)DATE,I1,I2,I3,I4,I5,I6
60 FORMAT(' DATA ERRORS. INPUT NEXT DATA' /9I5)
GO TO 5
70 STOP
END
C **************************************
SUBROUTINE RISE(D,M,IY,XL,RIS,SET,DECL)
C ************************************** SUB 1-B
INTEGER D,M
REAL MNLN
CALL CENTUR(D,M,IY,0.0,T,NX)
ANOM=RATNL(358.475833 +T*35999.04975)
MNLN=RATNL(279.69668+T* 36000.76892)
ECC=0.01675104 - T*0.0000418
TWOL=2.*MNLN
SUN=MNLN+(1.91946-0.004789*T)*SIND(ANOM)
1 +0.020094*SIND(2.*ANOM)+0.000293*SIND(3.*ANOM)
EPS=(23.452294-0.0130125*T)
DECL=ASIND(SIND(EPS)*SIND(SUN))
Y=TAND(EPS/2.)**2
EQNT=Y*SIND(TWOL)-2*ECC*SIND(ANOM)+4*ECC*Y*SIND(ANOM)*COSD(TWOL)
EQNT=(EQNT-0.5*Y*Y*SIND(2.*TWOL)-1.25*ECC*ECC*SIND(2.*ANOM))
EQNT=EQNT/0.0174532925/15.
XN=ACOSD((-SIND(DECL)*SIND(XL))/(COSD(DECL)*COSD(XL)))/15.0
RIS=12-EQNT-XN
SET =12-EQNT+XN
RETURN
END
C 0.0025 0.0060 0.0043 0.0026 0.0071 0.0027 0.0095 0.003
C 0.0079 0.0178 0.0297 0.0104 0.0221 0.0151 0.0281 0.006
C---------------------------------
SUBROUTINE LUNA(T,ANG,OMEG,DECL)
C--------------------------------- SUB 2-C
REAL L,M,MM,MM2
T2=T*T
OMEG=RATNL(259.183-1934.142*T+0.002*T2)
L=RATNL(270.434+481267.883*T-(T2-4*SIND(346.56+T*132.87))/1E3)
MM=RATNL(296.105+477198.849*T)
D=RATNL(350.737+445267.114*T)
F=RATNL(11.251+483202.025*T)
M=RATNL(358.476+T*35999.05)
E=1-0.002495*T
MM2=MM+MM
D2 =D+D
F2 =F+F
ANG=L+(6289*SIND(MM) + 1274*SIND(D2-MM) + 658*SIND(D2)
1 +214*SIND(MM2) - 114*SIND(F2) + 59*SIND(D2-MM2) + 53*SIND(D2+MM)
2 - 35*SIND(D) + 15*SIND(D2-F2) - 13*SIND(F2+MM) - 11*SIND(F2-MM)
3 +11*SIND(4*D-MM) +10*SIND(3*MM) +9*SIND(4*D-MM2)+ E*(-186*SIND(M)
4 + 57*SIND(D2-M-MM) + 46*SIND(D2-M) + 41*SIND(MM-M)- 30*SIND(MM+M)
5 - 8*SIND(M-MM+D2) - 7*SIND(D2+M) + 5*SIND(M+D) + 4*SIND(MM-M+D2)
6 + 3*SIND(MM2-M) + 2*(SIND(D2-M-MM2) - SIND(MM2+M))
7 + SIND(4*D-M-MM)))/1E3
C
CALCULATE LATITUDE & DECLINATION
C
BETA=(5128*SIND(F)+281*SIND(MM+F)+278*SIND(MM-F)+173*SIND(D2+F)
1 +55*SIND(D2+F-MM)+46 *SIND(D2-F-MM)+33*SIND(D2+F)+17*SIND(MM2+F)
2 +9*SIND(D2+MM-F))/1E3
EPSI=23.45-0.013*T
DECL=ASIND(SIND(BETA)*COSD(EPSI)+COSD(BETA)*SIND(EPSI)*SIND(ANG))
RETURN
END
C ********************************************
SUBROUTINE LONGIT(T,LON,AYN,IR,DECL,CHEST)
C ******************************************** SUB 2-A
REAL LON(14),ANG(9),ANG1(9),DECL(7),CHEST(7)
INTEGER IR(8)
CALL SAYANA(T,ANG,DECL,CHEST)
CALL SAYANA(T+1./24./36525.,ANG1,DECL,CHEST)
LON(1)=ANG(1)
DO 1 I=1,8
1 IR(I)=0
J=0
DO 2 I=2,6
LON(I+1)=ANG(I)
X=ANG1(I)-ANG(I)
IF(X.GT.0..AND.X.LT.358.)GO TO 2
J=J+1
IR(J)=I+1
2 CONTINUE
DO 3 I=7,9
LON(I+4)=ANG(I)
X=ANG1(I)-ANG(I)
IF(X.GT.0..AND.X.LT.358.)GO TO 3
J=J+1
IR(J)=I+4
3 CONTINUE
CALL LUNA(T,LON(2),LON(8),DECL(2))
LON(9)=(LON(8)+180.0)
C
C CHESTA BALA CALCLNS ; SUBTRACT AYANAMSA FOR NIRAYANA
C
CHEST(1)=(LON(1)+90.)
CHEST(2)=(LON(2)-LON(1))
DO 4 I=1,7
X=RATNL(CHEST(I))
IF(X.GT.180.)X=360.-X
4 CHEST(I)=X/180.
DO 5 I=1,14
5 LON(I)=RATNL(LON(I)-AYN)
RETURN
END
C ************************************
SUBROUTINE SAYANA(T,ANG,DECL,CHEST)
C ************************************ SUB 2-B
REAL C(2,9),D(2,9),ORB(9),E(2,9),INC(9),ASC(2,9),
1ANG(9),INCL,MNLN,ANOM(9),CHEST(7),DECL(7)
COMMON/INTRIO/INTIO
DATA ORB/1.0,1.5236883,0.3870986,5.202561,0.7233316,9.554747,
1 19.21814,30.10957,39.517738/
DATA C/358.476, 35999.050, 319.519, 19139.855,
1 102.279, 149472.515, 225.328, 3034.692,
2 212.603, 58517.804, 175.466, 1221.551,
3 72.65,428.38, 37.73,218.46,229.95,144.913/
DATA D/279.697, 36000.769, 293.737, 19141.696,
1 178.179, 149474.070, 238.049, 3036.302,
2 342.767, 58519.212, 266.564, 1223.510,
3 244.197,429.86, 84.46,219.886, 92.423,146.311/
DATA E / 0.01675104,-418.0, 0.09331290, 920.64,
1 0.20561421, 204.6, 0.04833475,1641.8,
2 0.00682069,-477.4, 0.05589232,-3455.,
3 0.0463444,-265.8,0.00899704,63.3,0.248644,0.0/
DATA INC/0.0, 1.850, 7.003, 1.309,3.394,2.493,0.772,1.779,17.15/
DATA ASC/ 0.000, 0.000, 48.786, 0.771, 47.146, 1.185,
1 99.443,1.01, 75.78,0.9, 112.79,0.873, 73.477,0.498,130.681,1.099,
2 108.9,1.3576/
T2=T*T
EPS=23.45-0.013*T
DO 10 I=1,9
10 ANOM(I)=RATNL(C(1,I)+T*C(2,I))
X=3*ANOM(4)-8*ANOM(2)+4*ANOM(1)
X=0.0113*SIND(X)+0.009*COSD(X)
Y=ANOM(4)-ANOM(2)
C1=(7*COSD(Y-49)+6*COSD(ANOM(4)+Y-188)+4*COSD(2*(Y-96)))/1E3
V=T/5.0+0.1
P=(237.476+3034.906*T)
Q=(265.917+1222.114*T)
VV=5.0*Q-P-P
Z=Q-P
SV=SIND(VV)
S2V=SIND(VV+VV)
CV=COSD(VV)
SZ=SIND(Z)
S2Z=SIND(Z+Z)
S2V=SIND(VV+VV)
S3Z=SIND(3.0*Z)
CZ=COSD(Z)
C2Z=COSD(Z+Z)
C3Z=COSD(3.0*Z)
SQ=SIND(Q)
S2Q=SIND(Q+Q)
CQ=COSD(Q)
C2Q=COSD(Q+Q)
C
AA=(331*SV-64*V*CV+14*SZ+18*S2Z+7*S3Z+(7*SZ+6*S2Z-34*CZ)*SQ+(-36*
1 SZ-6*CZ-7*C2Z)*CQ)/1E3
BB=(7*SV-20*CV+(7*SZ-4+34*CZ+6*C2Z)*SQ+(38*SZ+6*S2Z-7*CZ)*CQ-5*SZ
1 *S2Q+6*CZ*C2Q)/1E3
CC=(36*SV+13*CV+(-68*SZ-11*S2Z-2 +13*CZ)*SQ+(15*SZ-8+60*CZ+10*C2Z
1 +5*C3Z)*CQ+(-10*SZ-10*CZ)*S2Q+(-10*SZ+5*S2Z+10*CZ)*C2Q)/1E5
SA=(-814*SV+18*V*SV-10*CV+161*V*CV+8*S2V-149*SZ-40*S2Z-15*S3Z-6*SQ
1+(9*SZ-17*S2Z-6*S3Z+81*CZ+15*C2Z)*SQ+(86*SZ+25*CZ+14*C2Z+6*C3Z)*CQ
2 +(6*SZ+9*S2Z)*S2Q+(-5*CZ-8*C2Z)*C2Q)/1E3
SB=(77*SV+45*CV-15*V*CV-7*SZ+(-76*SZ-25*S2Z-9*S3Z)*SQ+(-73-150*CZ
1 +27*C2Z+10*C3Z)*CQ+(-14*SZ-8*CZ+13*C2Z)*S2Q+(-14*SZ+12*S2Z+15*CZ
2 -13*C2Z)*C2Q)/1E3
SC=(-79*SV+26*V*SV+134*CV+12*V*CV+(124+266*CZ-47*C2Z-19*C3Z)*SQ+(-
1127*SZ-42*S2Z-15*S3Z-13*V*CZ)*CQ+(22*SZ-22*S2Z-6*S3Z-28*CZ+20*C2Z
2 )*S2Q+(-28*SZ-16*CZ+22*C2Z+6*C3Z)*C2Q)/1E5
DD=(57*SV+293*CV+3363*CZ-308*C2Z-142*C3Z+(110-281*SZ+69*S2Z-39*S3Z
1 +214*CZ-100*C2Z-64*C3Z)*SQ+(-89+221*SZ-159*S2Z-65*S3Z+289*CZ+217*
2 C2Z)*CQ+(-78*CZ+50*C2Z)*S2Q-86*SZ*C2Q)/1E5
C
DO 100 J=1,9
ORBR=ORB(J)
ANMN=ANOM(J)
ECC=E(1,J)+T*E(2,J)/1E7
INCL=INC(J)
ASCN=ASC(1,J)+T*ASC(2,J)
MNLN=RATNL(D(1,J)+T*D(2,J))
IF(J.NE.2)GO TO 20
ANMN=ANMN-X
MNLN=MNLN-X
GO TO 55
20 IF(J.NE.4)GO TO 30
MNLN=MNLN+AA
ECC=ECC+CC
ANMN=ANMN+AA-BB/ECC
GO TO 55
30 IF(J.NE.6)GO TO 50
MNLN=MNLN+SA
ECC=ECC+SC
ANMN=ANMN+SA-SB/ECC
ORBR=ORBR+DD
GO TO 55
50 IF(J.EQ.7)MNLN=MNLN-.816-.166*SIND(MNLN+50.)
IF(J.EQ.8)MNLN=MNLN+0.6-.1*SIND(MNLN/2-90.)+.166*(T-1.)
IF(J.EQ.9)MNLN=MNLN-.1*SIND(MNLN)
C
C CALCULATE TRUE ANOM FROM MEAN ANOM
C
55 EC=ECC/0.0174532925
EOLD=ANMN
ITR=0
C2 ANEC=ANMN+EC*SIND(EOLD)
2 ANEC=EOLD+(ANMN+EC*SIND(EOLD)-EOLD)/(1.0-ECC*COSD(EOLD))
ITR=ITR+1
ADIF=(EOLD-ANEC)*100.0/EOLD
IF(INTIO.GT.0) WRITE(3,976)J,ITR,EOLD,ANEC,ADIF
976 FORMAT(1X,2I3,3F16.7)
IF(ABS(ADIF).LE. 0.00001)GO TO 3
IF(ITR.LT.10) GO TO 977
WRITE(3,978)J
978 FORMAT(1X,'FOR J = ',I1,', NOT CONVERGED IN 10 ITERATIONS')
GO TO 3
977 EOLD=ANEC
GO TO 2
3 ANTR=RATNL(ATAND(SQRT((1+ECC)/(1-ECC))*TAND(ANEC/2.))*2.0)
C
C CALCULATE HELIOCENTRIC LONG -- TRLONG AND RAD VECTOR --RAD
C
U =RATNL(MNLN+ANTR-ANMN-ASCN)
UU =ATAND(COSD(INCL)*TAND(U))
IF(U.GT.90..AND.U.LT.270.)UU=UU+180.
TRLONG=UU+ASCN
IF(J.EQ.2)TRLONG=TRLONG+C1
TRLONG=RATNL(TRLONG)
RAD=ORBR*(1.-ECC*COSD(ANEC))
IF(INCL.GT.0.)GO TO 5
C
C THIS IS FOR EARTH
C
ERAD=RAD
ELONG=TRLONG
ANG(1)=TRLONG
GO TO 100
C
C FOR OTHER PLANETS FIND GEOCENTRIC VALUE -- ANG
C
5 SINB=(SIND(U)*SIND(INCL))
RCOSB=RAD*SQRT(1.-SINB*SINB)
X=TRLONG-ELONG
XN=RCOSB*SIND(X)
XD=RCOSB*COSD(X)+ERAD
ANG(J)=RATNL(ATAN2D(XN,XD)+ELONG)
DEL=SQRT(XN*XN+XD*XD+(RAD*SINB)**2)
BETA=ASIND(RAD/DEL*SINB)
IF(J.GT.6)GO TO 100
DECL(J+1)=ASIND(SIND(BETA)*COSD(EPS)+COSD(BETA)*SIND(EPS)*SIND
1 (ANG(J)))
CHESTA BALA
CHEST(J+1)=(ELONG-(ANG(J)+TRLONG)/2.)
IF(J.EQ.3.OR.J.EQ.5)CHEST(J+1)=(TRLONG-(ANG(J)+ELONG)/2.)
100 CONTINUE
RETURN
END
C ****************************************
SUBROUTINE STAAR(PLAN,LONG,IR,IP,IF1,IF2)
C **************************************** SUB -3
CHARACTER*4 PLAN(14),STAR(2,27),THITHI(2,16),YOG(2,27),PAK(2,2)
INTEGER IR(8),IP(3,14),OWNER(9),DEG(14),MIN(14),PADA(14),S(14)
1,OW(14)
REAL LONG(14)
DATA OWNER/9,6,1,2,3,8,5,7,4/
DATA STAR/'ASWI','NI','BHAR','ANI','KRIT','HIKA','ROHI','NI',
1 'MRIG','SIRA','ARUD','RA ','PUNA','RVAS','PUSH','YAMI','ASLE',
2 'SHA','MAKH','A ','PUBB','A ','UTTA','RA','HAST','HA','CHIT',
3 'RA ','SWAT','HI ','VISA','KHA ','ANUR','ADHA','JYES','HTA ',
4 'MOOL','A ','PURV','SADA','UTRA','SADA','SHRA','VANA','DHAN',
5 'ISTA','SATA','BISA','PURV','BDRA','UTRA','BDRA','REVA','THI '/
DATA THITHI/'PADY','AMI ','DWIT','IYA ','THRI','TIYA',
1 'CHAT','URTI','PANC','HAMI','SASH','TI ','SAPT','HAMI',
2 'ASHT','AMI ','NAVA','MI ','DASA','MI ','EKAD','ASI ',
3 'DWAD','ASI ','TRYO','DASI','CHTR','DASI','PURN','IMA ',
4 'AMAV','ASYA'/
DATA PAK/'SUKL','A','KRIS','HNA'/
DATA YOG/'VISK','AMBA','PRIT','I ','AYUS','HMAN',
1 'SAUB','AGYA','SHOB','ANA ','ATIG','ANDA','SUKA','RMAN',
1 'DHRI','TI ','SOOL','A ','GAND','A ','VRID','DHI ',
2 'DHRU','VA ','VYAG','ATHA','HARS','HANA','VAJR','A ',
3 'SIDD','HI ','VYAT','IPTA','VARI','YAN ','PARI','GHA ',
4 'SIVA',' ','SIDD','HA ','SADH','YA ','SUBH','A ',
5 'SUKL','A ','BRAH','MA ','INDR','A ','VAID','RITI'/
C
DO 5 I=1,14
CALL CONV(LONG(I),DEG(I),MIN(I),IX)
N=LONG(I)/ 10.0 *3.0+1
S(I)=LONG(I)*3.0/40.0 +1
PADA(I)=N-(S(I)-1)*4
OW(I)=OWNER(S(I)-(S(I)-1)/9*9)
IP(1,I)=DEG(I)/30 +1
IP(2,I)=N-(N-1)/12*12
5 CONTINUE
ITH=RATNL(LONG(2)-LONG(1))/12.0+1.
IK=1
IF(ITH.GT.15)IK=2
IF(ITH.GT.15)ITH=ITH-15
IF(ITH.EQ.15.AND.IK.EQ.2)ITH=16
IY=RATNL(LONG(2)+LONG(1))/13.33333+1.
IF(IF1.EQ.0)WRITE(2,1)STAR(1,S(2)),STAR(2,S(2)),PADA(2),PAK(1,IK),
1 PAK(2,IK),THITHI(1,ITH),THITHI(2,ITH)
1 FORMAT(1X,'NAKSHATRA : ',2A4,I4,' PADA THITHI : (',
1 2A4,') ',2A4/' NIRAYANA LONGITUDES: '/1X,19(1H-)/
2 2(' PLANET DEG:MIN STAR PADA RULER ')/)
IF(IF1.GT.0)WRITE(2,2)STAR(1,S(2)),STAR(2,S(2)),PADA(2),PAK(1,IK),
1 PAK(2,IK),THITHI(1,ITH),THITHI(2,ITH),YOG(1,IY),YOG(2,IY)
2 FORMAT(' NAKSHATRA : ',2A4,I4,' PADA',13X,'THITHI : (',
1 2A4,') ',2A4,11X,'YOGA : ',2A4//
2 ' NIRAYANA LONGITUDES: ',
3'PLANET DEG MIN STAR PADAM RULER',13X,
3'PLANET DEG MIN STAR PADAM RULER'/1X,19(1H-))
IF(IF2.EQ.0)N=5
IF(IF2.GT.0)N=7
DO 10 I=1,N
IF(IF1.EQ.0)WRITE(2,15)(PLAN(K),DEG(K),MIN(K),STAR(1,S(K)),
1 STAR(2,S(K)),PADA(K),PLAN(OW(K)),K=I,I+N,N)
IF(IF1.GT.0)WRITE(2,16)(PLAN(K),DEG(K),MIN(K),STAR(1,S(K)),
1 STAR(2,S(K)),PADA(K),PLAN(OW(K)),K=I,I+N,N)
10 CONTINUE
15 FORMAT(2(1X,A4,I6,':',I2,2X,2A4,I3,4X,A4,3X))
16 FORMAT(24X,A4,I7,I5,2X,2A4,I7,7X,A4,
* 13X,A4,I7,I5,2X,2A4,I7,7X,A4)
K=0
DO 20 I=1,8
IF(IR(I).EQ.0)GOTO 21
IF(IF2.EQ.0.AND.IR(I).GT.10) GOTO 21
K=K+1
20 CONTINUE
21 IF(K.NE.0) WRITE(2,25)(PLAN(IR(J)),J=1,K)
25 FORMAT(/' PLANETS UNDER RETROGRESSION : ',5(A4,';')/)
RETURN
END
C *****************************************
SUBROUTINE BHAVA(PLAN,LONG,ZEN,IP,XM,IF1,IF2)
C ****************************************** SUB - 4
CHARACTER*4 PLAN(14)
INTEGER I1(12),I2(12),IP(3,14)
REAL XM(12),ST(13),STR(14),LONG(14)
IF(ZEN.LT.LONG(10))ZEN=ZEN+360.0
C
C CALC BHAVA MADHYAS
C
XM(1)=LONG(10)
XM(4)=ZEN-180.
X=(XM(4)-XM(1))/3.
XM(2)=XM(1)+X
XM(3)=XM(2)+X
X=60.0-X
XM(5)=XM(4)+X
XM(6)=XM(5)+X
DO 10 I=1,6
10 XM(I+6)=XM(I)+180.0
C
CALC BHAVA ARAMBAS
C
DO 20 I=2,12
20 ST(I)=(XM(I)+XM(I-1))*0.5
ST(1)=(XM(1)+XM(12)) *0.5-180.0
ST(13)=ST(1)+360.0
C
CALC POSITION OF PLANETS IN BHAVA CHART
C
DO 40 I=1,14
X=LONG(I)
IF(X.LT.ST(1))X=X+360.0
IF(X.GT.ST(13))X=X-360.0
DO 30 J=1,12
IF(X.GT.ST(J).AND.X.LE.ST(J+1))GO TO 35
30 CONTINUE
35 K=J+IP(1,10)-1
IF(K.GT.12)K=K-12
IP(3,I)=K
STR(I)=(X-ST(J))/(XM(J)-ST(J))
IF(X.GT.XM(J))STR(I)=(ST(J+1)-X)/(ST(J+1)-XM(J))
40 CONTINUE
C
C PRINT RESULTS
C
IF(IF1.EQ.0)RETURN
DO 50 I=1,12
XM(I)=RATNL(XM(I))
CALL CONV(XM(I),I1(I),I2(I),IX)
50 CONTINUE
WRITE(2,60)(I,I=1,12),(I1(I),I2(I),I=1,12)
60 FORMAT(/' BHAVA(DEG:MIN)',6X,12I8/1X,14('-')/16X,'MIDDLE ',12(I5,
1 ':',I2))
DO 70 I=1,12
ST(I)=RATNL(ST(I))
CALL CONV(ST(I),I1(I),I2(I),IX)
70 CONTINUE
WRITE(2,80)(I1(I),I2(I),I=1,12)
80 FORMAT(16X,'START ',12(I5,':',I2)/)
IF(IF2.GT.0) WRITE(2,90)PLAN,STR
IF(IF2.EQ.0) WRITE(2,100)(PLAN(I),I=1,9),(STR(I),I=1,9)
90 FORMAT(/' RESIDENTIAL',14(4X,A4)/' STRENGTH ',14F8.3/)
100 FORMAT(/' RESIDENTIAL', 9(4X,A4)/' STRENGTH ', 9F8.3/)
RETURN
END
C *********************************
SUBROUTINE CHART(PLAN,IP,IF1,IF2)
C ********************************* SUB 5
CHARACTER*4 PLAN(14),SP(20,24),SPC(480),V(4),BLNK
INTEGER IP(3,14),ST(12),BLK,OFF(10),FILL(12)
EQUIVALENCE (SPC(1),SP(1,1))
DATA ST/41,81,121,126,131,136,96,56,16,11,6,1/
DATA OFF,V,BLNK/2,3,1,22,23,21,4,24,0,20,'!',' ',' ','!',' '/
C
DO 1 I=1,480
1 SPC(I)=BLNK
NP=10
IF(IF2.GT.0)NP=14
C
DO 4 I=1,3
N=(I-1)*160
DO 2 J=1,12
2 FILL(J)=1
DO 3 J=1,NP
K=IP(I,J)
L=ST(K)+OFF(FILL(K))+N
SPC(L)=PLAN(J)
3 FILL(K)=FILL(K)+1
4 CONTINUE
C
IF(IF1.GT.0)GO TO 10
WRITE(2,5)
5 FORMAT(2X,2('+',4('-------+'),3X))
DO 9 BLK=1,4
DO 6 LIN=1,5
I = (BLK-1)*5+LIN
WRITE(2,7)(SP(I,J),J=1,4),V(BLK),(SP(I,J),J=5,12),V(BLK),(SP(I,J),
1 J=13,16)
6 CONTINUE
IF(BLK.NE.2)WRITE(2,5)
IF(BLK.EQ.2)WRITE(2,8)
7 FORMAT(2X,2(2('!',A3,1X,A3),A1,2(A3,1X,A3,'!'),3X))
8 FORMAT(2X, '+-------+ R A S I +-------+ ',
& '+-------+ NAVAMSA +-------+ ')
9 CONTINUE
RETURN
10 WRITE (2,11)
11 FORMAT(1X,3('+',4('---------+'),3X))
DO 15 BLK=1,4
DO 12 LIN=1,5
I=(BLK-1)*5+LIN
WRITE(2,13)(SP(I,J),J=1,4),V(BLK),(SP(I,J),J=5,12),V(BLK),(SP(I,J)
1 ,J=13,20),V(BLK),(SP(I,J),J=21,24)
12 CONTINUE
IF(BLK.NE.2)WRITE(2,11)
IF(BLK.EQ.2)WRITE(2,14)
13 FORMAT(1X,3(2('!',A4,1X,A4),A1,2(A4,1X,A4,'!'),3X))
14 FORMAT(1X,
&'+---------+ R A S I +---------+ ',
&'+---------+ NAVAMSA +---------+ ',
&'+---------+ BHAVA +---------+')
15 CONTINUE
RETURN
END
C **************************************
SUBROUTINE DASAS (PLAN,DATE, MOON,IF1)
C ************************************** SUB 6
CHARACTER*4 PLAN(14),AN2(9),ALORDS(9),MONTH(12)
REAL MOON
INTEGER DATE(3), PERIOD(9),OWNER(9),DAY(12),AN1(9),AN3(9)
DATA C,PERIOD/13.33333333,6,10,7,17,16,20,19,18,7/
DATA MONTH,DAY,OWNER/'JAN','FEB','MAR','APR','MAY','JUN','JUL',
1 'AUG','SEP','OCT','NOV','DEC',31,28,31,30,31,30,31,31,30,31,30,
2 31, 9,6,1,2,3,8,5,7,4/
C
C FIND THE STARTING DASA,CALCULATE THE PORTION REMAINING,PRINT
C
X = MOON-IF IX(MOON)/120*120
INTF = X/C+1.0
N = OWNER(INTF)
DASA = (INTF*C-X)/C* PERIOD(N)
I1 = DASA
X = (DASA-I1)*12
I2 = X
I3 = (X-I2)*30
IF(IF1.EQ.0) WRITE(2,1)PLAN(N),I1,I2,I3
1 FORMAT(/' VIMSOTTARI DASAS: '
& ,A4, ' DASA REMAINING AT BIRTH:',I3,
&' YRS',I3,' MONTHS',I3, ' DAYS'/1X,16(1H-)/
2 ' DASA ',5('BHUKTI ENDS ')/
3 ' ENDS ON ',5('------ ON ')/)
IF(IF1.GT.0) WRITE(2,11)PLAN(N),I1,I2,I3
11 FORMAT(/' VIMSOTTARI DASAS: '
& ,A4, ' DASA REMAINING AT THE TIME OF BIRTH :',I3,
&' YEARS',I3,' MONTHS',I3, ' DAYS'/1X,16(1H-)/
& ' DASA ENDS ON ',9(' BHUKTI ENDS ')/
& ' ---- ---- -- ',9(' ------ ON ')/)
I = DATE(2)
BEGIN = (FLOAT(DATE(1))/DAY(I)+(I-1))/12.0+DATE(3)
C
C FOR NINE DASAS WORK OUT THE EIGHT OR LESS INTERMEDIATE DATES
C IN THE REVERSE ORDER FOR ALL BHUKTIS
C
DO 100 I1 = 1,8
ENDO = BEGIN + DASA
X = PERIOD(N)/120.0
XX = ENDO
NNY=XX
K = 9
L = INTF
18 I = XX
Y = (XX-I)*12
IF ( I.GE.100)I=I-I/100*100
AN3(K) = I
J = Y+1
AN2(K) = MONTH(J)
I = (Y-J+1.0)*DAY(J)
IF(I.LE .0)I = 1
AN1(K) = I
L = L-1
IF (L.EQ.0) L=9
M = OWNER(L)
ALORDS(K) = PLAN(M)
K = K-1
IF(K.EQ.0) GO TO 21
DURN = PERIOD(M)*X
XX = XX-DURN
IF(XX.GT.BEGIN) GO TO 18
C
C PRINT BHUKTIS IN TWO LINES
C
21 K = K+ 1
K1=K+4
K2=9
IF(K1.LT.K2)K2=K1
IF(IF1.GT.0)GOTO211
WRITE(2,2)PLAN(N),(ALORDS(I),AN1(I),AN2(I),AN3(I),I=K,K2)
2 FORMAT(3X,A4,3X,5(1X,A3,I3,A3,I2))
22 FORMAT(1X,A4,I4,A3,I2,2X,9(2X,A3,I3,A3,I2))
K2=K1+1
IF(K1.GE.9)WRITE(2,3)AN1(9),AN2(9),NNY
IF(K1.LT.9)WRITE(2,3)AN1(9),AN2(9),NNY,(ALORDS(I),
1 AN1(I),AN2(I),AN3(I),I=K2,9)
GO TO 30
211 WRITE(2,22)PLAN(N),AN1(9),AN2(9),AN3(9),(ALORDS(I),AN1(I),
& AN2(I),AN3(I), I = K,9)
3 FORMAT(I3,A3,I4,4(1X,A3,I3,A3,I2))
C
C SET PARAMETERS FOR NEXT ITERATION
C
30 INTF = INTF + 1
IF(INTF.EQ. 10) INTF = 1
BEGIN = ENDO
N = OWNER(INTF)
DASA = PERIOD(N)
100 CONTINUE
WRITE(2,734)
734 FORMAT(1X)
RETURN
END
C *************************
SUBROUTINE ASHTA(PLAN,IP)
C ************************* SUB 7
CHARACTER*4 PLAN(14),IBL,IST,IL(12)
INTEGER PL(8),S(12,2),RAG(12),GRG(7),OWN(5,2),VAR(12),SOZ(344)
1,BAR(12),PN,RASP,GRAP,SODP,IP(3,14)
DATA IBL,IST,OWN/' ','*', 1,2,3,9,10,8,7,6,12,11/
DATA GRG,RAG/5,5,8,5,10,7,5,7,10,8,4,10,5,7,8,9,5,11,12/
DATA SOZ/1,2,4,7,8,9,10,11,-3,6,10,11,-1,2,4,7,8,9,10
A,11,-3,5,6,9,10,11,12,-5,6,9,11,-6,7,12,-1,2,4,7,8,9,
B10,11,-3,4,6,10,11,12,0,3,6,7,8,10,11,-1,3,6,7,10,11,
&-2,3,5,6,9,10,11,-1,3,4,5,7,8,10,11,-1,4,7,8,10,11,12,
&-3,4,5,7,9,10,11,-3,5,6,11,-3,6,10,11,0,3,5,6,10,11,
&-3,6,11,-1,2,4,7,8,10,11,-3,5,6,11,-6,10,11,12,-6,8,11,
&12,-1,4,7,8,9,10,11,-1,3,6,10,11,0,5,6,9,11,12,-2,4,6,
&8,10,11,-1,2,4,7,8,9,10,11,-1,3,5,6,9,10,11,12,-6,8,11,
&12,-1,2,3,4,5,8,9,11,-1,2,4,7,8,9,10,11,-1,2,4,6,8,10,11,
&0,1,2,3,4,7,8,9,10,11,-2,5,7,9,11,-1,2,4,7,8,10,11,-1,2,4,
&5,6,9,10,11,-1,2,3,4,7,8,10,11,-2,5,6,9,10,11,-3,5,6,12,
&-1,2,4,5,6,7,9,10,11,0,8,11,12,-1,2,3,4,5,8,9,11,12,-3,5,
&6,9,11,12,-3,5,6,9,11,-5,8,9,10,11,-1,2,3,4,5,8,9,10,11,
&-3,4,5,8,9,10,11,-1,2,3,4,5,8,9,11,0,1,2,4,7,8,10,11,-3,6,
&11,-3,5,6,10,11,12,-6,8,9,10,11,12,-5,6,11,12,-6,11,12,
&-3,5,6,11,-1,3,4,6,10,11,0/
WRITE(2,333)
333 FORMAT(/' SARVASHTAGA VARGA CHART :'/1X,25('-'),87X,'RASI',
1' GRAHA SODYA'/12X,'MESHA RISHABH MITHUNA KATAKA ',
2'SIMHA KANYA THULA VRISCHK DHANUS MAKARA KUMBHA ',
3'MEENA PINDA PINDA PINDA'/12X,117('-')/)
402 FORMAT(1X,A4,4X,12(3X,A1,I1,'(',I1,')'),6X,3I6)
DO 21 I = 1,7
21 PL(I)=IP(1,I)
PL(8)=IP(1,10)
DO 1 I = 1,12
IL(I) = IBL
DO 1 J = 1,2
1 S(I,J) = 0
PN = 0
C FOR EACH PLANET PERFORM CALCULATIONS & PRINT ONE LINE
C
DO 60 I = 1,7
DO 2 J = 1,12
2 VAR(J) = 0
J = 1
JJ = PL(J) - 1
7 PN = PN + 1
L = SOZ(PN)
IF(L) 5,10,3
3 L = L+JJ
4 IF (L.GT.12) L=L-12
VAR(L) =VAR(L)+1
GO TO 7
5 J = J + 1
JJ = PL(J) - 1
L = JJ - L
GO TO 4
10 DO 11 J =1,12
BAR(J)=VAR(J)
11 S(J,1) = S(J,1) + VAR(J)
C
C MAKE REDUCTIONS,ESTIMATE PINDAS
C TRIKONAR EDUCATION
DO 330 J = 1,4
J1 = J + 4
J2 = J + 8
IF (BAR(J)+BAR(J1).EQ. 0) BAR(J2) = 0
IF (BAR(J) + BAR(J2) .EQ. 0) BAR(J1) = 0
MIN = 9
IN = J+8
DO 310 K =J,IN,4
IF (BAR(K) .LT. MIN) MIN =BAR(K)
310 CONTINUE
DO 320 K = J,IN,4
320 BAR(K) = BAR(K) - MIN
330 CONTINUE
C EKADHIPADYA REDUCTION
DO 350 J =1,5
J1 = OWN(J,1)
J2 = OWN(J,2)
C CHECK IF THE HOUSE ARE OCCUPIED
L1 = 0
L2 = 0
DO 340 K = 1,7
IF (J1.EQ.PL(K)) L1 = 1
IF (J2.EQ.PL(K)) L2 = 1
340 CONTINUE
N1 = BAR(J1)
N2 = BAR(J2)
IF (L1*L2.EQ.1 .OR. N1*N2.EQ.0) GO TO 350
L = 1
IF (N1.EQ.N2) L =2
IF (N1.LT.N2) L =3
L3 = L1+2*L2+1
IF (L.EQ.2.AND.L3.EQ.1.OR.L.GT.1.AND.L3.EQ.3) BAR(J1) = 0
IF (L.EQ.1.AND.L3.EQ.2.OR.L.EQ.2.AND.L3.LT.3) BAR(J2) = 0
IF (L3.NE.2.AND. L.EQ.1) BAR(J1) = N2
IF (L3.LT.3.AND.L.EQ.3) BAR(J2) = N1
350 CONTINUE
DO 77 J = 1,12
77 S(J,2) = S(J,2) + BAR(J)
C
RASP = 0
GRAP = 0
DO 360 J = 1,12
360 RASP = RASP+RAG(J)*BAR(J)
DO 370 J = 1,7
K = PL(J)
370 GRAP = GRAP+GRG(J)*BAR(K)
KKK=PL(I)
IL(KKK)=IST
SODP = RASP + GRAP
WRITE(2,402) PLAN(I),(IL(J),VAR(J),BAR(J),J=1,12),RASP,GRAP,SODP
IL(KKK)=IBL
60 CONTINUE
WRITE(2,111) ((S(I,J),J=1,2),I=1,12)
111 FORMAT(/1X,'SARVA',3X,12(I4,'(',I2,')'))
RETURN
END
C*************************************************************
SUBROUTINE SHADBL(PLAN,LONG,IP,BHAV,VAR,DQ,XLMT,ITHRI,NW,IHOR,
1 DECL,CHEST)
C************************************************************SUB-9*
C
CHARACTER*4 PLAN(14),TYPE(2,2)
INTEGER ODD(7),MR(7),SUB(7),ISP(2,3),IBAV(24),
1BOT(7),IRAS(12),ID(7),DR(7),IP(3,14),IV(7),ITH(6),HOR(7)
REAL LONG(14),YUD(7),XKAL(2),TEMP(7),CHEST(7),DIK(7),VAR(7)
1,SUMS(2),DECL(7),SQR(3),USUAL(7),
2BIMB(5),RELS(2),SEE(12,2),STNO(7),TOT(7,2),OC(7),
3A(2),BHAV(12),BVI(12),B(2),STHAN(7),BTOT(12,2)
DATA IRAS/3,6,4,2,1,4,6,3,5,7,7,5/
DATA BOT/190,213,118,345,275,177,20/
DATA ODD/0,1,0,0,0,1,0/
DATA MR/1,3,1,2,1,3,2/
DATA SQR/60.0,30.0,15.0/
DATA USUAL/1.0,0.857,0.286,0.429,0.571,0.714,0.143/
DATA SUB/1,1,1,1,2,2,1/
DATA BIMB/9.4,6.6,190.4,16.6,158.0/
DATA SEE/0.,0.5,1.0,-0.5,-1.0,2.0,4*-0.5,4*0.,15.,45.,
&30.,0.,60.,45.,30.,15.,0.0,0.0/
DATA ISP/4,8,5,9,3,10/
DATA TYPE/'BENE','FIC','MALE','FIC'/
DATA STNO/5.0,6.0,5.0,7.0,6.5,5.5,5.0/
DATA IBAV/4*4,7,7,10,10,4,4,4*7,1,1,7,4,4,10,7,7,10,10/
DATA DR/1,1,1,4,4,1,1/
DATA ID/4,10,4,7,7,10,1/
DATA IV/1,2,2,2,1,1,2/
DATA ITH/4,1,7,2,6,3/
DATA HOR/1,6,4,2,7,5,3/
C
C CALCULATE PAKSHA & MOON'S ELONGATION
C
REL=RATNL(LONG(2)-LONG(1))
IK=1
IF(REL.LT.180.) GO TO 2
IK=2
REL=REL-180.
2 WRITE(2,1)TYPE(1,IK),TYPE(2,IK)
1 FORMAT(/1X,'SHADBALAS(RUPAS):',20X,2A4,'MOON & BENEFIC MERCURY '
&,'(VALUES IN BRACKETS APPLY FOR MALEFIC MERCURY)'/1X,17('-'),20X,
&77('-')/9X,'STHANA DIK CHESTA NAISARGIK --- KALA --- ** DHRISHTI
& **',6X,'GRAHA SHADBALA',6X,'RELATIVE',9X,'ISHTA KASTHA NET'/7X
&,4(3X,'BALA'),2(8X,'BALA'),33X,'STRENGTH',7X,2(2X,'BALA')/)
DO 10 I = 1,7
C STHANA BALA
X = ABS(LONG(I)-BOT(I))
IF(X.GT.180.0) X=360.0 -X
OC(I) = X/180.0
IR = IP(1,I)
J = IR + ODD(I)
K = IP(2,I)+ODD(I)
X = (J-J/2*2+K-K/2*2)/4.0
J = IR - IP(1,10)
IF (J.LT.0) J = J+12
K = MEET(J+1.0,3)
Y = SQR(K) /60.0
C
J = (LONG(I)-(IR-1)*30.0)/10.0+1
Z = 0.0
IF (J.EQ.MR(I)) Z=0.25
STHAN(I) = OC(I)+VAR(I)+X+Y+Z
C DIK BALA
J = ID(I)
X = ABS(LONG(I)-BHAV(J))
IF(X.GT.180.0) X=360.0-X
DIK(I) = X/180.0
10 CONTINUE
C KALABALA
C PRELIMINARIES
X =XLMT
IF(X.GT.12.0) X=24.0-X
A(1)= X/12.0
A(2)= 1.0-A(1)
SUB(2)=3-IK
SUB(4)=2
B(1) = REL/180.0
B(2) = 1.0-B(1)
C NATHONNATHA BALA
DO 21 I = 1,7
J = IV(I)
XX = A(J)
IF(I.EQ.4) XX=1.0
C PAKSHA BALA
J=3-SUB(I)
Y=B(J)
IF(I.EQ.2) Y=2.0*Y
TEMP(I)=XX+Y
21 CONTINUE
C THRIBAGHA BALA
K = ITH(ITHRI)
TEMP(K) = TEMP(K)+1.0
TEMP(5) = TEMP(5)+1.0
C VARSHA MASA VARA HORA BALA
NK = DQ/360.0
J = MEET(NK*3+4.0,7)
TEMP(J)=TEMP(J) + 0.25
NK = DQ/30.0
J = MEET(NK*2+4.0,7)
TEMP(J) = TEMP(J)+0.5
TEMP(NW) = TEMP(NW) + 0.75
J = HOR(IHOR)
TEMP(J) = TEMP(J) + 1.0
DO 100 I = 1,7
FAV = SQRT(OC(I)*CHEST(I))
UNF =-SQRT((1.0-OC(I))*(1.0-CHEST(I)))
RESL = FAV+UNF
IF(I.LT.3) CHEST(I) = 0.0
DO 50 K = 1,2
IF (I.EQ.4.AND.K.EQ.2) TEMP(I) = TEMP(I)+B(2)-B(1)
C YUDHDHA BALA
YUD(I) = 0.0
IF ( I.LT.3.OR.I.EQ.7) GO TO 49
K1 = I+1
DO 40 J = K1,7
Z=ABS(LONG(I)-LONG(J))
IF(Z.GT.1.0.AND.Z.LT.359.0) GO TO 40
W=ABS(STHAN(I)+DIK(I)+TEMP(I)-(STHAN(J)+DIK(J)+TEMP(J)))
W=W/ABS(BIMB(I-2)-BIMB(J-2))
IW = I
IL = J
IF (LONG(J).GE.LONG(I).OR.LONG(J).LT.1.0) GO TO 43
IW = J
IL = I
43 YUD(IW) = W
YUD(IL) = -W
40 CONTINUE
C AYANA BALA
49 X=DECL(I)
IF(I.EQ.2.OR.I.EQ.7) X=-X
IF(I.EQ.4) X=ABS(X)
AY = (X+24.0)/48.0
IF(I.EQ.1) AY=AY+AY
XKAL(K) = TEMP(I)+YUD(I)+AY
C
C DRIK BALA
C
SUM = 0
SUB(4)=3-K
DO 51 J = 1,7
X = RATNL((LONG(I)-LONG(J)))
L = X/30.0+1
XX = (X-(L-1)*30)*SEE(L,1)+SEE(L,2)
IF (J.EQ.1.OR.J.EQ.J/2*2)GO TO 51
K1 = (J-1)/2
IF((L-ISP(1,K1))*(L-ISP(2,K1)).EQ.0) XX = XX+15*K1
51 SUM = SUM+XX/240.0*(-1)**SUB(J)
SUMS(K) = SUM
TOT(I,K)=STHAN(I)+DIK(I)+XKAL(K)+CHEST(I)+USUAL(I)+SUMS(K)
RELS(K)=TOT(I,K)/STNO(I)
50 CONTINUE
WRITE(2,551) PLAN(I),STHAN(I),DIK(I),CHEST(I),USUAL(I),
1XKAL,SUMS,TOT(I,1),TOT(I,2),RELS,FAV,UNF,RESL
551 FORMAT(1X,A4,2X,4F7.3,2X,2(F7.3,'(',F6.3,')'),3X,2(F7.3,'(',
1 F7.3,')'),5X,3F7.3)
100 CONTINUE
C
C BHAVA BALAS
C
WRITE(2,555) (I,I=1,12)
555 FORMAT (/1X,'BHAVA',8X,12I8/1X,109('-')/)
DO 60 I=1,12
J = BHAV(I)/15.0+1
K = IBAV(J)-I
IF (K.LT.0) K = K+12
IF (K.GT.6) K=12-K
BVI(I) = K/6.0
BTOT(I,1) = BVI(I)
60 BTOT(I,2) = BVI(I)
WRITE(2,560) BVI
560 FORMAT(' BHAVA DIKBALA ',12F8.3)
DO 70 J= 1,2
SUB(4) = 3-J
DO 65 I=1,12
K =BHAV(I)/30.0+1
L =IRAS(K)
BVI(I) = TOT(L,J)
65 BTOT(I,J) = BTOT(I,J)+BVI(I)
IF (J.EQ.1) WRITE(2,565) BVI
IF (J.EQ.2) WRITE(2,566) BVI
565 FORMAT(' ADHIPATHI BALA',12F8.3)
566 FORMAT(16X,12('(',F6.3,')'))
70 CONTINUE
SUB(4) = 2
DO 80 I = 1,12
SUM = 0
DO 75 J=1,7
X=RATNL((BHAV(I)-LONG(J)))
K= X/30.0+1
XX = (X-(K-1)*30)*SEE(K,1)+SEE(K,2)
IF (J.EQ.1.OR.J.EQ.J/2*2) GO TO 75
K1 = (J-1)/2
IF (((K-ISP(1,K1))*(K-ISP(2,K1))).EQ.0) XX = XX+15*K1
75 SUM = SUM+XX/240.0*(-1)**SUB(J) *DR(J)
BVI(I) = SUM
BTOT(I,1) = BTOT(I,1)+SUM
BTOT(I,2) = BTOT(I,2)+SUM
80 CONTINUE
WRITE(2,600) BVI,BTOT
600 FORMAT(1X,'DHRISHTI BALA ',12F8.3//1X,'BHAVA BALA(NET)',
&F7.3,11F8.3/16X,12(1H(,F6.3,1H)))
WRITE(2,734)
734 FORMAT(1X)
RETURN
END
C ***************************************
SUBROUTINE VARGA(PLAN,LONG,IP,NAME,VAR)
C *************************************** SUB-8
CHARACTER*4 PLAN(14),RASI(2,12),BL,NAME(6),V(2,8)
REAL LONG (14),VAR(7)
INTEGER MITH(7,7),ISAP(6),MOOL(7),IP(3,14),IH(4),ITR(10,2),II(8)
& ,IRAS(12)
DATA RASI /'MESH','A','RISH','ABA','MITH','UNA','KATA','KA',
&'SIMH','A','KANY','A','THUL','A ','VRIC','HIKA','DHAN','US',
&'MAKA','RA','KUMB','HA','MEEN','A '/
DATA IRAS/ 3,6,4,2,1,4,6,3,5,7,7,5/
DATA IH,ITR/1,2,2,1,5,10,18,25,30,35,42,50,55,60,3,7,5,
A4,6,6,4,5,7,3/
DATA BL/' '/
DATA MITH/4,1,1,0,1,-1,-1, 1,4,0,1,3*0, 1,1,4,-1,1,0,0,
A1,-1,0,4,0,1,0, 3*1,-1,4,-1,0, -1,-1,0,1,0,4,1, 3*-1,
B1,0,1,4/
DATA ISAP,MOOL/1,2,4,8,12,16, 5,2,1,6,9,7,11/
DO 2 I = 1,7
2 VAR(I) = 0
WRITE(3,797)
797 FORMAT(' ALIGN THE TOP OF THE PAGE WITH THE PRINT HEAD &',
1 ' PRESS ANY KEY')
READ(1,798)
798 FORMAT(A1)
WRITE(2,10)NAME
10 FORMAT(56X,'HOROSCOPE OF ',6A4//' SAPTHAVARGA :',8X,'RASI',
18X,'HORA DREKKANA SAPTAMSA NAVAMSA ',
2'DWADASAMSA THRIMSAMSA DASAMSA'/1X,13('-'),8X,91('-')/)
DO 100 I =1,10
DEG = LONG(I)
D30 = DEG/30.0
J = IP(1,I)
II(1) = J
DD = DEG - (J-1)*30
K = MEET(2*D30+1,4)
II(2) = IH(K)
II(3) = MEET(J+IFIX(DD/10)*4.0,12)
II(4) = MEET(D30*7.0+1,12)
II(5) = IP(2,I)
II(6) = MEET(D30*12+J,12)
X = DEG - IFIX(DEG/60)*60
DO 20 K = 1,10
IF (X.LT.ITR(K,1)) GO TO 25
20 CONTINUE
25 II(7) = ITR(K,2)
NF=DD/3. +J
IF(J.EQ.J/2*2)NF=NF+8
NF=NF-NF/12*12
IF(NF.EQ.0)NF=12
II(8)=NF
DO 30 J = 1,8
K = II(J)
IF (J.EQ. 2 .OR. J.EQ.7) GO TO 28
V(1,J) = RASI(1,K)
V(2,J) = RASI(2,K)
K = IRAS(K)
GO TO 29
28 V(1,J) = PLAN(K)
V(2,J) = BL
29 IF (I.GT.7.OR.J.EQ.8) GO TO 30
L =IABS(IP(1,I)-IP(1,K))+1
IF(L.GT.7) L = 14-L
LL = -1
IF (L.GE.2.AND.L.LE.4) LL = 1
I1 = MITH(K,I) + LL+3
SP = ISAP(I1)/32.0
IF(J.EQ.1.AND. IP(1,I).EQ.MOOL(I)) SP = .75
VAR(I) =VAR(I)+SP
30 CONTINUE
WRITE(2,35) PLAN(I),((V(K,J),K=1,2),J=1,8)
35 FORMAT(11X,A4,8X,8(2A4,4X))
100 CONTINUE
RETURN
END
C***** SMALL FUNCTIONS *****
C -------------------------------------
SUBROUTINE CENTUR(D,M,Y,GMT,T,NW)
INTEGER D,Y
I1=M
I2=Y
IF(M.GT.2)GO TO 5
I1=M+12
I2=Y-1
5 KA=I2/100
I3=KA/4 -KA
L=D-1+13*(I1+1)/5+I2+I2/4+I3
NW=L-L/7*7+1
KB=I3+2
IF(Y.LE.1582.AND.M.LE.10.AND.D.LE.15)KB=0
T=(INT(365.25*I2)+INT(30.6*(I1+1))+D+KB-694025.5+GMT/24.)/36525.0
RETURN
END
C ----------------------------
FUNCTION ASCEND(SID,EPS,LAT)
C ----------------------------
REAL LAT
X=SID*15.0
P=SIND(EPS)*TAND(LAT)
Q=SIND(X)*COSD(EPS)
ASCEND=RATNL(ATAN2D(COSD(X),-(P+Q)))
RETURN
END
C ---------------------------
SUBROUTINE CONV(X,I1,I2,I3)
C ---------------------------
I1=X
Y=(X-I1)*59.99999
I2=Y
I3=(Y-I2)*59.99999
RETURN
END
C -------------------
FUNCTION AYNRAM(D,M,Y)
C -------------------
INTEGER D,Y
YR=D/365.+(M-1)/12.+Y
AYNRAM=-5.551659144+0.013981911336*YR
RETURN
END
C -------------------
FUNCTION AYNLAH(D,M,Y)
C -------------------
INTEGER D,Y
YR=D/365.+(M-1)/12.+Y
RAH=RATNL(259.183275-19.34142*(YR-1900.))
AYNLAH=22.461966594+0.01396330209*(YR-1900.)-17.*SIND(RAH)/3600.
IF(YR.GT.1960.)AYNLAH=AYNLAH-5./3600.
RETURN
END
C ---------------------
FUNCTION RATNL(ANGLE)
C ---------------------
RATNL=ANGLE-INT(ANGLE/360.0)*360.0
IF(RATNL.LT.0.0)RATNL=RATNL+360.0
RETURN
END
C ----------------
FUNCTION SIND(X)
C ----------------
SIND=SIN(X*0.0174532925)
RETURN
END
C ----------------
FUNCTION COSD(X)
C ----------------
COSD=COS(X*0.0174532925)
RETURN
END
C ----------------
FUNCTION TAND(X)
C ----------------
XX=X*0.0174532925
TAND=SIN(XX)/COS(XX)
RETURN
END
C -----------------
FUNCTION ATAND(X)
C -----------------
ATAND=ATAN(X)/0.0174532925
RETURN
END
C --------------------
FUNCTION ATAN2D(X,Y)
C --------------------
ATAN2D=ATAN2(X,Y)/0.0174532925
IF(ATAN2D.LT.0.)ATAN2D=ATAN2D+360.0
RETURN
END
C -----------------
FUNCTION ASIND(X)
C -----------------
ASIND=ASIN(X)/0.0174532925
RETURN
END
C -----------------
FUNCTION ACOSD(X)
C -----------------
ACOSD=ACOS(X)/0.0174532925
RETURN
END
C ------------------
FUNCTION MEET(A,J)
C ------------------
I = A
MEET = I-I/J*J
IF (MEET.LE.0) MEET= J
RETURN
END