File: KAMA.FT of Disk: Disks/MyPDP/m8-backup-rka1-rkb1

(Source file text) 

---

C	ELEKTRONISCHE WAERMELEITUNG
	DIMENSION RT(42)
	DIMENSION RDEL(42)
	WRITE(4,1000)
	READ(4,1100)GPAR
	WRITE(4,1200)
	READ(4,1300)VPD
	WRITE(3,1400)GPAR
	WRITE(3,1500)VPD
	RT(1)=1.
	RDEL(1)=0.
	RT(2)=.98
	RDEL(2)=0.2436
	RT(3)=0.96
	RDEL(3)=0.3416
	RT(4)=0.94
	RDEL(4)=0.4148
	RT(5)=0.92
	RDEL(5)=0.4749
	RT(6)=0.9
	RDEL(6)=0.5263
	RT(7)=0.88
	RDEL(7)=0.5715
	RT(8)=0.86
	RDEL(8)=0.6117
	RT(9)=0.84
	RDEL(9)=0.6480
	RT(10)=0.82
	RDEL(10)=0.681
	RT(11)=0.8
	RDEL(11)=0.711
	RT(12)=0.78
	RDEL(12)=0.7386
	RT(13)=0.76
	RDEL(13)=0.764
	RT(14)=0.74
	RDEL(14)=0.7874
	RT(15)=0.72
	RDEL(15)=0.8089
	RT(16)=0.7
	RDEL(16)=0.8288
	RT(17)=0.68
	RDEL(17)=0.8417
	RT(18)=0.66
	RDEL(18)=0.864
	RT(19)=0.64
	RDEL(19)=0.8796
	RT(20)=0.62
	RDEL(20)=0.8939
	RT(21)=0.6
	RDEL(21)=0.907
	RT(22)=0.58
	RDEL(22)=0.919
	RT(23)=0.56
	RDEL(23)=0.9299
	RT(24)=0.54
	RDEL(24)=0.9399
	RT(25)=0.52
	RDEL(25)=0.9488
	RT(26)=0.5
	RDEL(26)=0.9569
	RT(27)=0.48
	RDEL(27)=0.9641
	RT(28)=0.46
	RDEL(28)=0.9704
	RT(29)=0.44
	RDEL(29)=0.976
	RT(30)=0.42
	RDEL(30)=0.9809
	RT(31)=0.4
	RDEL(31)=0.985
	RT(32)=0.38
	RDEL(32)=0.9885
	RT(33)=0.36
	RDEL(33)=0.9915
	RT(34)=0.34
	RDEL(34)=0.9938
	RT(35)=0.32
	RDEL(35)=0.9957
	RT(36)=0.3
	RDEL(36)=0.9971
	RT(37)=0.28
	RDEL(37)=0.9982
	RT(38)=0.26
	RDEL(38)=0.998
	RT(39)=0.24
	RDEL(39)=0.9994
	RT(40)=0.22
	RDEL(40)=0.9997
	RT(41)=0.2
	RDEL(41)=0.9999
	RT(42)=0.18
	RDEL(42)=1.000
	I=0
15	I=I+1
	RDELT=RDEL(I)
	RTT=RT(I)
	SUBST=RDELT*GPAR*0.5/RTT
	X=0.
	SU=0.
	Z=200.
	O=2.
10	O=O+1.
	X=O
	WURZ=SQRT(X*X+SUBST**2.)
	CUB=RTT**3.*VPD
	DWURZ=X/WURZ
	HWURZ=0.5*WURZ
	EFUN=(2/(EXP(HWURZ)+EXP(-1.*HWURZ)))**2
	FO=X*X*EFUN*(1.+CUB)/(DWURZ+CUB)
	IF(FO-0.001)30,30,10
30	X=0
	DX=O/Z
35	X=X+DX
	WURZ=SQRT(X*X+SUBST**2.)
	CUB=RTT**3.*VPD
	DWURZ=X/WURZ
	HWURZ=0.5*WURZ
	EFUN=(2./(EXP(HWURZ)+EXP(-1.*HWURZ)))**2.
	IF(X-O)40,50,50
40	SU=(X*X*EFUN*(1.+CUB)/(DWURZ+CUB))+SU
	GOTO 35
50	DIV=3./(2.*3.14159*3.14159)
	SU=((X*X*EFUN*(1.+CUB)*(DWURZ+CUB)**(-1.))*0.5+SU)*DIV
	SUM=SU*DX
	WRITE(3,5400)SUM
	IF(I-42)15,60,60
60	GOTO 10
5500	FORMAT(/1X,'VERHAELTNIS PHONON-ELEKTRON STREUUNG?',T40,$)
5600	FORMAT(E16.8)
5700	FORMAT(1X,'VERHAELTNIS PHONON-DEFEKT STREUUNG=',T40,E16.8)
4200	FORMAT(E16.8)B
4400	FORMAT(1X,'REDUZIERTE TEMPERATUR?',T40,$)
4500	FORMAT(E16.8)
4600	FORMAT(1X,'REDUZIERTE TEMPERATUR=',T40,E16.8)
4700	FORMAT(1X,'REDUZIERTES GAP?',T40,$)
4800	FORMAT(E16.8)
4900	FORMAT(1X,'REDUZIERTES GAP=',T40,E16.8)
5100	FORMAT(1X,'GAPPARAMETER?',T40,$)
5200	FORMAT(E16.8)
5300	FORMAT(1X,'GAPPARAMETER=',T40,E16.8)
1000	FORMAT(1X,'OBERE GRENZE DES INTEGRALS WAR',T40,E16.8)
	STOP
	END

---