From: git archive service user Date: Sun, 29 Dec 2019 18:05:56 +0000 (+0100) Subject: Initial commit by marcello Galli X-Git-Url: http://legacy.helldragon.eu/gitweb/?a=commitdiff_plain;p=frankie.git Initial commit by marcello Galli --- 2e96fda4dad5eea91c5851a9601f42744c326a7d diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..054da65 --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +This software, written in the eighties +by Marcello Galli, is in the public domain. diff --git a/README.md b/README.md new file mode 100644 index 0000000..06c31aa --- /dev/null +++ b/README.md @@ -0,0 +1,53 @@ +frankie +======= + +A VAX/VMS FORTRAN program to produce horoscopes +--------------------------------------------------- + +This is a VAX FORTRAN code, written in 1984. +It computes planets positions at a given date to +produce horoscopes. + +Until the seventies most of the computational work was +done by using expensive supercomputers, as those build by Cray and IBM, +but in the eighties mini computers began to be produced and +sold at an affordable price. + +Most of them where produced by Dec Corp., and used the VAX/VMS +operating system. Soon these systems become common in university +departments and research institutions. + +At the Astronomy department of the Bologna University +in the course: "Esercitazioni di Astronimia I" +held by professor Battistini, there was a first part on +the use of VAX computers and FORTRAN programming. + +This program is the exercise on FORTRAN programming +of three students: Marcello Galli, Enrica Baiada and +Sabina Mengoli. Marcello was the main programmer, while +Sabina and Enrica where the "art team", +writing horoscopes suited to specific people. + +This work was well beyond the level of an average student, +but the main author couldn't had the maximum score at the exam: +at that time he hadn't enough experience in optical telescope +usage (that was the second part of the course). + +The program consists of three Fortran code: +frankie.for (about thousand statements), computing +the planet positions, Igor.for: to manage a binary +file with orbital elements and fraugluck.for, to +maintain a database file with responses. +In the "code" folder there is also a VAX/VMS DCL procedure for the +interactive use of the program, data files, +an executable and a pdf scan of the relation +for the exam (in Italian). + +The program run on a VMS/VAX computer, and +used very specific features of VAX FORTRAN, +as indexed files; it can't be used with +recent (2020) FORTRAN compilers. + +It is here as an example of VAX FORTRAN usage, +to be included in the collection of the +[*Software Heritage*] project (https://www.softwareheritage.org/). diff --git a/code/000readme.txt b/code/000readme.txt new file mode 100755 index 0000000..ce8db94 --- /dev/null +++ b/code/000readme.txt @@ -0,0 +1,34 @@ + + In questo direttorio ci sono un certo numero di programmi e + dati per fare l'oroscopo, scritti nell'84 da un gruppo di studenti + di astronomia dell'Universita' di Bologna, come esercizio di + programmazione per il corso di "esercitazioni I". + + -------------------------------------- + + Per utilizzare i programmi eseguire la procedura: Definizioni.com + ( che va modificata se i programmi vengono spostati di direttorio) + quindi digitare "oroscopo". + I responsi vengono mostrati al terminale e scritti su una serie di file + *.dum che l'utente avra' poi cura di distruggere. + + + -------------------------------------- + + + I programmi sono scritti in Vax-Fortran, ci sono poi alcuni files + di dati con elementi orbitali pert il calcolo delle posizioni dei + pianeti e testi degli oroscopi. + + FRANKIE.FOR : programma che fa gli oroscopi + + IGOR.FOR : programma per aggiornare il database degli + elementi orbitali: + CIB.DAT : database degli elementi orbitali + CIBO.DAT : " " " " + + FRAUGLUK.FOR : programma per gestire il database dei responsi: + GLUK.DAT : database dei responsi + GLUKIE.DAT : " " " + + -------------------------------------- diff --git a/code/Frankie-manual.pdf b/code/Frankie-manual.pdf new file mode 100755 index 0000000..7fc5b93 Binary files /dev/null and b/code/Frankie-manual.pdf differ diff --git a/code/cib.dat b/code/cib.dat new file mode 100755 index 0000000..dba5c75 --- /dev/null +++ b/code/cib.dat @@ -0,0 +1,76 @@ + -19840100 0.24457005000000000000E+07 0000000 + 0.0000000000E+000.1026650000E+030.0000000000E+00 0000000 + 0.1672000000E-01-.2322000000E+010.1495978700E+09 0000000 + 0.7004000000E+010.2906500000E+020.4814200000E+02 0000000 + 0.2056300000E+000.1913200000E+020.5790933548E+08 0000000 + 0.3394000000E+010.5381000000E+020.7653600000E+02 0000000 + 0.6780000000E-020.4755900000E+020.1082086273E+09 0000000 + 0.1850000000E+010.2863310000E+030.4943400000E+02 0000000 + 0.9339000000E-01-.1629900000E+030.2279407785E+09 0000000 + 0.1304000000E+01-.8622200000E+020.1002870000E+03 0000000 + 0.4847000000E-010.2544790000E+030.7782200876E+09 0000000 + 0.2489000000E+01-.2078200000E+020.1135170000E+03 0000000 + 0.5560000000E-010.1215790000E+030.1426990146E+10 0000000 + 0.7730000000E+000.9648300000E+020.7391900000E+02 0000000 + 0.4727000000E-010.7408200000E+020.2869557919E+10 0000000 + 0.1772000000E+01-.8711800000E+020.1316040000E+03 0000000 + 0.8590000000E-020.2252200000E+030.4496621752E+10 0000000 + 0.1713300000E+020.1138060000E+030.1101700000E+03 0000000 + 0.2555600000E+00-.8287000000E+010.5958213886E+10 0000000 + -19830923 0.24456005000000000000E+07 0000000 + .2140000000E-02-.7226024000E+020.1750410100E+03 0000000 + 0.1675900000E-01-.1012693700E+030.1495983188E+09 0000000 + 0.7005900000E+010.2908132000E+020.4835208000E+02 0000000 + 0.2056390000E+00-.3209412000E+020.5790918588E+08 0000000 + 0.3394710000E+010.5498138000E+020.7672620000E+02 0000000 + 0.6775000000E-02-.1135914200E+030.1082084777E+09 0000000 + 0.1850970000E+010.2863837800E+030.4961043000E+02 0000000 + 0.9339000000E-01-.2156580800E+030.2279334482E+09 0000000 + 0.1304700000E+01-.8489670000E+020.1004669000E+03 0000000 + 0.4802000000E-010.2448819000E+030.7783382699E+09 0000000 + 0.2484700000E+01-.1849400000E+020.1137088000E+03 0000000 + 0.5042000000E-010.1159521000E+030.1432615026E+10 0000000 + 0.7742000000E+000.1047190000E+030.7405490000E+02 0000000 + 0.4920000000E-010.6472370000E+020.2891746275E+10 0000000 + 0.1770500000E+010.2157837000E+030.1317674000E+03 0000000 + 0.4980000000E-02-.7835480000E+020.4534049643E+10 0000000 + 0.1713150000E+020.1137657000E+030.1104185000E+03 0000000 + 0.2568700000E+00-.8685200000E+010.5969732922E+10 0000000 + -19600923 0.24372005000000000000E+07 0000000 + 0.0000000000E+000.1022524800E+030.0000000000E+00 0000000 + 0.1672590000E-010.2595825000E+030.1495978700E+09 0000000 + 0.7004000000E+010.2897866000E+020.4786575000E+02 0000000 + 0.2056270000E+000.1523030000E+030.5790918588E+08 0000000 + 0.3394240000E+010.5469228000E+020.7632625000E+02 0000000 + 0.6792000000E-020.1086520000E+030.1082089265E+09 0000000 + 0.1849930000E+010.2860814500E+030.4925464000E+02 0000000 + 0.9336900000E-010.6257200000E+020.2279409281E+09 0000000 + 0.1306310000E+01-.8791590000E+020.1000623000E+03 0000000 + 0.4857220000E-010.2699192000E+030.7792021976E+09 0000000 + 0.2487180000E+01-.2217930000E+020.1133236000E+03 0000000 + 0.5072990000E-010.1980162000E+030.1433569311E+10 0000000 + 0.7722500000E+000.9913250000E+020.7370340000E+02 0000000 + 0.4582610000E-010.3317128000E+030.2863591956E+10 0000000 + 0.1773270000E+01-.1092324000E+030.1313603000E+03 0000000 + 0.4512100000E-020.1966702000E+030.4517825754E+10 0000000 + 0.1716987000E+020.1142741000E+030.1098856000E+03 0000000 + 0.2502376000E+000.3174867000E+030.5899969451E+10 0000000 + -19120101 0.24194025000000000000E+07 0000000 + 0.0000000000E+000.1014272700E+030.0000000000E+00 0000000 + 0.1674600000E-01-.1638280000E+010.1495978700E+09 0000000 + 0.7314810000E+010.2879826000E+020.4728824000E+02 0000000 + 0.2056167000E+000.3898933333E+020.5790918588E+08 0000000 + 0.3393840000E+010.5444507000E+020.7588773000E+02 0000000 + 0.6815000000E-020.3473986000E+020.1082087769E+09 0000000 + 0.1852780000E+010.2855609400E+030.4887860000E+02 0000000 + 0.9331980000E-01-.2636742200E+030.2279404793E+09 0000000 + 0.1308102000E+01-.8665431000E+020.9955931000E+02 0000000 + 0.4835700000E-010.2295012800E+030.7783282468E+09 0000000 + 0.2491940000E+01-.2156444000E+020.1128883800E+03 0000000 + 0.5584820000E-01-.3793742000E+020.1426990595E+10 0000000 + 0.7729200000E+000.9588235000E+020.7335830000E+02 0000000 + 0.4707810000E-010.1257158800E+030.2870929432E+10 0000000 + 0.1778150000E+01-.8694991000E+020.1308105600E+03 0000000 + 0.8541000000E-020.6754830000E+020.4498508481E+10 0000000 + 0.1716000000E+020.1140000000E+030.1080000000E+03 0000000 + 0.2530000000E+000.2480000000E+030.5924075652E+10 0000000 diff --git a/code/cibo.dat b/code/cibo.dat new file mode 100755 index 0000000..7ea0834 Binary files /dev/null and b/code/cibo.dat differ diff --git a/code/definizioni.com b/code/definizioni.com new file mode 100755 index 0000000..c9c337b --- /dev/null +++ b/code/definizioni.com @@ -0,0 +1,9 @@ +$! definizioni per usare questi programmi per fare oroscopi +$ define disko marc$disk:[marc.frankie] +$! +$ define cibo disko:cibo.dat ! cibo per il mostro +$ define cib disko:cib.dat ! cibo in forma sequenziale +$! (elementi orbitali) +$ define glukie disko:glukie.dat ! responsi +$ define gluk disko:gluk.dat ! responsi sequenziale +$oroscopo:==@disko:oro.com diff --git a/code/dj.for b/code/dj.for new file mode 100755 index 0000000..bfac034 --- /dev/null +++ b/code/dj.for @@ -0,0 +1,64 @@ + FUNCTION DJ(Y,M,D) 00008760 +C ******************************************* +C Giorno giuliano +C Input: Y: anno +C M: mese +C D: giorno ( frazioni di giorno come parte decimale) +C Output: DJ : giorno giuliano +C ******************************************* + REAL*8 C,D,DJ,A,B,G 00008770 + INTEGER*4 Y 00008780 + C=Y+M*1.E-2+D*1.E-4 00008790 +C CALCOLO DELLA CORREZIONE DI GREGORIO 00008800 + B=0 00008810 + IF(C.LE.1582.1015) GOTO 100 00008820 + A=INT(Y/100.) 00008830 + B=2-A+INT(A/4.) 00008840 + 100 CONTINUE 00008850 + IF(M.LE.2)THEN 00008860 + MY=Y-1 00008870 + MM=M+12 00008880 + ELSE 00008890 + MY=Y 00008900 + MM=M 00008910 + END IF 00008920 + CONTINUE 00008930 + G=0. 00008940 + IF(C.LT.0.) G=.75 00008950 + DJ=INT(365.25*MY-G)+INT(30.6*(MM+1))+D+1720994.5+B 00008960 + TYPE*,'GIORNO= ',D,' MESE= ',M,' ANNO= ',Y,' DJ=',DJ 00008970 + RETURN 00008980 + END 00008990 + SUBROUTINE JOD(DJ,G,M,JA) 00009980 +C ******************************************* 00009780 +C QUESTO E JODY,INVERSO DEL GIORNO GIULIANO COME SUBROUTINE 00010000 +C Input: DJ +C Output: G: giorno +C M: mese +C JA: anno +C ******************************************* 00009780 + REAL* 8 DJ,ALFA,A,B,G 00009990 + IF(DJ.LE.0.) RETURN 00010010 + DJ=DJ+0.5 00010020 + IZ=INT(DJ) 00010030 + IF(IZ-2299161) 3,5,5 00010040 + 3 A=IZ 00010050 + GO TO 6 00010060 + 5 ALFA= INT((IZ-1867216.25)/36524.25) 00010070 + A=IZ+1+ALFA-INT(ALFA/4.) 00010080 + 6 CONTINUE 00010090 + B=A+1524 00010100 + IC=INT((B-122.1)/365.25) 00010110 + ID=INT(365.25*IC) 00010120 + IE=INT((B-ID)/30.6001) 00010130 + F=DJ-IZ 00010140 + G=B-ID-INT(30.6001*IE)+F 00010150 + IF(IE.LT.13.5)M=IE-1 00010160 + IF(IE.GT.13.5)M=IE-13 00010170 + IF(M.LT.2.5) JA=IC-4715 00010180 + IF(M.GT.2.5) JA=IC-4716 00010190 + DJ=DJ-0.5 00010200 + TYPE*,'JULIAN DAY= ',DJ + TYPE*,'GIORNO= ',G,' MESE= ',M,' ANNO= ',JA + RETURN 00010230 + END 00010240 diff --git a/code/frankie.exe b/code/frankie.exe new file mode 100755 index 0000000..a5e843a Binary files /dev/null and b/code/frankie.exe differ diff --git a/code/frankie.for b/code/frankie.for new file mode 100755 index 0000000..6d42e6a --- /dev/null +++ b/code/frankie.for @@ -0,0 +1,1112 @@ + 00000010 + PROGRAM FRANKIE ! ABBIAMO CREATO UN MOSTRO? 00000020 +C ************************************************************* 00000030 +C 00000040 +C QUESTO PROGRAMMA CALCOLA LE POSIZIONI DEI PIANETI E DELLA LUNA 00000050 +C 00000060 +C COMITATO DI REDAZIONE: 00000070 +C MARCELLO GALLI (GRUPPO 5) 00000080 +C ENRICA BAIADA (GRUPPO 5) 00000090 +C SABINA MENGOLI (GRUPPO 8) 00000100 +C THIS ISSUE: SEPT-OCT 84 LAST REVISION:DEC 84 00000110 +C 00000120 +C SEMBRA UN ESERCIZIO DI MECCANICA CELESTE, MA IN REALTA' IL 00000130 +C SUO UNICO BIECO SCOPO E' QUELLO DI PERMETTERCI DI FARE OROSCOPI,00000140 +C 00000150 +C Non e' colpa nostra se il programma e' venuto lungo e 00000160 +C COMPLICATO! LA TERRA SI AGITA TROPPO PER ESSERE UN COMODO 00000170 +C punto di osservazione. 00000180 +C ************************************************************* 00000190 +C 00000200 + IMPLICIT REAL*8 (A-H,O-Z) 00000210 + CHARACTER*30,NOME 00000220 + INTEGER ANNO 00000230 + INTEGER CASE(10),SEGNI(10) 00000240 + REAL*8 MS,ML,MT,LAMBDA 00000250 + COMMON/MASS/MS,MT,ML,AMS(9),G,PIGREC,UA,EPS,PASSOP, 00000260 + 1 STMP,KRETT 00000270 + DIMENSION X(3,10),F(9),AE(9),XL(3) 00000280 + DIMENSION AME(9) ! ANOMALIA MEDIA 00000290 + DIMENSION BETA(10),LAMBDA(10),ISEGNC(12) 00000300 + DIMENSION CUSP(12),X1(3,10),ALFA(10),DELTA(10) 00000310 + DIMENSION E(6,9) 00000320 + DIMENSION AM(9) 00000330 +C 00000340 +C E sono gli elementi orbitali presi dal file CIBO.DAT preparato 00000350 +C da IGOR.FOR 00000360 +C Gli elementi orbitali usati sono: (la terra e' al primo posto) 00000370 +C inclinazione orbita sull'eclittica 00000380 +C longitudine nodo ascendente (omega piccolo) 00000390 +C longitudine perielio (omega grande) 00000400 +C eccetricita' 00000410 +C Anomalia media all'epoca misurata dal perielio 00000420 +C SEMIASSE MAGGIORE ( A ),IN KM!. ANGOLI CONTATI ORARI DA GAMMA 00000430 +C 00000440 +C AM sono le masse dei pianeti, 00000450 +C MS=massa luna,MS=massa sole,MT=massa terra(le masse sono date in00000460 +C X= posizioni dei pianeti (eliocentriche) 00000470 +C F= anomalia vera dei pianeti 00000480 +C AE=anomalia eccentrica dei pianeti 00000490 +C XL=posizione della luna 00000500 +C CUSP=longituduine eclittica cuspidi delle case 00000510 +C CASE=numero casa dei pianeti 00000520 +C SEGNI=costellazione del pianeta 00000530 +C ISEGNC= segni delle cuspidi delle case 00000540 +C BETA= latitudine eclittica BETL per la luna 00000550 +C LAMBDA= longitudine eclittica ALAMBL per la luna 00000560 +C ALFA=ascensione retta 00000570 +C DELTA=declinazione 00000580 +C X1=coord rettangolari geocentriche pianeti 00000590 +C -------------------------------------------------------- 00000600 + DATA AM/6.0469D24,3.3019D23,4.8693D24, 00000610 + 1 6.4248D23,1.899174D27,5.686399D26, 00000620 + 2 8.6633D25,1.0299D26,1.5913D22/ 00000630 + PIGREC=3.14159265358979323846 00000640 +C costante gravitazionale IN 1000*NEWTON*Km**2/Kg**2 00000650 + G=6.6732D-20 00000660 + UA=149.6D6 00000670 + MS=1.9891D30 00000680 + ML=7.36D22 00000690 + MT=5.9734D24 00000700 + DO 99 I=1,9 00000710 + 99 AMS(I)=AM(I) 00000720 +C 00000730 +C 00000740 +C ------------------------------------------------------------ 00000750 + PASSOP=0.D0 00000760 + STMP=0.D0 00000770 + KRETT=0 00000780 +C -------------------- input da terminale : 00000790 +C 00000800 + 1 CONTINUE 00000810 + TYPE*,' Come ti chiami? (metti il nome fra apici)' 00000820 + ACCEPT*,NOME 00000830 + IF(NOME.NE.'TABELLE') GO TO100 00000840 + TYPE*,' Fornire i parametri di controllo:' 00000850 + TYPE*,' STMP,PASSOP,KRETT' 00000860 + ACCEPT*,STMP,PASSOP,KRETT 00000870 + TYPE*,' LETTI PARAMETRI DI CONTROLLO:',STMP,PASSOP 00000880 + 1 ,KRETT 00000890 + GOTO 1 00000900 + 100 CONTINUE 00000910 + TYPE*,' Quando sei nato? (metti giorno mese anno )' 00000920 + ACCEPT*,GIORNO,MESE,ANNO 00000930 + IF(TESTG(ANNO,MESE,GIORNO).LT.1.D0) GO TO 2 00000940 + TYPE*,' MI HAI DATO UN GIORNO CHE NON ESISTE!' 00000950 + GO TO 1 00000960 + 2 TYPE*,' A che ora? (metti l''ora nella forma: ore.minuti )' 00000970 + TYPE*,' TEMPO UNIVERSALE!' + TYPE*,' (Che e'' quello di Greenwich! BADA A FUSI E ORA LEGALE)' + ACCEPT*,ORA 00000990 + IF(ORA.LE.24.D0) GO TO 101 00001000 + TYPE*,' COME ?' 00001010 + GO TO 2 00001020 + 101 CONTINUE 00001030 + TYPE*,' A che latitudine e longitudine? ' + TYPE*,' LATITUDINE IN GRADI.PRIMI ' + TYPE*,' LONGITUDINE CONTATA VERSO EST! IN ORE.MINUTI' 00001050 + ACCEPT*,ALAT,ALONG 00001060 + TYPE*,'SEMBRA CHE TU SIA:',NOME,' NATO IL:',ANNO,MESE,GIORNO 00001070 + TYPE*,' ALLE ORE:',ORA,' A:',ALAT,ALONG 00001080 +C Intestazioni dei files di output 00001090 + IF(STMP.LE.0.D0) GO TO 102 00001100 + WRITE(2,1000)NOME,ANNO,MESE,GIORNO 00001110 + WRITE(3,1000)NOME,ANNO,MESE,GIORNO 00001120 + WRITE(4,1000)NOME,ANNO,MESE,GIORNO 00001130 + WRITE(11,1000)NOME,ANNO,MESE,GIORNO 00001140 + WRITE(2,2000)ORA,ALAT,ALONG,STMP,PASSOP,KRETT 00001150 + WRITE(3,2000)ORA,ALAT,ALONG,STMP,PASSOP,KRETT 00001160 + WRITE(4,2000)ORA,ALAT,ALONG,STMP,PASSOP,KRETT 00001170 + WRITE(11,2000)ORA,ALAT,ALONG,STMP,PASSOP,KRETT 00001180 + 1000 FORMAT(' NOME:',A30,' DATA:',I5,I5,F10.5) 00001190 + 2000 FORMAT(' ORA: ',F10.5,' LAT:',F10.5,' LONG:',F10.5 00001200 + 1 ,' PARAMETRI INTERNI:',2E12.6,I5) 00001210 + WRITE(11,4000) 00001220 + 4000 FORMAT(/,45X,' DETTAGLI DEL MOTO DEI PIANETI',/) 00001230 + WRITE(2,5000) 00001240 + 5000 FORMAT(/,45X,'ASCENSIONE RETTA IN ORE E MINUTI',/) 00001250 + WRITE(3,6000) 00001260 + 6000 FORMAT(/,45X,'DECLINAZIONE IN GRADI E PRIMI',/) 00001270 + WRITE(4,7000) 00001280 + 7000 FORMAT(/,45X,'COORDINATE GEOCENTRICHE ECLITTICHE', 00001290 + 1 ' LAMBDA,BETA',/) 00001300 + WRITE(2,5500) 00001310 + WRITE(3,5500) 00001320 + WRITE(4,5500) 00001330 + 5500 FORMAT(5X,'DATA:',8X,'SOLE',4X,'MERCURIO',4X,'VENERE',7X, 00001340 + 2 'MARTE',6X,'GIOVE',4X,'SATURNO',5X,'URANO',5X, 00001350 + 3 'NETTUNO',4X,'PLUTONE',4X,'LUNA',/) 00001360 + 102 CONTINUE 00001370 +C ---------------------------------------------------------- 00001380 + TYPE*,' per questa volta ci credo, ora provo a fare i conti.' 00001390 +C Le metto in radianti,come tutti gli angoli nel programma. 00001400 + ALATR=(INT(ALAT)+(ALAT-INT(ALAT))/60.D0*100.D0)/360.D0*2*PIGREC 00001410 + ALONGR=(INT(ALONG)+(ALONG-INT(ALONG))/60.D0*100)/24.D0*2*PIGREC 00001420 +C 00001430 +C --------------------------------------------------------------- 00001440 +C Apertura del file dei dati 00001450 + OPEN(UNIT=99,FILE='CIBO',STATUS='OLD', + 1 ORGANIZATION='INDEXED',ACCESS='KEYED',RECORDTYPE='VARIABLE', 00001470 + 2 FORM='UNFORMATTED',ERR=105,RECL=250,KEY=(1:4:INTEGER)) 00001480 +C Calcolo valore della chiave 00001490 + KIAV=-(GIORNO+MESE*100+ANNO*10000) 00001500 + READ(UNIT=99,KEYGE=KIAV,KEYID=0,ERR=105) 00001510 + 1 KV,TEMPI,((E(J,JJ),J=1,6),JJ=1,9) 00001520 + CLOSE(UNIT=99,DISP='KEEP') 00001530 + CALL JOD(TEMPI,GIOIN,MESIN,IANIN) 00001540 + IF(STMP.LE.0) GO TO 106 00001550 + WRITE(11,7700)TEMPI,GIOIN,MESIN,IANIN, 00001560 + 1 (JJ,(E(J,JJ),J=1,6),JJ=1,9) 00001570 + 7700 FORMAT(' DATI INIZIALI:JD=',E20.15,' DATA:',F6.3,2I5, 00001580 + 1 ' ELEMENTI ORBITALI: (TERRA PRIMO POSTO)',/ 00001590 + 2 ' PIANETA',7X,'I',13X,'OMP',13X,'OMG',14X,'ECC',13X,'ANOM', 00001600 + 3 12X,'A',/,9(/,1X,I5,6E16.7),/) 00001610 + GOTO106 00001620 + 105 TYPE*,' AARGH! HO FAME,HO FAME! NON TROVO IL CIBO.DAT! ARGH'00001630 + TYPE*,' AARGH! DOVE E` IL MIO CIBO? DAMMELO !' 00001640 + STOP 00001650 + 106 CONTINUE 00001660 + DO 20 II=1,9 00001670 + E(1,II)=GRARAD(E(1,II)) 00001680 + E(2,II)=GRARAD(E(2,II)) 00001690 + E(3,II)=GRARAD(E(3,II)) 00001700 + E(5,II)=GRARAD(E(5,II)) 00001710 + 20 CONTINUE 00001720 +C ----------------------------------------------------------------00001730 +C Giorni giuliani interi dal 1900 per il calcolo del tempo sideral00001740 +C e dell'obliquita` eclittica (Meeu00001750 + T1=DJ(ANNO,MESE,GIORNO) 00001760 + T1=(T1-2415020.D0)/36525.D0 00001770 +C Obliquita' dell'eclittica dal Meeus 00001780 + EPS=23.452294-0.0130125*T1-0.00000164*T1**2 00001790 + EPS=GRARAD(EPS) 00001800 +C Longitudine in ore 00001810 + ALONGO=ALONGR/(2.D0*PIGREC)*24.D0 00001820 + ORAD=INT(ORA)+(ORA-INT(ORA))/60.D0*100.D0 00001830 +C ----------------------------------------------------- 00001840 +C tempo siderale finale locale 00001850 +C formule dal libro di Meeus gia citato 00001860 + TS=6.646056D0+2400.051262*T1+0.00002581*T1**2 00001870 + TS=MOD(TS,24.D0) 00001880 + TS=TS+ALONGO+(ORAD)*1.0027379D0 00001890 + TS=MOD(TS,24.D0) 00001900 + IF(STMP.GT.0)WRITE(11,*)' tempo siderale:',TS 00001910 +C tempo siderale in radianti 00001920 + TS=TS/24*2*PIGREC 00001930 +C ----------------------------------------------------------------00001940 + TFIN=DJ(ANNO,MESE,GIORNO) 00001950 + TFIN=TFIN+GIOR(ORA) 00001960 + TINIZ=TEMPI 00001970 +C Metto i tempi in secondi giuliani,per coerenza con G, in S,Kg,Km00001980 + TFIN=TFIN*86400 00001990 + TINIZ=TINIZ*86400 00002000 + TEMPO=TFIN-TINIZ 00002010 +C --------------------------------------------------------------- 00002020 +C intervallo per il calcolo dei pianeti: 36525 giorni.(Fa 1 solo s00002030 + DTP=86400*36525.D0 00002040 +C correggo l'intervallo in modo che alla fine del loop si 00002050 +C arrivi esattamete al tempo finale 00002060 + NT=ABS(TEMPO/DTP) 00002070 + IF(NT.EQ.0) NT=1 00002080 + DTP=TEMPO/NT ! INSERISCE IL RESTO DELLA DIVISIONE 00002090 +C 00002100 +C Input esplicito del passo 00002110 + IF(PASSOP.NE.0) DTP=PASSOP*86400 00002120 +C 00002130 + IF(STMP.GT.0) WRITE(11,7800)TINIZ,TFIN,TEMPO,DTP 00002140 + 7800 FORMAT(' TEMPO INIZIALE:',F15.2,' TEMPO FINALE:',F15.2, 00002150 + 1 ' INTERVALLO:',F15.2,' DTP:',E15.9) 00002160 +C ----------------------------------------------------------------00002170 +C ----------------------------------------------------------------00002180 + T=TINIZ 00002190 + T=T-DTP 00002200 +C 00002210 +C --------------------------------LOOP SU ORBITE IMPERTURBATE-- 00002220 +C ----------------------------------------------------------------00002230 + 51 CONTINUE 00002240 + T=T+DTP 00002250 +C 00002260 +C evoluzione della luna fino al tempo T 00002270 + CALL LUNAS(XL,R,T/86400.D0,ALAMBL,BETL,PIL) 00002280 +C evoluzione imperturbata dei pianeti su ellissi fino al tempo T 00002290 + CALL TEMA(X,F,AE,AME,E,T,TINIZ) 00002300 +C Coordinate eliocentriche della luna: 00002310 + DO 30 J=1,3 00002320 + 30 X(J,10)=XL(J)+X(J,1) 00002330 +C eventuale rettificazione delle orbite 00002340 + IF(KRETT.EQ.0) GOTO49 00002350 + IF(TINIZ.EQ.0) GOTO 49 ! PER IL TEMPO INIZIALE NON RETTIFICA OVVI00002360 + CALL RETT(E,X,F,DTP,AE) 00002370 + TINIZ=T ! OPPURE SI USA N FINALE SEMPRE INVECE CAMBIA E' N(T) 00002380 + DO 48 J=1,9 00002390 + 48 E(5,J)=AME(J)+E(5,J) 00002400 +C 00002410 + 49 CONTINUE 00002420 +C ----------------------------------------------------------- 00002430 +C MANCA CORREZIONE AL BARICENTRO TERRA-LUNA !!!!!!!!!!!!!!! 00002440 +C PARE PICCOLA. 00002450 +C ----------------------------------------------------------- 00002460 + IF(STMP.GT.0)CALL CORDI(T,X,X1,XL,BETA,LAMBDA,ALFA,DELTA,ALAMBL, 00002470 + 1 BETL) 00002480 + 50 CONTINUE 00002490 + IF(T.GE.TFIN.AND.DTP.GE.0.D0.OR.T.LE.TFIN.AND.DTP.LE.0.D0)goto50000002500 + GO TO 51 00002510 + 500 CONTINUE 00002520 +C ----------------------------------------------------------------00002530 +c ********* fine loop sugli intervalli di tempo *** 00002540 +C --------------------------------------------------------------- 00002550 + IF(PASSOP.NE.0) TFIN=T 00002560 + CALL CORDI(TFIN,X,X1,XL,BETA,LAMBDA,ALFA,DELTA,ALAMBL,BETL) 00002570 +C pianeti e luna nei segni 00002580 + DO 80 I=1,10 00002590 + SEGNI(I)=INT(LAMBDA(I)/(2*PIGREC)*12+1) 00002600 + IF(SEGNI(I).EQ.13) SEGNI(I)=12 00002610 + 80 CONTINUE 00002620 +C ------------------------------------------------------- 00002630 +C riporto il tempo da secondi a giorni giuliani 00002640 + TFIN=TFIN/86400. 00002650 +C ------------------------------------------------------- 00002660 +C Calcolo latitudine relativa alle cuspidi delle case 00002670 + CALL DOMI(CUSP,TS,ALATR,ALONGR) 00002680 +C ------------------------------------------------------- 00002690 +C Metto i pianeti nelle case 00002700 +C 00002710 + DO 90 I=1,10 00002720 + DO 95 J=1,12 00002730 + J1=J+1 00002740 + J0=J-1 00002750 + IF(J1.GT.12)J1=1 00002760 + IF(J0.LT.1) J0=12 00002770 + IF(LAMBDA(I).GT.CUSP(J).AND.LAMBDA(I).LT.CUSP(J1))GOTO180 00002780 + IF(CUSP(J).LT.CUSP(J0).AND.LAMBDA(I).LT.CUSP(J))GOTO180 00002790 + 95 CONTINUE 00002800 + CASE(I)=12 00002810 + GO TO 90 00002820 + 180 CASE(I)=J 00002830 + 90 CONTINUE 00002840 + DO 96 I=1,12 00002850 + ISEGNC(I)=CUSP(I)*12/(2.D0*PIGREC)+1 00002860 + IF(ISEGNC(I).GT.12) ISEGNC(I)=12 00002870 + 96 CONTINUE 00002880 +C ------------------------------------------------------- 00002890 +C Stampa del tema natale 00002900 + CALL STAMPAT(SEGNI,LAMBDA,CUSP,CASE,NOME,ALAT,ALONG,TFIN, 00002910 + 1 ISEGNC) 00002920 + STOP 00002930 + END 00002940 + SUBROUTINE CORDI(T,X,X1,XL,BETA,LAMBDA,ALFA,DELTA,ALAMBL,BETL) 00002950 +C ************************************************************* 00002960 +C CALCOLA COORDINATE DI TUTTI I TIPI E FA UNA MAREA DI STAMPE 00002970 +C ************************************************************ 00002980 + IMPLICIT REAL*8 (A-H,O-Z) 00002990 + COMMON/MASS/MS,MT,ML,AMS(9),G,PIGREC,UA,EPS,PASSOP, 00003000 + 1 STMP,KRETT 00003010 + DIMENSION X(3,10),X1(3,10),XL(3),BETA(10),LAMBDA(10) 00003020 + DIMENSION ALFA(10),DELTA(10),BET1(10),ALAM1(10) 00003030 + REAL*8 LAMBDA,MS,MT,ML 00003040 + DIMENSION IGR(10),APR(10),IOR(10),AMINU(10) 00003050 +C 00003060 + T1=T/86400 00003070 + CALL JOD(T1,GIORNO,MESE,IANNO) 00003080 +C 00003090 + IF(STMP.GT.120)WRITE(11,1000)((X(J1,J2),J1=1,3) 00003100 + 1 ,IANNO,MESE,GIORNO ,J2=1,10) 00003110 + 1000 FORMAT(' COORDINATE ELIOCENTRICHE RETTANGOLARI PIANETI', 00003120 + 1 /,(3(1X,E16.10),' DATA:',I6,I5,F6.2)) 00003130 +C -------------------------------------------------------- 00003140 +C calcolo coordinate geocentriche rettangolari dei pianeti 00003150 + DO 60 J=1,3 00003160 + 60 X1(J,1)=-X(J,1) 00003170 + DO 70 I=2,9 00003180 + DO 70 J=1,3 00003190 + 70 X1(J,I)=X(J,I)-X(J,1) 00003200 +C 00003210 +C ------------------------------------------------------- 00003220 +C mette neL vettore coordinate la luna all'ultimo posto 00003230 + X1(1,10)=XL(1) 00003240 + X1(2,10)=XL(2) 00003250 + X1(3,10)=XL(3) 00003260 +C 00003270 + IF(STMP.GT.125)WRITE(11, 2000)((X1(J1,J2),J1=1,3) 00003280 + 1 ,IANNO,MESE,GIORNO,J2=1,10) 00003290 + 2000 FORMAT(' COORDINATE GEOCENTRICHE RETTANGOLARI PIANETI', 00003300 + 1 /,(3(1X,E16.10),' DATA:',I6,I5,F6.2)) 00003310 +C 00003320 +C --------------------------------------------------------- 00003330 +C longitudine eclittica e declinazione pianeti e luna 00003340 + CALL RETTECL(X1,BETA,LAMBDA) 00003350 +C ------------------------------------------------------ 00003360 + DO 72 J=1,10 00003370 + LAMBDA(J)=MOD(LAMBDA(J),2.D0*PIGREC) 00003380 + BETA(J)=MOD(BETA(J),2.D0*PIGREC) 00003390 + BET1(J)=RADGRAD(BETA(J)) 00003400 + ALAM1(J)=RADGRAD(LAMBDA(J)) 00003410 + 72 CONTINUE 00003420 + BET1(10)=RADGRAD(BETL) ! DOVREBBERO AD OGNI MODO ESSERE EGUALI 00003430 + ALAM1(10)=RADGRAD(ALAMBL) 00003440 + IF(STMP.GT.0) 00003450 + 1 WRITE(4,1100) GIORNO,MESE,IANNO,(ALAM1(J),BET1(J),J=1,10) 00003460 + 1100 FORMAT(1X,F5.2,I3,I5,10(1H*,2F5.1)) 00003470 +C ------------------------------------------------------- 00003480 +C ascensione retta e declinazione 00003490 + CALL ECLEQ(EPS,BETA,LAMBDA,ALFA,DELTA) 00003500 +C --------------------------------------------------------- 00003510 + DO 75 J=1,10 00003520 +C ALfa in ore e minuti 00003530 + AAA=ALFA(J)/(2.D0*PIGREC)*24.D0 00003540 + AMINU(J)=(AAA-INT(AAA))*60.D0 00003550 + IOR(J)=INT(AAA) 00003560 +C Delta in gradi e primi 00003570 + AAA=RADGRAD(DELTA(J)) 00003580 + IGR(J)=INT(AAA) 00003590 + APR(J)=(AAA-IGR(J))*60.D0 00003600 + 75 CONTINUE 00003610 +C 00003620 + IF(STMP.GT.0) WRITE(2,4000)GIORNO,MESE,IANNO, 00003630 + 1 (IOR(J),AMINU(J),J=1,10) 00003640 + 4000 FORMAT(1X,F5.2,I3,I5,(10(1H*,I3,1X,F6.2))) 00003650 + IF(STMP.GT.0) WRITE(3,5000)GIORNO,MESE,IANNO, 00003660 + 1 (IGR(J),APR(J),J=1,10) 00003670 + 5000 FORMAT(1X,F5.2,I3,I5,10(1H*,I4,F6.2)) 00003680 + RETURN 00003690 + END 00003700 + SUBROUTINE ANOM(E,MP,MS,G,T,AME,AE,F,T0,PIGREC) 00003710 +C *************************************************** 00003720 +C CALCOLO ANOMALIA DEL PIANETA AL TEMPO T 00003730 +C *************************************************** 00003740 + IMPLICIT REAL*8 (A-H,O-Z) 00003750 + REAL*8MS,MP 00003760 + DIMENSION E(6) 00003770 + ENNE=SQRT(G*(MP+MS))/SQRT(E(6))**3 00003780 + AME=ENNE*(T-T0)+E(5) 00003790 + AE=AME 00003800 + N=0 00003810 + AMEG=RADGRAD(AE) 00003820 + 90 AE1=AME+E(4)*SIN(AE) 00003830 + IF(ABS(AE1-AE).LT.1.E-10) GO TO80 00003840 + AE=AE1 00003850 + N=N+1 00003860 + IF(N.GT.100) GOTO 80 00003870 + GO TO 90 00003880 + 80 CONTINUE 00003890 + AMEG1=RADGRAD(AE) 00003900 + W=SQRT((1+E(4))/(1-E(4)))*TAN(AE/2) 00003910 + F=ATAN(W)*2 00003920 +C marchingegno per cacciare nel giusto quadrante la 00003930 +C arcotangente che mette fra 90 e - 90 00003940 + FXP=ABS(F-AE) 00003950 + IF(FXP.GT.PIGREC/2.AND.FXP.LT.PIGREC*3.D0/2)F=F+PIGREC 00003960 + F=MOD(F,2.D0*PIGREC) 00003970 + RETURN 00003980 + END 00003990 + SUBROUTINE TEMA(X,F,AE,AME,E,T,T0) 00004000 +C **************************************************** 00004010 +C EVOLUZIONE DEI PIANETI SU ORBITE IMPERTURBATE 00004020 +C **************************************************** 00004030 + IMPLICIT REAL*8 (A-H,O-Z) 00004040 + REAL*8 MS,MT,ML 00004050 + COMMON/MASS/MS,MT,ML,AM(9),G,PIGREC,UA,EPS,PASSOP, 00004060 + 1 STMP,KRETT 00004070 + DIMENSION X(3,9),F(9),AE(9),E(6,9) 00004080 + DIMENSION ANM(3,9),AME(9) 00004090 + CALL JOD(T/86400.D0,GIORNO,MESE,IANNO) 00004100 +C 00004110 + TYPE*,' MUOVO I PIANETI !',' DATA:',GIORNO,MESE,IANNO 00004120 +C 00004130 + DO 10 I=1,9 00004140 +C IF(STMP.GT.100.D0)WRITE(11,1000)I,T,T0,GIORNO,MESE,IANNO 00004150 +C1000 FORMAT(' PIANETA',I5,' TFINALE:',E20.10,' TINIZIAL:',E20.10,00004160 +C 1 ' DATA: ',F6.2,2I5) 00004170 +C calcolo anomalia vera e raggio vettore 00004180 + CALL ANOM(E(1,I),AM(I),MS,G,T,AME(I),AE(I),F(I),T0,PIGREC) 00004190 + R=E(6,I)*(1-E(4,I)*COS(AE(I))) 00004200 +C calcolo coordinate eliocentriche rettangolari eclittiche 00004210 + CALL NODECL(E(1,I),X(1,I),R*COS(E(2,I)+F(I)),R*SIN(E(2,I)+F(I)) 00004220 + 1 ,0.D0) 00004230 + 10 CONTINUE 00004240 + IF(STMP.LE.50.D0) GOTO100 00004250 + DO 20 I=1,9 00004260 + ANM(1,I)=RADGRAD(AME(I)) 00004270 + ANM(2,I)=RADGRAD(AE(I)) 00004280 + ANM(3,I)=RADGRAD(F(I)) 00004290 + 20 CONTINUE 00004300 + IF(STMP.GT.0) WRITE(11,3000) 00004310 + 1 ((IANNO,MESE,GIORNO,JJ,(ANM(J,JJ),J=1,3)),JJ=1,9) 00004320 + 3000 FORMAT(' DATA:',I5,I5,F6.2,' PIANETA:',I5,' ANOMALIA MEDIA:'00004330 + 1 ,F8.3,' ANOMALIA ECCENTRICA:',F8.3,' VERA:',F8.3) 00004340 + 100 CONTINUE 00004350 + RETURN 00004360 + END 00004370 + SUBROUTINE LUNAS(XL,R,TT,ALAMBD,BET,PI) 00004380 +C **************************************************** 00004390 +C MOTO DELLA LUNA CON LE FORMULE PRESE DAL LIBRO DI 00004400 +C MEEUS - ASTRONOMICAL FORMULAE FOR CALCULATORS 00004410 +C **************************************************** 00004420 + IMPLICIT REAL*8 (A-H,O-Z) 00004430 + REAL*8 M,M1,L1 00004440 + DIMENSION XL(3) 00004450 + T=(TT-2415020D0)/36525.D0 00004460 +C Tempo in secoli giuliani da 0.5 GENN 1900 00004470 +C TERMINI SVILUPPI PERTURBATIVI 00004480 + T2=T*T 00004490 + L1=270.434164+481267.8831*T-0.001133*T2 00004500 + M=358.475833+35999.0498*T-0.00015*T2 00004510 + M1=296.104608+477198.8491*T+0.009192*T2 00004520 + D=350.737486+445267.1142*T-0.001436*T2 00004530 + F=11.250889+483202.0251*T-0.003211*T2 00004540 + E=1-0.002495*T-0.00000752*T2 00004550 + E2=E*E 00004560 + L1=MOD(L1,360.D0) 00004570 + M=MOD(M,360.D0) 00004580 + M1=MOD(M1,360.D0) 00004590 + D=MOD(D,360.D0) 00004600 + F=MOD(F,360.D0) 00004610 +C 00004620 +C 00004630 +C TYPE*,'L1,M.M1,D,F,T,E,T2',L1,M,M1,D,F,T,E,T2 00004640 + M=GRARAD(M) 00004650 + M1=GRARAD(M1) 00004660 + D=GRARAD(D) 00004670 + F=GRARAD(F) 00004680 +C Longitudine eclittica 00004690 + AL=E2*(0.002249*SIN(2*D-2*M)-0.002079*SIN(2*M)+ 00004700 + 1 0.002059*SIN(2*D-M1-2*M)+0.000717*SIN(M1-2*M) + 00004710 + 2 0.000704*SIN(M1-2*M-2*D) ) 00004720 + AL=AL+E*(-0.185596*SIN(M)+0.057212*SIN(2*D-M-M1)+ 00004730 + 2 0.045874*SIN(2*D-M)+0.041024*SIN(M1-M)- 00004740 + 3 0.030465*SIN(M+M1)-0.007910*SIN(M-M1+2*D)- 00004750 + 4 0.006783*SIN(2*D+M)+0.005*SIN(M+D)+ 00004760 + 5 0.004049*SIN(M1-M+2*D)+0.002695*SIN(2*M1-M)+ 00004770 + 6 0.002396*SIN(2*D-M-2*M1)-0.002125*SIN(2*M1+M)+ 00004780 + 7 0.00122*SIN(4*D-M-M1)-0.000811*SIN(M+M1+2*D)+ 00004790 + 8 0.000761*SIN(4*D-M-2*M1)+0.000693*SIN(M-2*M1+2*D)+ 00004800 + 9 0.000598*SIN(2*D-M-2*F)+0.000521*SIN(4*D-M) ) 00004810 + AL=AL+L1+6.28875*SIN(M1)+1.274018*SIN(2*D-M1)+0.658309*SIN(2*d)+ 00004820 + 1 0.213616*SIN(2*M1)-0.114336*SIN(2*F)+ 00004830 + 2 0.058793*SIN(2*D-2*M1)+0.053320*SIN(2*D+M1)- 00004840 + 3 0.034718*SIN(D)+0.015326*SIN(2*D-2*F)-0.012528*SIN(2*F+M1)-00004850 + 4 0.01098*SIN(2*F-M1)+0.010674*SIN(4*D-M1)+0.010034*SIN(3*M1)+00004860 + 5 0.008548*SIN(4*D-2*M1)+0.005162*SIN(M1-D)+ 00004870 + 6 0.003996*SIN(2*M1+2*D)+0.003862*SIN(4*D)+ 00004880 + 7 0.003665*SIN(2*D-3*M1)+0.002602*SIN(M1-2*F-2*D)- 00004890 + 8 0.002349*SIN(M1+D)-0.001773*SIN(M1+2*D-2*F)- 00004900 + 9 0.001595*SIN(2*F+2*D)-0.00111*SIN(2*M1+2*F)+ 00004910 + A 0.000892*SIN(M1-3*D)+0.00055*SIN(M1+4*D)+ 00004920 + B 0.000538*SIN(4*M1)+0.000486*SIN(2*M1-D) 00004930 +C Latitidine eclitt00004940 + B=E2*0.000306*SIN(2*D-2*M-F) 00004950 + B=B+E*(0.008247*SIN(2*D-M-F)+0.003372*SIN(F-M-2*D)+ 00004960 + 1 0.002472*SIN(2*D+F-M-M1)+0.002222*SIN(2*D+F-M)+ 00004970 + 2 0.002072*SIN(2*D-F-M-M1)+0.001877*SIN(F-M+M1)- 00004980 + 3 0.001803*SIN(F+M)+ 00004990 + 4 0.00157*SIN(M1-M-F)-0.001481*SIN(F+M+M1)+ 00005000 + 5 0.001417*SIN(F-M-M1)+0.00135*SIN(F-M)+ 00005010 + 6 0.000492*SIN(2*D+M1-M-F)-0.000367*SIN(M+F+2*D-M1)- 00005020 + 7 0.000353*SIN(M+F+2*D)+0.000317*SIN(2*D+F-M+M1) ) 00005030 + B=B+5.128189*SIN(F)+0.280606*SIN(M1+F)+0.277693*SIN(M1-F)+ 00005040 + 1 0.173238*SIN(2*D-F)+0.055413*SIN(2*D+F-M1)+ 00005050 + 2 0.046272*SIN(2*D-F-M1)+0.032573*SIN(2*D+F)+ 00005060 + 3 0.017198*SIN(2*M1+F)+0.009267*SIN(2*D+M1-F)+ 00005070 + 4 0.008823*SIN(2*M1-F)+0.004323*SIN(2*D-F-2*M1)+ 00005080 + 5 0.0042*SIN(2*D+F+M1)+0.001828*SIN(4*D-F-M1)- 00005090 + 6 0.00175*SIN(3*F)-0.001487*SIN(F+D)+0.00133*SIN(F-D)+ 00005100 + 7 0.001106*SIN(F+3*M1)+0.00102*SIN(4*D-F)+ 00005110 + 8 0.000833*SIN(F+4*D-M1)+0.000781*SIN(M1-3*F)+ 00005120 + 9 0.00067*SIN(F+4*D-2*M1)+0.000606*SIN(2*D-3*F)+ 00005130 + A 0.000597*SIN(2*D+2*M1-F)+0.00045*SIN(2*M1-F-2*D)+ 00005140 + B 0.000439*SIN(3*M1-F)+0.000423*SIN(F+2*D+2*M1)+ 00005150 + C 0.000422*SIN(2*D-F-3*M1)+0.000331*SIN(F+4*D)- 00005160 + D 0.000283*SIN(M1+3*F) 00005170 +C 00005180 + PI=E2*0.000026*COS(2*D-2*M) 00005190 + PI=PI+E*(0.000533*COS(2*D-M)+0.000401*COS(2*D-M-M1)+ 00005200 + 1 0.000320*COS(M1-M)-0.000264*COS(M+M1)-0.000111*COS(M)- 00005210 + 2 0.000083*COS(2*D+M)+0.000064*COS(2*D-M+M1)- 00005220 + 2 0.000063*COS(2*D+M-M1)+ 00005230 + 3 0.000041*COS(M+D)+0.000035*COS(2*M1-M)- 00005240 + 4 0.000029*COS(2*M1+M)+0.000019*COS(4*D-M-M1) ) 00005250 + PI=PI+0.9507240+0.051818*COS(M1)+0.009531*COS(2*D-M1)+ 00005260 + 1 0.007843*COS(2*D)+0.002824*COS(2*M1)+ 00005270 + 2 0.000857*COS(2*D+M1)-0.000271*COS(D)- 00005280 + 3 0.000198*COS(2*F-M1)+0.000173*COS(3*M1)+ 00005290 + 4 0.000167*COS(4*D-M1)+0.000103*COS(4*D-2*M1)- 00005300 + 5 0.000084*COS(2*M1-2*D)+0.000079*COS(2*D+2*M1)+ 00005310 + 6 0.000072*COS(4*D)-0.000033*COS(3*M1-2*D)- 00005320 + 7 0.00003*COS(M1+D)-0.000029*COS(2*F-2*D)- 00005330 + 8 0.000023*COS(2*F-2*D+M1) 00005340 +C 00005350 + PI=GRARAD(PI) 00005360 + BET=GRARAD(B) 00005370 + ALAMBD=GRARAD(AL) 00005380 +C 00005390 +C Raggio vettore 00005400 + R=6378.14/SIN(PI) 00005410 +C 00005420 +C Coordinate Rettangolari Geocentriche Eclittiche 00005430 + XL(1)=R*COS(BET)*COS(ALAMBD) 00005440 + XL(2)=R*COS(BET)*SIN(ALAMBD) 00005450 + XL(3)=R*SIN(BET) 00005460 +C 00005470 + RETURN 00005480 + END 00005490 + SUBROUTINE RETT(E,X,F,DT,AE) 00005500 +C *********************************************************** 00005510 +C FA UNO STEP DELLA SOLUZIONE COL METODO DI TAYLOR DELLE 00005520 +C EQUAZIONI DI LAGRANGE NELLA FORMA DI GAUSS 00005530 +C ********************************************************* 00005540 + IMPLICIT REAL*8 (A-H,O-Z) 00005550 + COMMON/MASS/AMS,AMT,AML,AM(9),G,PIGREC,UA,EPS,PASSOP, 00005560 + 1 STMP,KRETT 00005570 + DIMENSION F(9),S(3),FOR(3),E(6,9),X(3,9),AE(9) 00005580 +C E=elementi orbitali 00005590 +C X=posizioni dei pianeti 00005600 +C AMS=massa del sole 00005610 +C AM=masse pianeti 00005620 +C F=anomalie vere dei pianeti 00005630 +C G=costante gravitazionale 00005640 +C FOR=forza perturbante nel sistema eclittico 00005650 +C S=coordinate della forza perturbante nel piano orbitale 00005660 +C AE=anomalia eccentrica 00005670 +C --------------------------------------------------------------- 00005680 + TYPE*,' RETTIFICO UN POCO DI ORBITE,NON SI SA MAI', 00005690 + 1 ' CHE TORNI BUONO' 00005700 +C loop sui pianeti ---------------------------------------------- 00005710 + DO 10 I=1,9 00005720 +C calcolo forza perturbante 00005730 + FOR(1)=0. 00005740 + FOR(2)=0. 00005750 + FOR(3)=0. 00005760 + DO 20 II=1,9 00005770 +C salto il pianeta stesso,che non si autoperturba 00005780 + IF(II.EQ.I) GOTO 20 00005790 + RI3=(SQRT(X(1,II)**2+X(2,II)**2+X(3,II)**2))**3 00005800 + RRI3=(SQRT((X(1,I)-X(1,II))**2+(X(2,I)-X(2,II))**2+ 00005810 + 1 (X(3,I)-X(3,II))**2))**3 00005820 + DO 30 IJ=1,3 00005830 + 30 FOR(IJ)=FOR(IJ)-G*AM(II)*((X(IJ,I)-X(IJ,II))/RRI3+X(IJ,II)/RI3) 00005840 +C IF(STMP.GT.150) WRITE(11,*)'FORZA PERTURBANTE SUL PIANETA:00005850 +C 1 FOR,'COMPRESO IL PIANETA:',II 00005860 + 20 CONTINUE 00005870 +C ------------------------------------------------------------- 00005880 +C conversione a coordinate sul piano orbitale 00005890 + CALL ECLNOD(E(1,I),F(I),S,FOR) 00005900 + IF(STMP.GT.150.D0) WRITE(11,1000) S,I,DT 00005910 + 1000 FORMAT(' FORZA PERTURBANTE TOTALE SU PIANO ORBITA ',3E15.7, 00005920 + 1 ' PIANETA:',I3,' TEMPO:',E12.6) 00005930 +C ------------------------------------------------------------ 00005940 +C calcolo pezzi formule successive 00005950 + AMI=G*(AMS+AM(I)) 00005960 + ENNE=SQRT(AMI)/SQRT(E(6,I))**3 00005970 + SINF=SIN(F(I)) 00005980 + COSF=COS(F(I)) 00005990 + R=SQRT(X(1,I)**2+X(2,I)**2+X(3,I)**2) 00006000 + P=E(6,I)*(1-E(4,I)**2) 00006010 + COSU=COS(E(2,I)+F(I)) 00006020 + SINU=SIN(E(2,I)+F(I)) 00006030 + UNME=SQRT(1-E(4,I)**2) 00006040 + SIN2I2=SIN(E(1,I)/2)**2 00006050 + A2=E(6,I)**2 00006060 +C --------------------------------------------------------- 00006070 +C calcolo DA 00006080 + DADT=2./(ENNE*UNME)*(S(1)*E(4,I)*SINF+P*S(2)/R) 00006090 + DA=DADT*DT 00006100 +C calcolo DE 00006110 + DE=(UNME/(ENNE*E(6,I))*(S(1)*SINF+S(2)*(COS(AE(I))+COSF)))*DT 00006120 +C calcolo DI 00006130 + DI=(S(3)*R*COSU/(ENNE*A2*UNME))*DT 00006140 +C calcolo OG 00006150 + IF(E(1,I).NE.0.D0) THEN 00006160 + DOGDT=(S(3)*R*SINU/(ENNE*A2*UNME*SIN(E(1,I)))) 00006170 + ELSE 00006180 + DOGDT=0.D0 00006190 + END IF 00006200 + DOG=DOGDT*DT 00006210 +C calcolo DOS 00006220 + DOSDT=UNME/(ENNE*E(6,I)*E(4,I))* 00006230 + 1 (-S(1)*COSF+S(2)*(1+R/P)*SINF)+2*DOGDT*SIN2I2 00006240 + DOS=DOSDT*DT 00006250 +C calcolo DEP 00006260 + DEPDT=DOSDT*E(4,I)**2/(1+UNME)+2*DOGDT*UNME*SIN2I2-2*R*S(1)/ 00006270 + 1 (ENNE*A2) 00006280 + DEP=DEPDT*DT 00006290 +C ------------------------------------------------------------ 00006300 +C calcolo DOP 00006310 + DOP=DOS-DOG 00006320 +C ----------------------------------------------------------- 00006330 +C correggo gli elementi dell'orbita 00006340 + E(1,I)=E(1,I)+DI 00006350 + E(2,I)=E(2,I)+DOP 00006360 + E(3,I)=E(3,I)+DOG 00006370 + E(4,I)=E(4,I)+DE 00006380 + E(5,I)=DEP 00006390 + E(6,I)=E(6,I)+DA 00006400 + IF(STMP.LE.0.D0) GOTO10 00006410 + DIS1=RADGRAD(DI) 00006420 + DOPS1=RADGRAD(DOP) 00006430 + DOGS1=RADGRAD(DOG) 00006440 + DELLE1=RADGRAD(DEP) 00006450 + IF(STMP.GT.0) WRITE(11,6000) 00006460 + 1 DIS1,DOPS1,DOGS1,DE,DELLE1,DA 00006470 + 6000 FORMAT(' CORREZIONI A:DI,DOP,DOG,DE,DELLE,DA',8E15.5) 00006480 + 10 CONTINUE 00006490 + RETURN 00006500 + END 00006510 + SUBROUTINE DOMI(CUSPL,T,LAT,LONG) 00006520 +C ******************************************************* 00006530 +C CALCOLA LA LONGITUDINE ECLITTICA DELLE CUSPIDI 00006540 +C DELLE 12 CASE. 00006550 +C Sembra che questo metodo sia quello di un certo monaco 00006560 +C Placido , risalente al 1650 circa. Costui, individuati 00006570 +C ascendente e discendente (intersezioni fra eclittica 00006580 +C ed orizzonte) e medium ed imum coeli ( intersezioni 00006590 +C fra meridiano del luogo ed eclittica ); 00006600 +C divide in tre parti gli archi delimitati 00006610 +C sull'equatore dai meridiani di questi 4 punti 00006620 +C Individua cosi' sull'equatore 12 punti i cui meridiani 00006630 +C tagliano a fette l'eclittica; le fette sono le case. 00006640 +C Oltre questo modo di calcolare le case ne esistono 00006650 +C altri 4 o 5, ovviamente piu' semplici, ma questo va 00006660 +C di moda fra gli astrologi perche' loro mica fanno i 00006670 +C conti; vanno a vedere sulle tavole e un certo Rafael 00006680 +C calcola tavole molto diffuse con questo sistema. 00006690 +C Forse non ci abbiamo preso a riprodurre il metodo di 00006700 +C Placido (cosa estremamente probabile visto che lo 00006710 +C abbiamo dedotto da libri di astrologia e come noto 00006720 +C gli astrologi moderni per lo piu' non sanno contare) 00006730 +C In questo caso abbiamo inventato un metodo nuovo, 00006740 +C la cui verita' assoluta sara' affermata in base ad 00006750 +C argomenti inoppugnabili basati sulla scienza, la 00006760 +C cabala, un po' di numerologia, sedute spiritiche ed 00006770 +C altro,come di prassi. 00006780 +C --------------------------------------------------------- 00006790 + IMPLICIT REAL*8 (A-H,O-Z) 00006800 + COMMON/MASS/MS,MT,ML,AMS(9),G,PIGREC,UA,EPS,PASSOP, 00006810 + 1 STMP,KRETT 00006820 + DIMENSION CUSPL(12),A(3,3),B(3,3),C(3,3),MC(3),IC(3) 00006830 + DIMENSION ASC(3),DISC(3),CUSP(3,12) 00006840 + DIMENSION V(3),VV(3),ANGOL(12) 00006850 + REAL*8 MC,IC,LAT,LONG,MS,MT,ML 00006860 + TYPE*,' LE CASE, LE CASE! DOMIFICO!' 00006870 +C trasformazione con cui 00006880 +C metto asse x nel primo verticale (rotazione sul piano equatorial00006890 + COST=COS(T) 00006900 + SINT=SIN(T) 00006910 + B(1,1)=COST 00006920 + B(1,2)=SINT 00006930 + B(1,3)=0.D0 00006940 + B(2,1)=-SINT 00006950 + B(2,2)=COST 00006960 + B(2,3)=0.D0 00006970 + B(3,1)=0.D0 00006980 + B(3,2)=0.D0 00006990 + B(3,3)=1.D0 00007000 +C definisco medium coeli. Nel sistema dell'equatore, con l'asse x 00007010 +C lungo il meridiano del luogo, si tratta del vettore 1,0,0 . 00007020 +C Lo ruoto nell'equatore in modo da avere x lungo gamma applicando00007030 +C la traformazione inversa di B. 00007040 +C SI PUO' FARE ANCHE COME TRASFORMAZIONE DI ANGOLO DA COORDINATE 00007050 +C ALTAZIMUTALI IN ECLITTICHE! 00007060 + MC(1)=1.D0 00007070 + MC(2)=0.D0 00007080 + MC(3)=0.D0 00007090 + CALL trasf(ic,b) 00007100 +C L'imum coeli e' all'oppsto del medium coeli (riflessione del vet00007110 + IC(1)=-MC(1) 00007120 + IC(2)=-MC(2) 00007130 + IC(3)=-MC(3) 00007140 + TS=T-PIGREC/2. 00007150 +C Definisco l'ascendente con la risoluzione di un pasticciato 00007160 +C TRAINGOLO SFERICO. SPERIAMO DI AVERCI PRESO QUESTA VOLTA! 00007170 + TG=TAN(LAT) 00007180 + IF(TG.GT.0.D0) THEN 00007190 + ALM=ATAN2(SIN(TS), 00007200 + 1 COS(TS)*COS(EPS)+SIN(EPS)/TG ) 00007210 + ELSE 00007220 + ALM=0.D0 00007230 + ENDIF 00007240 + ALF=ATAN2(COS(EPS)*SIN(ALM),-COS(ALM)) 00007250 + ASC(1)=COS(ALF) 00007260 + ASC(2)=SIN(ALF) 00007270 + ASC(3)=0.0 00007280 +C WRITE(6,1000)ALF,ASC(1),ASC(2),ASC(3) 00007290 + 1000 FORMAT(' COEFF, ASC;',4E20.10) 00007300 +C definisco il discendente come riflesso dell'ascendente (a 180gra00007310 + DISC(1)=-ASC(1) 00007320 + DISC(2)=-ASC(2) 00007330 + DISC(3)=-ASC(3) 00007340 +C definisco l'angolo fra ascendente e punto gamma 00007350 + V(1)=1.D0 00007360 + V(2)=0.D0 00007370 + V(3)=0.D0 00007380 + THET=ANGOLO(V,ASC) 00007390 + IF(ASC(2).GT.0) THET=2*PIGREC-THET 00007400 +C WRITE(6,*)'THET',RADGRAD(THET) 00007410 + ANGOL(1)=THET 00007420 + D1=ANGOLO(IC,ASC)/3.D0 00007430 +C WRITE(6,*)'D1 D1 D1 D1',RADGRAD(D1) 00007440 + ANGOL(2)=ANGOL(1)+D1 00007450 + ANGOL(3)=ANGOL(2)+D1 00007460 + ANGOL(4)=ANGOL(3)+D1 00007470 + D1=ANGOLO(IC,DISC)/3.D0 00007480 +C WRITE(6,*)'D1 D1 D1 D1',RADGRAD(D1) 00007490 + ANGOL(5)=ANGOL(4)+D1 00007500 + ANGOL(6)=ANGOL(5)+D1 00007510 + ANGOL(7)=ANGOL(6)+D1 00007520 + D1=ANGOLO(MC,DISC)/3.D0 00007530 +C WRITE(6,*)'D1 D1 D1 D1',RADGRAD(D1) 00007540 + ANGOL(8)=ANGOL(7)+D1 00007550 + ANGOL(9)=ANGOL(8)+D1 00007560 + ANGOL(10)=ANGOL(9)+D1 00007570 + D1=ANGOLO(MC,ASC)/3.D0 00007580 +C WRITE(6,*)'D1 D1 D1 D1',RADGRAD(D1) 00007590 + ANGOL(11)=ANGOL(10)+D1 00007600 + ANGOL(12)=ANGOL(11)+D1 00007610 +C trasformazione degli angoli da equatoriale ad eclittico. 00007620 + COSE=COS(EPS) 00007630 + DO 40 I=1,12 00007640 + CUSPL(I)=ATAN2(COSE*SIN(ANGOL(I)),COS(ANGOL(I))) 00007650 + F1112=RADGRAD(CUSPL(I)) 00007660 + IF (CUSPL(I).LT.0) CUSPL(I)=CUSPL(I)+2.D0*PIGREC 00007670 + F1113=RADGRAD(CUSPL(I)) 00007680 + 40 CONTINUE 00007690 + RETURN 00007700 + END 00007710 + SUBROUTINE STAMPAT(SEGNI,LONG,CUSPIDI,CASE,NOME,ALAT,ALONG,T, 00007720 + 1 ISEGNC) 00007730 +C ******************************************************** 00007740 +C STAMPA DEL TEMA NATALE 00007750 +C ******************************************************* 00007760 + IMPLICIT REAL*8 (A-H,O-Z) 00007770 + CHARACTER*80 GLUMESS(3) 00007780 + DIMENSION SEGNI(10),CASE(10),CUSPIDI(12),LONG(10) 00007790 + DIMENSION ISEGNC(12) ! SEGNI DELLE CUSPIDI 00007800 + REAL*8 LONG 00007810 + CHARACTER*30,NOME 00007820 + CHARACTER*10,ZODIAC(12),PIANET(10) 00007830 + INTEGER SEGNI,CASE 00007840 + DATA PIANET/' SOLE ','MERCURIO ','VENERE ', 00007850 + 1 'MARTE ','GIOVE ','SATURNO ','URANO ', 00007860 + 2 'NETTUNO ','PLUTONE ','LUNA '/ 00007870 + DATA ZODIAC/'ARIETE ','TORO ','GEMELLI ', 00007880 + 1 'CANCRO ','LEONE ','VERGINE ','BILANCIA ', 00007890 + 2 'SCORPIONE ','SAGITTARIO','CAPRICORNO','ACQUARIO ', 00007900 + 3 'PESCI '/ 00007910 + WRITE(1,*) ' ' + WRITE(1,*) ' Oroscopo offerto dalla: ' + WRITE(1,*) ' FRANKENSTEIN BUILDING CORPORATION ' + WRITE(1,*) ' BOLOGNA-ITALY ' + WRITE(1,*) ' ' + WRITE(1,*)'?????????????????????????????????????????????' 00007920 + WRITE(1,*)' TEMA NATALE DI :',NOME 00007930 + CALL JOD(T,G,M,JA) 00007940 + WRITE(1,*)' NATO IL :',G,M,JA 00007950 + WRITE(1,*)' ALLA LATITUDINE:',ALAT 00007960 + WRITE(1,*)' ALLA LONGITUDINE:',ALONG 00007970 + WRITE(1,*)'?????????????????????????????????????????????' 00007980 +C stampe delle modalita' di uso 00007990 + OPEN(UNIT=98,FILE='GLUKIE',STATUS='OLD' + 1 ,ORGANIZATION='INDEXED',ACCESS='KEYED', 00008010 + 2 RECORDTYPE='VARIABLE',FORM='UNFORMATTED', 00008020 + 3 KEY=(1:4:INTEGER)) 00008030 + DO 30 KIAV=10201,10215 00008040 + READ(UNIT=98,KEYEQ=KIAV) KIAI,GLUMESS 00008050 + WRITE(1,*) GLUMESS 00008060 + 30 CONTINUE 00008070 + WRITE(1,*)' PIANETI NEI SEGNI:' 00008080 + DO 10 I=1,10 00008090 + WRITE(1,*)' ',PIANET(I),' IN ',ZODIAC(SEGNI(I)), 00008100 + 1 ' Long:',RADGRAD(LONG(I)) 00008110 + 10 CONTINUE 00008120 + WRITE(1,*) ' PIANETI NELLA CASE:' 00008130 + DO 20 I=1,10 00008140 + WRITE(1,*)' ',PIANET(I),' IN CASA:',CASE(I) 00008150 + 20 CONTINUE 00008160 + WRITE(1,*)' POSIZIONI DELLE CUSPIDI DELLE 12 CASE ' 00008170 + WRITE(1,*)' La prima cuspide e'' l''Ascendente,' + WRITE(1,*)' la quarta l''Imum Coeli, la settima il Discendente' + WRITE(1,*)' la decima il Medium Coeli.' + WRITE(1,1000) (J,RADGRAD(CUSPIDI(J)), 00008180 + 1 ZODIAC(ISEGNC(J)),J=1,12) 00008190 + 1000 FORMAT( ' CUSPIDE DELLA ',I5,' CASA IN:',F10.5,' SEGNO:',A10) 00008200 + WRITE(1,*)' FINE DEL TEMA NATALE...................... ' 00008210 + WRITE(1,*)' UN CUPO DESTINO SI PROFILA ALL''ORIZZONTE?' 00008220 + WRITE(1,*)' STAI PER COLLASSARE A BUCO NERO?' 00008230 + WRITE(1,*)' PIOVERA'' DOMANI O VEDRAI STELLE ?' 00008240 + WRITE(1,*)' ESPLOSIONI DI SUPERNOVAE ALL''ORIZZONTE?' 00008250 + WRITE(1,*)' MILLE INTERROGATIVI CI ASSILLANO.' 00008260 + WRITE(1,*)' LA RISPOSTA LA TROVERAI NELLA PARTE INTERPRETATIVA.' 00008270 + WRITE(1,*)'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$' 00008280 + WRITE(1,1500) 00008290 + 1500 FORMAT(////,' PARTE INTERPRETATIVA: (AUGURI!!!!!!)',///,1x, 00008300 + 1 80(1H$),//) 00008310 +C Stampa del responso 00008320 +C Lettura del sole 00008330 + DO 40 I=1,3 00008340 + ICHIAV=I*10000+100+SEGNI(1) 00008350 + READ(UNIT=98,KEYEQ=ICHIAV,ERR=555) KIAI,GLUMESS 00008360 + WRITE(1,*) GLUMESS 00008370 + 40 CONTINUE 00008380 +C Lettura dei pianeti nei segni e nelle case 00008390 + DO 50 K=1,10 00008400 + ICHIAV=40000+K*100+SEGNI(K) 00008410 + READ(UNIT=98,KEYEQ=ICHIAV,ERR=555) KIAI,GLUMESS 00008420 + WRITE(1,*) GLUMESS 00008430 + 50 CONTINUE 00008440 +C Pianeti nelle case 00008450 + DO 52 K=1,10 00008460 + ICHIAV=50000+K*100+CASE(K) 00008470 + READ(UNIT=98,KEYEQ=ICHIAV,ERR=555) KIAI,GLUMESS 00008480 + WRITE(1,*) GLUMESS 00008490 + 52 CONTINUE 00008500 +C LETTURA CASE NEI SEGNI 00008510 + DO 60 J=1,12 00008520 + ICHIAV=60000+J*100+ISEGNC(J) 00008530 + READ(UNIT=98,KEYEQ=ICHIAV,ERR=555) KIAI,GLUMESS 00008540 + WRITE(1,*) GLUMESS 00008550 + 60 CONTINUE 00008560 + CLOSE(UNIT=98,DISP='KEEP') 00008570 + RETURN 00008580 + 555 WRITE(1,5555) 00008590 +C 5555 FORMAT(' CI SPIACE MA IL SUO DESTINO E'' MANCHEVOLE MANCANDO00008600 +C 1 un MESSAGGIO INTERPRETATIVO') 00008610 + 5555 FORMAT( ' L''oroscopo e'' finito!') + GO TO 60 00008620 + END 00008630 + FUNCTION ANGOLO(X,Y) 00008640 +C ************************************** 00008650 +C CALCOLA L'ANGOLO FRA I VETTORI X ED Y 00008660 +C ****************************************** 00008670 + IMPLICIT REAL*8 (A-H,O-Z) 00008680 + DIMENSION X(3),Y(3) 00008690 + BSX=SQRT(X(1)**2+X(2)**2+X(3)**2) 00008700 + BSY=SQRT(Y(1)**2+Y(2)**2+Y(3)**2) 00008710 + SCAL=X(1)*Y(1)+X(2)*Y(2)+X(3)*Y(3) 00008720 + ANGOLO=ACOS(SCAL/(BSX*BSY)) 00008730 + RETURN 00008740 + END 00008750 + FUNCTION DJ(Y,M,D) 00008760 +C ******************************************* +C Giorno giuliano +C ******************************************* + REAL*8 C,D,DJ,A,B,G 00008770 + INTEGER*4 Y 00008780 + C=Y+M*1.E-2+D*1.E-4 00008790 +C CALCOLO DELLA CORREZIONE DI GREGORIO 00008800 + B=0 00008810 + IF(C.LE.1582.1015) GOTO 100 00008820 + A=INT(Y/100.) 00008830 + B=2-A+INT(A/4.) 00008840 + 100 CONTINUE 00008850 + IF(M.LE.2)THEN 00008860 + MY=Y-1 00008870 + MM=M+12 00008880 + ELSE 00008890 + MY=Y 00008900 + MM=M 00008910 + END IF 00008920 + CONTINUE 00008930 + G=0. 00008940 + IF(C.LT.0.) G=.75 00008950 + DJ=INT(365.25*MY-G)+INT(30.6*(MM+1))+D+1720994.5+B 00008960 +C TYPE*,'GIORNO= ',D,' MESE= ',M,' ANNO= ',Y,' DJ=',DJ 00008970 + RETURN 00008980 + END 00008990 + SUBROUTINE ECLEQ(EPS,BETA,LAMBDA,ALFA,DELTA) 00009000 +C ****************************************************** 00009010 +C DA COORDINATE ECLITTICHE AD ASCENSIONE RETTA E DECLINAZIONE 00009020 +C ************************************************************ 00009030 + IMPLICIT REAL*8 (A-H,O-Z) 00009040 + DATA PIGREC/3.14159265358979323846/ 00009050 + REAL*8 BETA(10),LAMBDA(10),ALFA(10),DELTA(10) 00009060 + COSE=COS(EPS) 00009070 + SINE=SIN(EPS) 00009080 + DO 10 I=1,10 00009090 + SINB=SIN(BETA(I)) 00009100 + COSB=COS(BETA(I)) 00009110 + SINL=SIN(LAMBDA(I)) 00009120 + COSL=COS(LAMBDA(I)) 00009130 + DELTA(I)=ASIN(SINB*COSE+COSB*SINE*SINL) 00009140 + ALFA(I)=ATAN2(-SINB*SINE+COSB*COSE*SINL,COSB*COSL) 00009150 +C Lo conto antiorario da 0 a 360 00009160 + IF(ALFA(I).LT.0) ALFA(I)=ALFA(I)+2*PIGREC 00009170 + 10 CONTINUE 00009180 + RETURN 00009190 + END 00009200 + SUBROUTINE ECLNOD(E,F,S,X) 00009210 +C ****************************************************************00009220 +C TRASFORMO DA COORDINATE ECLITTICHE RETTANGOLARI A COORDINATE 00009230 +C SUL PIANO ORBITALE, CON X LUNGO IL RAGGIO VETTORE 00009240 +C ****************************************************************00009250 +C QUESTA SUBROUTINE FA PARTE DEL PROGRAMMA DEGLI OROSCOPI 00009260 +C !!!!! LA PARTE PIU' NUMEROSA DEL COMITATO DI REDAZIONE ESPRIME 00009270 +C la sua perplessita' a riguardo della sottoindicata trasformazion00009280 +C di coordinate. Formulando un severo monito onde simili ghirigori00009290 +C non abbiano a ripetersi, declina ogni responsabilita' presente 00009300 +C e futura, non ritenendosi responsabile degli smarrimenti di 00009310 +C COORDINATE CHE SEGUIRANNO. !!!!!!!!! 00009320 + IMPLICIT REAL*8 (A-H,O-Z) 00009330 + DIMENSION A(3,3),X(3),S(3),E(6) 00009340 + SINOF=SIN(E(2)+F) 00009350 + COSOF=COS(E(2)+F) 00009360 + SINOG=SIN(E(3)) 00009370 + COSOG=COS(E(3)) 00009380 + SINI=SIN(E(1)) 00009390 + COSI=COS(E(1)) 00009400 +C TYPE*,'SINOF,COSOF,SINOG,COSOG,SINI,COSI' 00009410 +C TYPE*,SINOF,COSOF,SINOG,COSOG,SINI,COSI 00009420 + A(1,1)=COSOF*COSOG-SINOF*SINOG*COSI 00009430 + A(1,2)=COSOF*SINOG+SINOF*COSOG*COSI 00009440 + A(1,3)=SINOF*SINI 00009450 + A(2,1)=-SINOF*COSOG-COSOF*SINOG*COSI 00009460 + A(2,2)=-SINOF*SINOG+COSOF*COSOG*COSI 00009470 + A(2,3)=COSOF*SINI 00009480 + A(3,1)=+SINOG*SINI 00009490 + A(3,2)=-COSOG*SINI 00009500 + A(3,3)=COSI 00009510 +C TYPE*,'A=',A 00009520 +C --------------------------------------------------------- 00009530 + DO 10 I=1,3 00009540 + S(I)=0. 00009550 + DO 10 J=1,3 00009560 + 10 S(I)=S(I)+A(I,J)*X(J) 00009570 + RETURN 00009580 + END 00009590 + FUNCTION GIOR(ORA) 00009600 +C ******************************************************* 00009610 +C CONVERTE ORE IN FRAZIONI DI GIORNO 00009620 +C ! ORE ESPRESSE IN ORE,MINUTI 00009630 +C ******************************************************** 00009640 + REAL*8 GIOR,ORA,A 00009650 + A=INT(ORA) 00009660 + GIOR=(A+(ORA-A)/60*100)/24 00009670 + RETURN 00009680 + END 00009690 + FUNCTION GRARAD(G) 00009700 +C ******************************************* 00009780 +C SERVE PER CONVERTIRE I GRADI IN RADIANTI 00009710 +C ATTENZIONE! I GRADI DEVONO ESSERE COI DECIMALI 00009720 +C ******************************************* 00009780 + REAL*8 GRARAD,G 00009730 + GRARAD=G/180.D0*3.14159265358979323D0 00009740 + RETURN 00009750 + END 00009760 + SUBROUTINE TRASF(X,A) 00009770 +C ******************************************* 00009780 +C TRASFORMA X COLLA MATRICE A 00009790 +C ************************************************ 00009800 + IMPLICIT REAL*8 (A-H,O-Z) 00009810 + DIMENSION Y(3),X(3),A(3,3) 00009820 + DO 10 I=1,3 00009830 + Y(I)=0.D0 00009840 + DO 10 J=1,3 00009850 + 10 Y(I)=A(I,J)*X(J)+Y(I) 00009860 + GO TO 100 00009870 + ENTRY INV(X,A) 00009880 + DO 20 I=1,3 00009890 + Y(I)=0.D0 00009900 + DO 20 J=1,3 00009910 + 20 Y(I)=A(J,I)*X(J)+Y(I) 00009920 + 100 CONTINUE 00009930 + DO 30 I=1,3 00009940 + 30 X(I)=Y(I) 00009950 + RETURN 00009960 + END 00009970 + SUBROUTINE JOD(DJ,G,M,JA) 00009980 +C ******************************************* 00009780 +C QUESTO E JODY,INVERSO DEL GIORNO GIULIANO COME SUBROUTINE 00010000 +C ******************************************* 00009780 + REAL* 8 DJ,ALFA,A,B,G 00009990 + IF(DJ.LE.0.) RETURN 00010010 + DJ=DJ+0.5 00010020 + IZ=INT(DJ) 00010030 + IF(IZ-2299161) 3,5,5 00010040 + 3 A=IZ 00010050 + GO TO 6 00010060 + 5 ALFA= INT((IZ-1867216.25)/36524.25) 00010070 + A=IZ+1+ALFA-INT(ALFA/4.) 00010080 + 6 CONTINUE 00010090 + B=A+1524 00010100 + IC=INT((B-122.1)/365.25) 00010110 + ID=INT(365.25*IC) 00010120 + IE=INT((B-ID)/30.6001) 00010130 + F=DJ-IZ 00010140 + G=B-ID-INT(30.6001*IE)+F 00010150 + IF(IE.LT.13.5)M=IE-1 00010160 + IF(IE.GT.13.5)M=IE-13 00010170 + IF(M.LT.2.5) JA=IC-4715 00010180 + IF(M.GT.2.5) JA=IC-4716 00010190 + DJ=DJ-0.5 00010200 +C TYPE*,'JULIAN DAY= ',DJ 00010210 +C TYPE*,'GIORNO= ',G,' MESE= ',M,' ANNO= ',JA 00010220 + RETURN 00010230 + END 00010240 + SUBROUTINE NODECL(E,XX,X,Y,Z) 00010250 +C ********************************************************** 00010260 +C MUTA VETTORE NELLE COORDINATE DEL PIANO DELL'ORBITA IN 00010270 +C COORDINATE SUL PIANO DELL'ECLITTICA 00010280 +C ********************************************************** 00010290 +C SUBROUTINE FACENTE PARTE DEL PROGRAMMA DEGLI OROSCOPI 00010300 + IMPLICIT REAL*8(A-H,O-Z) 00010310 + DIMENSION E(6),XX(3) 00010320 +C ---------------------------------------------------- 00010330 + COSOG=COS(E(3)) 00010340 + SINOG=SIN(E(3)) 00010350 + COSI=COS(E(1)) 00010360 + SINI=SIN(E(1)) 00010370 +C TYPE*,'NODECL:COSOG,SINOG,COSI,SINI' 00010380 +C TYPE*,COSOG,SINOG,COSI,SINI 00010390 + XX(1)=X*COSOG-Y*SINOG*COSI+Z*SINOG*SINI 00010400 + XX(2)=X*SINOG+Y*COSOG*COSI-COSOG*SINI*Z 00010410 + XX(3)=Y*SINI+Z*COSI 00010420 + RETURN 00010430 + END 00010440 + FUNCTION RADGRAD(R) 00010450 +C ******************************************* 00009780 +C SERVE PER CONVERTIRE I RADFIANTI IN GRADI 00010460 +C ATTENZIONE! FORNISCE I GRADI CON I DECIMALI 00010470 +C ******************************************* 00009780 + REAL*8 RADGRAD,R 00010480 + RADGRAD=R*180.D0/3.14159265358979323D0 00010490 + RETURN 00010500 + END 00010510 + SUBROUTINE RETTECL(X,BETA,ALAMBD) 00010520 +C ****************************************** 00010530 +C DA COORDINATE RETTANGOLARI ECLITTICHE (X LUNGO GAMMA) 00010540 +C A BETA E LAMBDA , COORDINATE ECLITTICHE 00010550 +C **************************************************** 00010560 + IMPLICIT REAL*8(A-H,O-Z) 00010570 + DATA PIGREC/3.14159265358979323846/ 00010580 + DIMENSION X(3,10),BETA(10),ALAMBD(10) 00010590 + DO 10 I=1,10 00010600 + ALAMBD(I)=ATAN2(X(2,I),X(1,I)) 00010610 + BETA(I)=ASIN(X(3,I)/SQRT(X(1,I)**2+X(2,I)**2+X(3,I)**2)) 00010620 +C Lo conto antiorario dal gamma da 0 a 360 00010630 + IF(ALAMBD(I).LT.0) ALAMBD(I)=ALAMBD(I)+2*PIGREC 00010640 + 10 CONTINUE 00010650 + RETURN 00010660 + END 00010670 + FUNCTION TESTG(Y,M,D) 00010680 +C ******************************************* 00009780 +C SERVE PER ELIMINARE LE DATE CHE NON ESISTONO 00010710 +C ******************************************* 00009780 + IMPLICIT REAL*8 (A-H,O-Z) 00010690 + INTEGER Y 00010700 + DIMENSION MESE(12) 00010720 + DATA MESE/31,29,31,30,31,30,31,31,30,31,30,31/ 00010730 + IF(D.LT.0.OR.M.LT.0.OR.M.GT.12) GOTO 200 00010740 + C=Y+M*1.E-2+D*1.E-4 00010750 +C GIORNI UCCISI DA GREGORIO 00010760 + IF((C.GE.1582.1005).AND.(C.LE.1582.1014)) GOTO 200 00010770 +C MESE DI TROPPI DI' 00010780 + IF(MESE(M).LT.D) GOTO 200 00010790 +C BISESTILE INESISTENTE 00010800 + IF(INT(Y/4.)-Y/4..NE.0.AND.M.EQ.2.AND.D.GT.28) GOTO 200 00010810 + IF(Y/400.-INT(Y/400.).NE.0.AND.M.EQ.2.AND.D.GT.28.AND. 00010820 + 1 Y.GT.1582) GOTO 200 00010830 + TESTG=0. 00010840 + RETURN 00010850 + 200 TESTG=1. 00010860 + RETURN 00010870 + END 00010880 +C 00010890 + diff --git a/code/fraugluk.exe b/code/fraugluk.exe new file mode 100755 index 0000000..d482629 Binary files /dev/null and b/code/fraugluk.exe differ diff --git a/code/fraugluk.for b/code/fraugluk.for new file mode 100755 index 0000000..a7584e8 --- /dev/null +++ b/code/fraugluk.for @@ -0,0 +1,104 @@ + PROGRAM FRAUGLUK 00000010 +C CREA IL MAGAZZINO DELLE INTERPRETAZIONI PER FRANKIE 00000020 + CHARACTER *80 PAROLE(3) 00000030 +C 00000040 + OPEN(UNIT=98,FILE='GLUKIE',STATUS='UNKNOWN',ORGANIZATION= + A 'INDEXED',ACCESS='KEYED',RECORDTYPE='VARIABLE',FORM= 00000060 + A 'UNFORMATTED',RECL=247,KEY=(1:4:INTEGER)) 00000070 + 10 CONTINUE 00000080 + TYPE*,'SCEGLI UNA DELLE SEGUENTI OPZIONI' 00000090 + TYPE*,'FORNIRE I DATI = 1' 00000100 + TYPE*,'LEGGERE UN DATO = 2' 00000110 + TYPE*,'CORREGGERE UN DATO = 3' 00000120 + TYPE*,'USCIRE = 4' 00000130 + TYPE*,'ISTRUZIONE SULLE CHIAVI = 5' 00000140 + TYPE*,' LEGGE TUTTO SU FOR001.DAT =6' 00000150 + TYPE*,' LEGGE IL FILE SEQUENZIALE GLUK.DAT,CREA GLUKIE.DAT=7' 00000151 +C + ACCEPT*,K 00000170 + IF(K.EQ.1) GOTO 100 00000180 + IF(K.EQ.2)GOTO 200 00000190 + IF(K.EQ.3)GOTO 300 00000200 + IF(K.EQ.4)GOTO 400 00000210 + IF(K.EQ.5) GOTO 500 00000220 + IF(K.EQ.6) GO TO 600 00000230 + IF(K.EQ.7) GO TO 700 00000231 + GOTO 10 00000240 + 00000250 + 100 CONTINUE 00000260 + TYPE*,'DARE LA CHIAVE ED IL MESSAGGIO,FRA APICI!' 00000270 + ACCEPT *,KIAV 00000280 + ACCEPT *,PAROLE 00000290 + WRITE(98,ERR=1000) KIAV,(PAROLE(I),I=1,3) 00000300 + 15 CONTINUE 00000310 + GOTO 10 00000320 + 00000330 + 200 CONTINUE 00000340 + TYPE*,'DARE LA CHIAVE' 00000350 + ACCEPT*,KIAV 00000360 + READ (UNIT=98,KEYEQ=KIAV,ERR=1000)KIAV,PAROLE 00000370 + TYPE*,KIAV,PAROLE 00000380 + GOTO 10 00000390 + 00000400 + 300 CONTINUE 00000410 + TYPE*,'DARE LA CHIAVE' 00000420 + ACCEPT*,KIAV 00000430 + READ (UNIT=98,KEYEQ=KIAV,ERR=1000) KIAV,PAROLE 00000440 + TYPE*,KIAV 00000450 + TYPE *,PAROLE 00000460 + TYPE*,'PER ELIMINARE IL RECORD SCRIVERE 1' 00000470 + TYPE*,'PER CORREGGERE IL RECORD SCRIVERE 2' 00000480 + ACCEPT*,I 00000490 + IF(I.EQ.1)THEN 00000500 + DELETE (98) 00000510 + GOTO 10 00000520 + ELSE IF(I.EQ.2)THEN 00000530 + TYPE*,'DAMMI IL NUOVO MESSAGGIO FRA APICI!!!' 00000540 + ACCEPT*,PAROLE 00000550 + REWRITE(98,ERR=1000) KIAV,PAROLE 00000560 + ELSE 00000570 + GOTO 300 00000580 + ENDIF 00000590 + GOTO 10 00000600 + 00000610 + 400 CONTINUE 00000620 + CLOSE (UNIT=98,DISP='KEEP') 00000630 + STOP 00000640 + 00000650 + 500 CONTINUE 00000660 + TYPE*,' STRUTTURA DELLE CHIAVI' 00000670 + TYPE*,' LA PRIMA CIFRA SIGNIFICA: 1,2,3= SOLE NEI SEGNI' + TYPE*,' 4= PIANETI NEI SEGNI; 5=PIANETI NELLE CASE;' + TYPE*,' 6=CASE NEI SEGNI' + TYPE*,' 7= OPPOSIZIONI; 8=QUADRATURE; 9=TRIGONI.' 00000 + TYPE*,' LA SECONDA E TERZA CIFRA SIGNIFICANO QUALE PIANETA (O' + TYPE*,' CASA) STIAMO CONSIDERANDO; LE ULTIME DUE IN QUALE SEGNO' + TYPE*,' SI TROVI IL PIANETA,O IN QUALE CASA,O CON CHI ALTRI SIA' + TYPE*,' IN CONGIUNZIONE,OPPOSIZIONE,ETC.' + TYPE*,' DA 10201 IN POI PRAESCRIPTIONES ' 00000750 + TYPE*, ' ' 00000760 + GOTO 10 00000770 + 1000 TYPE*,'ERRORE!' 00000780 + GOTO 10 00000790 + 1001 TYPE*,'ERRORE! sto leggendo gluk.dat!' + GOTO 10 00000790 + 1002 TYPE*,'ERRORE! sto scrivendo gluk.dat!' + GOTO 10 00000790 + 1003 TYPE*,'ERRORE!' 00000780 + GOTO 10 00000790 + 600 READ(98,END=10) KIAV,PAROLE 00000800 + WRITE(1,2000) KIAV,PAROLE 00000810 + 2000 FORMAT(I20,/,(1X,A80)) 00000820 + GOTO600 00000830 + 700 CONTINUE 00000831 + OPEN(UNIT=99,FILE='GLUK',STATUS='OLD') + 70 READ(99,3100,END=10) KIAV + READ(99,3101,ERR=1001) PAROLE(1) + READ(99,3101,ERR=1001) PAROLE(2) + READ(99,3101,ERR=1001) PAROLE(3) + 3100 FORMAT(I20) + 3101 FORMAT(1X,A80) + TYPE *,KIAV + WRITE(98,ERR=1002) KIAV,(PAROLE(I),I=1,3) + GO TO 70 00000839 + END 00000840 diff --git a/code/gluk.dat b/code/gluk.dat new file mode 100755 index 0000000..5c25807 --- /dev/null +++ b/code/gluk.dat @@ -0,0 +1,932 @@ + 10101 + SOLE IN ARIETE: siete irruenti,aggressivi,istintivi,virili,amanti del rischio, + ma anche poco riflessivi ed incapaci di concentrazione,evitate quindi di pic- + chiare quelli piu" grossi di voi e soprattutto non aggredite in impeti di pas- + 10102 + SOLE IN TORO: siete persone in equilibrio STATICO,non amate i rischi,non avete + grosse ambizioni,cercate solo la sicurezza di una CASA (ecco perche" tanti i + suicidi tra i nati sotto questo segno);desiderate solo l"amore di una donna,ma + 10103 + SOLE IN GEMELLI: oltre la SPICCATA INTELLIGENZA la caratteristica predominante + dei nati sotto questo segno e" il senso dell"umorismo che spesso ne fa degli + OTTIMI POLITICI.Se non diventano politici e" perche" hanno una grande capacita" + 10104 + SOLE IN CANCRO: questo segno E" DONNA.E"l"estate che nasce tra i campi di gra- + no dorati dal sole,e"una ninfea che si schiude nel primo mattino,e"un micio + piccolo con cui giocare,e"una notte rischiarata dalla luna,e"una stella che + 10105 + SOLE IN LEONE: RRRRRROOOARRR! Siete dei gretti materialisti: risalendo ai + tempi della preistoria (alto Paleolitico) non avete avuto segni di evoluzione + interiore (ne"esteriore).Avete un"assoluta incapacita" di sublimazione: ecco + 10106 + SOLE IN VERGINE:Il GRANDE ASTROLOGO dice che siete freddi,aridi,pignoli,pun- + tigliosi,ossessivi,affetti da moralismo e conservatorismo;dice che in amore + siete puritani,e caldi quanto l"elio liquido.Dice anche che fate la doccia + 10107 + SOLE IN BILANCIA: inizia l"autunno:cadono le foglie,cadono i governi.La natura + ha terminato il suo ciclo evolutivo ed ora,incerta sul da farsi,si concede una + pausa.E come la natura anche voi siete incerti:passerete lunghe ore nel dilemma + 10108 + SOLE IN SCORPIONE: una delle creature piu" dolci e sensibili dell"universo in- + tero simboleggia il vostro segno:infatti voi assomigliate molto allo scorpione. + In questa stagione in cui la vegetazione muore,putrefacendosi lentamente,vengo- + 10109 + SOLE IN SAGITTARIO: la vostra duplice natura (meta" umana e meta" equina) fa + di voi individui piuttosto complessi.Difficilmenmte infatti riuscite ad essere + persone complete:rinunciate percio" fin da ora sia a vincere il premio Nobel + 10110 + SOLE IN CAPRICORNO: aridi,indifferenti,cupi,pessimisti,spietatamente razionali + non vi concedete ne"debolezze ne"nostalgie.La diffidenza,la mancanza di illu- + sioni,il freddo distacco da ogni umana passione domineranno la vostra vita af- + 10111 + SOLE IN ACQUARIO: Audaci e pronti ai cambiamenti (di qualsiasi colore),sono + portati alla carriera politica e finanziaria,esprimendo cosi` appieno la loro + personalita` permeata al massimo grado di opportunismo,slealta` e tendenza al + 10112 + SOLE IN PESCI: vivete in un mondo indefinito, impregnato di irrazionalita` e + misticismo, non a caso il vostro segno e` legato alla leggenda di Derceto che + gettatasi in mare per sottrarsi alla realta` venne trasformata in sirena,cioe` + 10201 + + + CAVE! + 10202 + Legere praescriptiones et modalitates antequam necare auctores + + PRAESCRIPTIONES + 10203 + Si credidis scriptis,sine me dicere,te stupidissimum esse.Tamen oro + et obsecro ut iracundi,permelosissimi,irritabiles et similes ab hoc + programma se abstineant. Praeterea se abstineant a legendo sequentia + 10204 + Lycei Gymnasique magistri,peritissimique consecutionis temporum,qui + credere non possunt latinum grossum aptissimum cazzatibus esse. + + 10205 + + QUOMODO OROSCOPUM TUUM LEGAS + + 10206 + Oculis,quia auribus vel pedibus legere fere impossibile. + Pars prima exponit planetarum positiones in signis zodiaci.Aedem positiones + planetarum ORRIDA PRAECISIONE COMPUTANTUR,tamen Auctores adfirmant hoc + 10207 + NIHIL DETRAHERE PROFESSIONALI DEMENTIALITATI RESPONSI. + Pars prima exponit etiam (sectio secunda) planetarum positiones in coelestis + aedibus et aedium cuspides in signis (sectio tertia). + 10208 + + Aedes vario modo calculantur:Auctores clarissimorum methodorum sunt + Campanus,Morinius,Albitius,Marcellinus Placidus,Zaril,Regiomontanus, + 10209 + Porphiriu. Praeferimus Marcellini Placidi methodum,quia optimum. + Placidus fuit monachus, qui vixit XVII saeculo.Is,inventis + ascendentibus,descendentibusque(quae sunt itersectiones inter + 10210 + eclipticam et horizontem)et medio imoque coelo(qua sunt intersec- + tiones inter loci meridianum et eclipticam),dividit in tres partes + omnes arcus aequinotialis circuli inter duos praedictorum punctorum. + 10211 + Itaque invenit 12 puncta,quorum meridiani eclipticam secant: + quaelibet pars aedes est. + Modi reliqui (Campani,Morini,etc.) simpliciores,sed astrologi Placidi + 10212 + methodum praeferunt, quia ei non amant computare: utuntur tabulis, et + Raphael quidam collegit hoc modo communissimas tabulas. + + 10213 + FORTASSE NOSTRA INTERPRETATIO PLACIDI METHODI INCORREPTA EST (hoc maxime + probabile,quia illum deduximus a libris astrologorum, et hodie notum + est astrologi nesciunt computare). HAC IN RE INVENIMUS NOVUM MODUM, + 10214 + MARCELLINI-PLACIDI (Marcellinus est auctor,iuvenis et pulcher,dulcisque + amicus,in primis suavis puellis). VERITAS ABSOLUTA METHODI AFFIRMATUR + VALENTISSIMIS ARGUMENTIS FUNDATIS IN SCIENTIA,IN NUMEROLOGIA,IN SESSIONIBUS + 10215 + SPIRITICIS ET CETERA, UT SOLITUM EST. + VALE ET NOS AMA + + 20101 + sione la vostra vicina di casa di 94 anni scambiata per la Cicciolina poiche" + c"e" la possibilita" che lei si innamori perdutamente di voi facendovi precipi- + tare dal vostro ottimismo abituale ad uno stato di profonda depressione,consi- + 20102 + non avete ancora capito,nella vostra inaudita possessivita",che conservare un + partner non significa rinchiuderlo nel freezer,anche perche"poi,prima di usar- + lo bisogna scongelarlo.Avete la tendenza ad ingrassare SMISURATAMENTE perche" + 20103 + di immediata comunicazione con gli altri,motivo per cui non vengono mai assun- + ti presso le PATRIE POSTE.Vivaci,curiosi,un poco superficiali,rimangono sempre + dei grandi bambinoni.Ecco perche" hanno bisogno di un TIMONIERE che li guidi + 20104 + esplode.E"il vento che gonfia le vele,sono gli spruzzi d"acqua salmastra sul + viso,e" un cuore con mille segreti da carpire,e" l"essenza selvaggia della na- + tura e della vita in contiunuo divenire.(Firmato Enrica 2Luglio/Sabina 5Luglio) + 20105 + perche"i vostri desideri passano sempre per uno stato fuso prima di diventare + gas(nervino).Smettetela di usare la clava nell"era delle guerre stellari: VA- + PORIZZARE il nemico e" piu" pulito e definitivo che spiaccicarlo al muro!!! + 20106 + tutti i mercoledi",dimostrazione che tenete molto all"igiene,alla pulizia per- + sonale ed alla salute,che dovete riguardare soffrendo voi di disturbi psicoso- + matici e neurovegetativi.Amando una vita programmata rivolgetevi ad un buon + 20107 + se sia piu" saggio mettere per prima la scarpa destra o la sinistra.Comunque + dotati di grande capacita" affettiva (99 mc) e troppo disponibili alle solleci- + tazioni di rapporti sempre nuovi,riuscite a coltivare contemporaneamente molte + 20108 + no a galla le vostre profonde turbe esistenziali che possono portarvi ad essere + distruttivi ed autodistruttivi.Ma che,se placate da un tenero sentimento,vi + condurranno sulla giusta via della ricostruzione (per ulteriori informazioni + 20109 + che il Derby di trotto.Nel contrasto che sussiste in voi tra l"animalesco e lo + spirituale riuscite completamente privi di chiarezza di idee:dormite indiffe- + rentemente sia in un letto Luigi XV che in una stalla;mangiate le ostriche con + 20110 + fettiva.Il passato per voi non puo` esistere,come non esiste il futuro e,a vol- + te,neppure il presente:evitate percio` di cercare nel calendario la vostra data + di nascita.Potrebbe non esistere,e per l"umanita`sarebbe un bene.Non si direbbe + 20111 + compromesso.Saturno in aspetti armonici favorisce invece l"evolversi di un"in- + dividualita` mistica e austera,desiderosa dell"assoluto,tesa verso alti ideali + di fratellanza fino alla fusione totale del proprio IO con l"intero universo. + 20112 + ne` carne ne` pesce.Il caos psicologico e` quindi l`essenza della vostra vita. + Infantili,suscettibili,incoerenti,sognatori,lamentosi,vittimisti,avete paura + di assumervi una qualsivoglia responsabilita`,come quella di prendere in mo- + 30101 + derato soprattutto il fatto che non siete portati ai legami lunghi e duraturi. + Consiglio agli uomini di trasferirsi nel Borneo a fare i cacciatori di teste e + alle donne di evitare gli uomini,tanto sono solo dei piantagrane. + 30102 + amate la buona tavola.Nel lavoro siete fedeli almeno quanto Lassie.Siete lenti + pratici e non molto acuti,ecco perche":IL VOSTRO MESTIERE E"FARE IL RAGIONIE- + RE.ALLE DONNE: L"essere troppo domestiche vi trasformera"in lavastoviglie. + 30103 + e li educhi alla vita.I piu"consigliati sono i timonieri del cancro che con + la loro pazienza e perseveranza ottengono sempre ottimi risultati.Personaggi + celebri nati sotto questo segno: MOTLEY,il cane delle macchine volanti. + 30104 + Gli uomini del Cancro amano molto la MAMMA:prendono il latte fino ai 7 anni, + camminano ai 10,parlano ai 18,finiscono le elementari ai 45,ai 60 vanno in di- + scoteca e agli 85 pensano sia l"ora di mettere su casa,ma ormai e"troppo tardi. + 30105 + Personaggi celebri nati sotto il segno del Leone: Napoleone Bonaparte.Consigli + ai nati sotto il segno del Leone: EVITATE I VIAGGI IN RUSSIA,soprattutto se + con tappe invernali in quel di Leningrado: comunque mettete la maglia di lana. + 30106 + softwarista.In mancanza di questi dovendo voi regolare minuziosamente il flusso + della vita per semplificarvi i calcoli ve ne diamo la formula:flusso=quantita" + di vita divisa per la superficie nell"unita" di tempo,ovvero: VIT/(cm**2*sec). + 30107 + relazioni (di origine varia o sconosciuta).Ma la vostra cronica incapacita" di + prendere qualsiasi decisione non vi condurra" mai all"altare,con indubbi van- + taggi per la religione,per il comune senso del pudore e per i vostri partner. + 30108 + rivolgersi al sig.Zamberletti,tel.06/3131).Personaggi celebri nati sotto que- + sto segno: Attila,Gengis Khan,JR.Consigli privati:quando siete in teneri atteg- + giamenti con il vostro diletto partner (gemelli) evitate i colpi di coda. + 30109 + l"avena e nitrite baciando una bionda fanciulla.Celebrita" di questo segno:Fu- + ria cavallo del West,il Cavallo di Troia,la trisnonna di mio cugino Temistocle. + Le donne di questo segno sono famose per le gambe piu"sexy dello Zoodiaco. + 30110 + ma amate la solitudine:quella che nasce dalla strage.Morti famosi sotto questo + segno:Himmler,Goering,Hitler,Hess,Goebbles,Von Ribbentrop,Streicher,Kappler. + Consiglio ai nati sotto questo segno: SUICIDATEVI! + 30111 + A questi poveri illusi consigliamo di dedicarsi alla meditazione trascendenta- + le,all"Hata Yoga,alla dottrina Zen,al buddismo,all"induismo tibetano.Personag- + gi celebri nati sotto questo segno:Noe`,l"idraulico e Deucalione di Tessaglia. + 30112 + glie la dolce e tenera fanciulla che da tanto tempo vi consola nello spirito e + nel corpo col suo amore sublime,puro e paziente (ma non ancora per molto!!!), + perdonandovi anche le insane e bieche passioni che nutrite per Carmen Russo. + 40101 + + + PIANETI NEI SEGNI. ( OVVERO IL DESTINO INCOMBE ) + 40102 + + PIANETI NEI SEGNI (LE VOSTRE DISGRAZIE INFELICI) + + 40103 + + PIANETI NEI SEGNI ( SI SPERA ) + + 40104 + PIANETI NEI SEGNI DEL CIELO + + + 40105 + + PIANETS IN SIGNARUM ( ENGLISH GROSSUM + + 40106 + + PIANETI NEI SEGNI + + 40107 + + PIANETI NEI SEGNI ASTRALI + + 40108 + + PIANETI NEI SEGNI ( MEANING OF YOUR LIFE) + + 40109 + + PIANETI NEI SEGNI + + 40110 + + PIANETI NEI SEGNI + + 40111 + + PIANETI NEI SEGNI ( CORAGGIO!) + + 40112 + + PIANETI NEI SEGNI ASTRALI E MISTERIOSI + + 40201 + Mercurio in Ariete- dovreste tenere piu` spesso la bocca chiusa:non rischiere- + ste cosi` di fare indigestione di mosche,zanzare e insetti in genere,soprat- + tutto non rischiereste un lungo conto dal dentista. + 40202 + Mercurio in Toro- Hermes con voi non e` stato molto generoso:anzi,vi ha del + tutto ignorato.L"unica cosa che vi ha dato e` un"elasticita` mentale simile + all"elasticita` della struttura del carbonio puro in forma tetraedrica. + 40203 + Mercurio in Gemelli- intelligenti e astuti,avete anche grande capacita` di as- + similazione e concentrazione. Ricordate pero` che con le vostre critiche spie- + tate potreste trasformarvi da commissari politici in uomini-a-mare. + 40204 + Mercurio in Cancro- avete un genietto dalla vostra che vi procurera` intelli- + genza,immaginazione e creativita`.Attenti pero` a non perderlo o maltrattarlo + perche` potrebbe riprendersi tutto e andarsene senza mai piu`farsi rivedere. + 40205 + Mercurio in Leone- siete allegri,ottimisti e a volte anche responsabili.La lo- + gica,l"intuito e l"astuzia potrebbeero fare di voi dei grandi capi:purtroppo + tutti i posti sono gia` occupati per l"eternita` e voi resterete disoccupati. + 40206 + Mercurio in Vergine- consiglio:compratevi la Treccani e imparatevela a memoria + cosicche` il vostro senso ipercritico potra`poi sbizzarrirsi.E noi,intanto che + ve la studiate,finalmente troveremo un po" di pace. + 40207 + Mercurio in Bilancia- siete equilibrati,tolleranti,comprensivi,rigorosi nelle + valutazioni,soppesate tutto prima di giudicare.Rispettate i compromessi e sie- + te avversi alle liti.Cura:arrabbiatevi o finirete dallo psicanalista. + 40208 + Mercurio in Scorpione- intelligenti,combattivi,tenaci,diabolici,creativi,cru- + deli,umoristici,sospettosi,vendicativi,diffidenti,provocatori,amate l"equivoco + ed il pericolo e non accettate sconfitte.Ragazzi,siete come James Bond. + 40209 + Mercurio in Sagittario- la fatina dai capelli turchini ha colpito ancora.Vi ha + dotato di un"intelligenza diligente,ingenua e sprovveduta e c"e` il rischio che + come Pinocchio vi facciate imbrogliare dal primo Geppetto che arriva. + 40210 + Mercurio in Capricorno- sapete sempre qual"e` la vostra meta e con pazienza, + perseveranza e calcolo la raggiungerete perche` voi siete i piu` duri,i piu` + forti,i piu` grandi,meglio di Burt Reynolds in "Quella sporca ultima meta". + 40211 + Mercurio in Acquario- siete curiosi,originali,anticonvenzionali,eccentrici,a- + vete anche un certo talento scientifico che se giustamente indirizzato potrebbe + fare di voi degli inventori di fama,come Archimede(quello di Topolino). + 40212 + Mercurio in Pesci- siete sensibili,intuitivi,ma avete quasi sempre le idee + troppo confuse per perndere decisioni rapide ed efficaci,soprattutto verso la + persona che piu` vi sta a cuore.Vi siete forse illusi di trovare di meglio? + 40301 + Venere in Ariete-gli uomini sono soggetti a colpi di fulmine.Consiglio:non + soffermatevi sotto gli alberi durante i temporali.Le donne utilizzano gli uo- + mini come i kleenex.Consiglio:una volta usati gettateli negli appositi cestini. + 40302 + Venere in Toro- la vostra fedelta` e` commovente,e lo e` tanto che leccate + sempre la mano al partner quando vi porge del cibo(affinche` non vada spreca- + to).Amate tanto i vostri cuccioli perche` sono morbidi,caldi e grassottelli. + 40303 + Venere in gemelli- il vostro bisogno di cambiare continuamente partner e`quasi + ridicolo.Tenetevi ben stretto quello che avete e non pensate ad altro se non + volete finire dall"ortopedico. + 40304 + Venere in Cancro- non siate sempre sinceri,sensibili,teneri,comprensivi,sensua- + li,romantici,coccoloni perche`ricevereste molte delusioni e vivreste amori tre- + mendamente infelici.Guardate J.R. e ricordate: la perfidia vince! + 40305 + Venere in Leone- i tre decimi di vista in vostro possesso vi impediscono di + vedere i difetti di chi condivide le vostre sciagure.Fatevi fare anche il suo + oroscopo e li scoprirete.Potrete cosi` prendere i dovuti provvedimenti... + 40306 + Venere in Vergine- sappiamo che fate l"amore con le scarpe nei piedi perche` + temete che il partner scopra che li avete piatti;sempre per questo motivo ave- + te solo avventure passeggere e vi lamentate con gli altri delle vostre sfortune + 40307 + Venere in Bilancia- siete affettuosi,dolci,buoni,socievoli.Avete il senso + della giustizia,della bellezza,dell"armonia.Nella vita sarete felici,come lo + fu San Francesco quando gli uccelleti gli risposero per la prima volta. + 40308 + Venere in Scorpione- in voi la perversione si e` fatta arte.Potreste dare molti + punti a Casanova,Eliogabalo,Messalina & Co.Non avete pregiudizi di sorta.Siete + truculenti e tirannici e se volete sangue per i vostri denti,telefonateci. + 40309 + Venere in Sagittario- siete peggio di Liz Taylor.La vostra inettitudine senti- + mentale vi condurra` solo e unicamente ad essere abbandonati.Ben vi sta,cosi` + la imparate,ad avere contemporaneamente tre partner che tradite di continuo. + 40310 + Venere in Capricorno-se la Luna non vi ha reso birbanti,Venere sara` piu` pro- + digo con voi,procurandovi si` legami tardivi (media ISTAT 87 anni),ma profondi + e duraturi,finche`morte non vi separi.Ah,sarete anche fedeli,ma non sensuali. + 40311 + Venere in Acquario- se pensate che l"adorato partner che tanto idealizzate sia + disposto a sopportare la vostra indipendenbza sessuale e la vostra intolleranza + verso i legami convenzionali,vi sbagliate:le corna sono corna e basta! + 40312 + Venere in Pesci- ha gli ochhi scuri,profondi come la notte;i capelli sono seta, + intrecciati tra le tue dita.Labbra morbide,piu` dolci del miele.Un corpo caldo + sotto la pelle fragrante di spezie e d"Oriente.Non e` un sogno:e`il tuo amore. + 40401 + Marte in Ariete- siete impazienti,impulsivi,rudi,istintivi,aggrssivi,audaci. + Avete fiducia solo in voi stessi e nelle vostre azioni.Per riavervi da queste + frustrazioni consiglio viaggi in Indocina,Afghanistan,centramerica,Libano. + 40402 + Marte in Toro- chi vi sta a fianco ricordi che sapete sempre dove volete arri- + vare e che ci arriverete con qualsiasi mezzo e a qualsiasi prezzo.Ricordi pure + che siete gelosi,possessivi e anche vendicativi.Agisca percio` di riguardo. + 40403 + Marte in Gemelli- grandi doti intellettuali,astuzia,aggrssivita`,sadismo,di- + sumana ingegnosita` e tremenda sfortuna caratterizzano questo Marte in Gemel- + li.Ricordate il coyote di Beep-Beep:ce l"ha pure lui,il Marte in Gemelli. + 40404 + Marte in Cancro- si sa che Marte e` collegato alla bile,al sistema pilifero,al + naso e ai globuli rossi,per cui se siete biliosi,se vi cascano i peli dalla + testa,se avete il raffreddore da fieno e siete anemici,e` tutta colpa sua. + 40405 + Marte in Leone- desiderereste tanto avere degli amici e spesso organizzate del- + le feste a sorpresa per procurarveli,ma la vostra indole carnivora e antropo- + faga li fa sparire presto,e cosi`dovete ricominciare daccapo la caccia. + 40406 + Marte in Vergine- la funzione dell"aggressivita` repressa e` discontinua e non + derivabile.Rifiutate di essere contraddetti,siete nascostamente irascibili,in- + tolleranti e vendicativi.Onesta` dubbia.Andreotti ha Marte in questo segno. + 40407 + Marte in Bilancia- non litigate sempre con tutti.Evitate,per esempio,di + schiaffeggiarvi tre volte per guancia tutte le mattine per punire la vostra + barba per essere cresciuta troppo durante la notte. + 40408 + Marte in Scorpione- se qualcuno vi da` uno schiaffo,porgete l"altra guancia. + Ma prima toglietevi l"elmo a punte avvelenate.Se non avete intenzione di far- + lo,almeno procurategli un fastoso funerale. + 40409 + Marte in Sagittario- o siete competitivi e aggrassivi da assassinare il vostro + migliore amico perche` non vi ha fatto vincere giocando a Wist,o siete cosi` + leali e buoni che,se gia` non l"avete fatto,dovreste prendere moglie o marito + 40410 + Marte in Capricorno- lei e` tenace,ambiziosa,metodica e paziente.Lui ama solo + il potere e non conosce premure,dolcezza e amore.Scordera` sempre il vostro com + pleanno,l`Anniversario,S.Valentino e Natale,e spesso anche che siete sposati. + 40411 + Marte in Acquario- se a forza di pensarci su avete dimenticato a chi dovevate + dare un pugno,consolatevi, perche` avete inventato una nuova teoria sulla non + violenza. + 40412 + Marte in Pesci- mancate di aggressivita`.Correte il pericolo di essere sopraf- + fatti in ordine sparso da: genitori,fratelli,cugini,zie,amici,partners e infine + dal vostro canarino (se anche lui non e` dei Pesci). + 40501 + Giove in Ariete: non avrete grosse difficolta` di inserimento nella vita so- + ciale,almeno fin quando chi vi sta accanto non si accorgera` della vostra ten- + denza a parlare troppo e in modo poco opportuno della sua vita molto privata. + 40502 + Giove in Toro- la vostra vita e` sedentaria,dedita unicamente alle poltrone e + alle posate (di Mamma`).Siete cosi` a basso metabolismo che non farete mai + soldi.Sport consigliato:lancio del martello(addosso ad uno scalpello). + 40503 + Giove in Gemelli: una cosa che mi piace di voi e` che a 80 anni vi ritenete + ancora troppo giovani per sposarvi.Tutto questo non vale per la Roberta,Ga- + briele e quel tipo con la barbetta e gli occhioni verdi piu` belli del mondo. + 40504 + Giove in Cancro: amate la vita tranquilla per cui non fate 5 mestieri contem- + poraneamente;imbavagliate e legate il pargolo quando urla;non inzuccherate i + capelli al prossimo e soprattutto licenziatevi dalla RAI 3. + 40505 + Giove in Leone: siete aggressivi,desiderosi di ammirazione e consensi.Un gior- + no,forse,arringherete le folle.Se vi seguono bene;se vi inseguono datevela a + gambe il piu` in fretta possibile. + 40506 + Giove in Vergine- armonico:ragione e calcolo condizionano le vostre decisioni. + Disarmonico:per ovvi motivi di censura non spiegheremo ai minorenni come cer- + tuni con Giove da queste parti fanno i soldi. + 40507 + Giove in Bilancia: siete pigri,autoindulgenti,presuntuosi,intrattabili e mora- + listi.Le vostre continue analisi sono sterili ed ossessive.Consiglio:attraver- + sate il Sahara a piedi,senz"acqua e senza scarpe,poi raccontateci il tutto. + 40508 + Giove in Scorpione- siete diffidenti,arroganti e polemici:avreste persino il + coraggio di dubitare dell"attendibilita`di questo oroscopo.Non provateci se + non volete fare una brutta fine. + 40509 + Giove in Sagittario- siete persone di ampie vedute,ottimiste,setrene,sincere, + leali e buone.Aspirate a gioie semplici ed a una vita sana e sportiva;avete + tanta fiducia nel prossimo. Consiglio:non fate i politici o resterete delusi. + 40510 + Giove in Capricorno- farete faville come commerciante di pellicce nel settore + del pidocchio muschiato,stupendo se associato alla pulce del Madagascar che + pero` e` in via di estinzione a causa dell"uso smodato di sapone nell"isola. + 40511 + Giove in Acquario- siete smodatamente pigri,rendetevi conto che e` giunta l"ora + di uscire alla luce! Basta guardare le stelle! Fatevi un po"di spettroscopia + solare ed abrronzatevi al celeostato.Capito?!? + 40512 + Giove in Pesci- con voi l"astrologo si e` veramente sprecato.Dice che amate i + comfort ed i piaceri intimi,che cercate di evitare le seccature e vorreste che + tutti al mondo si volessero bene.E` proprio un oroscopo superpersonale,questo! + 40601 + Saturno in Ariete- irresponsabili in vecchiaia come in gioventu` consumerete + le vostre migliori energie ristrutturando,progettando e costruendo improbabili + natanti o allevando anfiossi,qualsiasi cosa essi siano. + 40602 + Saturno in Toro- calma,riserbo,scarsa affettuosita` e sopreattutto un enorme + autocontrollo fanno di voi veri Vulcaniani,tanto da far invidia al Sig.Spock. + Tuttavia permettetevi di sorridere almeno una volta nella vita:non e`peccato. + 40603 + Saturno in Gemelli: al genere cocciuto-concentrato:non pensare sempre alla + stessa cosa:almeno a due (a turni alterni).Al genere frustrato-vendicativo-di- + un-freddo-disumano:va"a fare marine e ammazzali tutti chiunque essi siano! + 40604 + Saturno in Cancro- in vecchiaia sara` inutile l"abuso di creme e prodotti di + bellezza poiche`,comunque,gli specchi rifiuteranno di riflettere la vostra im- + magine raggrinzita e cheratinosa. + 40605 + Saturno in Leone- i leoni invecchiando perdono i denti,il pelo e il vizio.Per + i denti consigliamo Dracula,per il pelo Cesare Ragazzi e per il vizio una cal- + da notte con Tina Anselmi o con Amintore Fanfani+Ciriaco De Mita. + 40606 + Saturno in Vergine- le vergini invecchiando diventeranno acide zitelle.I ver- + gini invece diventeranno zitelli basici o maniaci sessuali assatanati.Gli al- + tri organizzeranno mostre e concorsi fotografici su Erotismo,nudo e verginita` + 40607 + Saturno in bilancia- invecchiando diventerete vecchi,asociali,egocentrici e de- + primenti.Finira` che a 103 anni il vostro partner che vi ha sopportato per 85 + anni chiedera` il divorzio e gli alimenti. + 40608 + Saturno in Scorpione-quelli del 54-56 soffriranno in tarda eta`(98-120 anni) + di fantasie erotiche morbose ed ossessive rivelando finalmente la loro sen- + sualita` perversa e contorta.Gli altri si spegneranno lentamente nell"oblio. + 40609 + Saturno in Sagittario- un modo comodo di pensare e` pensare sempre come pensa- + no gli altri,pensare esattamente l"opposto e` pero` piu` fine ed e` altrettan- + to facile.Non pensare e` meglio: fate finta! + 40610 + Saturno in Capricorno- col passare degli anni accentuerete il vostro carettere + tenere e dolce mettendovi ad allevare e coccolare Echinocactus grusonii,Opuntia + tunicata,Coryphantha vivipara,Pfeiffera yantothele e Ferocactus horridus. + 40611 + Saturno in Acquario- mai fu piu` azzeccato il proverbio:gallina vecchia fa buon + brodo (anche se a noi il brodo non piace).Infatti piu` invecchierete piu` ac- + centuerete il vostro straordinario fascino e la vostra insolita personalita` + 40612 + Saturno in Pesci- invecchiando i pesci diventano arteriosclerotici,escono dal + mare,salgono sulla terra,diventano anfibi,poi rettili,mammiferi,scimmie,indi + uomini:ecco spiegata l"evoluzione! + 40701 + Urano in Ariete- grandi capacita` tecniche,amore per la liberta`,intuizione, + audacia,temerarieta` avrebbero fatto di voi grandi aviatori; peccato siate sta- + ti battuti sul tempo da Werner Voss,Lindenberg,il Barone Rosso e Snoopy. + 40702 + Urano in Toro-vi entusiasmate facilmente di fronte a nuove teorie scientifiche + se siete giornalisti RAI certamente le renderete illogiche,ma non importa:l"im- + portante non e` capire,ma parlare(motto di De Coubertine,noto fisico del `700). + 40703 + Urano in Gemelli-avete l"idea fissa che l"amante vi tradisca,da qui un comples- + so di persecuzione dato dai biglietti anonimi che voi stessi vi scrivete.Con- + siglio: giocate alla roulette russa e l"amante avra` per trofeo un alce. + 40704 + Urano in Cancro-il dubbio amletico che voi tortura da anni sara` finalmente + risolto:un famoso matematico in punto di morte vi confessera` finalmente quan- + to e` grande un epsilon piccolo a piacere. + 40705 + Urano in Leone-la vostra ambizione geniale e il rifiuto di ogni imposizione vi + faranno prendere decisioni impulsive,come quella che Urano in Leone non vi va. + Metterete cosi` in uso la precessione degli equinozi ed avrete Urano in Cancro. + 40706 + Urano in Vergine- per le vostre idee stravaganti come quella che la terra e`a + forma di pera,rischiate la Santa Inquisizione,perche`solo il Papa,Bettino + Craxi e le William possono assumere questa sacra forma. + 40707 + Urano in Bilancia- siete persone senzienti e libere d"opinione:siete quindi + proprio sicuri che la RAIDUE con il suo Oroscopo di Stato non vi stia rubando + i soldi del canone TV?!? + 40708 + Urano in Scorpione- siete combattivi e tenaci,questo e` vero,ma forse e` me- + glio la smettiate di giocare a carte quando sapete benissimo che anche barando + le buscherete per la miliardesima volta. + 40709 + Urano in Sagittario-siete pargoli maledettamente determinati e individualisti + capaci di schiavizzare con le vostre trovate geniali tutta la parentela.Riu- + scite a sbalordire la massse con le vostre tendenze sadiche,perfide e violente. + 40710 + Urano in Capricorno-per gli uomini:l`obiettivo piu`grande della vostra vita + resta la conquista dell`Abissinia.Per le donne:il vostro obiettivo invece e` + fregare lo zerbino consunto di quell"antipatica della vostra vicina di casa. + 40711 + Urano in Acquario-Sono frequenti in questa configurazione astrale casi di cama- + leontismo utilitaristico,malattia incurabile,dalla sintomatologia complessa, + che colpisce soprattutto dirigenti della classe politica ed amministrativa. + 40712 + Urano in Pesci- se siete cristiani Dio illuminera` il vostro cammino;se siete + russi lo faranno il Baffone o la Siberia;se siete americani saranno i cow-boys + e la Coca-cola a illuminarvi,se siete libanesi saranno i bengala e le bombe. + 40801 + La vostra vitalita` si e` placidizzata. Metabolismo basso ( ipotiroideo + 15 pulsazioni all`ora (di Greenweech)) . Scuotetevi per raggiungere + le 16 pulsazioni/h (indispensabili per leggere l`oroscopo + 40802 + Nettuno nel toro esalta la vostra vitalita` animale. Non esagerate, + oppure ferratevi gli zoccoli e lucidatevi le zanne, vi possono + servire! + 40803 + La vitalita` di nettuno nei gemelli e` notoriamente divergente, anche + perche` sono in due a fare casino. Eccezione peri siamesi. + + 40804 + Vitalita` scarsissima: e` noto che i granchi camminano a marcia indietro + e` per questo che la vostra circolazione sanguigna va all`incontrario + ed i vostri antenati avevano il sangue blu. + 40805 + eccezionale la vitalita` animale di nettuno nel Leone. IL suo ruggito + e` vitale ma tanto si sa che Leone che rugge non morde. Fatevi assumere + come sigla della Paramount per non divenire astronomi devitalizzati[C + 40806 + Sembra ci sia una certa resistenza a vitalita` nuove tenetevi pure + quelle vecchie e datevi alla archeologia paleosumerica oppure alle + analisi interferometriche di superclusters ipoglicemici + 40807 + Nettuno in Bilancia-la vostra principale qualita`di leader sta nella spietata + intolleranza che nutrite verso ebrei,negri e slavi.In Francia funzionera`an- + che,ma qua no.E` troppo alta la considerazione che si ha per negrette e slave. + 40808 + Nettuno in Scorpione-spregiudicati,crudeli,perversi,geniali,vi compiacete del- + le cattiverie piu` gratte come spingere donne incinte sotto i tram (45 punti); + sgambettare i vecchietti (37 punti);rubare le merende ai bambini (54 punti). + 40809 + La vostra vitalita` e` finita in un segno di fuoco. Prima che bruci + del tutto spegnetela velocemente. Se non c`e`ancora riuscito + l`esame di analisi 2 provate con analisi 3. Auguri + 40810 + Nettuno in Capricorno- nonostante la vostra innata diffidenza,in fondo in fondo + siete dei creduloni e subirete spesso raggiri da chiromanti,cartomanti,psica- + nalisti,grafologi ed astrologi di origine varia e spesso sconosciuta. + 40811 + La vostra vitalita` ruggente ha ruggito a lungo.Ora siete senza voce + potrete sempre gridare forte in un film muto + O cercando sordi cui parlare + 40812 + Nettuno e` in un segno umido. Questo segnala che la vostra vitalita` + e` umida. Asciugatela al sole od innaffiatela ancora di piu` + cosi` fa le radici e cresce + 40901 + + + + 40902 + + + + 40903 + + + + 40904 + + + + 40905 + + + + 40906 + + + + 40907 + + + + 40908 + + + + 40909 + + + + 40910 + + + + 40911 + + + + 40912 + + + + 41001 + Luna in Ariete: gli uomini avranno successo finquando avranno una donna di cui + essere schiavi.Le donne viceversa avranno successo solo quando si saranno sba- + razzate di tutti gli uomini che si trovano sul loro cammino. + 41002 + Luna in Toro- le donne sono dedite alla famiglia e soprattutto ai bambini,sono + fedeli ed insicure;gli uomini sono possessivi e gelosi della loro donna e del- + la loro prole. 20000 anni e qui nulla e` cambiato. Sic!. + 41003 + Luna in Gemelli- a lui:smettetela di riassumerle l`intera opera di Karl Marx + quando vi trovate su un morbido letto a due piazze in una stanza dalle luci + basse,calde e soffuse:potreste non rivederla mai piu`.A lei: idem. + 41004 + Luna in Cancro- a lei e lui: siete assolutamente incapaci di rompere legami in- + felici.Consiglio:se non siete capaci di rompere legami,rompetevi la testa,rom- + petela al vostro partner,ma non rompete le scatole al resto dell`umanita`. + 41005 + Luna in Leone- a lei:una grande forza ed un grande fascino sprizzano da tutti + i pori della vostra persona:approfittatene!Lui ama le donne molto vistose che + poi assomiglino a Marilyn Monroe o abbiano una massa di 184 Kg non importa! + 41006 + Luna in Vergine- lui:la tua donna ideale e` una domestica tuttofare.Lei:se sei + disposta a vivere nell`aridita`,nell`egoismo;se tutte le sue critiche ti met- + tono in ansia,allora ,forse,sei la sua donna ideale,ma hai del fegato,ragazza! + 41007 + Luna in Bilancia- a lui:non guardatela troppo a lungo,pensando che sia una me- + ravigliosa opera d`arte perche` potrebbe rivestirsi e andarsene quando meno ve + lo aspettate.A lei:cambiare `guardatela` con `coccolatelo`. + 41008 + Luna in Scorpione- Lui e` alla perenne ricerca della donna fatale:quella che + lo fara`morire d`infarto.Lei e` perversa,morbosa,dissoluta e sara` una moglie + e una madre esemplare per vampiri,licantropi,orchi,Yeti e mostri in genere. + 41009 + Luna in Sagittario- lui:20 donne di cui 19 d`importazione in soli 2 giorni e + con tutte rotto il legame nelle 48 ore.Lei:5 matrimoni in 2 mesi con magnati + del petrolio,4 volte vedova ora in attesa di divorzio per sposare emiro arabo. + 41010 + Luna in Capricorno- lei piu` che un uomo vorrebbe avere al suo fianco un per- + sonal computer perfettamente efficiente.Anche lui desidererebbe un personal + computer:femmina,pero`. + 41011 + Luna in Acquario- a lei:ricorda che gli uomini sono primati non troppo evoluti + che mal si conciliano con la tua sete di liberta`.A lui:la tua donna ideale e- + siste,ma non ti dico chi e`,cosi` ti divertirai a cercarla. + 41012 + Luna in Pesci- a lei e lui:siete un branco di coccoloni,irriducibili romantici + bisognosi di dolcezza,tenerezza e protezione.Consiglio una casa calda,un camino + acceso,un buon vino,la persona giusta accanto e musiche di Dvorak e Smetana. + 50101 + + PIANETE NELLE CASE: OVVERO ANALISI PSICOTANTRICA DELL`IO + + 50102 + + Pianeti nelle case : ovvero come non si trova casa + + 50103 + + le case dei pianeti: ovvero : domificazione intrinseca + + 50104 + + PIANETI NELLE CASE : OVVERO : SI EDIFICA IN CIELO? + + 50105 + PIANETI NELLE CASE OVVERO COME FARE UNA CASETTA PER IL PROPRIO IO + + + 50106 + + PIANETI NELLE CASE OVVERO: ANALISI SEMANTICO ANALITICA DELL`IO + + 50107 + + PIANETI NELLE CASE: OVVERO LE CASE DEI PIANETI + + 50108 + + PIANETI NELLE CASE : OVVERO : COME HANNO TROVATO CASA I PIANETI + + 50109 + + PIANETI NELLE CASE ( MA CHI PAGA L`AFFITTO?) + + 50110 + + PIANETI NELLE LORO CASE ( LE HANNO COMPRATE MICA SONO IN AFFITTO) + + 50111 + + PIANETI NELLE CASE: COME LEGGERE IL VOSTRO IO SEGRETO + ( SE e` veramente segreto non fate leggere questo oroscopo) + 50112 + + Pianeti nelle case in cui stavano ( ora hanno traslocato) + + 50201 + + PIANETI NELLE CASE : DOMIFICAZIONE DELL`IO + + 50202 + Perche` quando siete nati non avete pensato a dare una occhiata al + medium Coeli,ascendente,discendente etc,cose fondamentali nella vita + invece di occuparvi banalmente di respirare. Sono i segni che + 50203 + Le case ,fissate dal medium,imum,ascendente e discendente,( in assenza + di decreti legge che stabiliscono un equo canone, sono state affittate + ai pianeti in modo selvaggio.Non preoccupatevi,questo + 50204 + Le case nel loro splendore celeste, con le loro intersezioni incalcolabili + ( salvo uso di trigonometria sferica) sono fondamentali per lo + sviluppo dell + 50205 + Ed eccoci qui infine ad analizzare le case.Esse sono il vostro io, + la vostra fine, il vostro inizio, il vostro destino. (siete mediatori + immobiliari?) Come sapeva anche Keplero infatti + 50206 + Le case, cui avreste dovuto occuparvi subito, invece di pensare a cose + piu` banali come mangiarvi e bervi tutti i soldi dei parenti ( se + non lo avete fatto fatelo finche` siete in tempo) + 50207 + Le case, le case grido` il moribondo nel deserto quando finita la + tempesta di sabbia vide le stelle. Lui si sentiva nell`imum coeli + e voleva arrivare fino almeno all`ascendente.Infatti le case + 50208 + L`ASCENDENTE E` FONDAMENTALE , ( a discendere si fa sempre a tempo) + perche` non ci avete guardato prima? Dove scendete voi, oltre che + a questa stanza dei terminali della torre. Sono le case che + 50209 + L`ascendente ed il discendente, con le loro parallassi trigonometriche + senza scampo integreranno e deriveranno il comportamento evolutivo + dell`io e perche` voi lo sappiate vi diciamo che + 50210 + Le case che determinano lo sviluppo dell`economia celeste potrebbero + essere la vostra disperazione.Potete sempre sfruttare la situazione e + frvele affittare dai pianeti che le hanno.Esse infatti + 50211 + I pianeti hanno le case e voi? Se sono congiunti ne hanno alcune in + comune, altre allora sono libere. Chiedetene il sequestro come + accaparrate da gente che non ci abita.Sono infatti le case che + 50212 + I pianeti hanno le loro case e ci abitano da sempre, il problema e` + andare a vedere dove abitavano quando siete nai. Perche` non avete + dato una occhiata allora?. ora non sapete che essi + 50301 + dicono che l`inizio della vostra vita fu contraddittorio. Non sapevate + bene come cominciare ed il solito UEEE! pareva banale. La levatrice vi + ha picchiato per questo e fu un grave trauma psicologico + 50302 + l`inizio della vostra vita fu abbastanza felice. Quando avete riso + per la prima volta (a 20 anni) avete notato che era faticoso e poco + divertente e non ci avete provato piu`.La seconda volta fu un trauma + 50303 + L`inizio della vostra vita fu scientifico. Tenuti a testa in giu` dalla + levatrice vi siete chiesti : E` UNO SPACE REVERSAL? . E quando vi + allattavano scoprire che il latte non e` un fluido perfetto fu traumatico + 50304 + L`inizio della vostra vita e` incerto. Siete sicuri di esistere, chiedetelo + ai vicini forse potranno darvi qualche indicazione. Quello che e` certo + e` che da piccoli avete subito un forte trauma da adattamento al bavaglino + 50305 + fanno apparire certa l`ipotesi di una vostra nascita felice.Avete subito + iniziato a cantare l`UEEEEE! in sol di BACH ( quello che canto` Bach + nella analoga occasione.Vi diedero dello stonato e fu un trauma + 50306 + fanno apparire la vostra nascita avvolta nelle nebbie. Infatti voi siete + affetti dal complesso delle nebbie che consiste nell`addormentarsi + durante le lezioni di calcolatore.Svegliarsi col Bip del Vax fu un trauma + 50307 + non vi dicono nulla, ma potranno farlo in futuro se eviterete di celarvi + nelle cantine per non essere visti dai pianeti e non farvi dire da + loro il vostro destino. Quando cio` accadra` sara` un trauma. + 50308 + a chi li sa leggere dicono che il vostro io e` affetto da complessi + risalenti alla nascita quando avete subito il tremendo trauma di + dover dare un verso destrorso al riferimento del biberon + 50309 + Fanno apparire la vostra nascita come soggetta a fenomeni statistici + avete controllato di essere coerente colle medie nazionali e siete + nato. Dopodiche` avete subito il trauma della alta deviazione standard + 50310 + dicono che la vostra nascita non si e` mai verificata. Anche loro si + sbagliano qualche volta, ma non potete contarci. Vitocca quindi di + abbandonare ai bisognosi i turni di calcolatore.Cio` e` traumatico + 50311 + suggeriscono per voi un passato vario e fantasioso, anche da appena nati + eravate fantasiosi e dicevate UAAAA! oltre che il solito UEEEE! + COMPLIMENTI!. Purtroppo dopo vi siete traumatizzati come al solito. + 50312 + dicono quale sia l`evoluzione l`involuzione, l`avvenire, il passato e + tutta la complessa algebra dell` essere. Che va impostata in campo + complesso alla ricerca delle radici.Se sono immaginarie e` un trauma + 50401 + + PIANETI NELLE CASE : OVVERO: DOMIFICAZIONE INTRINSECA + + 50402 + E come sanno tutti gli psichiatri i traumi infantili determinano tutto. + Potrete fare le cose piu` pazze per i successivi 150 anni senza speranza + di liberarvi delle primitive ossessioni. Peccato. + 50403 + tutta la vostra infanzia fu condizionata da questo. Per questo correvate + dietro ai gati randagi per calcolarne il peso specifico, lanciavate sassi + in orbite iperboliche, e vi disperavate per gli attriti parassiti + 50404 + Questo trauma fu pero` da voi subito dimenticato a causa del piu` grave + trauma successivo ( noto trauma del seggiolone) stando in alto vi + credevate il massimo. Ma vedere che sopra stava il soffitto fu terribile + 50405 + Questo trauma fu da voi pero` subito dimenticato per puro spirito di + contraddizione con gli psichiatri che ancora vi studiano per capire come + abbiate fatto a superare un cosi` grave momento della vostra vita; + 50406 + questo trauma si traduce nel sogno ricorrente del pulcino che vi insegue + per beccarvi. Al mattino correte a comprare una gabbietta e non sapete + perche` lo fate ( al negoziante pero` il perche` non interessa) + 50407 + questo trauma, accoppiato ad un accidentale trauma ematomatico al mignolo + destro, ha finito per condizionare pesantemente il vostro modo di vedere + l`ambiente circostante.Ora rifiutate inconsciamente cio` che fa BIP! + 50408 + A causa di questo per tutta l`infanzia siete stati terrorizzati dai passeri + grigi che rappresentano per il vostro inconscio i nemici pronti a + divorarvi (E` quello che FROID chiama COMPLESSO DELLA BRICIOLA) + 50409 + Questo evento e` stato il condizionatore della vostra infanzia.Ed avete + continuato a vedere da per tutto integrali convolutori e punti di + accumulazione. Accumulando frustrazione allo sciogliersi dei cumuli nevosi + 50410 + questo trauma e` la chiave di lettura della vostra psicologia contorta. + Quando starnutite non e` il raffreddore, e` la traumatica intrinseca che + sussulta. ( come dice Froid nel saggio: psicanalisi dello staurnuto) + 50411 + E successivamente avete studiato Coriolis negli scarichi dei lavandini, + tecnica del freddo in pellicceria, teoria delle code in mensa, ed avete + scoperto che un bus e` un sistema termodinamico di urti anelastici. + 50412 + questo ha causato in voi il nascere del vitale interrogativo: chi sono io? + La risposta data dalla teoria delle simmetrie personali: IO sono IO, TU sei + TU, LUI e` LUI ... e` stata giudicata insoddisfacente perche`banalmente vera + 50501 + Dopodiche` vi siete dati alle indagini serie tentando di capire per quale + misteriosa ragione si mangiasse ad ore fisse. Tentativi di indagini + statistiche portarono alla fame argomento convingente benche`ascientifico + 50502 + La fase successiva e` stata caratterizzata dalle indagini statistiche: + quanto spesso devo dormire? quando devo mangiare, nel dubbio vi + astenevate da ogni azione terrorozzando i vostri genitori + 50503 + Poi avete incominciato serie analisi sulle ragioni della vostra vita. + Ed avete elaborato la famosa teoria: Io sono, quindi mi si dia da + mangiare, da dormire, etc. etc. IO SONO IL RE + 50504 + A questo punto avete iniziato con le indagini serie: e vi siete chiesti; + ma a che ora si mangia qui?. Avete drammaticamente scoperto di non essere + in grado di rispondere non sapendo leggere l`ora e siete divenuti astronomi + 50505 + A questo punto vi siete dati agli studi statistici. Quante goccie stanno + nel biberon? L`indagine sperimentale consisteva nel contarle mentre + cadevano al suolo. Non foste capiti in questa vostra impresa scientifica + 50506 + A questo punto l`indagine divenne lo scopo principale della vostra vita + scoprire quanto latte riuscivate ad ingurgitare in una poppata non fu + pero` facile a causa dell`esaurimento di ogni tipo di scorte. + 50601 + + PIANETI NELLE CASE OVVERO: EDIFICAZIONI CELESTI + + 50701 + + PIANETI NELLE CASE OVVERO : UNA CASA PER UNO NON FA MALE A NESSUNO + ( Congiunzioni in crisi di alloggi ) + 50801 + + PIANETI NELLE CASE : OVVERO DOVE ABITANO I PIANETI + + 50901 + + PIANETI NELLE CASE: OVVERO: CASE DEI PIANETI + + 51001 + + PIANETI NELLE CASE ( Come hanno trovato casa i pianeti ) + ( Prendete esempio ) + 60205 + 2a Casa in LEONE: tendenza spiccata a taccagneria e avarizia o almeno ecces- + sivo senso del risparmio.Mestieri consigliati:strozzino ebreo,ususraio scozzese + bottegaio lucchese.Segno zodiacale effettivo malaysiano:LIMA con asc.RASPA. + 60206 + + + + 60207 + 2a Casa in BILANCIA: originalita`nelle spese e desiderio di sbalordire con- + nessi con alti e bassi finanziari creano una situazione economica caotica ma + che tende asintoticamente a zero.Non fate regali dispendiosi a Cacciari! diff --git a/code/glukie.dat b/code/glukie.dat new file mode 100755 index 0000000..e2ebcf6 Binary files /dev/null and b/code/glukie.dat differ diff --git a/code/igor.exe b/code/igor.exe new file mode 100755 index 0000000..af0658f Binary files /dev/null and b/code/igor.exe differ diff --git a/code/igor.for b/code/igor.for new file mode 100755 index 0000000..24411be --- /dev/null +++ b/code/igor.for @@ -0,0 +1,225 @@ + PROGRAM IGOR +C **************************************************** 00000020 +C E' LUI CHE PREPARA IL CIBO PER IL MOSTRO ! 00000030 +C FORNISCE DATI INIZIALI AD FILE INDEXED PER IL MOSTRO: FRANKIE 00000040 +C ------------------------------------------------------------ +C +C I dati da fornire sono : +C I : inclinazione - in gradi.decimali +C OS : omega piccolo segnato : longitudine del perielio -gradi.dec +C OG : Omaga grande : longitudine nodo ascendente - gradi.decimali +C ECC : eccentricita' dell'orbita +C Anom : Anomalia media all'epoca (dal punto gamma) - gradi.dec +C A : semiasse maggiore (distanza media) - in UA +C +C Il programma muta i dati in: +C I : inclinazione +C OP : omega piccolo = OS-OG - angolo nodo asc.-perielio +C OG : +C ECC : +C M0 : Anomalia media dal perielio = Anom-OS =A nom-OP-OG +C A : semiasse maggiore - In Kilometri . +C +C I dati vanno forniti per i pianeti nell'ordine: +C Terra,Mercurio,Venere,Marte,Giove,Saturno,Urano,Nettuno,Plutone +C +C Va fornita anche la data: anno,mese giorno; la data +C viene mutata nella chiave che contraddistingue gli elementi +C orbitali nel file indexed : KIAV=-aaaammgg ; +C aaaa=anno,mm=mese,gg=giorno +C +C *************************************************** 00000050 + IMPLICIT REAL*8 (A-H,O-Z) 00000060 + DIMENSION E(6,9) 00000070 + DATA UA/149597870.D0/ 00000080 +C 00000090 + OPEN(UNIT=99,FILE='CIBO',STATUS='UNKNOWN', + 1 ORGANIZATION='INDEXED',ACCESS='KEYED',RECORDTYPE='VARIABLE', 00000110 + 2 FORM='UNFORMATTED',RECL=250,KEY=(1:4:INTEGER)) 00000120 +C 00000130 + 1 CONTINUE 00000140 + TYPE*,' FORNISCI I DATI O LEGGI? (1 2 3=FINE.4=CORREGGI)' 00000150 + 1 ,' 5=LETTURA SU FOR001.DAT , 6=SEQUENZIALE IN KEYED.' 00000160 + ACCEPT*,K 00000170 + IF(K.EQ.3) GO TO 500 00000180 + IF(K.EQ.2) GO TO 300 00000190 + IF(K.EQ.1) GO TO 100 00000200 + IF(K.EQ.4) GO TO 400 00000210 + IF(K.EQ.5) GO TO 600 00000220 + IF(K.EQ.6) GO TO 700 00000221 + GO TO 1 00000230 +C Si forniscono i dati +C + 100 TYPE*,' DARE ANNO,MESE,GIORNO' 00000240 + ACCEPT*,IANNO,MESE,GIORNO 00000250 + T=DJ(IANNO,MESE,GIORNO) 00000260 +C QUESTE SONO CORREZZIONI ALLA EQUINOZIO DELLA DATA DL 2000 00000270 +C T1=(T-2451545.D0)/36525.D0 00000280 +C A1=1.3970*T1 00000290 +C B1=0.0131*T1 00000300 +C C1=5.1236+0.2416*T1 00000310 + KIAV=-(GIORNO+MESE*100+IANNO*10000) 00000320 + DO 10 I=1,9 00000330 + TYPE*,' DARE I,OS,OG,ECC,ANOM,A ,. PIANETA:',I 00000340 + ACCEPT*,(E(J,I),J=1,6) 00000350 + E(5,I)=E(5,I)-E(2,I) ! ANOM MEDIA DEL PERIELIO 00000360 + E(2,I)=E(2,I)-E(3,I) ! OP=OS-OG 00000370 + E(6,I)=E(6,I)*UA ! A IN KM 00000380 +C CORREZIONI ALL EQUINOZIO DELLA DATA DAL 2000 00000390 +C GRI=GRARAD(E(1,I)) 00000400 +C GR=GRARAD(E(3,I)+C1) 00000410 +C E(1,I)=E(1,I)+B1*COS(GR) 00000420 +C E(2,I)=E(2,I)+B1*SIN(GR)/SIN(GRI) 00000430 +C E(3,I)=E(3,I)+A1-B1*SIN(GR)/TAN(GRI) 00000440 + 10 CONTINUE 00000450 + WRITE(99)KIAV,T, ((E(J,JJ),J=1,6),JJ=1,9) 00000460 + TYPE*,KIAV,T, ((E(J,JJ),J=1,6),JJ=1,9) 00000470 + GO TO 1 00000480 +C +C Si legge un dato +C + 300 TYPE*,' DARE ANNO,MESE,GIORNO' 00000490 + ACCEPT*,IANNO,MESE,GIORNO 00000500 + KIAV=-(GIORNO+MESE*100+IANNO*10000) 00000510 + READ(UNIT=99,KEYGE=KIAV,KEYID=0,ERR=2) 00000520 + 1 KIAV,T, ((E(J,JJ),J=1,6),JJ=1,9) 00000530 + TYPE*,KIAV,T, ((E(J,JJ),J=1,6),JJ=1,9) 00000540 + GO TO 1 00000550 +C +C Fine +C + 500 CLOSE(UNIT=99,DISP='KEEP') 00000560 + STOP 00000570 +C +C Si corregge un dato +C + 400 CONTINUE 00000580 + TYPE*,' DARE LA CHIAVE' 00000590 + ACCEPT*,KIAV 00000600 + READ(UNIT=99,KEYEQ=KIAV,KEYID=0,ERR=2) 00000610 + 1 ,KIAV,T, ((E(J,JJ),J=1,6),JJ=1,9) 00000620 + 20 TYPE*,KIAV,T, ((E(J,JJ),J=1,6),JJ=1,9) 00000630 + TYPE*,' COSA DEVO CAMBIARE? DARE J,I, E(J,I),I=J=0=RISCRIVO,' 00000640 + TYPE*,' I=J=-1=ELIMINO IL RECORD,I=100 CAMBIO T' 00000650 + ACCEPT*,J,I,A 00000660 + IF(I.EQ.100) GO TO 260 00000670 + IF(I.EQ.-1.AND.J.EQ.-1)GO TO 250 00000680 + IF(J.EQ.0.OR.I.EQ.0) GOTO200 00000690 + E(J,I)=A 00000700 + GO TO 20 00000710 + 200 REWRITE(99,ERR=2)KIAV,T,((E(J,JJ),J=1,6),JJ=1,9) 00000720 + GOTO1 00000730 + 250 DELETE(99,ERR=2) 00000740 + GOTO1 00000750 + 260 T=A 00000760 + GO TO 20 00000770 + 2 TYPE*,' ERRORE' 00000780 + GOTO 1 00000790 +C +C Si legge tutto e lo si scrive su for001.dat +C + 600 CONTINUE 00000800 + 30 READ(99,END=1,ERR=2)KIAV,T,((E(J,JJ),J=1,6),JJ=1,9) 00000810 + WRITE(1,1000) KIAV,T 00000820 + WRITE(1,2000)(JJ,(E(J,JJ),J=1,6),JJ=1,9) 00000830 + 1000 FORMAT(' CHIAVE E JD:',I20,E30.20) 00000840 + 2000 FORMAT(1X,' PIANETA:',I5,'=',6E16.10) 00000850 + GO TO 30 00000860 +C +C Si muta un file sequenziale tipo for001.dat in un keyed +C + 700 CONTINUE 00000861 + OPEN(UNIT=98,FILE='CIB',STATUS='OLD') + 70 READ(98,888,END=1) KIAV,T 00000863 + READ(98,889) ((E(J,JJ),J=1,6),JJ=1,9) 00000864 + 888 FORMAT(1X,I9,13X,E26.0) 00000865 + 889 FORMAT(1X,3E16.10) 00000866 + WRITE(99,ERR=2) KIAV,T,((E(J,JJ),J=1,6),JJ=1,9) 00000867 + GO TO 70 00000868 + 444 TYPE*,' ERRORE IN LETTURA SULLE CHIAVI' 00000869 + GO TO 70 00000870 + 445 TYPE*,' ERRORE IN LETTURA' 00000871 + GO TO 70 00000872 + END 00000880 +C + FUNCTION DJ(Y,M,D) +C --------------------------------------------- +C Calcolo del giorno giuliano +C + REAL*8 C,D,DJ,A,B,G 00008770 + INTEGER*4 Y 00008780 + C=Y+M*1.E-2+D*1.E-4 00008790 +C CALCOLO DELLA CORREZIONE DI GREGORIO 00008800 + B=0 00008810 + IF(C.LE.1582.1015) GOTO 100 00008820 + A=INT(Y/100.) 00008830 + B=2-A+INT(A/4.) 00008840 + 100 CONTINUE 00008850 + IF(M.LE.2)THEN 00008860 + MY=Y-1 00008870 + MM=M+12 00008880 + ELSE 00008890 + MY=Y 00008900 + MM=M 00008910 + END IF 00008920 + CONTINUE 00008930 + G=0. 00008940 + IF(C.LT.0.) G=.75 00008950 + DJ=INT(365.25*MY-G)+INT(30.6*(MM+1))+D+1720994.5+B 00008960 +C TYPE*,'GIORNO= ',D,' MESE= ',M,' ANNO= ',Y,' DJ=',DJ 00008970 + RETURN 00008980 + END 00008990 + SUBROUTINE JOD(DJ,G,M,JA) 00009980 +C --------------------------------------- +C QUESTO E JODY,INVERSO DEL GIORNO GIULIANO COME SUBROUTINE 00010000 +C + REAL* 8 DJ,ALFA,A,B,G 00009990 + IF(DJ.LE.0.) RETURN 00010010 + DJ=DJ+0.5 00010020 + IZ=INT(DJ) 00010030 + IF(IZ-2299161) 3,5,5 00010040 + 3 A=IZ 00010050 + GO TO 6 00010060 + 5 ALFA= INT((IZ-1867216.25)/36524.25) 00010070 + A=IZ+1+ALFA-INT(ALFA/4.) 00010080 + 6 CONTINUE 00010090 + B=A+1524 00010100 + IC=INT((B-122.1)/365.25) 00010110 + ID=INT(365.25*IC) 00010120 + IE=INT((B-ID)/30.6001) 00010130 + F=DJ-IZ 00010140 + G=B-ID-INT(30.6001*IE)+F 00010150 + IF(IE.LT.13.5)M=IE-1 00010160 + IF(IE.GT.13.5)M=IE-13 00010170 + IF(M.LT.2.5) JA=IC-4715 00010180 + IF(M.GT.2.5) JA=IC-4716 00010190 + DJ=DJ-0.5 00010200 +C TYPE*,'JULIAN DAY= ',DJ 00010210 +C TYPE*,'GIORNO= ',G,' MESE= ',M,' ANNO= ',JA 00010220 + RETURN 00010230 + END 00010240 +C ------------------------------------------------------- + FUNCTION TESTG(Y,M,D) 00010680 +C SERVE PER ELIMINARE LE DATE CHE NON ESISTONO 00010710 +C -------------------------------------------------------- + IMPLICIT REAL*8 (A-H,O-Z) 00010690 + INTEGER Y 00010700 + DIMENSION MESE(12) 00010720 + DATA MESE/31,29,31,30,31,30,31,31,30,31,30,31/ 00010730 + IF(D.LT.0.OR.M.LT.0.OR.M.GT.12) GOTO 200 00010740 + C=Y+M*1.E-2+D*1.E-4 00010750 +C GIORNI UCCISI DA GREGORIO 00010760 + IF((C.GE.1582.1005).AND.(C.LE.1582.1014)) GOTO 200 00010770 +C MESE DI TROPPI DI' 00010780 + IF(MESE(M).LT.D) GOTO 200 00010790 +C BISESTILE INESISTENTE 00010800 + IF(INT(Y/4.)-Y/4..NE.0.AND.M.EQ.2.AND.D.GT.28) GOTO 200 00010810 + IF(Y/400.-INT(Y/400.).NE.0.AND.M.EQ.2.AND.D.GT.28.AND. 00010820 + 1 Y.GT.1582) GOTO 200 00010830 + TESTG=0. 00010840 + RETURN 00010850 + 200 TESTG=1. 00010860 + RETURN 00010870 + END 00010880 +C 00010890 + diff --git a/code/oro.com b/code/oro.com new file mode 100755 index 0000000..c58f970 --- /dev/null +++ b/code/oro.com @@ -0,0 +1,80 @@ +$! PROCEDURA CHE FA L"OROSCOPO ANIMANDO IL MOSTRO +$WRITE SYS$OUTPUT "***************************************************" +$WRITE SYS$OUTPUT " O R O S C O P O" +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " Offered by:" +$WRITE SYS$OUTPUT " FRANKESTEIN BUILDING CORPORATION" +$WRITE SYS$OUTPUT " Of Bononiae Astronomichal Observatory " +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " All rights reserved. " +$WRITE SYS$OUTPUT " This program is available to everybody on request" +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " Auctors are not responsable of anything ovvero:" +$WRITE SYS$OUTPUT " Ogni responsabilita' e' declinata." +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " Editorial commitee:" +$WRITE SYS$OUTPUT " Marcello Galli : Computational Effort" +$WRITE SYS$OUTPUT " Enrica Baiada : Ancient Research etc." +$WRITE SYS$OUTPUT " Sabina Mengoli : Art Director" +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT "***************************************************" +$ON ERROR THEN GOTO E1 +$OPEN/READ DATI CIBO ! elementi orbitali +$CLOSE DATI +$OPEN/READ DATI GLUKIE ! responsi +$CLOSE DATI +$ON ERROR THEN GOTO E2 +$OPEN/READ LOAD disko:FRANKIE.EXE +$CLOSE LOAD +$GOTO INIZIO +$E2: +$ON ERROR THEN GOTO E1 +$OPEN/READ FOR disko:FRANKIE.FOR +$CLOSE FOR +$WRITE SYS$OUTPUT " DEVO COMPILARE IL MOSTRO, ATTENDETE UN ATTIMO PREGO." +$FOR/OBJECT=FRANKIE.OBJ disko:FRANKIE.for +$LINK/EXE=disko:FRANKIE.EXE FRANKIE.OBJ +$GOTO INIZIO +$E1: +$WRITE SYS$OUTPUT "SORRY I CAN NOT FIND THE MONSTER, IS HE ESCAPED?" +$WRITE SYS$OUTPUT "I ADVERT YOU : FIND HIM FOR YOUR SECURITY!" +$WRITE SYS$OUTPUT " IT CAN BE THAT HIS FOOD IS LOST,HE CAN BE HUNGRY!" +$EXIT +$INIZIO: +$ON ERROR THEN GOTO E3 +$OPEN/WRITE UN1 UN1.DUM +$OPEN/WRITE UN2 UN2.DUM +$OPEN/WRITE UN3 UN3.DUM +$OPEN/WRITE UN4 UN4.DUM +$OPEN/WRITE UN11 UN11.DUM +$ASSIGN UN1 FOR001 +$ASSIGN UN2 FOR002 +$ASSIGN UN3 FOR003 +$ASSIGN UN4 FOR004 +$ASSIGN UN11 FOR011 +$ASSIGN/USER SYS$COMMAND SYS$INPUT +$RUN disko:FRANKIE.exe +$CLOSE UN1 +$CLOSE UN2 +$CLOSE UN3 +$CLOSE UN4 +$CLOSE UN11 +$TY UN1.DUM +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " " +$WRITE SYS$OUTPUT " BADA,BADA, SE TI SERVONO PRODOTTI DEL MOSTRO" +$WRITE SYS$OUTPUT " SONO SUI FILES : UN1.DUM ETC." +$WRITE SYS$OUTPUT " SE NON TE LI PIGLI POI IO LA BUTTO VIA QUESTA" +$WRITE SYS$OUTPUT " ROBACCIA MOSTRUOSA PRODOTTA!" +$E3: +$INQUIRE ANCORA "VUOI ANCORA OROSCOPI?" +$IF ANCORA.EQS."ANCORA" THEN GOTO INIZIO +$DEASSIGN FOR001 +$DEASSIGN FOR002 +$DEASSIGN FOR003 +$DEASSIGN FOR004 +$DEASSIGN FOR011 +$EXIT diff --git a/code/vari.for b/code/vari.for new file mode 100755 index 0000000..345a3f6 Binary files /dev/null and b/code/vari.for differ diff --git a/codemeta.json b/codemeta.json new file mode 100644 index 0000000..70ec83b --- /dev/null +++ b/codemeta.json @@ -0,0 +1,44 @@ +{ + "@context": "https://doi.org/10.5063/schema/codemeta-2.0", + "@type": "SoftwareSourceCode", + "name": "frankie", + "description": "A VAX/VMS FORTRAN program for horoscopes." + "codeRepository": "http://legacy.helldragon.eu/gitweb/frankie.git", + "downloadUrl": "git://legacy.helldragon.eu/frankie.git", + "programmingLanguage": "VAX FORTRAN", + "operatingSystem": "VAX-VMS" + "license": "Public domain", + "dateCreated":"1984-12-01", + "datePublished":"2019-12-26", + "developmentStatus": "Unsupported", + "creativeWorkStatus": "Legacy software" + "keywords": [ + "frankie", + "lunar motion", + "horoscopes", + "ephemeris", + "planet motions", + "planet position", + "astrology" + ], + "author": [ + { + "@type": "Person", + "givenName": "Marcello", + "familyName": "Galli", + "email": "marcello.galli@tiscali.it", + "web":"http://www.helldragon.eu", + "@id": "https://orcid.org/0000-0002-9135-3228" + }, + { + "@type": "Person", + "givenName": "Enrica", + "familyName": "Baiada" + }, + { + "@type": "Person", + "givenName": "Sabina", + "familyName": "Mengoli", + } + ] +}