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

(Source file text) 

---

	SUBROUTINE CAPFOU
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
600	FORMAT(1H0,T10,"DE HAAS VAN ALPHEN FIT")
601	FORMAT(1H+,T36,"SC")
602	FORMAT(1H+,T36,"EL")
603	FORMAT(1H+,T38,"-MAGNET    MATERIAL OR GLOBAL NUMBER= ",A2)
604	FORMAT(1H+,T81,"RUN NUMBER= ",I2,5X,"CREATION NUMBER= "
     $  ,A4,//)
606	FORMAT(T10,"FIELD BETWEEN ",F7.4," TESLA AND ",F7.4,
     $  " TESLA"," DK =",1PE9.2," 1/T TEMPERATURE =",0PF6.3,
     $  " +/-",F5.3,"  ANGLE HR =",F6.1//)
607	FORMAT(T10,"TORQUE:",T30,"CALIBRATED IN ",F9.2,
     $  " DYNCM/VOLT,  SAMPLE: LENGHT =",F6.3,
     $  " CM,  VLUME =",F6.3," CM^3"/)
608 	FORMAT(T10,"MAGNETOSTRICTION",T30,"CALIBRATED IN",F9.3,
     $  " ANGSTROEM/VOLT, SAMPLE: LENGTH =",F6.3,
     $  " CM,  VOLUME =",F6.3," CM^3"/)
609	FORMAT(T10,"MODULATION =",F6.4," TESLA,  PAR: SENS ="
     $  ,F7.3," MV,  TIME CONST =",F6.3," SEC  TEMP SET =",F6.2,
     $  " KOHM"//)
610	FORMAT(///,T10,I2,"/",I2,"/",I4,///)
611	FORMAT(T30,"CAPACITANCE =",F8.3," PF,  PAR: SENS =",F6.0,
     $  "  MMV,  TIME CONST =",F6.3," SEC"////)
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
C	ALTE MODULATIONSFILES
	IF (ADENT.EQ.1HM.AND.DITOMO.EQ.1HD) DITOMO=1HM
C
	IF (DITOMO.NE.1HX) GO TO 100
	IF (SOLLT.EQ.0.) DITOMO=1HD
	IF (SOLLT.EQ.1.) DITOMO=1HT
100	WRITE(0,600)
	IF (ADENT.EQ.1HM) GO TO 110
	WRITE (0,601)
	GO TO 120
110	WRITE(0,602)
120	WRITE(0,603) GLOBAL
	WRITE(0,604) RUN,ICREAT
	WRITE(0,614) NP
	CALL DATE(MONTH,DAY,YEAR)
	WRITE(0,610) DAY,MONTH,YEAR
	DK3=DK*1.E-3
	WRITE(0,606)HUP,HDOWN,DK3,TEMP,TV,HANG
	IF (DITOMO.NE.1HM) GO TO 130
	EICH=PS
	WRITE(0,609) CAPMO,PS,PT,SOLLT
	GO TO 200
130	IF (DITOMO.NE.1HD) GO TO 140
	EICH=ES*1.E-8/AKL
	WRITE(0,608) ES,AKL,AKV
	WRITE(0,611) CAPMO,PS,PT
	GO TO 200
140	IF (DITOMO.NE.1HT) GO TO 200
	EICH=ES/AKV
	WRITE(0,607) ES,AKL,AKV
	WRITE(0,611) CAPMO,PS,PT
200	WRITE(0,625) (Q(1,I),I=1,4)
	RETURN
	END

---