File: CAPFOU.FT of Tape: Various/ETH/f2
(Source file text) 

	SUBROUTINE CAPFOU
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
600	FORMAT(1H0,T10,'DE HAAS VAN ALPHEN FIT BY')
601	FORMAT(1H+,T38,'W.JOSS')
602	FORMAT(1H+,T38,'WM/WW')
603	FORMAT(1H+,T48,'MATERIAL OR GLOBAL NUMBER= ',A2)
604	FORMAT(1H+,T81,'RUN NUMBER= ',I2,5X,'CREATION NUMBER= '
     $  ,A4,//)
606	FORMAT(T10,'FIELD BETWEEN ',F7.4,' TESLA UND ',F7.4,
     $  ' TESLA','   DK = ',F7.4,' TEMPERATURE =',F5.2,
     $  '  ANGLE HR =',F6.1//)
607	FORMAT(T10,'TORQUE:     CALIBRATED IN ',F9.2,
     $  ' DYNCM/VOLT, CAPACITANCE C =',F8.3,' PF'//)
608 	FORMAT(T10,'MAGNETOSTRICTION:     CALIBRATED IN',F9
     $  .3,' ANGSTROEM/VOLT, CAPACITANCE C =',F8.3,' PF'//)
609	FORMAT(T10,'MODULATION =',F5.1,'GAUSS  PAR SENS. ='
     $  ,F6.3,'MV.  TIME C =',F6.3,'SEC.  T SETTING =',F5.2,
     $  'KOHM  TEMP. VAR. =',F6.3//)
610	FORMAT(///,T10,I2,' / ',I2,' / ',I4///)
CDC610	FORMAT(///,T10,A10,///)
614	FORMAT(T10,'NUMBER OF DATA POINTS= ',I4//)
625	FORMAT(//,T10,'INITIAL LEGENDRE COEFFS',//,
     $  T11,F8.3,T30,F8.3,T50,F8.3,T70,F8.3,//)
C
	ITORQ=.FALSE.
	IDILA=.FALSE.
	WRITE(3,600)
	IF (ADENT.NE.1HW) GO TO 135
	WRITE (3,601)
	ITORQ=.TRUE.
135	IF (ADENT.EQ.1HM) WRITE (3,602)
	WRITE(3,603) GLOBAL
	WRITE(3,604) RUN,ICREAT
	WRITE(3,614) NP
CDC	REMOVE 2!
	CALL DATE(MONTH,IDAY,IYEAR)
	WRITE(3,610) IDAY,MONTH,IYEAR
CDC	CALL DATE(YEAR)
CDC	WRITE(3,610) YEAR
	WRITE(3,606)HUP,HDOWN,DK,TEMP,HANG
	IF (.NOT.ITORQ) GO TO 140
	AMIST=AKV
	AKV=CHISQ
	CHISQ=AMIST
	CAP=AMI
	IF(SOLLT.EQ.0.) IDILA=.TRUE.
	IF(IDILA) GO TO 150
	WRITE(3,607)ES,CAP
	EICH=ES/AKV
	GO TO 200
150	WRITE(3,608) ES,CAP
	EICH=ES/AKL*1.E-8
	GO TO 200
140	IF (AMI.LT.1.) AMI=AMI*1.E4
	WRITE(3,609) AMI,PS,PT,SOLLT,TV
	EICH=PS
200	WRITE(3,625) (Q(1,I),I=1,4)
	RETURN
	END