C PROGRAM SPECTR
00000001
C ********************************************************************
00000002
C *
* 00000003
C * COMPUTATON OF THE ENEGRGY BAND STRUCTURE
(TIGHT-BINDING METHOD) * 00000004
C *
* 00000005
C ********************************************************************
00000006
C
00000007
IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4
(I-N)
00000008
INTEGER*4 TXA,TXL
00000009
EXTERNAL ELMT,ATOV
00000010
COMPLEX*16 APT,HPT,SPT,RPT,UPT,VPT,ABJ,CBJ,DCMPLX
00000011
COMMON/KPOIN/NIX,NIY,NIZ,JFI,DKX,DKY,DKZ,DKH,KXK(550),
00000012
,
KYK(550),KZK(550),MPT(17,17,17),JHI,
00000013
,
PKX(550),PKY(550),PKZ(550)
00000014
COMMON/DIRSP/NSR,NRV,MRS(30),BRX(3),BRY(3),BRZ(3),DRX,DRY,
00000015
,
DRZ,DRH,TBX(3),TBY(3),TBZ(3),ARX(600),ARY(600),
00000016
,
ARZ(600),DRR(600),KRX(600),KRY(600),KRZ(600)
00000017
COMMON PI,TPI,FPI,AOO,BOA,COA,LAT,NAT,NGT,IP,TXS,
00000018
,
TXA(3),MIO(3),MOR(3),MRI(3),MRF(3),NBE
00000019
DIMENSION HOV(3000),HPT(30,30),SOV(4500),SPT(30,30),EPT(30),
00000020
,
APT(30,30),RPT(30,30),UPT(30,30),EOV(30),TXO(10),
00000021
,
ABJ(30),MBN(30),AIR(2,30,30),RIR(2,30,30),TXL(4)
00000022
EQUIVALENCE (APT(1,1),AIR(1,1,1)),(RPT(1,1),RIR(1,1,1)),
00000023
,
(IBP,NOI),(NPB,NOF)
00000024
DEFINE FILE 10(5500,328,L,JRB),
00000025
,
14(550,1600,L,JRH), 15(550,1600,L,JRS)
00000026
DATA TXL/' SC ',' FCC',' BCC','
HEX'/,ERS/1.D-4/,ERE/1.D-6/, 00000027
, TXO/'
S ','3Z*Z-R*R',' X*X-Y*Y',' XY ','
ZX ', 00000028
,
' YZ ',' PX ','
PY ',' PZ ',' S
'/ 00000029
C
00000030
C CALCULATE REAL SPACE VECTORS BETWEEN
ALL ATOMS
00000031
C AND STORE THEM ON THE FILE 1
00000032
C
00000033
CALL VECGEN
00000034
C
00000035
CALL SIMSTR(LAT)
00000036
C
00000037
C READ AND PRINT INPUT DATA FOR THE
CALCULATION
00000038
WRITE (6,1818) TXS
00000039
READ (5,998) NPI,NPX,NPY,NPZ
00000040
WRITE (6,1798) NPI,NPX,NPY,NPZ
00000041
DO 34 IAT=1,NAT
00000042
READ (5,998) MIO(IAT),MOR(IAT),MRI(IAT),MRF(IAT)
00000043
34 CONTINUE
00000044
DO 54 IAT=1,NAT
00000045
NOI=MIO(IAT)
00000046
NOF=NOI+MOR(IAT)-1
00000047
WRITE(6,1828) TXA(IAT)
00000048
WRITE(6,1838) (TXO(IB),IB=NOI,NOF)
00000049
54 CONTINUE
00000050
C
00000051
C READ AND PRINT CONTROL PARAMETERS
FOR THE CALCULATION
00000052
READ(5,998) JOT,JSE,JPP,JPA,JPM,JPB,JPV,JWM,JWB
00000053
WRITE (6,1848) JOT,JSE,JPP,JPA,JPM,JPB,JPV,JWM,JWB
00000054
IF (NPI.NE.1) GO TO 94
00000055
C
00000056
C FORM THE ARRAY OF THE INDEPENDENT
BOUND INTEGRALS
00000057
C
00000058
CALL ATPARS(JPA,HOV,3000,NAH)
00000059
C
00000060
WRITE (6,1758) TXS
00000061
C
00000062
CALL FORMTX(0,ELMT,ATOV,0,0,0.D
0,0.D 0,0.D 0,
00000063
,
ERS,0,0,HPT,30,NBE,HOV,3000,NAH)
00000064
C
00000065
REWIND 9
00000066
WRITE (9) TXS,NAH,(HOV(INS),INS=1,NAH)
00000067
GO TO 104
00000068
94 REWIND 9
00000069
READ (9) TXS,NAH,(HOV(INS),INS=1,NAH)
00000070
WRITE (6,1728) TXS,NAH
00000071
IF (JPI.EQ.0) GO TO 104
00000072
WRITE (6,1738) TXS
00000073
WRITE (6,1748) (INS,HOV(INS),INS=1,NAH)
00000074
104 IF (JOT.NE.0) GO TO 154
00000075
IF (NPI.NE.1) GO TO 114
00000076
C
00000077
C FORM THE ARRAY OF THE INDEPENDENT
OVERLAP INTEGRALS
00000078
C
00000079
CALL ATPARS(JPA,SOV,4500,NAS)
00000080
C
00000081
WRITE (6,1768) TXS
00000082
C
00000083
CALL FORMTX(0,ELMT,ATOV,0,0,0.D
0,0.D 0,0.D 0,
00000084
,
ERS,0,0,SPT,30,NBE,SOV,4500,NAS)
00000085
C
00000086
WRITE (9) TXS,NAS,(SOV(INS),INS=1,NAS)
00000087
GO TO 154
00000088
114 READ (9) TXS,NAS,(SOV(INS),INS=1,NAS)
00000089
WRITE (6,1778) TXS,NAS
00000090
IF (JPI.EQ.0) GO TO 154
00000091
WRITE (6,1788) TXS
00000092
WRITE (6,1748) (INS,SOV(INS),INS=1,NAS)
00000093
C CONSTRUCT THE REGULAR MESH IN THE
IRREDUCIBLE ZONE
00000094
C
00000095
C STORE INPUT DATA ON THE FILE 11
00000096
154 REWIND 11
00000097
WRITE (11) AOO,BOA,COA,LAT,NAT,NGT,TXS,(TXA(IAT),IAT=1,NAT),
00000098
,
(MIO(IAT),IAT=1,NAT),(MOR(IAT),IAT=1,NAT),
00000099
,
(MRI(IAT),IAT=1,NAT),(MRF(IAT),IAT=1,NAT),NBE
00000100
IF (NPI.NE.1) GO TO 174
00000101
C
00000102
CALL KMESHP(LAT,NPX,NPY,NPZ,JPP,NPT)
00000103
C
00000104
C TRANSFORM THE VECTORS (KX,KY,KZ)
TO THE RECTANGULAR COORDINATES 00000105
DO 164 IP=1,NPT
00000106
C
00000107
CALL SIREVC(LAT,KXK(IP),KYK(IP),KZK(IP),
00000108
,
DKX,DKY,DKZ,DKH,PKX(IP),PKY(IP),PKZ(IP))
00000109
C
00000110
164 CONTINUE
00000111
C
00000112
C STORE THE MESH OF THE REGULAR POINTS
ON THE FILE 2
00000113
REWIND 2
00000114
WRITE (2) BOA,COA,LAT,NPX,NPY,NPZ,NPT,
00000115
,
NIX,NIY,NIZ,DKX,DKY,DKZ,DKH
00000116
WRITE (2) (KXK(IP),IP=1,NPT)
00000117
WRITE (2) (KYK(IP),IP=1,NPT)
00000118
WRITE (2) (KZK(IP),IP=1,NPT)
00000119
WRITE (2) (((MPT(I,J,K),I=1,NPX),J=1,NPY),K=1,NPZ)
00000120
WRITE (2) (PKX(IP),IP=1,NPT)
00000121
WRITE (2) (PKY(IP),IP=1,NPT)
00000122
WRITE (2) (PKZ(IP),IP=1,NPT)
00000123
GO TO 184
00000124
C
00000125
C READ COORDINATES OF THE REGULAR MESH
POINTS
00000126
174 REWIND 2
00000127
READ (2) BOA,COA,LAT,NPX,NPY,NPZ,NPT,
00000128
,
NIX,NIY,NIZ,DKX,DKY,DKZ,DKH
00000129
READ (2) (KXK(IP),IP=1,NPT)
00000130
READ (2) (KYK(IP),IP=1,NPT)
00000131
READ (2) (KZK(IP),IP=1,NPT)
00000132
READ (2) (((MPT(I,J,K),I=1,NPX),J=1,NPY),K=1,NPZ)
00000133
READ (2) (PKX(IP),IP=1,NPT)
00000134
READ (2) (PKY(IP),IP=1,NPT)
00000135
READ (2) (PKZ(IP),IP=1,NPT)
00000136
WRITE (6,1808) TXL(LAT),NPT
00000137
C
00000138
C CALCULATE THE ENERGY SPECTRUM POINT
AFTER POINT
00000139
C
00000140
184 WRITE (6,1708) TXS
00000141
DO 404 IP=NPI,NPT
00000142
PQX=PI*PKX(IP)
00000143
PQY=PI*PKY(IP)
00000144
PQZ=PI*PKZ(IP)
00000145
IF (JPB.NE.0) WRITE (6,1628) IP,PKX(IP),PKY(IP),PKZ(IP)
00000146
IF (JPM.NE.0) WRITE (6,1608)
00000147
C
00000148
C FORM THE MATRIX OF THE BOND INTEGRALS
AT THE POINT
00000149
C
00000150
CALL FORMTX(0,ELMT,ATOV,0,0,PQX,PQY,PQZ,
00000151
,
ERS,1,JPM,HPT,30,NBE,HOV,3000,NAH)
00000152
C
00000153
IF (JWM.EQ.0) GO TO 194
00000154
C
00000155
C STORE THE MATRIX OF THE BOND INTEGRALS
ON THE FILE 14
00000156
JRH=IP
00000157
WRITE (14'JRH) ((HPT(IB,JB),IB=1,NBE),JB=1,NBE)
00000158
194 IF (JOT.EQ.0) GO TO 204
00000159
C
00000160
C DIAGONALISE THE MATRIX AND OBTAIN
EIGENVECTORS
00000161
C
00000162
CALL DJACOB(HPT,60,30,NBE,ERE,1000,0,0,EPT,APT)
00000163
C
00000164
C CALCULATE THE INVERSE OF THE MATRIX
OF EIGENVECTORS
00000165
C
00000166
CALL DHERMT(APT,30,NBE,RPT,30,NBE)
00000167
C
00000168
GO TO 234
00000169
204 IF (JPM.NE.0) WRITE (6,1618)
00000170
C
00000171
C FORM THE MATRIX OF THE OVERLAP INTEGRALS
AT THE POINT
00000172
C
00000173
CALL FORMTX(0,ELMT,ATOV,0,0,PQX,PQY,PQZ,
00000174
,
ERS,1,JPM,SPT,30,NBE,SOV,3000,NAS)
00000175
C
00000176
IF (JWM.EQ.0) GO TO 214
00000177
C STORE THE MATRIX OF THE OVERLAP INTEGRALS
ON THE FILE 15
00000178
JRS=IP
00000179
WRITE (15'JRS) ((SPT(IB,JB),IB=1,NBE),JB=1,NBE)
00000180
C
00000181
C SOLVE THE GENERALISED EIGENVALUE
PROBLEM WITH THE EIGENVECTORS
00000182
C
00000183
214 CALL DCHOLK(HPT,SPT,30,NBE,ERE,1000,0,UPT,EOV,RPT,EPT,APT)
00000184
C
00000185
C CALCULATE THE INVERSE OF THE MATRIX
OF EIGENVECTORS
00000186
C
00000187
CALL DHERMT(UPT,30,NBE,HPT,30,NBE)
00000188
C
00000189
DO 224 JB=1,NBE
00000190
CBJ=DCMPLX(DSQRT(EOV(JB)),0.D
0)
00000191
DO 224 IB=1,NBE
00000192
224 HPT(IB,JB)=HPT(IB,JB)*CBJ
00000193
C
00000194
CALL DHERMT(RPT,30,NBE,UPT,30,NBE)
00000195
C
00000196
CALL DCMULM(HPT,30,NBE,UPT,30,NBE,RPT,30,NBE)
00000197
C
00000198
234 IF (JSE.EQ.0) GO TO 294
00000199
C NUMERATE THE EIGENVALUES IN ORDER
OF INCREASE
00000200
C
00000201
CALL DSORIN(EPT,NBE,MBN)
00000202
C
00000203
C ORDER THE EIGENVECTORS ACCORDING
TO EIGENVALUES
00000204
C
00000205
DO 284 JB=1,NBE
00000206
DO 244 IB=1,NBE
00000207
244 ABJ(IB)=APT(JB,IB)
00000208
DO 254 IB=1,NBE
00000209
NBJ=MBN(IB)
00000210
254 APT(JB,IB)=ABJ(NBJ)
00000211
DO 264 IB=1,NBE
00000212
264 ABJ(IB)=RPT(IB,JB)
00000213
DO 274 IB=1,NBE
00000214
NBJ=MBN(IB)
00000215
274 RPT(IB,JB)=ABJ(NBJ)
00000216
284 CONTINUE
00000217
294 IF (JPB.EQ.0) GO TO 364
00000218
C
00000219
C PRINT THE EIGENVALUES AND EIGENVECTORS
00000220
WRITE (6,1638) (IB,EPT(IB),IB=1,NBE)
00000221
WRITE (6,1678)
00000222
DO 324 IB=1,NBE
00000223
NPB=12
00000224
IF (NPB.GT.NBE) NPB=NBE
00000225
WRITE (6,1648) IB,(AIR(1,JB,IB),JB=1,NPB)
00000226
WRITE (6,1658) (AIR(2,JB,IB),JB=1,NPB)
00000227
IF (NPB.EQ.NBE) GO TO 324
00000228
DO 314 IBP=13,NBE,12
00000229
NPB=IPB+11
00000230
IF (NPB.GT.NBE) NPB=NBE
00000231
IF (MOD((IBP-1)/12,2).EQ.0) GO TO
304
00000232
WRITE (6,1668) (AIR(1,JB,IB),JB=IBP,NPB)
00000233
WRITE (6,1668) (AIR(2,JB,IB),JB=IBP,NPB)
00000234
GO TO 314
00000235
304 WRITE (6,1658) (AIR(1,JB,IB),JB=IBP,NPB)
00000236
WRITE (6,1658) (AIR(2,JB,IB),JB=IBP,NPB)
00000237
314 CONTINUE
00000238
324 CONTINUE
00000239
IF (JPV.EQ.0) GO TO 364
00000240
C
00000241
C PRINT THE INVERSE OF THE MATRIX OF
EIGENVECTORS
00000242
WRITE (6,1718)
00000243
DO 354 IB=1,NBE
00000244
NPB=12
00000245
IF (NPB.GT.NBE) NPB=NBE
00000246
WRITE (6,1648) IB,(RIR(1,IB,JB),JB=1,NPB)
00000247
WRITE (6,1658) (RIR(2,IB,JB),JB=1,NPB)
00000248
IF (NPB.EQ.NBE) GO TO 354
00000249
DO 344 IBP=13,NBE,12
00000250
NPB=IPB+11
00000251
IF (NPB.GT.NBE) NPB=NBE
00000252
IF (MOD((IBP-1)/12,2).EQ.0) GO TO
334
00000253
WRITE (6,1668) (RIR(1,IB,JB),JB=IBP,NPB)
00000254
WRITE (6,1668) (RIR(2,IB,JB),JB=IBP,NPB)
00000255
GO TO 344
00000256
334 WRITE (6,1658) (RIR(1,IB,JB),JB=IBP,NPB)
00000257
WRITE (6,1658) (RIR(2,IB,JB),JB=IBP,NPB)
00000258
344 CONTINUE
00000259
354 CONTINUE
00000260
364 IF (JWB.EQ.0) GO TO 404
00000261
C
00000262
C STORE THE EIGENVALUES AND EIGENVECTORS
ON THE FILE 10
00000263
C
00000264
JRB=1+(IP-1)*NBE
00000265
DO 374 IB=1,NBE
00000266
WRITE (10'JRB) EPT(IB),(APT(JB,IB),JB=1,NBE),
00000267
,
(RPT(IB,JB),JB=1,NBE)
00000268
374 CONTINUE
00000269
404 CONTINUE
00000270
C
00000271
998 FORMAT(1H ,9I5)
00000272
1768 FORMAT(//,20X,'THE RESULTS FOR THE INDEPENDENT',
00000273
,
' OVERLAP MATRIX ELEMENTS OF ',A8,/,20X,67('-'))
00000274
1728 FORMAT(/,30X,'INDEPENDENT MATRIX ELEMENTS OF THE',
00000275
,
' HAMILTONIAN OF ',A8,' READ',//,40X,'NUMBER',
00000276
,
' OF THE ELEMENTS',14X,'NAH=',I5)
00000277
1738 FORMAT(/,30X,'INDEPENDENT MATRIX ELEMENTS OF THE HAMILTONIAN',
00000278
,
' OF ',A8,//,4X,'NO',5X,'HOV',5(11X,'NO',5X,'HOV'),/)
00000279
1778 FORMAT(/,30X,'INDEPENDENT OVERLAP MATRIX ELEMENTS OF',A8,
00000280
,
' READ',//,40X,'NUMBER OF THE ELEMENTS NAS=',I5)
00000281
1818 FORMAT(//,30X,'INPUT DATA FOR THE CALCULATION OF THE',
00000282
,
' ENERGY BANDS OF ',A8,/,30X,62('-'))
00000283
1828 FORMAT(/,40X,'BASIS ORBITALS FOR THE ATOM OF',A4,/)
00000284
1838 FORMAT((20X,A8,5(' , ',A8)))
00000285
1848 FORMAT(//,40X,'CONTROL PARAMETERS FOR THE CALCULATION',/,
00000286
,
40X,38('-'),//,10X,'JOT=',I2,4X,'JSE=',I2,4X,'JPP=',
00000287
,
I2,4X,'JPA=',I2,4X,'JPM=',I2,4X,'JPB=',I2,4X,'JPV=',
00000288
,
I2,4X,'JWM=',I2,4X,'JWB=',I2)
00000289
1808 FORMAT(/,30X,'REGULAR MESH POINTS FOR ',A4,'IRREDUCIBLE',
00000290
,
' ZONE READ',//,20X,'NUMBER OF THE MESH POINTS IN',
00000291
,
' THE IRREDUCIBLE ZONE',10X,'NPT=',I5)
00000292
1798 FORMAT(/,20X,'NUMBER OF THE STARTING POINT IN THE',
00000293
,
' IRREDUCIBLE ZONE',20X,'NPI=',I4,/,20X,'NUMBERS',
00000294
,
' OF THE MESH POINTS ALONG SIMMETRY DIRECTIONS',
00000295
,
' NPX=',I3,' NPY=',I3,' NPZ=',I4)
00000296
1718 FORMAT(/,30X,'INVERSE OF THE MATRIX OF',
00000297
,
' EIGENVECTORS AT THE POINT',/)
00000298
1608 FORMAT(/,20X,'MATRIX OF THE B O U N D',
00000299
,
' I N T E G R A L S AT THE POINT')
00000300
1618 FORMAT(/,20X,'MATRIX OF THE O V E R L A P',
00000301
,
' I N T E G R A L S AT THE POINT')
00000302
1708 FORMAT(///,20X,'THE RESULTS FOR THE ENERGY BANDS OF
', 00000303
,
A8,' AT THE REGULAR MESH OF POINTS',/,20X,74('*'))
00000304
1788 FORMAT(/,30X,'INDEPENDENT OVERLAP MATRIX ELEMENTS OF
', 00000305
,
A8,//,4X,'NO',5X,'SOV',5(11X,'NO',5X,'SOV'),/)
00000306
1628 FORMAT(/,20X,'REGULAR MESH POINT NUMBER ',I4,6X,'PKX=',
00000307
,
F9.5,' PKY=',F9.5,' PKZ=',F9.5,/,20X,75('.'))
00000308
1638 FORMAT(/,30X,'EIGENVALUES OF THE ENERGY AT',
00000309
,
' THE POINT',//,(9(' ',I2,')',F9.5)))
00000310
1658 FORMAT(5X,12F10.5)
00000311
1668 FORMAT(2X,12F10.5)
00000312
1748 FORMAT((1H ,I5,1X,F12.8,5(3X,I5,1X,F12.8)))
00000313
1648 FORMAT(' ',I2,')',12F10.5)
00000314
1678 FORMAT(/,30X,'BAND STRUCTURE EIGENVECTORS AT THE POINT',/)
00000315
1758 FORMAT(//,20X,'THE RESULTS FOR THE INDEPENDENT MATRIX',
00000316
,
' ELEMENTS OF THE HAMILTONIAN OF ',A8,/,20X,78('-'))
00000317
END
00000318
BLOCK DATA
00000319
C ********************************************************************
00000320
C *
* 00000321
C * SET INITIAL VALUES TO THE ELEMENTS
OF COMMON-BLOCKS
* 00000322
C * /KPOIN/,
/DIRSP/, /RECSP/
TO ZERO
* 00000323
C *
* 00000324
C ********************************************************************
00000325
C
00000326
IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4
(I-N)
00000327
COMMON/KPOIN/NIX,NIY,NIZ,JFI,DKX,DKY,DKZ,DKH,KXK(550),
00000328
,
KYK(550),KZK(550),MPT(17,17,17),JHI,
00000329
,
PKX(550),PKY(550),PKZ(550)
00000330
DATA NIX,NIY,NIZ,JFI/4*0/,DKX,DKY,DKZ,DKH/4*0.D
0/,
00000331
, KXK/550*0/,KYK/550*0/,KZK/550*0/,MPT/4913*0/,JHI/0/,
00000332
, PKX/550*0.D
0/,PKY/550*0.D 0/,PKZ/550*0.D 0/
00000333
COMMON/DIRSP/NSR,NRV,MRS(30),BRX(3),BRY(3),BRZ(3),DRX,DRY,
00000334
,
DRZ,DRH,TBX(3),TBY(3),TBZ(3),ARX(600),ARY(600),
00000335
,
ARZ(600),DRR(600),KRX(600),KRY(600),KRZ(600)
00000336
DATA NSR,NRV/2*0/,MRS/30*0/,BRX,BRY,BRZ/9*0.D
0/,
00000337
, DRX,DRY,DRZ,DRH/4*0.D
0/,TBX,TBY,TBZ/9*0.D 0/,
00000338
, ARX/600*0.D
0/,ARY/600*0.D 0/,ARZ/600*0.D 0/,
00000339
, DRR/600*0.D
0/,KRX/600*0/,KRY/600*0/,KRZ/600*0/
00000340
COMMON/RECSP/NSK,NKV,MKS(20),BKX(3),BKY(3),BKZ(3),
00000341
,
AKX(300),AKY(300),AKZ(300),DKK(300),
00000342
,
KGX(300),KGY(300),KGZ(300)
00000343
DATA NSK,NKV/2*0/,MKS/20*0/,BKX,BKY,BKZ/9*0.D
0/,
00000344
, AKX/300*0.D
0/,AKY/300*0.D 0/,AKZ/300*0.D 0/,
00000345
, DKK/300*0.D
0/,KGX/300*0/,KGY/300*0/,KGZ/300*0/
00000346
END
00000347