File: INIFOU.FT of Tape: Various/ETH/f2

(Source file text) 

---

	SUBROUTINE INIFOU(IOK)
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
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)
C
615	FORMAT(1H0,T10,'--------------BAD FILE---------------',
     $  A1,A2,'D',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
CDC	REMOVE 2
90	CALL CHKEOF(EOF)
	READ(5,502) ADENT,GLOBAL,AMIST,AMIST,ICREAT
CDC90	READ(5,502) ADENT,GLOBAL,AMIST,AMIST,ICREAT
CDC	REMOVE
	IF (EOF.EQ.0.) GO TO 93
CDC	IF (EOF(5).EQ.0.) GO TO 93
	RUN=RUN+1
	WRITE(3,625) RUN
	STOP
93	IF (ADENT.NE.1HW.AND.ADENT.NE.1HM) GO TO 90
	BACKSPACE 5
	READ(5,501) ADENT,GLOBAL,AMIST,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 (AMIST.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,AMI,PS,PT,SOLLT,TEMP
     $  ,TV,SHIFT,PERMAS,ES,AKL,CHISQ,AKV,(AMIST,K=1,4)
	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
	SHFACT=14.69*PERMAS*TEMP/(DK*HUP*PI)
	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

---