PROGRAM JACOBI IMPLICIT NONE INTEGER Dim,Iteration,RowPeek,ColPeek CHARACTER*100 buffer REAL*8, DIMENSION(:,:),ALLOCATABLE :: SurfaceMatrix REAL*8, DIMENSION(:,:),ALLOCATABLE :: SurfaceMatrix_t INTEGER i,j,ii REAL*8 Increment REAL*4 timestart,timeend IF(IARGC() < 4) THEN WRITE(6,*)"Too Few Input Parameters.. there should be four" CALL EXIT(2) ENDIF ! Get Command Line Arguments CALL GETARG(1,buffer) READ(buffer,*)Dim CALL GETARG(2,buffer) READ(buffer,*)Iteration CALL GETARG(3,buffer) READ(buffer,*)RowPeek CALL GETARG(4,buffer) READ(buffer,*)ColPeek IF((RowPeek > Dim ).or.(ColPeek > Dim)) THEN WRITE(6,*)"Cannot Peek a matrix element outside of the surface" WRITE(6,*)"Arguments 3 and 4 must be smaller than",Dim CALL EXIT(3) ENDIF !Initialize Matrix ALLOCATE(SurfaceMatrix(Dim+2,Dim+2)) ALLOCATE(SurfaceMatrix_t(Dim+2,Dim+2)) ! Fill Initial Values DO i=2,Dim+1 DO j=2,Dim+1 SurfaceMatrix(j,i)=0.5 ENDDO ENDDO ! Left Side Increment = 100.0 / (Dim + 1) DO i=2,Dim+2 SurfaceMatrix(1,i) = (i-1)*Increment SurfaceMatrix(Dim+3-i,Dim+2) = (i-1)*Increment SurfaceMatrix(Dim+2,i) = 0.0 SurfaceMatrix(Dim+3-i,1) = 0.0 ENDDO CALL walltime(timestart) DO ii = 1,Iteration ! Actually do the Calculations DO i = 2,Dim+1 DO j = 2,Dim+1 SurfaceMatrix_t(j,i) = 0.25*(SurfaceMatrix(j-1,i) + $ SurfaceMatrix(j,i+1) + $ SurfaceMatrix(j+1,i) + $ SurfaceMatrix(j,i-1)) ENDDO ! j ENDDO ! i ! Transfer back to the main matrix DO i=2,Dim+1 DO j=2,Dim+1 SurfaceMatrix(j,i) = SurfaceMatrix_t(j,i) ENDDO ! j ENDDO ! i ENDDO ! ii CALL WALLTIME(timeend) WRITE(6,'(A,F20.10)')'The Iteration Time is ', $ timeend(1)-timestart(1) WRITE(6,'(A,I5,A,I5,A,F20.10)')'The Matrix Element ',ColPeek,',', $ RowPeek," is ",SurfaceMatrix(ColPeek+1,RowPeek+1) END PROGRAM ! Simple function for printing the matrix SUBROUTINE PrintSurfaceMatrix(SM,D) IMPLICIT NONE INTEGER D,i,j REAL*8 SM(D+2,*) WRITE(6,*)' ' WRITE(6,'(A)',advance='no')' ' DO i=1,D+2 WRITE(6,'(I10)',advance='no'),i ENDDO WRITE(6,*)' ' DO i=1,D+2 WRITE(6,'(I10)',advance='no'),i DO j=1,D+2 WRITE(6,'(F10.5)',advance='no'),SM(j,i) ENDDO WRITE(6,*)' ' ENDDO RETURN END SUBROUTINE subroutine WallTime(t) implicit none real*8 t integer t0, tr, tm call system_clock(t0, tr, tm) t = dble(t0)/dble(tr) return end