File: MAKA.FT of Disk: Disks/MyPDP/m8-backup-rka1-rkb1
(Source file text)
C ELEKTRONISCHE WAERMELEITUNG
C DAS PROGRAMM RECHNET DAS VERHAELTNIS VON ELEKTRONISCHER
C WAERMELEITUNG IM SUPRALEITENDEN ZUSTAND ZU DER IM NORMAL-
C LEITENDEM ZUSTAND. DIE EINZUGEBENDEN PARAMETER SIND:
C GPAR:=GAPPARAMETER VON 2*GAP=GPAR*K(BOLZ)*T
C VPD:=VERHAELTNIS VON DEFEKT ZU PHONON STREUUNG
DIMENSION RTT(42)
DIMENSION RDELT(42)
DIMENSION SUM(42)
60 WRITE(4,1000)
READ(4,1100)GPAR
WRITE(4,1200)
READ(4,1300)VPD
WRITE(4,2100)
READ(4,2200)ALF
WRITE(4,2300)
READ(4,2400)BET
WRITE(3,2500)ALF
WRITE(3,2600)BET
2100 FORMAT(1X,'ALPHA=?',T40,$)
2200 FORMAT(E16.8)
2300 FORMAT(1X,'BETA=?',T40,$)
2400 FORMAT(E16.8)
2500 FORMAT(1X,'ALPHA=',T40,E16.8)
2600 FORMAT(1X,'BETA=',T40,E16.8)
WRITE(4,1600)
READ(4,1700)TC
WRITE(3,1800)TC
WRITE(3,1400)GPAR
WRITE(3,1500)VPD
RTT(1)=1.
RDELT(1)=0.
RTT(2)=0.98
RDELT(2)=0.2436
RTT(3)=0.96
RDELT(3)=0.3416
RTT(4)=0.94
RDELT(4)=0.4148
RTT(5)=0.92
RDELT(5)=0.4749
RTT(6)=0.9
RDELT(6)=0.5263
RTT(7)=0.88
RDELT(7)=0.5715
RTT(8)=0.86
RDELT(8)=0.6117
RTT(9)=0.84
RDELT(9)=0.648
RTT(10)=0.82
RDELT(10)=0.681
RTT(11)=0.8
RDELT(11)=0.711
RTT(12)=0.78
RDELT(12)=0.7386
RTT(13)=0.76
RDELT(13)=0.764
RTT(14)=0.74
RDELT(14)=0.7874
RTT(15)=0.72
RDELT(15)=0.8089
RTT(16)=0.7
RDELT(16)=0.8288
RTT(17)=0.68
RDELT(17)=0.8471
RTT(18)=0.66
RDELT(18)=0.864
RTT(19)=0.64
RDELT(19)=0.8796
RTT(20)=0.62
RDELT(20)=0.8939
RTT(21)=0.6
RDELT(21)=0.907
RTT(22)=0.58
RDELT(22)=0.919
RTT(23)=0.56
RDELT(23)=0.9299
RTT(24)=0.54
RDELT(24)=0.9399
RTT(25)=0.52
RDELT(25)=0.9488
RTT(26)=0.5
RDELT(26)=0.9569
RTT(27)=0.48
RDELT(27)=0.9641
RTT(28)=0.46
RDELT(28)=0.9704
RTT(29)=0.44
RDELT(29)=0.9760
RTT(30)=0.42
RDELT(30)=0.9809
RTT(31)=0.4
RDELT(31)=0.985
RTT(32)=0.38
RDELT(32)=0.9885
RTT(33)=0.36
RDELT(33)=0.9915
RTT(34)=0.34
RDELT(34)=0.9938
RTT(35)=0.32
RDELT(35)=0.9957
RTT(36)=0.3
RDELT(36)=0.9971
RTT(37)=0.28
RDELT(37)=0.9982
RTT(38)=0.26
RDELT(38)=0.998
RTT(39)=0.24
RDELT(39)=0.9994
RTT(40)=0.22
RDELT(40)=0.9997
RTT(41)=0.2
WRITE(3,2000)
RDELT(41)=0.9999
I=1
15 I=I+5
RDEL=RDELT(I)
RT=RTT(I)
SUBST=RDEL*GPAR*0.5/RT
X=0.
SU=0.
Z=200.
O=2.
10 O=O+1.
X=O
WURZ=SQRT(X*X+SUBST**2.)
CUB=RT**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=RT**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(I)=SU*DX
WRITE(3,3000)RT
WRITE(3,3100)SUM(I)
TE=RT*TC
WAERN=TE/(ALF*TE**3.+BET)
WAERS=WAERN*SUM(I)
WRITE(3,3200)WAERS
WRITE(3,3300)TE
IF(I-41)15,60,60
1000 FORMAT(1X,'GAPPARAMETER?',T40,$)
1100 FORMAT(E16.8)
1200 FORMAT(1X,'VERHAELTNIS PHONON-DEFEKT STREUUNG?',T40,$)
1300 FORMAT(E16.8)
1400 FORMAT(1X,'GAPPARAMETER=',T40,E16.8)
1500 FORMAT(1X,'VERHAELTNIS PHONON/DEFEKT STREUUNG=',T40,E16.8)
1600 FORMAT(1X,'KRITISCHE TEMPERATUR?',T40,$)
1700 FORMAT(E16.8)
1800 FORMAT(1X,'KRITISCHE TEMPERATUR=',T40,E16.8)
2000 FORMAT(1H0,' RED. TEMP.',T21,'REL.WAERMEL.',T41,'WAERS'
$ ,T61,'TEMPERATUR',/)
3000 FORMAT(E16.8)
3100 FORMAT(1H+,T20,E16.8)
3200 FORMAT(1H+,T40,E16.8)
3300 FORMAT(1H+,T60,E16.8)
STOP
END