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