![Alignment of the Giza pyramids with data measured by Sir W. M. F. Petrie [6] (distances in m). Two numbers have been slightly corrected: The long diagonal is 936.16 m rather than 936.19 m, and one angle is 31° 55' 13'' rather than 34° 10' 11'' (explanation in [5, p. 96; 6, p. 125]). The relative elevations stem from S. Perring (see: [9, part IV,
map 1]). Detailed information is provided in the drawings of Maragioglio and Rinaldi [9]. The angles were calculated from the original distances, given in inches (1 inch = 2.54 cm).](https://www.researchgate.net/profile/Hans-Jelitto/publication/380874458/figure/fig3/AS:11431281247148307@1716646672702/Alignment-of-the-Giza-pyramids-with-data-measured-by-Sir-WMF-Petrie-6-distances-in_Q320.jpg)
Content uploaded by Hans Jelitto
Author content
All content in this area was uploaded by Hans Jelitto on Apr 08, 2025
Content may be subject to copyright.
Planetary Correlation
of the Pyramids at
Giza and Teotihuacán
The main editions
Supplementary text
!"#$
% & "'()*(+,$-#$
! .$/00123
%$
1st Edition4./04 2
!$5
*% 6
%$
2nd Edition 4/072!
4$1$424
%282
2 +2$
3rd Edition )/0//" 25%/0//#
%6
%92:!
%$5%
;4$/$
%2,./0$.
$
4th Edition */0/" 2)$/0/4#.$4
&%&$% :"#
&"4$0$<#$=
:2
4$0$1$.$/$&
6;"$/$$/$4#$6
4$0$< 2
&)/$. 4$
Copyright ©/04>/0/
!
"++0+/0/$ #
& &
>54/?144
>(:"/#"<<#
>&)
2
(CC) BY-NC-SA 4.0$
.@@2$@@%++@4$0@
@@2$@@%++@4$0@
3
% 25$4/?144
(:$"/#"<<#:$55$4
?1$)
)/ $ $ "%
$)#$5
00 +
2 AB +
@5%C?1$
(/+/01D%
*/0/
This work is dedicated
to my parents
Karl and Käthe Jelitto.
3(%.
2%+
$
!%
. $
% $)
2!%$
!"
!#
$%!!
!&$$
$#'%
$"$
!& % # !(!&
"%!%
#)%$"%$$!$%
"&"
#
#
'!%%"$
*$+#*#*+#*#+$
,#*$,#-#+$,#*.$#/%!
0"1!!%
"!2#3
2#4' $
,%!#
$5 *
$"%
#)$!
!$#0"$
(!!#
$5
!"!
#%364
37 4 " # (&
%!5
%!%"#8%$
!#
!"
75#
& $! !
!
!!96:#;
"$!
!#0
! " *$
+#*#,$+#+#*<+#+#=+$+#,#<$+#,#*.$$
#
&$.>=.==#$
5!+=!#0
+=!$"#<
" ' +=! %#
! %,&$
+=!%5!,+=#0
,$$#<$
"!!5!
#6'!=.==$
%!%#
) $ "
!!"
,#0(&5
$!%
$! "3.#4;
$5
#
/&0&
0
!$$$&!#
$%&!%
?/@A!$##$?/@*<$0
?/@5
30#4
5#
6+#,!$"
5 *#%
&.>=.==#!"
B.+=.=##(*
#0!
(%1$
%!
)!,#*.#-#
$ ::$ % 5 =
&$.+=.=#$!"
"!2##05$
!
,#*.#C#'$
#=#*# $%
% #=#+$
#=#,8:6#'
6!=.=,7=.=$
5D#
Contents
1. Introduction$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
2. General technical information$$$$$$$$$$$$
2.1 Data files and other related programs $$$$$$$$$$$$$$$
2.2 How to start the program$$$$$$$$$$$$$$$$$$$$$$$$$$ 1
3. Program features$$$$$$$$$$$$$$$$$$$$$$$$$ ?
3.1 Quick start options 1–22$$$$$$$$$ $$$$$$$$$$$$$$$$$ ?
$$%"D8#$$$$$$$$$$$$$$$$$$$$$$$$ /
$$/6"D8#$$$$$$$$$$$$$$$$$$$$$$$$ 4
$$%E$$$$$$$$$$$$$$$$ <
$$4% ;$$$$$$$$$$$$$$$
3.2 Quick start options for the book tables$$$$$$$$$$$$$$ //
$/$7!"#$$$$$$$$$$$$$$$$$ //
$/$/7!/"#$$$$$$$$$$$$$$$$$$$$$$$$$$ //
$/$."#$$$$$$$$$$$$$$$$$$$$$$$$$ //
3.3 Detailed options (0) $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /4
$$%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /<
$$/F$$$$$$$$$$$$$$$$$$ /<
$$,.%2$$$$$$$$$$$$$$$$$$$$$$$$$$ /<
$$4,.%$$$$$$$$$$$$$$$$$$$$$$$ /1
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /1
$$<6%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /1
$$1%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /1
$$?* $$$$$$$$$$$$$$$$$ /?
$$. $$$$$$$$$$$$$$$$$$$$$ /?
$$0A.C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /
$$6 A.C$$$$$$$$$$$$$$$$ /
$$/, %$$$$$$$$$$$$ /
$$8+ $$$$$$$$$$$$$ 0
$$4 (G $$$$$$$$$$$$$$$$$$ 0
$$. $$$$$$$$$$$$$$$$$$$$$$$$$$ 0
$$<$$$$$$$$$$$$$$$$$$$
$$1.%8%%$$$$$$$$$$$$$$$$$$ /
$$?%" %#$$$$$$$$$$$$$ /
$$;$$$$$$$$$$$$$$$$$$$$$$$$ /
$$/0 ;$$$$$$$$$$$$$$$$$$$$$$$
$$/F ;$$$$$$$$$$$$$$$$$$$$$$
$$//F %$$$$$$$$$$$$$$$$
$$/F$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$$/46&% $$$$$$$$$$$$$$$$$$$$$$$$$$$
$$/* $$$$$$$$$$$$$$$$$$$$$$$$ 4
3.4 Some program outputs $$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
$4$0$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
$4$/H!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ <
$4$H!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 1
$4$4H!4$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$4$H!1$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 40
$4$<H!0$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
$4$1H!$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4/
$4$?H!4$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
$4$H!$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
$4$0H!/0$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4<
$4$7!/0"A./C#$$$$$$$$$$$$$$$$$ 41
$4$/7!/"A.C#$$$$$$$$$$$$$$$$$ 4?
$4$7!4$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
$4$47!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$4$7!/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /
$4$<7!0$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$4$1F :!$$$$$$$$$$$$$$$$$$$$$$$$
4. Technical and theoretical basis (Giza)$$$ <
4.1 Positions on the Giza plateau$$$$$$$$$$$$$$$$$$$$$$ <
4$$ %$$$$$$$$$$$$$$$$$$$$$$$$$$$ <
4$$/ $$$$$$$$$$$$$$$$$$$$$$$$$$ 1
4.2 VSOP – planetary positions $$$$$$$$$$$$$$$$$$$$$$$ ?
4$/$,.?1 2$$$$$$$$$$$$$$$$$$$$$$$$$$$$
4$/$/,.?12$$$$$$$$$$$$$$$$$$$$$$$$$$ <0
4$/$IG:$$$$$$$$$$$$$ <0
4$/$4)% %$$$$$$$$$$$$$$$$$$$$$$$$$$ <
4$/$,./0$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ <
4$/$<.++2 $$$$$$$$$$$$$ <4
4.3 Relation between pyramid and planet positions$$$$$$$ <
4$$+$$$$$$$$$$$$$$$$$$$$$$$ <1
4$$//++$$$$$$$$$$$$$$$$$ <1
4.4 Two fit programs $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ <?
4$4$53(-$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ <?
4$4$/' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ <
4.5 Coordinate transformation of planetary orbits $$$$$$$$ 10
4.6 “Celestial positions” on the Giza plateau$$$$$$$$$$$$ 1
4$<$A.C%% :$$$$$$$$$ 1
4$<$/A.C% $53(-$$$$$$$ 1/
4$<$)A%C$$$$$$$$$$$$$$$$$$$$ 1
4$<$4D$$$$$$$$$$$$$$$$$$$$$$$$ 1
4.7 Syzygy $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 11
4$1$%E$$$$$$$$$$$$$$$$$$$$$$$$$$ 11
4$1$/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 11
4$1$ $$$$$$$$$$$$$$$$$$$$$$$$ 1
4$1$4$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ?/
4.8 Universal Time$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ?4
4.9 Computational changes from P3 to P4/P5 $$$$$$$$$$$$ ?<
4$$%$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ?<
4$$/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ?1
4$$) E$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ??
4$$4 4$$$$$$$$$$$$$$$$$$ ??
4.10 Further specific features concerning Giza$$$$$$$$$$$ ??
4$0$* $$$$$$$$$$$$$$$$$$$$$$$$$$ ?
4$0$/:% $$$$$$$$$$$$$$$$$$$$$$$$$ 0
4$0$ $$$$$$$$$$$$$$$$$$$$$$$$$
4$0$4A.C $$$$$$$$$$$$$$ /
4$0$A.C$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 4
4$0$<)% :"#$$$$$$$$$$$$$$$$$$$$$$$$ ?
4$0$1 $$$$$$$$$$$$$$$$$ 0/
5. The pyramids of Teotihuacán$$$$$$$$$$$$$ 0
5.1 Planetary correlation and data$$$$$$$$$$$$$$$$$$$$$ 0
$$) $$$$$$$$$$$$$$$$$$$$$$$ 0
$$/ $$$$$$$$$$$$$$$$$$ 0
$$D$$$$$$$$$$$$$$$ 0<
5.2 Comparison of pyramid area and solar system$$$$$$$ 0?
$/$H2% $$$$$$$$$$$$$$ 0?
$/$/ H8$$$$$$$$$$$$$$$$$$$$$$$
$/$6$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 1
$/$4)2 .$$$$$$$$$$$$$$$$$$$$$$$$ /0
6. Summary and epilogue$$$$$$$$$$$$$$$$$$$ //
)!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ /
Appendix A1 >.6$$$$$$$$$$$$$$$ /<
Main program" #$$$$$$$"!#*
>"8#$$$$$$$$$$$ **
>$"%$D8#$$ *C
>/$"A CD8#$$$$$$$$$$$$$ =+
>$"E#$$$$$$$$$ =
>4$";#$$$$$$$$$$$$$$$$$$$ +=
> $$$$$$$$$$$$$$$$$$ +,
Subroutines and functions $$$$$$$$$$$$$$$$$$$$$$$$$$$$$ +-
– Program input –
> "#$$$$$$$$$$$$$$$$$$$$$$$ +-
> "@:!#$$$$$ ,C
> " #$$$$$$$$ ,>
> " #$$$$$$$$$$ ,>
>! "2 #$$$$$$$$$$$$$$ ,>
> "#$$$$$$$$$$$$$$$$$$$$$ ,<
– Time and dates –
>! "! J4#$$$$$$$$$$ ,<
> "2 #$$$$$$$$$ .
>!% "2F1«&+#$$$$$$$$$$$$ .
>K "LMJB#$$$$$$$$$$$$$$ *
>E "2F1®#$$$$$$$ =
> " #$$$$$$$$$$$$$$$$$$$$$$$ +
>!% "% !#$$$$$$$$$$$$ +
– Astronomy –
>2 ",.?12#$$$$$$$$$$$$$$$ ,
>2/ " ,.?1 2#$$$$$$$$$$$$ ,
>2 "IG:#$$ ,
> "#$$$$$$$$$$$$$
> ".>#$$$$$$$$$$$$$$$ <
>K "#$$$$$$$$$$$ -.
> " #$$$$$$$$$$$$$$$ -*
>,.?1N ",.?1+#$$$$$$$$$ -=
– Coordinates/ positions –
>!! "26#$$$$$$ --
> "%#$$ --
> "A.CD8#$$$ ->
>2 "2&#$$$$$$$$$$$$$$$$$$ C*
> "#$$$$$$$$$$$$ C*
> " #$$$$$$$$$$$$$$$ C=
> " %#$$$$ C+
> " 6#$$$$$$ C+
>!! "2#$$$$$$$ C,
>! "ACD8#$$$$$$$$ C,
>! "A%CD8#$$ C
>! "#$$$$$$$$$$$$$ C>
>! "6#$$$$$$$ C<
>8 "2#$$$$$$$$$$ C<
> " D.#$$$$$ C<
> / " #$$$$$$$$$$$ C<
> "!% #$$ >.
– Program output –
> " #$$$$$$$$$$$$$$$$$$ >.
> " #$$$$$$$$$$$$$$$$$$ >.
>/ "#$$$$$$$$$ >=
> "#$$$$$$$$$$$$$$$$$$$$ >,
> " %#$$$$$$ >-
> "#$$$$$$$$$$$$$ >-
>88 "#$$$$$ >-
> "#$$$$$$$$$$ >C
>8 "% #$$$$$$$$ >>
>2K " A+/$C#$$$$$$$$$$$$$ ><
– Fit routines –
> ";#$$$$$$$$$ ><
>2 " ,.2$#$$$$ <.
>2/ " ,. 2$#$$$$$$ <.
> " #$$$$$$ <*
> "#$$$$$$$$ <+
>! "#$$$$$$$ <
>53(- "53(- #$$$ <
>53 "53(-8 "&##$$$ *.+
>3O,)) "53(-2 &#$$$$ *.
>F3F(.H "53(-:#$$$$ *.C
Appendix A2 >.6" #$$$ ?/
> "#$$$$$$$$$$$$"!#*
>2 "!#$$$$$$$$$$$$$$ -
>! "#$$$$$ C
> " #$$$$$$ C
B @5%$$ ?1
3$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ??
' $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
D8(%
;*&
1. Introduction
%% D8 "5$P#$.%
%;"*&#$%
$"B'FP> 3
#5%%,.?1QP/R$
&%
D8$ %)E!
)"D#QP4R$2
% %%+
$7 : 8 %6
%6 %*%!%(,
*%2%$5%%$
72
%$ %
% $
%$
*%,(
D8%"5$PQ$PR#$5$P%.=$P*$P5$Q<R$
(&%(%2$$6Q1?R$
"!6)#G7#G'#H-I#"!
%!B<+-#*-<+-#*<$+*JGKG*+KK
+,JG*.KG**KK5H$#G<-D-$#G*=I#%%F#G6#GBH<$09$
*I#%"7/H<I#"
$%*L=#,#
!% D8%
(%6 6 *!4%%$3(%
D! 66 *%!$3+
%4%%%%/<00/4?0P76Q02$P3$P10R$
"76M 6$#?14 2
I% D8%
%")*.#QP/R$E8%(NS
.8$)*.2
246$ &6
%%00P/0P76% PT$
% &%400%U7 %
%400%!"Q$< $R#$
2 %D8+
*%,($ 3 !
QR$) !
%%D%>
&$&
2 $&4QR
*$ 8
$O>%&>2 4$
2:!Q4R$
7 D($
%% $
) % %+
.% %"5$/#$
2A.CD8$5
A.C6%$3!A.C
:! .
%$= A*C6%$
61K!
$7$9$1$#
!*=+#,#+&%#$!
#"!&#
/
35$!% 6%2
%E%$ +
AIVCAHGC %
&% $)
&!$2
%%2 (%%UO+
!:22
,% I$*2QR$
!$
G#!"7/H<$09$+CI
!/#6H*I#
. % %%
A.C &%A.C(V &%
1/< *%!%"5$#$A.C
8 &%(V %
% $3&+
%A%CAC+ 5$P/$
(V " (V#
$*24$0$/%(:$"4#4$1$$
5
*%,(*.2%
$ "E#
%8%"%8%%#$3&
*%,.G!$)
2$
%$.
$
$6& 6%
%$
%00%%%"
Q$/4>/R#$) +
> 8 6% &>%2%
$
)%;*&$
*&% ;"5$4#22%
% % D8$
#$&=..$%
%#M$"!!<.J#61/1 /0 1
?@?/ #08 M#71E#/ !08 NMO*>C#
4
;
$
,.% % $
2!%%
%"*.(&F 6#$):2
$$23$
2. General technical information
%%,.?1 QP/R2%
$P7D$P57F%3*66(3
W:WWWW"B'FP/#$,. ,.W
W?1 % "?1#$ ,.?1%
52 3*66("B'F#$*
22$$,./03O3O/
$$4000<000% !+
$O2 ,.?1%
% ,.?12
2$4$/$$
)+ 53(-" &#Q<P1R2%
D$P=$P.N%!+FI I"I 8I%I3
I3 %B'F4#$5
! %$*Q?R2 $2+
"#B2"B# PMPP>PB%
5$(!$*"O).)(=.B'F%(& +B'F
<#$ 5$
! G
"B'F#$O!B'F2% 2
3$5 4$
2%237* 511
",$0'%+*5#.5@6=%$=
DOB511BF&"DOB#D5$3
5%$
3 66XX2%$+
2 : 5
%$3
% &%
,.?1$"32 $#
2.1 Data files and other related programs
$) +
2 2
& $'
'()*(+!$
<
+-B$5$,1#$"BK"!?/@*#
File Brief description
5
(&+ <4+%
(&+ <4+%
.+$"3 :/+2
%/+$#
.+$
B %
% D8;"!#
. !
O%%,.?1 75
,.?1% 75
! "3 &%$#
"#" )% " "$ #
"$ :!//
>QR 1>?$7Q4R$
"%"& '()* %D8
"#$"# *%,"%#
"+ .,.?1 *%*%%
$P* Q?$? $R
" % 2 ,.?/!
$P* Q?$/00 $R
" # " "$$D.# ;
), )%(
), (& " #
-./#$ *%,.?1)/000$0
-./# , $$$GG$$$
-./#$ ( $$$GG$$$
-./$ * $$$GG$$$
-./0 $$$GG$$$
-./ . $$$GG$$$
-./$ B $$$GG$$$
-./# O $$$GG$$$
-./#1 (+*%$$$GG$$$
-./2#$ *%,.?16%:&
-./2# , $$$GG$$$
-./2#$ ( $$$GG$$$
-./2$ * $$$GG$$$
-./20 $$$GG$$$
-./2 . $$$GG$$$
-./2$ B $$$GG$$$
-./2# O $$$GG$$$
'()*(+2?12?1$2%2
,.?12%%75"
3*66(#$ $&
$&2 A$$$C %
$) :! $$5$
+ $ $
% :!
$$3 $ %
$ $%%
:!$ $
8$ 53(-&
%%$3$2"(#
*%, $
,.?122$! Q?$P?P $R$
2$ % %
,.?/Q?$P/00 $R$5;%
2 $$) ,.?1)$ ,.?16$
2 %%QP/R2%%$%2
52 3*66($
2 %
9Q4R$
&2 (2 $)
QR$5'*+/.(I)O+/Y+
/1<+/ %
D8%$ )B*+/ 2%
(%"(#P !%
*Q?P$P<R$.IYDF7(QRAC !%
!.**!%=%+
2%($3%*!)$%"B'F1#$
3E%!'3O%'$P72
)$PDQ/0R$= !
:2%2 $
72D %$
'3O%Q$P1P $4P $R$%QR
*.6"*#Q///R$*
+ .Q/R"B'F?#2$
5& !2
B "F #3!D3*$
2.2 How to start the program
:%$) ! "+
+0+/0/$8#% "%#
AC &$3%F&
2F&B$3 %+
%%$ $3 =
%$ = 5 "$$
D5*D=6%#$F&=+
F& 6!I&%,7&$.
BB5+?3.??+$
13QR *Q?R("(%%#
"#$%"#2$
1
) B$$:
$ "3 ?0 9%
4?>$$$#3 &
$$
" #$3
AC 34#5 46 % +
7#5 47↵$O $ ↵+
!%$<4+%%P47↵
47↵$
AC +$)% %
4P↵4P↵$3
%78!797↵$3 DOB5
%$ $ "/:7↵$5
%$ $# ""1%$ $/:7↵$5/+%+
& 224$
)GU3&$
3. Program features
) %
;<)=2/;)(/<
$%$>$
?"&@$"?$# 1#$ $" @&@%@)# "
#$ A+B#$ #$AB#$$@ $A++B?.5A+B
#$ ABC##$#DAB-# $A+B5A+B
#AB #AB@&@%@A+B?.%A+B
+@AB+@AB@&@%@A+B%A+B
#$#"AB'"""&#A+B)=) # A+B@AB
"A+++B# "# "ABA+$15 "BEF
$3
$ % D8<
0D%%E+
</0 ;$% +
2 %E"%8%%#$
)% *%,E.%
$2 +
& $
3.1 Quick start options 1–22
O%0 2 +
$ &! 2,.
2% A.CD8
?
&&% $32
:!// %
%$"///%$#5&
%+7↵!, % )00)4000$
")M 6$#
)<.()./'-<,.
A%## $" $" #> #$$# $" "#))B
G "+H
-./2>1#$>#" " #>-# $"
#$"A@#$B$+ >I4?$#%#$
4 #4 "#E(((#$# ((((-#JKL.
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
@++EEEE++EEE+E+EE
@++E+E+EE+E+E+E+E+E++E
A?$#%B
#++EE+EE+EEEEEE4
#++EE+E+E+EE+EE+EE4
I#++EEEEE+EE+EEE
I#++E+E+EEEE+E+E+EE
#++EE+E+EEEEEEE4
#++EE++E+E++EE+EEE+E4
I#E+EEE+EE++EE++EE+
I#+E+EEE+EEEEEE
++#++EE+EEEEE+EE+E4
#++E+E+EE++EE+EE+EE4
++I#E+E+E+E+++EE+E+E+EE+
I#+E+E+EE+EEEE+E+E+
+#EE+EE+EEEEE+E+4
+#+EE+E+E+EE+EE+E+E4
+I#+E+E+EE++EE+EE+E+E++
+I#E+EEEEE++EE++EE
+#+E+E+EEEEEEE+E++4
+#+++EE+EE++EE+E+E+EE4
+I#+EE+E+E++EE+EEE+E
+I#+E+EEE++EE+EE+EE
+#EEE+EEE+EE+EE+4
+#+E+E+4
+I#+EE+EEEEE+EEE
+I#+E+E+EE+EE+E+E+EE
H+#+E+E+E+E+EEEEEE4
I#+E+E+EEEEEE+EE+
+I#+EE+E+E+EE+E+EEE
#+E+E+EEE+E+EEEE4
I#+EEEE+EE++
+I#+E+E+EE+EE+EEE+E
#+EE+EE+E+EEE++E+E++4
I#EE+
+I#++EE+EEEE+EE+EE++
#++EE+EE+EE+E+EE+E++4
I#+E+E+EE+E+EE+E+E+E++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+++AK4K##"%#B
)# ## %#E+
# # # $" E
2# $4%$&"% $" E+42, "#EE
$ "#EE#$
%$
% $3
:!$3 2
2
$ 2 %2
,.%%
"$$ #
$ %% ;$
3! &$) 2
!22$!
222%%+
$)%82%2
2$) 2% +
$ & 2
6B$$*
! 2$4$
O&& & 2$3
2")00000#
%% 2% $3
. *%,(*$
2"@#E%8%%$
%2%2IG:$
$
2 $5$
$4$" E>/>2
D8%$#
;<).(<;(<A.=N=?=B
A%$$%##" %" #;"""&#>IB
G "H
KC##$#D "K>#" " #>"#$#$$@ $
#$"A@#$B+ AB%$$%#E#%
5I@#$ J@L;;;;#;;;"
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++++
#%J,L## $#"#$JOL#$J,L
#$+++
-#+++++
$+++++
$++++++
I+++
. +++
,$+++++++++++
<#++++++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++++
#%J,L## $#"#$JOL#$J,L
#$+
-#+++++++++
$++++++
$+++++++
0
I++++++
. +++++++++
,$+++++++
<#++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++
#%J,L## $#"#$JOL#$J,L
#$+++
-#+++
$++++
$+++++++
I+++++
. +++++
,$+++++
<#++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++
#%J,L## $#"#$JOL#$J,L
#$+++++++
-#+++
$+++++
$+++++
I++++++++
. ++++++++
,$++++++++
<#++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++
#%J,L## $#"#$JOL#$J,L
#$+++++
-#++++
$+++++
$+++++
I++++++
. ++++
,$+++++
<#++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E++
<1#$@&@%"#E2, "#EE
$ "#EE#$
//:!%
&$ 2%
0" 204/0000004//#$
) 2$$3
%:!//$:!
!QP4R$
5QR4 +
%000P76)1000%8
%"D8#%$
4$52
/Q4/4R$
3.1.1 Pyramid positions (Giza)
!QR
% D8"5$#$*%6%(
6 %,*%!%*%$!+
%2$:
8 %$&2 :
0$/PT$5% 2% :+
&%0$00PT"4$0$<4$0$1' $Q4R#$=6
%9 2P"V
.# :
6
91
96
9
9
91
99
6
67&
P1
P7
"#>"#
"6%# "6 %# "*%!%#
/
!"
#2%#7
5#'%%!$6!
-!$!..HI
'#**#C=-
,#+#*#
:*BZ#$ A+BK"6 $#
AC +$ %+
%$2 %2
% : %G$
%*%% 2
.$22%00076)1000$
,.?1% %
$O2 Q/R"4$/$4#
2%%% $3
,.?1%$
%&$
2%%$.
! $
4% %
QR$2QP$P4< $0R$5
$$4$/$
:=BK#$ ABK
/P$ %E8
(G $)% E
2% (G$ 2!+
"Q$4$/1R#$
:+BK #ABK
"#2: /$%+
*%0??<0$$"#22
4%D8$*%+
$"O(:$P"#25$PP7 $#)%
*% O +
D8"Q4$/4$)/R#$
2$4$"Q44R#$
:,BK+@ABK
3 /"%#$+
2 ? ?
/" A+7@C#$ +
%$6
Q4$//$7$)/R$4$4$
:BK#$#"ABK
% % D8
*%$3 *%,
(%%*% %
$! %
!*%$3 *%
"#"2,.?1#$)
52[0$PT9* [/PT9\\\
[0$PT$% *QR$
3.1.2 Chamber positions (Giza)
3%44% A%C /*%,
( D %$ )
*%&% .$
5$P<$OAC
A*CD%2IG$)%A.
C "#$5 &+
$4$$4$/$7
% 2".*%,(*#
%$"%8%%#&$$$
4
H=,IB
&"!$%$
!#!"!,,$"
7K!#:36$47D#"
*=# 34!"++.++#
#'5$#
%2&
HG2 %$&+&%+&
"5$P<#8+&$:!2
&
:-BK#$ #$ABK
$ %%+
D%*%%$
2200076)1000$
:CBKC##$#DABK
% 2 ,.?1$3+
%2IG:"
$4$4$/$#$2 ,.?/%Q?$P1P $R
: I2%$%
<$2% 2 ,.?12+
< 2$
= 0000%2/4?
!2P$
:>BK #ABK
>% %%
D%*%"
$4$#$&)10??<4$$"#$O%
% D%$322+
4 $3
E:!
>4$0$$ %5$P<
2 %2%$5
A*CD%40P2IG
"5$<Q44$$/$)/R#$
:<BK+@ABK
)%4<+A $C+
2/%A %$C
44%2%$
:*.BK'"""&#A+BK
$5
%)/00%)00%
%%$*%
%$5
2 2 "0$PT#8
% 8"0$4PT#$=2
400%40"$4$<#$
%%%% "?Q4
$/0$)$)/R#$
3.1.3 Planetary conjunctions and transits
6E2
!% &2$
5$P1$ % 0??
*%,(*.%
$) %8%% E+
$
5*%, .G$3
5$P?% ,%/0/$!,
*% ,2$
<
5!7$9$1$76#:
7*C$+.>>$6$"!7#
$$Q$$$7*7, !
77#'%%!$6""!
""#%#@@+#,J#
2> .
*%,>%!%$=20000
%" 00076)1000#%&
&& ]$
2%8%% *%,2%2%000%$
&% A C A%
C%44%U5<1
. %$)%*%
" Q4R#$
:**BK#$$@ $A++BK
*% %0000$)%
*%.
2$5 *%,4$1$4
Q/$P1>R$%0??%+
/$32*%"$4$1#$
:*=BK-# $A+BK
), "#
%004000$ *%,
:%*%$7%00000 %
/0%,
%$" %%
$#3 2 82
" $#$ 8
*%$32
%8 *%$
:*+BK@&@%@>A+BK
%"%8%%# *%,(
.$ %8%%
@PMP]$2/0000$3
*%,%8%%2" %#
*, *%,2
8$3
*%,$$*,$
%%000P76)1000+
]$O%
% %$3 %8%%!+
"0 *%^??0%#
!+\Q4/$)/$7R$2
,.?1"4$/$4#$
:*,BK@&@%@>A+BK
O*$
*%,(*.$
] %E"%8%%#$
2%%$5 00076)1000!$
)2 2%8%%%&
2 2%000%"$4$?Q4$/<$/R#$
1
:*BK)=) # A+BK
%!$Y* %
*%$ *%"# %00076
)1000$B3_6+/0*"/$D8?D7#Y*
4 /0 " #$
0000%/0 *%.40
$ 2 ,.?1$324
++%
& $)%8
Y*2
$) BD52
>4$/$<$"/
//E ,$)&,
5$?$#
6B% $*D86B$
) ! :%
% :%6B/$PD8P`P4PM//$PD8`$
E !%% $=
//$PD"%#//$P`P0%$36B2$
?
9FR-$=.*=$1#
*,34
!"96#96"
1#8"#1
)"61#
""==$"7H=$#,>I#
3.1.4 Planetary correlation of Teotihuacán
' 2*&%/00%
% ;$ 2%
)2 "5$#$)D8
%+
% $ = D8 *% * .
22;. +OE
.$50222 $
&6# %
"!!%#
3)2 $)
;%
$5 !
> %
A*C> 8 A*C
% A*$C"=A*C:!
A.C$#$2+
% $
2%22:%
% $*2 Q/</1R$
%!Q/?R 3
%,.% 75Q/R$3%
%2%*
,.?/Q?$/00>/04R$5; &
%%"#0$
$7#"
!7D'#=>#
/0
$ 2
"D*$#%%$$
$
/$ D.$+
%3 "D$# $
D.2>:4$<$4$
$ D.%%D.2
D. $
4$ 3;%
% $%$O2
%/2 %$
:*-BK?.5A+BK
% "D.
4$<$4#$ !
0$) 2%V
2$/$$$>$$/$
:*CBK5A+BK
3 D.%
;$!0$
AC! $"$/$#$
:*>BK?.%A+BK
7D.%A.C2%
8 A*C% A*C"&$
1#$Q/R$
:*<BK%A+BK
?&ACD.
$A.C"#
$%%"//PMP$0PT#D."//PMP$?0PT#
"//#2%"$4$#$
:=.BK@ABK
2 /000076)4000$"D."#!
0# 000% & +
2%"$4$0#$5D.
&// &%076"//PMP$?T#9 +
%1076"//PMP$4T#$
:=*==B
*%,00076)1000
$5 4?$)
./$
/
3.2 Quick start options for the book tables
* !QRQ4R%:!
!$%
%$)!2$
$5& !Q
$PR 2$%
0/0/ $3
%$$4Q$/1R8+
40$)%?$)?$7Q4R$$2?0?$
3.2.1 Book 1 (!")
3 QR%
$3
!%:$
30%!*% &
A.C% $
$$0>$$/4$<$+
2 % %%
%$ 0+
000$%2
2 $O2
0/$
3%2$O%
A.CD8
*%$3 !
2 ,.?1$) 2
'KK8%% ,.?12%$
34% ,.?1
2"$4$4a$4$<#$
!QRQR28%%
$ :!2 ,.?1$+
2 ,.?1$3 !
" 2#
1?"$$<#$
3.2.2 Book 2 (in preparation)
1>?$7"&/4><#Q4R:!
2%$/1$) :!/10$
!">#22!/"1>?$7#$
&%!!/$
3.2.3 Special test option (999)
F 2 2 %
%$32%
2%$$3++ $$3
%/$)&+
$2$."#%
//
:!%$6)B3OO
!%
$"#2"
$#%$5
! %$
./%2%2
>?04$ % +
/ %$32
&
%&%$
(& $
A,#$" " $%$> B
A)#" ""#+B1##" #1@ #B
A#$$#$#1@ #$%$P" # "B
A)#" ""#B$#P$" #1@ #B
A$%$ #$1##$$"B
A)#" 1@ ##$""#+BPB
A$ #$# "" 1#"#" B
A #"#"$ /@2();;)).1 $##$B
A ?"&)# ")# #$#(;MB
A<1#$" " #"#" ""#B
A 1#%#QB
$# #$# ##$ #$1#P
---(;(;(<"""51
---" $(.(,<(-(2;
---"5""!.)
-------""""$1"0
-----N(<N*5&0#+
---:(P"51P"P"
-$ $"#5(/(/,)
+B( #" AB2,)(/<E<#5$# #$Q
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++
+++
+
++
++
+++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
B; #" A "#!# >>+++B
++++
+
+++
++
+
++
999999999999999999999999999<999999999999999999999999999
/
=% %$+
/2%$+
/$3 % 2!
$$3 5$
&)2 $B %D$
Note:D%$!$
22$
3 ;:%+
$$ $
D.D*2%
('(=D$D.
AC! $3
2
$$$
"D.A2%CAC#$
% % 2$3
! 28 $3
2! $ $
Z$Z
R # A"M+>5M+B?. ?.%" 44R
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
R@$A.BRRRRR++
R&#;RRRRR++++
R.@$A#$$@BRRRRR+++
R1$$"#$+A-#BRRRRR++
R.@$A$ BRR9RR8R+++
R1$$"#$A$BRRRRR++
R1$$"#$A #$BRRRRR+++++
R1$$"#$AI" #$BRRRRR++++
R1$$"#$A. $BRRRRR++
R1$$"#$A,$BRRRRR++++
R".IA<# #BRRRRR++++
RS+'# A.#BRR9RR8R++++++
RS+AKBRR9RR8R+++
RS+1AKBRR9RR8R+++
RSAKBRRRRR++++++
RS1AKBRRRR8R+
RSAKBRRRR8R+
RS'# AKBRRRR8R+
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
R9H@$"4 ##" "A!"BR
R8H$"#$## P" #R
3.3 Detailed options (0)
3:!2+
% 2%$3?"#
# "#7 "7AB$$3+
/4
$$.
$3 %
$%%
$3 %%6PXP6
".PXP6D!%#$3 ! "#+
$3 :$7
22 $
$ % %"D$#;$
/$ F *%@,E 4$
$ ,.%2 ,.2 %$
4$ ,.% ",.?16,.?1#/000$0",.?1)#$
$ :$
<$ 6% @D%D$
1$ % %"(#B2"B#$
?$ * *%,($
$ . *%$
0$ A.C *%!6 %A.C $
$ 6 A.C /$.F(53(-$
/$ , % % %$
$ 8+ $
4$ (G E (*%,"/#$
$ . ">4#!+%%$
<$ @ 2$
1$ .%8%% %E%$
?$ %" %# 2 $
$ ; D."#"#$
/0$ ; % $
/$ F ; 2"$$$#A.$C
//$ F % 2"!#$
/$ F 0$
/4$ 6&% &$
/$ * %X &$
3 %
$(2$O
O% $
2$$$
/
3.3.1 Planetary positions
HHH?"&@$"A+B>?1#$AB>
04 $" AB>)# "ABE "#
"#% *%,(M %D8
"/#% *%,(M D$
"#"%8%%#
"4#;
$ "#
% D8"/#% D%$
"#2%E +
2%*%,$ % "#
*%!%$&+&%+&
8+&$5"/#&
HG2 %$&+&
%+&8+&$"4# ;$
3.3.2 Linear constellations and transits
)$#$A+B>-#AB>AB>ABE "#
"# *%
"/# ,
"#E *%,("$ #
"4# E *%,(*"ZZZZZ#
"204 $" AB#2 2
$"#"/#$"#%8%% *%
,(."4#%8%% *%,(*.$
="#*%(%2
$%$
="4# 2$( *%
* *%( ,*$3
&$3 !
%$"3 a
:a8M">#`">/#@/b$#
3.3.3 VSOP theory versions
-./1"A+B>$ #$"AB>
C##DAB>#$"ABE"#
"# 2 ,.?1%
"/#2 ,.?1%*Q?$? $R
"#%% Q?$/00 $R2IG:
"4# 2 ,.?1%75Q/R
"#"2IG:# %$
"/#",.?1P2# $"4#" ,.?1
2#$"#"
,.?1P2# % "4#$
"# "4# $
/<
3.3.4 VSOP coordinate systems
.@ ###A+B>IABE "2#
"# "%:&#
"/#%/000$0" /000/00F1M/44$0#
% ,.?1P%$
,.?122% "#$,.?1 2
2IG:2 %$
3.3.5 Transit options
##D;A+B>#$# AB>#AB
#" "%#ABE "#
"#!:"(#
"/#!"#
"# (
"4#": 4?#
"#"/# &$2
!$% 2
2 $"#%4
% $3"4#
! . $3
"c #6"+
#" (#$%"4#
:!///: 4??0+
$
3.3.6 Calendar systems
2#$@?$#%A+B>I4?$#%ABE "#
"#D
"/#) D
"#%D $3
% 41/76)?/D
$3! 41/P76
2
%$3D
$
$%%%
$".)B*+/$#
3.3.7 Time systems
)"#@ #I4))A+B>,)ABE "2#
"#("(%:#"#2%
"/#B"B2#
/1
( %$B!
(G
"B6#$7 (G+
%$="/# B%:+
LPMPP>PB 5$(!$*Q0R"4$?#$
3.3.8 Mapping of planets and chambers
# -A+B>-AB>-AB>
-AB>-AB>-ABE"!#
"#(>,>*% "4#,>*%>(
"/#(>*%>, "#*%>(>,
"#,>(>*% "<#*%>,>(
2:IG HG
"!#6%$"#
%!$ ! +
$
3.3.9 Search method for the dates
%#4#$$#4#$$##
A+BABABABABE "#
5"#"4#
. ##$#$$@%#E"&#
. #P" A$>$#BE "#
"#*%
"/#*%
"#2 *%
"4#2 *%
"#% "2#
O "#"#2
%$3"#%*%
$"/# $3"#"4#+
22
*%2%$ &22%
2% : " #/$3
4P`P/PXPPMP/! $3"#
% $%
28%
$
5"#"4#"2#! 2
$5: *%9
:$32&
/?/"#$= "%8%#
,.?12%2"IG:#
&
/?
. #P" J$LA"#$BA$#BE "#
22@
"$$]#
2"$$+#@&2%2$3
0$02% @
2"$$]#8%8@$ %
8@% ,.?12$
3.3.10 “Sun position”
.@5A+B>2#$AB>$##ABE "#
"#A.C &1/< *%!%
"/#A.C &< 6 %
"#A.C
3"#"/#A.C *%!% 6 %
A.C&%J& +
%$2% $$5$P
"%
/5$P#$
3"#A.CD8 &
%$O & $A.C
D8 &%% *%,(
%$
3.3.11 Computation of free “Sun position”
.A+B>4.;AB>4'()*ABE "/#
"#A.C /8"(G #
"/#A.C % :".F(#
"#A.C 53(-
=%%%+
% A.C $
2$"# %
$"/#"# % A.C
D8 %D%"
4$<Q$)<R#$3 2%
%A.C
2%$3 A+B&$
3.3.12 Vertical coordinate of pyramid positions
&$1#A+B>2AB> ABE "#
"#8+2 %
"/#8+2 %
"#8+ %
/
= &%%
$22$ %""/##
: %$"#"/#%
"#$
3.3.13 The z-coordinate of chamber positions
:# A+B>"#AB>P# ABE "#
"#
"/#
"#
= &% &J"8+
# $7%
222$
3.3.14 Datum plane for Earth's surface
2$#A+B>#$AB>-#ABE "#
"# E" (V#
"/J4# E *%V
"# E ,V
5/+"$$"##%E
2%$"3%%E2%
(G $# % (*%
,2%$ (G"%,.?16#
%*%, "
4$Q$)$P/? $R#$5*% 2+
""/>4##%$
2 $
3.3.15 Specification of timing
2 #A++B>5<A+B>IABE "E#
2 #A++B>@#$A+B>IABE "E#
">4# 42Q$$?R
"# &+" *%V#
"# %
"0# ("(%%#
"#"4# %4$=
%$&+"# *%
"$$"#"/##$
8 %/000$7 2$5
F1 % & (:$ "/# 4$$ &+
"$$#$O%" #
2 $
$
0
@#$7A+B!2$%
2%$IAB% %(
$O&2 %
5A$#BE "!#
$@#$A$#BE "8#
"@#$A$#BE "8&#
IA$#BE "8E#
%(%E!&+2+
%"#2%$
3.3.16 Tolerance in degree or percent
)#$##%-#>$ A$#BE "#
!' #"4#$A$#BJTLE "#
)#$##%-./$ A$#BE "#
KKK-./A$#BE "!#
!'-./$ #$A$#BJTLE "#
KK-./#$A$#BJTLE "!#
!'>-./$ > $ " "JTLE "#
KK-./$ >"$%#JTLE "!#
%$%##" %" #A$#BE "#
%$$%#>-./$ A$#BE "#
KKK>-./A$#BE "!#
% >2%
%% %>
" #"2
''K'KK4$$4$$/QR#$ 2
$)% $
=A2C"$$"#"4##
"#!/00076)4000A
$C) %&
$3 2/2
%"#%2
$%% +
2$ "2#
%
!' #"4#$A$#BJTLE "#
KK"#$P" $" "%JTLE "/#
KK$" 1#@#"4#$JTLE "#
!"2#
%$)%MPT/
MPPTPMP0$/PT":!1?#$3
,.?12QR2+
2"#$) E% ,.?12$O
:! ,.?1 2$5+
E%
"$$0$09&$4$4a$4$<#$
3.3.17 Syzygy with simultaneous transit
0 "A+B>@ $" ABE "#
"#"%8%#
"/#%*%,
"#=
2
:2@"$$]#$6%*%,
%!*,$3 8
!2$3
% *%,$8
$
3.3.18 Polarity (orientation of planetary orbits)
-"#P$#" "<$ A+B>. ABE "!#
-"#P$#" <A+B>.AB><4.ABE "!#
"#!
"/#!
"#!
=%%/%
E(G % &
(G$3!$=
! ""## ""/##$
+2 $%
2!! $5%"#%
"#"/#$ "#"/#2"#$
3.3.19 Distances in Teotihuacán
" #?.A+B># #$AB>ABE "#
"#D.+
"/# &
"#"$$#
="# D.:+
4$<$4$
AC" $#2%
$O $$3
"/#!% $@ $"
%D.#$"# $
$) $
/
3.3.20 Time scan for Teotihuacán
$ #@#$A$#BE "8#
" #@#$A$#BE "8&#
. #P" "@#$A$#BE "#
"#%$
2%+E&% +
%2% $ 2%
%$*Q?R ,.%$3 %+
% $
3.3.21 Length unit for Teotihuacán
)# "" %"#A+B>KKABE "#
"# 2 $"D."#$$$#
"/# %A.C6"8 *#
"# ! D.
$@$="/# 2%
8 A*C% A*$C
3.3.22 Length unit for planetary distances
# $@" >5"# #$A+B>.ABE "2#
"#!
"/#
3"#%2!"/#
"<0?!Q/R#$
3.3.23 Logarithmic base
;%$1#+A+B>AB> ABE "#
"#0
"#
"4#%
2 %0$2%
:000"4# &"+
#$O"/#$
3.3.24 Complexity of output
/ $A+B>#! ##ABE "#
"#
"/#2
3"/#8 $+
%%C##DAB$
3.3.25 Mode of program output
A+B>"#AB>#"AB>#!" ABE "#
" $A+B>8"#AB>#!" ABE "#
"#%
"/# $&
"# "/#:" /#
"4#
="#%$="/#
% $&$ 2
"/#"#$2 $&+
$"#$$
I(%
#A.C53(-"0#
" 53(-
%
J@L "#
* (G
%"#$
2 Q4R$5/+
"#%D8
25$P<"!0>#$=%2+
% AC /%2
2$="4#$+
%%%6PXP6".PXP6D!%#$
,.?1N53(-
5'')O$ "&)#&4$
) 2Q$)4>)<R$
3.4 Some program outputs
. %2$$
= &+
&$%
+2 $.$4$12
:!$O %&2
%$
3.4.1 Option 0
=02%2+
2% $3 &
*% . %0//00$
$
3 HHH?"&@$"A+B>?1#$AB>
04 $" AB>)# "ABE
)$#$A+B>-#AB>AB>ABE+
-./#$"A+B>$ ABE+
4
##D;A+B>#$# AB>#AB
#" "%#ABE
2#$@?$#%A+B>I4?$#%ABE
)"#@ #I4))A+B>,)ABE+
$@#$A$#BE+
"@#$A$#BE
/ $A+B>#! ##ABE+
" $A+B>8"#AB>#!" ABE
)<.()./'2,=
A%## $" $" #> #$$# $" "#))B
G "H
-./2>1#$>#" " #>#$$@ $"
#$"A@#$B$+ >I4?$#%#$
4 #4 "#E(((#$# ((((-#JKL.
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++@+EE+
++<+EEE+E++E+E++E+E+EE4
+<++EE+E+E+EE++EE+++E+E+4
@+EEEE+E+EE+EEE
<++EE++EE+EE+E+E+E+E4
@+EE++EE+E+E+E+E+E+E+++
+<+EE+EE+EE+E+E+E+E4
+<++EE+EEEEEEE+E4
<+EE+E+E+EE+E+EEE4+
+<++E+E+EE+E+E+E+E+EE4
@E+E+E+EEE+EE+EE
<+E+E++E+E++EEEE+E++E4
@+++E+E++E+E+EE+EE+++EE+
++<++EE+EE+EE+EE+EE+4
+<EEEEEE++EE+++EE+4
<E+EEEEE+E+E+E+E4+
@++EE++EE+EE+EE+EE++
<EEEE+E+E+EEEE+4
+@+E+E+EE++EEEEEE
++<+EE+EE+EEEEEE++4
+<++EE++EE+EE+EE+EE4
<++EE++EE++EE+EE+EE+4+
@+EE+EE++EEEEEE
+<EEEEE+EEE++E+E++4
+@++EE+EEE+EEEEE+
+<+++E+EE+EEE+EEEE4
+<++EE+EE+EEEEE++E+4
<+++E+E++EE+EEEEEE+4+
+@++E+EEE+EEEEEE++
++<+EEEE+EE+EE++EE++4
+@++EE+EE++EE++EE++EE
+<+E+EE+EEEE+E+E+E4
+<+E++E++E+E++E+EEE+E+E+4
@+EEEEE+E+E+EEE++
<+EEEEE+E+EE+EE4+
++@+EE+EE+EE+EE+EE
+<++EE+E++E+EE+EE++EE+4
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E++AK4K##"%#B
)# ## %#E+
# # # $" E
2# $4%$&"% $" E+42, "#EE+
$ "#EE#$
* 2$4$1$& &
2%$ :!$
3.4.2 Quick start option 1
;<).(<;(?<<):()U)U=(./'?(N
A#$$@ #"B
G "+H
-./2>1#$>#" " #>K.K$##>2>'()*
<.>@#$+ +A+B> #$#'G+4+T
5@#$;;;;##" !.@.&.$'JTL
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++++9
++++++
+++++9
++++++++
++++++
+++++
++
++++++++++++9
+++++
++++++9
+++++++
+++++++9
+++++++++9
+++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+AE$" @>9"#P$# B
# # # # "E+2, "#EE
$ "#EE#$
) #$#7'22,.?1 2$)
%A+BD+
% 9ABD+
"%#$E
2
+>+H !
5 *%"#"$$#
@#$ %"%0&94$$#
;; *%,
;;# *%(
# 53(- "$)#
" 53(- A.C
!. &+ A.CD8"@., &.#
$ % A.C%"4$$/#
%92 "M#
'JTL 2% %"#%
353(-I($3QRQ4R22'
''K$'KK $:
<
%2%%$
00"Q$0R#$
3.4.3 Quick start option 3
;<).(<;(?<<):()U)U=(./'?(N
A#$$@ #"B
G "H
-./2AB#$>#" " #>K.K$##>2>'()*
<.> # "+>IM>@#$M+AB
#A?$#%$>))BM+@>E+E>)$@
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
5@#$;;;;##" !.@.&.$'JTL
;V;V;#V##
!@&!@&!#@#&#
!!!#!@@@#@&&&#&$##" "
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++++++
++++++++++
++++
++T
#"%#A4-44BE++
"" ""A4-44BE+
#$"#""A4-44BE++++++++++
$*+>*>*W# E++@
#$%*>*>*WE++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
!J,L@J,L&J,L;V$J,L;;#
#$+
-#++++++++
$++++++++++
$+++++++++
I+++++
. ++++
,$+++++++
<#++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2## ""?"&1@!JL@JL&JL$JL
;$" #.+X
#K# K#$$@+++G
A@$"" "B-#G
$ ++G
$++X
I" #$+
. $++++
,$++++
<# #++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
AKGK#! #" "$B2, "#EE+
$ "#EE#$
1
3 2
-./2AB#$>#" " #,.2
Y.Y$## A.CD8
A.C
2 28 % %
'()* A.C% 53(-
<.2 & +
"#$4$/$
:
;V *%
;V;#V## ,(
!@& 6 *%9&+&.*%
!@&!#@#&# 6"# ,(
!! 6 %
$##" " 2%'"$''K'KK#
#"%# $2$
"" "" %(G
#$"#"" $ .
A4-44B *%,(*
$*+>*>* %53(-
# $@
#$%*>*>*( % "53(-#
7M)BSE1")BM#
& *%
O$
!J,L@J,L&J,L 6)B
;>V>$J,L "#M .)B
;Z; *%
%$:%#
2 ;Z; 2%%$
# *%,(:
"5$P#$2 .
%) ' "# % )".#Q5$P10$P0R$
%2%" # .
%%%
D8$
. +
%D8$ %
*%!%$&+&%+&
8+&$:%$JL% +
A.CA%$C5 $
G4$$/Q4$/4R$!A.CA*C
$
?
3.4.4 Quick start option 4
;<).(<;(?<<):()U)U=(./'?(N
A#$$@#$#"B
G "H
-./2AB#$>#" " #>K.K$##>2>'()*
<.> # "+>IM>@#$M+AB
.#"#$A" #$B> #1#$M> #P" M+$AB
5@#$;;;;##" !.@.&.$'JTL
AI JL*4+[.KKKKKKB
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++++++
++++++
++++
+++
+++++
+++++
++++++
++
++++
+++
+
++
+++
+
X
+
+
++
+++
+
++++
+++
+++++
+++++++
++++++++++
+++++++
+++++++++
++++++
++++++
+++++++
++++++++
++++
++++++
++++
+++
++
++++
++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2, "#EE++
$ "#EE+#$
*%%)0??aQ4
$//$7R$"#2"&Q4R#$
.#"#$A" #$B *%
#1#$ 2
#P"
E2
$4$/$32% 2:
$
$3
JL 2"#
* E(G (G
4+[ %"2%01#
. A.C28
A*%CD8"5$P//Q5$PR#
3.4.5 Quick start option 7
;<).(<;(?<<):()U)U2UV./')U2U/.=(
A#$$@ #$"#"B
G "H
KC##$#D "K>#" " #>->K.K 1
<.>@#$+ +A+B%$$%#E+#%
5I@#$;;;;;##+#
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++++++++9
++++++++++++
+++++++++++9
+++++++++++
++++++++++
+++++++++9
+++++++++
++++++++++++
++++++++9
+++++++++++9
++++++++++++
+++++++++9
+++++++
+++++9
+++++++
+++++9
++++++++
+++++++++++9
+++++++
+++++++++++9
+++++++
++++++++++9
++++++++
+++++++++++9
++++++++
+++++++++9
+++++++
++++++++++9
+++++
+++++++++++++9
+++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+AE$" @>$#"#P#" "B
# # # # "E+2, "#EE+
$ "#EE+#$
40
O
KC##$#D "K2IG:
- (,*%IGHG$
K.K 1A.C &
%$$%# 2
#+# 2
/ %+
"@@%@@# 6%
2% 2IG
:%$30$/!/4000$
2 ,.?1
,.?12$+
$
3.4.6 Quick start option 10
;<).(<;(?<<):()U)U2UV./')U2U/.=(
A "# $# $" #>'"""&#B
G "+H
-./2>1#$>#" " #>->K.K$### >'()*
<.>@#$ A+B> #$#'G4T
5@#$ J@L*4+[!.@.&.'JTL
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++9+
+++++++++9+
+++++++
++++
++++++
++9
+++
+++++9
++++
+++++++9
+++++
++++
+++++++9
+++++++9
+++++9
++++9
++++++++
+++++
H+++++9
++++++
++++++9
++++++
+++++9+
+++++9
+++++++9
++++++++9+
+++++++++9
+++++
+++
+++++9
++++++++9+
+++++++9
++
H+++
4
+++++9
+++++
+++++++++++
++++++9+
+++++
+++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+++AE$" @>$#"#P#" "B
# # # # "E2, "#EE
$ "#EE#$
D%$ 2
9AHC!$O%
0??2M0$000%"$1#$
3.4.7 Quick start option 11
)<.()./'2,=
A%## $" $" #> #$$# $" "#))B
G "++H
-./2>1#$>#" " #>#$$@ $"
#$"A@#$B$ >I4?$#%#$
4 #4 "#E(((#$# ((((-#JKL.
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+<E+E+EEEEEEE+E+4+
<E+EEE+EE+++E+E++EE+4+
+<E+EE+EE+EEE+E+E+4+
+@+EE+EE+E+E+E+EE+E++
<+EE+EE+EE+E++E++E+E4+
<+EEEE+E+E+EE+EE4+
+<+E+E+EE++EE+EE+EE4+
++@+E+E+E+E+EE+EE+E+E
<+EEEE+E+EEEEE+4+
@++EEEE+EEE+EEE+++
<+EEEEE+E+EEEE+4+
<+++EE+E+E+EE+EE++EE4+
<++EE+EE+E+E+E+E+EE+4+
+@+EEEE+EEE+E+EE+
<+EEEE+EE++EE+E+E4+
@+EEEEEE++E+E+EE+++++
<++EE+EEEEEEEE4+
<+EEEE+EEEEEE4+
+<++E+E+E+E+E+E+EEEE++4+
+@+EE+EE+EE++EE+++EE+
<++EE+++EE+E+E+EE+EE+4+
@++EE++EE++EE+E+E+EE++
<+EEEE+EE++EE+++EE4+
<+E+E+EEEEE+E+EE++4+
<+E+E+EE+E++EEEEE4+
@++E+E++E+E+EE+EE+EE
<+E+E+E+EEEEEEE+4+
@+EE+EE++EE+E+E+EE+++
<++EE++EE+EE+EE++EE+4+
<+E+E+EE++E+E+EE+EE+4+
<EEEE+EEE+E+EE++4+
@+EE+EE+EE++E+E+EE+
<EEEEEEEEEE4+
<+EE++EE+E+EE+EEE4+
+<+EE+EE+EE+EE++EE4+
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
4/
2 # # "E++AK4K##"%#B
)# ## %#E+
# # # $" E
2# $4%$&"% $" E+42, "#EE++
$ "#EE+#$
3 & 17#$ 5
,.?162 2$O8
%$"/#
%%"!#$
!/1Q4$/1$7R$
"$$/#
*%"2#",#92
# %
(((((((- "5$?#
#$# "$$# .
#JKL .
"#
.
3 *%%!O2+
*%$2+
*%,%2%
$
( $3
%$* &
)76$$$Q/$P4/ $R$!O).)D.
56"5(!#*%"B'F#,"B'F
0#$"O32B'F2B2B$#3
%6
! $$ %
$) $
3.4.8 Quick start option 14
;<).(<;(<A.=N=?=B
A%$$%##" %" #;"""&#>IB
G "+H
-./2>1#$>#" " #>"#$#$$@ $
#$"A@#$B+ +A+B>%$$E4#%
$5I@#$ J@L;;;;#;;;"
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++++++++
+++++++
+++++++++++
++++++
++++++++
++++++++
++
+++++
4
++
+++++++++
-++++++
+++++
+++
+++
++++
+++++
++++++
++
++++++
++++
++++++
++
++++++++
+++++++
+++
+++
+++
++++++
++
++++++
+++++++
++++
++
++++
+++++
+
++++++
+++++++++
++
+
++++++++
+++++
++++++
+++++
++++++
++
+++
++++
+++++++++
+++++
++++++++
+++++
+++++
+++++++
+
++++
+++++
+++
+++++
+++++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+
<1#$@&@%"#E2, "#EE+
$ "#EE+#$
O&
"#$ %8%%
%$$ &$ 222 2 ,.?1
$ - 8" %#
;" @
44
%%
$
%$"%$7$# <]]
2 ,.?12%$ +
"Q4$/<R# $
3.4.9 Quick start option 19
3 ;
" $#%$+
$QRD.$O2%
%>>$
# $@2$$# "
#@$" )# "
G "+H
+(<,))
" "?. ?.%" JLJL
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
@$A.B++
&#;++++
.@$A#$$@B+++
1$$"#$+A-#B++
.@$A$ B++99+88
1$$"#$A$B++
1$$"#$A #$B+++++
1$$"#$AI" #$B++++
1$$"#$A. $B++
1$$"#$A,$B++++
".IA<# #B++++
S+'# A.#B+++9+9++88
S+AKB++99+88
S+1AKB++99+88
SAKB++++++
S1AKB+88
SAKB+88
S'# AKB+88
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
A9@$"4 ##" "!"B
A8$"#$## P" #B
2;2,;))
)# ">#% " E." A&#;B
$"#% " E.$"
%$" "1#A $BE
V@" #%A#$4B%A4B%A4B
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
.
#$$@+++
-#++++
$
4
$+
I" #$+
. $
,$+++
<# #+
A# B++
"#$" >A!BM!8E+
E
I"@#$E[E+++
0[E++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2, "#EE
$ "#EE#$
O&
?. D.D*('(=D
" JL ;D.%$
JL distances ;
S+dS positions at and nearby H86
A# B 2 "% #
#$
%A4B +E& %$
> 2$/$$
[ ".#
0[ E "Z#
3.4.10 Quick start option 20
# $@2$$# "
#@$" )# "
G "H
2;2,;))
)# ">#% " E$A$B
$"#% " E$A5B
%$" "1#A $BE+
[A?.B
I"@#$A#$" #BABA" #B
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
+++
++++
+++
+++++
++
++++++
+++
++++
+++
++++++
4<
++++
++++
++
++++
++++
++++
+++
++++
+++
++++
+++
+++
+++
+++++
++
+++
++
++
++++
+++++
++
++
+
+++
++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2, "#EE
$ "#EE#$
3 /0000P76)P4000"D.# $
% $7 %0000
00P76 "04+0P000+000/#
%&% & //
$2&%% %
%&// 1076>5$$/$$
3.4.11 Book option 230 (“Sun position 2”)
Q4$/R
"#6%$!
?$*%44% %
"#$ 6%>"e#>$
;<).(<;(?<<):()U)U2UV./')U2U/.=(
A#$$@ #$"#"B
G "H
-./2AB#$>#" " #>->K.K$### >'()*
<.> # "+>IM>@#$MAB
#A?$#%$>))BM+$>E+E+>)#@
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
5@#$;;;;##" !.@.&.$'JTL
;V;V;#V##
41
!@&!@&!#@#&#
!!!#!@@@#@&&&#&$##" "
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++
+++++++
++++
+++++T
#"%#A4-44BE+
"" ""A4-44BE+
#$"#""A4-44BE++++++
$*+>*>*W# E+@
#$%*>*>*WE++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
!J,L@J,L&J,L;V$J,L;;#
#$+++
-#++++++
$++++++++
$++++++++++
I+++++++
. +++++++
,$+++++++
<#+++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2## ""?"&1@!JL@JL&JL$JL
;$" #.++X
#K# K#$$@+G
A1#$" "B-#+G
$ +++++G
$+X
I" #$+
. $+++
,$++
<# #+++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
AKGK#! #" "$B2, "#EE+
$ "#EE++#$
5 %"
$4$#$A.CD%%
D%A*C 402IG
"5$P<//A./C5$//#$%
$3 # 2
$
3.4.12 Book option 231 (“Sun position 1”)
/0A./C"5$//#%%
$A.C"/#22$
%
"$# 2%$3 / .
% $5. $44
8+$&+%+$
4?
;<).(<;(?<<):()U)U2UV./')U2U/.=(
A#$$@ #$"#"B
G "+H
-./2AB#$>#" " #>->K.K$##">'()*
<.> # "+>IM>@#$MAB
#A?$#%$>))BM+$>E+E+>)#@
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
5@#$;;;;##" !.@.&.$'JTL
;V;V;#V##
!@&!@&!#@#&#
!!!#!@@@#@&&&#&$##" "
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++
+++++++
++++
++++T
#"%#A4-44BE+
"" ""A4-44BE+
#$"#""A4-44BE++++++
$*+>*>*W# E+@
#$%*>*>*WE+++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
!J,L@J,L&J,L;V$J,L;;#
#$+++
-#++++++
$++++++++
$++++++++++
I+++++++
. +++++++
,$+++++++
<#+++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2## ""?"&1@!JL@JL&JL$JL
;$" #.++X
#K# K#$$@+G
A1#$" "B-#G
$ ++G
$X
I" #$++
. $++++
,$++++
<# #++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
AKGK#! #" "$B2, "#EE+
$ "#EE#$
3.4.13 Book option 334
%D8 )0??
"5$P#$ 4$<$4$<$4$)
6%"5$///#0a/$
A.C%%2%$2+
% D. *%* $JL
&%f0$0004$
4
;<).(<;(?<<):()U)U=(./'?(N
A$#" "$" #@ #@$"B
G "H
-./AB#$> $I>K.K$##>2>'()*
<.> # "+>IM>@#$M+AB
#A?$#%$>))BM+@>E+E>)$@
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
5@#$*4+[.!.@.&.$'JTL
++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2## "" ""?"&
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
1@!JL@JL&JL$JL " #<%" #
#1#$EIM
.+++X
#$$@++++++
-#+++++
$ ++++
$++++++
I" #$+++
. $++++
,$++++
<# #++++++
#@&@%@EIM+
#$$@+++
-#++++
$ +++
$++++++
I" #$+++
. $+++++
,$++++
<# #++++++++
# $" EIM
#$$@+++
-#++
$ ++++
$+++++
I" #$+++
. $+++++
,$++++
<# #++++++
#@$"EIM
#$$@++++
-#+++
$ ++++
$++++X
I" #$++++
. $+++++++
,$+++++
<# #++++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2, "#EE+
$ "#EE#$
0
622 %
*%* O2$/ =&
D8$ .
*! $O& *%*
% O%$
O22&JL 2%+
2%$$(V $3
%"# %"
#$ 2 ! $JL 2%
$
3.4.14 Book option 511
3% %$
*%%$
% 2!
$)QR*%%
&$32 ,.?1 +
:!$3 &%
8%%82',.?1 2$
O 8,.?1 2
$32 QR+
! %
$! $
''[0$T$
;<).(<;(?<<):()U)U=(./'?(N
A "# $# $" #>'"""&#B
G "++H
-./2>1#$>#" " #>K.K$##>2>'()*
<.>@#$+ +AB> #$#'G4+T
5@#$ J@L*4+[!.@.&.'JTL
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++9
+++++9+
+++++
++++++++9
+++++X
+++++++9
+++++++9+
+++++++9
+++++++++9
++++++9
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+AE$" @>9"#P$# B
# # # # "E+2, "#EE
$ "#EE++#$
2 This was proposed by Thorsten Sander, who was interested in the planetary positions at Giza belonging to the outer
planets of our solar system.
= Q$P41R+
E 7$2
QR$)% QR:E
%
$8 'GQTR:!%
9 2 % $ )
"#%& QR$D%
24$$
322&
/%0$?%$6+
2% /$
) 7PMP$14P`P01
%$3QR % %A
C)PMP$00<4P"Q$/ $R#+%%$ 7MPg"P%@PP)#
MP$101P`P01Q$4< $R$7%%+% 2%
7GMPg"P%@PP#MP$1/<<P`P01$O2%%$
> ,.?1
2>2% :
"#$2:!?+
$/$$)2
% 12%$
3.4.15 Book option 512
5!
%2&$
;<).(<;(?<<):()U)U=(./'?(N
A "# $# $" #>'"""&#B
G "+H
-./2>1#$>#" " #>K.K$##1#>'()*
<.>@#$+ +AB> #$#'G4+T
5@#$ J@L*4+[!.@.&.'JTL
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++
+++
++++++
++++++
+++++9
+++9
++++9
+++++9
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "E+AE$" @>9"#P$# B
# # # # "E2, "#EE+
$ "#EE+#$
%% &
Q$< $&)4$4 $R$
/
3.4.16 Book option 510
3 %4%/?1<76"
%%)0#% $%
% $/$ E 0]%
%(V
"Q5$/$4R#$$8+ .0P
0P2 *%!%
(V "D./]?$00VO]1$440?V(#$4$5% 0$00?T
$ 2:
>
%E>2 $
;<).(<;(?<<):()U)U=(./'?(N
A "# $# $" #>'"""&#B
G "+H
-./2>1#$>#" " #>K.K$##> >'()*
<.>@#$+ +AB> #$#'G4+T
5@#$ J@L*4+[!.@.&.'JTL
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
++++++++9
9
+++
+++9X
+++++++
+++++++
+++++++9
+++++++
++++++++
+++++++9
+++
++++
+++
+++++9
++++
+++++++++9
++++++
++++++++9
+++++
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2 # # "EAE$" @>9"#P$# B
# # # # "E+2, "#EE
$ "#EE#$
3.4.17 List of quick start options
3:!8/$=:!
! $$O
! $:!
>?042%$3 *%,
! $$3
>?04$O
2$3 +/$$3 %
$ $$
6(&"!&"#7
%#!&"
!&!!%"!%!&#:%!
,-$>*.$*-==!&=#%
"!"#364!3"#4
,##!&!#
Option Brief description
Quick start options
1%*%00076>)1000+$'cT
2%*%00076>)1000/+$'c$T
3%" #/"*%0??#2
D8
4%*%/
"*%0??#$%
5% *%00076>)1000
,.?12+$'"#cT'"%#c0$/T
6 D%*%00076>
)1000+$'c0$?T
76*%00076>)1000%2IG
:&2$?]
86"#/")10??#2
ACD%
96"#*%+
/")10??#$%
10 6"#'8)/00>00'c0$4T
11 *% .)00>00"$/#
12 , .)00>4000
13 E*%,()/00>00:
@c]"/#
14 5 E*%,(*00076>)1000
:@c]
15 Y*" #*%00076>)1000
16 %$;"D.#!0%)/00
17 ZZZZ"#!ZZ0ZZZ
18 ZZZZ"D.#..ZZZZZ
19 ZZZZ"#..ZZZZZ
20 ;/000076>)4000"D.#!0
21–22 *%@,00076>)100094?+
9 "&0#$
Quick start options for book 2 [14]
170–171* 6*%00076>)1000+$'cT170
171*
180–181 6*%1806&'cT9
00076>)1000+$180181
190–195 )2 190–192+$190*%
(+*+,'cT191,+*+('c$/T192+
,+*+('c$/T193–195190–192 'cT
200–202* 20010&9200201202*
210–213 .$9210/4%/211/%
212–213210–211&
4
continue
220–221 .4 %220/4%/
221/%
230–232* 2308"#231* 232*
240–242* 2403" #241* %242* %
250–251 313&250)/?00>00251:)000>100
260 314
270–271 *%270 )00>/00271)/00>00"$/#
280–281 ,280400076>)0281)0>4000
300–301 300 *%10??9301*%$*%?0??
310–311 310,$$?0?9311$/0?
320 . A+C%00076>)1000'cT
321 . A+C/0076>)00'cT
322*–323* A.+$C"/#%*%//0??322* 323*/000$0
330–332* .$/"5$<///#330331332*
333*–335* .%$$/D8"5$#333*334+335*
338* . % %)0
370–373 ;370>37316>19
380–381 ;38020381$?0& D.
Quick start options for book 1 [5]
390–392 %*% 2 $000076>
)0000&$2$/]d$4],.?1)9,.?169IG:
400–402 .390>392&2 00076>)000
410–419 %/>4?>4,.?6
420–429 3410>419&
430–432 %*%O,.?1)"/000$0#
440–442 3430>432&,.?16" #
450 32
460–461 % *%
><>0
470–471 3460>46141QR
480–481 % ,$%'2 ><>0$
490–492 3417>419%$34QR%E>E1
2 /4$
500–502* 31500 501%502* %
510–512 %'800076>)1000'c0$T
510 %511 512 %
517* .5&,.?16 2 %
'"#c$?T'"#c0$T
518* .517*& %'"#c$0T
519* .517*& %'"#c/$T
Special options
032
111 D %
999 . # $%
−804 6 +/$$
4. Technical and theoretical basis (Giza)
D8$5 !
&)$= 24+
2% %%"4$#$
4.1 Positions on the Giza plateau
5& %6
%% %$8
$5Q4R$
4.1.1 Positions of pyramids
D8%2%%!%
.=$P*$P5$Q<R$2 5$P$A.+
C%%%%
*%,(Q$P/ $R$5A.C
*%!%
/$ %
% *%
, *%($ F/+
A.$C5+ %
:$22 % 6%0$0 6
%0$ *%!%/$<?Q3,R$+
%%
*%!%$) &+&%+&
8+&"5$/2#$
<
#!"$%$
"!H-$#*=IH$#*+.#I#'$H$#*=>I#
C=-!*#++#,#+--C##
5 % 2
% %$3
% %: %
Q$P4R$=% 2%%2
$ %4<$"6%+
#4$10"6 %#<$4"*%!%#
% Q<R"Q$P/1R#$
4.1.2 Positions of chambers
& 6%!
,$P*6$P'QR$%
88.%Q/R*(Q4R,%QR$P.$P
Q<R.=$P*$P5$Q<R$ 2 2
84$ %&
HG2 %"5$P/#$&+&
%+&8+&
$"'!)% HG 5PMP0$0
PMP/$?% )0??$#
"#5$P/$
2$% *
'2 % $3
&2 2
$3!
8 %
201$Q3,*R$%
& 2 23&%$
Q/><R& $3!5$P/ $
1
H-I
#'$%B%
!$$#
pyramids $ [m] ! [m] % [m]
"#
%" [m]
"+#
% [m]
"#
6% 1$ >14$4 >/$<? /$<? $
6 % ?$ >/40$04 >/$1 $ 4$
*%!% 0 P0 0 <$/? <$4
!$&H<I
'#G*=#$%B
"$$""!#
chambers $ [m] ! [m] %& [m]
"#
%' [m]
"#
%( [m]
"#
IG >$0 4$ 0 >$/4 >0$4?
HG 0 /$4 0 >/$?? >$1<
.$ >$4< >/?$4 0 >1$0 >4$01
$35$P/%
4$/1X$M01$<0$%%%
$$ 2 +
$)! *'
:%%2 2+
$
4.2 VSOP – planetary positions
,.?1 % % 2 % $P7 D$P5 "7
F%3*66(3W:WWWW#
QP/R$,. ,.WW?1%"?1#
$) ,.?1%
523*66("B'F#$
?
0$"%
#&"9#G7#G/H<$09$+CI#
!#(@!$
5"""#
,.?1 %"*%
O#2% $%2+
2 $32
2% $)% 2
",./000,./00/%5.Q1R,./0%.$Q?R3O
%5$QR#% ,.?1 % $2
&,.?12 % %
$
4.2.1 VSOP87 full version
5 %: QR396:>=
!%#!
5!!%#0
! 7 17 ! %
!5#
!21=..#4%
(/00"FF%($P*$
.$Q404R#$
&,.2,.?12%%
$3
2%2ETU2@;
." M#$ !
%:&/000$0%:&":&
#$ /000$0 &%%!
(/00$2 %/000$0:& +
& $&!+
(G&2 2% $)
22(40(40<
(/00$62 22 F@
@1"B'F#$$%!$Q4/R$
2,.?1) ,.?16$ )
,.?1% %&%&
$2+
a
;
a
a
&
a
0&
& /041" .#$)&%& -++
2
t
t
M"F1>/44$0#P@P</0$0
596:>C%#%96:>C 96:>C
%96:>CH*>$#+>*#I#
version kind of coordinates coordinate system
,.?1 "$# :&/000$0
,.?1) :&/000$0
,.?17 :&/000$0
,.?16 :&
,.?1 :&
,.?1( 7% :&/000$0
EV
W0
W5
8W
VW W
;W W V
"4#
8
a
$& T U+2$
2
%$5(:$"4#: TU$%
2% %22 "
t
#$
&&+ 2%%
%EV
W0
W5
8W
W VW*
W
;W W V VW W W ;W W V
"#
O22%:9(:$"#2
:$"2 ,.2
$#3
a
;
a
a
$$,.?1)$ *% :&/000$0$2
% " !+
2# ETU 2++
% $,.?1%
,.?1N$ 2%2 %
2% QP/R$* 2
'()*(+2?12?1$"$#&)$
4.2.2 VSOP87 short version
3 %* ,.?1
2"# Q?$33$P?>4//R$
;(:$"4#"#
%PT $)
2 ,.?12
%,.?16 22:&
$% 2 ,.?16
2$5%0??
2 ,.?1&%0$000]$
4.2.3 Orbital elements and Kepler's equation
32Q?R%
0//
"<#
2 ,.?/QR$ 02 :&
:&/000$0"Q?$P/00>/04R2$$#$
F1/44$0
</
"1#
& Q?$1 $R
<0
@M
M+E&
M%
M
W
M
p
M
@ % 9
$ 2IV:Q?$P?4
$R%1
171
"?#
% 7 2% 7GMP@GG
p
$7 IG:
:%2%$ 2&
1 7 110
"#
O+'
&$% %$"+
2%2 AC$#
O+' %22GK"1#PMPh"1#@h1
%%$3:
111
K 11711
1
"0#
)2 (:$"0#%1 %(:$"?#$&
$7%
/
1
/
"#
Q4$P<R%
n
$ *%,
% % %$
% % +
*%,(
d
d
/%
"5$P#$ +
$BIG: +
+ $;"
.#$
,.?12$
4.2.4 Accuracy of the theory
% ,.?1 *%,(+*%*
C"# /00076)<000C
Q/R$5.2 %)04000
BO 400076)?000Q/R$5
D8:9 %)
0??2$:=2 %
%)000e
<
):% QP/R$
2 %%%$)2+
% ,.?1P2,.?1P2Q?R$3
% %/00076)<000
%2
*%*$2% 2$3
% 000P76)1000 !"@7G>P@1#
%22 0$]0$/]$2 2+
%+
!%E"@PcP]$#2
0$/]20$]& *%,$
3 2 4]$
2% /000P76)<000
%)0??2$)%
"#,.?1),.?16$ @7G>P@
%$"2%
2$#O2 %,.?1
000P76)1000$3%4000%
%$
3!
2 % * Q? $P/00J/04R % 2 IG : " 2
$$:!1#$3%
,.?1$2% 2
%% +
$ 2
000076)0000"5$P 4$$#$
</
1 "#
"B B%%D"B !$! &DB
%!DB$#!
5$" !96:B%*96:>C%$%=96:>C
%$%+!96:>=$QK(# $%"
%$96:=.*+$"$!%,#
%22 2%
:$5$
% % 2%%
%$22A2C
:222$
*2,./0Q?R"5$#$3%
0$400076)?000$) 2 ,./0
! %
2,.?1 2$
4.2.5 VSOP2013
.%2,./0%$+F$.D$5)$P5
$*Q?R$D%22&+
%$3 52 3*66(
2%&% 2,.?1$3
2$O2
%4 ,.?1+
%$2 %%
$
$ /%B%2%%
"$$P/Pd#$3,.?1
,./00$):
% 2
,./0,.?1"5$#$ +
"#% ,.?1 ,./0$A+
%C,.?1$
7!e2%2$3
,.?1 &$ )
"#%($3 000%
%(2%
000% $) $*%
% 2% % 2000 %$=
,./0% $
</<%$=</<$4?1%/000
&+ ($O )/000"F1M
/44$0#/ 000% $+
(2%%%$3
AC22$
2% ,./05$P$6%
!$
/$ B3% ,./0400076)
?000 *%,$
,./0(%(+*%$
3%(4<10!% (V$5
,& &%/
<
$3 %%+
$
$ B &%0
,./0,.?1$&0
,./0$2 ,./0$
00$" !+
$#3 $
$
4$ B5% 75
% $34
&%')*%$3,./0
% $=
%2$2%
,./0 !..2
$"'!5,./02
')*%2
! $# %,./0
2$3
,./0% $O2 +
000 2$
$ 1%B & ,./0+
%$= ((+*
% $F% ,.?1
,./0 %$D%
%IV
$) 14$<"$4#
0$<P$5%D8 "5$ #
%2 4$P$72 2%
$5 2$
,./04@$,./0
% E
%2,.?1$3%
,.$3%!8
$3 % 2 >
2%>! %$
) %,.$
4.2.6 Single- and multi-thread versions of P5
3AC
"4#8 ")3#*$
,.?1-,.?1Y4,.?1N$34
%+$ 42
4$38%%
"# 2$
$ DOB 5
%$ $# ""1%$ $/:7↵$2
<4
% %$ $7 "7/ :77↵ 2% $
=4% "4$ 4+4$ #
%2$ $
O!6B $&
% Y*"<4+2?#%+
6BKKK$ 4P//P
/0P$
) B <$04F./0$04F.D5+
$+2 Y*
+2 $O2
$%8 <4+%
D5$+2 +
2 !8%$
")8%/++
!2% %$#O
2%!$
4.3 Relation between pyramid and planet positions
.%%32%32!
% 2%$ %!
> $4
% e)
% 5$ P4$
%%6%
(G6 %,G> >*%!
%*%G$ %
(:$"#>"#$35$P4 2)( %2
(,"66 %#%&%$3
*%$3% *%
%")5$P4#$
4 $32
%%8% $
!&008
%e3& 2!$8
%00 %!$
$3 !%%% $
= F6"F6# (86('O$3+
%%$32&
2$F6
01 /<$<!$52
%2"!2
#$>+8e2e
E((%%
22$32 :
0! 0!$3%
$ %$:
>+E>2"2# $")
2% %% +
2$#
<
&.$
*%9&$3%
(:$P"# *%*%!%
*%>!U35$P4J
%%%& *%G$3
% %$
*% . )
D8$="+#
1/<"5$#$
F+ "/#
5$4!%$2
2%$
<<
5 !7$9$ 1#
Q$$$77!#
1#
# 5 7
#'!%!$"!..6!-#
&:2e) %e)
*%&%$=
%$5%*2 ,.?1P%
*%Q?$/R$
F1M/40$/1X?1$<P4P<"&>0$# "/#
&$5&M0 *%
%/000$'"&G>P0$#&%2%$
O%%$
4.3.1 1-dimensional comparison
d
d
/D8"5$P#
"@#$*% &*
*%, ,( ( :2 @7>@9M
d
@7>@1M
d
/2$3A.C&%
*%!%$)A.C 6 %
d
d
/%"$$0#$3A+C+
%@$5 +
2'2Q$ $R$
4.3.2 2- and 3-dimensional comparisons
/++%$
+$F2 *%!%6
% 2 *%!%6%%)
2 *%,)2 *%($2))
2 % ,.?1$5&
A%C /Q4RF1M/?401$1<0
M"?$>/40$041$01#"#
)M"0$/?/0>0$1/100$014#"4#
(:$"#2 "
%5$P/#(:$"4#)B$")BM41?10$10!#
(.$$3
&2% %$=!
2GMP!S %(M!KSK
% $5
`%
M"`@"`!##
(
) )$O GMP(
PMP
( %
%$7 :"%#
2&%2 22'KK"
(#
Q$/<R
'KKL
00
/
(
/
(
/
QTR "#
5/+ %E
( $8+
28(:$"#$QR /+
<1
'K$6%+22
/%0$01PT$3 6%
%&/+
8$ 5% + $ A.
C %$O
@/(:$"#'K 'KK A2C
A2C +/++"
QR$#
4.4 Two fit programs
2 $
$ "53(-#&%D$=$
.$3!% I I"I 8I%I3#
3%$" #2 4$
2%:$
$ 4+
&4$/$4$1$4$1$/$
4.4.1 FITEX
2%$D$=$.+
"I I6%F%%I3#Q<P1R$%
5'')O3,DOB53_5$
" #2
:$3:2
& $
,% & +
% :
$2 ( 2
%2%2*
*
"<#
2 2+2+
,"*# +
'
T
U
E
T
Md$ "1#
$5 (:$"<#%
%$ &$32
2
$2%2*$
/$2*!&%$$ EMPdP
!$
'
"# %$
:J
$&2
! 2 $
2$2%! %$
<?
( 2 2$
2 *"%& $
&
* -. */
*/
"?#
2-&.& 2 +
22*M/$+! +:
% 2*"
& "*#$ & . 22
%% $5 2 +
222% 2
$$
% &%$B
%*"
2*$3+
+8*"*$=22
% %!
" *#%
$ &% 2
*$
EE 1
M$$$$1"#
$) % $3 +
%%$* 2Q<1R
$ "&)#$
4.4.2 Ringfit
) "P"5#PMP0P#$3
2%O+'%22
$ %&+
8$O% $
! %!2
$3 &2
$ &+
&$ $32
% % $7 !%
% $
:
/ 550/ 0/
5 0
/550/
"#
"500# $3
"5#"5//#"5# % "&+&# +
&+50 %
505
/
/ / 5/
//
/ 5
/
/ /
/
5/ 5/ 5/
"/0#
<
%+0:%52
$2 %"50# %%
:$$(:$"#0$
500 $$
5(:$"#$ &+&"PMP0# %
(:$"#82: &$2
5/
50
/0
/
"/#
"#$3&$+
AC 22 %
$22$
$ =2 22+
(:$"/#$
/$ 3$3
G!(:$"/0#8 +
$=2%! (:$"/0#8
$
$ (:$P"/#2$
&+&& 2%$"*+
%A C
&+22%+2$#
4$ $&+2
(%2%$3 :%
2%$
&+2 %28$
&5/2 (:$"/0#$)
"#&+2 !%2$
% &+2&+
22$)& 2
" #$
=& &$
%2"
Y*#PT$32$O2
% :2+
$ $
4.5 Coordinate transformation of planetary orbits
/+ %%
% 2 (G %
$3E%(G
2%E%8+$"&+%+&
$#O:=%
Ee (G$=
!*%G*% e3!
! *%, >&+%+&
$:2%"'#$
3! +
%% *%,%$
10
: *%%
2 &$5 %+
Q$)R$&+&% %*%
%2&+&$3A*%%C*%
%&+&$6*%"&7#
7
@7 *%
$=
M
7>@7
/
"//#
MP
>P
$ FG $5
2 (:$P"//#Q$P>R$O +
&0
0
$ $
"/#
($ ,$=
/+%
*%
,$*%,%%
2$*%&2Q$)R$
4.6 “Celestial positions” on the Giza plateau
F*%,(
% D8 *%*%!%+
,6 %(6%$
% D8$3
%AC%2"8#
2$:.
% D8!%
e% A.CD8&%
$"5 % A.CD8
A.C (G /QR#$
4.6.1 “Sun position” by system of linear equations
2 %&
4$$/ % D8$2
) )$ 2 % " %
2#2) )%$32
+2$=2
1PGLG
a
2" #2
!
/
!!$ !55!$ 5!!5
"/4#
1
)%2) $" %
QRQR% 2 6 %6
%$#O)))
%$O>" #A.C>$
2 ) ) ) + $
&22)2 *%.)
))$ % :".F(#
2
)5X) 5/X)5M2) "/#
) 2.F("/#QP$P4R
%55/5A.C2D8%
2M5X5/X5 "/<#
$%5$/2$3
% *%!%
%: %2$ 2
: <$/?8+ 2$+
A.C"/#%"Q$)<R#
5M><<$M//$?M/1$ "/1#
4.6.2 “Sun position” by coordinate transformation and FITEX
)%A.C %"+
#%%8%A $C
3 . D8$)
%
% 53(-$ %
$)4$5!
&0 (:$P"/#$
) %",.?1#%
%"'KK8#$+
> >% A$C
%%A8C++
$5EE/E9
E4EE<82%+
E1$2$)EE1
%$53(-82%2%8+
( +
%$3 5PP 5KPKPK
2%
5 K
K
K
E10E4$ E$ E<
5E
E/
E
"/?#
53(-! %$ % +
EE1&%00 f000%
228%$7A.
1/
Ce3%.$%
(:$P"/?#82"5PP#M"0P0P0#$)4$<$
/ A.C
5M><<1$M/$M/1/$4 "/#
(:$P"/1#"/#/P+
$ (:$P"/?# 6%
>2 >
*O%$
&%00PT2%8
53(-$.& A.CA%CD8+
$4$/>$4$4$4$<$4$>$4$<$
4.6.3 Additional “planetary positions”
2 A.C6
%"5$P<#$ 5$P<%+
$ A%CAE"%8%%#
$C %A$C2
! %$!
%8%%
%% 6%$
$5
% 53(-$
2EE1! $O&%
%44%*%$5%
%22+
E E1 A%C6%"5$P<#$7
&%,.?1)"/000$0#+
,.?16%$%&$!
2 !%$=
%E"%8%%# *%
$6%5$P<%
E$
=% %e
*%!%$.% %
>22%>D8 D82%$
5$P%%$3
%2$5 %%+
2 E E1 A%$C
$OA%C5$P
(G %/4$]"5$P/#2
%$.2 <$
A.C"5$P# / %0
6 %&/00$%
$
3 D82+
2&6
$3% D.2"D.
$4$#$ $
1
14
!%#!2%
1K#"!#7$"!
$!"=<JG<#.<K8$+*JG>#,-*K1#0
7#7*7,!77#:!
73!4 +.>>#6!"++,
%+#,#*+#;&!7DX=.*$:/0:871#
4.6.4 Geographical coordinates
22 %$
2 26"# 9
(&$
2 $
(&$
:$
3 ( /$
5$P<
MG/G`P";#%MP/G`P";#$"
5
%%2
5$$
D8$#=
(G
+
$= / /(G
:"$1#
: (5$<
/
/
%
/
/
"0#
3
% /
/
/
"#
)5$P<; +
:$ %
22 + #
*%22 ;>P@/$5(:$P"#
%
/
/
/
//
;
/
"/#
3 ;$2(:$"/# $2
; /
/
/
;
/
/
"#
B4$<$+
5$$ %% %$)
2%&+&%+&8+&
$ %
*%!%$38+2
2$%52;
@$ D.$"O6%
$#
1
6
1# ; !
"(#
*%!% ;P0PMP/]P?$1GPO+
@0PM]P1$<4GP(";G0PMP/$1//]O@0PM$/?/4](%^f0$00000]#
D8%2D. %$
%$3 5 A%
C *%!%+
;@$ ;MP;GG;0@PMP@G>P@05>
A%%C5A%$C3 0
% $
$5&2
%; L5GY<0]S?$?M4000?! (
$"P%&$#&2
2%; MP;0PXP;$O&&;#5
*%!%0%G0%;0(:$P"#
%(:$P"#$.%&2%(:$P"#"#%
;#(52;0;
5
0/ %%0/
"4#
O&2;G% ;M;G`i&@P5Gi$
!5 (
%2$6% /!
0$0/]$5
$
2%& P
^/"
G@/#^
^P
$
2$
2 %/P"
G@/#(
$"($#
2 (G ;M;0PXP;#
=$3 2&+
5$! 5
";# G";0#5
$ $3 Ji%i
:ACO @
%$) : !
% ;PMP";0PXP;#@/$
5@/5@/$
(:$P"#";G#$=/G";#
;
L@
<0
/j;
"#
%@#O>% % $5%
%@M@0PXP@$"3 ;
% /@"/X#22$#
O? /2%?M//#.%
?P%%$200%3
.2'E %& +
"(V#
? //
/
0
4
/
//
//
"<#
1<
2% &%+
%%"(#!%
'E $)& A%CD82<%
*%"04$4$5$#$
5%"5$P<#!+
%% D.%$)%+
% "%#$
4.7 Syzygy
4.7.1 Planetary conjunctions
%E@
2@0$$@0PMP]$+
$AEC
"*%,(#A4EC"*%,(*#$3
2%AC
$AC"%#% ,
( &%?4%$=E ,
(E2@+
8 $3 8@@0%8%%
$
58 @2 @
!$ O & +
$. 8&
2@0$8
:2$F@@/@ 2$3
8@
) %$5@P!P@/P!P@
"#%29 @P\P@/P\P@%
9 @P\P@/P!P@%2%"8# $3
"
@P!P@/P\P@
AC "
#$3! *%,
>$$$4$?$ .$
4.7.2 Transit phases
%*%,2$
:$3$$*%
(! % *%
; !$3
AC%AC
.$2% $
%&$
11
77*>$+.>>$*<B=.B<$#
corresponding planet Mercury Venus Earth Mars
F"O# /]P?$/<0G /]P?$4?/G /]P?$<?00G /]P$0?1G
F"(# ]P1$14G ]P?$04<0G ]P?$/1<G ]P?$??0G
"
5$P?1#$ ($5
*%,.
8 $ *%! .$Q44
$1R , Q/$P<R! +
7k6+Q/R$2 ,:
%0!$
=! <0P!%*Q/R
* $"3
%$ $#)&! *%
,$@;8+
17 (*%$F
P
*%. (
7
/
#
17
#
"1#
Z;1 ;7 ;1 ;7@1@7
"?#
#
*%( .$(:$"1#
%% (+*%+.(:$P"?#
"%#$5;1GMP0
",.?16#(:$"?#
#
;7@1@7
"#
(:$"1#42%2$3
%%2 2%$3
2 .%%
22"# 2
r
%
171
1
71
"40#
7(:$"1#"40#%%(:$"40#"4#
% $6 ,(:$"1#"40#
%79$7&e3
K"# .*%,
1?
:!1[B01/6
=..+#
QR Q!R
.":# P?$<< <0?
*% P$<? /4$1
, P?$400 <0$
(: P?$14 <1?$<<
( P?$1<41 <<$1
(4
G
"4#
/
G
"4/#
"65$P?1$#7 $3 &(:$"4# 2
%
.$3 AC*%G
(&% 2&$(2%
!2$32
$
F .G *%7
(1$ M1P>P72 $3 7
*%2 (9
($2$5%
22%$3
"
%$$
"
M0$P$72&1
*%7($2
&
Step 1: 6 *%7,.?17
2 "%#M/0$
Step 2: 6 (1,.?11M7X#
Step 3: 6*%(%
Mi1"1#>7"7#i2 %"M@$
Step 4: )i">ib
"
"
./91M7X"#
5 "
G#
/
/$ %
%
!//
!/
/
//
///
/
////
//
//
/
///
"4#
$72F1
/ (:$"4# !2%"
4$4$/#$O& GMP! 2
2%% " #$O
% %$*Q/R$O2
<0P!%*
$
4.7.3 Position angles of transit
.G$
%+&"5$P1#O$%
.(G$*2
*%,!
Q/$P4P $R$B % *%2% %
)<00/00$7%)0??% $
1
F( %
(V&"6'. %#% &(
"'. %#$3 $/6 $/6 2
% 2
2%Q4P4<R
$/6 34*+ $/6
"44#
3!4*+
($)34*+
$2 &%&1"G#
$ *%",#(6>+
,.?16" &#>&+
&%:% $=2!&+&
(G "2
:&#$7%&+% (G:$
:%
"
2%! )&$=Q41
$/0R
"
/$44?04/0$?<00$00<0$0141
"4#
(:$"1#
2$:
"
%&(:$"4#2+
2A%C Q41R$*%
%& (:$"1#4$$$
/$ O *%, .%"2#
($
% (G$
$ *%",#. +
$
4. 5 *%> %,J
%:! )WEQ4?$P<R
*Q/$PR2%$3
6
6+
.
*%,$=
PMP
P>P
6
PMP
P>P
6 Q &%
:%
Q/0</<4$?0</
/
6
$/
"4<#
5 Q
6
6
"41#
Q
6
6
$/
"4?#
/0</<4$?0</M<0`<0`<0@"/j# $
8 2
$:5
2$5% %+&"5$1#
5
"4#
?0
=P2:Q/R$3
8 3 2G`PPc0%X?0]$
)0??"5$P1# $2
! O).)(=./0$3+
0??%4<$
.22$4
&
"4$1$/22/#%
" #$ O
'2IG:"2#8
%E" #53(-+
$$A.C" #$
) ! 8$3
! 8$)
2 ($%
?
7 +.>>"#0
"%-<$<<.&H=I"%-<$.>G\G=-G&H=<I$%
5.#.-J*>##
"#$3 8%
2
22%!$3
($%
.G8
($3%>
.$%!!
(8$3
2 2 (8
"#$3>! *%2
,>%$%2 22%$
4.7.4 Transit series
*%, .+$
% Q/$1>R$
2 *%2%4<% ,2%/4
%$( %
$ *%*%?0??/0"
$4$1#$ *%.G!2
5$P?$ ",.?1#$
O %:
e5*%
4<%$3"(# $+
%$3
?/
7$%!=.
!"!8 6 S6' ?/@<
+#,#C#!7*>$+.>>#
4<P%
$3 +
$! 4<%
"#$FF%F"%
$ *%
"F"F%#4<%
"
"0#
"
$$0$0%$ $3
% 4</4%2%$5
*%22 7 M<?0/$/00 % , 9M
??1<$1%$3% %
$22$
)&2% %$,%
/0/$3 O$ %
&%000 1/00 : 2
,$5Q4R$
,5$$ %
$ ,
.5$P $)% ,.?1
$
*$$E+
2%2$3+
"&)#$
?
9$8#!%'#*>$
$$!,!"...C=..#
4.8 Universal Time
"%#"#%$3
%$B2"B#
%E(G $
%2%%$7
%! %(G
$B6"6B2#
B6%%%$ +
B% %
(2% $
7(G %!B
"B6#$5B
%&$% %
(G2$:2(
,.?1%$3 %$$ 2(BB6
$ 2 B$:2
M>B "#
:! O).)(=.%(& +
"B'F<#%2%3$
%1%5(!*!
*k.Q0R.kQR$
%:%F :$(!*2
:FM%X">0$#@/$5%QRQ4RF"# "%#
$&0$2?%
%$2%2%(:$"<?#"<#4$$$
2 0$%2
:%2% F1#
7 %+00"#$$076 T
h&(G
%$%2%$
2"5(!*Q0R#
F[>00 M>/0X//
F?/0
00
P"/#
>00cF[00
F
00
M0?$<>04$4X$1?/
>$/0>0$1?4/4
X0$0//14/X0$000</< P"#
00cF[<00
F000
00
M14$/><$0X1$/41//
X0$1?>0$?04<4
>0$0000?X0$00?1/01< P"4#
<00cF[100
MF><00 M/0>0$?0?>0$0//X
1/
P"#
?4
100cF[?00
MF>100
M?$?X0$<0>0$00/?/
X0$000<>
4
14000
P"<#
?00cF[?<0
MF>?00
M$1/>0$/441X0$00<?<//
X0$004<>0$00014<4X0$0000//1/
>0$000000<<X0$000000000?11 P"1#
?<0cF[00
MF>?<0
M1$</X0$11>0$/14/X0$0<?0<<?
>0$000441</44X
/14
P"?#
00cF[/0
MF>00
M>/$1X$44>0$0?/
X0$00<<<>0$00014 P"#
/0cF[4
MF>/0 M/$/0X0$?44>0$01<00/X0$00/0<P"<0#
4cF[<
MF>0 M/$01X0$401>
/
/
X
/41
P"<#
<cF[?<
MF>1 M4$4X$0<1>
/
/<0
>
1?
P"</#
?<cF[/00
MF>/000
M<$?<X0$4>0$0<014/X0$001/1
X0$000<?44X0$0000/1P"<#
/00cF[/00
MF>/000 M</$/X0$//1X0$00?/ P"<4#
/00cF[/0 M>/0X/`
F?/0
00
/
>0$</?`"/0>F#P"<#
F\/0 M>/0X//
F?/0
00
P"<<#
)%O).)(=. %
%FPcPFP\P/002M>0$0000//P`P"FP>P#/P
$"$#7%(:$"/#>"<<#"&
%P[PFG[P/00#B BM>"X#$O(:$"/#
"<<#$):)B*+/$
%"B'F/#! O).)QR %%
)B*+/" Q4$)R#$ +
"f#2
FM>/000 M"11f</#
FM/000 M"<$f0$#
FM000 M"14f#
FM/0000 M"/f1#^"/f4#%
?
4.9 Computational changes from P3 to P4/P5
= !QR
$,.?1%
$(!A.C
D8:$22
2J22J2$"%
B 4$?$#
O 4@
"&)# $$4$1$
4.9.1 Decimal year
32(%$%
! &F1M/4</?/$$3
%FM/0/$122
%)/0/$3 !Q$PR%F&% +
(
FF1
<$/4? 41$?<
"<1#
=: /%
200076)4000$7
% $ 5 % )P0000
2 4% %)00000&+
%$%!%)B*+/$
& D
%)P?/$
&% (:$"<1#$
" $
D2%2
"0[F1c//<0$#
FF1
<$/ 41/$0
"<?#
"F1c0//<0$[F1#
FF1 /44$0
<$/4/ /000$0
"<#
%% 0[F1c
//<0$%41/P76)P?/$2+
$
% 41/76$5%
2!!$D+
2$2<$/4/%%
2 <$/4/%Q/R %//<%$
O22%fP0$%
$O2
(:$P"<1#% (:$P"<?#"<#2%$$
*%%/$
(:$P"<1# !%FGMP0??$<(:$"<#FGMP0??$1$
6,.?1% %F1F$
?<
+$>..
3& ?00%Q$P/P<R
$) ?00%*%,
(2%
: $" 2%
25$P$.4$/$$#2?1?0$4%$3
2%<$/% %?00$0?/%
:?00%$2%<$/4/% D%
%?00$<%:?00%/$ ?00%
PQR%2 $ D
%)?/?00%/$)
% %%&%
$
4.9.2 Position tolerance
=% *%,( %"
#% 2%2 ' 'K
'KK2%$"' D ' !$# 3
%':2 'K'KK
$3 A.
C"QR# 2 A.C6L]6]
%'2M6P`P'Q$$$P1$P4R$
% *%!%"%#
6%" # %$
):2
2 "%# %
2%$ "27#
%2
%$F2 %"#
6 A.C 2%
6 67
"10#
A.C"#% :
5
6 &
6'
"1#
5
6 '
/
6
/
'
"1/#
7'2'2%00 (:$"1#
"1/#$3 A.C +
682(:$"1#%
8$2% (:$"1/#$
(:$"10#"1/# A.CAC>%6+
%>& *%,($52
%%"#&%%
($2!c"
/0/$4$$4$$4$/2%#$5%2:
%% *% +
4$
?1
4.9.3 Algebraic sign of *5
A.C
: 53(-% %
%E2 EE1$%
&0"E4PEPE<# (:$"/#$=E4EE<(
0 5"E<#P`P55"E#P`P5"E4#9Q$P $R$3
E$F
9 &
&+&2%&
55
0 0
0
0
"1#
"O3%QR2%"2#
2$7%:
>& >!
$#E (G +
(GQ$P4R$7%5$P/$=%
E%
%"#>E$3E4E<2
%E4PfPE<PfP2%+
%% :$ +
&%
5E<55E5E4 5E< 55E5E4
"14#
%&(:$"/#$7% %%
%&
$3 E E2E4E<$
!Q4R%2 E$
%%% E$(:$"14#+
&$) &+%+8+&E4E
E<%%%2
(:$"14#$
4.9.4 Date of constellations 13 and 14
54 &%
$3& %%82
'KK$5 !QR%"F1#
$348 'KK
%F1 2 $
32% !
$ !+
%4$
O2% $%
!" QR#2 $
4.10 Further specific features concerning Giza
2/")0??#+
4$0$/4$0$$% %
??
$%2 +
%2&%&$34$0$44$0$
A.CA$C3 %
% (:$"#4$0$<4$0$1 &
2&$
4.10.1 Matching coefficients
3 ! &
A%C
%2$ %E $2
%$ % %AC&
%&$
3% 8 6%2
$5 (."P)BM4$<!#
6%"4<$Q02$3,
$P//?R#$. 6%
%"?<$4# %<00
] :"$/!#$2
:2$<PT(.
(G$% 0$PT
$2 %%$O22
2%% %"000000000#<00$
A C E %
2$:2!$
: $2$
$(>.M000000000`
/$ ] @"]#M<00`
F!%:"$$ (
FOY!# "#
% 8"$$0040001000000$#$3%
2% 0PT
2$=&$F:+
&%0$ 0: %2$)+
2 2
00<00$2 :00<00&%0PT$)
%2Q$P<4P $R$O2 0PT
2:%:
$2$
2% 2
%$3 ! & 2 $$
(* ($2/
2%$/:2% 0PT
> 2%$
O%2
PTU2!% /
?
% PT$3 :
"!<00P#2 UB 2%$
=2%2 $3:
2U2 :$
:"$$5/5%:%#"554d#
:!$2 $
)%$$!$$5&
::
/$ A 2 $C 3 %
/$1P`P0?P@$2 0$PT
% 2%@$5 @
% 00000000$
2$2 /$%2%
$
=! $2 !
:%:% %
$.:"#"# %+
e) ! $O
%$*2%:2
!$% %A C&+
2%$(%(:$"#%84$0$<4$0$1
Q4R$%$
4.10.2 Obliquity of the ecliptic
5/ %
(G $ " (G#
(G /4$41]"ME9E$4$$4$4#$2%
,.?1%E EE1+
8 %$
=%G
e:% ^/$4]
: (G"#$7%
%:%%2 %$
0
!"1"
"'#==,#,CJE!+#,#+#
2 (G:+
(G +
$ ]$3 !%/<?76%
2 0076/076" 6%%
%)*./QP/R#^GMP/4$0] (:$"4#$%
2$)25$P/0"5$P/#$ %
!%&%
%5$P/%(G D8$"'!
2%^GMP/4$0]?0076$#
4.10.3 The riddle of midwinter
5P/6%A.C +
$3 ! A./C"5$/#
$<] 8$"= 5GMP<$/P GMP0$1P GMP/$<?P
2 A*%CA.C>
53 2% F)
/0$ F 58D 6!
$32%%!%
3$ + ",.#$2+
%& /4$41]AC$
+.>>"6"#
$4$>%"S""5#/PXP"#/##PMP$<0]$#.
28$:3
. &%4]28e
% . %$3&
28D8?$41]$$
3 .D8<$1]$5P/2
$3! A*%C
A.C.$
$]2%$5%
$
3&% ]$)
:% 2$F! +
6%"/<?76#)*.Q/R$ .2
8 % PMP0]>P^G>P;; 6
%$=^M/4$0];GMP/]P?$1/4GQ4R .PMP<$0]$5%
0??^M/$0]PM<$1]$72 %$
A./C%&% A*%
C5$/$2 !
A*%/"5$/#C"S5#PMP$4]$3.!%
%&%0$<]$"
6Q/R$# !%/<?76+
% $0]<$0]>P$<]>P0$<]PMP$?]%$
:$
= /<?P76
"/1076%#2%2 ,
:!//$
4.10.4 “Sun position” and concrete platform
35$PA.C&%<10 *%!+
%$ %%%%0??
% ,.?1%+ +
$: %e%$
3/0032 $ %
$
/]P1$??G]P1$<?4/G$2 +
%D.2"D&.#$
A.C,.?1/]P1$0G]P1$<?G
" $4$#$ ) /P`P0P/
& 6 %$
%P$%
2 + %%
$%/0/ % $*
%D(D*"2#$
= e3%%
$22 !
!!$:3! +
A.Ce
% $ A.C%2
/
"374%
% +.>>#%"!
6)#G7#G'#GH-$79000IH$#G+<=+<+I#!&
&"!7/H<$09$G=$G'#G=I#"$""
!$"!*<-#534
$$""(&++*#%++.,#*.##
/1/$<P22 *%!%$A.C
/02$. %%
%$
4.10.5 “Secret chambers”
) 26%$7A.C
%A*C40P2IG$2
2 % /00 !$5%.=$P*$P5$
%2 Q<$P,33394$R
A*$C)++ %G
2% 25$P//$
374
) 4$2 ?<$?P?<$1P
%$)2 A*/C?<$11
4$$8 %+
$$7Je
%& "5$P#1$/0PQ
3,P 5$P/R$<) V"0$#Q3,<5$P4R2
1$1P$A*/C4$?P
$3 A*/C/$<P
2 % " 2 5$P/#$
%%0$
6
) 5$///A*C %+
E&% IG
$ *%0??2%%,.?1
%$ $3
A%CD%%
P *$D%+
2% &%02%$
%2%2"
$$$4$#$ 0$/PT
% P A*$C78++
&Je
"# IG/$4<PQ3,15$P0R$
""%3643
4 +.>>$ !% !!# !
"&"!7/H<$09$G+,I# $;$"
!!!56#
364374=.G#' $!
5"#,*#*J!%#5"
"!#0&!!!$
!"$5;#0$5
!%#*#.J"%,.#*J#8
!"76**<#>.374
+#,#*=!!!!#,#:!7$
"!*<#>#"!2#M"%$%36=4
"37=4!#
< 32 & % $
)%& &2
D%Q5$<R%%88.%Q$/R$
4
) A*/C4$?P
"!/0#$3 &%J
J A*C 1$P
$
3 8 %&
A*CJA&
CA C&J
IG%G $&
%G &% %$)
A*/C$/$< &
%1$ $=2%)
*%2.G!% A*C2D%$
364
A.C2$
2% 0$3&
2 25$/$
5$/ 2 2"4#
A.C2$
$/%
"/#$
2
"5$/4# (G$4$?]
20$1PT /
$1]20$/PT$2%
(G 0$1PT
%$
6&"$!!
"!$!#;
%$"5
"QK!'#=+'#=1=#
2 $) 8/"#
2!
$ 3 (G2 4$?]
2%$3/2 +
*%,(&%$
<
% 2 "0]2#$
A%C&$
/$ =A./C"# 0$/PT$+
0$1PT/$PT$
$ ) ! (G"#%
%2 $1] $
(G%2%
IG"(#>5$
/5$/4/$ 2
E<M>0$]0]"$4$#$
4$ 3 & *%2
8% $+
"# 4$1
<$.%
%<"U# 2% +
$3"0$4$<# 8
"M0$000%# % $
%"!! *C$+.>>$
-B,*B*+$# $%6*=$!
!*"=%# $1K!
!!#0$1K!$!%#
35$/2 5$/2
E (G"#$+
%% ( 22$3
/(G2% 2$
)% ,(
*%$5/" #2%
%PMP0$3
%A./CA*/$C5
&$4$$)
"$4$/#$
1
4.10.6 Analysis of equation (1)
(:$"#/ 8 6%$5+
2(:$"#2
6
91
96
"#
% :' $QR2
%6M/0$<4Q4R/1/4?@P`PM/1/4?
2 .(96@91M0000QR$
% 0$0T (:$"#2%$
:%%
2%$2!% (:$"#$
5%.+(22+
%$2 (V2
E(V2 9M"4j@#P
/
//
$
%%2 2
$ (V2$
1[%
!
=+Q<R"B'F#$3
2
2
:
2 ($2+
2$=
E!
2+
8$
5$/<
$
)
9
8
%$)
(
"#$&
;
% "
5$/<#$
+
;L! $
"3
22
2%$#
?
61"G
#;$;*$;=#
=+ 4/0´/<M/0"´#$
" #&% '";#M!G`P"5$/<#
2%;;/$=";#
%";#(:$"#"#4$<$4"5$<#
/;
4/0
!
;/;/ %;/%; /
"1#
% (V
%2%+
$32 " #':
(
';
';
"1<#
2'";#
$6 '
$)2 %
%!2$
)%
2 $
22%$35$
/12 ' '/
8 $3!
'PMP0"
2# '/ :(V
/PMP/ "/ #$7+
& AC
(V '/lM4'/$
3 ''/ (:$"1<#
(
'/'/
''/
"11#
2 M0$P/$7%
(:$"1<#
$7 %AC
''/l%'/(:$"11#%'/lM0$?P/M0$?P/#
2(%"%#
(V$
O2&$= +
2'/'/l% $6
2 (!=!%
2%e='2
"#29 E'6`$
3
9)
0
'K K )
0
'
/K
/
/K '
/
/
/
"1?#
6"%$
%#
%2(2%&2$3
PccP/ 2 2% 2
'/'/l$ 8
$
# "&#
#(V "&#
#2 (:$"1?#"#$
=## A ´C%
& 2 ($7%2
#% 2(2$
: &
* &
*$ 5"&)/#
*Q-R$2 "+=#Q<R"B'F#
*8!$& !"&)/#
*$
*$& "22%#
) ! ++0+/0/$8% %%
4 7↵$.%(
2%2
$ (a005
0<0$" 2<0]$
D0]$#
)U\.-/;,(<2;,(<?;<..
A:$1 >$" #$# "B
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
$ \#D $$"E+A(.# ">B
$ \$$"E+A(.# ">B
$ \#$"E+
?#%$ " #J#%LE #%$""
! ##%" #J#%LE
C"#$%##1#1#A$" #B
AB#$%##"% A#1#BE+A+B
AVB#$%#A###BE+A+B
AV9B#$%#A#$5#BEAB
2#$#$#A###>" #%$ #BE+85[
""$#A@ "BE+85[
.$##$#A#D#BE+85[
-#$$# "A#$BE++85[
A2B-#A#$VBE++85[
A29B-#85#A#$V9BE++85[
-##$5#A292BE85[
AB$ \#A#"">###BE+++8+5[
AB$ \#8A82BE+8+5[
A'B$ \885#A829BE+8+5[
MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
00
3%##1##1#2$)%
2 (+
%% $)/ /
: ($: '1 "#+
'1//
/
/
/
/
+
+
/
/
//
/
/+
+
+
"1#
+
/
+
+
+
/
/
/
PPPP
1(*
3QR 6%%% %
U22
%&$ +
."U#(:$"#$2 % (:$"# %
$2%2
(:$"#$O2 .96M"4j@#
/6
`P"aP#
" #$P
physical quantities deviation
%2%2? ®0$0/1T
2 6% /0$<4
% /0$44Q4R$ ® a0$004T
(2$0?/1`0/!
. 0$000?TQ1?R2$ ®0$00T
(V% 000
%")*.Q/R#%$0$000TQR$ ® 0$000T
:E%
6%*7QR /0$4$ ®0$0004T
2% 0$0T22:
0$00 PT 2% 0$% :
/6PMP"<0?PfP/<#!Q/R 0$001T$3
2(:$"#
/6
P$2%
%%&%0$0PT$%+
%%2(:$"#%
(:$P"#% U: %U *+
2(+
+QR"B'F4#$2%$
1(=+
6(:$"/#/2 ,%!+
, 2$(:$"#
*%!% % $
% $
0
4.10.7 Determination of the solar radius
.2 +
$=
:%% $) +
2%% % (:$"# %
:$
$ &%(V
2%$5&.
.$
.
2$ $
/$ =2*%
$3, $
2,&,!%)/1
&*%)/0/$
$ +$5&
2%%. 2$)+
! 2"+ #%$
4.
$& . 2(
% .$
3 2.: !2%
$O2%
$5 2%
% %(%$
"#$
) 2
fP00!$ fP0$01PT$7
&! 2% &$
!%$
=:%"
;$/$# %
2$ /03)B"3)B#
"#&%<100!!+
$3 2!
% $3
& &%f/00!$
3 2 3)B(:$"#% 0$00TQ/R
$0$0?T%2%$.
(:$"#2%$5
!:+
$=%
($ Q/R2%%
%2&%$
/00! 3)B2$"3 20+
(:$"#<0?$"f$0#!a Q/R$#
0/
5. The pyramids of Teotihuacán
5 2 %( D8;
"5$/?#$3/0032!!
6m*&"-3,$3*'63*'6#$=3
%2 *&$3;+
&%$ %%
$
5.1 Planetary correlation and data
) ; 2
5$/?$)2%&2)2 +
"5$#$22!2$
522!!!$
#6$7$X=.*,S60$!#
6""!#1&
%#%!5!$6$/6
F"#'!%!!$#
0
)2$"/>/0#%
;(%$)
!$2%%!
2$)IG 2
. $
5$/$=+E&%
.$("#
P"#%
(
P
"?0#
)5$/2/M!/X"`#/%
!
/
!
/
"?#
!+&$!%
%% $
6!!%6#
3&2%% .
'."5$/?#$3
% $
&%
$3%&2+
2$"'!&
%&%+7$#
& &
%$
04
5.1.1 Assignment of the planets
! %25$0$2
% .2%0]%
( &$
7 %"6#
'6"!#=#=#=#+#
5.1.2 Different measurement methods
3 %;
% )2 $3":#
$%
$%%
%% D.$)%
$ *$$D*
('(=D+$
/$ D.+D*('(=D$%+
+
4$<$4"2#$
$ B%;$:+
% $
%%22 $
)2% $
4$ %;D.:
$
0
%%2%$ :
2;$)"#%
%:$.
"#! $ %
! %$
=%
!"5$#$=!%
2%$ 2A2$C
28
$222$
% %$3
! %2
$ $
6#!$
%#;6%%$%
!!!
#$%!"$!=*,#>6!>#
#=+.,!%%7#6BX=.*CM1/1$=.*,!$0810#
5.1.3 Geographical and astronomical data
%)2
?$D.
%D*?$)5$0
)2
$ (%$O
?%&$
% $
0<
'#+.#'7$
'#G+,#!!#
6"!!7#$
7$6 %!
"7#!"_
!%$!"`"#
P*P+'6'#+-#
No. Locations "5$0Q/</1R# cel. body geogr. lat. geogr. long. dist. [m] d [mm]
% * . $<<</ J?$?41 0$00 0$0
/ 8F A.C $<141 J?$?44// 1$00 $
A)2$C.%$ *% $</?/ J?$?4< 1<1$< /00$0
4 , $<</0 J?$?4<0/? /$0? /40$0
% . ( $</4l J?$?4<l ?$/n /4$n
< / * $<0</ J?$?4<0/ 0<$/0 /10$/
1 ) $<??0 J?$?4<4< $1/ /$4
? 4 $<??4 J?$?4<?0 /10$< $0
. $<?111 J?$?410 $? $
0 < B $<?<4 J?$?414< 4$1 $4
'. O $<?1?? J?$?411/ /$<4 4$
/ H"5$.%$# ."(# $<???l J?$?4<?0l 1/$/n 44<$1n
H A"(# $<?/l J?$?4<4?l 140$44n 4$?n
4 H") # A"(# $<?/00l J?$?4<<//l 1<0$4?n 4?$4n
H/ A"!# $<?/ J?$?4?4? <$</ $
< H") # A"P# o o /<<$1n <4$<n
1 H A"P# o o /?<$?0n <$/n
? H"5$.%$# A"P# o o //4$?n 1<$n
625!#"
&H=>I#!
%!F#7H*>I"96:>=H*I#%#25
%$"#(&H=<I#
celestial body [km]
Q/?R
Q/?R
[km]
)/000
)/000
[km]
)/00
)/00
."# <0? o o o o o
*% 100000 0$/0< 100?0 0$/0<? 100?0 0$/0/</
, 0?/00000 0$00<? 0?/0?<00 0$00<11 0?/0?<00 0$001<<01
( 4<00000 0$0<1 4?000 0$0<10?< 4?000 0$014/0
* //100000 0$0 //1/00 0$0400< //1/00 0$0141
11?00000 0$04? 11?/?400 0$04?44 11?/1?00 0$044
. 4/1000000 0$0< 4/4000 0$00?< 4/400000 0$0<//
B /?<<00000 0$04< /?10000 0$04</ /?10000 0$04<?/
O 44<<00000 0$00 40440000 0$00??? 40440000 0$00??1/?
01
!$ %7=.=,&"8!2
8:"a>..%* ?L*,<$<C$>C.#C..&
H-.I#? ! !# ! $$?
&H-*I$!2H-=I#*#
%#0%$
%%(%#
TNO [AU] 4 [years] 5 [km] Ref.
. 4$<f0$< 0$?00f0$00004 /<0$<f$1 f?0Q<R
( <?$/f0$000 0$4//0f0$000004 </$<4f0$004 //<f/Q<4R
D <1$4f0$00 0$4?f0$0000 0$?f0$0 /0f0Q<R
*!! 4$/?<f0$0000 0$<110f0$00000 04$1/?f0$000 40"#Q<<R
H 4$/<f0$0000 0$0f0$00000/ /?$0f0$000 0"#Q<1R
4/$?<1f0$00004 0$/?f0$00000 /?0$0f0$0004 "#Q<?<R
. 4/$4//f0$00004 0$00</?f0$00000/ /1$4?f0$0004 ?4<f/Q101R
/00/*.44$11<0f0$0000 0$4<11f0$00000/ /10$0/f0$000 ?00f/4Q1/R
$4?<?1 0$/4??0? /41$4 /1<$<f$/Q1R
$4</f0$0000/ 0$//1<4<f0$000000 /44$0f0$000/ 1f/Q141R
22 +E&%
%$ 2! Q/?R
%*",.?/#$
+ %0000P76)P0000$
2 %
!$5"/000#+OE"O#:
?0! Q<</R$3
O2! Q<>1R$
5.2 Comparison of pyramid area and solar system
% %2&$
2.+O
EO.$5%2
6$
5.2.1 Quantitative analysis of the correlation
3%!%
5$/$ //
: /2" &#%
/
/
/
/
/
"?/#
2
2%$&
"0#$"52 $#E
//! 2%Q1<R
0?
(
// //
"?#
FPMP/$3////$ //
"(:$"?/#:#$) %
"5#M5PXP%$%
/
/
"?4#
%
/
/
/
"?#
3:5$/%2%
$.(2PMP"(#$8
)2
& // M0$</$3 % *!
! /6M<0?!Q/R
%%
0$?0"5$/#$
@ %6#
6%!# %&#
7%#
"!#
O PMP0$00/40/ %PMP$?/?0: "5$
/#% + "!#$
) %8:2% %%
0
AC )
$3;
% % *
8F$A.C 6PMP1P
5$04$3 0
%% PMP%PMP0$"O
//2$3 +
%%$#
'#+="34$!+$/=6#
3 :(:$"?<#2% &%
$3%% .
. %$5
& O?"5$#$
2Q/</1R$=
(
/6
6
"?<#
M0$$$$&M0."#*%/P,
(4* <1.?BO$:
;
% $3. %
$O
8$& & 5$0
;$
% $
0
%%" "
#!=#*.+#=C ?&
8 6 F@ "! ?/@*#8 ! %
!#<$ =..#"!
7D'#=>#'6$H=-I#
3 % % .
.(% *
.$3 AC&% +
$
%)/00"#%
!$ &:3
2%)/00
e5 %?00076)4000
5$aD.$4$0$
$/=$*>$...;
,...#!H*>$#=..#I$
!F7!96:>=H*I#"%
#5/=.#<<<><<+.;6.#<<<<,<C.;#
&//% %
5$000%&2% $
):% $5%
/000P76)P<000,.%2%
"#$O2: *
$5/000764000%$=2
&2% 22?00076$5%
& ?000762% M/%
4000%&%//0000
%$(2 %%
$//5$ ?00076)4000$
= & // %%?0076$2%
$% %2
$$$O
%V$
/
5%%!5$44 %
*%)2
$% *E!
." #$ %.
*$
5.2.2 The temple of Quetzalcoatl
&: H8"5.%#
$ %&
%'.$3
+O$6%)2 %
'."O#$
7 % %
$7% (:$"?0#"?0#(:$"?#%%(
P(P`PPPMP!/$3 8:
! ( P
/
(87)
"!# "(#"P#$"(#"!#"P#
:$=
%8 % &$7%2
H8%0]"5$0#"H>H#
:$H>H5$<2$:+
+OE&&% $
25$<$ O:?00!%.
%$) O I
.. 2%%$
!% %% .$
$3 %+
8%$
$3%O2I7&2%
E$ !2%$)2%+
:(!P8 %%
$%% +
E$
52O%%T
I&%?2&$
2O8 . !.
.Q/<R$
):$35$4&'.$
5$0&2 2
'.)2$
5$1"'a'HaH#$)
.2$$% &"!%
#Q11R$ .
% %$ $
3 $
6:!8:
(>..&
" # 6
" 6 # !
!"
# ! 6
*<CG#"
%:!=.=*H=-I$
"!*."
7 =.=,#6 P
$
!!&
7615@!:
#
$
P'
6 #
5
H=-I#8 $
#==.#-"$
!!6#
%GLG==+#*>G!"P*
P=!#>#
6BX=.*CM1/1$=.*,
!$0810#
4
3 )2 !Q/<
4R. %>
5$P?$7%."6# 1$0?
%4]
% (:$"?<#$O28
%
8 "%
*#$
68!26# $5
$#6$6G$*<<#.>!
"1(#>-#2//#%H=-I#
32 5$0 (2 &%0]
% .$% % ( >
!+$)%5.%%
0]+ .$6:%+
) " .#
6$A++$CO3
5$12 H/'/5.%2
&%) $3 .e)e
> > "&+
#2 2e$$$B:$
3
%$"OA2C% A)2 $C#
*%2!"2#$
*% !22$
* 2$2"5$4#$
*) ;%$
*&2!%&!&$
*% A*C.$3! .
8% A*C".#"#
:$& %$
*% A.C ( (&$
*. 2!2(+
%%$!(
($
*% A.C2 *% $
*'. !"#O
"#%+O$)+
%2$
*3 (:$"?<#5$?O?
&$
*. "00#!
. %$
*. $'.A'OC
2A)2 C"68#$
*A5.%C% +OE.$
*(:$"?<#0: .:$
*3:"8#
%$%% +
// %$
*:$
%!$:) +
e)//b0$?%U
*%&
$/$<)BQ/<R$
*%) .$)%&
&%6%+
& ."&#$
3 %;%
2%(%2
%%$;2
.$3 %! %2
%$
)%D8;%
:2% $ %
&%% "&#$
5%2& 65.
% %400P´400P"5$1#$
<
5.2.3 The Citadel
3 !%%&%
.$62 5.%
) $= % 6
%2%$= 6e
+ !!2!
2 a"!# 10P$5+
%2A$C(&ACAC
2% A&$C
% 2:$
*0%3
! B5
$)!"3
V#
!
% &+
&$
)%
$B
2
$
2%!%
E$
3 & +
%%
e.%E
%
%
%e
22$
.%2%$$ F)"8$
00!#%+$
22 ."5$#
*3 ( $
*3 2
I. %
8$
*! EI$
*="#2$
*)%%%AC$
*(& ."# 2%% $
*6 .$
1
6#0
8 6 S/!@#M$F@!$)&#
5.% 65$
40$3) !" 2%#$
) 6+
.a2%+$
P#
6$
$5#
7 !
5
.%$3
!! +
$3
$
35$4
$
!$
%2%
%2
2
"#$
$
?
0"""#
5$4 "!5$4/AC#$
%$5
22 6$
6%
5$4/$ 2%
! %$
!5#
#
%$'#,.#
%% ;&%
// 2% 2$3
& %6 2$
5.2.4 An investigation of Sedna
$5 %;%
O . . > 2 /00 % *$ ($ 7
6$E$'8Q1?R>%
./01<$2+ ++!%
.$D% +
2 $ 2+
.%$
6.8 +
.a &a!$
2: a/$3 %
% %. a/ a4$
!!
.".#=."=.#(&+
%F"(F#$5$4$
[DF)!!6B8 6 $)&$15@
B6"! S16:$)&#
b bMc@c2 +
2 " 2#2%$=%
?02 $"+
# (F
b?00
$ <0<00
/d0$00
C "??#
2$ 2 bPMP0$00C%
$3 .& 00!
8 e) ."#
(M1<$1)B)B^4$<`0<!$
b(00 !
(
,
b(00 !
1<$14$<0<! <0<00
/d0$00?
C "?#
0$00C$3 (F
% %% %00!+8E.$
(F %$
% %
4$0/".#/$4/"=.#1?/"(F#$(F
/0
$/40.$(F%2
.a &a2
$
3 %
.$ O8E%%/00<$
%$ .%
.!$/0%$) %%!+
:&$)+
2 % %%2"2%#
%$)&25$44(,(L,(.E%Q1R$
(,(L,(. %%$. (
)0/04 %%!,($)
"L,#& %%( %$.
)/0<4$
2191e91F6#!!!7
7$!F86#&HC<I$"
&9# #U!&#
.V%% 0$?$)
.% .
$3$<000%&%000)B
2<%( $3
% /0/Q1R%2E&Q?0?R$.
..2
. & %%/000%$
6().O"().
&O#2/0//Q?/R$3 %&+
!2
!($. %!%$..
%;8:%$
/
6. Summary and epilogue
(:"#P>P"#% D8
%*%,("5$P#$3:(
6%$,6 %*%*%!%
." #$:
(numerators) (denominators)
6%(
6
91
96
F.
6%(
9
9
91
99
6 %,
6%(
6
67&
P1
P7
*%!%*%
692 %P .
$ :"#%8QR
4$0$<4$0$1$5 %+
D% 2
$ &%
44% *%$72E
*%,(*AC 2+
% .
*%$ E"@GcP]#
%2%000%"$4$?#$%
2
Apr. 17, 3088, 06:41:13 *%
May 18, 3088, 19:20:59 *% !"#
E *%,(*
May 31, 3088, 06:19:09 %*%
O= *%:*%&+
%A%C0??$5
:% .%$"
28$$'!"B'F<#%=!
F@[66$8 6 "B'F1#B6/+%!$#
::$%
2U::
%2$*%:
% e3QP$?1 $R
%
P$3 %$7%
% 2U
3 % %
$*%!%A5%C6 %
A.%C6%A%C+
: $32%A*%%C
//
A,%CA(%$CIGHG+
6%A(CA,C
A*%C2%$5%: 2
A2C2IG"5$P# 2+
$)%,.?1%
A.CA*C6%$5%2
6%!
"#$
52
+
%
! D8
2 &+
%
$ 1 Q
4R !
2%
& $
. +
&
& 2
AC"B'F?#$
&
% 2$
&
G "B'F#$ )
!%$*2
%$O
2(/+/01+
D%$3 % &!%
2% 3!$
) % QP4R$32
%
%$ QR
% %$%
% 6%&%:
! ! 6
% *%!%$
7 % 2%+
6 %22%E &%0$0$P$
%!$ E!2
!&%E !&%$)A C
>> $3 ! 2
% & !2
2 E$ %
!D8$3 2%AC
%% $5!2
+:$3 !QRf!6&D$
(E+&E+$
/
#
#
3 % 2: (%%
:$3+22% D8
$.!(%2%%
2&:(2&2+
e5 2
Q$P/?P $R$5 !+&
"&#>%%> %2
2Q4R$
) QP4R$
. QRE"D#
QP4P?>?<R$% "B'FP#!2
$) Q4RD8
!
$$
3 %%85$4%
A*C A. C
D%$32
2> % >% +
2%$
.;2")2 #+
%2 !
$) .+OE.
%$:" #2%
(
/6
6
M0$$$$%
.% $3 .8%%
H82 0:$ )+
: .
$3&%"U# 62
& % 2 %$B
E$O2!%(&%F
"(F#6 /0/?
&$%=."=.#+
% %:$
3)2
&%/$<)BQ/<R$:
&*e)2225$P0
4 ;"2#Q?1RQ??R
2"D#$
KKKKKKKKKKKKKKKKKKKKKKK
=: $=
D8%+
!$= $52+
&>>
"#!$O2%E
/4
!%%>%2
:$= 2
:%$
Assuming that the calculations make sense,
I hope the user has the same enjoyment I had,
when I wrote the program. (Hans Jelitto)
"H8D ==
6&7
! =!$#
Acknowledgments
()B*" (#
&! * "B'F/0#$<P $
"# =+7 3$ "B'FP/# ' , B.)$)% !
"B'FP//# *"#2 2
$. !$3$* D!"BD%#
2 $3
$W*p8"3WO*W&6*W&# 2
;/00$%%
!!$*%O=
(&$*%!'W6"6B2%OY6# +
='F7)%!$)%%!
3O)p"3O)*W&#
% ;"5$4#$,2)$N!".
'3')% .*# E%
."5$44#$5%3!! %D8+
;a2%a 2 %2$
/
Appendix A1>.6
D5
2
9% $*"#
D22
($2 2%
$3 %! &
2 $)% UO+
$3:%
$ &26
$3 &
%$%%?1
$
,.?1QP/R"®,.?1N#%7
52,.?1% !..
$ 53(-Q<P1R2
5"D5#$32
& 1/
$= D53_ 5 6
" #266 B"B2% %#
$5'<
8"&'806:S01*+<*B*<<C "''NOF8B2q2#
$B %% 2
D%).8%%%$O25
825 ! $$
?8?'Q?R"B'F/#$
) % %
$O3%
$7%%!! +
$52%" #$3
%+ $$ $
O2% %%
$54% ++&$
6%"$ #% +
+$
DOB52/$/4$/$<2%$
2 %> >%$5
22
!$6D8 K"4$1$#
3
%0??!!$5%% %;
&% $
O ;%!%$
%&:,.%
!32% $2+
"#2
%$33
$
/<
Datei: ~/home/p5/p5.f95 Seite 1 von 110
!--------------------------------------------------------------------!
! !
! P5 (GFortran) !
! !
5! PLANETENKORRELATION DER PYRAMIDEN !
! IN GIZA UND TEOTIHUACAN !
! !
! !
! = !
10 ! = = !
! = = !
! = P 5 = = !
! = Programm = = = !
! = fuer astronomi- = = = !
15 ! = sche Berechnungen = = = !
! = zur Planetenkorrela- = = = !
! = tion in Giza und Teotihua- = =!
! = = can. Grundlage sind Messungen = !
! = = namhafter Aegyptologen, die Aus- = !
20 ! = = wertung von Satellitenbildern und die = !
! = planetarische Theorie VSOP87 von Bretagnon = !
! = und Francou (IMCCE, Paris). Das Programm = !
! = ist eine Erweiterung der zweiten Edition = !
! = von P4. Die historische Abfolge ist daher = !
25 ! = P3, P4 (1./2. Edition) und P5 (3./4. Ed.). = = =!
! = = = = = = = = = = = = = = = = = = = = = = = = = !
! = = = = = = = = = = !
! !
! Hans Jelitto, Hamburg, 12. Maerz 2025 !
30 ! !
! !
! Kurzbeschreibung !
! !
! Das Programm P5 berechnet fuer lange Zeitraeume die !
35 ! Positionen der Planeten unseres Sonnensystems und er- !
! moeglicht einen praezisen Vergleich mit der Anordnung !
! der Giza-Pyramiden bzw. der Kammeranordnung innerhalb !
! der Cheops-Pyramide. Weiterhin berechnet es die Pha- !
! sen der Merkur- und Venustransite vor der Sonne und !
40 ! bestimmt Zeitpunkte von "linearen" Planetenkonstella- !
! tionen (Syzygium) im Zusammenhang mit den Pyramiden. !
! Verschiedene Theorievarianten und eine Vielzahl von !
! Optionen ermoeglichen Quervergleiche. !
! !
45 ! Eine weitere Planetenkorrelation wurde in Bezug auf !
! den Pyramidenbezirk in Teotihuacan (Mexiko) entdeckt. !
! Dies wurde hier ebenfalls implementiert. P5 reprodu- !
! ziert die astron. Berechnungen in den zwei Buechern: !
! !
50 ! 1. "PYRAMIDEN UND PLANETEN - Ein vermeintlicher Messfeh- !
! ler und ein neues Gesamtbild der Pyramiden von Giza", !
! Wissenschaft und Technik Verlag, Berlin (1999), !
! ISBN 3-89685-507-7 !
! !
55 ! 2. "PYRAMIDEN UND PLANETEN II - Giza und Teotihuacan" !
! (in Vorbereitung) !
! !
! ----------------------------------------------- !
! * COPYRIGHTS UND VERWENDUNG DES PROGRAMMS * !
60 ! ----------------------------------------------- !
! !
Datei: ~/home/p5/p5.f95 Seite 2 von 110
! Bezogen auf das Copyright von H. Jelitto stehen das !
! Programm P5 und die uebrigen Programmteile fuer wis- !
! senschaftliche, private, Ausbildungs- und paedagogi- !
65 ! sche Zwecke zur freien Verfuegung, solange der Name !
! des (der) Urheber(s) ordnungsgemaess genannt wird, und !
! duerfen nicht fuer kommerzielle Zwecke irgendeiner !
! Art verwendet werden. Kommerzielle Nutzung bedarf der !
! schriftlichen Genehmigung. Fuer die anderen Programm- !
70 ! teile (A. bis C.), die im Folgenden aufgezaehlt sind, !
! ist zu pruefen, ob eine Genehmigung der Urheber bzw. !
! Copyright-Inhaber erforderlich ist. (Informationen zur !
! Nutzung/Copyright der Datei "p5-manual-03-2025.pdf" !
! stehen zu Anfang jener Datei.) !
75 ! !
! Das Programm P5 wird in der Hoffnung zur Verfuegung !
! gestellt, dass es fuer andere nuetzlich ist, jedoch !
! ohne irgendeine Art von Garantie oder Gewaehrleistung. !
! !
80 ! Die Copyright-Angaben A.-D. beziehen sich auf das Pro- !
! gramm P5, die Versionen von P4 (32-bit-, 64-bit- und !
! Multithread-Version), auf die Version P3, sowie alle !
! zugehoerigen Dateien. (Siehe z.B. Aufzaehlung unten.) !
! !
85 ! A. Unterprogramm VSOP87Z (Original: VSOP87) basierend auf !
! der Theorie "Variations Seculaires des Orbites Plane- !
! taires") und zugehoerige Datenfiles: P. Bretagnon und !
! G. Francou, Institut de mecanique celeste et de calcul !
! des ephemerides (IMCCE), 77 Avenue Denfert-Rochereau, !
90 ! F-75014 Paris, France. !
! !
! B. Programmpaket FITEX (bestehend aus 4 Unterprogrammen !
! im hinteren Programmteil): KIT, Karlsruhe Institute of !
! Technology (zuvor: FZK, Forschungszentrum Karlsruhe in !
95 ! der Helmholtz-Gemeinschaft), Institut fuer Kernphysik, !
! Postfach 3640, D-76021 Karlsruhe. FITEX wurde von !
! G.W. Schweimer um 1972 entwickelt und erstmals ver- !
! oeffentlicht in: H.J. Gils: "The Karlsruhe Code MODINA !
! for Model Independent Analysis of Elastic Scattering !
100 ! of Spinless Particles." KfK 3063, Nov. 1980, Kernfor- !
! schungszentrum Karlsruhe (KfK), Zyklotron Laboratorium, !
! und in: KfK 3063, 1. Supplement, Dec. 1983. !
! !
! C. Umrechnung von "terrestrial time" (TT) in "universal !
105 ! time" (UT) mittels delta-T = TT - UT: Fred Espenak, !
! und Jean Meeus, NASA Eclipse Web Site, Polynomial !
! expressions for DELTA-T. !
! !
! D. Das Hauptprogramm P5 und die uebrigen Programmteile, !
110 ! einschliesslich der Modifikation des Unterprogramms !
! VSOP87 (--> "VSOP87Z"): (c) 2014-2025 Hans Jelitto, !
! Ewaldsweg 12, D-20537 Hamburg, Germany. !
! !
! --------- Danksagung -------- !
115 ! !
! Das Unterprogramm jdedate zur Umrechnung von JDE in !
! ein Kalenderdatum basiert auf einem Algorithmus aus dem !
! Buch von Jean Meeus: "Astronomical Algorithms", 1991, !
! 1st Engl. Ed., Willmann-Bell, Inc., Richmond, Virginia, !
120 ! USA, S. 63. Dafuer und fuer die Auflistung der gekuerz- !
! ten Reihen der VSOP87D-Parameter gilt mein herzlicher !
! Dank! Ebenfalls war das Buch "Transits" von Jean Meeus !
Datei: ~/home/p5/p5.f95 Seite 3 von 110
! (derselbe Verlag) als Basis und zum Testen der Transit- !
! berechnungen aeusserst hilfreich. !
125 ! !
! ----------------------------- !
! !
! Zum Programm P5 gehoeren die nachfolgenden 36 Dateien. !
! Eine ausfuehrbare 32-Bit-Version ist nur zum Programm !
130 ! P4 verfuegbar (2. Edition, Juni 2015). !
! !
! Datei Kurzbeschreibung !
! ----------------------------------------------------------- !
! p5.f95 . . . . FORTRAN-95-Quellcode (dieser Text) !
135 ! p5-64 . . . . . Exe-Datei, 64 bit, single-thread !
! p5-64-m . . . . Exe-Datei, 64 bit, multi-thread !
! p5-64.sh . . . loescht Bildschirm u. startet p5-64 !
! p5-64-m.sh . . loescht Bildschirm u. startet p5-64-m !
! p5-manual-03-2025.pdf: Bedienungsanleitung zu P5 und !
140 ! Beschreibung der Planetenkorrelationen !
! README-P5 . . . Kurzinformation zur Verwendung von P5 !
! README-vsop87 . Kurzinformation zur Theorie VSOP87 !
! vsop87.doc . . Ausfuehrlichere Information zur Theo- !
! rie "Planetary Solutions VSOP87" !
145 ! out.txt . . . . Ergebnis-Datei. Wenn diese nicht be- !
! reits existiert, wird sie bei entspre- !
! chender Option vom Programm erstellt. !
! !
! inedit.t . . . Datei zum Editieren der Eingabeparame- !
150 ! ter --> Parametersatz fuer "inparm.t" !
! inparm.t . . . Input gemaess Schnellstart-Optionen !
! ingiza.t . . . Parameter f. FITEX, Kammer-Koordinaten !
! in der Cheops-P. und Pyramiden-Koord. !
! inserie.t . . . Transitserien fuer Merkur und Venus !
155 ! inteoti.t . . . GPS-Koordinaten, ... in Teotihuacan !
! invsop1.t . . . VSOP87D, gekuerzt, Meeus: Astr. Alg. !
! invsop3.t . . . Polynomdarstellung der Bahnelemente, !
! berechn. aus VSOP82, Meeus: Astr. Alg. !
! !
160 ! VSOP87A, kart. Koord. (Ekl. J2000.0) !
! VSOP87A.mer . . Merkur (Diese und die folgen- !
! VSOP87A.ven . . Venus den Dateien enthalten !
! VSOP87A.ear . . Erde die Parameter zur !
! VSOP87A.mar . . Mars VSOP87-Theorie voll- !
165 ! VSOP87A.jup . . Jupiter staendig - Version !
! VSOP87A.sat . . Saturn April 2005.) !
! VSOP87A.ura . . Uranus !
! VSOP87A.nep . . Neptun !
! VSOP87A.emb . . Erde-Mond-Schwerpunktsystem !
170 ! !
! VSOP87C, kart. Koord. (Ekl. d. Epoche) !
! VSOP87C.mer . . Merkur !
! VSOP87C.ven . . Venus !
! VSOP87C.ear . . Erde !
175 ! VSOP87C.mar . . Mars !
! VSOP87C.jup . . Jupiter !
! VSOP87C.sat . . Saturn !
! VSOP87C.ura . . Uranus !
! VSOP87C.nep . . Neptun !
180 ! !
! DATUM-2.f95 . . Separates Kalenderprogramm (Quellcode) !
! DATUM-2 . . . . " " (ausfuehrbare Datei) !
! ----------------------------------------------------------- !
Datei: ~/home/p5/p5.f95 Seite 4 von 110
! !
185 ! ----------------------------------------------------------- !
! DIE VERSCHIEDENEN OPTIONEN !
! ----------------------------------------------------------- !
! !
! --> Neue Optionen und Ergaenzungen: !
190 ! !
! Die Aenderungen der Programmversion P4 (2. Ed.) !
! gegenueber der Ursprungsversion P3 wurden hier !
! ergaenzt durch neue Aenderungen und Erweiterungen !
! der vorliegenden Version P5 gegenueber P4. !
195 ! !
! > a) Zu typischen Parameterkombinationen gibt es !
! > jetzt 20 anstatt 15 Schnellstart-Optionen und !
! > wie gehabt die Info-Option (111). !
! > b) Verborgene Optionen: Ebenfalls Schnellstart- !
200 ! > optionen - aber nicht im Eingabe-Menue ange- !
! > zeigt - existieren fuer die Resultate in den !
! > Tabellen 39 bis 51 des Buches "Pyramiden und !
! > Planeten" und fuer die Tabellen 17 bis 36 des !
! > Buches 2, das sich in Vorbereitung befindet. !
205 ! > Die Tabelle 39 zum Beispiel besitzt drei Ab- !
! > schnitte, die sich mit den Zahlen 390, 391 !
! > und 392 aufrufen lassen, zusammengesetzt aus !
! > 39 und 0 bis 2. Ebenso lassen sind Anschluss- !
! > tabellen, wie z.B. 29.A und 29.B durch 290 !
210 ! > und 291 berechnen. Das heisst, alle (verborge- !
! > nen) Buchoptionen bestehen aus drei Ziffern! !
! > c) Spezialoption -804: Diese erzeugt die Liste !
! > der JDE-Zahlen und Transit-Serien in einer !
! > neuen Datei "inser-2.t". Wenn gewuenscht kann !
215 ! > diese Datei durch Umbenennen "inserie.t" er- !
! > setzen (im Allgemeinen nicht erforderlich). !
! > d) Optional: Programmstart mit einer Input-Datei !
! > "inedit.t", in der die Parameter manuell edi- !
! > tiert werden koennen (Aufruf mit Option 999). !
220 ! > e) Koordinaten der drei Kammern der Cheops-Pyra- !
! > mide zum Positionsvergleich mit den Planeten. !
! > f) Positionsvorgabe durch die Mittelpunkte der !
! > Kammern bzw. ihrer Ost- oder Westwaende. !
! > g) Sechs verschiedene moegliche Zuordnungen der !
225 ! > Planeten Erde, Venus und Merkur zu den drei !
! > Kammern in der Cheops-Pyramide. !
! > h) Perihelzeiten beim Merkur, Zeitpunkte nahe !
! > der Periheldurchgaenge und freier Zeitpunkt. !
! > i) Automatische Erkennung und Markierung der !
230 ! > Planetenkonstellationen 1 bis 14 bei Verwen- !
! > dung beliebiger Optionen. !
! > j) Uebertragung der Positionen von Merkur bis !
! > Neptun ins Pyramidengelaende auf Basis der !
! > Pyramiden- bzw. Kammeranordnung (bei 3D-Be- !
235 ! > rechnung mit FITEX, Einzelberechnung, Konst. !
! > 1 bis 14). Geographische Koord. (GPS) nur bei !
! > Konst. 12, fuer alle Etappen und Planeten. !
! > k) Kombination VSOP87-Kurzversion und -Voll- !
! > version: Konstellationen, die mit der Kurz- !
240 ! > version gefunden wurden, werden automatisch !
! > mit der Vollversion nachberechnet. Darueber !
! > hinaus: "Zeitintervall um Aphel bzw. um Peri- !
! > hel" auch fuer die Vollversion VSOP87 (sinn- !
! > voll wegen schnellerer Mikroprozessoren und !
Datei: ~/home/p5/p5.f95 Seite 5 von 110
245 ! > der Programmoptimierung). !
! > l) Ausser den beiden Optionen "Blick aus Richtung !
! > ekl. Nordpol" und "ekl. Suedpol" sind jetzt !
! > beide Optionen kombiniert moeglich. !
! > m) Zeitraeume werden nicht mehr mit der k-Nummer !
250 ! > des Aphel- bzw. Periheldurchgangs des Merkurs !
! > angegeben, sondern mit der eher gebraeuchli- !
! > chen Jahreszahl. !
! > n) Die Berechnungen mit VSOP87 wurde auf den Zeit- !
! > raum 13000 v.Chr. bis 17000 n.Chr. begrenzt. !
255 ! > Ausnahme: "Orbital Elements" und Loesung der !
! > Keplerschen Gl.: 30000 v.Chr. bis 30000 n.Chr. !
! > o) Syzygium: Merkur bis Erde bzw. Merkur bis Mars !
! > in Konjunktion, d.h. 4 bzw. 5 Himmelskoerper !
! > des Sonnensystems in einer Reihe: Sonne, Mer- !
260 ! > kur, Venus, Erde und optional auch Mars. !
! > p) Zusaetzlich werden Merkur- und Venustransite !
! > vor der Sonnenscheibe registriert. !
! > q) Zum Testen der Transit-Berechnung kann man !
! > sich lueckenlos alle Transite von Merkur und !
265 ! > Venus anzeigen lassen, was einen Vergleich !
! > mit Tabellen aus der Literatur bzw. aus dem !
! > Internet ermoeglicht. In diesem Fall werden !
! > Datum und Uhrzeit der Konjunktion, aufsteigen- !
! > der bzw. absteigender Knoten und die Nummer !
270 ! > der jeweiligen Transitserie angegeben. !
! > r) Als Zeitpunkt fuer den Planetentransit gibt !
! > es erstens das Kriterium "gleiche ekliptikale !
! > Laengen", zweitens "minimale Separation zwi- !
! > schen Sonne und Planet" (ohne Beruecksichti- !
275 ! > gung der Lichtlaufzeit) und drittens "Beginn, !
! > Mitte und Ende des Transits", d.h. die genau- !
! > en Kontaktzeitpunkte bzw. Phasen. !
! > s) Bei der Phasenbestimmung gibt es die Option, !
! > zusaetzlich die Positionswinkel des Planeten !
280 ! > waehrend der Phasen in Bezug auf die scheinba- !
! > re Bewegungsrichtung der Sonne zu berechnen. !
! > Hierbei ist eine Zeilenlaenge auf dem Monitor !
! > von mindestens 148 Zeichen erforderlich. !
! > t) Fuer die Transitphasen gibt es die zwei Zeit- !
285 ! > systeme "terrestrial (dynamical) time" (TT) !
! > und "universal time" (UT). Die Umrechnung mit !
! > delta-T = TT - UT wird ueber analytische Glei- !
! > chungen erreicht (F. Espenak und J. Meeus, !
! > siehe NASA Eclipse Web Site). !
290 ! > u) Fuer die Angabe der Transitphasen von Merkur !
! > und Venus wurde eine Datumsberechnung von !
! > J. Meeus integriert. Hierbei gibt es die auto- !
! > matische Kalenderwahl (julianischer bzw. gre- !
! > gorianischer Kalender) oder es wird der grego- !
295 ! > rianische Kalender fuer alle Zeiten verwendet. !
! > Die Datumsberechnung wurde derart modifiziert, !
! > dass sie jetzt auch fuer negative JDE gilt. !
! > v) Die Berechnung der dezimalen Jahreszahl wurde !
! > insofern verbessert, dass sie jetzt durch 2 !
300 ! > lineare Funktionen dargestellt wird, die je- !
! > weils fuer den Zeitraum des julianischen und !
! > des gregorianischen Kalenders stehen (abhaen- !
! > gig von der Kalenderwahl). !
! > w) In Bezug auf den Pyramidenbezirk in Teotihua- !
305 ! > can koennen fuer die Wallabstaende auf der !
Datei: ~/home/p5/p5.f95 Seite 6 von 110
! > Strasse der Toten und die Planetenabstaende !
! > Korrelationskoeffizienten berechnet werden. !
! > Dies ist fuer einen gegebenen Zeitpunkt als !
! > auch fuer ein Zeitintervall in konstanten !
310 ! > Zeitschritten moeglich. !
! > x) Die Option fuer die Programm-Ausgabe "Drucken" !
! > im Programm "P3" wurde durch "in Datei" er- !
! > setzt. Hierbei werden die Ergebnisse gleich- !
! > zeitig auf den Bildschirm und in die Datei !
315 ! > "out.txt" geschrieben. Um die Resultate dauer- !
! > haft zu speichern, muss die Datei "out.txt" !
! > nach dem Programmlauf umbenannt werden. Sonst !
! > kann sie beim naechsten Programmlauf ungewollt !
! > ueberschrieben werden. !
320 ! > y) Ebenfalls wurde zur Anzeige der Ergebnisse !
! > ein neues Format ergaenzt (special), das fuer !
! > eine Konstellation (z.B. 12) einige spezielle !
! > Parameter ausgibt. Damit lassen sich die we- !
! > sentlichen Tabellen aus dem Buch 2, z.B. mit !
325 ! > den verborgenen Optionen (siehe oben Punkt b), !
! > relativ einfach reproduzieren. !
! > z) Optimierung der Rechengeschwindigkeit, unter !
! > anderem durch Modifikation des Datenaufrufs im !
! > VSOP87-Unterprogramm (neuer Name: VSOP87Z) und !
330 ! > Verbesserung der Programm-Ausgabe, z.B. durch !
! > ausfuehrlichere Kopfzeilen, jetzt in Englisch. !
! > Am Ende des Programmlaufs wird die benoetigte !
! > Rechenzeit (CPU time) und Laufzeit (run time) !
! > angegeben, die nach Multithread-Optimierung !
335 ! > sehr unterschiedlich sein koennen. Diese Opti- !
! > mierung in P5 gilt fuer jede Thread-Anzahl. !
! ----------------------------------------------------------- !
! !
! !
340 ! Optionen von P5 insgesamt: !
! !
! (Falls nicht mit "Teotihuacan" gekennzeichnet, !
! beziehen sich die Optionen meistens auf Giza.) !
! !
345 ! ---------- Schnellstart-Optionen: ------------------------- !
! 1-20 --> Die wesentlichen astr. Berechnungen !
! 21-22 --> Mer./Ven.-Transite + Positionswinkel !
! 111 --> Information zu Autoren u. Copyrights !
! 390-519 --> Tabellen 39-51 aus "Pyram. u. Plan." !
350 ! 170-381 --> Tabellen 17-38, Buch 2 (in Vorb.) !
! 999 --> Input aus "inedit.t" (editierbar) !
! -804 --> Erzeugung der Datei "inser-2.t" !
! (0) --> Startparameter fuer Einzelmenues !
! !
355 ! ---------- Pyramidenbezirke: ------------------------------ !
! 1. Giza (Gizeh), Aegypten !
! 2. Teotihuacan, Mexiko (siehe weiter unten) !
! !
! ---------- Planetenpositionen: ---------------------------- !
360 ! 1. Anordnung der 3 Pyramiden in Giza !
! 2. Anordnung der 3 Kammern der Cheops-Pyramide !
! 3. Konjunktionen (Transit, Syzygium) !
! 4. Planetenkorrelation in Teotihuacan !
! !
365 ! ---------- VSOP87-Version: -------------------------------- !
! 1. Kombination von Kurz- u. Vollversion VSOP87 !
Datei: ~/home/p5/p5.f95 Seite 7 von 110
! 2. VSOP87 Kurzversion (Buch von J. Meeus) !
! 3. Keplersche Gleichung mit VSOP82 (Meeus) !
! 4. VSOP87 Vollversion (IMCCE, Internet) !
370 ! !
! ---------- Koordinatensystem in VSOP87: ------------------- !
! 1. Ekliptik der Epoche (VSOP87C, alle Vers.) !
! 2. J2000.0 (VSOP87A, nur Vollv. und Kepl. Gl.) !
! !
375 ! ---------- Umfang der Programm-Ausgabe: ------------------- !
! 1. normal (eine Zeile pro Konstellation) !
! 2. detailliert (mehrere Zeilen pro Konstell.) !
! !
! ---------- Zuordnung: Planeten <-> Kammern: --------------- !
380 ! 1.-6. Sechs moegl. Zuordnungen von Erde, Venus !
! und Merkur zu Koenigs-, Koeniginnen- und !
! Felsenkammer: 1. E-V-M (Standard), 2. E-M-V, !
! 3. V-E-M, 4. V-M-E, 5. M-E-V, 6. M-V-E. !
! !
385 ! ---------- Zeitpunkte: ------------------------------------ !
! 1. Apheldurchgang des Merkurs !
! 2. Periheldurchgang des Merkurs !
! 3. Aequidistante Abfolge von Zeitpunkten in !
! Zeitintervallen, die jeweils den Aphel- !
390 ! durchgang des Merkurs enthalten !
! 4. Aequidistante Abfolge von Zeitpunkten ana- !
! log um den Periheldurchgang des Merkurs !
! 5. Zeitpunkt voellig frei und Minimierung der !
! Abweichung zwischen Pyramiden und Planeten- !
395 ! anordnung durch Variation des Zeitpunkts !
! !
! ---------- "Sonnenposition": ------------------------------ !
! 1. genau suedlich Mykerinos-Pyramide (1D) !
! 2. genau suedlich Chefren-Pyramide (1D) !
400 ! 3. unbestimmt (2D und 3D) !
! !
! ---------- Berechnung ("Sonnenposition" unbestimmt): ------ !
! 1. 2-dimensional, Projektion auf Hauptebene !
! 2. 3-dimensional, durch lineares Gleichungs- !
405 ! system und Uebertragung der Loesung !
! 3. 3-dimensional, Koordinatentransformation !
! mit Fit-Programm FITEX !
! !
! ---------- Referenzsystem bei 2D-Berechnung: -------------- !
410 ! 1. Ekliptikales System !
! 2. Merkurbahn-System, Transformtion A, B oder !
! C (Gerade "Sonne - Merkur-Aphel" = x-Achse, !
! Merkurbahn def. xy-Ebene, Ekl. d. Epoche) !
! 3. Venusbahn-System, Transformation A, (Pro- !
415 ! jektion "Aphel - Merkur" genau auf x-Achse, !
! Venusbahn def. xy-Ebene, Ekl. der Epoche) !
! !
! ---------- "Polaritaet" bei Projektion (2D): -------------- !
! 1. Blick vom ekliptikalen Nordpol !
420 ! 2. Blick vom ekliptikalen Suedpol !
! 3. Beide Optionen 1. oder 2. !
! !
! ---------- Vorgegebene Hoehenlagen (3D): ------------------ !
! 1. Grundflaechen der Pyramiden !
425 ! 2. Schwerpunkte " " !
! 3. Spitzen " " !
! !
Datei: ~/home/p5/p5.f95 Seite 8 von 110
! ---------- Kammerpos. in Cheops-P. (3D, z-Koord.): -------- !
! 1. Ostwaende der Kammern !
430 ! 2. Mitte " " !
! 3. Westwaende " " !
! !
! ---------- Zeitpunkt-Eingabe: ----------------------------- !
! 1. Angabe der Konstellation (Nr. 1 bis 14) !
435 ! 2. Jahr bzw. Jahresintervall (von ... bis ...) !
! 3. Aphel- bzw. Periheldurchgang (k-Nummer) !
! 4. Julian Ephemeris Day (JDE) !
! !
! ---------- Planeten in Konjunktion: ----------------------- !
440 ! 1. Alle Merkur-Transite in einem Zeitintervall !
! 2. Alle Venus-Transite " " " !
! 3. Merkur bis Erde in einer Reihe (Syzygium) !
! 4. Merkur bis Mars " " " ( " ) !
! 5. Syzygium (3./4.) nur mit simultanem Transit !
445 ! !
! ---------- Transit-Bestimmung (geozentrisch): ------------- !
! 1. Transite: gleiche eklipt. Laenge Planet/Erde !
! 2. Transite: minimale Separation Planet/Sonne, !
! 1./2.: ohne Beruecksicht. der Lichtlaufzeit !
450 ! 3. Phasen und minimale Separation von der Erde !
! aus gesehen, Lichtlaufzeit beruecksichtigt !
! 4. Phasen wie in 3. und Positionswinkel !
! !
! ---------- Kalendersystem: -------------------------------- !
455 ! 1. Gregorianischer Kalender fuer alle Zeiten !
! 2. Automatische Wahl des Kalenders !
! (Greg. < 4712 BC < Julian. < 1582 AD < Greg.) !
! !
! ---------- Zeitsysteme: ----------------------------------- !
460 ! 1. "terrestrial dynamical time" (TT) bzw. JDE !
! 2. "universal time" (UT), basierend auf delta-T !
! (NASA Eclipse Web Site). !
! !
! ---------- Distanzen in Teotihuacan (Strasse der Toten): -- !
465 ! 1. berechnet aus GPS-Koordinaten [m] !
! 2. vor Ort gemessen [m] oder Karte/Monitor [mm] !
! !
! ---------- Lokale Laengeneinheit fuer Teotihuacan: -------- !
! 1. mm (Karte/Monitor) oder m (real, vor Ort) !
470 ! 2. "Sonne-Laengeneinheit" (Plaza de la Luna) !
! !
! ---------- Astronomische Laengeneinheit (Teotihuacan): ---- !
! 1. Kilometer !
! 2. Sonnenradius als Laengeneinheit !
475 ! !
! ---------- Basis des Logarithmus (Teotihuacan): ----------- !
! 1. Basis 10 !
! 3. Basis 3 (Option 2 fehlt.) !
! 4. beliebige Basis !
480 ! !
! ---------- Umfang der Augabe: ----------------------------- !
! 1. einzeilige Datenausgabe pro Konstellation !
! 2. ausfuehrliche Datenausgabe !
! 3. (Zeitpunkt oder Zeitintervall, Teotihuacan) !
485 ! !
! ---------- Ausgabegeraet: --------------------------------- !
! 1. Monitor !
! 2. Monitor + Datei auf Festplatte ("out.txt") !
Datei: ~/home/p5/p5.f95 Seite 9 von 110
! 3. Spezial-Programmausgabe (auf Mon. + Datei) !
490 ! 4. Programm-Abbruch !
! !
! ----------------------------------------------------------- !
! !
! Anmerkungen: !
495 ! !
! Die letztere Aufzaehlung (Optionen insgesamt) wurde der !
! Uebersichtlichkeit halber etwas vereinfacht. Sie entspricht !
! nicht immer dem Eingabe-Menue, das beim Programmstart mit !
! "detailed options (0)" abgefragt wird. Ausserdem sind nicht !
500 ! alle Kombinationen der Optionen durchfuehrbar. Solche, die !
! nicht erlaubt sind, werden beim Programmstart gar nicht zur !
! Auswahl gestellt. Das Programm ist gegen inkorrekte Eingabe !
! weitestgehend abgesichert. Eine Kontrolle entfaellt nur, wenn !
! die Input-Parameter in der Datei "inedit.t" manuell editiert !
505 ! werden und der Programmstart mit der Option 999 erfolgt. !
! !
! Anstelle des FORTRAN-77-Compilers (IBM Professional Fortran !
! Compiler, Version 1.0, Ryan McFarland) wird jetzt unter !
! Ubuntu Linux der GNU-Compiler GFortran verwendet, der den !
510 ! vollen Sprachumfang von Fortran 95 sowie die meisten Teile !
! von Fortran 2003 und Fortran 2008 enthaelt. Das feste Zeilen- !
! format wurde (im Prinzip) durch das freie Format ersetzt. !
! !
! Zum Programmpaket FITEX: !
515 ! Alle Real-Konstanten wurden mit Exponent "D" versehen, eben- !
! falls Funktionen wie DSQRT usw. eingefuehrt, sowie REAL(8) !
! und INTEGER(4). EPS wurde von 1.D-5 auf 1.D-8 gesetzt. !
! !
! Zum Unterprogramm VSOP87 bzw. VSOP87Z: !
520 ! Die VSOP87-Routine wurde dahingehend modifiziert, dass die !
! umfangreichen Dateien der VSOP87-Theorie nur einmal gelesen !
! und im Rechenspeicher in ein Array geschrieben werden, was !
! die Rechengeschwindigkeit wesentlich erhoeht. Ausserdem wur- !
! de das Unterprogramm mit "OpenMP" weitgehend fuer eine be- !
525 ! liebige Anzahl Threads parallelisiert (Fortran-95-Standard). !
! !
! Bei den Konstellationen 13, 14, sowie den "quick start !
! options" 322 und 323 wird automatisch auch die jeweilige !
! Merkur-Aphelposition berechnet, da sich hierbei der Merkur !
530 ! nicht im Aphel seiner Bahn befindet. Dies geschieht jedoch !
! nur bei Verwendung bestimmter Optionen, wie z.B. 3D/FITEX. !
! !
! Dieses Quellprogramm enthaelt Abschnitte, die deaktiviert !
! wurden (durch "!c", "!h", "!t", "!f" bzw. "!v") und fuer !
535 ! spezielle Zwecke gedacht sind. Das Aktivieren einiger Zeilen !
! durch Entfernen von z.B. "!h" am jeweiligen Zeilenanfang be- !
! wirkt das Einsortieren der Genauigkeiten Fpos in ein Array !
! (--> Histogramm: Fpos(0...5%) in Schritten von 0.05%). !
! !
540 ! Groessere Stellenanzahl in der Ergebnisausgabe (siehe "!f"): !
! Fuer einige Optionen koennen mehr Dezimalstellen angezeigt !
! werden. Dafuer sind entspechende Format-Statements zu erset- !
! zen. Schnellstart-Opt. 4, 9: siehe Ende des Hauptprogramms; !
! 3, 8: siehe Ende des Unterprogramms "plako" (durch Aktivie- !
545 ! ren bzw. Deaktivieren jeweiliger Formatzeilen). Auch wenn ei- !
! nige Schnellstart-Optionen in dieser 4. Edition modifiziert !
! wurden, bleibt der theoretisch Hintergrund unveraendert. !
! !
! Um bei Verwendung der Compiler-Option "-Wuninitialized" bzw. !
Datei: ~/home/p5/p5.f95 Seite 10 von 110
550 ! "-Wall" Warnmeldungen zu vermeiden, wurden einige Variablen !
! zusaetzlich vorab initialisiert und mit "pre-init." markiert. !
! !
!--------------------------------------------------------------------!
555 !-----Module----------------------------------------------------------
module base ! GRUNDLEGENDE VARIABLEN UND KONSTANTEN
save ! (Laengen in Metern, Zeiten in julian. Tagen)
integer(4) :: lmax(15),jp(12,6),il(3)
560 real(8) :: xyr(37),re(78),pyr(40)
real(8) :: ax,ay,az,bx,by,bz,cx,cy,cz,ao,ai,at
real(8), parameter :: pi = 3.1415926535897932d0, &
pidg = pi/180.d0, zjd0 = 2451545.d0, &
565 gdpi = 180.d0/pi, c = 299792458.d0, &
tcen = 36525.d0, AE = 149597870700.d0, &
tmil = 365250.d0, z0 = 0.d0, &
! ("Allen's Astrophys. Q.", R-Sonne: 695508 km bzw. 958,966",
570 ! Sonnenradius in "Transits", Meeus: 695990 km bzw. 959,63")
R0 = 695508000.d0, & ! R-Sonne (Brown/Christensen-Dalsgaard)
R3a = 6378136.6d0, R3p = 6356751.9d0, & ! R-Erde, IERS 2003
pmer = 2451590.257d0, & ! Erste Merkur-Perihelzeit nach J2000
ymer = 87.96934963d0 ! Merkur-Umlaufzeit: Perihel -> Perihel
575
real(8), dimension(2), parameter :: &
! Radien: Merkur 3,3629", Venus 8,41", Venusradius mit knapp
! 50 km Atmosphaere (ohne Atm. 6051000 m)
Ra = (/ 2439700.d0, 6099500.d0 /), & ! Radien (Mer., Ven.)
580 tsid = (/ 87.9693d0, 224.7008d0 /), & ! T-siderisch ( ", ")
tsyn = (/ 115.8775d0, 583.9214d0 /), & ! T-synodisch ( ", ")
! Theoretischer Massstabsfaktor (Planetenpositionen : Pyramiden-
zthe = (/ 9.7073d7, 2.3614d9 /) ! bzw. Kammerpositionen)
585
real(8), dimension(14), parameter :: &
! Nummern des Merkur-Apheldurchgangs der Konstellationen 1-14
akon = (/-38912.d0, -23134.d0, -7356.d0, 8422.d0, &
24200.d0, -24130.d0, -8352.d0, 7426.d0, &
590 23204.d0, 38982.d0, -4781.d0, 4519.d0, &
39313.9134336d0, -20240.1362451d0 /)
!c 39313.91342804d0, -20240.136249887d0 /)
! (alte Werte, Konst. 13, 14, manuell und
! iterativ mit P3 bestimmt)
595 end module
module astro
save
! Parameter der VSOP87-Kurzversion nach Meeus
600 real(8) :: par1(3,69,6,12)
! Parameter der VSOP87-Vollversion
real(8) :: par2(3,2048,0:5,3,9)
integer(4) :: it2(0:5,3,9),in2(0:5,3,9),iv2(9)
! zur Berechnung mittels Keplerscher Gleichung
605 real(8) :: par3(4,6,8,2)
! zur Bestimmung der Transit-Serie
real(8), parameter :: t13BC = -3027093.d0, t17AD = 7930183.d0
real(8), dimension(2), parameter :: cc=(/16802.20d0,88756.13d0/)
integer(4), dimension(4), parameter :: jj = (/-150,154,-6,19/)
610 integer(4), dimension(2), parameter :: ji = (/15,7/)
Datei: ~/home/p5/p5.f95 Seite 11 von 110
real(8) :: ser(-180:170,2),ase(-180:170),zstart
integer(4) :: ise(-180:170),isflag,ismax
! zur Berechnung der Planetenkorrelation in Teotihuacan
character(20) :: tname(0:17); character(1) :: q(0:17),st(0:17)
615 real(8) :: teot(0:17,4),comp(0:8,4),bmas(2,3)
real(8) :: alin(3),blin(3),phdis(3)
end module
program P5
620 !-----Hauptprogramm---------------------------------------------------
!-----Deklarationen und Initialisierungen
use base; use astro
implicit double precision (a-h,o-z)
625 dimension :: res(12),rp(3,4),md(0:9),pan(5),sd(2),zjda(4)
dimension :: df(6),diff(9),r(6),rku(3),rk(12)
dimension :: x(7),e(7),iw(100),f(9),y(9),z(9),w(1000)
dimension :: x0(7),iw0(4),w0(3),zmem(78),inum(0:4)
dimension :: ida(7),da(7),id5(5,7),da5(5,7),iw1(8),iw2(8)
630 dimension :: xx(5),yy(5),test(10),ort(0:9,4),rcm(3),acm(3)
!h dimension :: ihis(100) !h
character(1) :: t1(3),tra(2),tr,dp,ts,sl
character(2) :: dd,dn,ds,dss,kon
character(3) :: dk,pla(0:9)
635 character(5) :: dmo,dmo5(5)
character(7) :: emp
character(8) :: str,str2,str3
character(10) :: plan(0:9),zdate,ztime,zzone
character(20) :: dummy
640 character(23) :: text(0:9),tt(2)
character(49) :: titab
real(8) :: lbase(4) ! Teotihuacan
character(27) :: tluna(2) ! "
character(11) :: trsun(2),di(3) ! "
645 character(5) :: tdi(3),str4 ! "
character(14) :: di2(3,2) ! "
character(40) :: di3(2) ! "
data diff/0.d0,12.19d0,21.41d0,0.d0,-34.784d0,145.d0,60.4d0, &
168.d0,21.41d0/,pla/'Sun','Mer','Ven','Ear','Mar', &
650 'Jup','Sat','Ura','Nep','E-M'/
data titab/'body x[m] y[m] z[m] dr[m]'/
data tt/ ' (pyramid positions) ',' (chamber positions) '/
data text/' ',' of the "planets" ', &
7*' ',' barycenter -->'/
655 data plan/'Sun ','Mercury ','Venus ','Earth ', &
'Mars ','Jupiter ','Saturn ','Uranus ', &
'Neptune ','Earth-Moon'/
data str/' --- '/,str2/' -- '/,str3/' -- '/
data emp/' --- '/,dn/' '/,ds/' *'/,dss/' <'/,dp/':'/
660 data di2/'GPS dist. [m] ','real dist. [m]','Map dist. [mm]', &
' GPS distance ',' real distance',' Map distance '/ ! Teoti.
data di3/'log(per./km) log(a/km) log(aph./km)', & ! "
'log(per./Rs) log(a/Rs) log(aph./Rs)'/ ! "
data di/'- R^2 (GPS)',' R^2 (real)','- R^2 (Map)'/ ! "
665 data tdi/'"GPS"','dist.','dist.'/ ! "
data lbase/10.d0,0.d0,3.d0,0.d0/ ! "
data tluna/'normal (mm or m) ', & ! "
'Sun unit (Plaza de la Luna)'/ ! "
data trsun/'normal (km)','Sun radius '/,str4/' --- '/ ! "
670 data zjde0/0.d0/,ifitrun/0/,zjdelim/0.d0/,izmin/0/ ! pre-init.
Datei: ~/home/p5/p5.f95 Seite 12 von 110
!-----Input-Daten und Programmstart
call inputdata(ipla,ilin,imod,imo4,ikomb,io,lv,ivers, &
itran,isep,iuniv,ical,ika,iaph,iamax,step,ison,ihi,irb,ijd, &
675 zmin,zmax,ak,zjde1,dwi,dwikomb,dwi2,dwi3,nurtr,iek,iop0,iout)
if (iout==4) then; write(6,*); go to 1000; endif
call cpu_time(zia)
call date_and_time(zdate,ztime,zzone,iw1)
write(6,'(/'' <P5> Computation started ...'')')
680
! . . Die Input-Parameter werden in die Datei "inedit.t" geschrieben.
! Man kann sie dann gegebenenfalls manuell an geeigneter Stelle in
! "inparm.t" (Liste der Schnellstart-Optionen) einfuegen, wobei
! allerdings im Unterprogramm "inputdata" die Schnellstart-
685 ! Optionen angepasst werden muessen. Ausserdem suche --> iop0!
if (iop0/=999 .and.iop0/=-804) then
call inputfile(ipla,ilin,imod,imo4,ikomb,io,lv,ivers,itran, &
isep,iuniv,ical,ika,iaph,iamax,step,ison,ihi,irb,ijd,zmin, &
zmax,ak,zjde1,dwi,dwikomb,dwi2,dwi3,nurtr,iek,iop,2,iout)
690 endif
! . . Parameter fuer Spezial-Output (Konst. 12) --> is12 = 1
is12 = 0
if (((ipla==1 .and.iaph==1).or.(ipla==2 .and. &
695 iaph==2 .and.ika==1)).and.imod<=2 .and. &
ikomb==0 .and.iuniv==1 .and.io==2 .and. &
ison==5 .and.ijd==12 .and.iout==3) is12 = 1
! . . Erstellung weiterer Parameter
700 if (iout==1) then
ix = 6
else
ix = 1
open(unit=ix,file='out.txt')
705 write(6,'(9x,''Output file: "out.txt"'')')
endif
10 write(6,*); kmin = 0; kmax = 0
if (ipla<=2) then
if (ijd>=1 .and.ijd<=14) then
710 ak = akon(ijd)
if (ipla==2 .and.iek==1) ak = ak - 1.d0
call ephim(0,iaph,ipla,ical,ak,iak,zjde1,zjahr,delt)
endif
if (ijd==15 .and.imod==2 .and.iaph<=2) &
715 call ephim(0,iaph,ipla,ical,ak,iak,zjde1,zjahr,delt)
endif
if (ipla==3 .or.(ipla<=2 .and.ijd==15 .and. &
(imod/=2 .or.(imod==2 .and.(iaph==3 .or.iaph==4))))) then
call ephim(2,iaph,ipla,ical,ak,kmin,zjdemin,zmin,delt)
720 call ephim(2,iaph,ipla,ical,ak,kmax,zjdemax,zmax,delt)
if (ipla==3) izmin = idint(zmin)
endif
! . . Parameter fuer Transit-Pruefung
725 if (ipla<=3) then
if (ilin==1) then
itransit=1; il(1)=1; il(2)=3; il(3)=2
elseif (ilin==2) then
itransit=2; il(1)=2; il(2)=3; il(3)=1
730 else
itransit=0; il(1)=1; il(2)=4; il(3)=1
endif
Datei: ~/home/p5/p5.f95 Seite 13 von 110
endif
735 !-----Einlesen der Startwerte und Parameter fuer FITEX
! sowie der Koordinaten der Pyramiden bzw. Kammern
i0 = 0; j0 = 0; if (ipla==1) j0 = 18
if (ipla==3) e(1) = 1.d-6
if (ipla==1 .or.ipla==2) then
740 open(unit=10,file='ingiza.t')
do i=1,8+j0; read(10,*); enddo
read(10,*) dummy,(x0(i),i=1,7)
read(10,*) dummy,(e(i),i=1,7)
read(10,*)
745 read(10,*) dummy,(iw0(i),i=1,4)
read(10,*) dummy,(w0(i),i=1,3)
read(10,*)
read(10,*) dummy,iter
read(10,*); read(10,*)
750 ! Indizes von rp, k: Pyr./Kammern, i: Koordinaten und "Hoehe"
do k=1,3; read(10,*) dummy,(rp(k,i),i=1,4); enddo
read(10,*)
if ((ison==2 .or.ipla==2).and.is12==0) then
read(10,*) dummy,diff(2),diff(3)
755 else
read(10,*)
endif
do i=1,22-j0; read(10,*); enddo
do i=1,4
760 read(10,*) dummy,zjda(i)
enddo; close(10)
if (ipla==2 .and.imod/=3) call chambers(ika,rp)
endif
765 !-----Einlesen der Transitserien zum Festlegen der Startnummer(n)
if (ilin<=2 .and.ipla<=3) then
do i=-180,170
ase(i) = z0; ise(i) = i0
if (.not.(iop0==-804 .and.ilin==2)) ser(i,1) = z0
770 ser(i,2) = z0
enddo
if (iop0/=-804) then
open(unit=10,file='inserie.t')
do i=1,5; read(10,*); enddo
775 do i=-150,150,5; read(10,*)idummy,(ser(i+j,1),j=0,4); enddo
do i=1,4; read(10,*); enddo
do i=-10,15,5; read(10,*)idummy,(ser(i+j,2),j=0,4); enddo
close(10)
endif
780 ismax = -10000; zstart = 99.99d0
endif
!-----Einlesen der Daten fuer Teotihuacan
if (ipla==4) then
785 open(unit=10,file='inteoti.t')
do i=1,19;read(10,*); enddo
do i=0,17;read(10,*)tname(i),q(i),st(i),(teot(i,j),j=1,4);enddo
close(10)
endif
790
!-----Weitere Initialisierungen
do i=0,4; inum(i) = i0; enddo
isflag = i0; ifl = i0
Datei: ~/home/p5/p5.f95 Seite 14 von 110
iflag1 = i0; iflag2 = i0
795 ipos = i0; nfit = 7; mfit = 9
ipar = i0; if (isep==4) ipar = 2
indx = 1; iekk = iek; lid5 = -50000
prec = z0; lu = 10; delt = z0
if (ipla<=3) step = step/24.d0
800 diff1 = diff(2); diff2 = diff(3)
zamax = dfloat(iamax); zjdevor = -1.d10
do i=0,9; md(i) = 1; enddo
!h do i=1,100; ihis(i) = i0; enddo !h
805 ! Initialisierung zur Berechnung fuer die Datei "inserie.t",
! (--> "inser-2.t", danach manuelles Kopieren nach "inserie.t")
if (iop0==-804) then
if (ilin==1) is = -177 ! fuer Merkur, Jahre -18000 bis 18000
if (ilin==2) is = -6 ! fuer Venus, Jahre -30000 bis 30000
810 endif
! . . Berechnung des Zeitsprungs fuer die Option "Linearkonstell.";
! "tsprung" ist ein Zeitintervall in Tagen, das nach dem Ablauf
! einer Konjunktion von Venus und Erde uebersprungen wird. Dieses
815 ! darf nicht zu gross sein, um alle Ereignisse zu erfassen. Das
! erste Ereignis im Intervall der Jahre -13000 bis 17000 geht ver-
! loren fuer tsy = 577 Tage (tsprung = 557 Tage, dwin = 5 Grad),
! d.h. "tsprung" waere zu gross. Darueber hinaus ergab sich je-
! weils als groesster zulaessiger Wert fuer tsy (Version Kepl.):
820 !
! dwin tsy tsprung dwin tsy tsprung
! [Grad] [Tage] [Tage] [Grad] [Tage] [Tage]
! ------------------------ ------------------------
! 5 576 557 20 577 510
825 ! 10 578 543 45 578 430 (not used)
! 15 578 527 90 575 286 (not used)
! ------------------------ ------------------------
!
! Die Gleichung fuer tsprung (siehe unten) ist sinnvoll, da alle
830 ! tsy-Werte etwa gleich gross sind, was auch fuer die Optionen
! "Kurzv." und "Kombi." gilt. Zur Sicherheit wurde tsy = 570 Tage
! festgelegt (synodische Umlaufzeit der Venus: 583.9 Tage).
if (ipla==3 .and.ison==5) step = 1.d0
dwi0 = dwi; tsy = 570.d0 ! (fuer Syzygien)
835 if (ilin==1) tsy = 115.7d0 ! (Merkur, optim.)
if (ilin==2) tsy = 582.7d0 ! (Venus, optim.)
if (ipla==3 .and.ikomb==i0) dwi = dwi + 1.d0
dwin = dwi
if (ilin<=2) tsprung = tsy
840 if (ilin>=3) tsprung = dnint(tsy*(1.d0-dwin/180.d0))
if (tsprung<1.d0) tsprung = 1.d0
if (ipla==4) go to 30
! . . Blickrichtung von der suedlichen ekliptikalen Hemisphaere
845 if (iek==2 .and.ipla<=2) then
diff1 = -diff1; diff2 = -diff2
do i=1,9; diff(i) = -diff(i); enddo
endif
if (ipla==3) go to 20
850 if (ipla==4) go to 30
!-----Pyramidenabstaende und Winkel
! Indizes von "pyr":
! 1 bis 5: leer
Datei: ~/home/p5/p5.f95 Seite 15 von 110
855 ! 6: leer 7: pdx 8: pdy 9: pdz 10: leer
! 11: pax 12: pbx 13: pcx 14: pay 15: pby
! 16: pcy 17: paz 18: pbz 19: pcz 20: leer
! 21: pa 22: pb 23: pc 24: pb/pa oder pbx/pax
! 25: pc/pa oder pby/pay 26: pc/pb oder pby/pbx 27: alpha
860 ! 28: beta 29: gamma 30: leer 31: alpha1 32: alpha2
! 33: alpha3 34: pax/2 35: pay/2 36: pbx/2 37: pby/2
! 38: (pax+pbx)/2 39: (pay+pby)/2 40: leer
! Indizes 11-19 und 21-29 bei "pyr" und "xyr" entsprechen sich.
!
865 ! . . Anpassung der Koordinaten fuer Grundflaeche, Schwerpunkt und
! Spitze der Pyramiden bzw. Ostwand, Mitte und Westwand der
! Kammern.
if (ihi==2) then
cm = 0.25d0; if (ipla==2) cm = 0.5d0
870 do i=1,3; rp(i,4) = rp(i,4) * cm; enddo
endif
if (ihi==2 .or.ihi==3) then
do i=1,3; rp(i,3) = rp(i,3) + rp(i,4); enddo
endif
875 ! . . Abstaende der Pyramiden bzw. Kammern und weitere Groessen.
pyr(11) = rp(2,1)-rp(3,1); pyr(12) = rp(1,1)-rp(3,1)
pyr(14) = rp(2,2)-rp(3,2); pyr(15) = rp(1,2)-rp(3,2)
pyr(17) = rp(2,3)-rp(3,3); pyr(18) = rp(1,3)-rp(3,3)
pyr(13) = pyr(12)-pyr(11); pyr(16) = pyr(15)-pyr(14)
880 pax = pyr(11); pay = pyr(14); paz = z0
pbx = pyr(12); pby = pyr(15); pbz = z0
pcx = pyr(13); pcy = pyr(16); pcz = z0
if (ison==3) then
pyr(31) = - datan(pyr(14)/pyr(11))
885 pyr(32) = - datan(pyr(15)/pyr(12))
pyr(33) = - datan(pyr(16)/pyr(13))
pyr(34) = pyr(11)*0.5d0
pyr(35) = pyr(14)*0.5d0
pyr(36) = pyr(12)*0.5d0
890 pyr(37) = pyr(15)*0.5d0
pyr(38) = (pyr(11)+pyr(12))*0.5d0
pyr(39) = (pyr(14)+pyr(15))*0.5d0
endif
! Koordinaten des gemeinsamen Zentrums "rcm" der drei Pyramiden
895 ! bzw. Kammern und mittlerer Abstand zu den Pyramiden bzw. Kammern
! "dmi" (zur Fehlerberechnung von "Sonnen-","Planeten- und Aphel-
! positionen" in Giza in den Subroutinen "sonpos", "aphelko" und
! "plako")
do i=1,3; rcm(i) = (rp(1,i) + rp(2,i) + rp(3,i))/3.d0; enddo
900 do i=1,3
acm(i) = dsqrt((rp(i,1)-rcm(1))**2 + (rp(i,2)-rcm(2))**2 &
+ (rp(i,3)-rcm(3))**2)
enddo
dmi = (acm(1) + acm(2) + acm(3))/3.d0
905 !c do i=1,8
!c write(6,'(5f12.6)') (pyr(5*(i-1)+j),j=1,5)
!c enddo
! . . Zusaetze zur 3-dim. Berechnung
if (ison>=4) then
910 pyr(19) = pyr(18) - pyr(17)
paz = pyr(17); pbz = pyr(18)
pcz = pyr(19)
!c write(6,'('' x: '',3f12.3)') (pyr(i),i=11,13)
!c write(6,'('' y: '',3f12.3)') (pyr(i),i=14,16)
915 !c write(6,'('' z: '',3f12.3)') (pyr(i),i=17,19)
Datei: ~/home/p5/p5.f95 Seite 16 von 110
! . . . Erzeugung eines Vektors pd, der auf pa und pb senkrecht steht.
pdx = pby * paz - pay * pbz
pdy = pax * pbz - pbx * paz
pdz = pbx * pay - pax * pby
920 aba = dsqrt(pax*pax + pay*pay + paz*paz)
abb = dsqrt(pbx*pbx + pby*pby + pbz*pbz)
abd = dsqrt(pdx*pdx + pdy*pdy + pdz*pdz)
dfakt = (abb + aba) * 0.5d0/abd
pyr(7) = pdx * dfakt
925 pyr(8) = pdy * dfakt
pyr(9) = pdz * dfakt
! . . . Modellwerte fuer FITEX
if (ison==5) then
z(1) = z0; z(2) = z0; z(3) = z0
930 z(4) = pax; z(5) = pay; z(6) = paz
z(7) = pbx; z(8) = pby; z(9) = pbz
endif
endif
! . . Laengen, Laengenverhaeltnisse, Winkel
935 if (ison<=2) then
pyr(24) = pbx/pax
pyr(25) = pby/pay
pyr(26) = pby/pbx; if (iek==2) pyr(26) = -pyr(26)
else
940 pyr(21) = dsqrt(pax*pax + pay*pay + paz*paz)
pyr(22) = dsqrt(pbx*pbx + pby*pby + pbz*pbz)
pyr(23) = dsqrt(pcx*pcx + pcy*pcy + pcz*pcz)
pyr(24) = pyr(22)/pyr(21)
pyr(25) = pyr(23)/pyr(21)
945 pyr(26) = pyr(23)/pyr(22)
pyr(27) = dacos((pax*pbx+pay*pby+paz*pbz)/(pyr(21)*pyr(22)))
pyr(28) = dacos((pax*pcx+pay*pcy+paz*pcz)/(pyr(21)*pyr(23)))
pyr(29) = dacos((pbx*pcx+pby*pcy+pbz*pcz)/(pyr(22)*pyr(23)))
endif
950
!-----Einlesen aller Parameter der VSOP87D-Kurzversion (Meeus)
20 if (imod==1) then
open(unit=10,file='invsop1.t')
read(10,*)
955 do n=1,12
read(10,*); read(10,*) lmax(n)
read(10,*) (jp(n,j),j=1,lmax(n))
do m=1,lmax(n)
read(10,*)
960 do j=1,jp(n,m)
read(10,*) idummy,(par1(i,j,m,n),i=1,3)
enddo
enddo
enddo
965 close(10)
endif
!-----Bahnparameter als Polynome 3. Grades aus VSOP82 (Meeus)
30 if (io==2 .or.irb/=1 .or.imod==3 .or.ipla>=3) then
970 open(unit=10,file='invsop3.t')
do ll=1,2
do n=1,3; read(10,*); enddo
do k=1,8
do n=1,2; read(10,*); enddo
975 do j=1,6; read(10,*) (par3(i,j,k,ll),i=1,4); enddo
enddo
Datei: ~/home/p5/p5.f95 Seite 17 von 110
enddo
close(10)
endif
980
!-----Titelzeilen (Giza-Pyramiden)
if (ipla<=3) then
do iu=ix,6,5
call titel1(iaph,ijd,iu,ison,ipla,ilin,isep,nurtr, &
985 iuniv,is12,iop0)
call titel2(iu,imod,ivers,irb,ipla, &
ison,ihi,iek,ijd,ika,iaph,ilin,ical,ak,zjde1,zjahr,delt, &
dwi,dwikomb,dwi0,dwi2,dwi3,iamax,step,ikomb,zmin,zmax)
! . . . . Tabellenkopf
990 call tabe(iaph,imod,iek,iu,io,ison,ipla,ilin,itran,is12, &
iop0,iout)
enddo
endif
if (iaph==5) go to 200
995 if (ipla==3) go to 300
if (ipla==4) go to 800
! Anmerkung: In jedem Programmlauf wird nur eine
! der vier folgenden Hauptschleifen verwendet.
1000
!=====================================================================
!------------------------- 1. Hauptschleife --------------------------
!=====================================================================
1005 !-----1. Hauptschleife (Pyramiden- und Kammerpositionen---------------
! sowie Aphel- und Perihelzeitpunkte des Merkur)
k = kmin
100 zk = dfloat(k)
if (imod==2 .and.ijd==15 .and.iaph<=2) zk = ak
1010 isw = 1; if (iaph<=2 .and.iout==3) isw = 2
jmax = i0
ncount = i0
!.....JDE-Zeitpunkt (Merkur im und ausserhalb des Aphels)
1015 120 zjde = zjde1
if (ijd==15 .or.iaph==3 .or.iaph==4) then
ik = k
if (isw==1 .or.(isw==2 .and.iaph<=2)) then
if (ijd==15 .and.(imod/=2 .or. &
1020 (imod==2 .and.(iaph==3 .or.iaph==4)))) ak = zk
if (ijd==15) then
call ephim(i0,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
else
call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
1025 endif
else
acount = dfloat(ncount)
if (ijd==15) then
ak = zk + step * (acount - zamax * 0.5d0)/ymer
1030 call ephim(i0,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
else
zjde = zjde1 + step * (acount - zamax * 0.5d0)
call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
endif
1035 endif
endif
if (ijd==i0) call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
Datei: ~/home/p5/p5.f95 Seite 18 von 110
ik = idnint(ak)
time = (zjde - zjd0)/tcen
1040 tau = (zjde - zjd0)/tmil
if (ison==5) then
do i=1,4; iw(i) = iw0(i); enddo
do i=1,3; w(i) = w0(i); enddo
do i=1,7; x(i) = x0(i); enddo
1045 do i=4,6; x(i) = x(i) * pidg; enddo
endif
inum(1) = inum(1) + 1
!.....Variante 1 (VSOP87D, Kurzversion aus "Meeus", multiple threads)
1050 if (imod==1) then
!$omp parallel do shared(tau,re) private(i,resu)
do i=1,9; call vsop1(i,tau,resu); re(i) = resu; enddo
!$omp end parallel do
endif
1055
!.....Variante 2 (VSOP87A/C, Vollversion)
140 if (imod==2) then
do i=1,3; ii = 3*(i-1)
call vsop2(zjde,ivers,i,md,ix,prec,lu,r,ierr,rku)
1060 do j=1,3; re(ii+j) = rku(j); enddo
enddo
endif
!.....Variante 3 (Kepl. Gleichung, Polynome 3. Grades nach VSOP82)
1065 if (io==2 .or.irb/=1 .or.imod==3) then
immax = 3; if (io==2) immax = 4
do i=1,immax; ii = 6*i
call vsop3(lv,i,ix,ir,time,res)
if (ir/=i0) go to 1000
1070 re(25+ii) = res(1); re(28+ii) = res(5)
re(26+ii) = res(2); re(29+ii) = res(4)
re(27+ii) = res(3); re(30+ii) = res(6)
if (imod==3 .and.i<=4) re(3*i-2) = res(11)
enddo
1075 endif
!.....Koordinaten-Transformation und Bestimmung von F-pos
if (irb>=2 .or.imod/=3) call kartko(ison)
if (irb>=2) call transfo(irb,rku)
1080 if (irb>=2 .or.imod/=3) &
call relpos(ipla,ison,ijd,iek,iekk,ika)
!.....Korrelation der Positionen pruefen, Output
ic = i0
1085 err3 = z0; err4 = z0
dif1 = re(1) - re(4); call reduz(dif1,i0,i0)
dif2 = re(1) - re(7); call reduz(dif2,i0,i0)
if (ison<=2) then
err1 = dif1 - diff1; call reduz(err1,i0,i0)
1090 err2 = dif2 - diff2; call reduz(err2,i0,i0)
if (iek==3) then
err3 = dif1 + diff1; call reduz(err3,i0,i0)
err4 = dif2 + diff2; call reduz(err4,i0,i0)
endif
1095 !.......Hauptbedingung pruefen (ison = 1, 2) . . . . . . . . . . . . .
if ((dabs(err1)<dwi.and.dabs(err2)<dwi).or.ijd/=15 &
.or.(iek==3 .and.dabs(err3)<dwi.and.dabs(err4)<dwi) &
.or.(ijd==15 .and.imod==2 .and.ikomb==i0)) then
Datei: ~/home/p5/p5.f95 Seite 19 von 110
if (ikomb==1 .and.imod==1) then
1100 imod = 2
dwi = dwikomb
go to 140
endif
if (iek==3) then
1105 iekk = 1
if (dabs(err3)<dwi.and.dabs(err4)<dwi) iekk = 2
endif
inum(2) = inum(2) + 1
ic = 1
1110 ! Resultat Output
call konst(ik,kon)
dd = dn
if (iek==2 .or.iekk==2) dd = ds
do iu=ix,6,5
1115 if (imod/=3) then
if (iek==3 .and.iekk==1) then
write(iu,56)kon,ik,zjde,zjahr,re(1), &
dif1,dif2,err1,err2,dd
elseif (iek==3 .and.iekk==2) then
1120 write(iu,56)kon,ik,zjde,zjahr,re(1), &
dif1,dif2,err3,err4,dd
else
write(iu,55)kon,ik,zjde,zjahr,re(1), &
dif1,dif2,err1,err2,xyr(36)
1125 endif
else
if (iek==3 .and.iekk==2) then
write(iu,56)kon,ik,zjde,zjahr,re(1), &
dif1,dif2,err3,err4,dd
1130 else
write(iu,56)kon,ik,zjde,zjahr,re(1), &
dif1,dif2,err1,err2,dd
endif
endif
1135 enddo
endif
else
if ((iaph==3 .or.iaph==4).and.isw==1 .and.ijd==15) then
ifl = i0
1140 if (xyr(36)<dwi2) ifl = 1
endif
!.......Hauptbedingung pruefen (ison = 3, 4, 5). . . . . . . . . . . .
if (((isw==1 .or.(isw==2 .and.iaph<=2)).and. &
(xyr(36)<dwi.or.ijd/=15 .or. &
1145 (imod==2 .and.ikomb==i0.and.iaph<=2))).or. &
(isw==2 .and.((ifl==1 .and.xyr(36)<dwi3.and. &
ijd==15).or.ijd/=15))) then
if (ikomb==1 .and.imod==1) then
imod = 2
1150 dwi = dwikomb
go to 140
endif
inum(2) = inum(2) + 1
! Sonnenposition
1155 call sonpos(ison,iek,ix,rp(3,1),rp(3,2),rp(3,3),rcm,dmi, &
iter,iw,ke,mfit,nfit,f,x,e,w,y,z)
ic = 1; dd = dn
if (iek==2) dd = ds
do isun=1,4; ort(i0,isun) = xyr(30+isun); enddo
Datei: ~/home/p5/p5.f95 Seite 20 von 110
1160 ! Resultat Output
if (isw==1) then
call konst(ik,kon)
do iu=ix,6,5
if (ison==5) then
1165 if (ipla==2) then
write(iu,184)kon,ik,zjahr,dif1,dif2,ke,iw(3), &
(xyr(30+i),i=1,4),dd,xyr(36)
else
write(iu,165)kon,ik,zjahr,dif1,dif2,ke,iw(3), &
1170 (xyr(30+i),i=1,4),dd,xyr(36)
endif
elseif (ison==3) then
write(iu,67)kon,ik,zjahr,re(1),dif1,dif2, &
xyr(31),xyr(32),emp,xyr(34),dd,xyr(36)
1175 else
if (ipla==2) then
write(iu,85)kon,ik,zjahr,re(1),dif1,dif2, &
(xyr(30+i),i=1,4),dd,xyr(36)
else
1180 write(iu,65)kon,ik,zjahr,re(1),dif1,dif2, &
(xyr(30+i),i=1,4),dd,xyr(36)
endif
endif
enddo
1185 else
if (((xyr(36)<dwi2.or.iaph<=2).and.ijd==15).or. &
ijd/=15 .or.imod==2) then
if (iout==3) then
call konst(ik,kon); delh = delt * 24.d0
1190 call reduz(x(5),1,i0)
if (ipla==1) then
xma = xyr(35)*1.d-7;dxy=dsqrt(xyr(31)**2+xyr(32)**2)
sonne = datan((xyr(33)-rp(3,3))/dxy)*gdpi
else
1195 xma = xyr(35)*1.d-9; dxr = xyr(31)-rp(3,1)
dyr = xyr(32)-rp(3,2); dzr = xyr(33)-rp(3,3)
sonne = datan(dyr/dsqrt(dxr*dxr + dzr*dzr))*gdpi
if (dxr>0.d0) sonne = 180.d0 - sonne
call reduz(sonne,i0,i0)
1200 endif
do iu=ix,6,5
if (iaph==3 .or.iaph==4) then
if (ipla==2) then
write(iu,275)zjde,delh,x(5)*gdpi,xma, &
1205 sonne,(xyr(30+i),i=1,4),dd,xyr(36)
else
write(iu,255)zjde,delh,x(5)*gdpi,xma, &
sonne,(xyr(30+i),i=1,4),dd,xyr(36)
endif
1210 elseif (iaph<=2) then
if (ipla==2) then
write(iu,276)kon,ik,zjahr,x(5)*gdpi,xma, &
sonne,(xyr(30+i),i=1,4),dd,xyr(36)
else
1215 write(iu,256)kon,ik,zjahr,x(5)*gdpi,xma, &
sonne,(xyr(30+i),i=1,4),dd,xyr(36)
endif
endif
enddo
1220 else
Datei: ~/home/p5/p5.f95 Seite 21 von 110
! Pruefung zur Signifikanz --> dk
dk = ' '
zf = dabs((xyr(35)-zthe(ipla))/zthe(ipla))
if (zf<=2.d-2 .and.xyr(36)> 0.5d0) dk = 'M '
1225 if (zf> 2.d-2 .and.xyr(36)<=0.5d0) dk = 'F '
if (zf<=2.d-2 .and.xyr(36)<=0.5d0) dk = 'FM '
if (zf<=1.d-3 .and.xyr(36)<=0.1d0) dk = '>>>'
do iu=ix,6,5
if (ison==5) then
1230 if (ipla==2) then
write(iu,386)dk,ik,zjde,xyr(35),ke,iw(3), &
(xyr(30+i),i=1,4),dd,xyr(36)
else
write(iu,366)dk,ik,zjde,xyr(35),ke,iw(3), &
1235 (xyr(30+i),i=1,4),dd,xyr(36)
endif
elseif (ison==3) then
write(iu,367)dk,ik,zjde,xyr(35),ncount-iamax/2, &
xyr(31),xyr(32),emp,xyr(34),dd,xyr(36)
1240 else
if (ipla==2) then
write(iu,384)dk,ik,zjde,xyr(35),ncount-iamax/2,&
(xyr(30+i),i=1,4),dd,xyr(36)
else
1245 write(iu,365)dk,ik,zjde,xyr(35),ncount-iamax/2,&
(xyr(30+i),i=1,4),dd,xyr(36)
endif
endif
enddo
1250 endif
endif
endif
!h call histogramm(xyr(36),ihis) !h
endif
1255 endif
!.....Weiterer Output
do iu=ix,6,5
if (ic==1 .and.imod/=3 .and.io==2 .and.is12==0) then
1260 call linie(iu,2)
write(iu,57) (re(i),i=1,9)
do i=1,3
t1(i) = ' '; if (xyr(3+i)<z0) t1(i) = '-'
enddo
1265 write(iu,54) (xyr(i),i=1,3),t1(1),dabs(xyr(4)), &
t1(2),dabs(xyr(5)),t1(3),dabs(xyr(6)),(xyr(i),i=7,9)
write(iu,'(1x,6f9.6,f22.8,'' %'')') xyr(11),xyr(12), &
xyr(14),xyr(15),xyr(17),xyr(18),xyr(36)
call linie(iu,2)
1270 endif
if (is12/=0) call linie(iu,1)
if (is12==0 .and.ic==1.and.imod==3.and.io==2) call linie(iu,2)
if (ic==1 .and.io==2 .and.is12==0) then
if (imod/=3) then
1275 if (ivers==3) then
write(iu,'('' ascending node (M/V/E/Ma): '',2f12.6, &
& '' --- '',f12.6)')re(34),re(40),re(52)
else
write(iu,'('' ascending node (M/V/E/Ma): '',4f12.6)') &
1280 (re(28+6*i),i=1,4)
endif
Datei: ~/home/p5/p5.f95 Seite 22 von 110
write(iu,'('' inclination i (M/V/E/Ma): '',4f12.6)') &
(re(29+6*i),i=1,4)
write(iu,'('' perihelion pi (M/V/E/Ma): '',4f12.6)') &
1285 (re(30+6*i),i=1,4)
if (imod/=3 .and.irb/=1) &
write(iu,'('' ang. par. (omega, i, tau): '',3f12.6)') &
ao*gdpi,ai*gdpi,at*gdpi
if (ison==5) then
1290 write(iu,'('' transl. X1, X2, X3; del-t: '',3f12.6, &
& f9.3,'' days'')') (x(i),i=1,3),delt
do i=4,6; call reduz(x(i),1,i0); enddo
write(iu,'('' Euler angl. X4, X5, X6; M: '',3f12.6, &
& f13.0)') (x(i)*gdpi,i=4,6),xyr(35)
1295 !c write(6,'('' X7: '', f12.6)') x(7)
endif
else
do i=5,8; ii = 6*i
call vsop3(lv,i,ix,ir,time,res); if (ir/=i0) go to 1000
1300 re(25+ii) = res(1); re(28+ii) = res(5)
re(26+ii) = res(2); re(29+ii) = res(4)
re(27+ii) = res(3); re(30+ii) = res(6)
enddo
call elements(iu,ivers,pla)
1305 endif
if ((ison==3 .and.ijd>=1 .and.ijd<=10).or.ison==4) write( &
& iu,'('' scale factor M : '',f13.0)')xyr(35)
call linie(iu,1)
endif
1310 enddo
!.....Output: Koordinaten aller Planeten einschliesslich Neptun und
! des Schwerpunktsystems Erde-Mond, letzteres nur fuer VSOP87A,
! sowie transformierte "planetarische" Koordinaten in Giza
1315 if ((imo4==1 .and.iaph<=2 .and.is12==0 .and.io==2) &
.or.is12/=0) then
call plako(diff,ipla,ijd,ik,ison,ipos, &
rcm,x,y,ort,rp,dd,dn,dss,pla,plan,emp,text,tt,titab, &
is12,dmi,zjda,zjde,ivers,md,ix,prec,lu,r,ierr,rku)
1320 endif
! . . Ruecksprung fuer Aphel-Umgebung
if (ikomb==1 .and.imod==2) then
imod = 1; dwi = dwi0
1325 endif
if (iaph==3 .or.iaph==4) then
ncount = ncount + 1
if (ncount>jmax) then
ncount = i0
1330 if (isw==1) then
if (ijd==15 .and.ifl==i0) go to 190
isw = 2; jmax = iamax; go to 120
endif
else
1335 go to 120
endif
endif
! . . Standardruecksprung
1340 190 k = k + 1
if (k<=kmax) go to 100
Datei: ~/home/p5/p5.f95 Seite 23 von 110
!.....Aphelposition der Merkurbahn fuer Konstellation 13 bzw. 14
! (Pyramidenpos./Aphel) sowie "quick start option" 322 und 323
1345 if (ipla==1) call aphelko(imod,ivers,iaph,ipla, &
ison,ijd,io,iop0,ix,rp(3,4),x,y,rcm,dmi)
!-----Ende der 1. Hauptschleife (Pyramiden- und Kammerpositionen)-----
go to 900
1350
!=====================================================================
!------------------------- 2. Hauptschleife --------------------------
!=====================================================================
1355 !-----2. Hauptschleife (freier Zeitpunkt und Minimierung von Fpos-----
! fuer Pyramiden- und Kammeranordnung, Tabelle 51 in "Pyramiden
! und Planeten" und Tabelle 20 (?) im zweiten Buch)
200 zjde = zjdemin
dfe = 0.3d0; eep = e(1); irestart = i0; x36 = z0
1360 ! VORSICHT: "zfact" und "zstep" nicht zu gross waehlen. Sonst ge-
! hen beim Ruecksprung (s.u.) Konstellationen verloren. Standard-
! werte fuer Pyramiden: 0.5/ 1.0 und fuer die Kammern: 0.1/ 0.2
if (ipla==1) then
zfact = 0.5d0; zstep = 1.d0
1365 else
! (optimiert fuer alle Kammerzuordnungen)
zfact = 0.1d0; zstep = 0.2d0
endif
1370 !.....Startparameter fuer "fitmin"
220 ifitrun = i0; itin = i0
imodus = 1; iflag = i0
ke = 1; indx = 1; nu = i0
ddx1 = 1.d0; ddx2 = 1.d0
1375 do i=1,10; test(i) = z0; enddo
do i=1,5; xx(i) = z0; yy(i) = z0; enddo
xx(1) = zjde; go to 250
240 call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
250 tau = (zjde - zjd0)/tmil
1380 if (ison==5) then
do i=1,4; iw(i) = iw0(i); enddo
do i=1,3; w(i) = w0(i); enddo
do i=1,7; x(i) = x0(i); enddo
do i=4,6; x(i) = x(i) * pidg; enddo
1385 endif
inum(1) = inum(1) + 1
!.....Variante 1 (VSOP87D, Kurzversion aus "Meeus", multiple threads)
if (imod==1) then
1390 !$omp parallel do shared(tau,re) private(i,resu)
do i=1,9; call vsop1(i,tau,resu); re(i) = resu; enddo
!$omp end parallel do
endif
1395 !.....Variante 2 (VSOP87A/C, Vollversion)
if (imod==2) then
do i=1,3
ii = 3*(i-1)
call vsop2(zjde,ivers,i,md,ix,prec,lu,r,ierr,rku)
1400 do j=1,3; re(ii+j) = rku(j); enddo
enddo
endif
Datei: ~/home/p5/p5.f95 Seite 24 von 110
!.....Koordinaten-Transformation und Bestimmung von F-pos
1405 call kartko(ison)
call relpos(ipla,ison,ijd,iek,iekk,ika)
if (ison==5) yy(indx) = xyr(36)
! . . zjde so lange erhoehen, bis relativer Fehler nicht mehr steigt.
1410 !c write(6,'('' zjde,irestart,xyr(36),dwi,imod = '',f18.7,i3, &
!c & 2f9.3,i3)') zjde,irestart,xyr(36),dwi,imod
if (xyr(36)>10.d0) imod = 1
if (irestart==1) then
if (xyr(36)>x36) then
1415 go to 290
else
zjdelim = zjde
endif
endif
1420 irestart = i0
! . . Bedingung zum Aufruf von fitmin pruefen
if (xyr(36)>dwi.and.ifitrun==i0) go to 290
if (ikomb==1) imod = 2
1425
! . . Minimierung des relativen Fehlers F-pos mit "fitmin"
ifitrun = 1; imodus = 1
if (ddx1<dfe.or.ddx2<dfe) imodus = 2
call fitmin(imod,imodus,iaph,ke,xx,yy,eep,step,nu,iflag, &
1430 ddx1,ddx2,test,itin,indx,ix)
zjde = xx(indx)
if (ke==1) go to 240
irestart = 1
1435 ! . . verhindert, dass fitmin endlos ins vorherige Minimum faellt
if (dabs(zjde-zjdevor)<=0.1d0) then
zjde = zjdelim; go to 290
endif
zjdevor = zjde
1440
!.....Hauptbedingung pruefen (ison = 5). . . . . . . . . . . . . . . .
if (xyr(36)>=dwikomb) go to 290
inum(2) = inum(2) + 1
1445 ! . . Sonnenposition und Output
call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
call konst(iak,kon)
call sonpos(ison,iek,ix,rp(3,1),rp(3,2),rp(3,3), &
rcm,dmi,iter,iw,ke,mfit,nfit,f,x,e,w,y,z)
1450 dd = dn; if (iek==2 .or.iekk==2) dd = ds
xma = xyr(35) * 1.d-9
if (ipla==1) xma = xyr(35) * 1.d-7
call reduz(x(5),1,i0)
do iu=ix,6,5
1455 if (iout==3) then
if (ipla==1) then
write(iu,405)kon,iak,zjahr,delt,x(5)*gdpi,xma, &
(xyr(30+i),i=1,3),dd,xyr(36)
else
1460 write(iu,406)kon,iak,zjahr,delt,x(5)*gdpi,xma, &
(xyr(30+i),i=1,3),dd,xyr(36)
endif
else
if (ipla==1) then
Datei: ~/home/p5/p5.f95 Seite 25 von 110
1465 write(iu,407)kon,iak,zjde,zjahr,ke,iw(3), &
(xyr(30+i),i=1,4),dd,xyr(36)
else
write(iu,408)kon,iak,zjde,zjahr,ke,iw(3), &
(xyr(30+i),i=1,4),dd,xyr(36)
1470 endif
endif
enddo
!h call histogramm(xyr(36),ihis) !h
1475 ! . . Standardruecksprung
290 zjump = xyr(36)*zfact + zstep
zjde = zjde + zjump
x36 = xyr(36)
if (zjde<=zjdemax) go to 220
1480
!-----Ende der 2. Hauptschleife (freier Zeitpunkt)--------------------
go to 900
!=====================================================================
1485 !------------------------- 3. Hauptschleife --------------------------
!=====================================================================
!-----3. Hauptschleife (Suche von Linearkonstellationen)--------------
! Syzygium von Sonne, Merkur, Venus, Erde und Mars,
1490 ! sowie Bestimmung der Transite von Merkur und Venus.
! "zfact" und "zstep" wie in 2. Hauptschleife (nicht zu gross)
300 zfact = 0.025d0 * (1.d0 + (21.d0-dwi)/20.d0)
if (dwi>=21.d0) zfact = 0.025d0
1495 zstep = 0.01d0
sz = (1.d0 + 10.d0*zfact)
iabsatz = 3; if (iop0==21) iabsatz = 2 ! --> Leerzeile
zjde = zjdemin; dfd = 5.d0; dfe = 0.5d0
izp = 1; icv = 0
1500 310 zjdestep = zjde
if (ilin==2 .and.inum(0)>1 .and.iop0/=-804) dfd = 0.02d0
call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
ik = idnint(ak)
inum(0) = inum(0) + 1
1505 if (ilin>=3) itransit = i0
do i=1,2; tra(i) = ' '; enddo
if (ison==5) ifitrun = i0
if (ilin<=2) ifitrun = 1
!.....Startparameter fuer "fitmin", "sekante" und "ringfit"
1510 320 if (ison==5) then
iflag = i0; ke = 1; indx = 1; nu = i0
ddx1 = dfd; ddx2 = ddx1; itin = i0
do i=1,10; test(i) = z0; enddo
do i=1,5
1515 xx(i) = z0; yy(i) = z0
enddo
xx(1) = zjde
endif
go to 340
1520 330 zjde = xx(indx)
call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
340 time = (zjde - zjd0)/tcen
tau = (zjde - zjd0)/tmil
inum(1) = inum(1) + 1
1525
Datei: ~/home/p5/p5.f95 Seite 26 von 110
!.....Variante 1 (VSOP87D, Kurzversion aus "Meeus", multiple threads)
if (imod==1) then
!$omp parallel do shared(tau,re) private(i,resu)
do i=1,12; call vsop1(i,tau,resu); re(i) = resu; enddo
1530 !$omp end parallel do
if (ilin<=2) then
call kartko(ison)
do i=1,9; rk(i) = xyr(i); enddo
endif
1535 endif
!.....Variante 2 (VSOP87A/C, Vollversion)
350 if (imod==2) then
do i=il(1),il(2),il(3); ii = 3*(i-1)
1540 call vsop2(zjde,ivers,i,md,ix,prec,lu,r,ierr,rku)
do j=1,3
re(ii+j) = rku(j)
if (ilin<=2) rk(ii+j) = r(j)
enddo
1545 enddo
endif
!.....Variante 3 (Keplersche Gleichung, Polyn. 3. Grades nach VSOP82)
if (imod==3) then
1550 do i=1,4
ii = 6*i
call vsop3(lv,i,ix,ir,time,res)
if (ir/=i0) go to 1000
re(25+ii) = res(1); re(28+ii) = res(5)
1555 re(26+ii) = res(2); re(29+ii) = res(4)
re(27+ii) = res(3); re(30+ii) = res(6)
if (i<=4) re(3*i-2) = res(11)
enddo
endif
1560
!.....Korrelation der Positionen pruefen
ic = i0
iwo = i0
df(1) = re(1)-re(4); df(2) = re(1)-re(7)
1565 df(3) = re(1)-re(10); df(4) = re(4)-re(7)
df(5) = re(4)-re(10); df(6) = re(7)-re(10)
do i=1,6; call reduz(df(i),i0,i0); enddo
if (ilin==3) difm = dmax1(dabs(df(1)),dabs(df(2)),dabs(df(4)))
if (ilin==4) difm = dmax1(dabs(df(1)),dabs(df(2)),dabs(df(3)), &
1570 dabs(df(4)),dabs(df(5)),dabs(df(6)))
if (isep==1) then
if (itransit==1) difm = df(2)
if (itransit==2) difm = df(4)
else
1575 if (itransit==1 .or.itransit==2) then
call sepa(itransit,2,rk,sep1)
difm = dabs(sep1)
endif
endif
1580 if (ison==5) yy(indx) = difm
! . . Test-Ausdruck (--> !t)
!t difr = re(7)-re(1)
!t call reduz(difr,i0,i0)
!t do iu=ix,6,5;write(iu,'(''imod,ifit,dt,Le-Lm,jde,difm = '',2i2,&
1585 !t &f5.1,f6.1,f18.7,f13.7)')imod,ifitrun,step,difr,zjde,difm;enddo
Datei: ~/home/p5/p5.f95 Seite 27 von 110
!.....Hauptbedingung pruefen . . . . . . . . . . . . . . . . . . . . .
if (difm>=dwi.and.ifitrun/=1) go to 370
! . . Ruecksprung fuer ikomb = 1
1590 if (ikomb==1 .and.imod==1 .and.ilin>=3) then
ifitrun = 1; imod = 2; dwi = dwikomb
go to 350
endif
1595 ! . . Minimierung des Gesamtwinkels difm mit "fitmin" fuer ison = 5
! (Das heisst, "ison" hat hier eine andere Funktion und bedeutet
! Minimumsuche.)
if (ison==5) then
ifitrun = 1; step = 1.d0
1600 if (ilin>=3 .and.itransit==i0) then
call fitmin(imod,1,iaph,ke,xx,yy,e(1),step,nu, &
iflag,ddx1,ddx2,test,itin,indx,ix); zjde = xx(indx)
endif
if (itransit==1 .or.itransit==2) then
1605 if (isep==1) then
xj2 = xx(indx); yy2 = yy(indx); indx = 2
call ringfit(xj1,xj2,xj3,yy1,yy2,yy3, &
1.d-6,1.d-2,nu,50,ix,ke)
xx(2) = xj2; zjde = xj2
1610 else
eep = e(1)
if (ikomb==1 .and.imod==1 .and.isep>=3) eep=1.d2*e(1)
imodus = 1
if (ddx1<dfe.or.ddx2<dfe) imodus = 2
1615 call fitmin(imod,imodus,iaph,ke,xx,yy,eep,dfd,nu, &
iflag,ddx1,ddx2,test,itin,indx,ix)
zjde = xx(indx)
endif
endif
1620 if (ke==1 .or.(isep==1 .and.ke==5)) go to 330
endif
! . . Spezialtest fuer ikomb = 0 (imod = 1, 3)
! Anmerkung: Aufgrund der Zeitschritte (1 Tag) ist es moeglich,
1625 ! dass das Minimum des Winkelintervalls (difm) fuer die eklipti-
! kalen Laengen der Planeten genau zwischen zwei Zeitpunkten er-
! reicht wird. Falls die Schwelle (dwi0) so knapp unterschritten
! wird, dass sie an den Zeitpunkten davor und danach schon wieder
! ueberschritten wird, wuerde das Ereignis verloren gehen. Des-
1630 ! halb wird die Schwelle (dwi) zuvor um 1 Grad erhoeht, dann das
! Winkelintervall minimiert und anschliessend geprueft, ob die
! urspruengliche Schwelle (dwi0) unterschritten wurde.
if (ikomb==i0.and.ilin>=3) then
if (difm<dwi0) go to 360
1635 go to 370
endif
! . . Gegebenenfalls Sprung von der oberen zur unteren Konjunktion.
! Bei Minimierung der Winkelseparation (isep 2,3,4) wuerden ab
! einem gewissen Zeitpunkt nur noch obere Konjunktionen berech-
1640 ! net werden. Das wird durch die folgende if-Abfrage behoben.
360 if (isep>=2 .and.((itransit==1 .and.dabs(df(2))>170.d0) &
.or.(itransit==2 .and.dabs(df(4))>170.d0))) then
zjde = zjde + tsy*0.5d0
go to 320
1645 endif
if (ikomb/=1 .or.(ikomb==1 .and.(difm<dwikomb.or. &
ilin<=2))) then
Datei: ~/home/p5/p5.f95 Seite 28 von 110
if (itransit==i0.and.nurtr==1) inum(2) = inum(2) + 1
ic = 1
1650 if (ic==1 .and.icv==0 .and.ison/=5 .and.ilin>=3) then
inum(3) = inum(3) + 1
do iu=ix,6,5
write(iu,'(i12,''. syzygy'')') inum(3)
enddo
1655 endif
call konst(ik,kon)
! . . . Pruefen des Transits (nur bei imod = 1, 2)
if (itran==1 .and.ison==5) then
if (itransit==i0.or.ilin<=2) call memo(zjde,zjahr, &
1660 delt,df(1),df(2),df(3),difm,zmem,iak,imem)
if (itransit==1 .or.itransit==2) then
call transit(itransit,ikomb,imod,ipla,ilin,iaph,ivers, &
isep,ical,iuniv,tr,sep1,itt,sep,zjde,id5,da5,dmo5, &
zjahr,rk,md,ddx1,ddx2,dfd,test,itin,is,irs,ix,pan,sd,sl,&
1665 iop0,inum)
tra(itransit) = tr
endif
! . . . . Ereignis evtl. mit Transit, Output (ohne Transit bei imod=3)
if ((ilin>=3 .and.itransit==2).or. &
1670 (ilin<=2 .and.tr/=' ').or.imod==3) then
if (ikomb==1 .and.imod==1 .and.ilin<=2) then
imod = 2; go to 320
endif
if (nurtr==1 .or.(nurtr==2 .and. &
1675 (tra(1)/=' '.or.tra(2)/=' '))) then
if (ilin<=2 .or.nurtr==2) inum(2) = inum(2) + 1
iwo = 1
if (ilin>=3) then
do iu=ix,6,5
1680 if (dabs(zmem(5))<1.d-4) then
zmem(5) = dabs(zmem(5))
write(iu,456)kon,' ',tra(1),tra(2),imem, &
(zmem(i),i=1,7)
elseif (dabs(zmem(6))<1.d-4) then
1685 zmem(6) = dabs(zmem(6))
write(iu,457)kon,' ',tra(1),tra(2),imem, &
(zmem(i),i=1,7)
else
write(iu,455)kon,' ',tra(1),tra(2),imem, &
1690 (zmem(i),i=1,7)
endif
enddo
else
if (iop0==-804 .and.(zjahr<=-13000.d0 .or. &
1695 zjahr>=17000.d0)) go to 390; ts = ' '
if (tra(ilin)/='M'.and.tra(ilin)/='V') ts=tra(ilin)
if (iuniv==2) call delta_T(zjde)
call jdedate(zjde,ical,ida,da,dmo)
if (ida(3)>=izmin) then
1700 do iu=ix,6,5
if (isep==4 .and.((ilin==2 .and.lid5/=-50000 .and.&
id5(3,3)-lid5>50).or.(ilin==1 .and.mod(inum(2) +&
iabsatz,4)==0))) write(iu,*) ! --> Leerzeile
if (izp<=3) call zwizeile(iu,io,zmem(1), &
1705 ilin,imod,isep,ical,izp)
if ((isep<=3 .and. zmem(1)<=-1566122.5d0).or. &
(isep==4 .and.(zmem(1)<=-1931365.0d0 .or. &
zmem(1)>= 5373485.0d0))) then
Datei: ~/home/p5/p5.f95 Seite 29 von 110
if (isep<=2) then
1710 write(iu,458)kon,ts,imem,da(7),dmo,ida(3), &
(ida(i),dp,i=4,5),ida(6),(zmem(i),i=3,6),sep,irs
else
if (isep==3) then
if (itt==3) &
1715 write(iu,459)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),l=1,5),sep,sl,irs
if (itt==2) &
write(iu,461)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),str2,l=1,3,2), &
1720 (id5(5,i),dp,i=4,5),id5(5,6),sep,sl,irs
if (itt==1) &
write(iu,471)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
str2,str2,(id5(3,i),dp,i=4,5),id5(3,6), &
str2,str2,sep,sl,irs
1725 else
if (itt==3) &
write(iu,659)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),l=1,5),sep,sl, &
(pan(i),i=1,5),sd(1),sd(2),irs
1730 if (itt==2) &
write(iu,661)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),str2,l=1,3,2), &
(id5(5,i),dp,i=4,5),id5(5,6),sep,sl,pan(1), &
str3,pan(3),str3,pan(5),sd(1),sd(2),irs
1735 if (itt==1) &
write(iu,671)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
str2,str2,(id5(3,i),dp,i=4,5),id5(3,6), &
str2,str2,sep,sl,str3,str3,pan(3), &
str3,str3,sd(1),sd(2),irs
1740 endif
if (itt==i0.and.iu==6) inum(2) = inum(2) - 1
endif
else
if (isep<=2) then
1745 write(iu,558)kon,ts,imem,da(7),dmo,ida(3), &
(ida(i),dp,i=4,5),ida(6),(zmem(i),i=3,6),sep,irs
else
if (isep==3) then
if (itt==3) &
1750 write(iu,559)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),l=1,5),sep,sl,irs
if (itt==2) &
write(iu,561)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),str2,l=1,3,2), &
1755 (id5(5,i),dp,i=4,5),id5(5,6),sep,sl,irs
if (itt==1) &
write(iu,571)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
str2,str2,(id5(3,i),dp,i=4,5),id5(3,6), &
str2,str2,sep,sl,irs
1760 else
if (itt==3) &
write(iu,759)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),l=1,5),sep,sl, &
(pan(i),i=1,5),sd(1),sd(2),irs
1765 if (itt==2) &
write(iu,761)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
((id5(l,i),dp,i=4,5),id5(l,6),str2,l=1,3,2), &
(id5(5,i),dp,i=4,5),id5(5,6),sep,sl,pan(1), &
str3,pan(3),str3,pan(5),sd(1),sd(2),irs
Datei: ~/home/p5/p5.f95 Seite 30 von 110
1770 if (itt==1) &
write(iu,771)kon,ts,da5(3,7),dmo5(3),id5(3,3),&
str2,str2,(id5(3,i),dp,i=4,5),id5(3,6), &
str2,str2,sep,sl,str3,str3,pan(3), &
str3,str3,sd(1),sd(2),irs
1775 endif
if (itt==i0.and.iu==6) inum(2) = inum(2) - 1
endif
endif
if (isep<=2 .and.iu==6) then
1780 if (ts=='m'.or.ts=='v') inum(3) = inum(3) + 1
if (ts=='C'.or.ts=='c') inum(4) = inum(4) + 1
endif
enddo
else
1785 ic = i0; iwo = i0; inum(2) = inum(2) - 1
endif
lid5 = id5(3,3) ! --> Leerzeile
endif
endif
1790 endif
if (itransit==i0.or.ilin<=2) zjde0 = zjde
!t read(*,*) !t
! . . . Ereignis ohne Transit-Pruefung (z.B. imod = 3), Output
else
1795 do iu=ix,6,5
if (dabs(df(2))<1.d-4) then
write(iu,456)kon,' ',tra(1),tra(2),ik, &
zjde,zjahr,delt,(df(i),i=1,3),difm
elseif (dabs(df(3))<1.d-4) then
1800 write(iu,457)kon,' ',tra(1),tra(2),ik, &
zjde,zjahr,delt,(df(i),i=1,3),difm
else
write(iu,455)kon,' ',tra(1),tra(2),ik, &
zjde,zjahr,delt,(df(i),i=1,3),difm
1805 endif
enddo
call memo(zjde,zjahr,delt,df(1),df(2),df(3),difm,zmem, &
iak,imem)
endif
1810 endif
! . . Ruecksprung fuer Transit-Pruefung
370 if (itran==1 .and.ison==5 .and.ilin>=3) then
if (itransit/=i0) zjde = zjde0
if (ison==5 .and.ic==1 .and.ilin>=3 .and.imod/=3) &
1815 itransit = itransit + 1
if (itransit==1 .or.itransit==2) go to 320
endif
! . . Bedingung fuer Zeitsprung zur Verkuerzung der Rechenzeit
1820 if (ilin>=3 .and.dwin<=21.d0) then
iflag2 = iflag1; iflag1=i0
if (dabs(df(4))<=dwin) iflag1=1
endif; ifitrun = i0
1825 ! . . Weiterer Output
do iu=ix,6,5
if (((ilin<=2 .and.(tra(1)/=' '.or.tra(2)/=' ').and. &
((isep<=2 .or.(isep>=3 .and.itt/=0)).and. &
ida(3)>=izmin)).or.(ic==1 .and.ilin>=3)).and. &
1830 io==2 .and.iwo==1) then
Datei: ~/home/p5/p5.f95 Seite 31 von 110
if (imod/=3) then
call linie(iu,2+ipar); write(iu,57) (zmem(i),i=11,19)
write(iu,57) (zmem(i),i=20,22); call linie(iu,2)
endif
1835 if (ic==1 .and.imod==3 .and.io==2) call linie(iu,2)
immin = 1; if (imod==3) immin = 5
immax = 4; if (ilin>=3) immax = 8
if (immin<=immax) then
do i=immin,immax; ii = 6*i
1840 call vsop3(lv,i,ix,ir,time,res); if (ir/=i0) go to 1000
zmem(25+ii) = res(1); zmem(28+ii) = res(5)
zmem(26+ii) = res(2); zmem(29+ii) = res(4)
zmem(27+ii) = res(3); zmem(30+ii) = res(6)
enddo
1845 endif
if (ilin<=2) then
if (ivers==3) then
write(iu,'('' ascending node (M/V/E/Ma): '',2f12.6, &
& '' --- '',f12.6)')zmem(34),zmem(40),zmem(52)
1850 else
write(iu,'('' ascending node (M/V/E/Ma): '',4f12.6)') &
(zmem(28+6*i),i=1,4)
endif
write(iu,'('' inclination i (M/V/E/Ma): '',4f12.6)') &
1855 (zmem(29+6*i),i=1,4)
write(iu,'('' perihelion pi (M/V/E/Ma): '',4f12.6)') &
(zmem(30+6*i),i=1,4)
else
do i=31,78; re(i) = zmem(i); enddo
1860 call elements(iu,ivers,pla)
endif
call linie(iu,1+ipar)
endif
enddo
1865 390 if (ikomb==1 .and.imod==2) then; imod = 1; dwi = dwi0; endif
! . . Bedingter groesserer Zeitsprung
if (ilin<=2 .or.(dwin<=21.d0 .and.((iflag2==1 .and.iflag1==i0) &
.or.(ison==5 .and.ifitrun==i0.and.(ke==i0.or.ke==3))))) then
1870 zjde = zjde + tsprung; iflag1 = i0
else
zjde = zjdestep
if (ison==5 .or.(ison/=5 .and.dabs(difm)>dwin*sz)) then
stepl = difm*zfact + zstep; if (ic==1) stepl = 0.9d0*ymer
1875 zjde = zjde + stepl
else
zjde = zjde + step
endif
endif
1880 icv = ic
if (zjde<=zjdemax) go to 310
! . . Ergaenzung (Tabellenkopf fuer Transit-Test mit inum(2)=0)
if (ilin<=2 .and.inum(2)==0) then
do iu=ix,6,5
1885 call zwizeile(iu,io,zmem(1),ilin,imod,isep,ical,izp)
enddo
endif
!-----Ende der 3. Hauptschleife (Linearkonstellation, Transit)--------
1890 go to 900
Datei: ~/home/p5/p5.f95 Seite 32 von 110
!=====================================================================
!------------------------- 4. Hauptschleife --------------------------
!=====================================================================
1895
!-----4. Hauptschleife (Teotihuacan)----------------------------------
! Wallabstaende auf der "Strasse der Toten", in Google Maps
! linear gemessen bzw. ueber die geographischen Koordinaten
! (GPS) berechnet und Vergleich mit den Logarithmen der Pla-
1900 ! netenabstaende. "Teot" enthaelt alle Ortsdaten und "comp"
! nur die Daten fuer die lineare Regression.
!
! Array "teot(0..17,i)" (Index 0..17: Reihenfolge in "inteoti.t")
! i=1: geogr. Breite (Wallposition)
1905 ! i=2: geogr. Laenge ( " )
! i=3: Wallabstaende [m] (vorab eingegeben oder berechnet)
! i=4: Wallabstaende von Karte oder Bildschirm in Millimetern
!
! Array "comp(0..9,i)" (von "compare")
1910 ! i=1: ausgewaehlte Wallabstaende (vorgegeben oder berechnet)
! i=2: Periheldistanz (bzw. Sonnenradius)
! i=3: Grosse Halbachse ( " " )
! i=4: Apheldistanz ( " " )
1915 !-----Wallabstaende berechnet in Metern aus den GPS-Koordinaten
! (ilin = 1), vorgegeben in Metern (ilin = 2) oder gemessen von
! Karte/Bildschirm z.B. in Millimetern (ilin = 3)
800 continue
if (ilin==1) then ! Distanzen gemaess GPS-Koordinaten
1920 hcorr = (6375.726d0+2.304d0)/6375.726d0 !Hoehenkorrekturfaktor
do i=0,17
if (i/=4 .and.i<=10) then
call distance(0,i,dis)
elseif (i==4) then
1925 call distance(0,2,dis1)
call distance(2,4,dis2); dis = dis1 + dis2
elseif (i==11) then
call distance(0,14,dis1)
call distance(11,14,dis2); dis = dis1 - dis2
1930 elseif (i==12) then
call distance(12,14,dis3); dis = dis1 - dis3
elseif (i==13) then
call distance(13,14,dis4); dis = dis1 - dis4
elseif (i==14) then; dis = dis1
1935 elseif (i==15) then; dis = dis1 + dis4
elseif (i==16) then; dis = dis1 + dis3
elseif (i==17) then; dis = dis1 + dis2
endif
teot(i,3) = dis * hcorr ! mit linearer Hoehenkorrektur
1940 enddo
endif
kk = 4; if (ilin<=2) kk = 3; comp(0,1) = teot(0,kk)
do i=1,4; comp(i,1) = teot(i+1,kk); enddo
do i=5,8; comp(i,1) = teot(i+2,kk); enddo
1945
!-----Program output 1: Ausdruck der Eingabe-Daten
lbase(4) = dwi
do iu=ix,6,5
write(iu,820)'Planetary Correlation', &
1950 & 'of the Pyramids at Teotihuacan','< P5-option',iop0,' >'
write(iu,'(4x,a13//4x,a8,17x,a27,a5,a15)') '1. INPUT DATA', &
& 'Position',' GPS lat. GPS long. ',tdi(ilin), &
Datei: ~/home/p5/p5.f95 Seite 33 von 110
& ' [m] d [mm]'; call linie(iu,1)
do i=0,14; write(iu,815) tname(i),teot(i,1),q(i),teot(i,2), &
1955 q(i),teot(i,3),st(i),teot(i,4),st(i)
if (i==10) call linie(iu,2); enddo
do i=15,17; write(iu,816) tname(i),str4,str4,teot(i,3),st(i),&
& teot(i,4),st(i); enddo; call linie(iu,1)
write(iu,'(40x,a38)') '(* pyramid/temple position - off-axis)'
1960 write(iu,'(40x,a38)') '(+ sum or difference of two distances)'
if (ilin==1) &
write(iu,'(40x,a38)')'(Data in column "GPS" are GPS-results)'
!-----Program output 2: Tabellenkopf
1965 write(iu,'(/4x,a18//4x,a25,3x,a27/4x,a25,3x,a11)') &
& '2. CALCULATED DATA', &
& 'Teotihuacan, length unit:',tluna(isep), &
& 'astronomical length unit:',trsun(iuniv)
if (lbase(ical)>=9.99995d0) then
1970 write(iu,'(4x,a25,f10.4)') &
& 'logarithmic base (astr.):',lbase(ical)
else
write(iu,'(4x,a25,f9.4)') &
& 'logarithmic base (astr.):',lbase(ical)
1975 endif
if (io==1) then
write(iu,'(/26x,18(''-''),a11,1x,18(''-''))')di(ilin)
write(iu,*)' Julian year (per. dist', &
& 'ance) (a) (aph. distance)'
1980 call linie(iu,1)
else
write(iu,'(/4x,a4,9x,a14,7x,a40)')'Body',di2(ilin,isep), &
di3(iuniv)
endif
1985 enddo
!-----Spezielle Laengeneinheit (Distanz vom Zentrum der "Mondpyramide"
! zur Mitte des "Plaza de la Luna")
if (isep==2) then
1990 do i=0,8; comp(i,1) = comp(i,1)/teot(1,kk);enddo
teot(6,kk) = teot(6,kk)/teot(1,kk)
endif
!-----Bahnelemente der Planeten (VSOP3) und Logarithmieren
1995 xlog = dlog10(lbase(ical))
do i=2,4! (Sonne)
comp(0,i) = dlog10(R0*0.001d0)/xlog
if (iuniv==2) comp(0,i) = 0.d0
enddo
2000 time = zmin*0.01d0
810 do i=1,8! (Planeten)
call vsop3(lv,i,ix,ir,time-20.d0,res); if (ir/=i0) go to 1000
if (iuniv==2) res(2) = res(2)/(R0*0.001d0) ! spezielle Einheit
comp(i,3) = dlog10(res(2)*AE*0.001d0)/xlog
2005 comp(i,2) = comp(i,3) + dlog10(1.d0-res(3))/xlog
comp(i,4) = comp(i,3) + dlog10(1.d0+res(3))/xlog
enddo
!-----Berechnung fuer Periheldistanz, gr. Halbachse u. Apheldistanz
2010 do i=1,3
! . . . Bestimmtheitsmass (R^2)
call rcoef2(i,9,bmas)
Datei: ~/home/p5/p5.f95 Seite 34 von 110
! . . . Lineare Regression --> Steigung a und Ordinatenabschnitt b
2015 call lintrend(i,9,alin(i),blin(i))
! . . . Distanz des hypothetischen Planeten "Phaeton" (logarithmisch)
phdis(i) = alin(i)*teot(6,kk) + blin(i)
enddo
2020
!-----Program output 2: Berechnete Daten
! (Die drei Distanzen "aphel, a und perihel" gelten alternativ
! und enthalten den fiktiven Planeten "Phaeton" zwischen Mars
! und Jupiter.)
2025 do iu=ix,6,5
if (io==1) then
write(iu,850) time*100.d0,(bmas(1,i),i=1,3)
else
call linie(iu,1)
2030 if (isep==1) then
do i=0,8; write(iu,835) plan(i),(comp(i,j),j=1,4); enddo
call linie(iu,2); write(iu,'(2x,a10,f15.2,6x,3f14.4)') &
& ' (Phaeton)',teot(6,kk),phdis
else
2035 do i=0,8; write(iu,830) plan(i),(comp(i,j),j=1,4); enddo
call linie(iu,2); write(iu,'(2x,a10,f16.4,5x,3f14.4)') &
& ' (Phaeton)',teot(6,kk),phdis
endif
call linie(iu,2)
2040 write(iu,'(2x,a23,9x,a2,f13.8,2f14.8)') &
' linear fit, f(x)=ux+v','u:',alin
write(iu,'(34x,a2,f13.8,2f14.8)')'v:',blin
call linie(iu,2)
write(iu,840)'Julian year:',time*100.d0,'R^2:', &
2045 (bmas(1,i),i=1,3)
write(iu,841)'adj. R^2:',(bmas(2,i),i=1,3)
endif
enddo
2050 !-----Ruecksprung
if (step>0.d0) then
time = time + step*0.01d0
if (time<=zmax*0.01d0+1.d-8) go to 810
endif
2055
!-----Ende der 4. Hauptschleife (Teotihuacan)-------------------------
!=====================================================================
!---------------------- Ende der Hauptschleifen ----------------------
2060 !=====================================================================
900 do iu=ix,6,5; if (io/=2) call linie(iu,1+ipar); enddo
! . . Ruecksprung bei Option -804 und Speichern von "inser-2.t"
2065 if (iop0==-804) then
if (ilin==1) then
ilin = 2
zmin = -30000.d0
zmax = 30000.d0
2070 go to 10
endif
call save_ser
endif
Datei: ~/home/p5/p5.f95 Seite 35 von 110
2075 !-----Endzeilen
call cpu_time(zib)
call date_and_time(zdate,ztime,zzone,iw2)
call comtime(1,zia,zib,iw1,iw2,ihour,imin,sec)
call comtime(2,zia,zib,iw1,iw2,ihour2,imin2,sec2)
2080 do iu=ix,6,5
call endzeile(ipla,imod,ilin,iaph,isep,ison,ijd,ipos,io, &
iu,inum,ihour,imin,sec,ihour2,imin2,sec2,is12,iop0)
!h if (ipla<=2.and.imod<=2.and.ison>=3) then !h
!h write(iu,'(7x,a24,a33)') 'Frequency of deviations ', & !h
2085 !h & ' Fpos(0 to 5%) in steps of 0.05%:' !h
!h call linie(iu,1) !h
!h do i=0,4;write(iu,'(2(3x,10i3))') (ihis(j+i*20),j=1,20) !h
!h enddo; call linie(iu,1); write(iu,*); endif !h
close(iu)
2090 enddo
1000 continue
!-----Ende des Hauptprogramms-----------------------------------------
stop
2095 54 format(1x,3f9.6,3(a1,f7.6),3f9.6)
55 format(1x,a2,i7,f14.5,f10.3,f8.3,4f8.3,f6.1)
56 format(1x,a2,i7,f15.5,f11.3,f9.3,4f8.3,a2)
57 format(1x,3(f9.4,f8.4,f9.6))
65 format(1x,a2,i7,f10.3,3f8.3,3f7.1,f5.1,a2,f7.3)
2100 67 format(1x,a2,i7,f10.3,3f8.3,2f7.1,a7,f5.1,a2,f7.3)
85 format(1x,a2,i7,f10.3,3f8.3,3f7.2,f5.2,a2,f7.3)
165 format(1x,a2,i7,f10.3,2f8.3,i3,i4,3f7.1,f6.1,a2,f7.3)
184 format(1x,a2,i7,f10.3,2f8.3,i3,i4,3f7.2,f6.2,a2,f7.3)
255 format(1x,f14.5,f7.1,f7.2,f7.3,f7.2,3f7.1,f6.1,a2,f7.3)
2105 256 format(1x,a2,i7,f10.3,f8.2,f7.3,f7.2,4f7.1,a2,f7.3)
275 format(1x,f14.5,f7.1,f7.2,f7.3,f7.2,3f7.2,f6.2,a2,f7.3)
276 format(1x,a2,i7,f10.3,f8.2,f7.3,f8.2,3f7.2,f6.2,a2,f7.3)
365 format(1x,a3,i8,f13.3,f12.0,i6,1x,3f7.1,f5.1,a2,f7.3)
366 format(1x,a3,i8,f13.3,f12.0,i2,i4,3f7.1,f6.1,a2,f7.3)
2110 367 format(1x,a3,i8,f13.3,f12.0,i6,1x,2f7.1,a7,f5.1,a2,f7.3)
384 format(1x,a3,i8,f13.3,f12.0,i6,1x,3f7.2,f5.2,a2,f7.3)
386 format(1x,a3,i8,f13.3,f12.0,i2,i4,3f7.2,f6.2,a2,f7.3)
405 format(1x,a2,i7,f11.3,f8.3,f9.3,f9.4,f8.1,2f7.1,1x,a2,f7.3)
406 format(1x,a2,i7,f11.3,f8.3,f9.3,f9.4,f8.2,2f7.2,1x,a2,f7.3)
2115 407 format(1x,a2,i7,f15.5,f11.3,i3,i4,f8.1,2f7.1,f6.2,a2,f6.3)
408 format(1x,a2,i7,f15.5,f11.3,i3,i4,f8.2,2f7.2,f6.2,a2,f6.3)
455 format(1x,a2,3a1,i7,f15.5,f11.3,5f8.3)
456 format(1x,a2,3a1,i7,f15.5,f11.3,2f8.3,f6.1,f10.3,f8.3)
457 format(1x,a2,3a1,i7,f15.5,f11.3,3f8.3,f6.1,f10.3)
2120 458 format(1x,a2,a1,i7,f5.0,a5,i6,i3,2(a1,i2),4f8.3,f7.1,i5)
459 format(1x,a2,a1,f4.0,a5,i6,i3,2(a1,i2),4(i4,2(a1,i2)),f7.1, &
a1,i4)
461 format(1x,a2,a1,f4.0,a5,i6,i3,2(a1,i2),2(a10,i4,2(a1,i2)), &
f7.1,a1,i4)
2125 471 format(1x,a2,a1,f4.0,a5,i6,1x,a8,2x,a8,i4,2(a1,i2),2(2x,a8), &
f7.1,a1,i4)
558 format(1x,a2,a1,i7,f5.0,a5,i5,i4,2(a1,i2),4f8.3,f7.1,i4)
559 format(1x,a2,a1,f4.0,a5,i5,5(i4,2(a1,i2)),f7.1,a1,i3)
561 format(1x,a2,a1,f4.0,a5,i5,i4,2(a1,i2),2(a10,i4,2(a1,i2)), &
2130 f7.1,a1,i3)
571 format(1x,a2,a1,f4.0,a5,i5,2a10,i4,2(a1,i2),2a10,f7.1,a1,i3)
659 format(1x,a2,a1,f4.0,a5,i6,5(i4,a1,i2,a1,i2),f8.1,2x,a1, &
2x,5f8.2,3x,2f8.2,i6)
661 format(1x,a2,a1,f4.0,a5,i6,i4,2(a1,i2),2(a10,i4,2(a1,i2)), &
2135 f8.1,2x,a1,2x,f8.2,a8,f8.2,a8,f8.2,3x,2f8.2,i6)
Datei: ~/home/p5/p5.f95 Seite 36 von 110
671 format(1x,a2,a1,f4.0,a5,i6,2a10,i4,2(a1,i2),2a10,f8.1,2x,a1, &
2x,2a8,f8.2,2a8,3x,2f8.2,i6)
759 format(1x,a2,a1,f4.0,a5,i5,1x,5(i4,a1,i2,a1,i2),f8.1,2x,a1, &
2x,5f8.2,3x,2f8.2,i6)
2140 761 format(1x,a2,a1,f4.0,a5,i5,1x,i4,2(a1,i2),2(a10,i4,2(a1,i2)), &
f8.1,2x,a1,2x,f8.2,a8,f8.2,a8,f8.2,3x,2f8.2,i6)
771 format(1x,a2,a1,f4.0,a5,i5,1x,2a10,i4,2(a1,i2),2a10,f8.1,2x,a1,&
2x,2a8,f8.2,2a8,3x,2f8.2,i6)
! . . Teotihuacan
2145 815 format(4x,a20,1x,f13.6,1x,a1,f12.6,1x,a1,f10.2,1x,a1,f9.1,1x,a1)
816 format(4x,a20,7x,a5,9x,a5,2x,f12.2,a2,f9.1,a2)
820 format(/30x,a21/25x,a30/32x,a11,i4,a2/)
830 format(4x,a10,f14.4,5x,3f14.4)
835 format(4x,a10,f13.2,6x,3f14.4)
2150 840 format(4x,a12,f11.2,5x,a4,f13.8,2f14.8)
841 format(27x,a9,f13.8,2f14.8)
850 format(5x,f13.2,4x,3f17.10)
! . . Giza: Ausgabe einer groesseren Stellenanzahl zur Feinabstimmung
2155 ! bzw. Minimierung von F[%] fuer die Schnellstart-Optionen 4 u. 9.
! Dies wurde verwendet fuer Buch 1.
! Suche in der Umgebung des Merkur-Aphels bzw. Merkur-Perihels
!f255 format(1x,f14.5,f8.2,f7.2,f8.4,f6.1,3f7.1,f5.1,a2/65x,f14.8) !f
!f275 format(1x,f14.5,f8.2,f7.2,f7.3,f7.2,3f7.2,f5.1,a2/65x,f14.8) !f
2160 end program P5
subroutine inputdata(ipla,ilin,imod,imo4,ikomb,io,lv,ivers, &
itran,isep,iuniv,ical,ika,iaph,iamax,step,ison,ihi,irb,ijd, &
zmin,zmax,ak,zjde1,dwi,dwikomb,dwi2,dwi3,nurtr,iek,iop0,iout)
2165 !-----Inputdaten und Programmstart------------------------------------
implicit double precision (a-h,o-z)
character(36) :: com
iy = 6; ipla = 1; itran = 1; io = 0; ire = 0; z0 = 0.d0
write(iy,'(//29x,23(''-''))')
2170 write(iy,'(30x,''PLANETARY CORRELATION'')')
write(iy,'(30x,''P5 Program, Mar. 2025'')')
write(iy,'(29x,23(''-''))')
! . . Schnellstart-Menue
2175 write(iy,'(/4x,a13,6x,a17,5x,a15,5x,a11/1x,78a1/5(2x,2(a17,4x),&
& a16,4x,a14/),1x,78a1)') &
'Giza pyramids','Great P. chambers','transits syzygy', &
'Teotihuacan', &
('-',i=1,78), &
2180 '3D Mer at aph (1)','3D Mer at per (6)','Mercury tr (11)',&
'GPS m km (16)', &
'2D Mer at aph (2)','Keplers equ (7)','Venus tr (12)',&
'Map mm km (17)', &
'constell 3088 (3)','constell 3088 (8)','syzygy 3 pl (13)',&
2185 'GPS log3 (18)', &
'1.5 days 3088 (4)','1.5 days 3088 (9)','syzygy 4 pl (14)',&
'Map log3 (19)', &
'near aphelion (5)','F minimized (10)','TYMT test (15)',&
'24000 y. (20)', &
2190 ('-',i=1,78)
do
do
write(iy,'(8x,a10,3x,a20,3x,a26)',advance='no')'info (111)',&
'detailed options (0)','(1..20 or book options) : '
2195 read(*,*,iostat=iox) iop0
if (iox==0) exit
Datei: ~/home/p5/p5.f95 Seite 37 von 110
call emes(ire,com,dm)
enddo
iop=iop0
2200 if (iop==0) then; write(iy,*); go to 10; endif
if (iop==111) then; call info; iout=4; return; endif
! . . . Verborgene Optionen fuer Tabellen aus beiden oben genannten
! Buechern, s.a. im Programmkopf unter "Neue Optionen, b)"
2205 if ((iop>=0 .and.iop<=22).or. &
! 1. "Pyramiden und Planeten", Tab. 39-51
(iop>=390 .and.iop<=392).or.(iop>=400 .and.iop<=402).or. &
(iop>=410 .and.iop<=432).or.(iop>=440 .and.iop<=442).or. &
iop==450 .or.(iop>=460 .and.iop<=461).or.(iop>=470 .and. &
2210 iop<=471).or.(iop>=480 .and.iop<=481).or.(iop>=490 .and. &
iop<=492).or.(iop>=500 .and.iop<=502).or.(iop>=510 .and. &
iop<=512).or.(iop>=517 .and.iop<=519).or. &
! 2. Buch 2, Tab. 17-36 ausser 30
iop==170 .or.iop==171 .or.iop==180 .or.iop==181 .or. &
2215 (iop>=190 .and.iop<=195).or.(iop>=200 .and.iop<=202).or. &
(iop>=210 .and.iop<=213) .or.iop==220 .or.iop==221 .or. &
(iop>=230 .and.iop<=232).or.(iop>=240 .and.iop<=242).or. &
iop==250 .or.iop==251 .or.iop==260 .or.iop==270 .or. &
iop==271 .or.iop==280 .or.iop==281 .or.iop==300 .or. &
2220 iop==301 .or.iop==310 .or.iop==311 .or.(iop>=320 .and. &
iop<=323).or.(iop>=330 .and.iop<=335).or.iop==338 .or. &
(iop>=370 .and.iop<=373).or.(iop>=380 .and.iop<=381).or. &
iop==999 .or.iop==-804) exit
ire = 1; call emes(ire,com,dm)
2225 enddo
! . . Auswertung der eingegebenen Option
if (iop<0 .or.iop>20) then
id = mod(iop,10); ita = (iop-id)/10
2230
! Buch 1 (Parameter fuer Datei "inparm.t")
if (ita==39) iop = 21 + id
if (ita==40) iop = 24 + id
if (ita==41 .or.ita==42) then
2235 iop = 27 + id
if (id==7) iop = 3
if (id>=8) iop = 26 + id
endif
if (ita==43) iop = 36 + id
2240 if (ita==44) iop = 28 + 3*id
if (ita==45) iop = 2
if (ita==46 .or.ita==47) iop = 39 + id
if (ita==48) iop = 41 + id
if (ita==49) iop = 3
2245 if (ita==49 .and.id>=1) iop = 33 + id
if (ita==50) iop = 1
if (ita==50 .and.id>=1) iop = 42 + id
if (ita==51) iop = 45 + id
if (ita==51 .and.id>=7) iop = 89 + id
2250
! Buch 2 (Parameter fuer Datei "inparm.t")
if (ita==17) iop = 48 + id
if (ita==18) iop = 50 + id
if (ita==19) iop = 52 + id
2255 if (ita==20) iop = 58 + id
if (ita==21) iop = 61 + id
if (ita==22) iop = 65 + id
Datei: ~/home/p5/p5.f95 Seite 38 von 110
if (ita==23 .and.id==0) iop = 8
if (ita==23 .and.id>=1) iop = 66 + id
2260 if (ita==24 .and.id==0) iop = 3
if (ita==24 .and.id>=1) iop = 68 + id
if (ita==25) iop = 71 + id
if (ita==26) iop = 14
if (ita==27) iop = 73 + id
2265 if (ita==28) iop = 75 + id
if (ita==30) iop = 77 + id
if (ita==31) iop = 79 + id
if (ita==32) iop = 81 + id ! Bei iop0=322, 323 s.a. "aphelko".
if (ita==33 .and.id<=5) iop = 85 + id
2270 if (ita==33 .and.id==8) iop = 91
if (ita==37) iop = 16 + id
if (ita==38 .and.id==0) iop = 20
if (ita==38 .and.id==1) iop = 99
if (iop0==-804) iop = 94 ! Erzeugung der Datei "inser-2.t"
2275 if (iop0==21 .or.iop0==22) iop = 91 + id ! V/M-Tra. + Pos-win.
endif ! (Sonderoptionen)
! . . Einlesen der Parameter aus "inparm.t"
call inputfile(ipla,ilin,imod,imo4,ikomb,io,lv,ivers, &
2280 itran,isep,iuniv,ical,ika,iaph,iamax,step,ison,ihi,irb,ijd, &
zmin,zmax,ak,zjde1,dwi,dwikomb,dwi2,dwi3,nurtr,iek,iop,1,iout)
return
!.....Menues fuer Einzeleingabe der Parameter.........................
2285
! . . Planetenpositionen (Parameter: ipla)
10 do
write(iy,'('' >>> Giza pyramids (1), GP chambers (2),''/ &
&'' conj./transits (3), Teotihuacan (4) : ''&
2290 & )',advance='no')
read(*,*,iostat=iox) ipla
if (ipla>=1 .and.ipla<=4 .and.iox==0) exit
call emes(ire,com,dm)
enddo
2295
! . . Linearkonstellation (ilin) --- Transite ---
ilin = 4
if (ipla==3) then
do
2300 write(iy,'('' Tr. Mer.(1), Ven.(2), 3-co.(3), 4-co.(4) : ''&
& )',advance='no')
read(*,*,iostat=iox) ilin
if (ilin>=1 .and.ilin<=4 .and.iox==0) exit
call emes(ire,com,dm)
2305 enddo
endif
! . . VSOP, Theorie-Variante (imod)
! Es erfolgt hier eine Aenderung des Parameters 'imod' (s.u.).
2310 ! Eingabe : VSOP87 Kombi.(1), Kurzv.(2), Kepl.(3), Vollv.(4)
! intern : VSOP87 Kurzv.(1), Vollv.(2), Kepl.(3)
ikomb = 0; imod = 3
if (ipla<=3) then
do
2315 if (ipla<=2) then
write(iy,'('' VSOP87 combi. (1), short version (2),''/ &
&'' Kepl. equ. (3), full version (4) : ''&
& )',advance='no')
Datei: ~/home/p5/p5.f95 Seite 39 von 110
read(*,*,iostat=iox) imod
2320 if (imod>=1 .and.imod<=4 .and.iox==0) exit
else
if (ilin>=3) then
write(iy,'('' VSOP87 combi.(1), short v.(2), '', &
& ''Kepl.(3) : '')',advance='no')
2325 read(*,*,iostat=iox) imod
if (imod>=1 .and.imod<=3 .and.iox==0) exit
else
write(iy,'('' VSOP87-version full v.(1), '', &
& ''short v.(2) : '')',advance='no')
2330 read(*,*,iostat=iox) imod
if (imod>=1 .and.imod<=2 .and.iox==0) exit
endif
endif
call emes(ire,com,dm)
2335 enddo
! Aendern des Parameters "imod"
! (imo4 wird eingefuehrt, da imod wechselt, falls ikomb = 1 ist.)
imo4 = 0
if (imod==1) ikomb = 1
2340 if (imod==2) imod = 1
if (imod==4) then; imod = 2; imo4 = 1; endif
endif
! . . Version von VSOP87 (lv)
2345 ! (Bei Transits u. J2000: geringe Abw. zu Meeus => keine Option
! bzw. ipla <= 2.)
lv = 1; ivers = 3
if (ipla<=3) then
if (imod/=1 .or.(imod==1 .and.ikomb==1 .and.ipla<=2)) then
2350 do
write(iy,'('' System ecl. of epoch (1), J2000.0 (2)'', &
& '' : '')',advance='no')
read(*,*,iostat=iox) lv
if ((lv==1 .or.lv==2).and.iox==0) exit
2355 call emes(ire,com,dm)
enddo
if (lv==2) ivers = 1
endif
endif
2360
! . . Merkur- und Venustransite vor Sonne pruefen bei VSOP-Vollversion
! (Diese Option wird nicht mehr abgefragt, da nach Optimierung der
! VSOP87-Routine der Geschwindigkeitsvorteil durch Weglassen der
! Transit-Pruefung nur noch gering ist, d.h., itran ist stets 1.)
2365 !c if (ipla==3.and.ikomb==1.and.ilin>=3) then
!c do
!c write(iy,'('' Check planetary transit yes (1), no (2)'', &
!c & '' : '')',advance='no')
!c read(*,*,iostat=iox) itran
2370 !c if ((itran==1.or.itran==2).and.iox==0) exit
!c call emes(ire,com,dm)
!c enddo; if (itran==2) io = 1
!c endif
2375 ! . . Transit-Pruefung bei gleicher ekl. Laenge, minimaler Separation
! oder Berechnung der Phasen, optional mit Positionswinkeln (isep)
isep = 1
if (itran==1 .and.ilin<=2 .and.ipla<=3) then
do
Datei: ~/home/p5/p5.f95 Seite 40 von 110
2380 write(iy,'('' Date equ.L.(1), nearest (2), phases (3),''/ &
& '' phases and position angles (4) : ''&
& )',advance='no')
read(*,*,iostat=iox) isep
if (isep>=1 .and.isep<=4 .and.iox==0) exit
2385 call emes(ire,com,dm)
enddo
endif
! . . Julian/Gregorian calendar: Automatic choice of calender or
2390 ! only Gregorian calendar (ical)
ical = 0
if (ipla<=3) then
do
write(iy,'('' Calendar only Greg. (1), Jul./Greg. (2) : ''&
2395 & )',advance='no')
read(*,*,iostat=iox) ical
if ((ical==1 .or.ical==2).and.iox==0) exit
call emes(ire,com,dm)
enddo
2400 endif
! . . Terrestrial Time bzw. Universal Time (iuniv)
iuniv = 1
if (itran==1 .and.ilin<=2 .and.isep>=3 .and.ipla<=3) then
2405 do
write(iy,'('' Time system JDE/TT (1), UT (2)'', &
& '' : '')',advance='no')
read(*,*,iostat=iox) iuniv
if ((iuniv==1 .or.iuniv==2).and.iox==0) exit
2410 call emes(ire,com,dm)
enddo
endif
! . . Zuordnung der Planeten Erde (E), Venus (V) und Merkur (M) zu
2415 ! Koenigs-, Koeniginnen- und Felsenkammer, diese Reihenfolge (ika)
ika = 0
if (ipla==2 .and.imod/=3) then
do
write(iy,'('' Planets E-V-M (1), E-M-V (2), V-E-M (3),''/ &
2420 & '' V-M-E (4), M-E-V (5), M-V-E (6) : ''&
& )',advance='no')
read(*,*,iostat=iox) ika
if (ika>=1 .and.ika<=6 .and.iox==0) exit
call emes(ire,com,dm)
2425 enddo
endif
! . . Zeitpunkte im/um Aphel bzw. Perihel oder freier Zeitpunkt (iaph)
iaph = 1; iamax = 0
2430 step = 24.d0
if (ipla<=2) then
do
if (imod<=2 .and.ikomb==0 .and.imo4==0) then
write(iy,'('' Passage aph./per. area of aph./per. free''/ &
2435 & '' (1) (2) (3) (4) (5) : ''&
& )',advance='no')
read(*,*,iostat=iox) iaph
if (iaph>=1 .and.iaph<=5 .and.iox==0) exit
elseif (imod<=2 .and.ikomb==1 .and.imo4==0) then
2440 write(iy,'('' Passage aph. (1), per. (2), free (5)'', &
Datei: ~/home/p5/p5.f95 Seite 41 von 110
& '' : '')',advance='no')
read(*,*,iostat=iox) iaph
if ((iaph==1 .or.iaph==2 .or.iaph==5).and.iox==0) exit
elseif (imod<=2 .and.ikomb==0 .and.imo4==1) then
2445 write(iy,'('' Passage aph./ per. area of aph./ per.''/ &
& '' (1) (2) (3) (4)'', &
& '' : '')',advance='no')
read(*,*,iostat=iox) iaph
if (iaph>=1 .and.iaph<=4 .and.iox==0) exit
2450 else
write(iy,'('' Passage aphelion (1), perihelion (2)'', &
& '' : '')',advance='no')
read(*,*,iostat=iox) iaph
if ((iaph==1 .or.iaph==2).and.iox==0) exit
2455 endif
call emes(ire,com,dm)
enddo
if (iaph==3 .or.iaph==4) then
do
2460 write(iy,'('' Steps per Mercury passage : '')',advance='no')
read(*,*,iostat=iox) iamax
if (iamax>0 .and.iamax<=200000 .and.iox==0) exit
call emes(ire,com,dm)
enddo
2465 do
write(iy,'('' Step width (hours, real) : '')',advance='no')
read(*,*,iostat=iox) step
if (step>z0.and.step<=9999.9994d0 .and.iox==0) exit
call emes(ire,com,dm)
2470 enddo
if (imod==2) io = 1
endif
endif
2475 ! . . Sonnenposition (ison)
ison = 1
if (ipla<=2) then
do
if (ipla==1 .and.iaph<=2) then
2480 if (imod<=2) then
write(iy,'('' Sun pos. Myk.(1), Chefr.(2), free (3)'', &
& '' : '')',advance='no')
else
write(iy,'('' Sun pos. south of Myk.(1), Chefr.(2)'', &
2485 & '' : '')',advance='no')
endif
read(*,*,iostat=iox) ison
else
if (imod<=2) ison = 3
2490 endif
if (((imod<=2 .and.ison>=1 .and.ison<=3).or. &
(imod==3 .and.(ison==1 .or.ison==2))).and.iox==0) exit
call emes(ire,com,dm)
enddo
2495 endif
! . . Freie Sonnenposition, Berechnung 2- oder 3-dimensional (ison2)
if (iaph==5) ison = 5
if (ison==3) then
2500 do
if (ipla==1) then
Datei: ~/home/p5/p5.f95 Seite 42 von 110
write(iy,'('' Sun 2D (1), 3D/SLE (2), 3D/FITEX (3)'', &
& '' : '')',advance='no')
else
2505 write(iy,'('' Sun (three-dim.): SLE (2), FITEX (3)'', &
& '' : '')',advance='no')
endif
read(*,*,iostat=iox) ison2
if (((ipla==1 .and.ison2>=1 .and.ison2<=3).or. &
2510 (ipla==2 .and.(ison2==2 .or.ison2==3))).and.iox==0) exit
call emes(ire,com,dm)
enddo
if (ison2==2) ison = 4
if (ison2==3) ison = 5
2515 endif
! . . Hoehenlage der Pyramiden-Grundflaechen bzw. -Schwerpunkte (ihi)
ihi = 0
if (ipla<=2 .and.ison>=4) then
2520 do
if (ipla==1) then
write(iy,'('' z-coord. base (1), C-M (2), top (3)'', &
& '' : '')',advance='no')
else
2525 write(iy,'('' Wall east (1), middle (2), west (3)'', &
& '' : '')',advance='no')
endif
read(*,*,iostat=iox) ihi
if (ihi>=1 .and.ihi<=3 .and.iox==0) exit
2530 call emes(ire,com,dm)
enddo
endif
! . . Grundebene Ekliptik, Merkur- oder Venusbahn (irb)
2535 irb = 1
if (ipla<=2 .and.imod<=2 .and.ison==1) then
do
write(iy,'('' Coord. ecl.(1), Mer.(2-4), Ven.(5)'', &
& '' : '')',advance='no')
2540 read(*,*,iostat=iox) irb
if (irb>=1 .and.irb<=5 .and.iox==0) exit
call emes(ire,com,dm)
enddo
endif
2545
! . . Angabe bzw. Berechnung von JDE (ijd)
ijd = 15
if (ipla<=2 .and.ikomb==0 .and.iaph/=5) then
do
2550 if (imod==2 .and.iaph<=2) then
write(iy,'('' Constell. (1..14), k-No. (15), JDE (0)'', &
& '' : '')',advance='no')
else
write(iy,'('' Constell. (1..14), years (15), JDE (0)'', &
2555 & '' : '')',advance='no')
endif
read(*,*,iostat=iox) ijd
if (ijd>=0 .and.ijd<=15 .and.iox==0) exit
call emes(ire,com,dm)
2560 enddo
endif
ak = z0
Datei: ~/home/p5/p5.f95 Seite 43 von 110
zmin = z0
zmax = z0
2565 if (ipla<=3) then
if (ijd==15) then
if (imod==2 .and.iaph<=2 .and.ipla/=3) then
do
write(iy,'('' k (real): '')',advance='no')
2570 call pcheck(1,ak,2,dm,imod,ire)
if (ire==0) exit
enddo
else
do
2575 write(iy,'('' from year (real): '')',advance='no')
call pcheck(1,zmin,1,dm,imod,ire)
if (ire==0) exit
enddo
do
2580 write(iy,'('' until year (real): '')',advance='no')
call pcheck(1,zmax,1,dm,imod,ire)
if (zmin>=zmax.and.ire==0) then
call emes(ire,com,dm)
ire = 1
2585 endif
if (ire==0) exit
enddo
endif
endif
2590 if (ipla==3) then
step = z0
if (ilin>=3 .and.ikomb==0) then
do
write(iy,'('' Step width [hrs] (min.-search 0.) (real)'', &
2595 & '' : '')',advance='no')
read(*,*,iostat=iox) step
if (step>=z0.and.iox==0) exit
call emes(ire,com,dm)
enddo
2600 endif
endif
if (step==z0) ison = 5
if (ipla==3 .and.step/=z0) io = 1
zjde1 = z0
2605 if (ijd==0) then
do
write(iy,'('' JDE (real) : '')',advance='no')
call pcheck(1,zjde1,3,dm,imod,ire)
if (ire==0) exit
2610 enddo
endif
endif
! . . Winkelintervall bzw. relativer Fehler (dwi ... dwikomb)
2615 dwi = z0
dwi2 = z0; dwi3 = z0
dwikomb = z0; dm = 99.99d0
if (ipla<=2 .and.ijd==15 .and.(imod/=2 .or. &
(imod==2 .and.(iaph==3 .or.iaph==4)))) then
2620 if (ikomb==0 .and.iaph/=5) then
do
if (ison<=2) then
if (imod/=3) dm = 10.d0
Datei: ~/home/p5/p5.f95 Seite 44 von 110
write(iy,'('' Tolerance ecl. long. Venus, Earth (real)'', &
2625 & '' : '')',advance='no')
else
write(iy,'('' Max. F-pos at aphelion/ per. (real) [%]'', &
& '' : '')',advance='no')
endif
2630 call pcheck(2,dwi,1,dm,imod,ire)
if (ire==0) exit
enddo
else
do
2635 if (ison<=2) then
if (imod/=3) dm = 10.d0
write(iy,'('' Tolerance ecl. long. VSOP short (real)'', &
& '' : '')',advance='no')
else
2640 if (iaph/=5 .or.(iaph==5 .and.ikomb==1)) then
write(iy,'('' Max. F-pos VSOP short ver. (real) [%]'',&
& '' : '')',advance='no')
else
write(iy,'('' Max. F-pos, VSOP short, start fitmin [%]'',&
2645 & '' : '')',advance='no')
endif
endif
call pcheck(2,dwi,1,dm,imod,ire)
if (ire==0) exit
2650 enddo
do
if (ison<=2) then
if (imod/=3) dm = 10.d0
write(iy,'('' " " " VSOP full (real)'', &
2655 & '' : '')',advance='no')
else
if (iaph/=5 .or.(iaph==5 .and.ikomb==1)) then
write(iy,'('' " " VSOP full ver. (real) [%]'',&
& '' : '')',advance='no')
2660 else
write(iy,'('' " " VSOP short, final range [%]'',&
& '' : '')',advance='no')
endif
endif
2665 call pcheck(2,dwikomb,1,dm,imod,ire)
if (ire==0) exit
enddo
endif
if (iaph==3 .or.iaph==4) then
2670 do
write(iy,'('' " " consider without printing [%]'', &
& '' : '')',advance='no')
call pcheck(2,dwi2,1,dm,imod,ire)
if (ire==0) exit
2675 enddo
do
write(iy,'('' " " print beyond aphelion/per.[%]'', &
& '' : '')',advance='no')
call pcheck(2,dwi3,1,dm,imod,ire)
2680 if (ire==0) exit
enddo
endif
endif
if (ipla==3 .and.ilin>=3) then
Datei: ~/home/p5/p5.f95 Seite 45 von 110
2685 if (ikomb==0) then
do
write(iy,'('' Ang. range of eclipt. longitude (real)'', &
& '' : '')',advance='no')
call pcheck(2,dwi,1,dm,imod,ire)
2690 if (ire==0) exit
enddo
else
do
write(iy,'('' Ecl. angular range, VSOP short v. (real)'', &
2695 & '' : '')',advance='no')
call pcheck(2,dwi,1,dm,imod,ire)
if (ire==0) exit
enddo
do
2700 write(iy,'('' " " " , VSOP full v. (real)'', &
& '' : '')',advance='no')
call pcheck(2,dwikomb,1,dm,imod,ire)
if (ire==0) exit
enddo
2705 endif
endif
! . . Dreier- oder Viererkonjunktion nur mit Transit (nurtr)
nurtr = 1
2710 if (ipla==3 .and.ilin>=3 .and.ison==5 .and.imod/=3 &
.and.itran==1) then
do
write(iy,'('' All conjunctions (1), only transits (2)'', &
& '' : '')',advance='no')
2715 read(*,*,iostat=iox) nurtr
if ((nurtr==1 .or.nurtr==2).and.iox==0) exit
call emes(ire,com,dm)
enddo
endif
2720
! . . Blickrichtung auf die Planetenbahnen (iek)
! (nur bei 2D-Berechnungen)
iek = 1
if (ipla<=2) then
2725 do
if (ison<=2 .and.(ijd==15 .or.ijd==0)) then
if ((imod==2 .and.iaph<=2).or.ijd==0) then
write(iy,'('' View from ecliptic North (1), South (2)'', &
& '' : '')',advance='no')
2730 read(*,*,iostat=iox) iek
if (iek>=1 .and.iek<=2 .and.iox==0) exit
else
write(iy,'('' View from eclipt. N (1), S (2), N/S (3)'', &
& '' : '')',advance='no')
2735 read(*,*,iostat=iox) iek
if (iek>=1 .and.iek<=3 .and.iox==0) exit
endif
call emes(ire,com,dm)
else
2740 iek = 1
if ((ijd>=6 .and.ijd<=11).or.ijd==13 .or.ijd==14) iek=2; exit
endif
enddo
endif
2745
Datei: ~/home/p5/p5.f95 Seite 46 von 110
!-----Input Teotihuacan-----------------------------
! . . Kind of distance measurement (ilin)
if (ipla==4) then
2750 do
write(iy,'('' Distances GPS (1), meters (2), Map (3) : ''&
& )',advance='no')
read(*,*,iostat=iox) ilin
if (ilin>=1 .and.ilin<=3 .and.iox==0) exit
2755 call emes(ire,com,dm)
enddo
! . . .Time interval (zmin, zmax, step)
do
2760 write(iy,'('' from the year (real): ''&
& )',advance='no')
call pcheck(1,zmin,1,dm,imod,ire)
if (ire==0) exit
enddo
2765 do
write(iy,'('' until the year (real): ''&
& )',advance='no')
call pcheck(1,zmax,1,dm,imod,ire)
if (zmin>zmax.and.ire==0) then
2770 call emes(ire,com,dm); ire = 1
endif
if (ire==0) exit
enddo
step = 0.d0
2775 if (zmin<zmax) then
do
write(iy,'('' Step width in years (real): ''&
& )',advance='no')
read(*,*,iostat=iox) step
2780 if (step>z0.and.step<=zmax-zmin.and.iox==0) exit
call emes(ire,com,dm)
enddo
endif
2785 ! . . .Special length unit, Teotihuacan (isep)
do
write(iy,'('' Teotih. unit as given (1), "luna" (2) : ''&
& )',advance='no')
read(*,*,iostat=iox) isep
2790 if ((isep==1 .or.isep==2).and.iox==0) exit
call emes(ire,com,dm)
enddo
! . . .Special length unit for planetary distances (iuniv)
2795 do
write(iy,'('' Planetary unit, kilometer (1), R-Sun (2) : ''&
& )',advance='no')
read(*,*,iostat=iox) iuniv
if ((iuniv==1 .or.iuniv==2).and.iox==0) exit
2800 call emes(ire,com,dm)
enddo
! . . . Logarithmic base (ical, dwi)
do
2805 write(iy,'('' Logar. base 10 (1), 3 (3), custom (4) : ''&
& )',advance='no')
Datei: ~/home/p5/p5.f95 Seite 47 von 110
read(*,*,iostat=iox) ical
if (ical==1 .or.ical==3 .or.ical==4 .and.iox==0) exit
call emes(ire,com,dm)
2810 enddo
if (ical==4) then
do
write(iy,'('' Logarithmic base (real)'', &
& '' : '')',advance='no')
2815 read(*,*,iostat=iox) dwi
if (dwi>1.d0 .and.dwi<=1000.d0 .and.iox==0) exit
call emes(ire,com,dm)
enddo
endif
2820 endif
!-----End of input Teotihuacan----------------------
! . . Ausgabe (io)
if (io==0) then
2825 io = 2; if (iaph==5) io = 1
if (imo4==0 .and.iaph/=5) then
do
write(iy,'('' Output normal (1), extended (2)'',&
& '' : '')',advance='no')
2830 read(*,*,iostat=iox) io
if ((io==1 .or.io==2).and.iox==0) exit
call emes(ire,com,dm)
enddo
endif
2835 endif
! . . Ausgabegeraet (iout)
do
if (imod<=2 .and.ipla<=2 .and.ison==5) then
2840 write(iy,'('' Mon.(1), file (2), special (3), exit (4)'', &
& '' : '')',advance='no')
read(*,*,iostat=iox) iout
if (iout>=1 .and.iout<=4 .and.iox==0) exit
else
2845 write(iy,'('' Monitor (1), mon. + file (2), exit (4)'', &
& '' : '')',advance='no')
read(*,*,iostat=iox) iout
if ((iout==1 .or.iout==2 .or.iout==4).and.iox==0) exit
endif; call emes(ire,com,dm)
2850 enddo
end subroutine
subroutine inputfile(ipla,ilin,imod,imo4,ikomb,io,lv,ivers, &
itran,isep,iuniv,ical,ika,iaph,iamax,step,ison,ihi,irb,ijd, &
2855 zmin,zmax,ak,zjde1,dwi,dwikomb,dwi2,dwi3,nurtr,iek,iop,irw,iout)
!-----Einlesen der Inputdaten bei Schnellstart------------------------
! irw=1: lesen aus "inparm.t", irw=2: schreiben in "inedit.t"
! Mit Hilfe von inedit.t kann inparm.t manuell editiert werden.
implicit double precision (a-h,o-z)
2860 if (irw==1) then
if (iop/=999) then
open(unit=10,file='inparm.t')
do i=1,10*iop+1; read(10,*); enddo
else
2865 open(unit=10,file='inedit.t')
do i=1,26; read(10,*); enddo
endif
Datei: ~/home/p5/p5.f95 Seite 48 von 110
read(10,*) ipla,ilin,imod,imo4,ikomb
read(10,*) lv,itran,isep,iuniv,ical
2870 read(10,*) ika,iaph,iamax,step
read(10,*) ison,ihi,irb,ijd
read(10,*) zmin,zmax,ak,zjde1
read(10,*) dwi,dwikomb,dwi2,dwi3
read(10,*) nurtr,iek,io,iout
2875 ivers = 3; if (lv==2) ivers = 1
elseif (irw==2) then
open(unit=10,file='inedit.t')
do i=1,36; read(10,*); enddo
write(10,'(5i3)') ipla,ilin,imod,imo4,ikomb
2880 write(10,'(5i3)') lv,itran,isep,iuniv,ical
write(10,'(2i3,i6,f12.5)') ika,iaph,iamax,step
write(10,'(3i3,i4)') ison,ihi,irb,ijd
write(10,'(3f13.5,f15.5)') zmin,zmax,ak,zjde1
write(10,'(4f8.3)') dwi,dwikomb,dwi2,dwi3
2885 write(10,'(4i3)') nurtr,iek,io,iout
write(10,*) ('-',i=1,59)
write(10,*) ('*',i=1,27),' END ',('*',i=1,27)
endif
close(10)
2890 end subroutine
subroutine chambers(ig,rx)
!-----Aenderung der Planeten-Kammer-Zuordnung-------------------------
! Reihenfolge Koenigs-, Koeniginnen- u. Felsenkammer mit Planeten:
2895 ! ig: 1. E-V-M, 2. E-M-V, 3. V-E-M, 4. V-M-E, 5. M-E-V, 6. M-V-E
implicit double precision (a-h,o-z)
dimension :: rx(3,4),x(5),y(5)
if (ig==3 .or.ig==5) call pchange(1,1,2,rx,x,y,indx)
if (ig==2 .or.ig==4 .or.ig==5) call pchange(1,2,3,rx,x,y,indx)
2900 if (ig==4) call pchange(1,1,2,rx,x,y,indx)
if (ig==6) call pchange(1,1,3,rx,x,y,indx)
end subroutine
subroutine pchange(imodus,iz,jz,rxx,x,y,indx)
2905 !-----Vertauschen von Input-Zeilen oder Zahlen in "fitmin"------------
implicit double precision (a-h,o-z)
dimension :: rxx(3,4),x(5),y(5)
if (imodus==1) then; do i=1,4
rpc=rxx(iz,i); rxx(iz,i)=rxx(jz,i); rxx(jz,i)=rpc; enddo
2910 elseif (imodus==2) then
z=x(iz); x(iz)=x(jz); x(jz)=z
z=y(iz); y(iz)=y(jz); y(jz)=z
if (indx==iz) then; indx = jz; return; endif
if (indx==jz) indx = iz
2915 endif
end subroutine
subroutine pcheck(i,p,n,dm,imod,ire)
!-----Read and check of input parameter p-----------------------------
2920 ! modus i: read + check time (1), tolerance (2)
! time n: year (1), k-number (2), JDE (3)
! p: input parameter, dm: maximum allowed value
! error code ire (ire = 0 means "no error.")
implicit double precision (a-h,o-z)
2925 character(36) :: com
ire = 0
read(*,*,iostat=iox) p
if (iox/=0) ire = 1
Datei: ~/home/p5/p5.f95 Seite 49 von 110
if (i==1 .and.ire==0) then
2930 ire = 2
if (imod/=3) then
if (n==1 .and.(p<-13000.00001d0 .or.p>17000.00001d0)) then
com = ' (-13 000. <= year <= 17 000.) '
elseif (n==2 .and.(p<-63000.001d0 .or.p>63000.001d0)) then
2935 com = ' (-63 000. <= k <= 63 000.) '
elseif (n==3 .and.(p<-3030000.1d0 .or.p>7940000.1d0)) then
com = ' (-3 030 000. <= JDE <= 7 940 000.) '
else
ire = 0
2940 endif
else
if (n==1 .and.(p<-30000.00001d0 .or.p>30000.00001d0)) then
com = ' (-30 000. <= year <= 30 000.) '
elseif (n==2 .and.(p<-133000.01d0 .or.p>117000.01d0)) then
2945 com = ' (-133 000. <= k <= 117 000.) '
elseif (n==3 .and.(p<-9240000.1d0 .or.p>12680000.1d0)) then
com = ' (-9 240 000. <= JDE <= 12 680 000.)'
else
ire = 0
2950 endif
endif
elseif (i==2 .and.ire==0) then
if (p<=0.d0) ire = 1
if (p>dm) ire = 3
2955 endif
if (ire/=0) call emes(ire,com,dm)
end subroutine
subroutine emes(ire,com,dm)
2960 !-----Error message---------------------------------------------------
implicit double precision (a-h,o-z)
character(36) :: com
iy = 6
if (ire<=1) write(iy,'(/'' ---> Insert a correct number.''/)')
2965 if (ire==2) write(iy,'(/'' ---> Insert a correct number. '', &
& a36/)')com
if (ire==3) write(iy,'(/'' ----> number too large '', &
& ''(max.'',f6.2,'').''/)') dm
end subroutine
2970
subroutine konst(ik,kon)
!-----Automatische Erkennung der Planetenkonst. 1 bis 14 --> kon------
! Suchtoleranz (+/-) fuer Konst.: 53 Tage, fuer "->": 880 Tage
use base, only : akon
2975 implicit double precision (a-h,o-z)
character(2) :: kon,tkon(14)
data tkon/' 1',' 2',' 3',' 4',' 5',' 6',' 7', &
' 8',' 9','10','11','12','13','14'/
ye = 10.d0; kon = ' '
2980 ep = 0.6d0
ako = dfloat(ik)
do i=1,14
a1 = dabs(ako-akon(i))
a2 = dabs(ako-(akon(i)-1.d0))
2985 if (a1<ye.or.a2<ye) kon = '->'
if (a1<ep.or.a2<ep) kon = tkon(i)
enddo
end subroutine
Datei: ~/home/p5/p5.f95 Seite 50 von 110
2990 subroutine ephim(i,iaph,ipla,ical,ak,iak,day,year,delt)
!-----Julian Ephemeris Day and Year (Merkur im Aphel)-----------------
! Input ist "ak" (Nummer des Apheldurchgangs), "day" oder "year".
! i = 0: ak --> day, year, delt
! i = 1: day --> ak, iak, year, delt
2995 ! i = 2: year --> day, ak, iak
implicit double precision (a-h,o-z)
if (i==0) call akday(0,iaph,ipla,ak,iak,day)
! . . Neue Werte (Buch 2)
3000 ! Diese Zahlen verbessern nur die Genauigkeit der dezimalen
! Jahreszahl auf +/- 0,5 Tage im Vergleich zum Datum, aendern
! jedoch nichts an den bisherigen astronomischen Berechnungen
! und Datumsberechnungen. Alle durch 400 teilbaren Jahreszahlen,
! wie z.B. -1200.0 oder 2000.0, entsprechen jetzt exakt dem
3005 ! 1. Januar, 12 Uhr. Das heisst, das dezimale Jahr 2000.0 be-
! deutet die Standard-Epoche J2000.0.
if (ical==2 .and.((i<=1 .and.day>=0.d0 .and.day<2299160.5d0) &
.or.(i==2 .and.year>=-4712.d0 .and.year<1582.7854097d0))) then
A = 365.25d0; B = 0.d0; C =-4712.d0 ! (Julian. Kal.)
3010 else
A = 365.2425d0; B = 2451545.d0; C = 2000.d0 ! (Gregor. Kal.)
endif
! . . Vorherige Werte (Buch 1)
!c A = 365.248d0; B = 0.d0; C = -4711.9986d0 ! (Programm P3)
3015
! . . Umrechnung der Daten
if (i<=1) year = (day - B)/A + C
if (i==1) call akday(1,iaph,ipla,ak,iak,day)
if (i<=1) then
3020 aik = dnint(ak); call akday(0,iaph,ipla,aik,iak,aiday)
delt = day - aiday
else
day = A * (year - C) + B; call akday(1,iaph,ipla,ak,iak,day)
endif
3025 end subroutine
subroutine akday(j,iaph,ipla,ak,iak,day)
!-----Julian Ephemeris Day--------------------------------------------
! j = 0: ak --> day
3030 ! j = 1: day --> ak,iak
! ymer = Umlaufzeit des Merkur in Tagen
use base, only : pmer,ymer
implicit double precision (a-h,o-z)
if (j==0) then
3035 aak = ak
if (iaph==1 .or.iaph==3 .or.(iaph==5 .and.ipla==1)) &
aak = aak - 0.5d0
day = pmer + ymer * aak
endif
3040 if (j==1) then
ak = (day - pmer)/ymer
if (iaph==1 .or.iaph==3 .or.(iaph==5 .and.ipla==1)) &
ak = ak + 0.5d0
iak = idnint(ak)
3045 endif
! . . Apheldurchgang der Erde
!c day = 2451547.507d0 + 365.2596358d0 * (ak + 0.5d0) &
!c + 1.58d-8 * (ak + 0.5d0)**2
end subroutine
3050
Datei: ~/home/p5/p5.f95 Seite 51 von 110
subroutine delta_T(zjd)
!-----Umrechnung: Terrestrial Time --> Universal Time-----------------
! Gleichungen von Fred Espenak und Jean Meeus, entwickelt auf Ba-
! sis des "Five Millennium Canon of Solar Eclipses", nach Artikeln
3055 ! von Morrison/Stephenson (2004) und Stephenson/Houlden (1986).
! (NASA Eclipse Web Site, Polynom. expressions for DELTA-T, 2005)
! DELTA-T (del) in Sekunden.
implicit double precision (a-h,o-z)
call ephim(1,1,1,1,ak,iak,zjd,y,delt)
3060 if (y>-500.d0 .and.y<=500.d0) then
u = y/100.d0
del = 10583.6d0 - 1014.41d0 * u + 33.78311d0 * u**2 &
- 5.952053d0 * u**3 - 0.1798452d0 * u**4 &
+ 0.022174192d0 * u**5 + 0.0090316521d0 * u**6
3065 elseif (y>500.d0 .and.y<=1600.d0) then
u = (y-1000.d0)/100.d0
del = 1574.2d0 - 556.01d0 * u + 71.23472d0 * u**2 &
+ 0.319781d0 * u**3 - 0.8503463d0 * u**4 &
- 0.005050998d0 * u**5 + 0.0083572073d0 * u**6
3070 elseif (y>1600.d0 .and.y<=1700.d0) then
t = y - 1600.d0
del = 120.d0 - 0.9808d0 * t - 0.01532d0 * t**2 &
+ t**3 / 7129.d0
elseif (y>1700.d0 .and.y<=1800.d0) then
3075 t = y - 1700.d0
del = 8.83d0 + 0.1603d0 * t - 0.0059285d0 * t**2 &
+ 0.00013336d0 * t**3 - t**4 / 1174000.d0
elseif (y>1800.d0 .and.y<=1860.d0) then
t = y - 1800.d0
3080 del = 13.72d0 - 0.332447d0 * t + 0.0068612d0 * t**2 &
+ 0.0041116d0 * t**3 - 0.00037436d0 * t**4 &
+ 0.0000121272d0 * t**5 - 0.0000001699d0 * t**6 &
+ 0.000000000875d0 * t**7
elseif (y>1860.d0 .and.y<=1900.d0) then
3085 t = y - 1860.d0
del = 7.62d0 + 0.5737d0 * t - 0.251754d0 * t**2 &
+ 0.01680668d0 * t**3 - 0.0004473624d0 * t**4 &
+ t**5/233174.d0
elseif (y>1900.d0 .and.y<=1920.d0) then
3090 t = y - 1900.d0
del = -2.79d0 + 1.494119d0 * t - 0.0598939d0 * t**2 &
+ 0.0061966d0 * t**3 - 0.000197d0 * t**4
elseif (y>1920.d0 .and.y<=1941.d0) then
t = y - 1920.d0
3095 del = 21.20d0 + 0.84493d0 * t - 0.076100d0 * t**2 &
+ 0.0020936d0 * t**3
elseif (y>1941.d0 .and.y<=1961.d0) then
t = y - 1950.d0
del = 29.07d0 + 0.407d0 * t - t**2/233.d0 + t**3/2547.d0
3100 elseif (y>1961.d0 .and.y<=1986.d0) then
t = y - 1975.d0
del = 45.45d0 + 1.067d0 * t - t**2/260.d0 - t**3/718.d0
elseif (y>1986.d0 .and.y<=2005.d0) then
t = y - 2000.d0
3105 del = 63.86d0 + 0.3345d0 * t - 0.060374d0 * t**2 &
+ 0.0017275d0 * t**3 + 0.000651814d0 * t**4 &
+ 0.00002373599d0 * t**5
elseif (y>2005.d0 .and.y<=2050.d0) then
t = y - 2000.d0
3110 del = 62.92d0 + 0.32217d0 * t + 0.005589d0 * t**2
elseif (y>2050.d0 .and.y<=2150.d0) then
Datei: ~/home/p5/p5.f95 Seite 52 von 110
del = -20.d0 + 32.d0 * ((y-1820.d0)/100.d0)**2 &
- 0.5628d0 * (2150.d0 - y)
else
3115 u = (y - 1820.d0)/100.d0; del = -20.d0 + 32.d0 * u**2
endif
! Spaetere Korrektur (NASA Eclipse Web Site):
if (y<1955.d0 .or.y>2005.d0) del = del-1.2932d-5*(y-1955.d0)**2
zjd = zjd - del/86400.d0
3120
! . . Alternativ: Jean Meeus, "Transits", S. 73, der wiederum fol-
! gende Referenz zitiert: L.V. Morrison, F.R. Stephenson, Sun
! and Planetary System, Vol. 96, Reidel, Dordrecht, 1982, S. 73
!c zjd = zjd - ((zjd-2382148.d0)**2/41048480.d0 - 15.d0)/86400.d0
3125 end subroutine
subroutine jdedate(zjd,ical,ida,da,dmo)
!-----Umrechnung Julian Day --> Kalenderdatum + Uhrzeit (TT)----------
! Basierend auf einem Algorithmus aus "Astronomical Algorithms"
3130 ! von Jean Meeus (S. 63). Copyright: 1991, Willmann-Bell,
! Anmerkung: Der Algorithmus wurde geringfuegig modifiziert
! (Ersetzung der Integer- durch die Floor-Funktion), so dass
! er jetzt fuer beide Kalender auch fuer JDE < 0 gilt.
! Indizes:
3135 ! 1: dez.Tag, 2: Mon., 3: Jahr, 4: Std, 5: Min, 6: Sek, 7: int.Tag
implicit double precision (A-H,O-Z)
dimension :: ida(7),da(7)
character(5) :: monat(12),dmo
data monat/' Jan.',' Feb.',' Mar.',' Apr.',' May ',' June', &
3140 ' July',' Aug.',' Sep.',' Oct.',' Nov.',' Dec.'/
Z = sdint(zjd + 0.5d0); F = zjd + 0.5d0 - Z
if (z>=0.d0 .and.Z<2299161.d0 .and.ical==2) then
A = Z
else
3145 alpha = sdint((Z - 1867216.25d0)/36524.25)
A = Z + 1.d0 + alpha - sdint(alpha*0.25d0)
endif
B = A + 1524.d0
C = sdint((B - 122.1d0)/365.25d0)
3150 D = sdint(365.25d0 * C)
E = sdint((B - D)/30.6001d0)
da(1) = B - D - sdint(30.6001d0*E) + F + 5.d-9
if (E<14.d0) then
da(2) = E - 1.d0
3155 else
if (E==14.d0 .or.E==15.d0) then
da(2) = E - 13.d0
else
da(2) = 999.d0
3160 endif
endif
M = idnint(da(2))
if (M>2) then
da(3) = C - 4716.d0
3165 else
if (M==1 .or.M==2) then
da(3) = C - 4715.d0
else
da(3) = 9999999999999.d0
3170 endif
endif
st = da(1) - sdint(da(1)); dst = st*24.D0
Datei: ~/home/p5/p5.f95 Seite 53 von 110
da(4) = sdint(dst)
da(5) = (dst - sdint(dst))*60.D0
3175 da(6) = (da(5) - sdint(da(5)))*60.D0
da(7) = sdint(da(1)) ! day
ida(3) = idnint(da(3)) ! year
ida(4) = idnint(da(4)) ! hours
ida(5) = idnint(da(5)-0.5d0+1.d-10) ! minutes
3180 ida(6) = idnint(da(6)) ! seconds
imo = idnint(da(2)) ! month
! Geringfuegige Korrektur der Darstellung
! (Beispiel: Uhrzeit 13:44:60 wird zu 13:45:00)
3185 do i=6,5,-1
if (ida(i)>=60) then
ida(i) = ida(i) - 60
ida(i-1) = ida(i-1) + 1
endif
3190 enddo
if (ida(4)>=24) then
ida(4) = ida(4) - 24
da(1) = da(1) + 1.d0
da(7) = sdint(da(1))
3195 endif
! (Beispiel: 31. Mai, 23:59:60 wird zu 1. Juni, 0:0:0.)
if ((dabs(da(7)-32.d0)<=1.d-8.and.(imo==1.or.imo==3 &
.or.imo==5.or.imo==7.or.imo==8.or.imo==10.or.imo==12)).or. &
(dabs(da(7)-31.d0)<=1.d-8.and.(imo==4.or.imo==6.or.imo==9 &
3200 .or.imo==11)).or.(dabs(da(7)-30.d0)<=1.d-8.and.imo==2)) then
do k=30,32
q = dfloat(k); if (dabs(da(7)-q)<=1.d-8) da(1)=da(1)+1.d0-q
enddo
da(7) = sdint(da(1)); imo = imo + 1
3205 if (imo==13) then
imo = 1
da(3) = da(3) + 1.d0
ida(3) = idnint(da(3))
endif
3210 endif
dmo = monat(imo)
end subroutine
double precision function sdint(x)
3215 !-----Floor function--------------------------------------------------
! replacing some integer-functions in the subroutine "jdedate"
! in order to expand the domain of definition for JDE < 0
real(8) :: x
sdint = dint(x)
3220 if (x<0.d0 .and.dmod(x,1.d0)/=0.d0) sdint = sdint - 1.d0
end function
subroutine weekday(ZJD,wd)
!-----Berechnung des Wochentages--------------------------------------
3225 real(8) :: ZJD,ZJS
character(10) :: wday(0:6),wd
data wday/' Sunday',' Monday',' Tuesday',' Wednesday', &
' Thursday',' Friday',' Saturday'/
ZJS = ZJD + 700000001.5d0
3230 if (ZJS<0.d0 .and.dmod(ZJS,1.d0)/=0.d0) ZJS = ZJS - 1.d0
wd = wday(idnint(dmod(dint(ZJS),7.d0)))
end subroutine
Datei: ~/home/p5/p5.f95 Seite 54 von 110
subroutine vsop1(l,tau,resu)
3235 !-----Berechnung der ekliptikalen Koordinaten (VSOP87D-Kurzversion)---
use base, only : gdpi,z0,lmax,jp
use astro, only : par1
implicit double precision (a-h,o-z)
resu = z0
3240 do j=1,lmax(l)
sum0 = z0
do i=1,jp(l,j)
sum0 = sum0 + par1(1,i,j,l) * &
dcos(par1(2,i,j,l) + par1(3,i,j,l)*tau)
3245 enddo
resu = resu + sum0*tau**(j-1)
enddo
resu = resu * 1.d-8
if (l==1 .or.l==4 .or.l==7 .or.l==10) call reduz(resu,1,1)
3250 if (l/=3 .and.l/=6 .and.l/=9 .and.l/=12) resu = resu*gdpi
end subroutine
subroutine vsop2(zjde,ivers,ibody,md,ix,prec,lu,r,ierr,rku)
!-----Aufruf der VSOP-Subroutine (VSOP87A/C-Vollversionen)------------
3255 ! (Index von rku 1: L, 2: B, 3: r)
implicit double precision (a-h,o-z)
dimension :: r(6),rku(3),md(0:9)
character(11) :: afile(9),cfile(8)
data afile/'VSOP87A.mer','VSOP87A.ven','VSOP87A.ear', &
3260 'VSOP87A.mar','VSOP87A.jup','VSOP87A.sat', &
'VSOP87A.ura','VSOP87A.nep','VSOP87A.emb'/
data cfile/'VSOP87C.mer','VSOP87C.ven','VSOP87C.ear', &
'VSOP87C.mar','VSOP87C.jup','VSOP87C.sat', &
'VSOP87C.ura','VSOP87C.nep'/
3265 if (md(ibody)==1) then
if (ivers==1) open(unit=10,file=afile(ibody))
if (ivers==3) open(unit=10,file=cfile(ibody))
endif
call VSOP87Z(zjde,ivers,ibody,prec,lu,r,ierr,md)
3270 if (md(ibody)==1) close(10)
call kugelko(r(1),r(2),r(3),rku)
!c write(6,'(/'' x, y, z = '',3f14.10)') (r(i),i=1,3)
!c write(6,'( '' vx,vy,vz = '',3f14.10)') (r(i),i=4,6)
!c write(6,'( '' L, B, r = '',3f14.10)') (rku(i),i=1,3)
3275 do iu=ix,6,5
if (ierr/=0) write(iu,'('' In VSOP87Z: ierr = '',i2)')ierr
enddo
end subroutine
3280 subroutine vsop3(l,k,ix,ke,time,res)
!-----Bahn-Elemente, abgeleitet aus VSOP82 (nach Meeus)---------------
! fuer J2000.0 und Ekliptik der Epoche; Berechnung der wahren
! Anomalie (ekliptikale Laenge) mit der Keplerschen Gleichung.
! (Index von res 1: L, 2: a, 3: e, 4: i, 5: Omega, 6: pi, 7: M,
3285 ! 8: omega, 9: E, 10: nue, 11: eklipt. Laenge)
use base, only : pidg,gdpi
use astro, only : par3
implicit double precision (a-h,o-z)
dimension :: res(12)
3290 u360 = 360.d0; ke = 0; eps = 1.d-13
do j=1,6
resu = 0.d0
do i=1,4
resu = resu + par3(i,j,k,l)*time**(i-1)
Datei: ~/home/p5/p5.f95 Seite 55 von 110
3295 if (j==1 .or.j>=5) call reduz(resu,0,1)
res(j) = resu
enddo
enddo
res(7) = res(1) - res(6)
3300 if (res(7)<0.d0) res(7) = res(7) + u360
res(8) = res(6) - res(5)
if (res(8)<0.d0) res(8) = res(8) + u360
! . . Loesung der Keplerschen Gleichung (Resultat: zen)
3305 ii = 0; E = res(3); zm = res(7)*pidg; ze = zm
itmax = 100 ! Maximalzahl der Iterationen
meth = 1! Drei iterative Methoden zur Auswahl (meth = 1..3)
if (meth<3) then
3310 do
if (meth==1) then
! 1. Verfahren von Newton-Raphson (schnellste Methode)
zen = ze + (zm + E*dsin(ze) - ze)/(1.d0 - E*dcos(ze))
else
3315 ! 2. Fixpunktverfahren (Keplersche Gleichung)
zen = zm + E*dsin(ze)
endif
if (dabs(zen-ze)<eps) exit
if (ii>itmax) then; ke = 2; go to 20; endif
3320 ii = ii+1; ze = zen
enddo
else
! 3. Sekantenverfahren (verwendet Sekantensteigung)
ke = 1; ze2 = zm
3325 10 fze2 = zm + E*dsin(ze2) - ze2
call sekante(ze1,ze2,fze1,fze2,eps,0.1d0,ii,itmax,ix,ke)
if (ke==1) go to 10
if (ke==2) go to 20 ! ("Ringfit" hat hier keinen Zeitvorteil
zen = ze2 ! gegenueber "sekante", da die Keplersche
3330 endif ! Gleichung weniger Rechenzeit benoetigt
go to 30 ! als "Ringfit" selbst.)
! . . zu viele Iterationen
20 do iu=ix,6,5
3335 write(iu,'(/'' ----> error in "vsop3" '', &
& ''(Keplers equation), ke ='',I2/)') ke
enddo; return
30 res(9) = zen*gdpi; if (res(9)<0.d0) res(9) = res(9) + u360
3340 ! . . Berechnung der wahren Anomalie
res(10) = 2.d0 * datan(dsqrt((1.d0 + E)/(1.d0 - E)) &
* dtan(zen*0.5d0))*gdpi
if (res(10)<0.d0) res(10) = res(10) + u360
res(11) = res(10) + res(6)
3345 if (res(11)>u360) res(11) = res(11) - u360
end subroutine
subroutine transit(ip,ikomb,imod,ipla,ilin,iap,ivers,isep, &
ical,iuniv,tr,sepmin,itt,sep,zjde,id5,da5,dmo5,zjahr, &
3350 rk,md,ddx1,ddx2,dfd,test,itin,is,ires,ix,pan,sd,sl,iop0,inum)
!-----Ueberpruefung der Transite von Merkur bzw. Venus----------------
! Die berechneten Zeitpunkte sind optional dieselbe ekliptikale
! Laenge bei Erde und Merkur bzw. Venus, die minimale Separation
! oder die genauen Phasen. "M" bedeutet "normaler", "C" (geozen-
3355 ! trischer) zentr. Transit des Merkurs und "m"/"c", dass irgend-
Datei: ~/home/p5/p5.f95 Seite 56 von 110
! wo auf der Erde der Transit partiell/zentral erscheint. Analog
! stehen "V" und "v" fuer die Venus. Das Minuszeichen "-" bedeu-
! tet, dass der Planet die Sonne knapp verfehlt und dass der
! dichteste Abstand der "sichtbaren" Scheiben (Sonnen- und Plane-
3360 ! tenrand) nicht mehr als etwa 1 Prozent des scheinbaren Sonnen-
! radius' betraegt (verwendet nur bei Syzygy-Berechnungen). Die
! Planetenscheibe ist in diesem Fall natuerlich nicht sichtbar.
! Index (ip): 1 = Merkur, 2 = Venus
use base
3365 implicit double precision (a-h,o-z)
dimension :: zi(2),sd(2),tcorr(2),rem(78)
dimension :: ida(7),da(7),id5(5,7),da5(5,7),pan(5)
dimension :: r(6),rku(3),rk(12),md(0:9),inum(0:4)
dimension :: xx(5),yy(5),xk(2),yk(2),test(10)
3370 character(5) :: dmo,dmo5(5)
character(1) :: tr,tp(8),sl
data tp/'M','m','V','v','-',' ','C','c'/
data blim/0.d0/,shift/0.d0/,xj3/0.d0/,yy3/0.d0/ ! pre-init.
data ba/0.d0/,del/0.d0/ ! pre-init.
3375
! . . Einige Konstanten
T = (zjde-zjd0)/tcen
! Axel D. Wittmann: we = Schiefe der Ekliptik der Epoche
we = (23.4458042d0 - 0.856033d0 * &
3380 dsin(0.015306d0 * (T + 0.50747d0))) * pidg
zi(1) = re(35); zi(2) = re(41)
wfact = 3600.d0*gdpi; eps = 2.d-7
! (Der folgende Korrekturfaktor "tcorr" zur Berechnung
! der minimalen Separation ist nur eine Abschaetzung.)
3385 do j=1,2; tcorr(j) = tsyn(j)/tsid(j); enddo
ee = dsqrt(R3a*R3a-R3p*R3p)/R3a
R3 = R3p/(AE*dsqrt(1.d0-(ee*dsin(we))**2))
a = dasin(R0/(AE*re(9)))
b3 = dasin(R3*re(3*ip)/(re(9)*(re(9)-re(3*ip))))
3390 bp = dasin(Ra(ip)/(AE*(re(9)-re(3*ip))))
bmin1 = a-bp; bmin2 = a-bp-b3
bmax1 = a+bp; bmax2 = a+bp+b3
!.....OPTIONEN 1/ 2: gleiche eklipt. Laenge u. minimale Separation
3395 if (isep==1) then
din = dcos(zi(ip)*pidg*tcorr(ip))
dre = (re(3*ip-1)-re(8))*pidg
ba = din*datan(re(3*ip)*dsin(dre)/(re(9)-re(3*ip)*dcos(dre)))
bap = dabs(ba)
3400 else
bap = sepmin
endif
if (ikomb==1 .and.imod==1) bmax2 = bmax2*1.8d0
bout = bmax2*1.01d0; tr = tp(6)
3405 if (bap<=bmin2) tr = tp(2*ip-1)
if (bap>bmin2.and.bap<=bmax2) tr = tp(2*ip)
if (bap>bmax2.and.bap<=bout.and.ilin>=3) tr = tp(5)
if (isep<=2 .and.ilin<=2) then
if (bap<=bp+b3) tr = tp(8)
3410 if (bap<=bp) tr = tp(7)
endif
!c do iu=ix,6,5; write(iu,'(a15,a18,i3,5f8.5)')'ip,bmin2,bmin1,', &
!c 'bmax1,bmax2,bap = ',ip,bmin2,bmin1,bmax1,bmax2,bap; enddo
3415 ! . . Min. Separation (sep) zw. Sonne und Planet in Bogensekunden.
! "Plus/minus" bedeutet noerdlich/suedlich des Sonnenzentrums.
Datei: ~/home/p5/p5.f95 Seite 57 von 110
if (isep==1) then
sep = ba*wfact
else
3420 sep = bap*wfact; if (re(3*ip-1)<0.d0) sep = -sep
endif
if (isep<=2) then
if (tr==' '.or.ilin>=3) return; go to 60
endif
3425
!.....OPTIONEN 3/ 4: Transitphasen ohne/mit Positionswinkeln
! (Beginn, Ende und minimale Separation des geozentrischen Tran-
! sits => Ein, drei oder fuenf Zeitpunkte werden berechnet.)
if (bap>bmax2*1.005d0 .or.(ikomb==1 .and.imod==1)) then
3430 itt = 0; return
endif
! . . Weitere Parameter festlegen
prec = z0; lu = 10; itr = 1
3435 do j=1,78; rem(j) = re(j); enddo
do j=1,5
do k=1,7; id5(j,k) = 0; da5(j,k) = z0; enddo
enddo
xj2 = zjde
3440
! . . Mitte des Transits, minimale Separation mit Lichtlaufzeit
if (itr==1) then
idr = 3; ke = 1; indx = 1
step = 5.d-2; iflag = 0
3445 ddx1 = dfd + 1.d0; nu = 0
if (ilin<=2) ddx1 = 1; ddx2 = ddx1
xx(1) = xj2; itin = 0; iex = 0
do j=1,10; test(j) = z0; enddo
! Mittlere Laufzeit des Lichtes, optimierter Startwert [Tage]
3450 if (ip==1) del = 320.d0/86400.d0 ! Merkur
if (ip==2) del = 150.d0/86400.d0 ! Venus
if (imod==1) then; ept=3.d-14; else; ept=2.d-9; endif
! VSOP87-Berechnung mit Beruecksichtigung der Lichtlaufzeit
3455 10 if (imod==1) then
call vsop1tr(ip,rk,(xj2-zjd0-del)/tmil,del,r3i,ept,inum,resu)
else
call vsop2tr(xj2-del,ivers,ip,md,ix,prec,lu,r,rk, &
ierr,del,r3i,ept,inum,rku)
3460 endif
if (iex==1) go to 20
! Bestimmung: auf- bzw. absteigender Knoten
if (nu==1 .or.nu==2) then
xk(nu) = xj2; yk(nu) = re(3*ip-1)
3465 endif
if (nu==2) then
sl = '/'; if ((yk(2)-yk(1))/(xk(2)-xk(1))<0.d0) sl = ' '
endif
! Ende Knotenbestimmung
3470 call sepa(ip,2,rk,sep0i); yy(indx) = sep0i
epv = 1.d-6; if (sep0i<30.d0) epv = 1.d-7
call fitmin(imod,2,iap,ke,xx,yy,epv,step,nu,iflag, &
ddx1,ddx2,test,itin,indx,ix)
xj2 = xx(indx)
3475 if (ke==0 .and.isep==4 .and.iex==0) then
iex = 1; go to 10
endif
Datei: ~/home/p5/p5.f95 Seite 58 von 110
if (ke==1) go to 10
3480 ! Art des (streifenden) Transits
20 if (sep0i<=bmin2) then; tr=tp(2*ip-1); itt=3; endif
if (sep0i>bmin2.and.sep0i<=bmin1) itt=3
if (sep0i>bmin1.and.sep0i<=bmax1) itt=2
if (sep0i>bmax1.and.sep0i<=bmax2) itt=1
3485 if (sep0i>bmax2) then; itt = 0; return; endif
if (sep0i>bmin2.and.sep0i<=bmax2) then
inum(3) = inum(3) + 1
tr=tp(2*ip)
endif
3490 sep = sep0i*wfact
if (re(3*ip-1)<0.d0) sep = -sep
xjdt = xj2
zjde = xj2
if (iuniv==2) call delta_T(xjdt)
3495 call jdedate(xjdt,ical,ida,da,dmo)
call ephim(1,iaph,ipla,ical,ak,iak,zjde,zjahr,delt)
! Berechnung des Positionswinkels (minimale Separation)
if (isep==4) call pos_angle(ip,zjde,rk,ang)
3500
! Radien (semidiameter) von Sonne und Merkur/Venus
if (isep>=3 .and.ilin<=2) then
sd(1) = dasin(R0/(AE*re(9))) * wfact
sd(2) = dasin(Ra(ip)/(AE*r3i)) * wfact
3505 ! Kennzeichnung des zentralen Transits
csep = (r3*re(3*ip)/re(9)+Ra(ip)/AE)*wfact/(re(9)-re(3*ip))
if (dabs(sep)<csep) then
tr = tp(8)
if (dabs(sep)<sd(2)) tr = tp(7)
3510 inum(4) = inum(4) + 1
endif
! Mit der zeitlichen Verschiebung "shift" (in julian. Tagen)
! wird der spaeter folgende Startpunkt fuer "ringfit" bzw.
! "sekante" moeglichst nahe an die Nullstelle verlegt.
3515 wu = 1.d0-(sep/sd(1))**2
if (wu<1.d-2) wu = 1.d-2
if (ip==1) shift = 0.115d0 * dsqrt(wu)
if (ip==2) shift = 0.17d0 * dsqrt(wu)
endif
3520 endif
if (itr==1) then
if (itt==1) itr = 6
go to 50
3525 endif
! . . Vorbereitung zur naechsten Berechnung im selben Transit
30 iis = 0; ke = 1
itr = itr + 1
3530 ! Kontaktpunkt I
if (itr==2) then
idr = 1; blim = bmax1
xj2 = zjde - shift
endif
3535 ! Kontaktpunkt II
if (itr==3) then
if (itt==2) itr = 5
idr = 2; blim = bmin1
Datei: ~/home/p5/p5.f95 Seite 59 von 110
xj2 = zjde - shift
3540 endif
! Kontaktpunkt III
if (itr==4) then
idr = 4; blim = bmin1
xj2 = zjde + shift
3545 endif
! Kontaktpunkt IV
if (itr==5) then
idr = 5; blim = bmax1
xj2 = zjde + shift
3550 endif
! . . Berechnung der Kontaktzeiten I bis IV
if (imod==1) then; ept=1.d-12; else; ept=2.d-7; endif
40 tau = (xj2 - zjd0)/tmil
3555 ! VSOP87D Kurzversion (imod=1), VSOP87C Vollversion (imod=2)
if (imod==1) then
call vsop1tr(ip,rk,tau,del,r3i,ept,inum,resu)
else
call vsop2tr(xj2,ivers,ip,md,ix,prec, &
3560 lu,r,rk,ierr,del,r3i,ept,inum,rku)
endif
! "Sekante" wurde durch das etwas schnellere "ringfit" ersetzt.
call sepa(ip,2,rk,sep0i)
yy2 = sep0i-blim
3565 call ringfit(xj1,xj2,xj3,yy1,yy2,yy3,eps,1.d-3,iis,25,ix,ke)
if (ke==1 .or.ke==5) go to 40
if (ke==2) go to 60
xjdt = xj2 + del
if (iuniv==2) call delta_T(xjdt)
3570 call jdedate(xjdt,ical,ida,da,dmo)
! . . Berechnung des Positionswinkels (Planet am Sonnenrand)
if (isep==4 .and.itr/=1) call pos_angle(ip,xj2,rk,ang)
3575 ! . . Ruecksprung
50 do k=1,7; id5(idr,k) = ida(k); da5(idr,k) = da(k); enddo
dmo5(idr) = dmo; pan(idr) = ang
if (itr<=4) go to 30
do j=1,78; re(j) = rem(j); enddo
3580
!.....Berechnung der Transitserie
60 if (ikomb==0 .or.(ikomb==1 .and.imod==2)) &
call tserie(ip,zjde,is,iop0,ires)
end subroutine
3585
subroutine sepa(ip,iv,rk,sep0i)
!-----Berechnung der Separation Sonne-Merkur bzw. Sonne-Venus---------
! Index ip: 1 = Merkur, 2 = Venus
use base, only : pidg,re
3590 implicit double precision (a-h,o-z)
dimension :: rk(12),rd(3)
if (iv==1) then
! . . . 1. Variante - raeumliche Geometrie (Testvariante)
cos0i = dsin(re(3*ip-1)*pidg) * dsin(re(8)*pidg) + &
3595 dcos(re(3*ip-1)*pidg) * dcos(re(8)*pidg) * &
dcos((re(3*ip-2)-re(7))*pidg)
sep0i = datan(re(3*ip)*dsqrt(1.d0-cos0i*cos0i)/ &
(re(9)-re(3*ip)*cos0i))
else
Datei: ~/home/p5/p5.f95 Seite 60 von 110
3600 ! . . . 2. Variante - Vektoranalysis
do j=1,3; rd(j) = rk(3*(ip-1)+j) - rk(6+j); enddo
ab = -rk(7)*rd(1)-rk(8)*rd(2)-rk(9)*rd(3)
a = dsqrt(rk(7)**2 + rk(8)**2 + rk(9)**2)
b = dsqrt(rd(1)**2 + rd(2)**2 + rd(3)**2)
3605 sep0i = dacos(ab/(a*b))
endif
end subroutine
subroutine pos_angle(ip,xjd,rk,ang)
3610 !-----Positionswinkel des Planeten fuer beliebigen Transit in Bezug
! auf die Richtung zum Himmelsnordpol (y-Achse auf Sonnenscheibe),
! vergleiche scheinbare Bewegungsrichtung der Sonne.
! ip : 1 fuer Merkur, 2 fuer Venus
! xjd : Zeitpunkt der Ankunft des Lichtes auf der Erde
3615 ! rk(1..9) : rechtwinklige heliozentrische Koordinaten
! von Merkur, Venus und Erde (VSOP87C)
! eeps : Stellung Erdachse gegen Ekliptik in jener Epoche
! rgeo(1..9): transformierte geozentrische Koordinaten von Sonne,
! Merkur und Venus (rechtwinklig, dann sphaerisch)
3620 ! ang : Positionswinkel des Planeten vor der Sonne
use base, only : pidg,gdpi,zjd0,tcen
implicit double precision (a-h,o-z)
dimension :: rk(12),rgeo(9),rku(3),xx(3)
do i=1,9; rgeo(i) = rk(i); enddo
3625
!.....Die Berechnung des Positionswinkels erfolgt in 4 Schritten.
! Schritte 1-3: Koordinatentransformation helio- zu geozentrisch.
! 1. Rotation um x-Achse um Winkel der Schiefe der Ekliptik (Epoche);
3630 ! Axel D. Wittmann: "On the variation of the obliquity of the
! ecliptic", Univ.-Sternwarte Goettingen, 1984, MitAG 62, S.203
T = (xjd-zjd0)/tcen
eeps = (23.4458042d0 - 0.856033d0 * &
dsin(0.015306d0 * (T + 0.50747d0))) * pidg
3635 call rotmat(1,-eeps,0.d0,0.d0,rgeo)
! 2. Translation des heliozentrischen Koordinatenursprungs von der
! Sonne zur Erde. Das ergibt neue Koordinaten fuer Sonne und
! Merkur bzw. Venus.
3640 do i=1,3
xx(i) = -rgeo(6+i); rgeo(6+i) = rgeo(3+i)
rgeo(3+i) = rgeo(i); rgeo(i) = 0.d0
enddo
call translat(xx(1),xx(2),xx(3),rgeo)
3645
! 3. Umrechnung in sphaerische Koordinaten
! (Positionen von Sonne, Merkur und Venus)
do i=0,6,3
call kugelko(rgeo(i+1),rgeo(i+2),rgeo(i+3),rku)
3650 do j=1,3; rgeo(i+j) = rku(j); enddo
enddo
! 4. Berechnung des Positionswinkels nach Andre Danjon: "Astronomie
! Generale", S.36, Gl."3 bis". Siehe auch Jean Meeus: "Transits",
3655 ! S.15 ("kartesische" Koordinaten x und y in Bogensekunden).
sdec = rgeo(2) * pidg
dra = (rgeo(3*ip+1)-rgeo(1)) * pidg
ddec = (rgeo(3*ip+2)-rgeo(2)) * pidg
tdra = dsin(sdec) * dtan(dra) * dtan(dra*0.5d0)
3660 zk = 206264.8062d0/(1.d0 + dsin(sdec) * tdra)
Datei: ~/home/p5/p5.f95 Seite 61 von 110
x = -zk * (1.d0 - dtan(sdec)*dsin(ddec)) * dcos(sdec)*dtan(dra)
y = zk * (dsin(ddec) + dcos(sdec) * tdra)
ang = datan(-x/y)*gdpi
if (y*dcos(ang*pidg)<0.d0) ang = ang + 180.d0
3665 call reduz(ang,0,1)
end subroutine
subroutine tserie(ip,zjde,is,iop0,ires)
!-----Bestimmung der Transit-Serie------------------------------------
3670 ! Die Seriennummern entsprechen denen der "NASA Eclipse Web Site".
! (Die Liste der Seriennummern "inserie.t" wird nur einmal verwen-
! det, um die Startnummern, d.h. die Nummern zu bestimmen, die den
! ersten gefundenen Transiten zugeordnet werden. Danach werden al-
! le weiteren Seriennummern unabhaengig von der Liste berechnet.)
3675 ! Index (ip): 1 = Merkur
! 2 = Venus
use astro, only : ser,ase,cc,t13BC,t17AD, &
zstart,ise,ji,jj,isflag,ismax
implicit double precision (a-h,o-z)
3680 if (dabs(zstart-99.99d0)<1.d-10) zstart = zjde
if (iop0/=-804) then
if (zjde<t13BC-365.d0 .or.zjde>t17AD+365.d0) then
ires = 999
return
3685 endif
! . . . Seriennummer (is) fuer Startzeitpunkt suchen
if (isflag==0) then
do j=jj(2*ip-1),jj(2*ip)
3690 if (ser(j,ip)>zjde) then
is = j
isflag = 1
exit
endif
3695 enddo
endif
endif
! . . Aktuelle Seriennummer bestimmen
3700 kflag = 0
do j=is-ji(ip),is
zlim = dmax1(t13BC,zstart)
if (zjde-zlim>cc(ip)+100.d0) then
do k=jj(2*ip-1),is
3705 ise(k) = 1
enddo
endif
a = (zjde-ser(j,ip))/cc(ip)
x = dabs((a-dnint(a))*cc(ip))
3710 b = dabs(zjde-ase(j)-cc(ip))
!c write(6,'(''a,x,b,ise(j),j,is,ismax ='',f9.3,f10.3,f16.6, &
!c & i3,3i5)')a,x,b,ise(j),j,is,ismax
if (x<10.d0 .and.(b<2.d0 .or.ise(j)==0)) then
ires = j
3715 kflag = 1
if (j>ismax) ismax = j
endif
if (j==is.and.kflag==1) go to 20
enddo
3720 if (ismax==-10000 .or.is>ismax) ismax = is - 1
is = ismax + 1
Datei: ~/home/p5/p5.f95 Seite 62 von 110
ismax = is
ser(is,ip) = zjde
ires = is
3725 20 ase(ires) = zjde
ise(ires) = 1
end subroutine
subroutine VSOP87Z(tdj,ivers,ibody,prec,lu,r,ierr,md)
3730 !---------------------------------------------------------------------
! >>
! >> UPGRADE (by H. Jelitto): As proposed by Bretagnon and Francou
! >> for rapidity of computation, the parameters in the VSOP87-files
! >> are read only once at the first call for each planet. The main
3735 ! >> data are copied into the 5-dimensional array "par2" for random
! >> access, covering all planets of one VSOP87-version. For the
! >> calculation of the transit phases (TYMT test), this reduces the
! >> computing time by a factor 20 to 30. Thus, the original subrou-
! >> tine "VSOP87" is extended and renamed as "VSOP87Z."
3740 ! >>
! >> The new VSOP87Z-routine has been checked only for the use of the
! >> theory versions VSOP87A and VSOP87C. Furthermore, the code is
! >> converted to the Fortran 95 standard and the free source form.
! >> The version VSOP87D is applied only in a short form, taken from
3745 ! >> the book "Astronomical Algorithms" of Jean Meeus --> vsop1.
! >>
! >> PARALLEL PROCESSING: To realize parallel processing, the VSOP87-
! >> subroutine is further modified with the application programming
! >> interface (API) "OpenMP." For compilation of P5, we use the com-
3750 ! >> mand: "gfortran -fopenmp -static-libgfortran -O3 -Wall p5.f95."
! >> For single-thread application, use: "gfortran -static -O3 -Wall
! >> p5.f95." VSOP87Z is adapted to any number of threads (including
! >> one). Notice: For the parallelization, the if-statement for com-
! >> parison with the parameter p in the inner do-loop had to be de-
3755 ! >> activated. This statement probably had an advantage in former
! >> times, when the data were read from magnetic tape. However, this
! >> branching is not allowed from an OpenMP structured block.
! >>
! >> The following text belongs to the original VSOP87-subroutine.
3760 ! >> (The quantity "ua" indicates the astronomical unit.)
! >>
!---------------------------------------------------------------------
!
! Reference : Bureau des Longitudes - PBGF9502
3765 !
! Object :
!
! Substitution of time in VSOP87 solution written on a file. The
! file corresponds to a version of VSOP87 theory and to a body.
3770 !
! Input :
!
! tdj julian date (real double precision).
! time scale : dynamical time TDB.
3775 !
! ivers version index (integer).
! 0: VSOP87 (initial solution).
! elliptic coordinates
! dynamical equinox and ecliptic J2000.
3780 ! 1: VSOP87A.
! rectangular coordinates
! heliocentric positions and velocities
Datei: ~/home/p5/p5.f95 Seite 63 von 110
! dynamical equinox and ecliptic J2000.
! 2: VSOP87B.
3785 ! spherical coordinates
! heliocentric positions and velocities
! dynamical equinox and ecliptic J2000.
! 3: VSOP87C.
! rectangular coordinates
3790 ! heliocentric positions and velocities
! dynamical equinox and ecliptic of the date.
! 4: VSOP87D.
! spherical coordinates
! heliocentric positions and velocities
3795 ! dynamical equinox and ecliptic of the date.
! 5: VSOP87E.
! rectangular coordinates
! barycentric positions and velocities
! dynamical equinox and ecliptic J2000.
3800 !
! ibody body index (integer).
! 0: Sun (not used here in VSOP87Z)
! 1: Mercury
! 2: Venus
3805 ! 3: Earth
! 4: Mars
! 5: Jupiter
! 6: Saturn
! 7: Uranus
3810 ! 8: Neptune
! 9: Earth-Moon barycenter
!
! prec relative precision (real double precision).
!
3815 ! if prec is = 0 then the precision is the precision
! p0 of the complete solution VSOP87.
! Mercury p0 = 0.6 10**-8
! Venus p0 = 2.5 10**-8
! Earth p0 = 2.5 10**-8
3820 ! Mars p0 = 10.0 10**-8
! Jupiter p0 = 35.0 10**-8
! Saturn p0 = 70.0 10**-8
! Uranus p0 = 8.0 10**-8
! Neptune p0 = 42.0 10**-8
3825 !
! if prec is not equal to 0, let us say in between p0 and
! 10**-2, the precision is :
! for the positions :
! - prec*a0 ua for the distances.
3830 ! - prec rd for the other variables.
! for the velocities :
! - prec*a0 ua/day for the distances.
! - prec rd/day for the other variables.
! a0 is semi-major axis of the body.
3835 ! Mercury a0 = 0.3871 ua
! Venus a0 = 0.7233 ua
! Earth a0 = 1.0000 ua
! Mars a0 = 1.5237 ua
! Jupiter a0 = 5.2026 ua
3840 ! Saturn a0 = 9.5547 ua
! Uranus a0 = 19.2181 ua
! Neptune a0 = 30.1096 ua
!
Datei: ~/home/p5/p5.f95 Seite 64 von 110
! lu logical unit index of the file (integer).
3845 ! The file corresponds to a version of VSOP87 theory and
! a body, and it must be defined and opened before the
! first call to subroutine VSOP87.
!
! Output :
3850 !
! r(6) array of the results (real double precision).
!
! for elliptic coordinates :
! 1: semi-major axis (ua)
3855 ! 2: mean longitude (rd)
! 3: k = e*cos(pi) (rd)
! 4: h = e*sin(pi) (rd)
! 5: q = sin(i/2)*cos(omega) (rd)
! 6: p = sin(i/2)*sin(omega) (rd)
3860 ! e: eccentricity
! pi: perihelion longitude
! i: inclination
! omega: ascending node longitude
!
3865 ! for rectangular coordinates :
! 1: position x (ua)
! 2: position y (ua)
! 3: position z (ua)
! 4: velocity x (ua/day)
3870 ! 5: velocity y (ua/day)
! 6: velocity z (ua/day)
!
! for spherical coordinates :
! 1: longitude (rd)
3875 ! 2: latitude (rd)
! 3: radius (ua)
! 4: longitude velocity (rd/day)
! 5: latitude velocity (rd/day)
! 6: radius velocity (ua/day)
3880 !
! ierr error index (integer).
! 0: no error.
! 1: file error (check up ivers index).
! 2: file error (check up ibody index).
3885 ! 3: precision error (check up prec parameter).
! 4: reading file error.
!
!---------------------------------------------------------------------
3890 ! --------------------------------
! Declarations and initializations
! --------------------------------
use astro, only : par2,it2,in2,iv2
implicit double precision (a-h,o-z)
3895 character(7) :: bo,body(0:9)
dimension :: r(6),t(-1:5),a0(0:9),md(0:9)
data body/'SUN','MERCURY','VENUS','EARTH','MARS','JUPITER', &
'SATURN','URANUS','NEPTUNE','EMB'/
data a0/0.01d0,0.3871d0,0.7233d0,1.d0,1.5237d0,5.2026d0, &
3900 9.5547d0,19.2181d0,30.1096d0,1.d0/
data dpi/6.2831853071795864769d0/
data t/0.d0,1.d0,5*0.d0/
data t2000/2451545.d0/
data a1000/365250.d0/
Datei: ~/home/p5/p5.f95 Seite 65 von 110
3905 k=0; ierr=3
if (md(ibody)==1) then
ideb=0
do i=1,3; do j=0,5; it2(j,i,ibody) = -1; enddo; enddo
endif
3910 do i=1,6; r(i)=0.d0; enddo
t(1)=(tdj-t2000)/a1000
do i=2,5; t(i)=t(1)*t(i-1); enddo
if (prec<0.d0 .or.prec>1.d-2) return
if (md(ibody)/=1) ierr = 0
3915 !v q=dmax1(3.d0,-dlog10(prec+1.d-50))
! -----------------------------------------------------------
! File reading, for each planet only at first call to VSOP87Z
! -----------------------------------------------------------
3920 if (md(ibody)==1) then
10 read (lu,1001,end=20) iv,bo,ic,it,inn
iv2(ibody) = iv
it2(it,ic,ibody) = 1
in2(it,ic,ibody) = inn
3925 if (ideb==0) then
ideb=1; ierr=1
if (iv/=ivers) return
ierr=2
if (bo/=body(ibody)) return
3930 ierr=0
endif
if (inn==0) go to 10
do n=1,inn
read (lu,1002) (par2(i,n,it,ic,ibody),i=1,3)
3935 enddo
go to 10
20 md(ibody) = 2
endif
3940 ! ------------------------------------
! Computation of planetary coordinates
! ------------------------------------
ic = 1; it = 0
iv = iv2(ibody)
3945 if (iv==0) k=2
if (iv==2 .or.iv==4) k=1
30 inn = in2(it,ic,ibody)
if (inn==0) go to 50
!v p=prec/10.d0/(q-2)/(dabs(t(it))+it*dabs(t(it-1))*1.d-4+1.d-50)
3950 !v if (k==0 .or.(k/=0 .and.ic==5-2*k)) p=p*a0(ibody)
!$omp parallel do reduction(+:r) shared(inn,par2,it,ic,ibody,t) &
!$omp private(n,a,b,c,cu)
do 40 n=1,inn
a = par2(1,n,it,ic,ibody)
3955 b = par2(2,n,it,ic,ibody)
c = par2(3,n,it,ic,ibody)
!v if (dabs(a)<p) go to 50
!v u = b + c*t(1)
cu = dcos(b + c*t(1))
3960 r(ic) = r(ic) + a*cu*t(it)
!v if (iv==0) go to 40
!v su=dsin(u) ! velocity of planet (not used)
!v r(ic+3)=r(ic+3)+t(it-1)*it*a*cu-t(it)*a*c*su
40 enddo
3965 !$omp end parallel do
Datei: ~/home/p5/p5.f95 Seite 66 von 110
50 if (it<=4 .and.it2(it+1,ic,ibody)/=-1) then
it = it + 1
go to 30
else
3970 if (ic<3) then
it = 0
ic = ic + 1
go to 30
endif
3975 endif
if (iv/=0) then
do i=4,6
r(i)=r(i)/a1000
enddo
3980 endif
if (k==0) return
r(k)=dmod(r(k),dpi)
if (r(k)<0.d0) r(k)=r(k)+dpi
return
3985
! -------
! Formats
! -------
1001 format (17x,i1,4x,a7,12x,i1,17x,i1,i7)
3990 1002 format (79x,f18.11,f14.11,f20.11)
end subroutine
subroutine kartko(ison)
!-----Umwandlung in kartesische Koordinaten, re(1..9) --> xyr(1..9)---
3995 ! mit Merkur bei x-Achse
! Indizes von "re" : 1: Lm' 2: Bm 3: rm 4: Lv' 5: Bv
! 6: rv 7: Le' 8: Be 9: re
! Indizes von "xyr": 1: xm 2: ym 3: zm 4: xv 5: yv
! 6: zv 7: xe 8: ye 9: ze 10: leer
4000 use base
implicit double precision (a-h,o-z)
rr = re(1)
if (ison==2) rr = re(4)
if (ison==0) rr = 0.d0
4005 do i=3,9,3
xyr(i-2) = re(i)*dcos(re(i-1)*pidg)*dcos((re(i-2)-rr)*pidg)
xyr(i-1) = re(i)*dcos(re(i-1)*pidg)*dsin((re(i-2)-rr)*pidg)
xyr(i) = re(i)*dsin(re(i-1)*pidg)
enddo
4010 end subroutine
subroutine relpos(ipla,ison,ijd,iek,iekk,ika)
!-----Vergleich der Positionen Pyramiden/Kammern mit Planeten,--------
! daraus Bestimmung der Genauigkeit Fpos bzw. xyr(36) in Prozent
4015 ! und der Polaritaet "iek" bzw. "iekk".
! Weitere Indizes von "xyr":
! 11: xv-xm 12: xe-xm 13: xe-xv 14: yv-ym 15: ye-ym
! 16: ye-yv 17: zv-zm 18: ze-zm 19: ze-zv 20: leer
! 21: v - m 22: e - m 23: e - v 24: q1 25: q2
4020 ! 26: q3 27: alpha' 28: beta' 29: gamma' 30: leer
! 31: x-Son 32: y-Son 33: z-Son 34: delta-s 35: M
! 36: Fpos, F'pos, F"pos
! Indizes 11-19 und 21-29 bei "pyr" und "xyr" entsprechen sich.
use base
4025 implicit double precision (a-h,o-z)
Datei: ~/home/p5/p5.f95 Seite 67 von 110
! . . Pyramidenabstaende
xyr(11) = xyr(4)-xyr(1); xyr(12) = xyr(7)-xyr(1)
xyr(13) = xyr(7)-xyr(4); xyr(14) = xyr(5)-xyr(2)
4030 xyr(15) = xyr(8)-xyr(2); xyr(16) = xyr(8)-xyr(5)
xyr(17) = xyr(6)-xyr(3); xyr(18) = xyr(9)-xyr(3)
xyr(19) = xyr(9)-xyr(6)
ax = xyr(11); ay = xyr(14)
bx = xyr(12); by = xyr(15)
4035 cx = xyr(13); cy = xyr(16)
if (ison==3) then
az = z0; bz = z0
cz = z0
else
4040 az = xyr(17); bz = xyr(18)
cz = xyr(19)
endif
! . . Feststellen der Polaritaet (Blickrichtung auf die Ekliptik)
4045 ! gemaess Vorzeichen der z-Komponente des Vektorproduktes a x c.
if (ijd==15 .or.ijd==0) then
if (iek/=3) iek = 1
if (iek==3) iekk = 1
ez = ax*cy-ay*cx
4050 if ((ipla==1 .and.ez>=z0).or.(ipla==2 .and. &
((ez<z0.and.(ika==1 .or.ika==4 .or.ika==5)).or. &
(ez>=z0.and.(ika==2 .or.ika==3 .or.ika==6))))) then
if (iek/=3) iek = 2
if (iek==3) iekk = 2
4055 endif
endif
! . . Berechnung der rel. Abweichung [%] --> xyr(36)
! Sonnenposition auf Nordsuedachse
4060 if (ison<=2) then
xyr(24) = bx/ax; xyr(25) = by/ay; xyr(26) = by/bx
s = 1.d0
if (iek==3 .and.iekk==2) s = -1.d0
dx1 = (xyr(24) - pyr(24))/pyr(24)
4065 dx2 = (xyr(25) - pyr(25))/pyr(25)
dx3 = (xyr(26)-s*pyr(26))/pyr(26)
xyr(36) = 100.d0 * dsqrt((dx1*dx1 + dx2*dx2 + dx3*dx3)/3.d0)
return
endif
4070
!.....Relative Abweichung, Sonnenposition frei (2- und 3-dimensional)
! Anmerkung: Bei Berechnung von F"pos (Sonnenpos. frei) laesst
! sich statt der Strecken Mykerinos-/Chefren-Pyramide u. Myker.-/
! Cheops-Pyramide auch ein anderes Streckenpaar verwenden, wie
4075 ! z.B. Mykerinos-/Chefren-Pyramide und Chefren-/Cheops-Pyramide.
! F"pos hat dann eventuell etwas andere Werte, aber die Minimie-
! rung von F"pos liefert dieselben Zeitpunkte. Das heisst, die
! wesentlichen Ergebnisse bleiben identisch.
xyr(21) = dsqrt(ax*ax + ay*ay + az*az)
4080 xyr(22) = dsqrt(bx*bx + by*by + bz*bz)
xyr(23) = dsqrt(cx*cx + cy*cy + cz*cz)
xyr(24) = xyr(22)/xyr(21)
!c xyr(25) = xyr(23)/xyr(21)
!c xyr(26) = xyr(23)/xyr(22)
4085 xyr(27) = dacos((ax*bx + ay*by + az*bz)/(xyr(21) * xyr(22)))
!c xyr(28) = dacos((ax*cx + ay*cy + az*cz)/(xyr(21) * xyr(23)))
!c xyr(29) = dacos((bx*cx + by*cy + bz*cz)/(xyr(22) * xyr(23)))
Datei: ~/home/p5/p5.f95 Seite 68 von 110
dx1 = (xyr(24)-pyr(24))/pyr(24)
dx2 = xyr(27)-pyr(27)
4090 xyr(36) = 100.d0 * dsqrt((dx1*dx1 + dx2*dx2)*0.5d0)
end subroutine
subroutine sonpos(ison,iek,ix,xp3,yp3,zp3, &
rcm,dmi,iter,iw,ke,m,n,f,x,e,w,y,z)
4095 !-----Bestimmung von Sonnenposition und Massstab --> xyr(31 - 35)-----
! Indizes von xyr wie in relpos
use base
implicit double precision (a-h,o-z)
dimension :: D(3,3),xsta(n),ysta(m),rcm(3)
4100 dimension :: x(n),e(n),iw(100),f(m),y(m),z(m),w(1000)
!.....Zweidimensionale Berechnung der Sonnenpos. (x- und y-Koord.)
! Projektion der Planetenpositionen in die Ekliptikebene.
! Zusammengehoerige Pyramiden- und Planetenabstaende werden paral-
4105 ! lel ausgerichtet und in der Mitte zur Deckung gebracht. (Wegen
! des gemeinsamen Massstabsfaktors "zmas" haben die entsprechenden
! Strecken leicht unterschiedliche Laengen.)
em = 1.d0
if (iek==2) em = -1.d0
4110 if (ison<=3) then
sax = (xyr(4)+xyr(1)) * .5d0
say = (xyr(5)+xyr(2)) * .5d0
sbx = (xyr(7)+xyr(1)) * .5d0
sby = (xyr(8)+xyr(2)) * .5d0
4115 scx = (xyr(7)+xyr(4)) * .5d0
scy = (xyr(8)+xyr(5)) * .5d0
al1 = - em * pyr(31) - datan(ay/ax) + datan(say/sax)
al2 = - em * pyr(32) - datan(by/bx) + datan(sby/sbx)
al3 = - em * pyr(33) - datan(cy/cx) + datan(scy/scx)
4120 r1 = dsqrt(sax*sax + say*say)
r2 = dsqrt(sbx*sbx + sby*sby)
r3 = dsqrt(scx*scx + scy*scy)
zmas = (pyr(21)/xyr(21) + pyr(22)/xyr(22) + &
pyr(23)/xyr(23))/3.d0
4125 xso1 = - r1 * zmas * dcos(al1) + pyr(34)
xso2 = - r2 * zmas * dcos(al2) + pyr(36)
xso3 = - r3 * zmas * dcos(al3) + pyr(38)
yso1 = - r1 * zmas * dsin(al1) + pyr(35) * em
yso2 = - r2 * zmas * dsin(al2) + pyr(37) * em
4130 yso3 = - r3 * zmas * dsin(al3) + pyr(39) * em
xyr(31) = (xso1 + xso2 + xso3)/3.d0
xyr(32) = (yso1 + yso2 + yso3)/3.d0
if (iek==2) xyr(32) = - xyr(32)
xyr(33) = z0
4135
! . . Fehlerabschaetzung fuer die Sonnenposition
xyr(34) = dsqrt((xyr(31)-rcm(1))**2 + (xyr(32)-rcm(2))**2) &
* xyr(36) * 1.d-2
! . . Massstabsfaktor (nur fuer "Sonne" suedlich der
4140 ! dritten Pyramide, zweidimensional gerechnet.)
xyr(35)=AE*0.25d0*(dabs(xyr(11)/pyr(11))+dabs(xyr(12)/pyr(12))&
+ dabs(xyr(14)/pyr(14))+dabs(xyr(15)/pyr(15)))
endif
4145 !.....Dreidimensionale Berechnung (x-, y- und z-Koordinate)
! Loesung eines linearen inhomogenen Gleichungssystems bzgl. der
! Planetenpositionen und Uebertragung des Ergebnisses auf die
! Pyramidenpositionen.
Datei: ~/home/p5/p5.f95 Seite 69 von 110
! . . Erzeugung eines (schiefwinkligen) Vektordreibeins fuer die Pla-
4150 ! neten (mit Hilfe des Vektorproduktes). Die 3 Vektoren bilden
! dann die Spalten der Koeffizienten-Matrix.
if (ison==4) then
D(1,1) = ax; D(2,1) = ay; D(3,1) = az
D(1,2) = bx; D(2,2) = by; D(3,2) = bz
4155 dx = by*az - ay*bz
dy = ax*bz - bx*az
dz = bx*ay - ax*by
aba = dsqrt(ax*ax + ay*ay + az*az)
abb = dsqrt(bx*bx + by*by + bz*bz)
4160 abd = dsqrt(dx*dx + dy*dy + dz*dz)
dfakt = (aba + abb) * 0.5d0/abd
D(1,3) = dx * dfakt
D(2,3) = dy * dfakt
D(3,3) = dz * dfakt
4165 ! . . . Inversion der Matrix D
call invert(D)
! . . . Berechnung der Loesung mit x = Inv.(D) * (- Merkur-Koord.)
x1 = - D(1,1) * xyr(1) - D(1,2) * xyr(2) - D(1,3) * xyr(3)
x2 = - D(2,1) * xyr(1) - D(2,2) * xyr(2) - D(2,3) * xyr(3)
4170 x3 = - D(3,1) * xyr(1) - D(3,2) * xyr(2) - D(3,3) * xyr(3)
! . . . Koordinaten der Sonnenposition in Giza
xyr(31) = x1 * pyr(11) + x2 * pyr(12) + x3 * pyr(7)
xyr(32) = x1 * pyr(14) + x2 * pyr(15) + x3 * pyr(8)
xyr(33) = x1 * pyr(17) + x2 * pyr(18) + x3 * pyr(9)
4175 ! . . . Massstabsfaktor
xyr(35) = AE * dsqrt((xyr(12)**2 + xyr(15)**2 + xyr(18)**2)/ &
(pyr(12)**2 + pyr(15)**2 + pyr(18)**2))
endif
4180 !.....Dreidimensionale Berechnung (x-, y- und z-Koordinate)
! mit Hilfe des Fit-Programms FITEX. Die Konstellation der Plane-
! ten wird durch Translation, Rotation und Groessenaenderung mit
! der Anordnung der Pyramiden bzw. der Kammern in der Cheops-Pyra-
! mide zur Deckung gebracht. Anschliessend wird die resultierende
4185 ! Transformation auf die Sonnenposition (Koordinatenursprung)
! angewendet.
if (ison==5) then
istart = 0
ke = 0
4190 if (iter/=0) then
do iu=ix,6,5; write(iu,*); enddo
endif
! . . . Koordinatentransformation --> y(i)
4195 do
do i=1,m; y(i) = xyr(i); enddo
call translat(x(1),x(2),x(3),y)
call rotmat(5,x(4),x(5),x(6),y)
call mastab(x(7),y)
4200 if (istart==0) then
do i=1,n; xsta(i) = x(i); enddo
do i=1,m; ysta(i) = y(i); enddo
endif
4205 ! . . . . Die Fehlerquadrate dabs(F)**2
w(4) = z0
do i=1,m; f(i) = y(i) - z(i); w(4) = w(4) + f(i)*f(i); enddo
istart = istart + 1
Datei: ~/home/p5/p5.f95 Seite 70 von 110
4210 ! . . . . Ausgabe der Iterationen (Aufruf von FITEX)
do iu=ix,6,5
if (iter/=0)write(iu,152)iw(3),iw(4),w(3),w(4),(x(i),i=1,n)
enddo
call fitex(ke,m,n,f,x,e,w,iw); if (ke/=1) exit
4215 enddo
! . . . Ausgabe der Ergebnisse
if (iter/=0) then
do iu=ix,6,5
4220 write(iu,153) ke,iw(3),iw(4),w(3),w(4)
j2 = n+n
write(iu,154) x,(w(4+j),j=1,j2)
if (w(5)==z0) go to 10
j2=4+j2
4225 !c do i=1,n
!c j1=j2+1; j2=j1+i-1
!c write(iu,154) (w(j),j=j1,j2)
!c enddo
10 write(iu,*)
4230 write(iu,'('' start x(1..'',i1,''):'',7F13.3)') &
n,(xsta(i),i=1,3),(xsta(i)*gdpi,i=4,6),xsta(7)
write(iu,'('' " y(1..'',i1,''):'',9f13.3)') &
m,(ysta(i),i=1,m)
write(iu,'('' results x(1..'',i1,''):'',7f13.3)') &
4235 n,(x(i),i=1,3),(x(i)*gdpi,i=4,6),x(7)
write(iu,'('' " y(1..'',i1,''):'',9f13.3/)') &
m,(y(i),i=1,m)
enddo
endif
4240
! . . . Berechnung der Sonnenposition im Pyramidengelaende mit Hilfe
! der gerade bestimmten Parameter x(1)..x(7) durch Transforma-
! tion des Koordinatenursprungs (Sonne)
do i=1,m; y(i) = z0; enddo
4245 call translat(x(1),x(2),x(3),y)
call rotmat(5,x(4),x(5),x(6),y)
call mastab(x(7),y)
xyr(31) = y(1)
xyr(32) = y(2)
4250 xyr(33) = y(3)
xyr(35) = AE/x(7)
endif
if (ison>=4) then
4255 !.......Korrektur der Koordinaten (1/4 Hoehe oder ganze Hoehe der
! 3. Pyramide bzw. Positionskoordinaten der Felsenkammer)
xyr(31) = xyr(31) + xp3
xyr(32) = xyr(32) + yp3
xyr(33) = xyr(33) + zp3
4260
! . . . Fehlerabschaetzung fuer die Sonnenposition
!c if (ison==4) then
dcm = dsqrt((xyr(31)-rcm(1))**2 + (xyr(32)-rcm(2))**2 &
+ (xyr(33)-rcm(3))**2)
4265 qu = dcm
if (dcm<dmi) qu = dmi * ((dcm/dmi)**2 + 1.d0)*0.5d0
xyr(34) = qu * xyr(36) * 1.d-2
!c else
!c xyr(34) = dsqrt(w(4))
4270 !c endif
Datei: ~/home/p5/p5.f95 Seite 71 von 110
endif
return
152 format(5x,2i5,1p,9e13.5)
4275 153 format(3i5,1p,8e23.15)
154 format(' ',1p,6e13.5)
end subroutine
subroutine invert(a)
4280 !-----Inversion der 3x3-Matrix a, d.h. a -> inv(a)--------------------
real(8) :: a(3,3),b(3,3),dei
integer(2) :: i,j
! . . Die Kofaktoren
4285 b(1,1) = a(2,2)*a(3,3) - a(2,3)*a(3,2)
b(1,2) = a(2,3)*a(3,1) - a(2,1)*a(3,3)
b(1,3) = a(2,1)*a(3,2) - a(2,2)*a(3,1)
b(2,1) = a(3,2)*a(1,3) - a(3,3)*a(1,2)
b(2,2) = a(3,3)*a(1,1) - a(3,1)*a(1,3)
4290 b(2,3) = a(3,1)*a(1,2) - a(3,2)*a(1,1)
b(3,1) = a(1,2)*a(2,3) - a(1,3)*a(2,2)
b(3,2) = a(1,3)*a(2,1) - a(1,1)*a(2,3)
b(3,3) = a(1,1)*a(2,2) - a(1,2)*a(2,1)
4295 ! . . Kehrwert der Determinante und Transponieren
dei = 1.d0/(a(1,1)*b(1,1) + a(1,2)*b(1,2) + a(1,3)*b(1,3))
do i=1,3; do j=1,3; a(i,j) = b(j,i)*dei; enddo; enddo
end subroutine
4300 subroutine rotmat(iachse,w1,w2,w3,a)
!-----Erstellung der Dreh-Matrix und Multiplikation-------------------
! 3 Vektoren fuer Merkur bis Erde: a(1..9) --> a(1..9)
! iachse = 1-3: Drehung um x-, y- oder z-Achse (Winkel w1)
!
4305 ! ( cos w1 sin w1 0 )
! z.B. Dz(w1) = ( -sin w1 cos w1 0 )
! ( 0 0 1 )
!
! iachse = 4: Drehung um Knotenlinie (Winkel w1, w2)
4310 ! iachse = 5: Drehung um beliebige Achse (Winkel w1, w2
! und w3: die Eulerschen Winkel)
implicit double precision (a-h,o-z)
dimension :: a(9),b(9),D(3,3)
z0 = 0.d0
4315 one = 1.d0
s1 = dsin(w1)
c1 = dcos(w1)
if (iachse<=3) then
do j=1,3; do i=1,3; D(i,j) = z0; enddo; enddo
4320 if (iachse==1) then
D(1,1) = one ! axis 1
D(2,2) = c1
D(2,3) = s1
D(3,2) = - s1
4325 D(3,3) = c1
else
D(1,1) = c1
if (iachse==2) then
D(1,3) = s1 ! axis 2
4330 D(2,2) = one
D(3,1) = - s1
Datei: ~/home/p5/p5.f95 Seite 72 von 110
D(3,3) = c1
else
D(1,2) = s1 ! axis 3
4335 D(2,1) = - s1
D(2,2) = c1
D(3,3) = one
endif
endif
4340 else
s2 = dsin(w2)
c2 = dcos(w2)
if (iachse==4) then
D(1,1) = - s1 * s1 * (one - c2) + one ! axis 4
4345 D(1,2) = s1 * c1 * (one - c2)
D(1,3) = - s1 * s2
D(2,1) = s1 * c1 * (one - c2)
D(2,2) = - c1 * c1 * (one - c2) + one
D(2,3) = c1 * s2
4350 else
s3 = dsin(w3)
c3 = dcos(w3)
D(1,1) = c1 * c3 - s1 * c2 * s3 ! axis 5
D(1,2) = s1 * c3 + c1 * c2 * s3
4355 D(1,3) = s2 * s3
D(2,1) = - c1 * s3 - s1 * c2 * c3
D(2,2) = - s1 * s3 + c1 * c2 * c3
D(2,3) = s2 * c3
endif
4360 D(3,1) = s1 * s2
D(3,2) = - c1 * s2
D(3,3) = c2
endif
4365 ! . . Ausfuehrung der Transformation (Merkur-, Venus- und Erdposition)
!c do i = 1,3; write(6,'(3f13.8)')(D(i,j),j=1,3); enddo
do i=1,9; b(i) = z0; enddo
do k=0,6,3
do i=1,3
4370 do j=1,3
b(k+i) = b(k+i) + D(i,j)*a(j+k)
enddo
enddo
enddo
4375 do i=1,9; a(i) = b(i); enddo
!c write(6,'(a12,3f13.8)') ' Mercury : ',(a(j),j=1,3)
!c write(6,'(a12,3f13.8)') ' Venus : ',(a(j),j=4,6)
!c write(6,'(a12,3f13.8)') ' Earth : ',(a(j),j=7,9)
end subroutine
4380
subroutine translat(a1,a2,a3,a)
!-----Translation der Positionen der 3 Planeten-----------------------
! 3 Vektoren a(1..9) --> a(1..9)
real(8) :: a1,a2,a3,a(9)
4385 integer(2) :: i
do i=1,7,3
a(i) = a(i) + a1
a(i+1) = a(i+1) + a2
a(i+2) = a(i+2) + a3
4390 enddo
end subroutine
Datei: ~/home/p5/p5.f95 Seite 73 von 110
subroutine mastab(zmas,a)
!-----Massstabsaenderung----------------------------------------------
4395 ! 3 Vektoren a(1..9) --> a(1..9)
real(8) :: zmas,a(9)
integer(2) :: i
do i=1,9; a(i) = zmas * a(i); enddo
end subroutine
4400
subroutine transfo(irb,rku)
!-----Transformation ins Merkurbahn-System (Venusbahn-System)---------
! re(1..9) --> re(1..9), xyr(1..9) --> xyr(1..9)
! Die Transformationen A, B und C liefern dasselbe Ergebnis.
4405 ! Die Eingabewinkel ao, ai, at sind im Modul "base" gespeichert.
use base
implicit double precision (a-h,o-z)
dimension :: xyt(9),rku(3)
pi2 = pi * 2.d0
4410 if (irb>=2 .and.irb<=4) then
ao = (re(34) - re(1))*pidg
else
ao = (re(40) - re(1))*pidg
endif
4415 if (ao<z0) ao = ao + pi2
if (ao>pi2) ao = ao - pi2
!c write(6,'(a10,f23.8)') ' re(4) ',re(4)
!c write(6,'(a10,f23.8)') ' re(40) ',re(40)
if (irb>=2 .and.irb<=4) then
4420 ai = dabs(datan(xyr(3)/(xyr(1)*dsin(ao))))
else
rxy = dsqrt(xyr(4)*xyr(4) + xyr(5)*xyr(5))
aov = (re(40) - re(4))*pidg
ai = dabs(datan(xyr(6)/(rxy*dsin(aov))))
4425 endif
at = dasin(dsin(ao)/dsqrt(1.d0-(dsin(ai)*dcos(ao))**2))+ao-pi
a1 = ao; a2 = ai; a3 = at
!c write(6,'(a12,3f13.8)') ' Mercury : ',(xyr(j),j=1,3)
!c write(6,'(a12,3f13.8)') ' Venus : ',(xyr(j+3),j=1,3)
4430 !c write(6,'(a12,3f13.8)') ' Earth : ',(xyr(j+6),j=1,3)
do i=1,9; xyt(i) = xyr(i); enddo
!.....Transformation A --> Dz(at) * K(ao,ai)
! (Reihenfolge der Matrizen von rechts nach links!)
4435 if (irb==2 .or.irb==5) then
! . . . Matrix K(ao,ai)
call rotmat(4,a1,a2,z0,xyt)
! . . . Matrix Dz(at)
if (irb==5) then
4440 at = datan(xyt(2)/xyt(1))
a3 = at
endif
call rotmat(3,a3,z0,z0,xyt)
endif
4445
!.....Transformation B --> Dz(at-ao) * Dx(ai) * Dz(ao)
if (irb==3) then
! . . . Matrix Dz(ao)
call rotmat(3,a1,z0,z0,xyt)
4450 ! . . . Matrix Dx(ai)
call rotmat(1,a2,z0,z0,xyt)
! . . . Matrix Dz(at-ao)
call rotmat(3,a3-a1,z0,z0,xyt)
Datei: ~/home/p5/p5.f95 Seite 74 von 110
endif
4455
!.....Transformation C --> R(ao,ai,at-ao)
if (irb==4) then
! . . . Matrix R(ao,ai,at-ao)
call rotmat(5,a1,a2,a3-a1,xyt)
4460 endif
! . . Ruecktransformation in Kugelkoordinaten
do i=1,9; xyr(i) = xyt(i); enddo
do i=0,6,3
4465 call kugelko(xyr(i+1),xyr(i+2),xyr(i+3),rku)
do j=1,3; re(i+j) = rku(j); enddo
enddo
end subroutine
4470 subroutine kugelko(r1,r2,r3,rku)
!-----Umrechnung in Kugelkoordinaten rku(1)..rku(3)-------------------
! (Index von rku 1: phi, 2: theta, 3: r)
use base, only : gdpi
implicit double precision (a-h,o-z)
4475 dimension :: rku(3)
ra = dsqrt(r1*r1 + r2*r2)
rku(1) = datan(r2/r1)*gdpi
rku(2) = datan(r3/ra)*gdpi
rku(3) = dsqrt(ra*ra + r3*r3)
4480 if (r1<0.d0) rku(1) = rku(1) + 180.d0
if (rku(1)<0.d0) rku(1) = rku(1) + 360.d0
end subroutine
subroutine aphelko(imod,ivers,iaph,ipla, &
4485 ison,ijd,io,iop0,ix,dh3,x,y,rcm,dmi)
!-----Berechnung der "Merkur-Aphelposition" in Giza-------------------
! fuer Konstell. 13, 14, sowie "quick start option" 322 und 323.
! Die Berechnung kann mit VSOP87A (ivers=1) und VSOP87C (ivers=3)
! durchgefuehrt werden. Die Ortsabweichungen im Pyramidengelaende
4490 ! zwischen beiden Versionen liegen fuer Konst. 13 bzw. 14 bei ca.
! 10 cm und 5 mm, bei der Schatten-Konstellation 12 bei ca. 4 mm.
! Sollte sich an den Zeitpunkten dieser Konstellationen etwas aen-
! dern, sind die astron. Aphelkoordinaten in "aphelm" anzupassen.
use base
4495 implicit double precision (a-h,o-z)
dimension :: aphelm(18),x(7),y(9),rcm(3)
!.....Sphaerische ekliptikale Koordinaten L, B und r des Merkur-Aphels
! fuer Konst. 13 und 14 jeweils fuer J2000.0 und Ekl. der Epoche
4500 ! und fuer "Schatten-Konstellation 12" mit J2000.0 (Option 323)
! und Ekliptik der Epoche (Option 322).
!
! . . A. Berechnung mit Gl. (7.1) --> Konst. 13: JDE = 5909973.28368
! Konst. 14: JDE = 671046.63581
4505 ! Optionen 322 und 323: JDE = 2849071.14940
! data aphelm/
! 272.2596751d0, -5.4263369d0, 0.4672908784d0, (K.13, VSOP87A)
! 46.8137077d0, -6.4048699d0, 0.4670482474d0, (K.13, VSOP87C)
! 249.5729904d0, -1.9354192d0, 0.4662991040d0, (K.14, VSOP87A)
4510 ! 182.1787524d0, -1.3530604d0, 0.4662950222d0,.. (K.14, VSOP87C)
!
! . . B. r(Mer.) optimiert --> Konst. 13 (VSOP87A): JDE = 5909973.264
! (r maximal fuer Aphel) (VSOP87C): JDE = 5909973.255
! Konst. 14 (VSOP87A/C): JDE = 671046.632
Datei: ~/home/p5/p5.f95 Seite 75 von 110
4515 data aphelm/272.2054713d0, -5.4229877d0, 0.4672909313d0, &
46.7345218d0, -6.4007584d0, 0.4670483641d0, &
249.5625348d0, -1.9341303d0, 0.4662991059d0, &
182.1682931d0, -1.3518259d0, 0.4662950244d0, &
258.9945271d0, -3.6947988d0, 0.4667842406d0, &
4520 274.2350325d0, -3.8355115d0, 0.4667842399d0/
if ((ijd==13 .or.ijd==14 .or.iop0==322 .or.iop0==323).and. &
imod<=2 .and.ison==5 .and.iaph==1 .and.ipla==1 .and.io==2) then
if (ijd==13 .and.ivers==1) j = 1
4525 if (ijd==13 .and.ivers/=1) j = 4
if (ijd==14 .and.ivers==1) j = 7
if (ijd==14 .and.ivers/=1) j = 10
if (iop0==322) j = 16
if (iop0==323) j = 13
4530 do i=4,6; re(i) = aphelm(j+i-4); enddo
! Umrechnung in kartesische Koordinaten
call kartko(ison)
! Koordinatentransformation: Weltraum --> Pyramidengelaende
do i=4,6; y(i) = xyr(i); enddo
4535 call translat(x(1),x(2),x(3),y)
call rotmat(5,x(4),x(5),x(6),y)
call mastab(x(7),y)
y(6) = y(6) + dh3
! Fehler in Metern (dr)
4540 dcm = dsqrt((y(4)-rcm(1))**2 + (y(5)-rcm(2))**2 &
+ (y(6)-rcm(3))**2)
qu = dcm
if (dcm<dmi) qu = dmi * ((dcm/dmi)**2 + 1.d0)*0.5d0
dr = qu * xyr(36) * 1.d-2
4545 ! Ausgabe des Ergebnisses
do iu=ix,6,5
write(iu,'('' Mercury aphelion coordinates [m]:'', &
& f13.2,2f10.2,f9.2)') y(4),y(5),y(6),dr
call linie(iu,1)
4550 enddo
endif
end subroutine
subroutine plako(diff,ipla,ijd,ik,ison,ipos, &
4555 rcm,x,y,ort,rp,dd,dn,dss,pla,plan,emp,text,tt,titab, &
is12,dmi,zjda,zjde,ivers,md,ix,prec,lu,r,ierr,rku)
!-----Koordinaten fuer Merkur bis Neptun------------------------------
! und Berechnung der "Planetenpositionen" im Giza-Gelaende fuer
! Konst. 1-14 mit ison = 5 (FITEX) und imod = 2 (VSOP87-Vollv.).
4560 ! Zusaetzlich:
! Spezialausgabe fuer Konst. 12 mit iuniv = 1 (TT) und iout = 3
! (spezial). In diesem Fall sind nur noch folgende Parameter
! variierbar: ipla (Pyr.- oder Kammerpositionen), imod (VSOP87
! Voll- oder Kurzv.), lv (VSOP87A oder VSOP87C, bei Vollv.) und
4565 ! ihi (z-Koordinate)
use base
implicit double precision (a-h,o-z)
dimension :: diff(9),r(6),rku(3),md(0:9),x(7),y(9),rcm(3)
dimension :: ort(0:9,4),rp(3,4),zjda(4)
4570 character(2) :: dd,dn,dss
character(3) :: pla(0:9),line
character(7) :: emp
character(10) :: plan(0:9)
character(18) :: date(4)
4575 character(23) :: text(0:9),tt(2)
Datei: ~/home/p5/p5.f95 Seite 76 von 110
character(49) :: titab
data date/'date of chambers: ','date of syzygy: ', &
'date of transit: ','date of pyramids: '/
data line/'---'/
4580
! . . Tabellenkopf
do iu=ix,6,5
if (is12==0) then
write(iu,*); call linie(iu,1)
4585 write(iu,*)'pla. x[AU] y[AU] z[AU] L', &
' B r[AU] Lm-L dev.'
call linie(iu,2)
else
write(iu,'(/27x,''Celestial positions in Giza'')')
4590 call linie(iu,1)
write(iu,*)' body x[m] y[m] z[m]', &
' dr[m] latitude N longitude E'
endif
enddo
4595
!.....Positionen von Merkur bis Neptun und Sonne im Pyramiden-
! gelaende und im System innerhalb der Cheops-Pyramide (nur
! VSOP87-Vollversion)
icm = 1
4600 imax = 8
if (ivers==1) imax = 9
if (is12/=0) imax = 8! urspruenglich imax = 4 (Aug. 2022)
icmax = 1
if (is12/=0) icmax = 4
4605 10 if (is12/=0) then
zjde = zjda(icm)
do iu=ix,6,5
call linie(iu,2)
write(iu,'(4x,a18,''JDE ='',f14.5)') date(icm),zjda(icm)
4610 call linie(iu,2)
enddo
endif
if (is12/=0 .and.icm==1) then ! "Sonnenposition"
if (ipla==1) then
4615 call geoko(ort(0,1),-ort(0,2),ipla,iB1,zB2,iL1,zL2)
else
call geoko(ort(0,1),ort(0,3),ipla,iB1,zB2,iL1,zL2)
endif
do iu=ix,6,5
4620 write(iu,102) plan(0),(ort(0,j),j=1,4),iB1,zB2,iL1,zL2
enddo
endif
do 20 id=1,imax
call vsop2(zjde,ivers,id,md,ix,prec,lu,r,ierr,rku)
4625 dif = re(1) - rku(1); call reduz(dif,0,0)
err = dif-diff(id); call reduz(err,0,0)
if (is12==0) then
do iu=ix,6,5
if (id/=4 .and.(id<=6 .or.id==9)) then
4630 write(iu,100)pla(id),(r(i),i=1,3),(rku(i),i=1,3),dif,err
else
write(iu,101)pla(id),(r(i),i=1,3),(rku(i),i=1,3),dif,emp
endif
enddo
4635 endif
Datei: ~/home/p5/p5.f95 Seite 77 von 110
!....."Planetenpositionen" im Giza-Gelaende (kartesische Koord.)
if (((ijd>=1 .and.ijd<=14).or.(ik==4519 .and.ipla==1).or. &
((ik==4518 .or.ik==5349).and.ipla==2)).and.ison==5) ipos = 1
4640 if (ipos==1) then
if (id==1) then
do j=1,3; y(j) = rku(j); enddo
endif
do j=1,3; re(j+3) = rku(j); enddo
4645 call kartko(ison)
do j=4,6; y(j) = xyr(j); enddo
call translat(x(1),x(2),x(3),y)
call rotmat(5,x(4),x(5),x(6),y)
call mastab(x(7),y)
4650 do j=1,3
ort(id,j) = y(3+j) + rp(3,j)
enddo
! Genauigkeit der "Planetenpositionen"
if (id<=3 .and.is12==0) then
4655 ort(id,4) = dsqrt((ort(id,1)-rp(4-id,1))**2 &
+ (ort(id,2)-rp(4-id,2))**2 &
+ (ort(id,3)-rp(4-id,3))**2)
elseif (id==9 .and.is12==0) then
ort(id,4) = dsqrt((ort(id,1)-rp(1,1))**2 &
4660 + (ort(id,2)-rp(1,2))**2 &
+ (ort(id,3)-rp(1,3))**2)
else
dcm = dsqrt((ort(id,1)-rcm(1))**2 &
+ (ort(id,2)-rcm(2))**2 &
4665 + (ort(id,3)-rcm(3))**2)
qu = dcm
if (dcm<dmi) qu = dmi * ((dcm/dmi)**2 + 1.d0)*0.5d0
ort(id,4) = qu * xyr(36) * 1.d-2
endif
4670 ! Geographische Koordinaten (Laenge und Breite) der
! transformierten Sonnen- und Planetenpositionen
if (is12/=0) then
if (ipla==1) then
call geoko(ort(id,1),-ort(id,2),ipla,iB1,zB2,iL1,zL2)
4675 else
call geoko(ort(id,1),ort(id,3),ipla,iB1,zB2,iL1,zL2)
endif
do iu=ix,6,5
write(iu,102) plan(id),(ort(id,j),j=1,4),iB1,zB2,iL1,zL2
4680 enddo
endif
endif
20 enddo
4685 ! . . Ruecksprung zum naechsten Planeten
icm = icm + 1; if (icm<=icmax) go to 10
! . . Weitere Ergebnis-Ausgabe
if (ipos==1 .and.is12==0) then
4690 text(2) = tt(ipla)
do iu=ix,6,5
call linie(iu,1)
write(iu,'('' Celestial pos. in Giza'',4x,a49)')titab
call linie(iu,2)
4695 write(iu,'('' Local coordinates'',9x,''Sun '', &
& f10.2,2f10.2,f9.2)') (ort(0,j),j=1,4)
enddo
Datei: ~/home/p5/p5.f95 Seite 78 von 110
do i=1,imax
dd = dn
4700 if ((i>=1 .and.i<=3).or.i==9) dd = dss
do iu=ix,6,5
write(iu,'(a23,5x,a10,3f10.2,f9.2,a2)') &
text(i),plan(i),(ort(i,j),j=1,4),dd
enddo
4705 enddo
endif
do iu=ix,6,5; call linie(iu,1); enddo
return
100 format(1x,a3,3f10.6,f9.4,f8.4,f10.6,2f9.4)
4710 101 format(1x,a3,3f10.6,f9.4,f8.4,f10.6,f9.4,1x,a7)
102 format(2x,a10,f9.2,f10.2,f9.2,f7.2,i7,f10.5,i6,f9.5)
! . . Groessere Stellenanzahl fuer Schnellstart-Optionen 3 und 8
!f100 format(2x,a3,f11.6,2f10.6/28x,f13.7,f11.7,f14.10/58x,f13.7,f8.3)
4715 !f101 format(2x,a3,f11.6,2f10.6/28x,f13.7,f11.7,f14.10/58x,f13.7,a8)!f
end subroutine
subroutine geoko(x,y,ipla,iB1,zB2,iL1,zL2)
!-----Berechnung der geographischen Koordinaten-----------------------
4720 ! (iB1,zB2 und iL1,zL2, jeweils in Grad und Minuten)
use base, only : pi,pidg,R3a,R3p
implicit double precision (a-h,o-z)
! . . Erdumfang ueber Pole. Anstelle von Ue = 40008 km folgt
4725 ! Ellipsenumfang nach Srinivasa Ramanujan.
zl = 3.d0*((R3a-R3p)/(R3a+R3p))**2
Ue = pi*(R3a+R3p) * (1.d0 + zl/(10.d0 + dsqrt(4.d0-zl)))
! Geographische Position des Koordinatenursprungs fuer jeweils
4730 ! die Pyramiden und Kammern (Genauigkeit ca. +/- 0,000010°)
if (ipla==1) then
zB0 = 29.972529d0 ! Zentrum der Mykerinos-Pyramide
zL0 = 31.128243d0 ! (Pyramiden-System)
else
4735 zB0 = 29.979197d0 ! Senkrechte Mittelachse der Ostwand der
zL0 = 31.134275d0 ! Koeniginnenkammer (Kammer-System)
endif
! . . Geographische Breite (zB)
4740 dBa = 360.d0 * x/Ue
zBa = zB0 + dBa
call geokar(zBa,ua,va)
call geokar(zB0,u0,v0)
xa = dsqrt((ua-u0)**2 + (va-v0)**2)
4745 dB = dBa * dabs(x/xa)
zB = zB0 + dB
iB1 = idint(zB)
zB2 = dmod(zB,1.d0)*60.d0
4750 ! . . Geographische Laenge (zL)
zBm = 0.5d0*(zB + zB0)
call geokar(zBm,um,vm)
dL = y/(pidg*um)
zL = zL0 + dL
4755 iL1 = idint(zL)
zL2 = dmod(zL,1.d0)*60.d0
end subroutine
Datei: ~/home/p5/p5.f95 Seite 79 von 110
subroutine geokar(B,u,v)
4760 !-----Abstand eines Punktes der geographischen Breite B---------------
! zur Erdachse (u) und zur Aequatorebene (v) (kartesische Koord.)
use base, only : pidg,R3a,R3p
implicit double precision (a-h,o-z)
u = R3a/dsqrt(1.d0 + (dtan(B*pidg)*R3p/R3a)**2)
4765 v = R3p*dsqrt(1.d0 - (u/R3a)**2)
end subroutine
subroutine reduz(a,i,j)
!-----Winkelreduzierung a --> a (z.B. 387 Grad --> 27 Grad)---------
4770 ! i = 0: dezimale Grad
! i = 1: Bogenmass
! j = 0: a --> -180...180 Grad
! j = 1: a --> 0...360 Grad
use base, only : pidg,gdpi
4775 implicit double precision (a-h,o-z)
u360 = 360.d0; z1 = 1.d0
if (a<0.d0) z1 = -1.d0
if (i/=0) a = a*gdpi
ab = dabs(a); if (ab>u360) ab = dmod(ab,u360)
4780 if ((j==0 .and.ab>180.d0).or. &
(j==1 .and.a<0.d0)) ab = ab - u360
a = z1 * ab; if (i/=0) a = a * pidg
end subroutine
4785 subroutine distance(i1,i2,dis)
!-----Entfernung zweier Punkte in Teotihuacan-------------------------
! (linear bestimmt in Metern anhand der GPS-Koordinaten)
use base, only : pidg
use astro, only : teot
4790 integer(4) :: i1,i2 ! Nummern bzw. Kennzeichnung beider Punkte
real(8) :: u1,v1,u2,v2,x,y,dis
call geokar(teot(i1,1),u1,v1)
call geokar(teot(i2,1),u2,v2)
x = dsqrt((u2-u1)**2 + (v2-v1)**2)
4795 y = dabs((teot(i1,2)-teot(i2,2))*pidg) * (u1+u2)*0.5d0
dis = dsqrt(x*x+y*y)
end subroutine
subroutine rcoef2(k,n,bmas)
4800 !-----Bestimmtheitsmass-----------------------------------------------
! Zusammenhang zw. Wallpositionen in Teotih. und Planetenbahnen
! k=1: Periheldistanzen
! k=2: grosse Halbachsen
! k=3: Apheldistanzen
4805 ! n : Anzahl der Datenpunkte
use astro, only : comp
integer(4) :: i,k,n
real(8) :: v(5),bmas(2,3),xn
xn = dfloat(n)
4810 do i=1,5; v(i) = 0.d0; enddo
do i=0,n-1
v(1) = v(1) + comp(i,1)*comp(i,k+1)/xn
v(2) = v(2) + comp(i,1)/xn
v(3) = v(3) + comp(i,k+1)/xn
4815 enddo
do i=0,n-1
v(4) = v(4) + ((comp(i,1)-v(2))**2)/xn
v(5) = v(5) + ((comp(i,k+1)-v(3))**2)/xn
enddo
Datei: ~/home/p5/p5.f95 Seite 80 von 110
4820 bmas(1,k) = ((v(1) - v(2)*v(3))/(dsqrt(v(4)*v(5))))**2! R^2
bmas(2,k) = 1.d0-(1.d0-bmas(1,k))*(xn-1.d0)/(xn-2.d0) ! adj. R^2
end subroutine
subroutine memo(zz1,zz2,zz3,zz4,zz5,zz6,zz7,zmem,ik,imem)
4825 !-----Ergebnis-Parameter merken---------------------------------------
use base, only : re
implicit double precision (a-h,o-z)
dimension :: zmem(78)
zmem(1) = zz1; zmem(2) = zz2
4830 zmem(3) = zz3; zmem(4) = zz4
zmem(5) = zz5; zmem(6) = zz6
zmem(7) = zz7
do i=1,12; zmem(10+i) = re(i); enddo
do i=31,78; zmem(i) = re(i); enddo
4835 imem = ik
end subroutine
subroutine info
!-----Information zu den Copyrights (aus der Datei "ingiza.t")--------
4840 integer(2) :: i
character(70) :: itext(38)
open(unit=10,file='ingiza.t')
do i=1,105; read(10,*); enddo
do i=1,38; read(10,*) itext(i); enddo
4845 close(10); write(6,'(///38(5x,a70/))') (itext(i),i=1,38)
end subroutine
subroutine titel1(iaph,ijd,ia,ison,ipla, &
ilin,isep,nurtr,iuniv,is12,iop0)
4850 !-----Haupttitel und Untertitel---------------------------------------
implicit double precision (a-h,o-z)
character(3) :: xt
character(10) :: pc,pd
pc = '(PYRAMIDS)'; if (iop0==321) pc = '(CHAMBERS)'
4855 pd = ' pyramids)'; if (ipla==2) pd = ' chambers)'
xt = 'TT)'; if (iuniv==2) xt = 'UT)'; write(ia,*)
if (iop0==300) then
write(ia,'(20x,A20,A22)')'4 PLANETS IN A LINE ', &
'(SYZYGY), MAY 17, 3088'
4860 go to 20
elseif (iop0==301) then
write(ia,'(17x,A16,A31)')'MERCURY TRANSIT ', &
'(MIN. SEPARATION), MAY 18, 3088'
go to 20
4865 elseif (iop0==310) then
write(ia,'(18x,A14,A32)')'VENUS TRANSIT ', &
'(MIN. SEPARATION), DEC. 18, 3089'
go to 20
elseif (iop0==311) then
4870 write(ia,'(19x,A20,A23)')'3 PLANETS IN A LINE ', &
'(SYZYGY), DEC. 23, 3089'
go to 20
elseif (iop0==320 .or.iop0==321) then
write(ia,'(18x,A34,1x,A10)') &
4875 'SEARCH FOR "SHADOW-CONSTELLATIONS"',pc
go to 10
elseif (iop0==322 .or.iop0==323) then
write(ia,'(11x,A20,A29,1x,A10)')'PRECEDING "SHADOW-CO', &
'NSTELLATION" 12, MAY 22, 3088',pc
4880 go to 20
Datei: ~/home/p5/p5.f95 Seite 81 von 110
elseif (iop0==338) then
write(ia,'(22x,A37)')'ORBITAL ELEMENTS OF OUR EIGHT PLANETS'
go to 20
endif
4885 if (ipla==1) write(ia,*)' PLANETS IN ', &
'ALIGNMENT WITH THE PYRAMIDS OF GIZA'
if (ipla==2) write(ia,*)' PLANETS IN ALIGNME', &
'NT WITH THE CHAMBERS OF THE CHEOPS PYRAMID'
if (ipla==3) then
4890 if (ilin>=3) write(ia,'(28x,a11,a15)')'PLANETS IN ', &
'A LINE (SYZYGY)'
if (ilin==1) write(ia,'(31x,a19)')'TRANSITS OF MERCURY'
if (ilin==2) write(ia,'(32x,a17)')'TRANSITS OF VENUS'
endif
4895
! . . Untertitel
10 if (ipla<=2 .and.is12==0) then
if (iaph==1 .and.ijd/=13 .and.ijd/=14) &
write(ia,'(30x,a21)')'(Mercury at aphelion)'
4900 if (iaph==2 .and.ijd/=13 .and.ijd/=14) &
write(ia,'(29x,a23)')'(Mercury at perihelion)'
if (iaph==3 .or.(iaph==1 .and.(ijd==13 .or.ijd==14))) &
write(ia,'(29x,a23)')'(Mercury near aphelion)'
if (iaph==4 .or.(iaph==2 .and.(ijd==13 .or.ijd==14))) &
4905 write(ia,'(28x,a25)')'(Mercury near perihelion)'
if (iaph==5) write(ia,'(24x,a34)') &
'(time not restricted, F minimized)'
elseif (ipla<=2 .and.is12/=0) then
write(ia,'(17x,a38,a10)') &
4910 '(more positions - coordinate system of',pd
elseif (ipla==3) then
if (isep==1) then
if (ison/=5) then
write(ia,'(14x,a21,a33)')'(eclipt. longitudes, ', &
4915 'all within an angular range, JDE)'
else
if (ilin>=3) then
if (nurtr==1) then
write(ia,'(13x,a18,a37)')'(angular range of ', &
4920 'eclipt. longitudes dL minimized, JDE)'
else
write(ia,'(5x,a18,a52)')'(angular range of ', &
'eclipt. longitudes dL minimized, only transits, JDE)'
endif
4925 else
write(ia,'(11x,a18,a38,a3)')'(equal eclipt. lon', &
'gitudes for Earth und transit planet, ',xt
endif
endif
4930 elseif (isep==2) then
write(ia,'(14x,a51,a3)') &
'(minimum separation, without travel time of light, ',xt
else
if (iuniv==1) then
4935 write(ia,'(17x,a48)') &
'(geocentric transit phases, terrestrial time TT)'
else
write(ia,'(18x,a46)') &
'(geocentric transit phases, universal time UT)'
4940 endif
endif
Datei: ~/home/p5/p5.f95 Seite 82 von 110
endif
20 if (isep/=4) then
write(ia,'(32x,a11,i4,a2)')'< P5-option',iop0,' >'
4945 else
write(ia,'(10x,a11,i4,a47)')'< P5-option',iop0, &
' > (monitor line width minimal 148 characters)'
endif
end subroutine
4950
subroutine titel2(ia,imod,ivers,irb,ipla, &
ison,ihi,iek,ijd,ika,iaph,ilin,ical,ak,zjde1,zjahr,delt, &
dwi,dwikomb,dwi0,dwi2,dwi3,iamax,step,ikomb,zmin,zmax)
!-----Zwei weitere Titelzeilen----------------------------------------
4955 implicit double precision (a-h,o-z)
dimension :: ida(7),da(7)
character(5) :: ca(2),dmo
character(7) :: cal(2)
character(10) :: wd
4960 character(15) :: text0
character(27) :: text1
character(19) :: text2
character(8) :: text3(0:6)
character(25) :: text4
4965 character(22) :: text5(2)
data ca/' (c1)',' (c2)'/,cal/'Gregor.','Julian.'/
data text3/ ' ',' E-V-M, ',' E-M-V, ', &
' V-E-M, ',' V-M-E, ',' M-E-V, ',' M-V-E, '/
data text5/', only Greg. calendar',', Jul./Greg. calendar'/
4970 if (imod==1) text1 = ' VSOP87D short ver.(Meeus)'
if (imod==2 .and.ivers==1) text1=' VSOP87A (2005) full ver.,'
if (imod==2 .and.ivers==3) text1=' VSOP87C (2005) full ver.,'
if (imod==3) text1 = ' "Keplers equation", '
if (ikomb==1 .and.ivers==1)text1=' VSOP87A, comb. search, '
4975 if (ikomb==1 .and.ivers==3)text1=' VSOP87C, comb. search, '
if (ivers==1) text2 = ' standard J2000.0,'
if (ivers==3) text2 = ' ecliptic of date,'
if (ipla<=2) then
if (irb==1) then
4980 if (ison==1) text4 = ' "Sun" south of Myker. P.'
if (imod==3 .and.ipla==2) text4 ='"Sun" south of sub. cham.'
if (ison==2) text4 = '"Sun" south of Chefren P.'
if (ison==3) text4 = '"Sun position" free, 2D '
if (ipla==1) then
4985 if (ison==4 .and.ihi==1) text4 ='"Sun" free, 3D, base, SLE'
if (ison==4 .and.ihi==2) text4 =' "Sun" free, 3D, C-M, SLE'
if (ison==4 .and.ihi==3) text4 =' "Sun" free, 3D, top, SLE'
if (ison==5 .and.ihi==1) text4 ='"Sun" free 3D base, FITEX'
if (ison==5 .and.ihi==2) text4 ='"Sun" free 3D, C-M, FITEX'
4990 if (ison==5 .and.ihi==3) text4 ='"Sun" free 3D, top, FITEX'
endif
if (ipla==2) then
if (ison==4 .and.ihi==1) text4 ='"Sun" free, 3D, east, SLE'
if (ison==4 .and.ihi==2) text4 ='"Sun" free, 3D, mid., SLE'
4995 if (ison==4 .and.ihi==3) text4 ='"Sun" free, 3D, west, SLE'
if (ison==5 .and.ihi==1) text4 ='"Sun" free 3D east, FITEX'
if (ison==5 .and.ihi==2) text4 ='"Sun" free 3D mid., FITEX'
if (ison==5 .and.ihi==3) text4 ='"Sun" free 3D west, FITEX'
endif
5000 endif
if (irb==2) text4 = ' ref. Mercury orbit (A)'
if (irb==3) text4 = ' ref. Mercury orbit (B)'
Datei: ~/home/p5/p5.f95 Seite 83 von 110
if (irb==4) text4 = ' ref. Mercury orbit (C)'
if (irb==5) text4 = ' reference Venus orbit'
5005 elseif (ipla==3) then
if (ilin==1) text4 = ' all Mercury transits'
if (ilin==2) text4 = ' all Venus transits'
if (ilin==3) text4 = 'linear c., Merc. to Earth'
if (ilin==4) text4 = 'linear c. Mercury to Mars'
5010 endif
write(ia,'(/a27,a19,a8,a25)') text1,text2,text3(ika),text4
if (ipla<=2) then
if (iek==1) text0 =' Ecl. north p/'
if (iek==2) text0 =' Ecl. south p/'
5015 if (ison>=3 .or.iek==3) text0 =' Ecl. N and S,'
elseif (ipla==3) then
text0 =' Period (yea'
endif
if (ijd==15 .and.(imod/=2 .or.(imod==2 .and. &
5020 (iaph==3 .or.iaph==4)))) then
if (ipla<=2) then
if (ison<=2) then
if (ikomb/=1) write(ia,'(a15,'' years'',f10.2, &
& '' to'',f10.2,a5,'' angular range:'',f8.4,'' deg'')') &
5025 text0,zmin,zmax,ca(ical),dwi0
if (ikomb==1) write(ia,'(a15,'' years'',f10.2, &
& '' to'',f10.2,a5,'', angular r.:'',f6.2,''/'',f6.2, &
& '' deg'')') text0,zmin,zmax,ca(ical),dwi,dwikomb
else
5030 if (ikomb/=1 .and.iaph/=5) then
write(ia,'(a15,'' years'',f10.2,'' to'',f10.2,a5, &
&'', tolerance F <'',f8.4,'' %'')') &
text0,zmin,zmax,ca(ical),dwi0
else
5035 write(ia,'(a15,'' years'',f10.2,'' to'',f10.2,a5, &
& '', tolerance F <'',f6.2,''/'',f6.2,'' %'')') &
text0,zmin,zmax,ca(ical),dwi,dwikomb
endif
endif
5040 elseif (ipla==3) then
if (ilin>=3) then
if (ikomb==1) write(ia,'(a15,''rs)'',f10.2, &
& '' to'',f10.2,a5,'', angular r.:'',f6.2,''/'',f6.2, &
& '' deg'')') text0,zmin,zmax,ca(ical),dwi,dwikomb
5045 if (ikomb/=1) write(ia,'(a15,''rs)'',f10.2,'' to'', &
& f10.2,a5,3x,'' angular range:'',f8.4,'' deg'')') &
text0,zmin,zmax,ca(ical),dwi0
else
write(ia,'(5x,a15,''rs) from'',f10.2,'' to'',f10.2,a22)') &
5050 text0,zmin,zmax,text5(ical)
return
endif
endif
else
5055 call ephim(1,iaph,ipla,ical,ak,iak,zjde1,zjahr,delt)
if (ijd>=1 .and.ijd<=14) then
write(ia,'(a15,'' constellation'',i3,'', JDE ='', &
& f15.5,'', year ='',f9.2,a5)')text0,ijd,zjde1,zjahr,ca(ical)
else
5060 write(ia,'(a15,20x,'' JDE ='',f15.5,'', year ='',f9.2,a5)') &
text0,zjde1,zjahr,ca(ical)
endif
if (iaph<=2) then
Datei: ~/home/p5/p5.f95 Seite 84 von 110
call jdedate(zjde1,ical,ida,da,dmo)
5065 call weekday(zjde1,wd)
k=1; if (zjde1>=0.d0 .and.zjde1<2299161.d0 .and.ical==2) k=2
if (zjde1>=1356183.d0 .and.zjde1<=5373484.d0) then
write(ia,'(25x,''date ('',a7,'',TT) ='', &
& f4.0,a5,i5,'','',i3,2('':'',i2),'','',A10)') &
5070 cal(k),da(7),dmo,(ida(i),i=3,6),wd
return
else
write(ia,'(24x,''date ('',a7,'',TT) ='', &
& f4.0,a5,i6,'','',i3,2('':'',i2),'','',A10)') &
5075 cal(k),da(7),dmo,(ida(i),i=3,6),wd
return
endif
endif
endif
5080 if (iaph==3 .or.iaph==4) then
write(ia,'('' Special search (interval), step number ='',i6,&
& '', step width ='',f8.3,'' hour(s)'')')iamax,24.d0*step
endif
if ((iaph==3 .or.iaph==4).and.ijd==15) then
5085 write(ia,'('' Consider without printing by tolerance ='', &
& f8.4)') dwi2
write(ia,'('' Print beyond aphelion (per.) by toler. ='', &
& f8.4)') dwi3
endif
5090 end subroutine
subroutine tabe(iaph,imod,iek,ia,io, &
ison,ipla,ilin,itran,is12,iop0,iout)
!-----Tabellenkopf----------------------------------------------------
5095 ! Bei Datumsberechnungen uebernimmt das Unterprogramm
! "zwischenzeile" die Tabellenueberschrift.
implicit double precision (a-h,o-z)
character(2) :: trs
if (ilin>=3.) then
5100 write(ia,*)
if (io==2 .and.imod/=3) call linie(ia,1)
endif
if (ipla==3) then
trs = 'tr'
5105 if (itran==2 .or.ison/=5 .or.imod==3) trs = ' '
if (ilin>=3) then
if (ison==5) then
write(ia,'('' co '',a2,'' k JDE year'',&
& '' dt[days] Lm-Lv Lm-Le Lm-Lma dLmin'')')trs
5110 else
write(ia,'('' co '',a2,'' k JDE year'',&
& '' dt[days] Lm-Lv Lm-Le Lm-Lma dL'')')trs
endif
endif
5115 elseif (ipla<=2) then
if (ison<=2) then
if (imod/=3 .and.iek/=3) then
write(ia,'('' con k JDE year '', &
& '' Lm Lm-Lv Lm-Le del1 del2 F[%]'')')
5120 else
write(ia,'('' con k JDE year'', &
& '' Lm Lm-Lv Lm-Le del1 del2 P'')')
endif
else
Datei: ~/home/p5/p5.f95 Seite 85 von 110
5125 if (ison==3 .or.ison==4) then
write(ia,'('' con k year Lm Lm'', &
& ''-Lv Lm-Le x-Sun y-Sun z-Sun dr P F[%]'')')
if (iaph==3 .or.iaph==4) then
write(ia,'('' ( ~k JDE M'', &
5130 & '' no. " " " " " " )'')')
endif
endif
if (ison==5) then
if (iaph==3 .or.iaph==4 .or.iout/=3) then
5135 if (iaph/=5) then
write(ia,'('' con k year Lm-Lv Lm'', &
& ''-Le e it x-Sun y-Sun z-Sun dr P F[%]'')')
else
write(ia,'('' con k JDE ye'', &
5140 & ''ar e it x-Sun y-Sun z-Sun dr P F[%]'')')
endif
else
if (ipla==1) then
if (iaph/=5) then
5145 write(ia,'('' con k year X5 M/1'', &
& ''0^7 h-Sun x-Sun y-Sun z-Sun dr P F[%]'')')
else
write(ia,'('' con k year dt[days] '', &
& '' X5 M/10^7 x-Sun y-Sun z-Sun P F[%]'')')
5150 endif
elseif (ipla==2) then
if (iaph/=5) then
write(ia,'('' con k year X5 M/1'', &
& ''0^9 h-Sun x-Sun y-Sun z-Sun dr P F[%]'')')
5155 else
write(ia,'('' con k year dt[days] '', &
& '' X5 M/10^9 x-Sun y-Sun z-Sun P F[%]'')')
endif
endif
5160 endif
if (iaph==3 .or.iaph==4) then
if (iout==3) then
if (ipla==1) then
write(ia,'('' ( JDE dt[h] X5 M/'', &
5165 & ''10^7 h-Sun " " " " " " )'')')
elseif (ipla==2) then
write(ia,'('' ( JDE dt[h] X5 M/'', &
& ''10^9 h-Sun " " " " " " )'')')
endif
5170 else
write(ia,'('' ( ~k JDE M'', &
& '' " " " " " " " " )'')')
endif
endif
5175 endif
endif
endif
! (Output zum Vergleich mit den Pyramidenabstaenden)
if (ilin>=3) then
5180 if (imod==3) then
call linie(ia,1)
else
call linie(ia,io)
endif
5185 if (io==2 .and.imod/=3 .and.is12==0) then
Datei: ~/home/p5/p5.f95 Seite 86 von 110
write(ia,'('' Lm Bm Rm Lv Bv '', &
& '' Rv Le Be Re '')')
if (ipla==3) write(ia,'('' Lma Bma Rma'')')
if (ipla<=2) then
5190 write(ia,'('' xm ym zm xv yv '', &
& '' zv xe ye ze '')')
write(ia,'('' xv-xm xe-xm yv-ym ye-ym zv-zm'', &
& '' ze-zm rel. deviation'')')
endif
5195 call linie(ia,1)
endif
endif
if (iop0==-804) write(ia,'(/24x,a33/31x,a19)') &
'calculation of the file inser-2.t','--- please wait ---'
5200 end subroutine
subroutine elements(ia,ivers,pla)
!-----Ausgabe der Bahnelemente aller Planeten-------------------------
! im Rahmen der erweiterten Ergebnisausgabe
5205 use base, only : re
implicit double precision (a-h,o-z)
character(3) :: pla(0:9)
write(ia,'('' pla. mean long. a [AU] '', &
& ''eccentr. asc.node incl. per.[°] per.[AU]'')')
5210 call linie(ia,2)
do i=1,8
pd = re(26+6*i) * (1.d0-re(27+6*i))
if (ivers==3 .and.i==3) then
write(ia,'(1x,a3,f13.5,2f10.5,a11,f9.5,f11.5,f10.5)')pla(i),&
5215 (re(24+6*i+j),j=1,3),' --- ',(re(24+6*i+j),j=5,6),pd
else
write(ia,'(1x,a3,f13.5,2f10.5,f11.5,f9.5,f11.5,f10.5)') &
pla(i),(re(24+6*i+j),j=1,6),pd
endif
5220 enddo
end subroutine
subroutine linie(ia,ib)
!-----Linie, waagerecht-----------------------------------------------
5225 implicit double precision (a-h,o-z)
if (ib==1) write(ia,'(1x,79a1)') ('=',i=1,79)
if (ib==2) write(ia,'(1x,79a1)') ('-',i=1,79)
if (ib==3) write(ia,'(1x,147a1)') ('=',i=1,147)
if (ib==4) write(ia,'(1x,147a1)') ('-',i=1,147)
5230 end subroutine
subroutine zwizeile(ia,io,zjde,ilin,imod,isep,ical,izp)
!-----Tabellenueberschrift und Zwischenzeile bei Datumsausgaben-------
! Bei Transitbestimmungen werden abhaengig von der Wahl der
5235 ! Kalender-Option Zwischenzeilen eingefuegt, die den Uebergang
! von einem zum anderen Kalender kennzeichnen.
implicit double precision (a-h,o-z)
ipar = 0; if (isep==4) ipar = 2
is = isep; if (is==2) is = 1
5240 if (izp==1) then
if (isep/=4) then
write(ia,*)
else
write(ia,'(93x,''position angles [deg]'',12x, &
5245 & ''semidiameters ["]'')')
endif
Datei: ~/home/p5/p5.f95 Seite 87 von 110
endif
if (izp==1) then
if (ilin<=2 .and.io==2) call linie(ia,1+ipar)
5250 if (isep<=2) then
write(ia,'('' co/p k date time'', &
& '' dt[days] Lm-Lv Lm-Le Lm-Lma sep["] S'')')
elseif (isep==3) then
write(ia,'('' co/p date, phase: I I'', &
5255 & ''I nearest III IV sep["]a S'')')
else
write(ia,'('' co/p date, phase: I II '', &
&'' nearest III IV sep["] a P1 '',&
&''P2 near. P3 P4 s-Sun s-pl. S'')')
5260 endif
if (imod/=3 .and.io/=2) then
call linie(ia,1+ipar)
else
call linie(ia,io+ipar)
5265 endif
if (io==2 .and.imod/=3) then
write(ia,'('' Lm Bm Rm Lv Bv '', &
& '' Rv Le Be Re '')')
write(ia,'('' Lma Bma Rma'')')
5270 call linie(ia,1+ipar)
endif
if (ia==6) then
izp=2; if (zjde>=0) izp=3
if (zjde>=2299161.d0) izp=4
5275 endif
elseif (zjde>=0.d0 .and.izp==2 .and.ical==2) then
select case (is)
case(1);write(ia,'(1x,13(''-''),'' (Jul. cal.) '',53(''-''))')
case(3);write(ia,'(1x,''----- (Jul. cal.) '',61(''-''))')
5280 case(4);write(ia,'(1x,''----- (Jul. cal.) '',129(''-''))')
end select
if (ia==6) izp = 3
elseif (zjde>=2299161.d0 .and.izp==3 .and.ical==2) then
select case (is)
5285 case(1);write(ia,'(1x,12(''-''),'' (Greg. cal.) '',53(''-''))')
case(3);write(ia,'(1x,''---- (Greg. cal.) '',61(''-''))')
case(4);write(ia,'(1x,''---- (Greg. cal.) '',129(''-''))')
end select
if (ia==6) izp = 4
5290 endif
end subroutine
subroutine comtime(i,za,zb,iw1,iw2,ihour,imin,sec)
!-----Bestimmung der Rechenzeit --------------------------------------
5295 ! i = 1: CPU time, i = 2: run time
! Stopzeit zb - Startzeit za = Rechenzeit [hhh:mm:ss.sss]
implicit double precision (a-h,o-z)
dimension :: iw1(8),iw2(8)
if (i==1) then
5300 t1 = za; t2 = zb
else
t1 = dfloat(iw1(5)*3600+iw1(6)*60+iw1(7))+dfloat(iw1(8))*1.d-3
t2 = dfloat(iw2(5)*3600+iw2(6)*60+iw2(7))+dfloat(iw2(8))*1.d-3
endif
5305 zt = t2-t1; if (zt<0.d0) zt = zt + 86400.d0
zih = dint(zt/3600.d0); ihour = idnint(zih)
zm = (zt-zih*3600.d0)/60.d0; zim = dint(zm)
Datei: ~/home/p5/p5.f95 Seite 88 von 110
imin = idnint(zim); sec = (zm-zim)*60.d0
end subroutine
5310
subroutine endzeile(ipla,imod,ilin,iaph,isep,ison,ijd,ipos, &
io,ia,inum,ihour,imin,sec,ihour2,imin2,sec2,is12,iop0)
!-----Endzeilen des Outputs-------------------------------------------
! Zusammenfassung: Anzahl gefundener Ereignisse, Rechenzeit
5315 implicit double precision (a-h,o-z)
dimension :: inum(0:4)
character(37) :: te1
character(8) :: te2,te22
character(1) :: te3
5320 character(29) :: te4
character(15) :: te5
te1 = ' '
te2 = 'CPU time'; te3 = ':'; te5 = ' -- end of run.'
te22 = 'run time'; te4 = '("<" exact deviation dr) '
5325 ipar = 0; if (isep==4) ipar = 2
if (io==2 .and.inum(2)==0) call linie(ia,1+ipar)
if ((imod/=3 .and.ison>=3).or.imod==3) then
if (ipla==1) te1 = '(P: polarity, * view from ecl. south)'
if (ipla==2) te1 = '(P: polarity, resp. view on ecliptic)'
5330 endif
if (ilin<=2 .and.isep>=3) &
te1 = ' ("/" means ascending node)'
if (ipla<=3 .and.ijd==15 .and.iop0/=-804 .and.(imod/=2 .or. &
& (imod==2 .and.(iaph==3 .or.iaph==4 .or.ilin<=2)))) then
5335 write(ia,500)' Computed constellations:',inum(1),te1
if (ilin<=2) then
write(ia,501)' Tested planet. passages:',inum(0)
write(ia,501)' Detected transits :',inum(2)
write(ia,502)' Centr./grazing transits:',inum(4),' /', &
5340 inum(3),te2,ihour,te3,imin,te3,sec
else
if (ipla<=2) then
write(ia,503)' Detected constellations:',inum(2),te2, &
ihour,te3,imin,te3,sec
5345 elseif (ipla==3) then
if (ison==5) then
inumber = inum(2)
else
write(ia,501)' Detected constellations:',inum(2)
5350 inumber = inum(3)
endif
write(ia,503)' Number of syzygies :',inumber,te2, &
ihour,te3,imin,te3,sec
endif
5355 endif
else
if (ipos==1 .and.is12==0 .and.iop0/=-804) then
write(ia,504)te4,te2,ihour,te3,imin,te3,sec
else
5360 if (iop0==-804) write(ia,'(43x,a36)') &
'The file inser-2.t has been created.'
write(ia,505)te2,ihour,te3,imin,te3,sec
endif
endif
5365 write(ia,506)te22,ihour2,te3,imin2,te3,sec2,te5
500 format(1x,a25,i10,6x,a37)
501 format(1x,a25,i10)
502 format(1x,a25,i5,a2,i3,7x,a8,i3,a1,i2,a1,f6.3)
Datei: ~/home/p5/p5.f95 Seite 89 von 110
503 format(1x,a25,i10,7x,a8,i3,a1,i2,a1,f6.3)
5370 504 format(14x,a29,a8,i3,a1,i2,a1,f6.3)
505 format(43x,a8,i3,a1,i2,a1,f6.3)
506 format(43x,a8,i3,a1,i2,a1,f6.3,a15/)
end subroutine
5375 !h subroutine histogramm(zz,ihis) !h
!-----Einsortieren der Genauigkeiten Fpos (zz) in ein Array-----------
! fuer Pyramiden oder Kammern (ipla <= 2, imod <= 2, ison >= 3).
! Zur Nutzung muessen alle !h-Kommentarzeilen aktiviert werden.
!h implicit double precision (a-h,o-z)
5380 !h dimension :: ihis(100)
!h i = idnint(zz*20.d0 + 0.5d0); if (i<=100) ihis(i) = ihis(i) + 1
!h end subroutine
subroutine save_ser
5385 !-----Speicherung von Daten in die Datei "inser-2.t"------------------
! Wenn die Datei "inserie.t" mit den julianischen Tagen (JDE)
! und den Nummern der Transit-Serien neu berechnet werden soll,
! erfolgt dies mit der Schnellstart-Option -804. Hiermit wird
! die neue Datei "inser-2.t" erzeugt. Falls gewuenscht kann
5390 ! diese - durch Umbenennung in "inserie.t" - die vorherige bzw.
! fehlende Datei "inserie.t" ersetzen. Die Verwendung dieser
! Option ist normalerweise nicht erforderlich.
use astro, only : ser
implicit double precision (a-h,o-z)
5395 open(unit=10,file='inser-2.t')
write(10,'(9x,a21,a42/6x,a10,a58)')'Julian Ephemeris Day ', &
'of each first transit in a series (S-No.),','to be used', &
' for the years -13000 BC to 17000 AD, VSOP87C full version'
write(10,'(34x,a9)')'(Mercury)'
5400 write(10,'(a14,4(12x,a3))')'S-No. JDE',('JDE',i=1,4)
write(10,'(79a1)')('-',i=1,79)
! Serien, Merkur
do i=-150,150,5
write(10,'(I4,5f15.5)')i,(ser(i+j,1),j=0,4)
5405 enddo
write(10,'(79a1)')('-',i=1,79)
write(10,'(35x,a7)')'(Venus)'
write(10,'(a14,4(12x,a3))')'S-No. JDE',('JDE',i=1,4)
write(10,'(79a1)')('-',i=1,79)
5410 ! Serien, Venus
do i=-10,10,5
write(10,'(I4,5f15.5)')i,(ser(i+j,2),j=0,4)
enddo
ser(19,2) = 1.d12
5415 write(10,'(I4,4f15.5,e15.1)')i,(ser(15+j,2),j=0,4) ! " "
write(10,'(79a1/)')('-',i=1,79)
close(10)
end subroutine
5420 subroutine lintrend(k,n,u,v)
!-----Lineare Regression, f(x) = ux+v --> u, v (Teotihuacan)----------
! k = 1: Periheldistanzen, n = Anzahl der Punkte
! k = 2: grosse Halbachsen
! k = 3: Apheldistanzen
5425 use astro, only : comp
integer(4) :: i,k,n
real(8) :: sumx,sumy,sumx2,sumxy,sig2,u,v,xn
xn = dfloat(n)
sumx = 0.d0; sumy = 0.d0; sumx2 = 0.d0; sumxy = 0.d0
Datei: ~/home/p5/p5.f95 Seite 90 von 110
5430 do i=0,n-1
sumx = sumx + comp(i,1)
sumy = sumy + comp(i,k+1)
sumx2 = sumx2 + comp(i,1)**2
sumxy = sumxy + comp(i,1)*comp(i,k+1)
5435 enddo
sig2 = xn*sumx2 - sumx**2
u = (xn*sumxy - sumx*sumy)/sig2
v = (sumx2*sumy - sumx*sumxy)/sig2
end subroutine
5440
subroutine vsop1tr(ip,rk,tau,del,r3i,eps,inum,resu)
!-----Berechnung der ekliptikalen Koordinaten (Kurzversion VSOP87)----
! Beruecksichtigung der Laufzeit des Lichtes, die bei Berechnung
! der Transitphasen eine Rolle spielt (siehe "vsop2tr")
5445 ! Index ip: 1 = Merkur, 2 = Venus
use base
implicit double precision (a-h,o-z)
dimension :: rk(12),rd(3),inum(0:4)
del = del/tmil ! Laufzeit des Lichtes: Merkur/Venus --> Erde
5450 ist = 3*ip-2
ii = 3*(ip-1)
do j=ist,ist+2
call vsop1(j,tau,resu)
re(j) = resu
5455 enddo
call kartko(0)
do j=ist,ist+2; rk(j) = xyr(j); enddo
do
tau1 = tau + del; inum(1) = inum(1) + 1
5460 do j=7,9
call vsop1(j,tau1,resu)
re(j) = resu
enddo
call kartko(0)
5465 do j=7,9
rk(j) = xyr(j)
enddo
do j=1,3
rd(j) = rk(ii+j) - rk(6+j)
5470 enddo
r3i = dsqrt(rd(1)**2 + rd(2)**2 + rd(3)**2)
del = r3i*AE/(c*86400.d0*tmil)
tau2 = tau + del
if (dabs(tau2-tau1)<eps) exit
5475 enddo
del = del*tmil
end subroutine
subroutine vsop2tr(xj2,ivers,ip,md, &
5480 ix,prec,lu,r,rk,ierr,del,r3i,eps,inum,rku)
!-----Aufruf der VSOP87-Subroutine (Vollversion)----------------------
! Beruecksichtigung der Laufzeit des Lichtes
! Index von rku: 1 = L, 2 = B, 3 = r; ip: 1 = Merkur, 2 = Venus
! Input: Zeitpunkt "xj2", Output: Koordinaten der Planeten und
5485 ! Laufzeit des Lichtes "del" vom Planet "ip" zur Erde
use base, only : re,c,AE
implicit double precision (a-h,o-z)
dimension :: rk(12),rd(3),r(6),rku(3),md(0:9),inum(0:4)
ii = 3*(ip-1)
5490 call vsop2(xj2,ivers,ip,md,ix,prec,lu,r,ierr,rku)
Datei: ~/home/p5/p5.f95 Seite 91 von 110
do k=1,3
re(ii+k) = rku(k)
rk(ii+k) = r(k)
enddo
5495 do
xj3 = xj2 + del
inum(1) = inum(1) + 1
call vsop2(xj3,ivers,3,md,ix,prec,lu,r,ierr,rku)
do k=1,3
5500 re(6+k) = rku(k)
rk(6+k) = r(k)
enddo
do j=1,3
rd(j) = rk(ii+j) - rk(6+j)
5505 enddo
r3i = dsqrt(rd(1)**2 + rd(2)**2 + rd(3)**2)
del = r3i*AE/(c*86400.d0)
xj4 = xj2 + del
if (dabs(xj4-xj3)<eps) exit
5510 enddo
end subroutine
subroutine fitmin(imod,imodus,iap,ke,x,y,ee1, &
step,nu,iflag,ddx1,ddx2,test,itin,indx,ix)
5515 !-----Minimum stetiger aber nicht ueberall diff.-barer Funktionen-----
! --> Resultat = x(indx), indx = 1, 2 oder 3.
!
! imodus = 1
! Das Unterprogramm basiert auf einer Art ternaerem Suchen. Es
5520 ! verwendet 3 Stuetzpunkte, um einen neuen Punkt zu finden und
! einen alten durch diesen zu ersetzen. Dabei ruecken die Punkte
! immer naeher zusammen, bis die Suchgenauigkeit (ee1) unter-
! schritten wird. Das Minimum wird durch wiederholten Aufruf
! von fitmin gefunden. Dieser Such-Algorithmus ist nicht beson-
5525 ! ders schnell, konvergiert aber zuverlaessig und wird u.a. zur
! Minimierung von "dL" bei Syzygien verwendet.
!
! imodus = 2 (Spezialsuche)
! Das Unterprogramm findet den Scheitelpunkt (Minimum) hyper-
5530 ! bolischer Funktionen der Form: y = a * sqrt((x-b)**2 + c**2).
! Dieser Algorithmus konvergiert deutlich schneller, findet
! jedoch im konkreten Fall der Planetenbewegung die Loesung nur
! dann, wenn sie zeitlich nicht zu weit entfernt liegt. Er dient
! zur schnellen Berechnung der minimalen Separation des Transits.
5535
implicit double precision (a-h,o-z)
dimension :: rx(3,4),x(5),y(5),test(10),d(3)
ie = 0; ze = 0.d0; ee2 = 1.d-30
zpa = 5.d0 ! zpa >= 2.d0
5540 10 iconv = 0
!c do iu=ix,6,5; write(iu,'('' nu,imod,imodus,indx,ddx1,ddx2 ='',&
!c & i4,3i3,2f13.8)')nu,imod,imodus,indx,ddx1,ddx2
!c write(iu,'(a12,3f18.8)') ' x(1..3) = ',(x(i),i=1,3)
!c write(iu,'(a12,3f18.12/)')' y(1..3) = ',(y(i),i=1,3); enddo
5545 nulim = 1
!.....Bestimmung der ersten drei x- und y-Werte
if (iap==5 .and.imod==2) then
nulim = 2
5550 if (nu==0) then; indx = 1; go to 99; endif
endif
Datei: ~/home/p5/p5.f95 Seite 92 von 110
if (nu<=nulim) then
do i=1,2
x(4-i) = x(3-i)
5555 y(4-i) = y(3-i)
enddo
x(1) = x(1) + step
indx = 1
go to 99
5560 endif
dy1 = y(2)-y(1)
dy2 = y(3)-y(2)
! . . Pruefen auf numerisches Rauschen (im Minimum) und Konvergenz-
5565 ! problem. Letzteres Problem entsteht eventuell beim Umschalten
! von der VSOP87-Kurzversion zur -Vollversion.
if (dy1>=ze.and.dy2<ze) then
i1 = 0; if (ddx1+ddx2>1.d-3) i1 = 1
i2 = 0; if (dabs(dy1)+dabs(dy2)>1.d-3) i2 = 1
5570 !c if (i1==0.and.i2==0) write(6,*)' --> num. noise, nu =',nu
!c if (i2==1) write(6,'(a23,i3)') ' --> switch-pr.(dy), ',nu
!c if (i1==1) write(6,'(a23,i3)') ' --> switch-pr.(dx), ',nu
if (i1==1 .or.i2==1) then
iconv = 1; go to 20
5575 endif
if (imodus==1) then
ke = 0
return
endif
5580 endif
20 if (imodus==1) then
!.......Quasiternaeres Suchen (imodus = 1)
if (dy1>=ze.and.dy2>=ze.and.iflag==0) then
5585 do i=1,2
x(4-i) = x(3-i) ! way 1
y(4-i) = y(3-i)
enddo
x(1) = x(1)+x(2)-x(3)
5590 if (dabs(x(1)-x(4))<1.d-8) then
y(1) = y(4)
go to 10
endif
indx = 1
5595 elseif ((dy1<ze.and.dy2<ze.and.iflag==0).or.iconv==1) then
do i=1,2
x(i) = x(1+i) ! way 2
y(i) = y(1+i)
enddo
5600 x(3) = x(3)+x(2)-x(1)
if (dabs(x(3)-x(5))<1.d-8) then
y(3) = y(5)
go to 10
endif
5605 indx = 3
elseif ((dy1<ze.and.dy2>=ze).or.iflag==1) then
select case (iflag)
case(0) ! way 3
do i=1,2
5610 x(3+i) = x(2*i-1)
y(3+i) = y(2*i-1)
enddo
Datei: ~/home/p5/p5.f95 Seite 93 von 110
x(3) = (x(3)+(zpa-1.d0)*x(2))/zpa
indx = 3; iflag = 1
5615 case(1)
x(1) = (x(1)+(zpa-1.d0)*x(2))/zpa
indx = 1; iflag = 0
end select
endif
5620 else
!.......Suche mit hyperbolischem Fit (imodus = 2)
a1 = x(1)-x(2); a3 = x(3)-x(2)
b1 = (y(2)**2-y(1)**2)*a3
5625 b2 = (y(3)**2-y(2)**2)*a1
if (dabs(b1+b2)<ee2) then; ke = 0; return; endif
b = 0.5d0*(b1*a3+b2*a1)/(b1+b2) + x(2)
d(1) = dabs(x(1)-b)
d(2) = dabs(x(2)-b)
5630 d(3) = dabs(x(3)-b); indx = 1
if (d(2)>d(1).and.d(2)>d(3)) indx = 2
if (d(3)>d(1).and.d(3)>d(2)) indx = 3
x(indx) = b
if (x(1)>x(2)) call pchange(2,1,2,rx,x,y,indx)
5635 if (x(2)>x(3)) call pchange(2,2,3,rx,x,y,indx)
if (x(1)>x(2)) call pchange(2,1,2,rx,x,y,indx)
endif
ddx1 = dabs(x(2)-x(1))
ddx2 = dabs(x(3)-x(2))
5640 ddx3 = dabs(x(3)-x(1))
if (imodus==2) then
do i=1,10
if (dabs(ddx3-test(i))<1.d-7) ie = 1
enddo
5645 endif
!.....Hauptbedingung pruefen und Check auf Endlosschleife (ie=1)
if (ddx1<=ee1.or.ddx2<=ee1.or.ie==1) then
!c do iu=ix,6,5; write(iu,'('' nu,imod,imods,indx,dx1,dx2,ie'',&
5650 !c & '' ='',i4,3i3,2f13.8,i3)') nu,imod,imodus,indx,ddx1,ddx2,ie
!c write(iu,'(a12,3f18.8/)') ' x(1..3) = ',(x(i),i=1,3); enddo
ke = 0
return
endif
5655 if (imodus==2) then
itin = itin + 1
if (itin>10) itin = 1
test(itin) = ddx3
endif
5660
99 nu = nu + 1
!c write(6,'(a11,2i2,3f18.7)')' m,n,x1-3 =',imodus,nu,(x(i),i=1,3)
if (nu<=100) return
ke = 2
5665 do iu=ix,6,5
write(iu,'(/'' ----> error in "fitmin", ke ='',I2/)') ke
enddo
end subroutine
5670 subroutine ringfit(x1,x2,x3,y1,y2,y3,ep,step,nu,itmax,ix,ke)
!-----Nullstellenbestimmung-------------------------------------------
! Die Routine liefert fuer die Kreisfunktion, die durch (x1,y1),
! (x2,y2) und (x3,y3) verlaeuft, die naechstgelegene Nullstelle
Datei: ~/home/p5/p5.f95 Seite 94 von 110
! (neuer x2-Wert). Wie bei "sekante" ergibt wiederholtes Aufrufen
5675 ! von "ringfit" die Nullstelle einer stetig differenzierbaren
! Funktion. Die Rechenzeit (TYMT Test) verkuerzt sich um ca. 3%,
! was wenig ist. Da die Grundidee und die Gleichungen jedoch auch
! eine gewisse Aesthetik besitzen, wurde diese Routine beibehal-
! ten. Der Einsatz von "ringfit" ist nur sinnvoll, wenn die Be-
5680 ! rechnung der Ausgangsfunktion deutlich mehr Zeit erfordert als
! "ringfit" selbst.
implicit double precision (a-h,o-z)
if (ke/=5) ke = 1; ep0 = 1.d-15
if (nu<=0 .or.ke==5) then
5685 call sekante(x1,x2,y1,y2,ep,step,nu,itmax,ix,ke); return
endif
if (nu==1) then ! Erzeugung des 3. Startpunktes
x31 = x1; y31 = y1; x32 = x2; y32 = y2
call sekante(x1,x2,y1,y2,ep,step,nu,itmax,ix,ke)
5690 if (x1==x31) then
x3 = x32; y3 = y32
else; x3 = x31; y3 = y31
endif; return
endif
5695 sh = x2 ! Verschiebung (x2) zum Ursprung
x1 = x1-sh; x2 = 0.d0; x3 = x3-sh
!c do iu=ix,6,5; write(iu,'(a16,i3,6f10.6)') &
!c 'nu, x123, y123 =',nu,x1,x2,x3,y1,y2,y3; enddo
z1 = x1*x1 + y1*y1; ya = y2-y1; xa = -x1
5700 z2 = y2*y2; yb = y3-y2; xb = x3
z3 = x3*x3 + y3*y3; yc = y1-y3; xc = x1-x3
denom = x1*yb + x3*ya
if (denom<ep0) go to 10
xy = 0.5d0/denom
5705 if (dabs(xy)>=ep0) go to 20
10 x1 = x1+sh; x2 = sh
if (dabs(x1-x2)<ep0) x2 = x2 + 1.d0
ke = 5; return ! switchover to "sekante"
20 x0 = (z1*yb + z2*yc + z3*ya)*xy
5710 y0 = -(z1*xb + z2*xc + z3*xa)*xy
wu = x0*x0 + (y2-y0)**2 - y0*y0
if (wu<0.d0) then; ke = 4; go to 30; endif
wu = dsqrt(wu); xx = x0+wu; xx2 = x0-wu ! (2 Loesungen)
xmid = (x1+x2+x3)/3.d0
5715 if (dabs(xx-xmid)>dabs(xx2-xmid)) xx = xx2
d1 = dabs(x1-xx); d2 = dabs(xx); d3 = dabs(x3-xx)
if (d3>d1.and.d3>d2) then
x3 = 0.d0; y3 = y2
elseif (d1>d2.and.d1>d3) then
5720 x1 = 0.d0; y1 = y2
endif
x1 = x1+sh; x2 = xx+sh; x3 = x3+sh; nu = nu+1
if (dabs(x2-x1)<ep.or.dabs(x3-x2)<ep) then
!c do iu=ix,6,5; write(iu,'(a8,7x,a1,i3,3f14.10)') &
5725 !c 'nu, x123','=',nu,x1-sh,x2-sh,x3-sh; enddo
ke = 0; return
endif
if (nu<=itmax) return
ke = 2
5730 30 do iu=ix,6,5
write(iu,'(/'' ----> error in "ringfit", ke ='',I2/)') ke
enddo
end subroutine
Datei: ~/home/p5/p5.f95 Seite 95 von 110
5735 subroutine sekante(x1,x2,y1,y2,ep,step,nu,itmax,ix,ke)
!-----Nullstellenbestimmung der Sekante-------------------------------
! Das Programm liefert die Nullstelle der linearen Funktion, die
! durch (x1,y1) und (x2,y2) verlaeuft. Das Ergebnis wird als
! neuer x2-Wert ausgegeben. Wiederholtes Aufrufen dieser Routine
5740 ! liefert die Nullstelle (erster Ordnung) einer stetig differen-
! zierbaren, nicht notwendigerweise linearen Funktion.
implicit double precision (a-h,o-z)
if (ke/=5) ke = 1
!c do iu=ix,6,5; write(iu,'(a16,i3,2f16.6,2f12.6)') &
5745 !c 'nu,x1,x2,y1,y2 =',nu,x1,x2,y1,y2; enddo
nu = nu + 1
if (nu<=1) then
x1 = x2 !---------------------------------
y1 = y2 ! In sekante, ringfit,
5750 x2 = x1 + step ! fitmin, and vsop3 the
return ! error code ke means:
endif !
if (y1==y2) then ! ke=0: no error, result found
ke = 3; go to 10 ! ke=1: routine runs (internal)
5755 endif ! ke=2: too many iterations
x0 = x2-y2*(x2-x1)/(y2-y1) ! ke=3: division by zero
if (dabs(y2)<dabs(y1)) then ! ke=4: root of negative number
x1 = x2 ! ke=5: switchover to "sekante"
y1 = y2 !---------------------------------
5760 endif
x2 = x0
if (dabs(x2-x1)<ep.and.nu>2) then
!c do iu=ix,6,5; write(iu,'(a16,i3,2f16.6)') &
!c 'nu,x1,x2 =',nu,x1,x2; enddo
5765 ke = 0
return
endif
if (nu<=itmax) return
ke = 2
5770 10 do iu=ix,6,5
write(iu,'(/'' ----> error in "sekante", ke ='',I2/)') ke
enddo
end subroutine
5775 ! >> Update: The 4 subroutines of FITEX have been updated <<
! >> for Fortran 95 standard, double precision, <<
! >> and free source form. <<
!---------------------------------------------------------------------
5780 ! FITEX M O D I N A 8 7
!---------------------------------------------------------------------
!
! PROGRAMM BESCHREIBUNG NR. 320 VON G. W. SCHWEIMER (VERSION 1985)
!
5785 ! CHISQUARE MINIMISING SUBROUTINE
! SOLVES THE NONLINEAR LEAST SQUARES PROBLEM
! USING A LEAST SQUARES INTERPOLATION BETWEEN VARIABLES AND FUNCTIONS
! OR THE EXACT GRADIENT OF THE FUNCTIONS
! CALLED SUBROUTINES: LILESQ(LINEAR LEAST SQUARES PROBLEM)
5790 ! INVATA(INVERSION OF A(TRANSPOSED)*A)
! FIT1(ONE DIMENSIONAL MINIMUM SEARCH)
! CALLING SEQUENCE
! KE=0
! M=NUMBER OF FUNCTIONS, M GE N
5795 ! N=NUMBER OF VARIABLES, N GE 1
Datei: ~/home/p5/p5.f95 Seite 96 von 110
! DO 1 I=1,N
! X(I)=STARTING VALUES OF THE VARIABLES
! 1 E(I)=ABSOLUTE SEARCH ACCURACIES FOR THE VARIABLES, E(I) NE 0
! W(1)=FIRST STEP SIZE IN UNITS OF E(I), IF LE 1 W(1) = 100 BY
5800 ! FITEX THE MAXIMUM ALLOWED STEP SIZE IS 2*W(1)
! W(2)=METHOD OF APPROXIMATION, 0 FOR LEAST SQUARES INTERPOLATION
! 1 FOR EXACT GRADIENT OF THE FUNCTIONS
! IW(1)=NUMBER OF POINTS TO BE REMEMBERED, IF LE N IW(1) = N+1
! IW(2)=MAXIMUM NUMBER OF FUNCT. EVALUATIONS, IF EQ 0 IW(2)=2IW(1)
5805 ! IF IW(2) LT 0 NO ACTION EXCEPT KE = 0
! JA=4+MAX0(14,(N*(N+5))/2)+(M+N+1)*(IW(1)+1)
! 2 W(4)=0.
! DO 3 I=1,M
! F(I)=FUNCTION VALUES AT THE POINT X
5810 ! IF(W(2)==0.) GO TO 3
! W(JA+I+M*(J-1))= DF(I)/DX(J) FOR J=1,N
! 3 W(4)=W(4)+F(I)*F(I)
! OPTIONAL WRITE(*,*) IW(3),IW(4),W(3),W(4),X,F
! CALL FITEX(KE,M,N,F4,X4,E4,W4,IW)
5815 ! IF(KE==1) GO TO 2
! W(3)=ERROR RENORMALISATION FACTOR
! W(4)=MINIMUM QUADRATIC SUM OF THE F(I)
! X=MINIMUM POINT
! F=FUNCTIONS AT THE MINIMUM POINT
5820 ! KE=ERROR CODE KE=0: WITHOUT ERRORS
! KE=2: USER INTERRUPT; RETURNS MINIMUM VALUES
! WITHOUT ERRORS. THE CURRENT POINT IS
! IGNORED. FOR NORMAL USER INTERRUPT SET
! IW(2)=IW(3).
5825 ! KE=3: MAXIMUM NUMBER OF FUNCTION EVALUATIONS
! KE=4: ROUNDING ERRORS
! KE=5: THE FUNCTIONS DO NOT DEPEND ON X(IW(4))
! KE=6: USELESS VARIABLES IN THE PREPARATORY CALLS,
! THE LABELS OF THE VARIABLES ARE IW(3),IW(4)
5830 ! KE=7: M LT N OR N LT 0 OR W(2)*(W(2)-1.) NE 0
! W(4+I)=STANDARD ERRORS OF THE VARIABLES
! THE ERROR CALCULATION ASSUMES LINEAR FUNCTIONS.
! THE PROGRAM SHOWS THE LINEARITY BY THE KIND OF
! PREDICTION IW(3)
5835 ! IW(3)=0: LINEAR PREDICTION
! =1: STEP SIZE LIMITATION
! =2: ONE DIMENSIONAL SEARCH
! =3: RANDOM SEARCH
! THE ERRORS ARE CORRECTLY CALCULATED IF THE LAST
5840 ! N ITERATIONS WERE LINEAR, I.E. IW(3)=0.
! W(4+N+I)=ERROR ENHANCEMENTS
! W(4+N+N+I+(J*(J-1))/2)=ERROR CORRELATION BETW. X(I) AND X(J) I<J
! IW(3): NUMBER OF FUNCTION EVALUATIONS
! IW(4): NUMBER OF DEGREES OF FREEDOM
5845 ! WORKING FIELD: IW: LENGTH 4+K WITH K = IW(1)
! W: LENGTH 4+MAX(14,(N*(N+5))/2)+(M+N+1)*(K+1)+M*N
! ADRESSES IN IW
! 4+L: LABELS OF THE QUADRATIC SUMS
! ADRESSES IN W
5850 ! 4+I: STANDARD ERROR OF X(I)
! 4+N+I: ERROR ENHANCEMENT FOR X(I)
! FROM 4+N+N+1: MATRIX D AND ERROR CORRELATIONS
! FROM JS+1 MATRIX S; JS = 4+MAX0(14,(N*(N+5))/2)
! FROM JA+1: MATRIX A WITH JA = JS+(M+N+1)*(K+1)
5855 ! THE WORKING FIELDS CONTAIN ALL INFORMATION FOR THE CONTINUATION OF
! THE SEARCH. THIS ALLOWS A SEARCH WITHIN ANOTHER SEARCH JUST
Datei: ~/home/p5/p5.f95 Seite 97 von 110
! CHANGING THE WORKING FIELDS.
!
!---------------------------------------------------------------------
5860 SUBROUTINE FITEX(KE,M,N,F,X,E,W,IW)
IMPLICIT NONE
INTEGER(4) :: KE,M,N,I,I1,I2,J,J1,J2,J3,JA,JD,JM,JS,K,KV
! >> Sizes of IW and W are increased because of index overflow,
! >> although FITEX ran correctly before. (The numbers 100 and 1000
5865 ! >> are appropriate, if n = 7 and m = 9.)
INTEGER(4) :: IW(100),L,LM,MF
REAL(8) :: E(N),F(M),W(1000),X(N),EPS,S,T,U,V,BIG
REAL(4) :: A
INTEGER(2) :: IR
5870 ! >> A and IR in the equivalence statement have still the original
! >> single precision, since they are used to generate random numbers
! >> and so the calculation is not changed.
EQUIVALENCE (A,IR)
DATA EPS/1.D-8/,BIG/7.D+75/
5875 DATA MF/0/,J/0/,LM/0/,JS/0/,JM/0/,JD/0/,JA/0/,J3/0/ ! pre-init.
IF (IW(2)<0) GO TO 50
JD = 4 + N + N
JS = 4 + MAX0(14,(N*(N+5))/2)
LM = M + N + 1
5880 IF (KE/=0) GO TO 2
IF (IW(1)<=N) IW(1) = N + 1
IF (IW(2)==0) IW(2) = 2*IW(1)
IF (W(1)<=1.D0) W(1) = 100.D0
IW(3) = 1
5885 K = IW(1)
DO L = 1,K
IW(L+4) = 1 + K - L
W(JS+LM*L) = 7.D75
ENDDO
5890 KE = 1
2 K = IW(1)
KV = K
JA = JS + LM* (K+1)
JM = JS + LM*IW(5) - LM
5895 J3 = JA - LM
IF (KE==2) GO TO 52
IF (M<N.OR.N<1 .OR.W(2)*(W(2)-1.D0)/=0.D0) GO TO 57
IF (W(4)<=0.D0) GO TO 50
L = IW(K+4)
5900 IF (W(JS+LM*L)==BIG) KV = L - 1
DO I = 1,K
J1 = JS + LM*IW(I+4)
IF (W(4)<W(J1)) GO TO 4
ENDDO
5905 GO TO 37
4 IF ((W(2)==0.D0 .AND.I>MAX0(N+1,KV)).OR. &
(W(2)==1.D0 .AND.I>1)) GO TO 37
IF (KV<K) KV = KV + 1
I1 = K + 4
5910 I2 = K - I
IF (I2==0) GO TO 6
DO J = 1,I2
I1 = I1 - 1
IW(I1+1) = IW(I1)
5915 ENDDO
IW(I1) = L
JM = JS + LM*IW(5) - LM
Datei: ~/home/p5/p5.f95 Seite 98 von 110
! NEW ROW
6 J1 = JS + LM* (L-1)
5920 DO I = 1,N
J1 = J1 + 1
W(J1) = X(I)
ENDDO
DO I = 1,M
5925 J1 = J1 + 1
W(J1) = F(I)
ENDDO
W(J1+1) = W(4)
! TEST MAXIMUM NUMBER OF FUNCTION EVALUATIONS
5930 IF (IW(3)>=IW(2)) GO TO 53
IF (N==1) GO TO 42
! EXACT GRADIENTS OR END OF PREPARATORY FUNCTION EVALUATIONS
IF (W(2)==1.D0 .OR.IW(3)>N+1) GO TO 15
! PREPARATORY FUNCTION EVALUATIONS
5935 MF = IW(3)
IF (MF==1) GO TO 12
X(MF-1) = W(3)
J2 = JS + N
S = 0.D0
5940 DO I = 1,M
T = F(I) - W(J2+I)
S = S + T*T
ENDDO
J = 2
5945 IF (S<EPS*EPS*W(JS+LM)) GO TO 55
W(3) = S
J1 = 2 + N + MF
W(J1) = DSQRT(W(3))
IF (MF<=2) GO TO 12
5950 I1 = N + 1
DO J = 3,MF
I2 = J2 + LM* (J-2)
S = 0.D0
DO I = 1,M
5955 S = S + (W(I2+I)-W(J2+I))* (F(I)-W(J2+I))
ENDDO
IF (DABS(W(J1)*W(I1+J)-DABS(S))<EPS*DABS(S)) GO TO 56
ENDDO
12 IF (MF==N+1) GO TO 15
5960 W(3) = X(MF)
X(MF) = X(MF) + W(1)*E(MF)
GO TO 100
! END OF PREPARATORY FUNCTION EVALUATIONS
! SUM OF INVERSES OF THE QUADRATIC SUMS
5965 15 S = 0.D0
DO L = 1,KV
T = W(JS+LM*L)
S = S + 1.D0/ (T*T)
ENDDO
5970 W(JA) = 1.D0/S
! CENTRE OF THE VARIABLES AND FUNCTIONS
I1 = M + N
DO I = 1,I1
J1 = JS
5975 S = 0.D0
DO L = 1,KV
T = W(J1+LM)
S = S + W(J1+I)/ (T*T)
Datei: ~/home/p5/p5.f95 Seite 99 von 110
J1 = J1 + LM
5980 ENDDO
W(J3+I) = S*W(JA)
ENDDO
IF (KE/=1) GO TO 60
IF (W(2)==0.D0) GO TO 20
5985 J1 = JA - M - 1
DO I = 1,M; W(J1+I) = F(I); ENDDO
GO TO 23
! MATRIX A
20 J1 = JA
5990 DO I = 1,N
U = W(J3+I)
DO J = 1,M
J1 = J1 + 1
J2 = JS
5995 S = 0.D0
T = W(J3+N+J)
DO L = 1,KV
V = W(J2+LM)
S = S + (W(J2+N+J)-T)* (W(J2+I)-U)/ (V*V)
6000 J2 = J2 + LM
ENDDO
W(J1) = S*W(JA)
ENDDO
ENDDO
6005 IF (KE/=1) GO TO 62
! LINEAR LEAST SQUARES PROBLEM
23 CALL LILESQ(M,N,IR,W(JA+1),W(JA-M),W(5),W(N+5))
IF (IR<0) GO TO 54
IF (IR==0) GO TO 24; GO TO 35
6010 ! MATRIX D
24 J1 = JD
DO I = 1,N
T = W(J3+I)
DO J = 1,I
6015 J1 = J1 + 1
J2 = JS
S = 0.D0
U = W(J3+J)
DO L = 1,KV
6020 V = W(J2+LM)
S = S + (W(J2+I)-T)* (W(J2+J)-U)/ (V*V)
J2 = J2 + LM
ENDDO
W(J1) = S*W(JA)
6025 ENDDO
ENDDO
! NEW VARIABLES
IF (W(2)==0.D0) GO TO 28
DO I = 1,N
6030 X(I) = W(JM+I) - W(I+4)
ENDDO
GO TO 31
28 DO I = 1,N
I2 = 1; J1 = JD + (I*I-I)/2
6035 S = 0.D0
DO J = 1,N
J1 = J1 + I2
IF (J>=I) I2 = J
S = S + W(J1)*W(J+4)
Datei: ~/home/p5/p5.f95 Seite 100 von 110
6040 ENDDO
X(I) = W(J3+I) - S
ENDDO
! TEST OF CONVERGENCE
31 A = 0.E0
6045 DO I = 1,N
W(I+4) = X(I) - W(JM+I)
A = AMAX1(A,SNGL(DABS(W(I+4)/E(I))))
ENDDO
IF (A<1.E0) GO TO 50
6050 IW(4) = 0
W(3) = 1.D0
IF (A<2.E0*W(1)) GO TO 33
! STEP SIZE LIMITATION
IW(4) = 1
6055 W(3) = 2.D0*W(1)/A
33 DO I = 1,N; X(I) = W(JM+I) + W(3)*W(I+4); ENDDO
GO TO 100
! RANDOM PREDICTION
35 DO I = 1,N
6060 A = SNGL(W(J3+I))
X(I) = W(JM+I) + W(1)*E(I)* &
(MOD(IABS(INT(IR,KIND=4)),200)-100)/100.D0
ENDDO
IW(4) = 3
6065 GO TO 100
! ONE DIMENSIONAL SEARCH
37 IF (N==1) GO TO 43
IF (IW(3)>=IW(2)) GO TO 53
IF (IW(4)==2) GO TO 39
6070 IW(4) = 2
DO I = 1,N; W(J3+I) = X(I) - W(JM+I); ENDDO
IR = 3
W(5) = IR
IR = 20
6075 W(6) = IR
W(8) = 0.5D0
W(11) = 0.D0
W(12) = 0.D0
W(13) = 0.D0
6080 W(14) = 1.D0
W(16) = W(JM+LM)
W(17) = W(4)
GO TO 40
39 W(9) = W(4)
6085 CALL FIT1(KE,W(5),W(8))
40 DO I = 1,N; X(I) = W(JM+I) + W(8)*W(J3+I); ENDDO
IF (KE==3) KE = 2
IF (KE==2) GO TO 53
KE = 1
6090 W(3) = W(8)
GO TO 100
! ONLY ONE VARIABLE X
42 IF (IW(3)>1) GO TO 43
KE = 0
6095 W(10) = W(1)*E(1)
W(11) = E(1)
W(12) = 0.D0
43 IR = INT(IW(2),KIND=2)
W(6) = A
6100 W(8) = X(1)
Datei: ~/home/p5/p5.f95 Seite 101 von 110
W(9) = W(4)
CALL FIT1(KE,W(5),W(8))
IW(4) = 2
X(1) = W(8)
6105 IF (KE==1) GO TO 100
IF (KE>0) KE = KE + 1
W(3) = 0.D0
W(5) = 0.D0
IF (W(6)/=0.D0) GO TO 74
6110 W(5) = DSQRT(DABS((W(13)-W(15))/ ((W(16)-W(17))/(W(13)-W(14))- &
(W(17)-W(18))/ (W(14)-W(15)))))
W(6) = 1.D0
W(7) = 1.D0
GO TO 71
6115 ! END OF SEARCH
50 KE = 0
IF (W(4)==0.D0 .OR. IW(2)<0) GO TO 100
GO TO 52
! ERROR CODE DEFINITION
6120 57 KE = KE + 1
56 KE = KE + 1
55 KE = KE + 1
54 KE = KE + 1
53 KE = KE + 2
6125 52 DO I = 1,N; W(I+4) = 0.D0; ENDDO
W(3) = 0.D0
IF (KE*(KE-3)/=0 .OR.(KE==3 .AND.(W(2)==1.D0 .OR. &
(W(3)==0.D0 .AND.IW(3)<=N)))) GO TO 74
! COMPUTATION OF THE ERRORS OF THE VARIABLES
6130 ! RESTORE MATRIX G
IF (W(2)==0.D0) GO TO 15
J1 = JA
I1 = N + 1
DO 45 I = 2,I1
6135 IF (I>M) GO TO 45
DO J = I,M
W(J1+J) = 0.D0
ENDDO
J1 = J1 + M
6140 45 ENDDO
DO 49 I = 1,N
DO I1 = I,N
A = SNGL(W(4+N+I1))
IF (IR==I) EXIT
6145 ENDDO
IF (I1==I) GO TO 49
J1 = JA + M* (I-1)
J2 = JA + M* (I1-1)
W(4+N+I1) = W(4+N+I)
6150 DO J = 1,N
A = SNGL(W(J1+J))
W(J1+J) = W(J2+J)
W(J2+J) = A
ENDDO
6155 49 ENDDO
GO TO 66
! INVERSE OF MATRIX D
60 T = DSQRT(W(JA))
J1 = JA
6160 DO I = 1,N
S = W(J3+I)
Datei: ~/home/p5/p5.f95 Seite 102 von 110
J2 = JS + I - LM
DO L = 1,KV
J1 = J1 + 1
6165 W(J1) = T*(W(J2+L*LM)-S)/W(JS+L*LM)
ENDDO
ENDDO
CALL INVATA(KV,N,IR,W(JA+1),W(JD+1),X)
IF (IR==0) GO TO 20
6170 GO TO 74
! MATRIX G = A*INVERSE OF D
62 DO L = 1,M
J1 = L + JA - M
DO I = 1,N
6175 I1 = JD + (I*I-I)/2
I2 = 1
S = 0.D0
DO J = 1,N
I1 = I1 + I2
6180 IF (J>=I) I2 = J
S = S + W(I1)*W(J1+J*M)
ENDDO
X(I) = S
ENDDO
6185 DO J = 1,N; W(J1+J*M) = X(J); ENDDO
ENDDO
! DIAGONAL ELEMENTS OF G(T)*G
66 J1 = JA
DO I = 1,N
6190 S = 0.D0
DO L = 1,M
J1 = J1 + 1
S = S + W(J1)*W(J1)
ENDDO
6195 W(4+N+I) = DSQRT(S)
ENDDO
! STANDARD ERRORS AND ERROR CORRELATIONS
CALL INVATA(M,N,IR,W(JA+1),W(JD+1),X)
IF (IR/=0) GO TO 74
6200 DO I = 1,N
W(I+4) = DSQRT(W(JD+ (I*I+I)/2))
W(4+N+I) = W(I+4)*W(4+N+I)
ENDDO
J1 = JD
6205 DO I = 1,N
DO J = 1,I
J1 = J1 + 1
W(J1) = W(J1)/ (W(I+4)*W(J+4))
ENDDO
6210 ENDDO
! ERROR RENORMALISATION FACTOR
71 S = 0.D0
DO I = 1,M; S = S + W(JM+N+I); ENDDO
W(3) = DSQRT(DABS(W(JM+LM)-S*S/M)/MAX0(M-N-1,1))
6215 DO I = 1,N; W(I+4) = W(I+4)*W(3); ENDDO
! RESTORE OPTIMUM VALUES TO X AND F
74 IW(4) = M - N - 1
IF ((KE-5)* (KE-6)/=0) GO TO 75
IW(3) = J - 2
6220 IW(4) = MF - 1
75 DO I = 1,N; X(I) = W(JM+I); ENDDO
DO I = 1,M; F(I) = W(JM+N+I); ENDDO
Datei: ~/home/p5/p5.f95 Seite 103 von 110
W(4) = W(JM+LM)
100 IF (KE==1) IW(3) = IW(3) + 1
6225 END SUBROUTINE
!---------------------------------------------------------------------
! FIT1 M O D I N A 8 7
!---------------------------------------------------------------------
6230 !
! PROGRAMM BESCHREIBUNG NR. 309 VON G. W. SCHWEIMER (VERSION 1985)
!
! MINIMISATION OF A FUNCTION F(X) OF ONE VARIABLE X
! CALLING SEQUENCE
6235 ! KE=0
! I(2)=MAXIMUM NUMBER OF FUNCTION EVALUATIONS
! W(1)=START VALUE OF X
! W(3)=FIRST STEP SIZE
! W(4)=ABSOLUTE SEARCH ACCURACY
6240 ! W(5)=RELATIVE SEARCH ACCURACY
! 1 W(2)=FUNCTION VALUE F(X) AT X=W(1)
! OPTIONAL WRITE VI(1),X,F
! CALL FIT1(KE,VI,W)
! IF(KE==1) GO TO 1
6245 ! XMIN=W(1)
! FMIN=W(2)
! NF=VI(1)
! KE = ERROR CODE: KE=0 NO ERRORS, KE=
! 2 MAXIMUM NUMBER OF FUNCTION EVALUATIONS
6250 ! 3 ROUNDING ERRORS, PROB. BECAUSE BOTH W(4) AND W(5) ARE TOO SMALL
! THE WORKING FIELDS I AND W HAVE THE LENGTH 3 AND 11 RESPECTIVELY
! THEY CONTAIN ALL INFORMATION FOR THE CONTINUATION OF THE SEARCH
! THEREFORE A SEARCH WITHIN ANOTHER SEARCH CAN BE DONE JUST CHANGING
! THE WORKING FIELDS
6255 ! IF 2 FUNCTION VALUES F1 AND F2 ARE KNOWN FOR X = X1 AND X2 RESPEC-
! TIVELY WITH X1 NE X2 ENTER THE CALLING SEQUENCE AFTER DEFINING :
! KE = 1; I(1) = 3; W(6) = X1; W(7) = X2; W(9) = F1; W(10) = F2 AND
! W(1) = USERS CHOICE
! WORKING FIELD VARIABLES:
6260 ! I(1): CURRENT NUMBER OF FUNCTION EVALUATIONS
! I(2): MAXIMUM NUMBER OF FUNCTION EVALUATIONS
! I(3): MINIMUM POINTER, THE MINIMUM FUNCTION VALUE IS AT W(7+I(3))
! W(1): CURRENT VALUE OF X
! W(2): USER SUPPLIED FUNCTION VALUE
6265 ! W(3): FIRST STEP SIZE
! W(4 AND 5): SEARCH ACCURACIES
! W(6, 7 AND 8): X1, X2 AND X3 WITH X1 < X2 < X3
! W(9, 10 AND 11): FUNCTION VALUES AT X1, X2 AND X3 RESPECTIVELY
!
6270 !---------------------------------------------------------------------
SUBROUTINE FIT1(KE,V,W)
IMPLICIT NONE
INTEGER(4) :: KE,IV,J,K
REAL(8) :: V(3),W(11)
6275 IF (KE==1) GO TO 2
KE = 1
V(1) = 1
V(3) = -1
W(6) = W(1)
6280 W(9) = W(2)
1 W(1) = W(1) + W(3)
GO TO 12
2 IF (V(1)>2.D0) GO TO 3
Datei: ~/home/p5/p5.f95 Seite 104 von 110
V(3) = 0.D0
6285 W(7) = W(1)
W(10) = W(2)
IF (W(2)<=W(9)) GO TO 1
V(3) = -1.D0
W(1) = W(6) - W(3)
6290 GO TO 12
3 IF (V(1)>3.D0) GO TO 5
W(8) = W(1)
W(11) = W(2)
DO 4 J = 1,3
6295 K = 7 - MOD(J,2)
IF (W(K)<=W(K+1)) GO TO 4
W(1) = W(K)
W(K) = W(K+1)
W(K+1) = W(1)
6300 K = K + 3
W(1) = W(K)
W(K) = W(K+1)
W(K+1) = W(1)
4 ENDDO
6305 V(3) = 0.D0
IF (W(9)<W(10).AND.W(9)<W(11)) V(3) = -1.D0
IF (W(11)<W(10).AND.W(11)<W(9)) V(3) = 1.D0
GO TO 9
! SORT IN THE NEW VALUES OF X AND F
6310 5 IF (V(3)==0.D0) GO TO 6
J = IDINT(V(3))
W(7-J) = W(7)
W(10-J) = W(10)
IF ((W(7+J)-W(1))*(W(1)-W(7))>0.D0) GO TO 7
6315 W(7) = W(7+J)
W(10) = W(10+J)
W(7+J) = W(1)
W(10+J) = W(2)
IF (W(2)>=W(10)) V(3) = 0.D0
6320 GO TO 9
6 J = -1
IF (W(1)<W(7)) J = 1
IF (W(2)>W(10)) GO TO 8
W(7+J) = W(7)
6325 W(10+J) = W(10)
7 W(7) = W(1)
W(10) = W(2)
IV = IDINT(V(3))
IF (W(2)<=W(10+IV)) V(3) = 0.D0
6330 GO TO 9
8 W(7-J) = W(1)
W(10-J) = W(2)
9 IV = IDINT(V(3))
J = 7 + IV
6335 ! ERROR TESTS
IF (W(6)==W(7) .OR. W(7)==W(8) .OR. &
(W(9)==W(10).AND.W(10)==W(11))) GO TO 15
IF (V(1)>=V(2)) GO TO 16
IF (V(3)==0.D0) GO TO 10
6340 ! STEP SIZE LIMITATION
W(1) = W(J) + 2.D0*V(3)* (W(8)-W(6))
GO TO 12
10 W(1) = DMIN1(W(8)-W(7),W(7)-W(6))/(W(8)-W(6))
IF (W(1)>0.1D0) GO TO 11
Datei: ~/home/p5/p5.f95 Seite 105 von 110
6345 W(1) = .5D0* (W(6)+W(8))
GO TO 12
! PREDICTION OF THE POSITION OF THE MINIMUM
11 W(1) = ((W(9)-W(10))/ (W(6)-W(7))- (W(10)-W(11))/(W(7)-W(8)))/ &
(W(6)-W(8))
6350 W(1) = .5D0* (W(6)+W(8)+ (W(11)-W(9))/ (W(1)* (W(6)-W(8))))
! TEST OF CONVERGENCE
W(2) = DABS(W(1)-W(J))
IF (W(2)<DABS(W(4)) .OR. W(2)<DABS(W(5)*W(J))) GO TO 13
12 V(1) = V(1) + 1.D0
6355 RETURN
13 KE = 0
14 IV = IDINT(V(3))
W(1) = W(7+IV)
W(2) = W(10+IV)
6360 RETURN
15 KE = KE + 1
16 KE = KE + 1
GO TO 14
END SUBROUTINE
6365
!---------------------------------------------------------------------
! INVATA M O D I N A 8 7
!---------------------------------------------------------------------
!
6370 ! PROGRAMM BESCHREIBUNG NR. 320 VON G. W. SCHWEIMER (VERSION 1985)
!
! INVERSION OF THE PRODUCT MATRIX A(TRANSPOSED)*A
! THE MATRIX A IS REDUCED TO AN UPPER TRIANGULAR MATRIX R BY
! HOUSEHOLDER TRANSFORMATIONS. THE REMAINING COMPUTATION IS STRAIGHT
6375 ! FORWARD.
! INPUT VARIABLES: N: NUMBER OF COLUMNS OF MATRIX A
! M: NUMBER OF ROWS OF MATRIX A, M >= N > 0
! A: INPUT MATRIX (DESTROYED)
! OUTPUT VARIABLES: IR: ERROR CODE
6380 ! IR=-2: M LT N OR N LT 1
! IR=-1 RANK OF MATRIX A IS ZERO
! IR=0 NO ERROR, RANK OF MATRIX A IS N
! IR>0 RANK OF MATRIX A IS IR, THE INVERSE
! OF A(T)*A IS COMPUTED CONSIDERING THE
6385 ! IR COLUMNS OF A INDICATED BY THE FIRST
! IR COMPONENTS OF IP
! A: TRIANGULAR MATRIX R, R=A(I,J) I<=J=1,N
! D: VECTOR OF LENGTH (N*(N+1))/2, IT CONTAINS THE
! UPPER TRIANGULAR PART OF THE INVERSE OF A(T)*A
6390 ! IP: PERMUTATION VECTOR OF LENGTH N, ITS FIRST IR
! COMPONENTS CONTAIN THE LABELS OF THE USEFULL
! COLUMNS OF A, THE LAST COMPONENTS CONTAIN
! THE LABELS OF THE COLUMNS WHICH ARE LINEAR
! COMBINATIONS OF THE FIRST.
6395 ! THE RANK OF THE MATRIX A IS DETECTED COMPARING THE RESULT
! OF A SUM WITH THE SUM OF ABSOLUTE VALUES.
! IF SUM OVER I OF T(I) <= EPS * (SUM OF ABS(T(I))) THEN
! SUM IS SET TO EXACTR ZERO.
!---------------------------------------------------------------------
6400 SUBROUTINE INVATA(M,N,IR,A,D,VP)
IMPLICIT NONE
INTEGER(2) :: IR
INTEGER(4) :: M,N,I,I1,IJ,J,K,L
! Size of D changed (see above, FITEX)
6405 REAL(8) :: A(M,N),D(15*N),VP(N)
Datei: ~/home/p5/p5.f95 Seite 106 von 110
REAL(8) :: EPS,P,Q,R,S,SIG,T,U,V,C
DATA EPS/1.D-8/
DATA I1/0/ ! pre-init.
IR = INT(N,KIND=2)
6410 IF (M<N.OR.N<1) GO TO 19
DO I = 1,IR; VP(I) = I; ENDDO
! HOUSEHOLDER LOOP
K = 0
2 K = K + 1
6415 ! PIVOT ELEMENT
3 C = 0.D0
DO 4 I = K,M
IF (DABS(A(I,K))<=C) GO TO 4
C = DABS(A(I,K))
6420 I1 = I
4 ENDDO
IF (C>0.D0) GO TO 8
IR = IR - INT(1,KIND=2)
IF (K>IR) GO TO 13
6425 ! SET UP THE PERMUTATION VECTOR IP AND PERMUTE COLUMNS OF MATRIX A
L = IDINT(VP(K))
DO J = K,IR; VP(J) = VP(J+1); ENDDO
VP(IR+1) = L
DO I = 1,M
6430 C = A(I,K)
DO J = K,IR; A(I,J) = A(I,J+1); ENDDO
A(I,IR+1) = C
ENDDO
GO TO 3
6435 ! ROTATION OF THE LOWER COLUMN FRAGMENTS OF A(K)
8 DO J = K,IR
C = A(K,J)
A(K,J) = A(I1,J)
A(I1,J) = C
6440 ENDDO
S = A(K,K); V = 0.D0
DO I = K,M
U = A(I,K)/S
V = V + U*U
6445 ENDDO
V = 1.D0/DSQRT(V)
SIG = S/V
U = S + SIG
A(K,K) = -SIG
6450 IF (K>=IR) GO TO 13
L = K + 1
DO J = L,IR
S = V*A(K,J)
P = DABS(S)
6455 DO I = L,M
R = (A(I,K)/SIG)*A(I,J)
S = S + R
P = P + DABS(R)
ENDDO
6460 IF (DABS(S)<=EPS*P) S = 0.D0
T = (A(K,J)+S)/U
IF (DABS(T)<=EPS*DABS(S/U)) T = 0.D0
A(K,J) = -S
DO I = L,M
6465 Q = A(I,J)
P = T*A(I,K)
Datei: ~/home/p5/p5.f95 Seite 107 von 110
R = Q - P
IF (DABS(R)<=EPS*DABS(P)) R = 0.D0
A(I,J) = R
6470 ENDDO
ENDDO
GO TO 2
! END OF HOUSEHOLDER LOOP
13 IF (IR==0) GO TO 20
6475 ! INVERSE OF THE TRIANGULAR MATRIX R STORED IN D
IJ = 0
DO 16 K = 1,IR
D(IJ+K) = 1.D0/A(K,K)
IF (K==1) GO TO 16
6480 I = K
DO L = 2,K
I1 = I
I = I - 1
S = 0.D0
6485 DO J = I1,K; S = S + A(I,J)*D(IJ+J); ENDDO
D(IJ+I) = -S/A(I,I)
ENDDO
IJ = IJ + K
16 ENDDO
6490 ! INVERSE OF THE PRODUCT MATRIX
IJ = 0
DO J = 1,IR
DO I = 1,J
IJ = IJ + 1
6495 I1 = IJ
L = J - I
S = 0.D0
DO K = J,IR
S = S + D(I1)*D(I1+L)
6500 I1 = I1 + K
ENDDO
D(IJ) = S
ENDDO
ENDDO
6505 GO TO 20
19 IR = -2
20 IF (IR==0) IR = -1
IF (IR==N) IR = 0
END SUBROUTINE
6510
!---------------------------------------------------------------------
! LILESQ M O D I N A 8 7
!---------------------------------------------------------------------
!
6515 ! PROGRAMM BESCHREIBUNG NR. 320 VON G. W. SCHWEIMER (VERSION 1985)
!
! LINEAR LEAST SQUARES PROBLEM !!B-A*X!!=MIN(X)
! SOLVED BY HOUSEHOLDER TRANSFORMATIONS
! REDUNDANT VARIABLES ARE DETECTED BY THE METHOD OF G.GOLUB,
6520 ! NUMERISCHE MATHEMATIK, VOL. 7, PAGE 206-216, (1965)
! INPUT VARIABLES:M: NUMBER OF ROWS OF A AND B
! N: NUMBER OF COLUMNS OF A AND ROWS OF X
! A: M*N MATRIX (DESTROYED)
! B: VECTOR OF M COMPONENTS (DESTROYED)
6525 ! OUTPUT VARIABLES: X: VECTOR OF VARIABLES, THE REDUNDANT VARIABLES
! ARE SET TO ZERO. THE !!X!!=MIN IS NOT USED
! BECAUSE THE COMPONENTS OF X ARE ASSUMED TO BE
Datei: ~/home/p5/p5.f95 Seite 108 von 110
! NOT COMMENSURABLE
! IP: PERMUTATION VECTOR OF N COMPONENTS, IT CONTAINS
6530 ! THE COLUMN LABLES OF MATRIX A ORDERED ACCORDING
! THEIR IMPORTANCE IN REDUCING THE EUCLIDEAN NORM
! A: THE UPPER PART CONTAINS THE TRANSFORMED INPUT A
! A(2,1) CONTAINS THE SQUARE OF THE EUCLIDEAN
! NORM
6535 ! B: TRANSFORMED INPUT B
! IER: ERROR CODE
! IER=0 NO ERROR
! IER=-1 ALL COMPONENTS OF X ARE ZERO AND MAY BE
! REDUNDANT
6540 ! IER=-2 NO ACTION BECAUSE M < N OR N < 1
! IER>0 THE FIRST IER COMPONENTS OF IP CONTAIN
! THE LABELS OF THE NONZERO COMPONENTS OF X, THE
! REMAINING COMPONENTS OF X ARE ZERO AND MAY BE
! REDUNDANT
6545 ! NOTE: ALL ARITHMETIC OPERATIONS ARE PERFORMED IN DOUBLE PRECISION,
! AN ITERATIVE IMPROVEMENT IS IMPOSSIBLE WITHOUT SAVING A AND B.
! THE ROUND OFF ERROR OF !!B-A*X!!**2 IS APPROXIMATLY GIVEN BY
! !!B(INITIAL)!!**2 - !!B(TRANFORMED)!!**2
!---------------------------------------------------------------------
6550 SUBROUTINE LILESQ(M,N,IER,A,B,X,VP)
IMPLICIT NONE
INTEGER(2) :: IER
INTEGER(4) :: M,N,I,IP,J,K,L,L1,L2
REAL(8) :: C,DELTA,EPS,P,Q,R,S,SIG,T,U,V,W
6555 REAL(8) :: A(M,N),B(M),VP(N),X(N)
DATA EPS/1.D-8/
DATA W/0.d0/,SIG/0.d0/,L2/0/,L1/0/,L/0/ ! pre-init.
IER = 0
IF (M<N.OR.N<1) GO TO 19
6560 DO J = 1,N; VP(J) = J
ENDDO
! ROTATION LOOP
DO 10 K = 1,N
! PIVOT ELEMENT
6565 U = 0.D0
DO 4 J = K,N
C = 0.D0
DO 2 I = K,M
IF (DABS(A(I,J))<=DABS(C)) GO TO 2
6570 L2 = I
C = A(I,J)
2ENDDO
IF (C==0.D0) GO TO 4
S = 0.D0
6575 T = 0.D0
DO I = K,M
V = A(I,J)/C
S = S + V*V
T = T + V*B(I)
6580 ENDDO
IF (U>=T* (T/S)) GO TO 4
U = T* (T/S)
SIG = C*DSQRT(S)
W = T
6585 L = J
L1 = L2
4ENDDO
IF (U==0.D0) GO TO 11
Datei: ~/home/p5/p5.f95 Seite 109 von 110
! PERMUTE A(K) AND B(K)
6590 I = IDINT(VP(L))
VP(L) = VP(K)
VP(K) = I
DO I = 1,M
C = A(I,L)
6595 A(I,L) = A(I,K)
A(I,K) = C
ENDDO
C = B(K)
B(K) = B(L1)
6600 B(L1) = C
DO J = K,N
C = A(K,J)
A(K,J) = A(L1,J)
A(L1,J) = C
6605 ENDDO
! ROTATION OF THE LOWER COLUMN FRAGMENT OF A(K) AND B(K)
U = SIG + A(K,K)
V = A(K,K)/SIG
DELTA = (B(K)+V*W)/U
6610 A(K,K) = -SIG
B(K) = -V*W
L = K + 1
IF (L>M) GO TO 10
IF (K>=N) GO TO 8
6615 DO J = L,N
S = V*A(K,J)
P = DABS(S)
DO I = L,M
R = A(I,K)/SIG*A(I,J)
6620 S = S + R
P = P + DABS(R)
ENDDO
IF (DABS(S)<=EPS*P) S = 0.D0
T = (A(K,J)+S)/U
6625 IF (DABS(T)<=EPS*DABS(S/U)) T = 0.D0
A(K,J) = -S
DO I = L,M
Q = A(I,J)
P = T*A(I,K)
6630 R = Q - P
IF (DABS(R)<=EPS*DABS(P)) R = 0.D0
A(I,J) = R
ENDDO
ENDDO
6635 8DO I = L,M
B(I) = B(I) - DELTA*A(I,K)
ENDDO
10 ENDDO
! END OF ROTATION LOOP
6640 K = N
GO TO 12
11 K = K - 1
IER = int(K,KIND=2)
! SQUARE OF THE EUCLIDEAN NORM
6645 12 S = 0.D0
L = K + 1
IF (K==M) GO TO 14
DO I = L,M
S = S + B(I)*B(I)
Datei: ~/home/p5/p5.f95 Seite 110 von 110
6650 ENDDO
14 A(2,1) = S
IF (K==N) GO TO 16
! COMPONENTS OF X WHICH DO NOT REDUCE THE EUCLIDEAN NORM
DO I = L,N
6655 DO J = L,N
IP = IDINT(VP(J))
X(IP) = 0.D0
ENDDO
ENDDO
6660 IF (K==0) GO TO 20
! COMPUTATION OF X
16 IP = IDINT(VP(K))
X(IP) = B(K)/A(K,K)
IF (K==1) GO TO 21
6665 DO J = 2,K
L = K + 2 - J
S = B(L-1)
DO I = L,K
IP = IDINT(VP(I))
6670 S = S - A(L-1,I)*X(IP)
ENDDO
IP = IDINT(VP(L-1))
X(IP) = S/A(L-1,L-1)
ENDDO
6675 GO TO 21
! ERROR CODE
19 IER = IER - INT(1,KIND=2)
20 IER = IER - INT(1,KIND=2)
21 RETURN
6680 END SUBROUTINE
! Number of lines: 6681
Appendix A2 – TOPO Source Code
GFortran, free source form
Before displaying the TOPO source code, the data of the upper and lower lakes is provided (file:
zlakes.txt). The rectangular borders are given by their geographical latitudes and longitudes. The
reader is free to modify the numbers or extend the table by other lakes or continental seas. If the
table is to be extended, the number 14 (Anzahl der Gebiete/ number of areas) must be accordingly
adapted.
* *
* --- HOCH LIEGENDE BINNENMEERE --- *
* (zur Berechnung des tatsaechlichen Erdvolumens) *
* *
* Diese Datei enthaelt geographische rechtwinklige Gebiete mit *
* den groessten Binnenseen, die ueber oder unter dem Meesesspiegel- *
* niveau liegen. Die Begrenzungen werden durch die geographische *
* Breite und Laenge in dezimalen Grad gegeben. Vorzeichen: noerdl. *
* Breite pos./ suedl. Breite neg./ westl. Laenge neg./ oestl. Laen- *
* ge pos. Die Hoehe des Wasserspiegels ueber dem Meeresniveau (NN, *
* Normal Null) ist in Metern anzugeben. Aus programmtechnischen *
* Gruenden darf ein Gebiet nicht ueber den Nullmeridian reichen. *
======================---==
Anzahl der Gebiete: 14
======================---==
geograph. Breite geograph. Laenge Hoehe ueber NN
von bis von bis [m] (google)
=======================================================================
1. Lake Superior -------------------------- North America ------------
46.4 49.2 -92.7 -84.0 183. (184)
2. Lake Michigan
41.3 46.3 -88.4 -84.3 176. (176)
3. Lake Huron
42.9 46.5 -84.3 -79.7 176. (176)
4. Lake Erie
41.2 43.0 -83.9 -78.7 174. (174)
5. Lake Ontario
43.0 44.4 -80.0 -75.7 75. (75)
6. Great Bear Lake
64.2 67.3 -126.0 -117.0 156. (156 ?)
7. Great Slave Lake
60.7 63.2 -118.4 -108.8 156. (156)
8. Lake Winnipeg (*)
50.3 54.0 -99.6 -96.0 217. (217)
9. Kaspijskoje More (*) ------------------------ Asia ----------------
36.2 50.0 44.0 56.0 -28. (-28)
10. Aralskoje More (*)
43.1 47.2 57.7 62.5 53. (35 ?)
11. Ozero Bajkal (*)
51.4 55.9 103.4 110.0 455. (455)
12. Lake Victoria (*) -------------------------- Africa ---------------
-3.3 0.7 31.4 35.0 1134. (1134 ?)
13. Lake Tanganyika (*)
-8.9 -3.3 29.1 31.3 773. (782)
14. Lake Malawi (Lago Niassa) (*)
-14.5 -9.4 33.8 35.4 473. ( ? )
=======================================================================
(*) Hierbei ist in 'Worldbath' anstelle des Seebodens schon die
Hoehe des Wasserspiegels angegeben, was unser Ergebnis nicht
beeinflusst, da wir sowieso die Wasserspiegelhoehe benoetigen.
TOPO source code →
182
Datei: ~/home/topo/topo.f95 Seite 1 von 7
!=====================================================================!
! !
! !
! T O P O (gfortran) !
5! !
! !
! Programm zur Berechnung des Erdvolumens und weiterer Parameter !
! unter Beruecksichtigung der Land- und Wassermassen ueber Meeres- !
! spiegelniveau bei Verwendung der topographischen Daten von !
10 ! "Worldbath" und unter Beruecksichtigung der Ellipsoid- bzw. !
! Sphaeroidgestalt der Erde. !
! !
! Hans Jelitto !
! Hamburg, 9. Maerz 2025 !
15 ! !
! !
! Zum Programm gehoert die Datei der topographischen Hoehendaten !
! '[X]data.tsv'. Sie wurde von der Website (Worldbath): !
! !
20 ! http://iridl.ldeo.columbia.edu/SOURCES/.WORLDBATH/.bath/ !
! !
! unter 'Data Files' und 'Text with tab-separated-values' [X+] !
! heruntergeladen. !
! !
25 ! Als simplen Ansatz koennte man annehmen, dass die durchschnitt- !
! liche Hoehe zur Berechnung des Volumens der Landmassen genuegt. !
! Leider ist dieser Wert fuer die Berechnung des Erdvolumens nicht !
! brauchbar, da nur der Mittelwert der Daten berechnet wird. Dies !
! ist fuer kleine Gebiete, in denen sich der Abstand der geogra- !
30 ! phischen Gitterpunkte kaum aendert, zulaessig. Ueber groessere !
! Gebiete und speziell inklusive der Pole liefert diese Methode !
! jedoch keine korrekten Ergebnisse, da die unterschiedlichen !
! Gitterpunktabstaende nicht beruecksichtigt werden. Zum Vergleich !
! wird dennoch dieser vereinfachte Wert durch das Programm mit !
35 ! berechnet und als arithmetisches Mittel in Klammern angegeben. !
! Entsprechende Zahlen fuer die Landmassen ueber dem Meeresspiegel !
! sind unter "(arithm. mean)" aufgefuehrt. Sie sind jedoch auch !
! meist nicht korrekt wegen dieses zu einfachen Rechenansatzes. !
! !
40 ! Darueber hinaus kann die normale Mittelwertbestimmung sowieso !
! nicht verwendet werden, weil zur Berechnung des Erdvolumens in !
! unserem Fall auf den Meeresflaechen nicht der Meeresboden, son- !
! dern der Meeresspiegel als Grundlage dient. !
! !
45 ! Die Zahlen unter "vol.-based" entsprechen der mittleren Hoehe !
! gemaess dem tatsaechlichen Volumen. Die Berechnung wurde abge- !
! leitet aus Gleichung (78) mit gemitteltem Erdradius und Vernach- !
! laessigung des Terms hoechster Ordnung (h^3). Darueber hinaus !
! existieren zwei alternative Berechnungsmethoden (in Kommentare !
50 ! umgewandelt - siehe unten "!c"). Die Zahlen unter "ell.-based" !
! (ellipsoid-based) beruhen auf einem einfacheren Ansatz "Flaeche !
! mal Hoehe", das heisst ohne Volumeneffekte hoeherer Ordnung. !
! !
! In diesem Programm werden die groessten Binnenseen mit Ober- !
55 ! flaechen, welche sich ueber- oder unterhalb des Meeresspiegels !
! befinden, ebenfalls erfasst. Bei einigen Seen in Worldbath ist !
! der Boden und bei anderen Seen die Wasserspiegelhoehe angegeben. !
! Insgesamt betraegt die Volumenkorrektur, die sich durch solche !
! Seen mit Angabe Seeboden ergibt, ueber 2600 Kubikkilometer, was !
60 ! prozentual gesehen jedoch immer noch gering ist. !
! !
Datei: ~/home/topo/topo.f95 Seite 2 von 7
! --------------------- !
! !
! Zum Programm 'Topo' gehoeren nachfolgende 6 Dateien: !
65 ! !
! Datei Kurzbeschreibung !
! -------------------------------------------------------------- !
! topo Ausfuehrbare Programmdatei !
! topo.f95 FORTRAN-Quellcode, vorliegender Text !
70 ! [X]data.tsv Topograph. Daten (5 minute-grid, Worldbath) !
! zlakes.txt Korrekturdaten, hoch und tief liegende Seen !
! readme.pdf Kurzinformation zum Programm !
! out.txt Ergebnis-Datei (wird mit jedem Programmlauf !
! ueberschrieben) !
75 ! -------------------------------------------------------------- !
! !
!=====================================================================!
module constants; real(8) :: pi,a,c,dl,dnx
80 integer(4), parameter :: NX5 = 4320, NY5 = 2161
end module
module lakes; real(8) :: se(5,50),zero
integer(4) :: il(5,50),nlake
end module
85
program topo
!-----Hauptprogramm----------------------------------------------------
use constants; use lakes
90 implicit double precision (A-H,O-Z); integer(4) ivap(NX5)
! Bei folgenden Deklarationen (0:2) bedeuten die Indizes drei
! verschiedene Hoehen: "0" bedeutet Meeresboden, "1" Meeresspiegel
! und "2" Meeresspiegel mit hoch und tief liegenden Binnenseen.
real(8) ev(0:2),hmitt(0:2),hmitv(0:2),hmitw(0:2)
95 real(8) sumh(0:2),sumo(0:2),sumw(0:2),Vg(0:2),Vges(0:2)
character(38) :: title1,title2,line
character(23) :: dummy; character(11) :: tfile
!-----Parameter eingeben
100 title1 = ' EARTH`S VOLUME INCLUDING LANDMASS '
title2 = ' (Worldbath, 5 arc-minute resolution) '
line = '======================================'
open(unit=1,file='out.txt')
write(6,'(//4(21x,A38/))') line,title1,title2,line
105 write(1,'(/2(21x,A38/))') title1,title2
write(*,'(17x,''latitude .......... (min. -90.0) from : '')' &
& ,advance='no')
read(*,*) gbmin
if (gbmin<-90.d0 .or.gbmin>90.d0) go to 100
110 write(*,'(17x,''latitude .......... (max. 90.0) to : '')' &
& ,advance='no')
read(*,*) gbmax
if(gbmax<-90.d0 .or.gbmax>90.d0 .or.gbmax<gbmin) go to 100
write(*,'(17x,''ext. longitude east (min. 0.0) from : '')' &
115 & ,advance='no')
read(*,*) glmin
if (glmin<0.d0 .or.glmin>360.d0) go to 100
write(*,'(17x,''ext. longitude east (max. 360.0) to : '')' &
& ,advance='no')
120 read(*,*) glmax
if (glmax<0.d0 .or.glmax>360.d0 .or.glmax<glmin) go to 100
Datei: ~/home/topo/topo.f95 Seite 3 von 7
!-----5x5-Bogenminuten-Gitter (Worldbath)
tfile = '[X]data.tsv'
125 NX = NX5; NY = NY5
!-----Programmstart
dnx = dfloat(NX)
dgrad = dnx/360.d0
130 ibmin = idnint((gbmin + 90.d0)*dgrad + 1.d0)
ibmax = idnint((gbmax + 90.d0)*dgrad + 1.d0)
ilmin = idnint(glmin*dgrad + 1.d0)
ilmax = idnint(glmax*dgrad)
if (ilmax<ilmin) go to 100
135 db = dfloat(ibmax-ibmin+1)
dl = dfloat(ilmax-ilmin+1)
write(*,'(/'' Computation started. '')',advance='no')
do i=1,idint((gbmax+90.d0)/5.d0)
write(*,'(''>'')',advance='no')
140 enddo
write(*,'(/'' Output file: out.txt '')',advance='no')
!-----Einlesen der Daten hoch bzw. tief liegender Seen
zero = 0.d0
145 open(unit=10,file='zlakes.txt')
do i=1,14
read(10,*)
enddo
read(10,'(A23,I4)') dummy,nlake
150 do i=1,5
read(10,*)
enddo
do i=1,nlake
read(10,*)
155 read(10,*) (se(j,i),j=1,5)
enddo
do i=1,nlake
do j=1,2
il(j,i) = idnint((se(j,i)+ 90.d0)*dgrad + 1.d0)
160 enddo
if (se(3,i)>=zero) then
il(3,i) = idnint(se(3,i)*dgrad + 1.d0)
else
il(3,i) = idnint((se(3,i)+360.d0)*dgrad + 1.d0)
165 endif
if (se(4,i)>=zero) then
il(4,i) = idnint(se(4,i)*dgrad)
else
il(4,i) = idnint((se(4,i)+360.d0)*dgrad)
170 endif
!c write(*,*)'i, il(1..5) = ',i,(il(j,i),j=1,4),se(5,i)
enddo
close(10)
175 !-----Weitere Konstanten
! Aequatorradius Polradius
! Referenz-Ellipsoid Erde: a [m] c [m]
! ================================================================
! K.R. Lang, Astophys. Data, Planets ... 6378140 6356775
180 ! World Geod. System's Ref. Ellipsoid 6378137 6356752.3
! IERS Conventions (1989) 6378136 6356751.3
! IERS Conventions (2003) 6378136.6 6356751.9
! ================================================================
Datei: ~/home/topo/topo.f95 Seite 4 von 7
a = 6378136.6d0
185 c = 6356751.9d0
pi = 3.14159265358979324d0
V0 = (4.d0*pi/3.d0)*a**2*c * 1.d-9
! . . Ellipsoid-Oberflaeche, Hauptachsen: a = b > c (oblat)
e = dsqrt(1.d0 - (c/a)**2)
190 ath = 0.5d0 * dlog((1.d0 + e)/(1.d0 - e))
Feli = 2.d0 * pi * (a*a + c*c * ath/e) ! [m**2]
! . . Flaeche an den Polen (fuer -90 und 90 Grad geogr. Breite)
dwi = pi/(180.d0*dgrad)
call koord(-0.5d0*pi+0.5d0*dwi,x0,y0)
195 Fpol = pi * x0**2
! . . Kugel-Oberflaeche bei gleichem Volumen wie Ellipsoid
rm = (a**2*c)**(1.d0/3.d0)
Fkug = 4.d0*pi*rm**2! [m**2]
! . . Weitere Initialisierungen
200 imo = 5 * idnint(dgrad)
inum = 0
Fges = zero
do i = 0,2
sumw(i) = zero
205 Vg(i) = zero
Vges(i) = zero
enddo
!-----Berechnung - Volumen der Landmassen und Erdoberflaeche
210 open(unit=5,file=tfile,status='unknown', &
& access='sequential',RECL=NX*NY)
do k=1,ibmax
if (mod(k,imo).eq.0) write(*,'(''>'')',advance='no')
read(5,*) (ivap(i),i=1,ilmax)
215 if (k>=ibmin) then
do i=0,2; sumh(i) = zero; sumo(i) = zero; enddo
breite = -0.5d0*pi + dfloat(k-1)*dwi
call koord(breite,x,y)
r = dsqrt(x**2 + y**2)
220 ! . . . . Innere Hauptschleife (Beruecksichtigung des Meeresspiegels)
do l=ilmin,ilmax
ev(0) = dfloat(ivap(l))
ev(1) = ev(0)
if (ev(1)<zero) ev(1) = zero
225 call levels(ev(0),k,l,ev(2))
do i=0,2
ek = ev(i)
sumh(i) = sumh(i) + ek
! . . . . . . mit Volumenanteilen hoeherer Ordnung
230 sumo(i) = sumo(i) + ek*(1.d0 + ek/r + ((ek/r)**2)/3.d0)
enddo
inum = inum + 1
enddo
! . . . . Flaechenberechnung (Meeresspiegel)
235 call stripe(breite,dwi,100,Fi,Fh)
if (k.eq.ibmin) Fi = Fi - Fh
if (k.eq.ibmax) Fi = Fh
if (k.eq.1.or.k.eq.NY) Fi = Fpol * dl/dnx
Fges = Fges + Fi
240 do i=0,2
sumw(i) = sumw(i) + sumh(i)/dl
! . . . . . Vg: Volumen zur Berechnung der mittleren Hoehe
Vg(i) = Vg(i) + Fi*sumh(i)/dl
Vges(i) = Vges(i) + Fi*sumo(i)/dl
Datei: ~/home/topo/topo.f95 Seite 5 von 7
245 enddo
endif
enddo
close(5)
250 !-----Ergebnisse der mittleren Hoehe
do i=0,2
! . . . Mittlere Hoehe nach Flaechenanteilen auf Meeresspiegelniveau
! (Naeherung gemaess Volumen = Flaeche * Hoehe)
hmitt(i) = Vg(i)/Fges
255
! - - - 1. Mittlere Hoehe gemaess Volumen: Berechnung abgeleitet aus
! Gleichung (78) mit mittlerem Erdradius und Vernachlaessigung
! des Terms hoechster Ordnung (Hoehe^3)
hmitv(i) = -rm/2.d0 + dsqrt(Vges(i)*rm/Fges + rm**2/4.d0)
260 ! write(*,'(/3x,a7,f10.3)')'1. h =',hmitv(i)
! . . . 2. Alternative Berechnung mit Ellipsoidform und auch Vernach-
! laessigung des Terms hoechster Ordnung (Hoehe^3)
!c cube = 0.75d0*Vges(i)/pi
265 !c q = a*(a/2.d0 + c)/(2.d0*a + c)
!c hmitv(i) = (-q + dsqrt(cube/(2.d0*a + c) + q**2)) * Feli/Fges
! write(*,'(3x,a7,f10.3)')'2. h =',hmitv(i)
! . . . 3. Alternative Berechnung mit Kugelvolumen und Korrektur ge-
270 ! maess Ellipsoid-Oberflaeche (bei sehr kleiner Flaeche ungenau
! bzw. falsch, wie z.B. bei einem oder wenigen Punkten nahe Pol)
!c cube = rm**3 + 0.75d0*Vges(i)/pi
!c hmitv(i) = (-rm + cube**(1.d0/3.d0)) * Fkug/Fges
! write(*,'(3x,a7,f10.3)')'3. h =',hmitv(i)
275
! . . . Arithmetisches Mittel
hmitw(i) = sumw(i)/db
Vges(i) = Vges(i)*1.d-9
enddo
280 ! . . Ergebnisse (Flaeche und Volumen)
Fges = Fges*1.d-6 ! Gesamtflaeche (aufintegriert)
Verdl = Vges(2) - Vges(1) ! Volumen der hoeher gelegenen Seen
Verdg = V0 + Vges(1) ! Erdvolumen (Ellipsoid) + Landmassen
Verds = V0 + Vges(2) ! Erdvolumen + Landmassen + h. g. Seen
285
!-----Ergebnis-Ausgabe
write(*,'(/)')
do iu=1,6,5
write(iu,'(1x,78a1)') ('=',i=1,78)
290 write(iu,'(7x,A26,f13.1,A29)')'Earth`s equator. radius :', &
& a,' m (IERS conventions, 2003)'
write(iu,'(7x,A26,f13.1,A29)')'Earth`s polar radius :', &
& c,' m (IERS conventions, 2003)'
write(iu,'(7x,A26,f13.1,A2)')'Earth`s mean radius :', &
295 & rm,' m'
write(iu,'(7x,A13,A16,f8.2,A4,f8.2,3X,A16)')'Geograph. lat', &
& 'itude [deg] : ',gbmin,' to',gbmax,'used grid points'
write(iu,'(7x,A13,A16,f8.2,A4,f8.2,5X,I14/)')'Extended long', &
& 'itude [deg] : ',glmin,' to',glmax,inum
300 write(iu,'(A33,A44)') ' Kind of average ', &
& ' ell.-based vol.-based (arithm. mean)'
write(iu,'(7x,70a1)') ('-',i=1,70)
write(iu,'(A33,F11.3,A2,F12.3,A6,F10.3,A3)') &
& ' (A) Average height (sea bed) :',hmitt(0), &
305 & ' m',hmitv(0),' m (',hmitw(0),' m)'
Datei: ~/home/topo/topo.f95 Seite 6 von 7
write(iu,'(A33,F11.3,A2,F12.3,A6,F10.3,A3)') &
& ' (B) Average h. (sea level) :',hmitt(1), &
& ' m',hmitv(1),' m (',hmitw(1),' m)'
write(iu,'(A33,F11.3,A2,F12.3,A6,F10.3,A3)') &
310 & ' (B*) Average h. (upper lakes) :',hmitt(2), &
& ' m',hmitv(2),' m (',hmitw(2),' m)'
write(iu,'(7x,70a1/)') ('-',i=1,70)
write(iu,'(A24,A27,1p,1e19.9,A5)')' Covered area ....', &
& '. (sea level, integrated) :',Fges,' km^2'
315 write(iu,'(A24,A27,1p,1e19.9,A5)')' Ellipsoid surface', &
& ' ........... (analytical) :',Feli*1.d-6,' km^2'
write(iu,'(A23,A28,1p,1e19.9,A5/)')' Surface of spher', &
& 'e ......... (equal volume) :',Fkug*1.d-6,' km^2'
write(iu,'(A24,A27,1p,1e19.9,A5)')' Volume correction', &
320 & ' ............. (as per A) :',Vges(0),' km^3'
write(iu,'(A24,A27,1p,1e19.9,A5)')' (C) Volume of landmas', &
& 's ............ (as per B) :',Vges(1),' km^3'
write(iu,'(A24,A27,1p,1e19.9,A5)')' (C*) Volume of landmas', &
& 's + lakes ... (as per B*) :',Vges(2),' km^3'
325 write(iu,'(A22,A29,1p,1e14.4,A10/)')' Volume of upper', &
& ' lakes ........... (C* - C) :',Verdl,' km^3'
write(iu,'(A24,A27,1p,1e19.9,A5)')' (D) Earth`s volume ..', &
& '.. (ellipsoid, sea level) :',V0, ' km^3'
write(iu,'(A23, A28,1p,1e19.9,A5)')' (E) Earth`s volume +', &
330 & ' landmass ........ (D + C) :',Verdg,' km^3'
write(iu,'(A24,A27,1p,1e19.9,A5)')' (F) Earth`s vol. + la', &
& 'ndm. + lakes ... (D + C*) :',Verds,' km^3'
write(iu,'(1x,78a1/)') ('=',i=1,78)
enddo
335 go to 200
100 continue
do iu=1,6,5
write(iu,'(/A36,A20)')' -----> Insert a correct number: ',&
& 'lat-max >= lat-min,'
340 write(iu,'(37x,a25//)')'lon-max >= lon-min + 0.05'
enddo
200 close(1)
stop
end program topo
345
subroutine levels(ev0,k,l,ev2)
!-----Erfassung von hoch oder tief liegenden Binnenseen. Falls
! zutreffend wird die Hoehenangabe 'ev2' korrigiert. (Anmerkung:
! Die Gebiete duerfen nicht ueber den Nullmeridian reichen, was
350 ! auch nicht vorkommt. Gegebenenfalls waere eine Loesung, das
! Gebiet entlang des Nullmeridians zu teilen.)
use lakes
implicit double precision (a-h,o-z)
ev2 = ev0
355 do i=1,nlake
elev = se(5,i)
if (il(1,i)<=k.and.k<=il(2,i).and. &
& il(3,i)<=l.and.l<=il(4,i)) then
if (ev0<elev) ev2 = elev; go to 10
360 else
if (i>=nlake.and.ev0<zero) ev2 = zero
endif
enddo
10 return
365 end
Datei: ~/home/topo/topo.f95 Seite 7 von 7
subroutine koord(br,x,y)
!-----Input: 'br' geograph. Breite; Output: 'x' Abstand des Brei-
! tenkreises zur Erdachse, 'y' Abstand des Breitenkreises zur
370 ! Aequatorebene (mit Vorz.); Berechnung fuer abgeplattete
! Sphaeroidgestalt.
use constants
implicit double precision (a-h,o-z)
x = a / dsqrt(1.d0 + (c*dtan(br)/a)**2)
375 y = c * dsqrt(1.d0 - (x/a)**2)
if (br<0.d0) y = -y
return
end
380 subroutine stripe(b,dwi,n,F,Fh)
!-----berechnet die Flaeche F des Streifens (Breite 'dwi') zwischen
! zwei Breitenkreisen mit den geographischen Breiten b-dwi/2 und
! b+dwi/2 auf der Ellipsoid-Oberflaeche. Der Winkel dwi ist der
! geographische Breiten- bzw. Laengenunterschied zweier benach-
385 ! barter Gitterpunkte im Bogenmass. Je groesser der Parameter 'n'
! ist, desto genauer ist die numerische Integration der Oberflae-
! che. (Der Parameter n teilt den Streifen der Flaeche F in 2*n
! parallele duenne Streifen, wobei n = 100 hier voellig ausrei-
! chend ist.)
390 use constants
implicit double precision (a-h,o-z)
ti = 1.d0/dfloat(2*n)
F = 0.d0
call koord(b-0.5d0*dwi,x1,y1)
395 do i=1,2*n
call koord(b+(dfloat(i)*ti-0.5d0)*dwi,x2,y2)
dbr = dsqrt((x2-x1)**2 + (y2-y1)**2)
F = F + (x1+x2)*dbr
if (i.eq.n) Fh = F * pi*dl/dnx
400 x1 = x2
y1 = y2
enddo
F = F * pi*dl/dnx
return
405 end
! Number of lines: 406
Use of programs P5, TOPO, and description
!! !"#!#$%&'( )*+,-
.$!/01
$2
3&4567 $8
%09
$: %0
$:
9$
2
;
Further copyrights
<<
1
".1
!!$
Subroutine VSOP87 + associated data files%=,>
>=,?@0&$7) A$7:8>9
>>>>8BC%456#0$#!#,5C
&6C%6C01,6$
Program package FITEX%
0&D8%4567.0D8%1&:ED:F
D FA0 8 - %4567#.0
%1&8GD28880$:8CH1A$I$,
J@#$$A&DBK8+-B8
-C,,DD"!L" % J?!0 %4567#0 DD
"!L" $,% J?"0%4567#L0DFD%DD0E2
6$
Data file [X]data.tsv 2I&
C1858M6KCK641
+*2%456 "0C&+--+--
%4,10+C18%4567 .0$
Subroutine DELTA_T and numbered equations in the Universal Time section %
14140&
@/:C2B
+-,-CI,CK%456L0$
Site plan of Teotihuacán %:$ .0& -
:6 --B5
+8-
8+-%456#@0$
P3, P4, P5, TOPO programs and all remaining program parts, data files, text, and
figures%7 !!$=,?@
® =,?@H<=,?@E0&C #K#!"@A$
Comment: Concerning the P5 program, the TOPO program, related files, and this manu-
al, there appears to be no problem with the use if it is for nonprofit use and if the authors
and copyright owners, respectively, are appropriately quoted. If some of the items in the
list above are to be used separately, this should be checked individually. Nevertheless,
the correct use and acceptance of copyrights is the sole responsibility of the user.
?@
Internet addresses
I %4560
2$12
2<<%
20$2 11 2
456N$$%4567 J08
$K8
221$:21
4H1)5A%5A02$
845628
&
$ 456%7N70%7N7=0
456,O$
#$ 22$82
456$
"$ 8456
8$
8282$-1
4561$818
P
$+$
22
2$81
$+&81
8-1%1$0$
List of Internet addresses
No. URL
&MMQ$M$
# &MM$1$$M%B,5C8BC #!#6C0
" &MM$$MMMM1?@M
. &MM$2$MM$
&MM$$$1M$
L &MM$$$1M,CM#!!.$
@ &MM1$MM,2AR !#!
? &MM$M
J &MM$$$1MMMB$
! &MM$$$1MMM=$
&MM$Q$$1MMR$
# &MM$$$1M,CM#!!.$
" &MM$$$M,45C,M$I56K)-M$M
??
. &MM$$$1MM
&MM$Q$$1MMR$
L &MM$$MM,
@ &MM$Q$$1MMR1$
? &MMQ$M2$
J &MMQ$MF$
#! &MM2$MM#
# &MM2$MM
## &MM$F$MBMM!J.""JL#L"
#" &MM$$MM $#$!M$
#. &MM$$2$MM$
# &MM2$2$2$MM2M$ST@@?L"J
#L &MM2$2$2$MM2M$ST@@?L.!
#@ &MM$$$
#? &MM$$1$MM J?#-U#L-$$$ .$$#@?)M
#J &MM$$1$MM J??-U#L-$$$#!#$$"!J)M
"! &MMQ$M$
" &MM1$MM" J#.! #!"?J#@M
"# &MM$F$MRMRF$
"" &MMF2$M
". &MM$M2M6J@#.LBM6PRRRR
" &MM1$MM2!!
"L &MM$$$1MI")MM$
"@ &MM$$MM
"? &MM1$MM2 MMMM
"J &MM1$MM2#MMMM
.! &MM1$MM2"MMMM
. &MM1$MMRR@:B"-O--B--MMLMM
.# &MM?!##!$$1$M" MMA= J !CM
J !RARRR=R $
." &MM1$1$M1MMM J "RBCRARRR88$
.. &MM1$MM! MM?MM
. &MM1$MM!#MM !MM
.L &MM1$MMRJ@??@"?.@ L@MM.MM
.@ &MM$$$MM ?"J ST#@@#@J?L #?.# "!
.? &MM$$$MM ?.!#ST#@@#@J?L #?.# "!
.J &MM$$$MM ?.#"ST#@@#@J?L #?.# "!
?J
! &MM$$M$STRVTV8T #JVTMMMM
#!!M! M J$
&MM$$MMMM#! "M!JM# ?." "$
# &MM$$MMMM1#! "M
" &MM$$MMMM#! "M
. &MM$$MMMM9MMM JR#! J # .$
&MM$$MM
L &MM$$MM9MMM#
@ &MM$$1$MM J?#-U#L-$$$ .$$#J@,M
? &MM$$MM?..!@ .!?@?@"@"LLM
8$ST$0
J &MM$$MM @ @#@M8-4#!!!-8-4#!!L+
8
L! &MM$$2$$MWM
L &MM1$MM)-)- MM#MM
L# &MM$$$1MMM$
L" &MM$Q$$1MMR2$XMST,
L. &MMF$$MC,K,#! MC,K,#! "@?$
L &MM#$$MMMMM#! J$+)R$
LL &MM2$MM1
L@ &MM$$MS1TOCL+C
L? &MM$$MS1T K6BF:.
LJ &MM$$MS1TA=1=B=8!
@! &MM$ ?$M21QQ#!#"M
J!
References
Y Z )$&>1P><,=,?#$-
-114% J?#0#@?<#??)& J?#-V-$$$ .$$#@?)%4567#?0®
Y#Z )$:A$&1<=,?@$
--202% J??0"!J<" )& J??-V-$$$#!#$$"!J)%4567#J0®
Y"Z $&A-[1AF<8&K$
AFI5=82GW 44/1% JJ0"<#?5A®
Y.Z $&A-[1AF<88&B2
AAFI5=82GW 44/2% JJ0JJ<
#!5A®
YZ $&<C1B[A
1AF$IV2=)% JJJ0%456"!01&5A
%,121$0
YLZ IB:&AF$:V,2BV$
-V$6/,VI+*2% ??"0%4567" 0®$%+
1 ??"%456"#0$0
Y@Z 5>9-PC%C0>M &!!!B\P5
&%06F–17F–18%AF06H–23%,990$
K+,584B,$:$,$M8$A$+$<:5-+C J@?> &!!!-1 J@@
,>>>>1>>9,45=C*:CA*1E2
)%4567""0
Y?Z C%,10 !!!&%0,79/630 and
79/645%-078/630 and 78/645%K01E2
)%4567""0
YJZ B=5&6P-B$5
% JL0&Part IVmap 1&+AF%110$8&
map 3&11map 4&map 5&
map 6&OPmap 7&DP%4567".0
Y !Z 2IC&62]$C&2I$II$&
FIA% J?#0)8$J@!)8=$ ##@< #"J%4567"0
Y Z I^I&-_,$2E#$% JJ.0
Nr. 2?K8& !$ !!#MF$ JJ.!#!#!"
Y #Z $K1$I25$6B$II$)A$&5
C$+C)-58,379 ii% J?@0?
Y "Z $&AF<.K$
5A%#! 0K8& !$ " .!M5A$#$ $ "$# L.®
Y .Z $&)2#%0
Y Z ,5$&K_<=EFI$=1E
BFM5EI)K $-% J?0
Y LZ ,A$7I$&8DFDE26% J@"
J?0%0
Y @Z A$7$&DBK8+-B8-C,,
$DFD%DDD80E26KfK?3063% J?!0%4567#0
KfK?3063 – 1. Supplement% J?"0%:8CH0%4567#L0
Y ?Z B$&--$:CCI)8$5=4,-% JJ 0
%4567#!0
Y JZ B$7-$&,2.$!%0``2$DB,
$$) !L@--B8.? !L4,-aB2-$%4567@0
Y#!Z )15$A-$&KA$6=BG6F% JJ.0
Y# Z )4$5^,$&B, <.%B ? @"
#9#!!!$!0$,2-2=)
+*2% JJ JJ"0
J
Y##Z 5^,$)4$&B,$)$8$K,42% JJ"0
%4567"L0<:&,8B)-K%4567"@0
Y#"Z ,&-2A+4A6%4567?0
Y#.Z $&A2<K21AF$$&
:G-_-2,C8%--,0,E 5/15%#! 0 .<#
5A®
Y#Z B$&$I)8$5=4,-% J?J0%456##08,)+&J@?!J.""JL#L#
Y#LZ $&b,,$82%.7$0
8-1414%B"#!#!0
K8& !$ " .!M5A$#$#$ "#!$L!L.JM#
Y#@Z $&b$%0
Y#?Z 6D$5$&-K&,$,+*2) C% JJ#0
.!<. 8,)+ .L?.!L.#L,+*2%#! #0
Y#JZ )$7B$K$&-K,5
-500&6 J<6 J?% JJ?0K8& !$ !?LM" . L
Y"!Z C2:$B$&CK%`:1B,
C(0$+-,-CI,A,:,,CK1%#!!.0%4567L0
Y" Z C2:$B$&4K%`:1B,C(0$
+-,-CI,A,:,,CK1%#!!.0%4567 #0
Y"#Z ,FF&6I2A$CKCVol. I – III
% ?L@02&1$8<888%4567"?<.!0
Y""Z ,FF&AC$-&-1B5
1Vol. XIII ?L!< ?LJ+V$C% ?@ 0$"$ L<#%4567. 0
Y".Z CB&A<$)AVol. I, II
% J ! J "01%0&1$888%4567.#."018-1%1$0
Y"Z =,&AF ?"@$
:6Vol. I – III% ?.!< ?.#02&1$8<888%456..<.L0
Y"LZ ,&AF$Vol. I – IIIC$-C$7$6% J"J< J.#041_
&1$8<888%4567.@<.J0®$"
1'AF ?"@($=$
Y"@Z :-$,$6$&-
$--%-V-0429%#!!0"L <"L@)&#!!-V-$$$.#J$$"L :%456!0
Y"?Z ,$6$:A$:-$B$&+=,#! "
#! "$-$-$@-.J%#! "0%4567 0&=,#! "%4567#0#! "
%4567"0
Y"JZ :-$K$==$K5-$)6$KK$AB$62$&
8+ J$+,9938B>9>
, !J%#! J08,)+J@?#J !! ? @%4567.0®8+ J%456708+#
8+# %4567L0
Y.!Z ,C$B$&6CKC#!!M6C#!!KC9#!!!$
--114% J?#0#J@<"!#)& J?#-V-$$$ .$$#J@,%456@0®
Y. Z ,C$B$&1)6PKC#!!-
-$--233% JJ!0##<#@
Y.#Z 25$,$:2I$B$I$A$)K$$&66CKC..!
KC.. $- L M !%#!# 0K8& !$"?.@M "?"?? M. .
Y."Z =$$&-[-$)8I1BIEG% J??0
Y..Z ,$D$-)$-$-PB$:$$&58-4M8-AI2A
&#!!L$B$K$-$98%#!!@0 < ?!
K8& !$ !!@M !LJ!!@J!@#
Y.Z KG2-$&1-F=C$,%Q2041_
,A_8%#!!J0K8& !$ ?. JM"? ?
J#
Y.LZ =$,$7$=K$7-$&8-4#!!!-8-4#!!L+
8$,B#!!J= ".-1-,
J--,M-8--,:BB:$? ##!!J,1A$
AAS 09-159%#!!J0J J$%4567?0%4567J0
Y.@Z I-$7K$&19$41_,A^MitAG 62
% J?.0#! <#!.%4567L!0®'K(®
Y.?Z KQ-$&-A>><-,>9c>B>9>$,C
c&$V5$,% JJ0
Y.JZ $&B="!!!)d-K@!!!:$
%#!##05AK8& !$ " .!M5A$#$#$# .?J$"L?!M
Y!Z B6$,:$5$`=CP2CK
C`$$-$35Part 3-#!!.No. 120%#!!.0"#@<""L
Y Z ,:$5$B$-$&Atlas of Historical Eclipse Maps. 41$$$% J?L0
Y#Z B,1K$&*$1+-,--K,
$)$-$-$102/1% JJ#0.!<.#)& JJ#)--$$ !#$$$.!B
Y"Z )6&6_51A2AA$,
=)% J#L0%4567L 0
Y.Z $$&KC,FAAF$,1C
+$"JA1% J#0
YZ $&1-F-$K= $-% JJ"0
YLZ I&I&C1858M6KCK
641+*2%456 "0
Y@Z D$5$)5$8$,2H$,$&,3,)$6+
+392% JJ?0 < @
Y?Z BB$8-$-$$&K,$
,$290%#! 0L@"<L?@K8& !$ !!@M #!@! !LL
YJZ CA5B +--+
--%4,10+C18%4567 .0
YL!Z Q1C$=$,C$B$&B6-BCB
5-4$$B$K$-$103/4%#!!J0"L<"@#
K8& !$ !!@M !LJ!!JJ#!"?
YL Z $-M&IK$5$+-,-A,:ABK#!@@
%#! J0%4567L#0
YL#Z 6,)K62%,0$68
1B#!#.%456L"0
YL"Z b-$D$BG$A$$&`+`&-1+=88$,F
%J!"@@0,#! !CD "J$-$-$541%#! #06L
K8& !$ ! M!!!.L"L M#! # ??@.H1& #!.$!?JJ)&#! #-V-$$$. 6$$$L
YL.Z ,)$F$6$-B$$&,FC
$C,- Vol. 6C,K,#! "@?C,K,B%#! 0)&
#! $$$ "@ ,%456L.0®
YLZ D$BA$2-$$$&%##!??0#!!@5 !$
%#! J08$334%#! J0" $!#$7"< !K8& !$ ! LMQ$$#! J$!"$! "H1& J!"$!."J)&
#! ?K,$$$$!" !#D
YLLZ )B$C$&FB22$-$$6$@L@M %#! "06@
K8& !$ !??M#!. ?#!M@L@M M6@H1& "!.$ !. )&#! "-$$$@L@6$$$@)
YL@Z )5:$,)$F$6$$&,F,-K-6
Q%!!!!0OB,$-$$773%#! "0#L
K8& !$ !??M!!!.L"@HM@@"M M#L)&#! "-$$$@@"$$$#L)
YL?Z KC$$K,$$6$&P$-$$
877/1%#! J0. K8& !$"?.@M "?."@M ""H1& J!.$!!##
J"
YLJZ F$,,F$,)$$&F
$+!%#! @0# J<##"K8& !$ !"?M#.!
Y@!Z AI$B$+D$,$5$A$$&B$8334
%#! J0L#<@?%4567L0K8& !$ ! LMQ$$#! J$!"$!"
Y@ Z )B$C$))$$&KBFD)Q-6B-1$
-$$ .M %#! @0 J<#K8& !$"?.@M "?"?? ML".LH1& @!#$!@. .)&
#! @-$$$$ .$$$ J)
Y@#Z 5:$6$)5:$=6B$$&C1%"!@#L 0
#!!#B,.$C,#!# $C,$K8& !$ J.M#!# ..!
C,#!# ..!$51 ",#!# $
Y@"Z +:$4$6$B$$&BNew Horizons
$8287%#! @0 #<#JK8& !$ ! LMQ$$#! L$!L$!#@H1& L!"$!!?#
Y@.Z :,$6C$BG$$&`+`&-1+=888$
Herschel-,,85C1@!<!!e$-$-$
555- %#! "0K8& !$ ! M!!!.L"L M#! "# "#J
Y@Z )B$C$))$$&BFDQ$-$$ LM.%#! ?0 L.<
LJK8& !$"?.@M "?"?? MJ#H1& ?! $!@## )&#! ?-$$$$ L$$ L.)
Y@LZ $&C:$-$,$B$5-$-&
+$HHH8% J?0
Y@@Z B$&B-B=$I)8$5=4,-%#!!J0 ?#
8,)+J@?!J.""JLJ#@%4567LL0%&"$-,07
Y@?Z )B$C$Q$5FK$&K1$-
617/1%#!!.0L.<L.JK8& !$ !?LM.##!JH1&M!.!..L
Y@JZ E2=$-$,21-$-$:1D$,$$&-B,#!#J#!".$
-1,568/7%#!# 0#@#<#@@K8& !$ ! LMQ$$#!# $!$!"H1&# #$ "! @
Y?!Z E2=$-$)1-$-$,21-$-$$&B+Q,&
$@.8-%8-0)2-FQ
= -,%80%#!#"05A
Y? Z -$$B$:$++$$$&1
+Q$#!#.--,M-8---,K1%#!#.0
5A®
Y?#Z K:$-B$-)-$$&C-,+&,$
.,,C-1%,,C-0)%#!##08,)+&J@??. J ?..!K8&
!$?# MJ@??. J ?..!$!?"®
Y?"Z $&A<K-1AF$-=B2
BF#!!!Spezial 6/156%#!!!0 #<##K8& !$ .?!M??#$".@®
Y?.Z $&A[<KD$-=B2BF#!!!
Spezial 27/221%#!!L0L< LK8& !$ .?!M??#$#J"®
Y?Z $&%80<KAF1^6$=%L!B$0
+=,66F%#! "01K=K*%4567L@0K8&
!$ " .!M5A$#$#$#.@J#$"@ #J
Y?LZ $&88<AFE2A2$=%@#B$0
$+=I,66F%#! .0*%4567L?0K8&
!$ " .!M5A$#$#$ "@!$J?.?
Y?@Z $&K21bA1,$=%"!B$0
+CK-*BCC8+A#!#"%-$-$,$0KBE:2M,F%"!$,$#!#"01
1*%4567LJ0-+A-5 ?)%4567@!0
Y??Z $&K21bA1,$%
0F+CK-*BCC8+A#!#":2M,F:G-_-
2,C8-$-$,$%#!#"0J!< !5A®%Y?@Z0
Y?JZ 4A+4:<:1.$@$#%A0:,:)B-%#! #0%4567#"0
J.
J
JL