program rondel
DOUBLE PRECISION A,AV,AN,AR,FI,hs,hm,h0,h0r,r,r0,T,T0
DOUBLE PRECISION P,P0,HN,HN0,d,pm,ps,k,kr,qm,qs,RAD
DOUBLE PRECISION TS,EP0,EP1,EP2,EP3,EP,PI,i,VM,NM
DOUBLE PRECISION VEK,hmr,hsr,FIR,EPR,VMR,NMR,ARV,ARN
DOUBLE PRECISION A1,A2,A4,AV1,AV2,AV4,AN1,AN2,AN4
Integer W
c Vstup dat 8
write(*,1)
1 format(5X,22H Zadaj Zemepisnu sirku:)
read(*,*)FI
write(*,2)
2 format(5X,30H Zadaj Nadmorsku vysku rondelu:)
read(*,*)HN0
write(*,3)
3 format(5X,37H Zadaj Teplotu v st.Celzia a Tlak hPa:)
read(*,*)T,P
write(*,4)
4 format(5X,29H Zadaj vek rondelu napr.-4800:)
read(*,*)VEK
c Blok konštant 21
PI=3.141592653589793
pm=0.950722
qm=0.25605
ps=0.0024428
qs=0.2665638
kr=0.00899321
EP0=23.452294
EP1=-0.0130125
EP2=-1.63888D-06
EP3=5.02777D-07
T0=10
P0=1013
RAD=57.29577952
c Reálny horizont 35
write(*,5)
5 format(5X,36H Zadaj nadm.vysku vzdialeneho obzoru:)
read(*,*)HN
write(*,6)
6 format(5X,36H Zadaj vzdialenost obzoru v metroch :)
read(*,*)d
c h0r pocitane v radianoch 42
h0r=datan((HN-HN0)/d)
write(*,7)h0r
7 format(5X,5H h0r=,F14.10 )
c r0 a r v stupnoch 46
h0=h0r*180./PI
r0=0.5831984 - 0.1978208*h0 + 2.838004D-02*h0*h0
r=r0*(1-0.036*(T-T0)*0.0010*(P-P0))*EXP(-HN/8400)
c Oprava výšky 50
write(*,8)h0
8 format(5X,4H h0=,F14.10)
write(*,9)r0
9 format(5X,4H r0=,F14.10)
write(*,10)r
10 format(5X,3H r=,F14.10)
k=kr*d/1000.
write(*,11)k
11 format(5X,3H k=,F14.10)
c Oprava vysky Slnko 60
hs=h0-r+ps-k +qs
c Oprava vysky Mesiac 62
hm=h0-r+pm-k +qm
write(*,12)hs,hm
12 format(5X,4H hs=,F14.10,5X,4h hm=,F14.10)
c Blok vypoctu sklonu ekliptiky 66
TS=(VEK-1900)/100.
write(*,13)TS
13 format(5X,4H TS=,F14.10)
EP=EP0+EP1*TS+EP2*TS*TS+EP3*TS*TS*TS
write(*,14)EP
14 format(5X,4H EP=,F14.10)
c rozhodovaci blok deklinacie 73
write(*,30)
30 format (5X,29H Je deklinacia zaporna? ano=0:)
read(*,*)W
i=5.14539
IF(W)32,31,32
31 EP=-EP
VM=EP-i
NM=EP+i
GO TO 33
32 VM=EP+i
NM=EP-i
33 write(*,15)VM,NM
15 format(5X,4H VM=,F14.10,5X,4H NM=,F14.10)
c Blok prevodu uhlov na radiany
hmr=hm*PI/180.
hsr=hs*PI/180.
FIR=FI*PI/180.
EPR=EP*PI/180.
VMR=VM*PI/180.
NMR=NM*PI/180.
c Vypocet pre Slnko
AR=(dsin(EPR)-dsin(FIR)*dsin(hsr))/(dcos(FIR)*dcos(hsr))
write(*,16)AR
16 format(5X,4H AR=,F16.10)
c Vypocet pre vysoky Mesiac
ARV=(dsin(VMR)-dsin(FIR)*dsin(hmr))/(dcos(FIR)*dcos(hmr))
write(*,17)ARV
17 format(5X,5H ARV=,F16.10)
c Vypocet pre nizky Mesiac
ARN=(dsin(NMR)-dsin(FIR)*dsin(hmr))/(dcos(FIR)*dcos(hmr))
write(*,18)ARN
18 format(5X,5H ARN=,F16.10)
c Blok azimutov v stupnoch
A=RAD*datan(DSQRT(1.-AR*AR)/AR)
write(*,19)A
19 format(5X,9H A_Slnko=,F16.10)
AV=RAD*datan(DSQRT(1.-ARV*ARV)/ARV)
AN=RAD*datan(DSQRT(1.-ARN*ARN)/ARN)
write(*,20)AV,AN
20 format(5X,16HVysoky Mesiac A=,F16.10,5X,15HNizky Mesiac A=,F16.10)
write(*,21)
21 format(5X,51H~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~)
write(*,21)
write(*,21)
c Blok Vysledkov
c Slnko
IF(W)42,41,42
41 A1=0
A2=0
A4=360+A
A=-A
GO TO 43
42 A1=180-A
A2=180+A
A4=0
A=0
c Mesiac
43 IF(W)52,51,52
51 AV1=0
AV2=0
AV4=360+AV
AV=-AV
AN1=0
AN2=0
AN4=360+AN
AN=-AN
GO TO 53
52 AV1=180-AV
AV2=180+AV
AV4=0
AV=0
AN1=180-AN
AN2=180+AN
AN4=0
AN=0
53 write(*,22)
22 format(5X,7H Slnko:)
write(*,23)A1,A2,A,A4
23 format(5X,4HAnw=,F8.4,5H Ane=,F8.4,5H Asw=,F8.4,5H Ase=,F8.4)
write(*,21)
write(*,24)
24 format(5X,8H Mesiac:)
write(*,25)
25 format(5X,14H Vysoky Mesiac)
write(*,26)AV1,AV2,AV,AV4
26 format(5X,4HAnw=,F8.4,5H Ane=,F8.4,5H Asw=,F8.4,5H Ase=,F8.4)
write(*,21)
write(*,27)
27 format(5X,13H Nizky Mesiac)
write(*,28)AN1,AN2,AN,AN4
28 format(5X,4HAnw=,F8.4,5H Ane=,F8.4,5H Asw=,F8.4,5H Ase=,F8.4)
write(*,21)
STOP
END