C $DEBUG
       SUBROUTINE ABL5(DATEN,PHASE,T2,OMEGA,A,IS,IPA,IPKOPP,
     X LINES,DELAY,T22,OM2,ARRAY,DNF,DOPPL,IQ1,IMERK,SOUT)
       IMPLICIT REAL*8 (A-H,O-Z)
       IMPLICIT INTEGER*2 (I-N)
       REAL*8 DATEN(4096),DNF(6),ARRAY(6,6),U(6)
C
       AM=-1.*A
       DO 10 I=IPA,LINES
        X=IS*I
        WE=DEXP(-1.*X*(T2+(T22+DOPPL)*(2.*DELAY+X)))
        ARG=PHASE+(OMEGA+OM2*X)*X
        U(1)=DCOS(ARG)*WE
        U(2)=AM*X*U(1)
        U(3)=AM*DSIN(ARG)*WE
        IF(IPKOPP.EQ.1) THEN
         U(4)=(X+DELAY)*U(3)
        ELSE
         U(4)=X*U(3)
        ENDIF
        U(5)=(X+2*DELAY)*U(2)
        U(6)=DATEN(I)-A*U(1)
       DO 11 K1=1,6
       DNF(K1)=DNF(K1)+U(K1)*U(K1)
   11  CONTINUE
       IF(IQ1.EQ.1)
     X SOUT=SOUT+(U(IMERK)/U(6))**2
       DO 12 K1=1,5
       NK1=K1+1
       DO 13 K2=NK1,6
       ARRAY(K1,K2)=ARRAY(K1,K2)+U(K1)*U(K2)
   13  CONTINUE
   12  CONTINUE
   10  CONTINUE
       RETURN
       END

C      SUBROUTINE .FIT	   VERSION 1	24.9.80
C      VERSION 2:HAEKEL SCHON VOR FIT:U(LINE,NVAR1)=V(LINE)
C      AUFRUF:	CALL FIT(U,V,NVAR,NVAR1,LENGTH,LINES,SE,CO,NFAIL)
C			 U=U(LENGTH,NVAR1) FUNKTIONALDETERMINANTE
C			 V=V(LENGTH) NAEHERUNGSFEHLER
C			 NVAR  ANZAHL DER ANPASSPARAMETER
C			 NVAR1	NVAR+1
C			 LENGTH	 MAXIMALES DATENFELD
C			 LINES	AKTUELLES DATENFELD
C			 SE=SE(NVAR) STANDARDFEHLER DES FIT
C			 CO=CO(NVAR,NVAR) KORRELATIONSMATRIX
C			 NFAIL 0:FIT OK 1:FIT HAT SINGULARITAET
C
       SUBROUTINE FIT6(DNF,A,V,NVAR,NVAR1,LENGTH,LINES,SE,CO,NFAIL)
       IMPLICIT REAL*8 (A-H,O-Z)
       IMPLICIT INTEGER*2 (I-N)
C
       DIMENSION V(6),SE(6),
     X SR(6),A(6,6),C(6,6),R(6,6),X(6),DNF(6),CO(6,6)
C
C
       N1=NVAR1
       Z0=1./DNF(N1)
C
C
C
       DET=1.
       DO 53 M=1,NVAR
       N2=M-1
       DO 52 J=M,N1
       Z2=0.
       IF(M.EQ.1)GOTO 43
       DO 42 K=1,N2
       Z2=R(K,M)*R(K,J)+Z2
   42  CONTINUE
   43  Z2=A(M,J)-Z2
       IF(J.NE.M)GOTO 50
       DET=DET*Z2
       IF(Z2-1.E-15.GT.0.)GOTO 44
       GOTO 99
   44  R(M,M)=DSQRT(Z2)
       GOTO 52
   50  R(M,J)=Z2/R(M,M)
   52  CONTINUE
   53  CONTINUE
       IT=1
C
C
C
       Z2=0.
       Z3=0.
       M=NVAR
   60  X(M)=(R(M,N1)-Z2)/R(M,M)
       V(M)=X(M)*DNF(M)*Z0
       Z3=X(M)*A(M,N1)+Z3
       IF(M.EQ.1)GOTO 70
       Z2=0.
       DO 61 J=M,NVAR
       Z2=R(M-1,J)*X(J)+Z2
   61  CONTINUE
       M=M-1
       GOTO 60
   70  Z3=(1.-Z3)*Z0*Z0/DBLE(LINES-NVAR)
C       WRITE(*,'(2E12.4,2I4)') Z3,Z0,LINES,NVAR
       IF(Z3.LT.0.)Z3=0.
       SIGMA=DSQRT(Z3)
C
       IT=2
C
C
       K=N1
   71  I=K
       K=K-1
       C(K,K)=0.
   72  N2=I
       I=I-1
       Z2=0.
       IF(I.EQ.NVAR)GOTO 76
       IT=3
       DO 75 N=N2,NVAR
       Z2=R(I,N)*C(N,K)+Z2
   75  CONTINUE
       C(I,K)=-Z2/R(I,I)
   76  CONTINUE
       IF(I.EQ.K)C(I,I)=C(I,I)+1./(R(I,I)*R(I,I))
       C(K,I)=C(I,K)
       IF(I.GT.1)GOTO 72
       IF(K.GT.1)GOTO 71
C
C
C
       ZDIAG=0.
       ZOFF=0.
       IT=5
       DO 33 I=1,NVAR
       Z2=C(I,I)
       SR(I)=DSQRT(Z2)
       Z2=DNF(I)
       SE(I)=Z2*SR(I)*SIGMA
       SR(I)=1./SR(I)
       DO 32 K=I,NVAR
       ZCHECK=0.
       DO 30 L=1,NVAR
       ZCHECK=ZCHECK+A(I,L)*C(L,K)
   30  CONTINUE
       IF(I.EQ.K)GOTO 31
       ZABS=ABS(ZCHECK)
       IF(ZOFF.GT.ZABS)GOTO 32
       ZOFF=ZABS
       GOTO 32
   31  ZABS=ABS(ZCHECK-1.)
       IF(ZDIAG.GT.ZABS)GOTO 32
       ZDIAG=ZABS
   32  CONTINUE
   33  CONTINUE
       DO 102 I=1,NVAR
       DO 101 K=1,I
       Z2=C(I,K)
       CO(I,K)=Z2*SR(I)*SR(K)
  101  CONTINUE
  102  CONTINUE
       IT=4
       NFAIL=0
       RETURN
   99  NFAIL=1
       RETURN
       END

       SUBROUTINE SIM2(DATEN,PHASE,T2,OMEGA,A,IS,IPA,
     X LINES,DELAY,T22,OM2,FAK,VSUM,IVSUM,DOPPL)
       IMPLICIT REAL*8 (A-H,O-Z)
       IMPLICIT INTEGER*2 (I-N)
       REAL*8 DATEN(4096)
       IF(IVSUM.EQ.1) GOTO 120
       DO 10 I=IPA,LINES
        X=IS*I
        WERT=FAK*A*DCOS(PHASE+X*(OMEGA+OM2*X))
     X  *DEXP(-1.*X*(T2+(T22+DOPPL)*(2*DELAY+X)))
        DATEN(I)=DATEN(I)+WERT
   10  CONTINUE
       RETURN
CCCCCCCCCCCCCCCCCCCCCCCCCC
  120  CONTINUE
       VSUM=0.
       DO 20 I=IPA,LINES
        X=IS*I
        WERT=A*DCOS(PHASE+X*(OMEGA+OM2*X))
     X  *DEXP(-1.*X*(T2+(T22+DOPPL)*(2*DELAY+X)))
        ABW=DATEN(I)-WERT
        VSUM=VSUM+ABW*ABW
   20  CONTINUE
       RETURN
       END
C
       SUBROUTINE DOPP(IOUT,IN,IPA,LINES,IKDOP,DATEN,APAR,IPAR,RPAR
     X ,FREQ,PHASE,AMPL,TEMP,MOL,DOPPL,DELAY)
       IMPLICIT REAL*8 (A-H,O-Z)
       IMPLICIT INTEGER*2 (I-M)
       REAL*8 DATEN(4096),RPAR(24)
       INTEGER*2 IPAR(32)
       CHARACTER*2 APAR(128)
C
       INTEGER*2 OUT
       REAL*8 MOL
       OUT=IOUT
       IS=IPAR(1)
C
C
C      BASELINEKORREKTUR+BERECHNUNG DER AMPLITUDE
       BMAX=DATEN(1)
       BMIN=DATEN(1)
C       DSUM=0.
       DO 5 I=IPA,LINES
       IF(DATEN(I).LT.BMIN) BMIN=DATEN(I)
       IF(DATEN(I).GT.BMAX) IPHASE=I
       IF(DATEN(I).GT.BMAX) BMAX=DATEN(I)
C       DSUM=DSUM+DATEN(I)
    5  CONTINUE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C      BASELINE
C       BASELINE=DSUM/FLOAT(LINES-IPA+1)
       BASELINE=0.0D+00
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C      PHASE
C       IF(PHASE.EQ.0.) THEN
       PHASE=-1.*IS*IPHASE*FREQ/159.155
       KPHASE=-1*IDINT(PHASE/6.2831853)
       PHASE=PHASE+(KPHASE+1)*6.2831853
C       ENDIF
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C      DOPPLERKORREKTUR
CCCCCCCC
       IF(IKDOP.EQ.1) THEN
        MOL=RPAR(5)
        IF(DELAY.EQ.0.) DELAY=RPAR(4)*1000.
        TEMP=RPAR(7)
        GHZFRQ=RPAR(1)/1000.
       WRITE(*,1704) MOL,DELAY,TEMP,GHZFRQ
 1704  FORMAT('  MOLGEW.:',F12.2,'  DELAY:',F12.4,/,
     X '  TEMPERATUR:',F12.2,' FREQ[GHZ]:',F12.6)
       IF(MOL.LE.0.5) DOPPL=0.
       IF(MOL.LE.0.5) GOTO 819
C      BERECHNUNG DER DOPPLERBREITE
7371    DOPPL=GHZFRQ*GHZFRQ*1.826E-12*TEMP/MOL
  819      IF(DOPPL.LE.0.) THEN
              WRITE(0,1305)
 1305   FORMAT(' MOLGEW.(AMU),TEMP(K),DELAY(NS)',
     X ' (ALLES REAL)',/)
              READ(IN,*,ERR=819) MOL,TEMP,DELAY
              GOTO 7371
        ENDIF
        DOPPL2=SQRT(DOPPL)*1000.
        DOPPL3=DOPPL2*265.
        WRITE(OUT,5001) DOPPL2,DOPPL3,BASELINE
        WRITE(*,5001) DOPPL2,DOPPL3,BASELINE
       WRITE(OUT,1704) MOL,DELAY,TEMP,GHZFRQ
 5001   FORMAT(' DOPPLERBREITE:',F8.6,' =',F8.2,
     X  ' KHZ BASELINEKORR.:',F10.2,/)
       ELSE
        DOPPL=0.
       ENDIF
C       DO 52 I=IPA,LINES
C       DATEN(I)=(DATEN(I)-BASELINE)
C   52  CONTINUE
       AMPL=(BMAX-BMIN)/2.
       RETURN
       END