File: WAERP.FT of Disk: Disks/MyPDP/m8-backup-rka1-rkb1
(Source file text)
C PHONONEN WAERMELEITUNG
DIMENSION RTT(9)
DIMENSION RDELT(9)
WRITE(4,1400)
READ(4,1500)GPAR
WRITE(4,1600)
READ(4,1700)TC
WRITE(4,1800)
READ(4,1900)GY
WRITE(4,2000)
READ(4,2100)YK
WRITE(4,2200)
READ(4,2300)CY
WRITE(3,1000)GPAR
WRITE(3,1100)TC
WRITE(3,1200)GY
WRITE(3,1300)YK
WRITE(3,2400)CY
1000 FORMAT(1X,'GAPPARAMETER=',T40,E16.8)
1100 FORMAT(1X,'KRITISCHE TEMPERATUR=',T40,E16.8)
1200 FORMAT(1X,'PUNKTDEFEKTSTR.=',T40,E16.8)
1300 FORMAT(1X,'BOUNDARY SCATTERING=',T40,E16.8)
2400 FORMAT(1X,'PHONON-ELEKTRONSTR.=',T40,E16.8)
1400 FORMAT(1X,'GAPPAR?',T40,$)
1500 FORMAT(E16.8)
1600 FORMAT(1X,'KRITISCHE TEMPERATUR',T40,$)
1700 FORMAT(E16.8)
1800 FORMAT(1X,'PUNKTDEFEKTSTREDUUNG?',T40,$)
1900 FORMAT(E16.8)
2000 FORMAT(1X,'BOUNDARY SCATTERING',T40,$)
2100 FORMAT(E16.8)
2200 FORMAT(1X,'PHONON-ELEKTRONSTREUUNG',T40,$)
2300 FORMAT(E16.8)
RTT(1)=0.9
RDELT(1)=0.5263
RTT(2)=0.8
RDELT(2)=0.711
RTT(3)=0.7
RDELT(3)=0.8288
RTT(4)=0.6
RDELT(4)=0.907
RTT(5)=0.5
RDELT(5)=0.9569
RTT(6)=0.4
RDELT(6)=0.985
RTT(7)=0.3
RDELT(7)=0.9971
RTT(8)=0.2
RDELT(8)=0.9999
RTT(9)=0.1
RDELT(9)=1.000
I=0
WRITE(3,5400)
5400 FORMAT(1H0,'RED. TEMP'.,T21,'SUP.PHON.LEIT.',T41,
$ 'VERH.PHONONL',T61,'TEMPERATUR')
5 I=I+1
RDEL=RDELT(I)
RT=RTT(I)
ZWEI=0.
DREI=0.
AH=0.
ENTE=2./(1.+EXP(RDEL*0.5*GPAR/RT))
PHOWA1=0.
DXX=0.2
PHOWAN=0.
10 AH=AH+DXX
WRITE(4,4800)I
4800 FORMAT(1X,'PUNKT NR.',T40,E16.8)
WRITE(4,2500)AH
2500 FORMAT(E16.8)
CE=RDEL*0.5*GPAR/RT/AH
O=.2
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.001)20,30,30
30 DX=O/150.
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.
WRITE(4,9810)ENTE
9810 FORMAT(E16.8)
AX=1.+EXP(AH*OSQCE)
AXX=1.+EXP(AH*(OSQCE+1.))
T=1.+1./AH*ALOG(AX/AXX)
ENTE=ENTE+2.*T
WRITE(4,9800)ENTE
9800 FORMAT(E16.8)
IF(CE-0.5)60,70,70
60 ZWEI=0.
O=SQRT(0.5-CE)
DX=O/150.
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=ZWEI+0.5*(1.-(1./(1.+EXP(AH*CE))+1./(1.+EXP(AH*(1.-CE)))))
$ *CE*(-1.)/SQRT((-1.)*2.*CE*(2.*CE-1.))
DREI=0.5*(1.-(1./(1.+EXP(AH*(O*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.))
ZWEI=(-4.)*DX*(ZWEI+DREI)
WRITE(4,9700)ZWEI
9700 FORMAT(E16.8)
70 ENTE=ENTE+ZWEI
TE=RT*TC
PHOWAS=(AH**4.*EXP(AH))/(((EXP(AH)-1.)**2.)*(CY*TE*AH
$ *ENTE+YK+GY*TE**4.*AH**4.))
WRITE(4,9600)PHOWAS
9600 FORMAT(E16.8)
PHOWA1=PHOWA1+PHOWAS
IF(PHOWAS.LE.0.005)GOTO80
75 PHOWAN=PHOWAN+(AH**4.*EXP(AH))/(((EXP(AH)-1.)**2.)*(CY*TE*AH
$ +YK+GY*TE**4.*AH**4.))
GOTO10
80 IF(AH.LE.8.)GOTO75
PHOWA1=PHOWA1*DXX*TE**3.
PHOWAN=PHOWAN*DXX*TE**3.
RPHOW=PHOWA1/PHOWAN
WRITE(3,9000)RT
9000 FORMAT(E16.8)
WRITE(3,9100)PHOWA1
9100 FORMAT(1H+,T21,E16.8)
WRITE(3,9200)RPHOW
9200 FORMAT(1H+,T41,E16.8)
WRITE(3,9300)TE
9300 FORMAT(1H+,T61,E16.8)
IF(I.LT.9)GOTO5
90 WRITE(4,9400)
9400 FORMAT(1X,'IST DIESER FIT BESSER?')
STOP
END