C########################################################################
C
       SUBROUTINE RALFA(FALF,ISHIF,HDM,ALFA,EXTRA,F,MENDIF,MAZDIF,
     1 MELDIF,VER,MAXALF,MZAHL,KZAHL)
C
C       DIESE SUBROUTINE TRENNT MIT HILFE EINER INTERPOLATION DIE ALFA-
C       ZAEHLRATEN VON DEN PROTONENZAEHLRATEN UND SPEICHERT SIE IM FELD
C       FALF(9,9,9)  ; ENTSPRECHEND  WERDEN DIE PROTONENZAEHLRATEN KORRI
C       GIERT UND NEU IN FIS1(7,7,32) GESPEICHERT ; DIE  GROESSEN  NEN,
C       NAZ,NEL GEBEN DEN ECKPUNKT DES ALFA-MESSBEREICHS AN UND LA1,LA2,
C       LA3 SEINE LAENGE ( COMMONBLOCK AA ) ; WENN EXTRA = .TRUE.,D.H.
C       WENN RANDEXTRAPOLATION , DANN WIRD F ANSTELLE VON FIS1 BENUTZT.
C       
       COMMON/SEN1/FINT(32),FI1B(32),FIS1(7,7,32)
       COMMON/A7/MEN,MAZ,MEL,LC1,LC2,LC3
       COMMON /KANAL/ VOLT(34,2),AZIMUT(18,2),ELEVAT(11)
       COMMON/AA/NEN,NAZ,NEL,LA1,LA2,LA3
       COMMON/MAXIMUM/MAXINT,RATINT,MAX3D(3),RAT3D,MAXI1B,RATI1B
       DIMENSION PAZ(3),PEN(3),PEL(3),FALF(9,9,9),XF(6),YF(6),SIGMAY(3)
       DOUBLE PRECISION COEF(3),X(3),Y(3),F(33,9,9),FH,YY,DJ
       LOGICAL HDM,ALFA,EXTRA
       DIMENSION FMAX(5),JMIN(5),FMIN(5),JMAX(5),I2M(5),I3M(5),MAXALF(3)
       INTEGER  PAZ,PEN,PEL
       MN=MEN+LC1-1
       MZ=MAZ+LC2-1
       ML=MEL+LC3-1
       VER = 0.
       K=0
       NTERMS = 3
       IFEHL = 0
       IF ( KZAHL .LT. MZAHL ) GO TO 5555
       LMAX = MEN - 1 + LC1
       LMIN = MEN - 1 + LC1
C
C****** EINLESEN VON FIS1 IN F ****************************
C
 5555 IF ( EXTRA ) GO TO 190
      DO 191 I=1,LC1
      DO 191 J=1,LC2
      DO 191 K=1,LC3
  191 F(I,J,K) = FIS1(K,J,I)
C 
  190 CONTINUE   
C     Write(6,*) (((F(i,j,k),i=5,7),j=5,7),k=7,11)
C
C-----------------------------------------------------------------------
C----- SUCHE EXTREMA IN 3D UND INTEGRATIONSZAEHLERDATEN ---------------
C-----------------------------------------------------------------------
       FLA=0.
       J=MAXINT+9
       IF(J.GT.32) J=32
C       WRITE(6,3007) J
 3007  FORMAT(4H  J=I2)
       DO 10 I=1,6
       J=J-1
       IF(FINT(J+1).LT.15) GO TO 10
       FGL=FINT(J+1)*0.9
       JS=J+1
       JM=JS
       IF(FINT(J).LT.FGL) GO TO 11
       JM=JS+1
       IF(FINT(J).LT.FLA) GO TO 11
       FLA=FGL
10     CONTINUE
       WRITE(6,602)
602    FORMAT(' NO ALFA-MAXIMUM FOUND IN INTEGRATED DATA 1A ')
       IFEHL = 1
       KZAHL = KZAHL + 1
       GO TO 7000
11     CONTINUE
       DO 12 I=1,5
       J=JM-I
       IF ( J.LE. 1 ) GO TO 12
       FGL=FINT(J)
       KM = J
       IF(FINT(J-1).GT.FGL) GO TO 13
12    CONTINUE
      WRITE(6,603)
603   FORMAT(' NO ALFA-MINIMUM FOUND IN INTEGRATED DATA 1A')
       IFEHL = 1
       KZAHL = KZAHL + 1
      GO TO 7000
13    CONTINUE
      KZAHL = 0
C
C******EXAKTE BESTIMMUNG DER  EXTREMA AUS DEN INTEGRATIONSZAEHLERN ***
C     INSTRUMENT 1A
      I1 = JM - 1
      I2 = JM + 2
      IF(I2.GT.31) I2=31
C      WRITE(6,3008) I1,I2,KM
 3008 FORMAT(5H  I1=I3,3HI2=I3,3HKM=I3)
      DO 14 I=I1,I2
      FGL=FINT(I)
      LMAX=I
C      WRITE(6,5463) I
 5463 FORMAT(3H I=I2)
      IF(FINT(I+1).LT.FGL) GO TO 15
14    CONTINUE
      WRITE(6,604) I2,JM
604   FORMAT(' THIS SHOULD NOT HAPPEN  I2=',I3,'JM=',I3)
      ALFA = .FALSE.
      GO TO 900
15    DO 114 L = 1,4
      J = LMAX -L
C      WRITE(6,5464) J
 5464 FORMAT(3H J=I2)
      IF ( J .LE. 1 ) GO TO 114
      FGL = FINT(J)
      LMIN = J
      IF ( FINT(J-1) .GT. FGL ) GO TO 1144
  114 CONTINUE
C     WRITE(6,6043)
 6043 FORMAT( 'THIS SHOULD NOT HAPPEN' )
      ALFA = .FALSE.
      GO TO 900
 1144 CONTINUE
      WRITE(6,6044) LMAX,LMIN,FINT(LMAX),FINT(LMIN),MAXINT,RATINT
 6044 FORMAT(' Alpha separation'/6H LMAX=I2,6H LMIN=I2,5H MAX=F8.2,
     1 5H MIN=F8.2,8H MAXINT=I2,8H RATINT=F8.2)
      IF ( .NOT. HDM .AND. LMIN  .GE. (MEN+LC1) ) GO TO 6615
C
C     INSTRUMENT 1B
      DO 3014 I=I1,I2
      FGL=FI1B(I)
      LBMAX=I
C      WRITE(6,3011) I
 3011 FORMAT(3H I=I2)
      IF(FI1B(I+1).LT.FGL) GO TO 3015
 3014 CONTINUE
      WRITE(6,3604)I2,JM
 3604 FORMAT(' THIS SHOULD NOT HAPPEN  I2=',I3,'JM=',I3)
      IF ( IFEHL .EQ. 0 ) GO TO 3015
      ALFA = .FALSE.
      GO TO 900
C
 3015 DO 3114 L= 1,4
      J = LBMAX-L
C      WRITE(6,3064) J
 3064 FORMAT(3H J=I2)
      IF ( J .LE. 1 ) GO TO 3044
      FGL = FI1B(J)
      LBMIN = J
      IF ( FI1B(J-1) .GT. FGL ) GO TO 3044
 3114 CONTINUE
      WRITE(6,3043)
 3043 FORMAT( 'THIS SHOULD NOT HAPPEN' )
      IF ( IFEHL .EQ. 0 ) GO TO 3044
      ALFA = .FALSE.
      GO TO 900
 3044 CONTINUE
      WRITE(6,3444) LBMAX,LBMIN,FI1B(LBMAX),FI1B(LBMIN)
 3444 FORMAT(7H LBMAX=I2,6HLBMIN=I2,5H MAX=F8.2,5H MIN=F8.2)
      BMAXIN = FI1B(LBMAX)
      DO 3055 I=2,LBMAX
      K = LBMAX - I + 1
      IF ( FI1B(K) .LT. BMAXIN ) GO TO 3055
      BMAXIN = FI1B(K)
 3055 CONTINUE
      VER1A = 0.
      VER1B = 0.
      IF (FINT(LMAX) .GT. 0.) VER1A = RATINT/FINT(LMAX)
      VHI = FI1B(LBMAX) - 25.
      IF (VHI .GT. 0.) VER1B = (BMAXIN-25.)/VHI
      IF (VER1B .GT. 0.) VER = VER1A/VER1B
C      WRITE(6,3057) VER1A,VER1B,VER
 3057 FORMAT(7H VER1A=E10.4,6HVER1B=E10.4,6H  VER=E10.4)
C     IF ( VER .LT. 1.2  .AND. VER  .GT. 0.0 ) GO TO 62
 7000 CONTINUE
C
C***** SUCHE NACH ALFA-MAXIMUM UND MINIMUM IN RICHTUNG DES PROTONEN-
C***** MAXIMUMS; FALLS KEINES GEFUNDEN , SUCHE IN DEN NACHBARKANAELEN *
      FLA = 0.
      I1 = MAX3D(3) + MENDIF
      I2 = MAX3D(2) + MAZDIF
      I3 = MAX3D(1) + MELDIF
C      WRITE(6,6677) (  MAX3D(I),I ,I=1,3)
 6677 FORMAT(6I4)
      I2M(1) = I2
      I3M(1) = I3
      I2M(2) = I2 + 1
      I3M(2) = I3
      I2M(3) = I2
      I3M(3) = I3 + 1
      I2M(4) = I2
      I3M(4) = I3 - 1
      I2M(5) = I2 - 1
      I3M(5) = I3
      DO 708 KK = 1,5
      I2 = I2M(KK)
      I3 = I3M(KK)
C      WRITE(6,703) I1,I2,I3
  703 FORMAT(4H    3I4)
      J = I1 + 9
      IF ( J.GT. LC1) J=LC1
      DO 701 I = 1,6
      J = J - 1
      IF ( J .LT. I1 + 3 )  GO TO  709
      IF ( F(J+1,I2,I3)  .LE. 5.D0) GO TO 701
      FGL = F(J+1,I2,I3)*0.8
      LS = J + 1
      LM = LS
      IF ( F(J,I2,I3)  .LT. FGL*1.D0) GO TO 710
      LM = LS + 1
      IF ( F(J,I2,I3) .LT. FLA*1.D0) GO TO 710
      FLA = FGL
  701 CONTINUE
      FLA = 0.
  708 CONTINUE
  709 CONTINUE
      WRITE(6,6022)
 6022 FORMAT('NO ALFA MAXIMUM FOUND IN 3D DATA ')
C     IF ( VER .GT. 1.8 .AND. IFEHL .EQ. 0 ) GO TO 719
      IF ( IFEHL .EQ. 0) GO TO 719
      ALFA = .FALSE.
      GO TO 900
  710 DO 702 I  = 1,5
      J = LM-I
      IF ( J .LE. 1 ) GO TO 702
      FGL = F(J,I2,I3)
      IF ( F(J-1,I2,I3) .GT. FGL*1.D0) GO TO 720
  702 CONTINUE
      WRITE(6,6033)
 6033 FORMAT('  NO MINIMUM FOUND IN 3D DATA ')
      IF ( IFEHL .EQ. 0 ) GO TO 719
      ALFA = .FALSE.
      GO TO 900
  719 N3DMAX = LMAX - MEN + 1
      N3DMIN = LMIN - MEN + 1
      WRITE(6,7199)
 7199 FORMAT(' TRENNE ALFAS BEIM MINIMUM DES INTEGRATIONSZAEHLERS AB')
      GO TO 722
  720 CONTINUE
      N3DMAX = LM
      N3DMIN = J
      IF ( IFEHL .EQ. 1 .AND.(N3DMAX -N3DMIN) .GT. 2) GO TO 6613
  721 MAXDIF = N3DMAX - LMAX + MEN -1
      MINDIF = N3DMIN - LMIN + MEN -1
      WRITE(6,6055) N3DMAX,N3DMIN,MAXDIF,MINDIF
 6055 FORMAT(8H  3DMAX=I3,8H  3DMIN=I3,8H MAXDIF=I3,8H MINDIF=I3)
      IF ( MAXDIF .NE. 0 )  WRITE(6,6066)
      IF ( MINDIF .NE. 0 ) WRITE(6,6077)
 6066 FORMAT(' ALFA-MAXIMUM AUS INTEGRATIONS- UND 3D-DATEN STIMMT  NICHT
     1 UEBEREIN ')
 6077 FORMAT(' MINIMUM ZWISCHEN ALFA UND PROTONEN PEAK AUS INTEGRATIONS
     1 UND 3D-DATEN ERMITTELT STIMMT NICHT UEBEREIN ')
      IF ( ABS(1.*MINDIF) .GT. 2..AND. IFEHL .EQ. 1) GO TO 725
      IF ( MINDIF .GE. 1 .OR. MINDIF .LT. -1) GO TO 719
C*****CHECK IF SUFFICIENT 3D DATA EXISTS*********************
  722 IF(N3DMAX .LT. LC1 .AND. N3DMIN .GT. 0 ) GO TO 16
      WRITE(6,605) LC1,N3DMAX
605   FORMAT(' INSUFFICIENT 3D DATA  LC1,N3DMAX=',2I3)
  725 ALFA =.FALSE.
      GO TO 900
16    CONTINUE
C
C*****SEARCH 3D DATA FOR ALPHA MAXIMUM ********************************
      I1=N3DMAX
      FH= F(I1,I2,I3)
      N1=I1-1
      IF(N1.LT.1) N1=1
      N2=I1+1
      IF(N2.GT.LC1) N2=LC1
      L1=I2-1
      IF(L1.LT.1) L1=1
      L2=I2+1
      IF(L2.GT.LC2) L2=LC2
      M1=I3-1
      IF(M1.LT.1) M1=1
      M2=I3+1
      IF(M2.GT.LC3) M2=LC3
      K=0
17    DO 20 I1=N1,N2
      DO 20 I2=L1,L2
      DO 20 I3=M1,M2
      IF( F(I1,I2,I3)-FH )  20,21,22
22    FH= F(I1,I2,I3)
      K=0
21    K=K+1
      IF(K.GE.4) GO TO 23
C***** PEN , PAZ , PEL ENTHAELT DIE MAXIMUMS ADRESSE ******************
      PAZ(K)=I2
      PEL(K)=I3
      PEN(K)=I1
20    CONTINUE
      MAXALF(1) = I1
      MAXALF(2) = I2
      MAXALF(3) = I3
      GO TO 24
23    K=K-1
      WRITE(6,606) K
606   FORMAT(' THIS OUGHT NOT TO HAPPEN  K=',I3)
      ALFA = .FALSE.
      GO TO 900
C
24    CONTINUE
      IF(FH.GT. 5.D0) GO TO 25
      WRITE(6,615)  FH
615   FORMAT('  MAX 3D ALFA FLUX KLEINER ALS  5;FLUX=',D10.4)
      ALFA =.FALSE.
      GO TO 900
25    FM3D=FH
      FMZ=0.3*FM3D
C      WRITE(6,616) FH,PEN(1),PAZ(1),PEL(1)
  616 FORMAT(5X,'ALFA-MAXIMUM=',D10.2,4H EN=I2,4H AZ=I2,4H EL=I2)
C***** GEGENWAERTIG WIRD DEN ALFAS NUR DAS ENERGIE-INTERVALL LIMITIERT**
      L2 = 1
      M2 = LC2
      L3 = 1
      M3 = LC3
      L1 = N3DMIN
      M1 = L1 + 8
      IF ( M1 .GT. LC1 ) M1 = LC1
      WRITE(6,607) L1,M1,L2,M2,L3,M3
607   FORMAT(' LIMITS ARE (EN,AZ,EL)',6I5)
C***** STARTKANAL NUMMERN  DES ALFA-MESSAUSSCHNITTES BEZOGEN AUF DAS
C***** GROSSE RASTER ***************
      NEN=L1+MEN-1
      NAZ=L2+MAZ-1
      NEL=L3+MEL-1
      LA1=M1-L1+1
      LA2=M2-L2+1
      LA3=M3-L3+1
      IF ( LA1 .LT. 3 ) GO TO 613
C**** AUSSCHREIBEN DER ZAEHLRATEN *************************************
C          L5=L1-5
C          IF(L5.LT.1) L5=1
C          DO 94 I3=  L3,M3
C          DO 94 I2=  L2,M2
C  94      WRITE(6,620)( F(I1,I2,I3)  ,I1=L5,M1)
C
C      WRITE(6,600)      LA1,LA2,LA3,NEN,NAZ,NEL
C 600 FORMAT(3H   6I4)
C*****PRESET FALF ARRAY TO ZERO**********************************
      DO 4000 I1=1,9
       DO 4000 I2=1,9
        DO 4000 I3 =1,9
4000     FALF(I1,I2,I3)= 0.0
       ALFA = .TRUE.
C
C-----------------------------------------------------------------------
C*****JEDES ENERGIESPEKTRUM WIRD BEI FESTEM WINKELKANAL AUF EXTREMA
C***** UNTERSUCHT UND DIE COUNTS AUF FALF UND F VERTEILT .
C-----------------------------------------------------------------------
      DO 700 I3=L3,M3
      DO 700 I2=L2,M2
      IMAX = N3DMAX
      IMIN = N3DMIN
C***** ES WIRD EINE MINDESTZAEHLRATE VON 1 ANGENOMMEN *****************
      DJ=1.D0
C     CHECK IF DATA >DJ EXISTS
      LX= M1 - 1
      DO 40 I1=L1,LX
      IF( F(I1,I2,I3) .GE. DJ) GO TO 41
40    CONTINUE
C     NO DATA >1
      GO TO 700
41    CONTINUE
      IF ( I1 .GE. L1 + 1 )  GO TO  598
      CMIN = F(L1,I2,I3)
      IF ( F(L1+1,I2,I3) .NE. 0. ) GO TO 43
      IF ( F(L1-1,I2,I3) .GT. CMIN ) IMIN = IMIN + 1
      GO TO 598
   43 CONTINUE
      IF ( F(L1+2,I2,I3) .NE. 0. ) GO TO 44
      IF ( F(L1-1,I2,I3) .GE. CMIN ) GO TO 390
      GO TO 598
   44 CONTINUE
      IF ( F(L1-1,I2,I3) .GE. CMIN ) GO TO 45
      GO TO 390
   45 IF ( F(L1+1,I2,I3) .LT. CMIN )  GO TO 46
      GO TO 390
   46 IMIN = IMIN + 1
      IF ( F(L1+2,I2,I3) .LT. F(L1+1,I2,I3) ) IMIN = IMIN + 1
C
C*****ABZIEHEN DER EXTRAPOLIERTEN ZAEHLRATEN DER PROTONEN ************
  390 ISTRT = IMIN - 4
C      WRITE(6,9066) IMIN,ISTRT,ISHIF
 9066 FORMAT(6H IMIN=I2,7H ISTRT=I2,7H ISHIF=I2)
      DO 840  I = 1,3
      JJ = ISTRT + I + 1 + MEN - 1
      LL = ISTRT + I
      X(I) = VOLT( JJ,ISHIF)*1.D0
      YY = F(LL,I2,I3)
C      WRITE(6,9077) YY
 9077 FORMAT(4H YY=D12.3)
      IF ( YY .LE. 1.D0) YY=1.D0
C     Y(I) = DBLE(YY)
      Y(I) = DLOG(YY)
      COEF(I) = 0.D0
  840 SIGMAY(I) = 1./SQRT(SNGL(YY))
C     DO 841 I=1,3
C     WRITE(6,906) X(I),Y(I),SIGMAY(I),I
C 906 FORMAT(2D12.3,E12.3,I5)
C 841 CONTINUE
      NPTS = 3
      CALL POLFIT(X,Y,SIGMAY,NPTS,NTERMS,+1,COEF,CHISQR)
      NPTS = NPTS + 3
      DO 842 I= 4,NPTS
      JJ = ISTRT + 1 +I + MEN - 1
      XF(I) = VOLT(JJ,ISHIF)
      YY = (COEF(1) + COEF(2)*XF(I) + COEF(3)*(XF(I)**2))
      YF(I) = DEXP( YY  )
C      WRITE(6,8422) XF(I),YF(I),I,COEF(I-3)
 8422 FORMAT( 2E12.3 ,I5,D12.3)
  842 CONTINUE
C***** ERZEUGUNG DES ALFA-ZAEHLRATENFELDES ****************************
      IANF = IMIN
      IEND = IMIN + 2
      JJ = 3
C      WRITE(6,8455) IANF,IEND
 8455 FORMAT(' ianf,iend',2(I4))
      DO 843 I = IANF,IEND
      JJ = JJ + 1
      FF = F(I,I2,I3)    - YF(JJ)
      IF ( FF .LT. 0. ) FF = F(I,I2,I3)
      K = I -L1 + 1
      FALF(K,I2,I3) = FF
      F(I,I2,I3)  =  F(I,I2,I3)  -  FF*1.D0
C      WRITE(6,8433)   F(I,I2,I3) ,FALF(K,I2,I3),FF,I,K,I2,I3
 8433 FORMAT( 1D12.3,2E12.3 ,3X,4I2)
  843 CONTINUE
      GO TO 7043
  598 CONTINUE
      IEND = IMIN - 1
C***** NACH ABZUG DER FITZAEHLRATE DER PROTONEN VON DER ALFA-ZAEHLRATE
C***** WIRD FUER I GROESSER ALS IEND DIE PROTONENZAEHLRATE NULL GESETZT
 7043 IEND = IEND + 1
      DO 844 I = IEND , M1
      K = I - L1 + 1
      IF ( I .LT. L1 ) GO TO 844
      FALF(K,I2,I3) = F(I,I2,I3)
C      WRITE(6,8404) FALF(K,I2,I3),K,I2,I3
 8404 FORMAT(10X,5HFALF=F8.2,3I5)
  844 F(I,I2,I3) =0.D0
      IF ( M1 .EQ. LC1) GO TO 846
      MM1 = M1 +1
      DO 845 I=MM1,LC1
  845 F(I,I2,I3) = 0.D0
  846 CONTINUE
      GO TO 700
  613 WRITE(6,614)
  614 FORMAT('  BAD DATA : FELDLAENGE LA1 < 3 ')
      ALFA = .FALSE.
      GO TO 900
 6613 WRITE(6,6614)
 6614 FORMAT(' BAD DATA : MAX-MIN-DIFFERENZ IN 2D GROESSER ALS 2 UND
     1 IFEHL = 1')
      ALFA = .FALSE.
      GO TO 900
 6615 WRITE(6,6616)
 6616 FORMAT(' MINIMUM ZWISCHEN ALFAS UND PROTONEN AUS INSTRUMENT 1A
     1 LIEGT AUSSERHALB DES MESSARRAYS')
      GO TO 900
700   CONTINUE
C-----------------------------------------------------------------------
C****** SCHLEIFENENDE **************************************************
C-----------------------------------------------------------------------
C      FELDLAENGE IN DER ENERGIE SOLL UNGERADE SEIN
       IF ( LA1 .LT. 9 .AND. (LA1-2*(LA1/2)) .EQ. 0 ) LA1 = LA1 +1
       IF ( LA3 .EQ. 6 .OR. LA3 .EQ. 8 ) LA3 = LA3 + 1
      IF ( EXTRA ) GO TO 902
      DO 93 I=1,LC1
      DO 93 J=1,LC2
      DO 93 K=1,LC3
   93 FIS1(K,J,I)= F(I,J,K)
  902 CONTINUE
C           DO 92 I3=1,LA3
C           DO 92 I2=1,LA2
C   92      WRITE(6,620)(FALF(I1,I2,I3),I1=1,LA1)
C     GO TO 900
   62 WRITE(6,6226) VER
 6226 FORMAT(' VERHAELTNIS DER PEAKS VER=',E10.4)
C     ALFA = .FALSE.
C
900    CONTINUE
       WRITE(6,4563) ALFA
 4563  FORMAT(6H ALFA=L3)
C      WRITE(6,630) FINT,FH ,FMZ
C      WRITE(6,631) MAX3D
C      WRITE(6,631) MN,MZ,ML,MEN,MAZ,MEL,LC1,LC2,LC3
C      WRITE(6,631) M1,M2,M3,L1,L2,L3
C      WRITE(6,631) (PEN(I),PAZ(I),PEL(I),I=1,K),LMAX,JM
C      WRITE(6,631) LA1,LA2,LA3,NEN,NAZ,NEL
620    FORMAT(15F7.2)
621         FORMAT(10E10.2)
630    FORMAT(16F7.1/16F7.1/2F7.1)
631    FORMAT(10I5)
640          FORMAT(9(D10.3,I3))
641          FORMAT(3I5,E11.3, I5,E11.3)
690    FORMAT(10X,6I6)
      RETURN
      END
C
C***********************************************************************
C      SUBROUTINE POLFIT
C      LEAST-SQUARE FIT TO DATA WITH POLYNOMIAL CURVE
C      Y = A(1) +A(2)*X + A(3)*X***2 + .....
       SUBROUTINE POLFIT(X,Y,SIGMAY,NPTS,NTERMS,MODE,A,CHISQR)
       DIMENSION X(1),Y(1),SIGMAY(1),A(1)
       DIMENSION SUMX(19),SUMY(10),ARRAY(10,10)
       DOUBLE PRECISION X,Y,SUMX,SUMY,XTERM,YTERM,ARRAY,CHISQ
       DOUBLE PRECISION DETERM,DELTA,A
C
   11 NMAX = 2*NTERMS - 1
      DO 13 N=1,NMAX
   13   SUMX(N) = 0.
      DO 15 J=1,NTERMS
   15   SUMY(J) = 0.
        CHISQ = 0.
21     DO 50 I=1,NPTS
          XI = X(I)
          YI = Y(I)
31     IF ( MODE ) 32,37,39
  32  IF (YI) 35,37,33
  33  WEIGHT = 1./YI
      GO TO 41
  35  WEIGHT = 1./(-YI)
      GO TO 41
  37  WEIGHT = 1.
      GO TO 41
  39  WEIGHT = 1./ SIGMAY(I)**2
41    XTERM = WEIGHT
      DO 44 N=1,NMAX
      SUMX(N) = SUMX(N) + XTERM
  44  XTERM = XTERM*XI
  45  YTERM = WEIGHT*YI
      DO 48 N=1,NTERMS
       SUMY(N) = SUMY(N) + YTERM
  48  YTERM = YTERM*XI
  49  CHISQ = CHISQ + WEIGHT*YI**2
   50 CONTINUE
C
51    DO 54 J=1,NTERMS
       DO 54 K=1,NTERMS
      N = J +K -1
  54  ARRAY(J,K) = SUMX(N)
      DELTA = DETERM(ARRAY,NTERMS)
      IF ( DELTA ) 61,57,61
  57  CHISQR = 0.
      DO 59 J=1,NTERMS
  59  A(J) = 0.
      GO TO 80
  61  DO 70 L =1,NTERMS
       DO 66 J=1,NTERMS
        DO 65 K =1,NTERMS
      N = J+ K -1
  65  ARRAY(J,K) = SUMX(N)
  66  ARRAY(J,L) = SUMY(J)
  70  A(L) = DETERM ( ARRAY,NTERMS )/DELTA
C
      IF (NPTS .LE. NTERMS ) GO TO 90
   71 DO 75 J=1,NTERMS
       CHISQ = CHISQ - 2.*A(J)*SUMY(J)
       DO 75 K =1,NTERMS
        N = K + J -1
   75  CHISQ = CHISQ + A(J)*A(K)*SUMX(N)
   76 FREE = NPTS - NTERMS
   77 CHISQR = CHISQ  / FREE
80    RETURN
90    CHISQR = 1.E5
      RETURN
      END
C
C**************  FUNCTION DETERM  **************************************
      REAL FUNCTION DETERM*8  (ARRAY,NORDER)
      DOUBLE PRECISION ARRAY,SAVE
      DIMENSION ARRAY(10,10)
10    DETERM = 1.D0
11    DO 50 K = 1,NORDER
      IF ( ARRAY(K,K) )  41,21,41
21    DO 23 J=K,NORDER
      IF ( ARRAY(K,J) )  31,23,31
   23 CONTINUE
      DETERM = 0.D0
      GO TO 60
   31 DO 34 I = K,NORDER
       SAVE = ARRAY(I,J)
       ARRAY(I,J) = ARRAY(I,K)
   34 ARRAY(I,K) = SAVE
      DETERM = - DETERM
C
   41  DETERM = DETERM*ARRAY(K,K)
      IF ( K-NORDER)  43,50,50
   43 K1 = K  + 1
      DO 46 I=K1,NORDER
      DO 46 J=K1,NORDER
   46  ARRAY(I,J) = ARRAY(I,J) - ARRAY(I,K)*ARRAY(K,J)/ARRAY(K,K)
50    CONTINUE
60    RETURN
      END
C########################################################################
C
      SUBROUTINE ALVER(F,V,AZ,EL,FALF,MVALF,MAALF,MEALF,AVXS,AVYS,AVZS,
     1BAS,ISHIF,Hhelios)
      COMMON/AA/NEN,NAZ,NEL,LA1,LA2,LA3
      COMMON/KANAL/VOLT(34,2),AZIMUT(18,2),ELEVAT(11)
      COMMON/KONST/PI,UMRF,LH1,LH2,LH3,PIH
      DOUBLE PRECISION V(33),AZ(9),EL(9),F(33,9,9),DFN,
     1 FMAX,ELZ(9),FZZ(9)
      DIMENSION CHACOR(11,2),FALF(9,9,9)
      INTEGER Hhelios
C
C******************** ALFAVERTEILUNGSFUNKTION **************************
C
C********EICH- UND KORREKTURFAKTOREN FUER DIE VERTEILUNGSFUNKTION *****
      DATA CHACOR/4.,4.626,4.956,4.687,4.527,4.393,4.588,4.731,4.591,4.9
     150,4.,4.,4.532,4.609,4.768,4.748,4.876,4.673,4.622,4.540,4.039,4./
C     DELEL = 0.08727
C     DELAZ = 0.09774
      DELZ = 0.01
      GMOA = 4.E-7
      CORR = 1./(GMOA*DELZ)
      WURZ = 1./SQRT(2.)
C
      IANF = NEN + 1
      IEND = IANF + LA1 - 1
      JANF = NAZ + 1
      JEND = JANF + LA2 - 1
      KANF = NEL + 1
      KEND = KANF + LA3 - 1
C
      write(6,*)  'alpha array dimensions'
      WRITE (6,677) IANF,IEND,JANF,JEND,KANF,KEND
 677  FORMAT( 6(I3) )
      write(6,*)  'length', LA1,LA2,LA3
C      write(6,*) Hhelios,ISHIF
C
       DO 11 I=IANF,IEND
   11  V(I+1-IANF) = VOLT(I,ISHIF)*1.D5*WURZ
       DO 12 J =JANF,JEND
   12  AZ(J+1-JANF) = AZIMUT(J,ISHIF)*1.D0
       DO 13 K = KANF,KEND
   13  EL(K+1-KANF) =  ELEVAT(K)*1.D0
        DO 14 I = 1,LA1
        DO 14 J = 1,LA2
        DO 14 K = 1,LA3
        DFN =   V(I)**4*DCOS(EL(K)*UMRF)
C        write(6,*) 'DFN=', DFN
        F(I,J,K) = (FALF(I,J,K) + BAS)*4.D0/CHACOR(K,Hhelios)*CORR/DFN
C        write(6,*) 'F=', F(I,J,K)
   14   CONTINUE
C*********************************************************************
  100 CONTINUE
      IF ( Hhelios .EQ. 2) GO TO 47
C     UMRECHNUNG DER  WINKELZAEHLUNG IN DER ELEVATION VON - NACH +
      DO 40 I = 1,LA1
      DO 40 J = 1,LA2
      DO 41 K = 1,LA3
   41 FZZ(K)= F(I,J,LA3-K+1)
      DO 42 K = 1,LA3
   42 F(I,J,K) = FZZ(K)
   40 CONTINUE
      DO 50 K=1,LA3
   50 ELZ(K)= EL(LA3-K+1)
      DO 51 K=1,LA3
   51 EL(K) = ELZ(K)
      GO TO 46
   47 CONTINUE
      DO 43 I=1,LA1
      DO 43 K=1,LA3
      DO 44 J=1,LA2
   44 FZZ(J) = F(I,LA2-J+1,K)
      DO 45 J=1,LA2
   45 F(I,J,K) = FZZ(J)
   43 CONTINUE
      DO 52 J=1,LA2
   52 ELZ(J) = AZ(LA2-J+1) 
      DO 53 J=1,LA2
   53 AZ(J) = ELZ(J)
C     MAXIMUM -BESTIMMUNG   DER VERTTEILUNGSFUNKTION
   46 FMAX = 0.D0
      DO 20 I = 1,LA1
      DO 20 J =1,LA2
      DO 20 K = 1,LA3
      IF ( F(I,J,K) .LT. FMAX ) GO TO 20
      FMAX = F(I,J,K)
      MVALF = I
      MAALF = J
      MEALF = K
   20 CONTINUE
      WRITE(6,1875) FMAX ,I,J,K
 1875 FORMAT(11H  ALFAFMAX=D12.4,3I5)
C*****BESTIMMUNG DER CARTESISCHEN GESCHWINDIGKEITSKOMPONENTEN DES
C     MAXIMUMS
      AZB = AZ(MAALF)*UMRF
      ELB = EL(MEALF)*UMRF
      COSA = COS(AZB)
      COSE = COS(ELB)
      SINA = SIN(AZB)
      SINE = SIN(ELB)
      AVXS = V(MVALF)*COSA*COSE
      AVYS = V(MVALF)*SINA*COSE
      AVZS = V(MVALF)*SINE
      write(6,*)'alpha particle maximum parameters'
      WRITE(6,9002) AVXS,AVYS,AVZS,MVALF,MAALF,MEALF,LA1,LA2,LA3
 9002 FORMAT(6H AVXS=E15.4,6H AVYS=E15.4,6H AVZS=E15.4/4H MV=I2,
     14H MA=I2,4H ME=I2,4HLA1=I2,4HLA2=I2,4HLA3=I2)
  888 RETURN
      END
C
C     MAXIMUMSSUCHROUTINE
      SUBROUTINE MAXSU(VXS,VYS,VZS,FMAX,VL,IPL)
      LOGICAL IPL
      COMMON/KONST/PI,UMRF,LH1,LH2,LH3,PIH
      DIMENSION Z(3)
      DOUBLE PRECISION S(4)
      NZAHL = 0
      FMAX = EXP(FMAX)
      VL1 = VL
      VXS1 = VXS
      VYS1 = VYS
      VZS1 = VZS
      VXS2 = VXS1
      VYS2 = VYS1
      VZS2 = VZS1
      FMAX1 = FMAX
      FMAX2 = FMAX1
  100 CONTINUE
      NZAHL = NZAHL + 1
C     WRITE(6,101) NZAHL
  101 FORMAT(7H NZAHL=I1)
      Z(1) = -VL1
      Z(2) = 0.
      Z(3) = +VL1
      DO 1  I=1,3
      DO 1  J=1,3
      DO 1  K=1,3
      VX = VXS1 + Z(I)
      VY = VYS1 + Z(J)
      VZ = VZS1 + Z(K)
      R = VX**2 + VY**2 + VZ**2
      R1 = SQRT(VX**2 + VY**2)
      S(1) = 1.D0*SQRT(R)
      S(2) = 1.D0*ATAN2(VY,VX)/UMRF
      S(3) = 1.D0*ATAN2(VZ,R1)/UMRF
      CALL CINT(S,IPL,IERR)
      FFMAX = 0.
      IF ( IERR .EQ. 0. ) FFMAX = SNGL(DEXP(S(4)))
C     IF ( IERR .EQ. 1 ) FFMAX= 0.
C     WRITE(6,102) VX,VY,VZ,FFMAX
  102 FORMAT(5X,3E10.3,6HFFMAX=E10.3)
      IF ( FFMAX .LE.  FMAX2 ) GO TO 1
      FMAX2 = FFMAX
      VXS2 = VX
      VYS2 = VY
      VZS2 = VZ
    1 CONTINUE
      IF ( FMAX2 .EQ. FMAX1 ) GO TO 120
      EPS = ABS( (FMAX2-FMAX1)/FMAX1 )
C     WENN DIE ABWEICHUNG DES NEUEN MAXIMUMS VOM ALTEN <0.2% SPRING ANS
C     ENDE
      IF ( EPS .LT. 0.02 ) GO TO 200
      GO TO 121
  120 IF ( FMAX2 .NE. FMAX ) GO TO 200
  121 VL1 = VL1/2.
      FMAX1 = FMAX2
      VXS1 = VXS2
      VYS1 = VYS2
      VZS1 = VZS2
      IF ( NZAHL .GT. 3 ) GO TO 200
      GO TO 100
  200 VXS = VXS2
      VYS = VYS2
      VZS = VZS2
      FMAX = ALOG(FMAX2)
  300 RETURN
      END
C
      SUBROUTINE KORORB(PARA,WEL,WAZ,AWEL,AWAZ,Hhelios,
     & ora4,ora8,ora9,ora15,ora17)
C**********************************************************************