<div id='wikitext'>
<pre><b> File: NORFOU.FT of Tape: Various/ETH/f2</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
	SUBROUTINE NORFOU
C
	COMMON /TITLE/ ADENT,GLOBAL,RUN,ICREAT
	COMMON /FITPAR/ JIT,FISTOP,AMARQI,UPMARQ,DNMARQ,VARI,
     $  UPVAR,DNVAR,VARMIN,MLOOP,LOOPLW,ISTART,ISTOP,ITEST,IDEFIX
	COMMON /PARAM/ DKHI,SHFACT,CHISQ,ITORQ,IDILA,DK,DL,HANG
     $  ,HUP,HDOWN,AMI,PS,PT,SOLLT,TEMP,TV,ES,AKL,AKV,CAP,EICH
	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 ITORQ,IDILA,ITEST,TASWI
C
CDC	JUST SO WE DON&#039;T MISS THIS VITAL DECLARATION!!
C	DIMENSION=KMAX*4 AND KMAX,10
	REAL DER1(44),DER2(11,10)
C
	NA=K1*4
	DO 10 I=1,NA
	C(I)=0.
	DO 20 J=1,NA
	AR(I,J)=0.
20	CONTINUE
10	CONTINUE
	DO 30 IX=1,NP
	I=IX-1
	H2=FLOAT(I)/NP
	H3=2.*H2-1.
	H4=6.*H2*H2-6.*H2+1.
	H5=20.*H2*H2*H2-30.*H2*H2+12.*H2-1.
	R1=-F(IX)+Q(1,1)+Q(1,2)*H3+Q(1,3)*H4+Q(1,4)*H5
	FLD1OV=1.+I*DKHI
	SQTFLD=SQRT(FLD1OV)
	IF (ITORQ) SQTFLD=1./SQTFLD
	DO 40 L=2,K1
	LX=L-1
	QL1=Q(L,1)
	QL2=Q(L,2)
	QL4=Q(L,4)
	CO=COS(I*QL1-QL2)
	SI=SIN(I*QL1-QL2)
	AM=Q(L,3)*SQTFLD/(1.-EXP(-SHFACT*QL1*FLD1OV))
	E8=1./(1.-EXP(-QL4))
	E9=EXP(-H2*QL4)
	E3=1.-E8-H2
	EX=QL4*E8*E9
	E1=E8*E9*(1.+QL4*E3)
	R1=R1+AM*CO*EX
	DER1(LX*4+1)=-I*SI*AM*EX*D1(L,1)
	DER1(LX*4+2)=SI*AM*EX*D1(L,2)
	DER1(LX*4+3)=CO*EX*D1(L,3)
	DER1(LX*4+4)=CO*AM*E1*D1(L,4)
C  IF SECOND DERIVATIVE
C	E2=E1*E3+E8*E9*(E3-Q(L,4)*E8*(1-E8))
C	DER2(LX,1)=-I*I*CO*AM*EX*D1(L,1)*D1(L,1)
C	DER2(LX,2)=I*CO*AM*EX*D1(L,1)*D1(L,2)
C	DER2(LX,3)=-CO*AM*EX*D1(L,2)*D1(L,2)
C	DER2(LX,4)=-I*SI*EX*D1(L,1)*D1(L,3)
C	DER2(LX,5)=SI*EX*D1(L,2)*D1(L,3)
C	DER2(LX,6)=0.
C	DER2(LX,7)=-I*SI*AM*E1*D1(L,1)*D1(L,4)
C	DER2(LX,8)=SI*AM*E1*D1(L,2)*D1(L,4)
C	DER2(LX,9)=CO*E1*D1(L,3)*D1(L,4)
C	DER2(LX,10)=CO*AM*E2*D1(L,4)*D1(L,4)
40	CONTINUE
	DER1(1)=D1(1,1)
	DER1(2)=D1(1,2)*H3
	DER1(3)=D1(1,3)*H4
	DER1(4)=D1(1,4)*H5
	DERX=0.
	DO 50 KL=1,K1
	L=KL-1
	M1=0
	DO 60 NL=1,4
	I=NL+4*L
	C(I)=C(I)-DER1(I)*R1
	IF (L.EQ.0) GO TO 75
	LJ=4*L
	DO 70 J=1,LJ
	AR(J,I)=AR(J,I)+DER1(J)*DER1(I)
70	CONTINUE
75	DO 80 M=1,NL
	J=M+4*L
	M1=M1+1
C IF SECOND DERIVATIVE
C	IF (L.NE.0) DERX=R1*DER2(L,M1)
	AR(J,I)=AR(J,I)+DER1(J)*DER1(I)+DERX
80	CONTINUE
60	CONTINUE
50	CONTINUE
30	CONTINUE
	DO 100 J=1,NA
100	DIAGEL(J)=AR(J,J)
	RETURN
	END
</pre>
<hr/>
</div>