        PROGRAM CDELX
C  DETERM OF CENA DEL X MBI-9 FROM rvt.for
C  L. N. TKACH
C  WITH ALL DATA IN rvt1.txt
C  ./be  > cdelx.res pico cdelx.res lpr cdelx.res
C  DATA OF LAST REDACTION: 7 MART  2007 
C
      COMMON /NHI/NHI(1000),IHI(10),NLM,GR(10),SA(10)
      COMMON /AXXX/NNHI,AXX(10),
     *XX(10),XX2(10),X,KM
      DIMENSION XD(1000),IR(3)
      IDAY=7
      MANS=3
      JEAR=2007
      NSB=0
      NNHI=1
      KM=1
      I=1
      NLM=84
      DO 49 K=1,NNHI
      IHI(K)=I
      I=I+NLM
      AXX(K)=0.0
      XX(K)=0.0
      XX2(K)=0.0
      GR(K)=0.0
      SA(K)=1.0
   49 CONTINUE
      DO 549 K=1,1000
  549 NHI(K)=0
      PRINT 112,IDAY,MANS,JEAR
      PRINT 102
  102 FORMAT (2X,' DETERM OF CENA DEL MICR MBI-9'/
     *2X,'BY L. N. TKACH IN PROCEDURE rvt.for'/
     *2X,'DATA IN FILE rvt1.txt')
  112 FORMAT (5('*'),2X,I2,'.',I2,'.',I4,2X,'cdelx.for',5('*'))
      OPEN (2,file='rvt1.txt',status='old')
  100 FORMAT (8I6)
    1 READ (2,100) (IR(K),K=1,3)
      IF (IR(1).LT.1) GO TO 77
      NSB=NSB+1
      B=IR(1)
      XD(NSB)=B
      GO TO 1
   77 CLOSE (2)
      N=NSB-1
      DO 3 K=1,N
      X=XD(K)-XD(K+1)
      IF (X.LT.0.0) X=-X
      IF (X.GT.11.0) GO TO 3
      IF (X.LT.5.0) GO TO 3
      CALL HISTO
    3 CONTINUE
      CALL LITPRI
      CALL RANGIR(XD,NSB)  
      STOP
      END
C
      SUBROUTINE BXXX
      COMMON /AXXX/NNHI,AXX(10),
     *XX(10),XX2(10),X,I
      XX(I)=XX(I)+X
      XX2(I)=XX2(I)+X*X
      AXX(I)=AXX(I)+1.0
   77 RETURN
      END
C
      SUBROUTINE HISTO
      COMMON /NHI/NHI(1000),IHI(10),NLM,GR(10),SA(10)
      COMMON /AXXX/NNHI,AXX(10),
     *XX(10),XX2(10),T,KM
      CALL BXXX
      M=(T-GR(KM))/SA(KM)
      IFL=0
      X=GR(KM)+SA(KM)*(NLM-4)
      IF (T.LT.GR(KM)) GO TO 1
      IF (T.GT.X) GO TO 2
      GO TO 3
    1 M=NLM-4
      IFL=2
      GO TO 3
    2 M=NLM-3
      IFL=2
    3 K=M+IHI(KM)
      NHI(K)=NHI(K)+1
      K=NLM+IHI(KM)-1
      NHI(K)=NHI(K)+1
      K=K-1
      IF (IFL.GT.1) GO TO 77
      NHI(K)=NHI(K)+1
   77 RETURN
      END
C
      SUBROUTINE RANGIR(F,MM)
      DIMENSION F(1000)
      N=MM
      M=N-1
    7 DO 31 L=1,M
      A=F(L+1)
      IF (A.GT.F(L)) GO TO 31
      F(L+1)=F(L)
      F(L)=A
   31 CONTINUE
      M=M-1
      IF (M.GT.0) GO TO 7
      RETURN
      END
C
      SUBROUTINE LITPRI
      COMMON /NHI/IHI(1000),IHS(10),NLM,GR(10),SA(10)
      COMMON /AXXX/NNHI,AXX(10),
     *XX(10),XX2(10),X,KM
      DIMENSION SR(10),SS(10)
C
      DO 1 K=1,NNHI
C
      PRINT 101,K
  101 FORMAT (/2X,10('*'),
     *2X,'NUMBER OF HISTOGRAMM=',I4,2X,10('*'))
      PRINT 151
  151 FORMAT (2X,' DISTRIBUTION DELEN PER 10 MICRON')
      IHIS=IHS(K)
      IK=IHIS+NLM-5
      LI=IHI(IK+3)
      LLKI=IHIS-1
      L=0
      SR(K)=0.0
      SS(K)=0.0
      IF (AXX(K).LT.1.5) GO TO 1
      SR(K)=XX(K)/AXX(K)
      SX2=XX2(K)
      SXX=XX(K)
      ANX=AXX(K)
      CNX=(SX2-((SXX**2)/ANX))/(ANX-1.0)
      IF (CNX.GT.0.0) GO TO 2
      PRINT 204,CNX,SX2,SXX,ANX
  204 FORMAT (2X,'IN SABR PHIST WE HAV SQRT(-)'/2X,4E12.6)
      GO TO 6
    2 SS(K)=SQRT(CNX)
    6 PRINT 202,GR(K),SA(K),AXX(K),SR(K),SS(K)
  202 FORMAT (2X,'LEFT GRAN AND STP OF HIST=',2F12.6/2X,
     *'ALL NUMB IN HIST MIDL VAL AND STANDARD DEV='/2X,
     *F8.1,2X,F12.6,2X,F12.6)
      DO 4 M=IHIS,IK
      L=L+IHI(M)
      LLKI=LLKI+1
      IF (L.EQ.LI) GO TO 5
    4 CONTINUE
    5 PRINT 203,(IHI(M),M=IHIS,LLKI)
      IK=IK+1
  203 FORMAT (2X,10I6)
      L=IK+3
      PRINT 205,(IHI(M),M=IK,L)
  205 FORMAT (2X,'OVER LEFT GRAN =',I6,2X,'GREATER HIST=',I6/2X,
     *'EVENTS IN HISIOG=',I6,2X,'ALL EVENTS=',I6)
  102 FORMAT (2X,10('*'),2X,'NUMBER OF HISTOGRAMM=',I4,2X,10('*'))
      PRINT 102,K
    1 CONTINUE
      RETURN
      END


