C
PROGRAM SQUARE
IMPLICIT REAL*8(A-H, O-Z)
PARAMETER(NDIM =50)
PARAMETER(NDIM2 = NDIM*NDIM)
PARAMETER(PI =3.1415926D0)
PARAMETER(SML = 0.1D-5)
DIMENSION FF(0:NDIM, 0:NDIM)
DIMENSION XX(0:NDIM), YY(0:NDIM)
DIMENSION RX(0:NDIM2), RY(0:NDIM2)
DIMENSION PX(0:NDIM, 0:NDIM), PY(0:NDIM, 0:NDIM)
C
C ***** INPUT ATOM POSITION WITHIN A CELL *****
C
READ(5,*) NLAT, AA, NG
WRITE(6,2010) NLAT
2010 FORMAT('# LATTICE SIZE=',I4)
WRITE(6,2011) AA
2011 FORMAT('# LATTICE CONSTANT=',F7.4)
WRITE(6,2012) NG
2012 FORMAT('# CALCULATED K-RANGE =', I4, ' x G')
READ(5,*) NATOM
WRITE(6,2020) NATOM
2020 FORMAT('# NUMBER OF ATOMS PER CELL=',I4)
DO 10 I = 0, NATOM-1
READ(5,*) XX(I), YY(I)
WRITE(6,2030) XX(I), YY(I)
2030 FORMAT('# ',2F6.2)
10 CONTINUE
C
C ***** SET ATOM COORDINATES *****
C
J = 0
DO 20 IY = 0, NLAT-1
DO 20 IX = 0, NLAT-1
DO 20 IN = 0, NATOM - 1
J = J + 1
RX(J) = AA*(DFLOAT(IX) + XX(IN))
RY(J) = AA*(DFLOAT(IY) + YY(IN))
20 CONTINUE
JN = J
WRITE(6,2040) JN
2040 FORMAT('# JN=',I4)
C
C ***** SET K-SPACE MESH COORDINATES *****
C
GG = 2.D0*PI/AA
DP = 1.D0/DFLOAT(NLAT)
PMIN = -DFLOAT(NG)
NP = 2*NG*NLAT
DO 30 IY = 0, NP
DO 30 IX = 0, NP
PX(IX,IY) = PMIN + DP*DFLOAT(IX)
PY(IX,IY) = PMIN + DP*DFLOAT(IY)
30 CONTINUE
C
C ***** CALCULATE STRUCTURE FACTOR *****
C
DNN = 1.D0/DFLOAT(JN)
DO 40 JY = 0, NP
DO 40 JX = 0, NP
PPX = GG*PX(JX, JY)
PPY = GG*PY(JX, JY)
WRE = 0.D0
WIM = 0.D0
DO 50 J = 1, JN
RRX = RX(J)
RRY = RY(J)
WRE = WRE + DCOS(PPX*RRX+PPY*RRY)
WIM = WIM + DSIN(PPX*RRX+PPY*RRY)
50 CONTINUE
FF(JX, JY) = (WRE*WRE + WIM*WIM)*DNN
40 CONTINUE
C
C ***** OUTPUT RESULTS *****
C
DO 60 JY = 0, NP
DO 60 JX = 0, NP
WRITE(6,1010) PX(JX, JY), PY(JX, JY), FF(JX, JY)
60 CONTINUE
1010 FORMAT(3E15.6)
STOP
END
入力ファイル例:
12 2.D0 2
1
0.D0 0.D0