Tabla de Casas de Regiomontano (Calculo y Programa )

'regio.bas
'Este programa produce una Tabla de Casas por el sistema de Regiomontano que se graba en un 'fichero con el nombre Regiomon.doc. Este fichero puede abrirse con cualquier procesador de 'textos.

'Las instrucciones utilizadas en el codigo son de Basic y pueden ser facilmente traducibles a 'cualquier lenguaje de programacion.

'Se producen las longitudes de las Casas 10, 11, 12, 1, 2 y 3, las otras no son necesarias pues basta con añadirles 6 signos.

cls
pi=3.14159296535
cdr= pi/180
gecl=23:mecl=27:secl=15
obl=(gecl+mecl/60+secl/3600)*cdr

'print tan(105/cdr)
'input rrr

dim z(12)
dim p(12)
dim v(12)
dim x(12)
dim y(12)
dim l(12)
dim sic(12)
dim sic$(12)
dim gr(12)
dim mi(12)
dim po$(12)
open "regiomon.doc" for output as #1
for si=1 to 12
for grado=0 to 29
g=grado
gr=int(g)
l=(si-1)*30+g                            'l=longitud del medio cielo
ss=si:gosub signos:si$=ss$       'signo del MC en letra
ra=atn(tan(l*cdr)*cos(obl))/cdr 'ascension recta en grados
if ra<0 then ra=ra+360
if ra>360 then ra=ra-360

if l=0   then ra=0.0001
if l=90 then ra=90
if l>90 and l<270 then ra=ra+180
if l=180 then ra=180
if l=270 then ra=270
if l>270 then ra=ra+360
if  l>360 then ra=ra-360
if l=360 then ra=360

rag=int(ra):ram=(ra-rag)*60  ' ascension recta en grados y minutos
st=ra*24/360                          ' st=hora sideral

' h.s. en horas,minutos y segundos
sth=int(st)
stmm=(st-sth)*60 :stm=int(stmm)
stss=(stmm-stm)*60:sts=cint(stss)

'for la=22 to 37
la=22
' como ejemplo se crean las Casas para la latitud 22N, basta con sustituir este valor para
' crear la tabla de otra latitud. Tambien puede introducirse un bucle para varias latitudes
' ver la linea anterior donde se crea un bucle de 22 a 37 grados de latitud.

lat=la*cdr

for n=1 to 12 ' bucle de las 12 casas
   z(n)=60+n*30 : if z(n)>360 or z(n)=360 then z(n)=z(n)-360
   p(n)=atn(tan(z(n)*cdr)*cos(lat))/cdr
   sz=sin(z(n))
   cz=cos(z(n))
   if sz>0 and cz<0 then l(n)=l(n)+180        ' cuadrante 2

   if sz<0 and cz<0 then l(n)=l(n)+180        ' cuadrante 3
   if sz<0 and cz>0 then l(n)=l(n)+360        ' cuadrante 4
 
   if n<7 then then p(n)=p(n)-180
   if p(n)<0 then p(n)=p(n)+360

v(n)=sin(p(n)*cdr) * sin(lat) * sin(obl)

x(n)=cos(ra*cdr+z(n)*cdr) * cos(lat) * cos(obl)- v(n)
y(n)=sin(ra*cdr+z(n)*cdr) * cos(lat)

t=y(n)/(x(n))
l(n)=atn(t)/cdr

if y(n)>0 and x(n)<0 then l(n)=l(n)+180
if y(n)<0 and x(n)<0 then l(n)=l(n)+180
if y(n)<0 and x(n)>0 then l(n)=l(n)+360

if l(n)<0 then l(n)=l(n)+360
if l(n)>360 then l(n)=l(n)-360

sic(n)=int(l(n)/30)+1 'signo de la Casa
ss=sic(n):gosub signos:sic$(n)=ss$
gc=l(n)-30*(sic(n)-1):gr(n)=int(gc)
m=(gc-gr(n))*60:mi(n)=cint(m)

next n


if g=0 then
   print #1, "Tabla de Casas de Regiomontano. Alba de Hermes"
   print #1, " C10 AR   HS"
   print #1, " s g gr mi h m s Lo Casa11 Casa12 Casa 1 Casa 2 Casa 3"
end if
print #1, using "\ \ ## ### ##,.# ## ## ## ## ##\\## ##\\## ##\\## ##\\## ##\\##";_
si$;g;rag;ram;sth;stm;sts;la;_
gr(11);sic$(11);mi(11);gr(12);sic$(12);mi(12);gr(1);_
sic$(1);mi(1);gr(2);sic$(2);mi(2);gr(3);sic$(3);mi(3)
' next la
next grado
next si
close #1
end

signos:
select case ss
case 1: ss$="ar"
case 2: ss$="ta"
case 3: ss$="ge"
case 4: ss$="cn"
case 5: ss$="le"
case 6: ss$="vi"
case 7: ss$="li"
case 8: ss$="es"
case 9: ss$="sa"
case 10:ss$="cp"
case 11:ss$="ac"
case 12:ss$="pi"
end select
return
sub s

while inkey$=""
wend
end sub