      PROGRAM FOUR2D
      IMPLICIT NONE

! TWO-DIMENSIONAL FOURIER PROGRAM, WRITTEN IN FORTRAN 90
! INPUT DATA ARE h, k,/Fo,/ s (s = SIGN TO BE ATTACHED TO Fo)
! LIMITS OF h AND k ARE EACH SET AT 20
! LIMITS OF X AND Y ARE EACH SET AT 40
! THE LIMITS CAN BE CHANGED IF DESIRED

      REAL :: ARG0,ARG,PI2,FO,SN,RHOMAX
      REAL :: F(0:20,0:20),G(0:20,0:20)        
      REAL :: SUMY(0:20,0:40),COZ(0:20,0:40),ZIN(0:20,0:40)
      REAL :: ZOC(0:40,0:20),NIZ(0:40,0:20)
      REAL :: SUME(0:40,0:40),SUMO(0:40,0:40)
      INTEGER :: H,I,J,K,NDAT,HMAX,KMAX

! OPEN FILES FOR INPUT (7) AND OUTPUT(8)
      OPEN(7,FILE='TWODAT.TXT')
      OPEN(8,FILE='RHO(XY).TXT')

! SET PARAMETERS; NOTE THAT THE SUBDIVISIONS ALONG x AND y ARE SET HERE AS 40 EACH
      PI2=6.283185307
      ARG0=PI2/40

! INTRODUCTION WRITTEN TO SCREEN
      WRITE(*,1)
1     FORMAT(//////1X,'TWO-DIMENSIONAL FOURIER SUMMATION PROGRAM FOR'// &
      1X,'CENTROSYMMETRIC PROJECTIONS: CURRENTLY SET FOR p2gg.'/// & 
      1X,'INPUT CONSISTS OF LINES OF h k /Fo/ sign(/Fo/) IN A FILE NAMED & 
     &TWODAT.TXT.'// & 
      1X,'THE MAXIMUM VALUES OF h AND k ARE EACH 20 AND a AND b ARE DIVI&
     &DED INTO 40ths.'// &
      1X,'THE FOURIER MAP WILL BE STORED IN THE FILE RHO(XY).TXT'// &
      1X,'THE PORTIONS OF THE MAP CAN BE JOINED ALONG THE LINE Y = 20.' &
     &/// & 
      1X,'ARE YOU READY TO GO?  IF SO, PRESS THE ENTER KEY.'/)
      PAUSE

! CLEAR ARRAYS FOR /Fo/ h+k EVEN (F) AND h+k ODD (G)
      F=0.0
      G=0.0

! SET COUNTER AND MAXIMUM h AND k RECORDERS
      NDAT=0
      HMAX=0
      KMAX=0

! READ DATA AND SET UP F AND G ARRAYS.  NOTE THAT F AND G ARE PLANE-GROUP
! DEPENDENT; REFER TO THE SECTION ON FOUR2D IN CHAPTER 11 OF THE TEXT
      DO I=0,400
            READ(7,*,END=2)H,K,FO,SN
            IF(H==0 .OR. K==0)FO=0.5*FO
	    IF(H>HMAX)HMAX=H
	    IF(K>KMAX)KMAX=K
	    NDAT=NDAT+1
	    IF(MOD((H+K),2)==0)THEN
	          F(H,K)=FO*SN
	          ELSE
	          G(H,K)=FO*SN
	          ENDIF
            END DO    

! SET UP THE ARRAYS OF COS(2PI x INDEX x INTERVAL)
2     DO I=0,20
	    ARG=ARG0*I
	    DO J=0,40
	          COZ(I,J)=COS(ARG*J)
	          ZIN(I,J)=SIN(ARG*J)
                  END DO
            END DO 

! MATRIX MULTIPLICATION AND TRANSPOSITION
! SUMY (20,40) = F (20,20) x COZ(20,40) 
! ZOC  (40,20) = COZ (20,40)T
! SUME (40,40) = ZOC (40,20) x SUMY (20,40) 

      SUMY=MATMUL(F,COZ)
      ZOC=TRANSPOSE(COZ)
      SUME=MATMUL(ZOC,SUMY)

! SIMILARLY FOR THE FOLLOWING THREE COMMANDS
      SUMY=MATMUL(G,ZIN)
      NIZ=TRANSPOSE(ZIN)
      SUMO=MATMUL(NIZ,SUMY)
      
! MATRIX SUBTRACTION, AND FIND MAXIMUM OF RESULTING SUME TO NORMALIZE
! SUME TO A MAXIMUM OF 100
      SUME=SUME-SUMO
      RHOMAX=100.0/MAXVAL(SUME)

! PRINT RHO(X,Y) FROM ARRAY SUME      
      CALL PRINTR(SUME,40,40,RHOMAX)          
      WRITE(*,3)
3     FORMAT(1X,'CALCULATION ENDED. RESULTS IN FILE RHO(XY).TXT'/)
      STOP

! *************
      CONTAINS   
! *************            

      SUBROUTINE PRINTR(PSTOR,NTRIG,NTROG,RHOMAX)
      IMPLICIT NONE

! PRINT FOURIER MAP
! PSTOR IS THE FINAL ARRAY SUME
! NTRIG AND NTROG ARE THE LIMITS OF SUBDIVISION ALONG X AND Y RESPECTIVELY
! RHOMAX IS THE MAXIMUM RHO(X,Y); FIELD FIGURES ARE NORMALIZED TO THIS VALUE

      REAL PSTOR(0:40,0:40),RHOMAX
      INTEGER NTRIG,NTROG,NPAGE,NSTART,NEND,J,K,I

! DETERMINE NUMBER OF PAGES OF OUTPUT
      NPAGE=NTROG/20
      IF(NTROG-(20*NPAGE)>0)NPAGE=NPAGE+1

! SET HORIZONTAL LIMITS FOR LINES ALONG Y, AND SET LOOP FOR PAGES
      DO I=1,NPAGE           
         NSTART=(I-1)*20
	    IF(I==NPAGE)THEN
               NEND=NTROG
               ELSE
               NEND=NSTART+20
               ENDIF
	          
! PRINT HEADING AND Y-AXIS INTERVALS
        !         PRINTWRITE(8,'(1X,'2-D FOURIER IN 40ths: X VERTICAL, Y HORIZONTAL')')
    
         WRITE(8,'(/6X,21I3)')(J,J=NSTART,NEND)

! PRINT BLANK LINE
         WRITE(8,'(1X)')

! PRINT LINES OF NTRIG (X-COORDINATE VERTICAL)
         DO J=0,NTRIG
	    
! PRINT OVER NTROG (Y-COORDINATE HORIZONTAL)
            WRITE(8,'(1X,I2,3X,21I3)')J,(NINT(PSTOR(J,K)*RHOMAX),K=NSTART,NEND)
            END DO

! PRINT 15 BLANK LINES, THE OBJECT BEING TO GET SUCCESSIVE PAGES OF OUTPUT
! ON TO SEPARATE PAGES WHEN THE OUTPUT IS OPENED IN WINWORD
         WRITE(8,'(///////////////)')
         END DO                         
      END SUBROUTINE PRINTR

! ***********************
      END PROGRAM FOUR2D
! ************************      
