<div id='wikitext'>
<pre><b> File: KSE.FT of Tape: Various/ETH/f4</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
	SUBROUTINE SERFOU(IPASS)
C
	COMMON /TITLE/ ADENT,GLOBAL,DITOMO,RUN,ICREAT
	COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI,
     $  UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX
	COMMON /PARAM/ DKHI,SHFACT(11),CHISQ,DK,DL,HANG
     $  ,HUP,HDOWN,CAPMO,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,EICH
	COMMON /EFFMU/ FRE1(11),FRE2(11),PERMAS(11)
	COMMON /PEAKS/ TASWI,KBLOW,KBLOW1,KMAX,K1,K3,CHI,
     $  Q(11,4),HIGHT(21),INDEX(21)
	COMMON /VECT/ C(44),D1(11,4),DIAGEL(44),D(44),E(44)
	COMMON /DATIN/ F(512),NP
	COMMON /CONST/ PI,TWOPI
	COMMON /PLOTC/ PLTBUF(400)
	COMMON /FAF/ A(2049),B(2049),N
	DIMENSION AR(44,44),Z(44,44)
	EQUIVALENCE (A,AR),(B,Z)
	INTEGER RUN
	REAL K3
	LOGICAL ITEST,TASWI
C
	REAL NF,MU
C
100	FORMAT(1H1,T10,&quot;PASSRKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKmTRm5RKUuUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU) CHI
	IF (IPASS.EQ.0) WRITE(0,120) CHI
	IF (IPASS.EQ.0) KLAST=KMAX*2+1
	IF (IPASS.LE.0) GO TO 6
	KBLOW1=FLOAT((N/NP)*KBLOW)/100.
	TASWI=.F.
	KLAST=KMAX/2+1
	K1=1
2	JA=K1+1
	JE=KMAX*2+1
	DO 5 J=JA,JE
	INDEX(J)=0
5	HIGHT(J)=0.
	GO TO 1
6	DO 4 J=2,K1
	HIGHT(J)=ABS(Q(J,3))
4	INDEX(J)=-INEW*IFIX(Q(J,1)*FLOAT(N)/TWOPI)
1	I=3*N/NP
3	JA=I-KBLOW1
	JE=I-1
	DO 10 J=JA,JE
	IF (A(J+1).LT.A(J)) GO TO 15
10	CONTINUE
	JA=I
	JE=I+KBLOW1/2-1
	DO 12 J=JA,JE
	IF (A(J+1).GT.A(J)) GO TO 20
12	CONTINUE
	GO TO 35
15	JA=I
	JE=I+KBLOW1-1
	DO 30 J=JA,JE
	IF (A(J+1).GT.A(J)) GO TO 20
30	CONTINUE
	JA=I-KBLOW1/2
	JE=I-1
	DO 32 J=JA,JE
	IF (A(J+1).LT.A(J)) GO TO 20
32	CONTINUE
35	HIGH=A(I)*FLOAT(N/NP)
	IND=I*INEW
	DO 40 K=2,KLAST
	IDIST=IABS(I-IABS(INDEX(K)))
	IF (IDIST.LT.KBLMIN) GO TO 45
	IF (IDIST.GE.2*KBLMIN) GO TO 36
	DO 37 LL=2,KLAST
	IF (K.EQ.LL) GO TO 37
	IDIST=IABS(IABS(INDEX(K))-IABS(INDEX(LL)))
	IF (IDIST.LT.KBLMIN) GO TO 45
37	CONTINUE
36	IF (HIGH.LT.HIGHT(K)) GO TO 40
	IF (K.EQ.KLAST) GO TO 52
	LE=KLAST-K
	DO 50 LL=1,LE
	L=KLAST-LL
	HIGHT(L+1)=HIGHT(L)
	INDEX(L+1)=INDEX(L)
	IF (IPASS.EQ.0) GO TO 50
	SHFACT(L+1)=SHFACT(L)
	DO 53 M=1,4
53	Q(L+1,M)=Q(L,M)
50	CONTINUE
52	HIGHT(K)=HIGH
	INDEX(K)=IND
	IF (K1.LT.KLAST) K1=K1+1
	GO TO 45
40	CONTINUE
45	I=I+KBLOW1/2-1
20	I=I+1
	IF (I.LE.N/2-KBLOW1) GO TO 3
	IF (IPASS.LE.0) GO TO 25
	CALL TAUFOU(INDEX(2),FNU,PHI,AF,TAU)
	IF (ABS(TAU).LT.2.) GO TO 25
	IF (TASWI) GO TO 25
	TASWI=.T.
	KBLOW1=KBLOW1*(1.+(ABS(TAU)-2.)/3.)
	K1=2
	WRITE(0,130) KBLOW1
	GO TO 2
25	KK=K1
	HIGH=CHISQ
	IF (IPASS.EQ.0) HIGH=CHISQ/100.
	HIGH=SQRT(HIGH/K1)/2.
	K1=2
	DO 57 I=3,KK
	IF (HIGHT(I).GT.HIGH) GO TO 56
	INDEX(I)=0
	HIGHT(I)=0.
	GO TO 57
56	K1=K1+1
57	CONTINUE
	DO 60 I=2,K1
	IF (INDEX(I)*INEW.LT.0) GO TO 60
	CALL TAUFOU(INDEX(I)*INEW,FNU,PHI,AF,TAU)
	NF=FNU/DL
	DO 61 J=2,11
	JJ=J
	IF (NF.GE.FRE1(J).AND.NF.LE.FRE2(J)) GO TO 62
	JJ=1
61	CONTINUE
62	IF (IPASS.EQ.0) GO TO 58
	Q(I,1)=TWOPI*FNU/NP
	Q(I,2)=PHI
	Q(I,3)=AF
	Q(I,4)=-TAU
	SHFACT(I)=14.69*PERMAS(JJ)*TEMP/(DK*HUP*PI)
58	CONTINUE
	PH=PHI*180./PI
	AM=AF*EICH
	TA=-TAU/DL
	MU=PERMAS(JJ)*NF*1.E-3
	WRITE(0,160) NF,PH,AM,TA,MU
60	CONTINUE
	IF (IPASS.EQ.0) K1=KEEP
	RETURN
	END
</pre>
<hr/>
</div>