C       PROGRAM NA VYPOCET POLOHY KONCA TIENA TYCE SL. HODIN
C               - KLASICKYCH AKO NA SKALNATOM PLESE
C               - VALCOVYCH AKO BUDU G2
c
c       authors: J. Budaj
c       contact: budaj@ta3.sk
c       published: http://www.ta3.sk/~budaj/software
c       special requirements:
c       non original routins:
c       input: keyboard
c       output:  SLN.DAT
c
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        OPEN(2,FILE='SLN.DAT',STATUS='NEW')
        WRITE(*,'(15X,A)')' VYSTUP BUDE AJ V SUBORE "SLN.DAT" '
        WRITE(*,'(A,$)')' DEKLINACIA SLNKA [STUP.xxx] => '
        READ(*,*)DELTA
        WRITE(*,'(A,$)')' DLZKA TYCE => '
        READ(*,*)EL
        WRITE(*,*)' AKCEPTUJ ZEM.S. SKAL. PLESA   -1-'
        WRITE(*,'(A,$)')'  INA ZEMEPISNA SIRKA [STUP.xxx] => '
        READ(*,*)FI
        IF(ABS(FI-1.D0).LT.1.E-10)THEN
          FI=49.D0+11.D0/60.D0+20.D0/3600.D0
        ENDIF
        WRITE(*,*)' KLASICKE [SP]                -1- '
        WRITE(*,'(A,$)')'  VALCOVE [G2]                 -2-      => '
        READ(*,*)IVOL
        WRITE(2,'(A,F6.2,A,F6.2,A,F6.3,A,I2)')' ZEM. SIRKA =',FI
     P  ,'   DEKL. SLNKA =',DELTA,'   DLZKA TYCE =',EL
     P  ,'   TYP =',IVOL
        PI=3.14159265D0
        DELTA=PI/180.D0*DELTA
        FI=PI/180.D0*FI
        IF(IVOL.EQ.1)THEN
          WRITE(*,*)'  HOD.U.SL.- POZIC.U.TIENA - DLZKA TIENA'
          WRITE(2,*)'  HOD.U.SL.- POZIC.U.TIENA - DLZKA TIENA'
        ENDIF
        IF(IVOL.EQ.2)THEN
          WRITE(*,'(A,$)')'  POLOMER VALCA     => '
          READ(*,*)R
          WRITE(2,'(A,F7.2)')' POLOMER VALCA = ',R
          WRITE(*,*)'  HOD.U.SL.   -      X     -     Y'
          WRITE(2,*)'  HOD.U.SL.   -      X     -     Y'
        ENDIF
        DO 10 I=1,25
          T=PI/180.D0*DBLE(I-1)*3.75D0
          IF(IVOL.EQ.1)THEN
            CALL SP(EL,FI,DELTA,T,ALFA,TIEN)
            WRITE(*,20)180.D0/PI*T,180.D0/PI*ALFA,TIEN
            WRITE(2,20)180.D0/PI*T,180.D0/PI*ALFA,TIEN
          ENDIF
          IF(IVOL.EQ.2)THEN
            CALL G2(EL,R,FI,DELTA,T,X,Y)
            WRITE(*,'(F10.3,2X,2F12.4)')180.D0/PI*T,X,Y
            WRITE(2,'(F10.3,2X,2F12.4)')180.D0/PI*T,X,Y
          ENDIF
10      CONTINUE
20      FORMAT(F10.3,4X,F9.3,F16.4)
        STOP
        END
C-----------------------------------------------------------------------
        SUBROUTINE SP(EL,FI,DELTA,T,ALFA,TIEN)
C       VYPOCITA POZICNY UHOL TIENA=ALFA A DLZKU TIENA=TIEN
C               PRE ISTY HODINOVY UHOL SLNKA V RAD
C               EL    - DLZKA TYCE
C               FI    - ZEM. SIRKA V RAD
C               DELTA - DEKLINACIA SLNKA V RAD
C               T     - HODINOVY UHOL SLNKA V RAD
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        PI=3.14159265D0
        ALFA=DATAN(COS(FI)*DSIN(T)/DCOS(T))
        ALFA1=DACOS(SIN(FI)*DCOS(ALFA))
        TIEN=EL*DSIN(PI/2.D0+DELTA)/DCOS(ALFA1+DELTA)
        RETURN
        END
C-----------------------------------------------------------------------
        SUBROUTINE G2(EL,R,FI,DELTA,T,Y,Z)
C               EL    - DLZKA TYCE
C               R     - POLOMER VALCA
C               FI    - ZEM. SIRKA V RAD
C               DELTA - DEKLINACIA SLNKA V RAD
C               T     - HODINOVY UHOL SLNKA V RAD
C       VYSTUP:
C               Y -HORIZONTALNE PO VALCI, KLESA S CASOM, NARASTA DO LAVA
C               Z -ZVISLE PO VALCI, NARASTA NADOL
        IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        X0=DCOS(T)*DCOS(DELTA)
        Y0=DSIN(T)*DCOS(DELTA)
        Z0=DSIN(DELTA)
        P=EL*DCOS(FI)+R
        D=(DCOS(FI)+Z0/X0*DSIN(FI))/(DSIN(FI)-Z0/X0*DCOS(FI))
        D2=(Y0/X0*(DSIN(FI)+DCOS(FI)*D))**2.D0
        DISKR=P*P*D2*D2-(1.D0+D2)*(P*P*D2-R*R)
        IF(DATAN(X0/(Y0+1.D-30)).LT.DACOS(R/P).OR.DISKR.LT.0.D0)THEN
          Y=0.D0
          Z=0.D0
          RETURN
        ENDIF
        X1=(P*D2+DSQRT(DISKR))/(1.D0+D2)
        Y1=DSQRT(D2)*(X1-P)
        Z=-D*(X1-P)+EL*DSIN(FI)
        Y=R*DATAN(Y1/X1)
        RETURN
        END