PROGRAM TURM
      INTEGER ID(500,6)
      REAL*8  RL(1000),X(500),Y(500),Z(500),T(500)
      CHARACTER*72 HED
      COMMON/XYZ/ X,Y,Z
      OPEN(2,FILE='TURMGR1',FORM='FORMATTED')
      DO 2000 I=1,500
      T(I)=0.0D0
      DO 2000 J=1,3
      ID(I,J)=1
      IF(I.LE.3) ID(I,J)=0
 2000 ID(I,J+3)=0
      PRINT*,CHAR(27),'E'
 1000 PRINT*,'IDEELLE HOEHE ='
      READ(*,*) H0
      PRINT*,'BAUHOEHE ='
      READ(*,*) HBAU
      PRINT*,'AUSG.STABLAENGE '
      READ(*,*) RL0
 101  FORMAT('  H0=',F10.3,' HBAU=',F10.3,' RL0=',F10.3)
      WRITE(HED,101)H0,HBAU,RL0
      REWIND 2
      WRITE(2,'(1X,A72,7(1H ),1H*)') HED 
      RAD=ATAN(1.0)/45.
      TA30=SQRT(3.0)/3.
      TA60=SQRT(3.0)
      TAWI=H0/(RL0*TA30)
      I=0
      J=0
      RZ=0.0
      IF(H0.LE.0.0) THEN
      PRINT*,'IDEELLE BAUHOEHE IST UNSINNIG'
      GOTO 1000
      ENDIF
   1  I=I+1
      RL(I)=RL0*(H0-RZ)/H0
      A=0.5*RL(I)*TA30
      B=2.0*A
      J=J+1
      X(J)=-0.5*RL(I)
      Y(J)=-A
      Z(J)=RZ
      S=STAB(J-1,J)
      S=STAB(J-3,J)
   2  J=J+1
      X(J)=0.5*RL(I)
      Y(J)=-A
      Z(J)=RZ
      S=STAB(J-4,J)
      S=STAB(J-3,J)
   3  J=J+1
      X(J)=0.0
      Y(J)=B
      Z(J)=RZ
      S=STAB(J-4,J)
      S=STAB(J-3,J)  
      S=STAB(J-2,J-1)
      S=STAB(J-1,J)  
      S=STAB(J,J-2)
   4  RZ=ZET(H0,RL0,RZ,A)
      IF(RZ.GT.HBAU) GOTO 10       
      I=I+1
      RL(I)=RL0*(H0-RZ)/H0
      A=0.5*RL(I)*TA30
      B=2.0*A
      J=J+1
      X(J)=0.0
      Y(J)=-B
      Z(J)=RZ
      S=STAB(J-3,J)
      S=STAB(J-2,J)
      J=J+1
      X(J)=0.5*RL(I)
      Y(J)=A
      Z(J)=RZ
      S=STAB(J-3,J)
      S=STAB(J-2,J)
      J=J+1
      X(J)=-.5*RL(I)
      Y(J)=A
      Z(J)=RZ
      S=STAB(J-3,J)
      S=STAB(J-5,J)  
      S=STAB(J-2,J-1)
      S=STAB(J-1,J)  
      S=STAB(J,J-2)
      RZ=ZET(H0,RL0,RZ,A)
      IF(RZ.GT.HBAU) GOTO 10
      GOTO 1
  10  RZ=ZET(H0,RL0,RZ,A)
      PRINT*,'TURMSPITZE'
      IMAT=2
      J=J+1
      X(J)=0.0
      Y(J)=0.0
      Z(J)=RZ
      S=STAB(J-3,J)
      S=STAB(J-2,J)  
      S=STAB(J-1,J)
      KN=0
C      DO 11 K=1,J
C      KN=KN+1
C      WERT(KN)=X(K)
C      KN=KN+1
C      WERT(KN)=Y(K)
C      KN=KN+1
C      WERT(KN)=Z(K)
 100  FORMAT(5F10.3)
C  11  PRINT100, WERT(KN-2),  WERT(KN-1), WERT(KN)
      PRINT*,J,' PUNKTE'
      IF(J.GT.500) STOP' ZU VIELE PUNKTE'
C       ********** TAPE4
      N1=0
      N2=0
      N3=0
      N4=0 
      KNT=J
      OPEN(4,FILE='TAPE4',FORM='UNFORMATTED')
      WRITE(4) HED,KNT,N1,N2,N3,N4
      WRITE(4) ((ID(N1,N2),N2=1,6),N1=1,KNT)
      WRITE(4) (X(NI),NI=1,J)
      WRITE(4) (Y(NI),NI=1,J)
      WRITE(4) (Z(NI),NI=1,J)
      WRITE(4) (T(NI),NI=1,J)
      CLOSE(4)
      PRINT*,'TAPE4 OK '
      SLG=STAB(-9999,IST)
      IST=IST-1
      PRINT*,'IST=',IST
      PRINT*,' GESAMTLAENGE =',SLG
      CLOSE(2)
      STOP
      END
C**********************************************************  ZET
      FUNCTION ZET(H0,RL0,RZ,A)
      DATA I/0/
      IF(I.EQ.1) GOTO 1
      A0=0.5*RL0*SQRT(3.0)/3.0
      AT=1.0+4.0*A0*A0/(H0*H0)
      I=1
   1  BT=A*4.0*A0/H0-8.0*A0*A0/H0-2.0*RZ
      CT=4.0*A0*A0-4.0*A*A0+RZ*RZ-8.0*A*A
      SQ=BT*BT-4.0*AT*CT
      ZET=(-BT+SQRT(SQ))/(2.0*AT)
      PRINT*,' =================== Z=',ZET,'   A=',A
      RETURN
      END
C*********************************************************   STAB
      FUNCTION STAB(J1,J)
      REAL*8 X(500),Y(500),Z(500)
      COMMON/XYZ/ X,Y,Z
      DATA IST,INI/1,0/
      STAB=0.0
      IMAT=1
      E=2.06E4
      A=10.0
      T=0.0
      INK=0
C------------- INITIAL
      IF(IST.EQ.1.AND.INI.EQ.0) THEN
      SLG=0.0
C                     1234*1234*1234*1234*1234*
      WRITE(2,'(1X,15H    1  300    1 ,65(1H ),1H*)')
      WRITE(2,'(1X,I5,5F10.0)') IMAT,E,T,T,A,T
      DO 400 L=1,4
 400  WRITE(2,'(1X,4F10.0)') T,T,T,T
      INI=1 
      ENDIF
C ---------  GESAMTLAENGE
      IF(J1.LE.-9998) THEN
      J=IST
      STAB=SLG
      RETURN
      ENDIF
C
      IF(J1.LE.0.OR.J.LE.0) GOTO 1
  100 FORMAT(1X,'STAB NR',I5,' ZWISCHEN PUNKT ',I3,' UND',I3,
     * ' L=',F10.3)
  200 FORMAT(1X,4I5,F10.3,I5)
      IMAT=1
      WRITE(2,200) IST,J1,J,IMAT,T,INK
      IST=IST+1
      SQ=(X(J)-X(J1))**2+(Y(J)-Y(J1))**2+(Z(J)-Z(J1))**2
      STAB=SQRT(SQ)
      PRINT 100,IST,J1,J,STAB
      SLG=SLG+STAB
    1 RETURN
      END