f90: Calculate Kronecker product of two matrices. *.exe and *.out are the Windows and Linux executables.

kronecker.exe

kronecker.f90

PROGRAM kronecker

IMPLICIT NONE

! Declarations

INTEGER:: i, j, k, l, m, n, o, p, q, r, err10, err11
REAL,DIMENSION(:,:),ALLOCATABLE:: a, b, c
 CHARACTER(20):: infile1, infile2, outfile, exiit

! Opening prints

PRINT*,
PRINT*,
PRINT*, 'This program is written by Mohammad A. Nilforooshan.'
PRINT*, 'All rights reserved.'
PRINT*, 'http://sites.google.com/site/mannprofile/'

! Ask for the input files, open and check them

PRINT*,
PRINT*,
PRINT*, 'Type the name of the input file for the 1st matrix.'
READ*, infile1
OPEN(UNIT=10, FILE=infile1, STATUS='OLD', IOSTAT=err10)

IF (err10/=0) THEN
    PRINT*,
    PRINT*,
    PRINT*, 'Error reading the input file'
    STOP
END IF

PRINT*,
PRINT*,
PRINT*, 'Insert the number of rows.'
READ*, m
PRINT*, 'Insert the number of columns.'
READ*, n

IF (n>50) THEN
    PRINT*,
    PRINT*,
    PRINT*, 'Sorry, up to 50 columns can be written in the output file!'
    PRINT*, 'Contact programmer to get space for more columns.'
    STOP
END IF

PRINT*,
PRINT*,
PRINT*, 'Type the name of the input file for the 2nd matrix.'
READ*, infile2
OPEN(UNIT=11, FILE=infile2, STATUS='OLD', IOSTAT=err11)

IF (err11/=0) THEN
    PRINT*,
    PRINT*,
    PRINT*, 'Error reading the input file'
    STOP
END IF

PRINT*,
PRINT*,
PRINT*, 'Insert the number of rows.'
READ*, o
PRINT*, 'Insert the number of columns.'
READ*, p

IF (p>50) THEN
    PRINT*,
    PRINT*,
    PRINT*, 'Sorry, up to 50 columns can be written in the output file!'
    PRINT*, 'Contact programmer to get space for more columns.'
    STOP
END IF

IF (n*p>50) THEN
    PRINT*,
    PRINT*,
    PRINT*, 'Sorry, up to 50 columns can be written in the output file!'
    PRINT*, 'Contact programmer to get space for more columns.'
    STOP
END IF

! Read the first matrix

ALLOCATE(a(m,n))
READ(10,*) ((a(i,j),j=1,n),i=1,m)

! Read the second matrix

ALLOCATE(b(o,p))
READ(11,*) ((b(k,l),l=1,p),k=1,o)

! Generate the third matrix

ALLOCATE(c((m*o),(n*p)))

l=1
q=0

DO i=1,m
    DO k=1,o
        j=1
        q=q+1
        DO r=1,n*p
            c(q,r)=a(i,j)*b(k,l)
            l=l+1
            IF (l>p) THEN
                l=1
                j=j+1
            END IF
        END DO
    END DO
END DO

! Ask for the name of the output file

PRINT*,
PRINT*,
PRINT*, 'Type the name of the output file.'
READ*, outfile

! Write in the output file

OPEN(UNIT=13, FILE=outfile, STATUS='UNKNOWN')
DO q=1,m*o
    WRITE(13,'(50F10.3)') (c(q,r), r=1,n*p)
END DO

! Finished

PRINT*,
PRINT*,
PRINT*, 'Press any key to exit.'
READ*, exiit

IF (exiit=='a') THEN
GO TO 142
END IF

142 END PROGRAM kronecker

kronecker.out