File: PHONON.FT of Disk: Disks/MyPDP/m8-2-rka1-rkb1
(Source file text)
C PHONONEN-WAERMELEITUNG
WRITE(4,1000)
READ(4,1100)RT
WRITE(4,1200)
READ(4,1300)RDEL
WRITE(4,1400)
READ(4,1500)GPAR
1000 FORMAT(1X,'RED. TEMP.?',T40,$)
1100 FORMAT(E16.8)
1200 FORMAT(1X,'RED. GAP?',T40,$)
1300 FORMAT(E16.8)
1400 FORMAT(1X,'GAPPAR?',T40,$)
1500 FORMAT(E16.8)
ZWEI=0.
DREI=0.
AH=0.
WRITE(3,9100)AH
9100 FORMAT(1X,'HQUEROMEGA/KT=',T40,E16.8)
ENTE=2./(1.+EXP(RDEL*0.5*GPAR/RT))
WRITE(3,9200)ENTE
9200 FORMAT(1X,'INTEGRAL=',T40,E16.8)
10 AH=AH+0.1
WRITE(3,9300)AH
9300 FORMAT(1X,'HQUEROMEGA/KT=',T40,E16.8)
CE=RDEL*0.5*GPAR/RT/AH
WRITE(4,9400)CE
9400 FORMAT(E16.8)
O=.1
20 O=O+.1
OSQ=O*O
OSQ1=OSQ+1.
OSQ2C=OSQ+2.*CE
OSQ2C1=OSQ2C+1.
OSQCE=OSQ+CE
ERST=(OSQ*OSQ2C+OSQCE)/SQRT(OSQ1*OSQ2C*OSQ2C1)
IF(O-ERST+0.0005)20,30,30
30 WRITE(4,9900)O
9900 FORMAT(E16.8)
DX=O/300
U=-DX
ERST=0.
ENTE=0.
N=0
40 U=U+DX
N=N+1
USQ=U*U
USQ1=USQ+1.
USQ2C=USQ+2.*CE
USQ2C1=USQ2C+1.
USQCE=USQ+CE
ERST=((1.+EXP(AH*USQCE))**(-1.)-(1.+EXP(AH*(USQCE+1.)))**(-1.))
$ *(USQ*USQ2C+USQCE)/SQRT(USQ1*USQ2C*USQ2C1)
IF(N.LE.1)ERST=ERST*0.5
ENTE=ENTE+ERST
IF(U-O+DX)40,50,50
50 ENTE=.5*(((1.+EXP(AH*OSQCE))**(-1.)-(1.+EXP(AH*(OSQCE+1.)))
$ **(-1.))*(OSQ*OSQ2C+OSQCE)/SQRT(OSQ1*OSQ2C*OSQ2C1))+ENTE
ENTE=ENTE*DX*4.
AX=1.+EXP(AH*OSQCE)
AXX=1.+EXP(AH*(OSQCE+1.))
T=1.+1./AH*ALOG(AX/AXX)
ENTE=ENTE+2.*T
IF(CE-0.5)60,70,70
60 ZWEI=0.
O=SQRT(0.5-CE)
DX=O/200.
U=0.
65 U=U+DX
USQ=U*U
USQM1=USQ-1.
USQ2CE=USQ+2.*CE
USQCE1=USQ2CE-1.
USQCE=USQ+CE
U1CE=1.-CE-USQ
AKLA=(USQ*USQ2CE-USQCE)/SQRT(USQM1*USQ2CE*USQCE1)
FEX=1./(1.+EXP(AH*USQCE))+1./(1.+EXP(AH*U1CE))
FEX1=1.-FEX
ZWEI=ZWEI+FEX1*AKLA
IF(U-O+DX)65,66,66
66 ZWEI=(-4.)*ZWEI*DX
ZWEI=ZWEI+0.5*(1.-1./(1.+EXP(AH*CE))+1./(1.+EXP(AH*(1.-CE))))
$ *CE*(-1.)/SQRT((-1.)*2.*CE*(2.*CE-1.))*DX
DREI=0.5*(1.-(1./(1.+EXP(AH*(O+CE)))+1./(1.+EXP(AH*(1.-CE
$ -O*O))))*(O*O*(O*O+2.*CE))-(O*O+CE))/SQRT((O*O-1.)*(O*O+2.
$ *CE)*(O*O+2.*CE-1.))*DX
ENTE=ENTE+ZWEI+DREI
70 WRITE(3,5000)ENTE
5000 FORMAT(1X.'INTEGRAL=',T40,E16.8)
GOTO10
STOP
END