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