C
C $DEBUG
       SUBROUTINE S1N(DATEN,PHASES,T2S,FREQS,AS,IS,IPA,
     X LINES,DELAY,T22,OM2,ARRAY,DNF,DOPPL,LINJH,IQH,PI,
     X IFSTPL,T2ALL,PNULL,OUT,IZSUP,IZYKLEN,ICORMX,IZSUPM
     X ,RKL,DT2ME,T2MAXW,T2MINW,AVSUM,IAUS,OUTD,
     X INEUFT,T2OUTF,LINMAX,DOPPLS)
       IMPLICIT REAL*8 (A-H,O-Z)
       IMPLICIT INTEGER*2 (I-N)
       COMMON/DAT/DATENN(4096),AVGSUM(16),IKAVG
       REAL*8 DATEN(4096),DNF(6),ARRAY(6,6),U(6),
     X PHASES(30),T2S(30),FREQS(30),AS(30),OM2(30),
     X AR(6,6),CO(6,6),DMF(6),SE(6),
     X V(6),VCOR(6)
       INTEGER*2 IQH(5),OUT,OUTD
C
111     CONTINUE
        IFSTPL=0
        T22F=0.D+00
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  SUBTRAKTION DER AVERAGERKORR. UND DER STOERUNGEN     C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
          DO 9736 I=IPA-1,LINES-1,IKAVG
           DO 9736 L=1,IKAVG
            IF((I+L).LE.LINES)
     X       DATEN(I+L)=DATENN(I+L)-AVGSUM(L)
 9736      CONTINUE
          IF (LINJH.LT.LINMAX) THEN
         FAK=-1.D+00
         DO 6731 LIN=LINJH+1,LINMAX
         OMEGA=FREQS(LIN)*2.D+00*PI/1000.D+00
         A=AS(LIN)
         T2=T2S(LIN)
         PHASE=PHASES(LIN)
         CALL SIM2(DATEN,PHASE,T2,OMEGA,A,IS,IPA,
     X   LINES,DELAY,T22F,OM2(LIN),FAK,VSUM,0,DOPPLS)
6731     CONTINUE
         ENDIF
CCCCCCCC BEGINN FITSCHLEIFE CCCCCCCCCCCC
       DO 90 KZYKLEN=1,IZYKLEN
       IF(INEUFT.EQ.1) THEN
       DO 901 I=1,3
       VCOR(I)=0.D+00
901    CONTINUE
       ICOR=0
       AT2ALL=T2ALL
       APNULL=PNULL
       ADELAY=DELAY
       GOTO 600
       ENDIF
CCCCCCCC INITIALISIEREN CCCCCCCCCCCCCCCC
       DO 8 K1=1,4
       DNF(K1)=0.D+00
       DMF(K1)=0.D+00
       ARRAY(K1,K1)=1.D+00
       AR(K1,K1)=1.D+00
       NK1=K1+1.D+00
       DO 9 K2=NK1,4
       ARRAY(K1,K2)=0.D+00
        AR(K1,K2)=0.D+00
    9  CONTINUE
    8  CONTINUE
      IF(IQH(1).EQ.1) THEN
      DO 1275 I12=2,4
       IF(IQH(I12).EQ.1) IMERK=I12-1
 1275 CONTINUE
      ELSE
        IMERK=0
      ENDIF
        CALL ABLS(DATEN,PHASES,T2S,FREQS,AS,IS,IPA,
     X LINES,DELAY,T22,OM2,ARRAY,DNF,DOPPL,LINJH,IQH,PI,SOUT,IMERK)
C
       IF(IQH(1).NE.1) GOTO 95842
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     EINPARAMETERFIT                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      V(1)=ARRAY(IMERK,4)/DNF(IMERK)
      SE(1)=1.D+00/DSQRT(SOUT/(LINES-IPA))
      GOTO 12751
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     ENDE EINPARAMETERFIT               C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
95842  CONTINUE
       DO 16 K1=1,4
       DNF(K1)=1.D+00/DSQRT(DNF(K1))
   16  CONTINUE
       DO 14 IK1=1,3
       NK1=IK1+1.D+00
       DO 15 IK2=NK1,4
       IF(IQH(IK1+1).EQ.0) THEN
       GOTO 14
       ELSE
       K1=IQH(IK1+1)
       ENDIF
       IF(IQH(IK2+1).EQ.0) THEN
       GOTO 15
       ELSE
       K2=IQH(IK2+1)
       ENDIF
       DMF(K1)=DNF(IK1)
       AR(K1,K2)=ARRAY(IK1,IK2)*DNF(IK1)*DNF(IK2)
   15  CONTINUE
   14  CONTINUE
       DMF(IQH(1)+1)=DNF(4)
       DO 114 K1=1,3
       NK1=K1+1
       DO 115 K2=1,4
       AR(K2,K1)=AR(K1,K2)
  115  CONTINUE
  114  CONTINUE
       NFAIL=0
CCCCCCCCCCC CALL FIT CCCCCCCCCCCC
       NVAR=IQH(1)
       NVAR1=NVAR+1
       LINESM=LINES+1-IPA
       CALL FIT6(DMF,AR,V,NVAR,NVAR1,1024,LINESM,SE,CO,NFAIL)
C
       IF(NFAIL.NE.0) THEN
       WRITE(OUT,1000) NFAIL
 1000  FORMAT(' FIT NICHT OK,NFAIL=',I4)
       ICOR=ICORMX+10
       GOTO 610
       ENDIF
C
12751  CONTINUE
       XCOR=2.D+00
CCCCCCCCCCC SICHERN DER ALTEN WERTE CCCCCCCCCCCCCCC
       AT2ALL=T2ALL
       APNULL=PNULL
       ADELAY=DELAY
       DO 50 IV=1,3
       IF(IQH(IV+1).EQ.0) THEN
       VCOR(IV)=0.D+00
       ELSE
       VCOR(IV)=V(IQH(IV+1))*2.D+00
       ENDIF
   50  CONTINUE
       ICOR=0
C   PRO FITZYKLUS NUR RELAXATIONSZEITAENDERUNGEN VON 0.5 MOEGLICH
       IF(VCOR(1).GT.DT2ME) VCOR(1)=DT2ME
       RT2M=-2.D+00*DT2ME
       IF(VCOR(1).LT.RT2M) VCOR(1)=RT2M
CC   PRO FITZYKLUS PHASENAENDERUNGEN VON MAXIMAL PI/2 MOEGLICH
C       IF(VCOR(2).GT.PI) VCOR(2)=PI
C       IF(VCOR(2).LT.(-1.D+00*PI)) VCOR(2)=-1.D+00*PI
CC   PRO FITZYKLUS MAXIMAL DELAYAENDERUNGEN VON 200 NS MOEGLICH
C       IF(VCOR(3).GT.400.) VCOR(3)=400.D+00
C       IF(VCOR(3).LT.-400.) VCOR(3)=-400.D+00
CC   PRO FITZYKLUS MAXIMAL DELAYAENDERUNGEN VON 150NS MOEGLICH
 1627  CONTINUE
       IF(ABS(VCOR(3)).GT.150.) THEN
          VCOR(2)=VCOR(2)/2.D+00
          VCOR(3)=VCOR(3)/2.D+00
          GOTO 1627
       ENDIF
CCCC SCHLEIFE MIT FEHLERQUADRAT SOLL KLEINER WERDEN CCC
  600  CONTINUE
       ICOR=ICOR+1
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  EINSCHUB FUER FIT NICHT ERFOLGREICH           C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       IF(ICOR.GE.ICORMX) THEN
       WRITE(*,*)' VERWENDE WIEDER ALTE PARAMETER'
       T2ALL=AT2ALL
       PNULL=APNULL
       DELAY=ADELAY
       ENDIF
610    CONTINUE
       IF(ICOR.GE.ICORMX) THEN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C SUBTRAKTION DER ALTEN BERECHNETEN DECAYS  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
         FAK=-1.D+00
         DO 732 LIN=1,LINJH
         OMEGA=FREQS(LIN)*PI/500.D+00
         A=AS(LIN)
       IF(IQH(2).EQ.1) T2S(LIN)=T2ALL
       IF((IQH(3)+IQH(4)).GT.0)
     X PHASES(LIN)=PNULL+DELAY*OMEGA
       IF(PHASES(LIN).GT.2.D+00*PI) PHASES(LIN)=PHASES(LIN)-
     X   2.D+00*PI*DINT(PHASES(LIN)/(2.D+00*PI))
         T2=T2S(LIN)
         PHASE=PHASES(LIN)
         CALL SIM2(DATEN,PHASE,T2,OMEGA,A,IS,IPA,
     X   LINES,DELAY,T22F,OM2(LIN),FAK,VSUM,0,DOPPL)
  732    CONTINUE
C       ENDIF
       VSUM=0.D+00
       DO 7818 I=IPA,LINES
         VSUM=VSUM+DATEN(I)*DATEN(I)
7818   CONTINUE
       BSUM=DSQRT(VSUM/DBLE(LINES-IPA+1))
       ASUM=DSQRT(AVSUM/DBLE(LINES-IPA+1))
       WRITE(*,'(2(A,F14.4))') ' STDABW. NEU',BSUM,'    ALT',ASUM
       GOTO 95
       ENDIF
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  ENDE EINSCHUB FUER FIT NICHT ERFOLGREICH      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       DO 60 IV=1,3
       IF(VCOR(IV).NE.0.) VCOR(IV)=VCOR(IV)/XCOR
   60  CONTINUE
       T2ALL=AT2ALL+VCOR(1)
       IF(IT2G.EQ.1) THEN
         IF(T2ALL.GT.T2MAXW) T2ALL=T2MAXW
         IF(T2ALL.LT.T2MINW) T2ALL=T2MINW
       ENDIF
       PNULL=APNULL+VCOR(2)
       DELAY=ADELAY+VCOR(3)
       FAK=-1.D+00
       DO 717 LIN=1,LINJH
       OMEGA=FREQS(LIN)*PI/500.D+00
       A=AS(LIN)
       IF(IQH(2).EQ.1) THEN
        T2=T2ALL
       ELSE
        T2=T2S(LIN)
       ENDIF
       IF((IQH(3)+IQH(4)).GT.0) THEN
         PHASE=PNULL+DELAY*OMEGA
       ELSE
         PHASE=PHASES(LIN)
       ENDIF
       CALL SIM2(DATEN,PHASE,T2,OMEGA,A,IS,IPA,
     X LINES,DELAY,T22F,OM2(LIN),FAK,VSUM,0,DOPPL)
  717  CONTINUE
       VSUM=0.D+00
       DO 818 I=IPA,LINES
         VSUM=VSUM+DATEN(I)*DATEN(I)
  818  CONTINUE
C      FEHLERQUADRAT SOLL KLEINER WERDEN
C       WRITE(OUT,'(2E20.10)') VSUM,AVSUM
        IF((VSUM.GT.RKL*AVSUM).AND.(INEUFT.NE.1)) THEN
           IFSTPL=1
        ELSE
           IFSTPL=0
        ENDIF
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       IF((VSUM.GT.AVSUM).AND.(INEUFT.NE.1)) THEN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  SUBTRAKTION DER AVERAGERKORR. UND DER STOERUNGEN     C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
          DO 9737 I=IPA-1,LINES-1,IKAVG
           DO 9737 L=1,IKAVG
            IF((I+L).LE.LINES)
     X       DATEN(I+L)=DATENN(I+L)-AVGSUM(L)
9737      CONTINUE
          IF (LINJH.LT.LINMAX) THEN
         FAK=-1.D+00
         DO 7731 LIN=LINJH+1,LINMAX
         OMEGA=FREQS(LIN)*PI/500.D+00
         A=AS(LIN)
         T2=T2S(LIN)
         PHASE=PHASES(LIN)
         CALL SIM2(DATEN,PHASE,T2,OMEGA,A,IS,IPA,
     X   LINES,DELAY,T22F,OM2(LIN),FAK,VSUM,0,DOPPLS)
7731     CONTINUE
         ENDIF
       GOTO 600
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       ENDIF
         ASUM=DSQRT(AVSUM/DBLE(LINES-IPA+1))
         BSUM=DSQRT(VSUM/DBLE(LINES-IPA+1))
         AVSUM=VSUM
         WRITE(*,'(2(A,F14.4))') ' STDABW. NEU',BSUM,'    ALT',ASUM
   90  CONTINUE
   95  CONTINUE
       DO 727  LIN=1,LINJH
       IF(IQH(2).EQ.1) T2S(LIN)=T2ALL
       OMEGA=FREQS(LIN)*PI/500.D+00
       IF((IQH(3)+IQH(4)).GT.0)
     X PHASES(LIN)=PNULL+DELAY*OMEGA
       IF(PHASES(LIN).GT.2.D+00*PI) PHASES(LIN)=PHASES(LIN)-
     X   2.D+00*PI*DINT(PHASES(LIN)/(2.D+00*PI))
  727  CONTINUE
       IF(PNULL.GT.(PI*2.)) PNULL=PNULL-2.D+00*PI
       IF(PNULL.LT.0.) PNULL=PNULL+2.D+00*PI
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C         AUSGABE                         C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
       IF((IZSUP.EQ.IZSUPM).OR.(IAUS.EQ.1)) THEN
         IOUT=OUT
 1234    CONTINUE
         WRITE(IOUT,12341)
12341    FORMAT(/,22X,' WERT        FEHLER    LETZTE KORR.')
         IF(IQH(2).GT.0 ) THEN
          T2ALLA=T2ALL*1000.D+00
          T2OUTF=SE(IQH(2))*1000.D+00
          VCORA=VCOR(1)*1000.D+00
          WRITE(IOUT,12342)
     X    T2ALLA,T2OUTF,VCORA
12342     FORMAT(13X,' 1/T2:',3F12.6)
         ENDIF
         IF(IQH(3).GT.0 ) THEN
          PNULLA=PNULL*180.D+00/PI
          SEA=SE(IQH(3))*180.D+00/PI
          VCORA=VCOR(2)*180.D+00/PI
          WRITE(IOUT,12343)
     X    PNULLA,SEA,VCORA
12343     FORMAT(' PHASE AM PULSENDE:',3F12.6)
         ENDIF
         IF(IQH(4).GT.0) WRITE(IOUT,12344)
     X    DELAY,SE(IQH(4)),VCOR(3)
12344     FORMAT(12X,' DELAY:'3F12.6)
         WRITE(IOUT,12345)
12345    FORMAT(' ')
         IF((IZSUP.EQ.IZSUPM).AND.(IOUT.NE.OUTD)) THEN
           IOUT=OUTD
           GOTO 1234
         ENDIF
       ENDIF
        IF(INEUFT.EQ.1) THEN
        INEUFT=0
        GOTO 111
        ENDIF
       RETURN
       END
C
C
C
       SUBROUTINE ABLS(DATEN,PHASES,T2S,FREQS,AS,IS,IPA,
     X LINES,DELAY,T22,OM2,ARRAY,DNF,DOPPL,LINJH,IQH,PI,SOUT,IMERK)
       IMPLICIT REAL*8 (A-H,O-Z)
       IMPLICIT INTEGER*2 (I-N)
       REAL*8 DATEN(4096),DNF(6),ARRAY(6,6),U(6),
     X PHASES(30),T2S(30),FREQS(30),AS(30),US(4)
       INTEGER*2 IQH(5)
C
        SOUT=0.D+00
       DO 10 I=IPA,LINES
        DSUM=0.D+00
        US(1)=0.D+00
        US(2)=0.D+00
        US(3)=0.D+00
       DO 9 LIN=1,LINJH
        PHASE=PHASES(LIN)
        T2=T2S(LIN)
        A=AS(LIN)
        FREQ=FREQS(LIN)
        OMEGA=FREQ*2.D+00*PI/1000.D+00
        AM=-1.D+00*A
        X=IS*DFLOAT(I)
        WE=DEXP(-1.D+00*X*(T2+(T22+DOPPL)*(2*DELAY+X)))
        ARG=PHASE+(OMEGA+OM2*X)*X
        Z=DCOS(ARG)*WE
        DSUM=A*Z+DSUM
        U(1)=AM*X*Z
        Z2=U(1)*(T22+DOPPL)*2.D+00
        U(2)=AM*DSIN(ARG)*WE
        U(3)=U(2)*OMEGA+Z2
        US(1)=US(1)+U(1)
        US(2)=US(2)+U(2)
        US(3)=US(3)+U(3)
    9  CONTINUE
        US(4)=DATEN(I)-DSUM
       DO 11 K1=1,4
        DNF(K1)=DNF(K1)+US(K1)*US(K1)
   11  CONTINUE
       IF(IQH(1).EQ.1)
     X SOUT=SOUT+(US(IMERK)/US(4))**2
       DO 12 K1=1,3
        NK1=K1+1
       DO 13 K2=NK1,4
        ARRAY(K1,K2)=ARRAY(K1,K2)+US(K1)*US(K2)
   13  CONTINUE
   12  CONTINUE
   10  CONTINUE
       RETURN
       END