C   M. Hasenbusch, original version 1989
          PROGRAM TES 
           IMPLICIT DOUBLE PRECISION (A-H,O-Z)

           REAL*8 ENER1(500000)
           REAL*8 ENER2(500000)
C           REAL*8 ENER3(500000)
C           REAL*8 ENER4(500000)

           CHARACTER *20 TEST
           WRITE(*,*) 'GEBEN SIE DEN FILE AN'
           READ*, TEST
           OPEN(20,FILE = 'ERGEBNIS',STATUS = 'OLD')
            OPEN(10,FILE =TEST,STATUS ='OLD')
           WRITE(*,*) 'Geben Sie die Zahl der Messungen die am Anfang'
           WRITE(*,*) 'verworfen werden sollen'
           READ*,IU 
           WRITE(*,*) 'Geben Sie die Gesamtzahl der Messungen'
           WRITE(*,*) 'hoechsts 500000'
           READ*,IH
           WRITE(*,*) 'geben Sie die Zahl der Bins (nicht die Groesse)'
           WRITE(*,*) 'hoechstens 1000'
           READ*,IBZ
           WRITE(*,*) 'Geben Sie t_max fuer die Bestimmung der '
           WRITE(*,*) 'integrierten Taus'
           READ*,IY
C   an dieser Stelle wird eine Zeile mit information zu der Simulation
C   gelesen. Falls nicht vorhanden, bitte wegnehmen.
         read(10,*)  
           DO 1,I=1,IH   
         read(10,*)  ENER1(i),ENER2(i)
C         read(10,*)  ENER1(i),ENER2(i),ENER3(i),ENER4(i)
1          CONTINUE
           IUX=IU
           IHX=IH
           IYX=IY
           IBZX=IBZ
           CALL AUS(ENER1,IUX,IHX,IYX,IBZX,PB,PBF)
           IUX=IU
           IHX=IH
           IYX=IY
           IBZX=IBZ
           CALL AUS(ENER2,IUX,IHX,IYX,IBZX,PB,PBF)
C           IUX=IU
C           IHX=IH
C           IYX=IY
C           IBZX=IBZ
C           CALL AUS(ENER3,IUX,IHX,IYX,IBZX,PB,PBF)
C           IUX=IU
C           IHX=IH
C           IYX=IY
C           IBZX=IBZ
C           CALL AUS(ENER4,IUX,IHX,IYX,IBZX,PB,PBF)

        STOP'ENDE'
        END
           SUBROUTINE AUS(ENER,IU,IH,IY,IBZ,OBSS,OBSSF)
           IMPLICIT DOUBLE PRECISION (A-H,O-Z)

           REAL*8 ENER(500000)
           REAL*8 OBBIN(1000),TAUBIN(1000)
           IH=IH-IY
           ITEIL=(IH-IU)/IBZ
           IU=IH-ITEIL*IBZ
           NOR=IH-IU
      WRITE(20,*) ' '
      WRITE(20,2001)                                                    
      WRITE(20,2002) IH,IU
      WRITE(20,2003) IY,IBZ
      WRITE(20,2001)                                                    
      WRITE(20,*) ' '
2001  FORMAT('   ###################################################### 
     &')
2002  FORMAT('   #     statistics = ',I7,'   discarded = ',I7,'     #')
2003  FORMAT('   #     time steps = ',I7,'   bins      = ',I7,'     #')
      WRITE(20,*) '    t          rho(t)          ln(rho)       tau',
     & '*ln(rho)' 
      WRITE(20,2004)                                                    
2004  FORMAT('   ------------------------------------------------------ 
     &')
          ID=2
          OBS=0D0
          P=0D0
           CALL MITTEL(ENER,IU,IH,NOR,IY,TAU,OBS,ID,P,OBSS,OBSSF)
           PPPP=SQRT(P)                         
          SOK=TAU*SQRT((2D0*(IY*2D0+1D0))/NOR)
          ID=0
          NOR=NOR/IBZ
         DO 123,IBIN=1,IBZ
           IU2=IU+(IBIN-1)*NOR
           IH=IU2+NOR
           CALL MITTEL(ENER,IU2,IH,NOR,IY,TAU,OBS,ID,P,O,OF)
123        TAUBIN(IBIN)=TAU
          ID=1
         DO 124,IBIN=1,IBZ
           IU2=IU+(IBIN-1)*NOR
           IH=IU2+NOR
           CALL MITTEL(ENER,IU2,IH,NOR,IY,TAU,OBS,ID,P,O,OF)
124        OBBIN(IBIN)=OBS
           IU2=0
           IH=IBZ
           NOR=IBZ
           IY=0
           ID=3
C          WRITE(20,*) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$'
           CALL MITTEL(OBBIN,IU2,IH,NOR,IY,TAU,OBS,ID,P,O,OF)
           ID=4
      WRITE(20,*) ' '
           WRITE(20,4000) PPPP
           CALL MITTEL(TAUBIN,IU2,IH,NOR,IY,TAU,OBS,ID,P,O,OF)
          WRITE(20,1005) SOK
      WRITE(20,2001)                                                    
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
1005   FORMAT('                         +- ',F6.2,'  (Sokals method)')
4000   FORMAT('         SIGMA =  ',E11.3)
C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        END
       SUBROUTINE MITTEL(MAG,IU,IH,NOR,IUHG,AK,DMAG,ID,P,OBS,OBSF)
       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
        REAL*8 MAG(500000)
        REAL*8 ZXX(1000)
       IF(ID.NE.0) THEN
      DMAG=0D0
      QMAG=0D0
      DO 11,I=IU+1,IH
      DMAG=DMAG+MAG(I)
11      QMAG=QMAG+MAG(I)*MAG(I)
       DMAG=DMAG/NOR
       QMAG=QMAG/NOR
       P=QMAG-DMAG*DMAG
       ENDIF
       ZCO=0D0
       ZCCO=0D0
       KOO=0
  
2       KOO=KOO+1
      IF(KOO.LE.IUHG) THEN
      CO=0D0
      CCO=0D0
      DO 3,IN=IU+1,IH
3       CCO=CCO+(DMAG-MAG(IN))*(DMAG-MAG(IN+KOO))
        CCO=CCO/NOR
       CCOO=CCO/P
       ZXX(KOO)=CCOO
       ZCCO=ZCCO+CCOO
      GOTO 2
      ENDIF
      AK=ZCCO+0.5D0
      IF(ID.EQ.2) THEN
      DO 707 ,IZX=1,IUHG
       CCXX=-LOG(ABS(ZXX(IZX)))
       WRITE(20,1001) IZX,ZXX(IZX),CCXX,AK*CCXX
707   CONTINUE
       WRITE(20,2000)                                     
      ENDIF
      IF(ID.EQ.3) THEN
       WRITE(20,3004) SQRT(P*(2D0*ZCCO+1D0)/NOR)
      ENDIF
      IF(ID.EQ.2) THEN
       WRITE(20,*) ' '
       WRITE(20,1004) DMAG,SQRT(P*(2D0*ZCCO+1D0)/NOR)
       OBS=DMAG
       OBSF=SQRT(P*(2D0*ZCCO+1D0)/NOR)
      ENDIF
      IF(ID.EQ.4) THEN
       WRITE(20,*) ' '
       WRITE(20,1003) DMAG,SQRT(P*(2D0*ZCCO+1D0)/NOR)
      ENDIF
1001   FORMAT(' ',I5,' ',F15.3,' ',F15.3,' ',F15.3)
1003   FORMAT('           TAU = ',F7.2,' +- ',F6.2,  
     & '  (binning)')
1004   FORMAT('    OBSERVABLE = ',E14.7,' +- ',E10.3)
3004   FORMAT('                                +- ',E10.3,
     & '  (binning)')
2000  FORMAT('   ------------------------------------------------------ 
     &')
       END
