File: KIN.FT of Tape: Various/ETH/f4

(Source file text) 

---

	SUBROUTINE INIFOU(IOK)
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
	REAL EOF(5)
C
501	FORMAT(A1,A2,A1,I2,A4)
502	FORMAT(A1,A2,A1,A2,A4)
503	FORMAT(F8.1)
504	FORMAT(I2,20(/F9.4))
506	FORMAT(I6)
507	FORMAT(I2)
508	FORMAT(3F10.5)
C
615	FORMAT(1H0,T10,"--------------BAD FILE---------------",
     $  A1,A2,A1,I2,///)
620	FORMAT(1H0,T10,"----- FILE NUMBER ",I2,
     $  " OUT OF RANGE -----",////)
625	FORMAT(1H0,T10,"----- END-OF-FILE AT FILE ",I3," -----",///)
C
	RUN=ISTART-1
	GO TO 90
200	WRITE(3,615) ADENT,GLOBAL,RUN
90	CALL CHKEOF(EOF(5))
	READ(5,502) ADENT,GLOBAL,AMIST,AMIST,ICREAT
	IF (EOF(5).EQ.0.) GO TO 93
	RUN=RUN+1
	WRITE(3,625) RUN
	STOP
93	IF (DITOMO.NE.1HM.AND.DITOMO.NE.1HD.AND.
     $  DITOMO.NE.1HT.AND.DITOMO.NE.1HX) GO TO 90
	BACKSPACE 5
	READ(5,501) ADENT,GLOBAL,DITOMO,RUN,ICREAT
	IF (RUN.LT.ISTART) GO TO 90
	IF (RUN.LE.ISTOP) GO TO 95
	WRITE(3,620) RUN
	STOP
95	READ(5,506) NP
	IF (NP.LE.0.OR.NP.GT.512) GO TO 200
	IF (DITOMO.EQ.1HX) IOK=IOK+1
	ISTART=RUN
	IF (IOK.NE.0) GO TO 101
	DO 100 I=1,NP
100	READ(5,503) F(I)
101	IF (IOK.EQ.2) READ(5,504) IVAR,(AMIST,K=1,IVAR)
	READ(5,504) IVAR,DK,HANG,HUP,HDOWN,CAPMO,PS,PT,SOLLT,TEMP
     $  ,TV,SHIFT,PERMAS(1),ES,AKL,AKV,(AMIST,K=1,5)
	CHISQ=0.
	IF (IVAR.LE.20) GO TO 105
	READ (5,503) (AMIST,K=21,IVAR)
105	IF (IOK.EQ.1) READ(5,504) IVAR,(AMIST,K=1,IVAR)
	IF (IOK.EQ.0) GO TO 106
	DO 104 I=1,NP
	IF (IOK.EQ.2) READ(5,503) AMIST
	READ (5,503) F(I)
	IF (IOK.EQ.1) READ(5,503) AMIST
104	CONTINUE
106	IF (HUP.GT.20.) HUP=HUP/10000.
	IF (HDOWN.GT.20.) HDOWN=HDOWN/10000.
	IF (PT.GT.10.) PT=PT/1000.
	IF (TEMP.LT.1.) TEMP=5.
	IF (TEMP.GT.5.) TEMP=5.
	IF (IDEFIX.NE.0) CALL FILFOU
	DKHI=DK*HUP*.001
	DL=DK*1.E-3*NP
	DO 107 I=2,11
	FRE1(I)=0.
	FRE2(I)=0.
107	PERMAS(I)=.0
	IF (PERMAS(1).NE.0.) GO TO 109
	PERMAS(1)=1.
	REWIND 4
	READ(4,507) IMIST
	IMIST=IMIST+1
	DO 108 I=2,IMIST
108	READ(4,508) FRE1(I),FRE2(I),PERMAS(I)
109	K1=1
	DO 120 K=2,KMAX
	DO 117 I=1,4
117	Q(K,I)=0.
120	CONTINUE
	A0=0.
	A1=0.
	A2=0.
	A3=0.
	DO 30 IX=1,NP
	I=IX-1
	FUNC=F(IX)/NP
	H2=FLOAT(I)/NP
	PLEG1=2.*H2-1.
	PLEG2=6.*H2*H2-6.*H2+1.
	PLEG3=20.*H2*H2*H2-30.*H2*H2+12.*H2-1.
	A0=A0+FUNC
	A1=A1+PLEG1*FUNC
	A2=A2+PLEG2*FUNC
	A3=A3+PLEG3*FUNC
30	CONTINUE
	Q(1,1)=A0
	Q(1,2)=A1*3.
	Q(1,3)=A2*5.
	Q(1,4)=A3*7.
	CALL CAPFOU
	RETURN
	END

---