module matrixxx
 implicit none
interface matrix
 module procedure matrixa
 module procedure matrixb
end interface matrix
interface printmatrix
 module procedure printmatrixa
 module procedure printmatrixb
 module procedure printmatrixc
end interface printmatrix
contains
 subroutine matrixa(A,B,C,M,K,N)
  integer :: i,j,l,M,K,N
  integer :: A(M,K)
  integer :: B(K,N)
  integer :: C(M,N)
   do i=1,M
    do j=1,N
     do l=1,K
     C(i,j)=C(i,j)+A(I,l)*B(l,J)
     end do
    end do
   end do 
 end subroutine matrixa
 subroutine matrixb(A,B,C,M,K,N)
  integer :: i,j,l,M,K,N
  real :: A(M,K)
  real :: B(K,N)
  real :: C(M,N)
   do i=1,M
    do j=1,N
     do l=1,K
     C(i,j)=C(i,j)+A(I,l)*B(l,J)
     end do
    end do
   end do 
 end subroutine matrixb 
 subroutine matrixc(A,B,C,M,K,N)
  integer :: i,j,l,M,K,N
  real :: A(M,K)
  integer :: B(K,N)
  real :: C(M,N)
   do i=1,M
    do j=1,N
     do l=1,K
     C(i,j)=C(i,j)+A(I,l)*B(l,J)
     end do
    end do
   end do 
 end subroutine matrixc 
 subroutine printmatrixa(A,B,C,M,K,N)
  character :: for*20
  integer :: M,K,N,i,j
  integer :: A(M,K)
  integer :: B(K,N)
  integer :: C(M,N)
  for='(??(1X,I2))'
  write(*,*) 'A='
  write(for(2:3),'(I2)') K
   do i=1,M
   write(*,FMT=for) (A(i,j),j=1,k)
   end do
  write(*,*) 'B='
  write(for(2:3),'(I2)') N
   do i=1,K
   write(*,FMT=for) (B(i,j),j=1,N)
   end do
  write(*,*) 'C='
  write(for(2:3),'(I2)') N
   do i=1,M
   write(*,FMT=for) (C(i,j),j=1,N)
   end do
 end subroutine printmatrixa
 subroutine printmatrixb(A,B,C,M,K,N)
  character :: for*20
  integer :: M,K,N,i,j
  real :: A(M,K)
  real :: B(K,N)
  real :: C(M,N)
  for='(??(1X,I2))'
  write(*,*) 'A='
  write(for(2:3),'(I2)') K
   do i=1,M
   write(*,FMT=for) (A(i,j),j=1,k)
   end do
  write(*,*) 'B='
  write(for(2:3),'(I2)') N
   do i=1,K
   write(*,FMT=for) (B(i,j),j=1,N)
   end do
  write(*,*) 'C='
  write(for(2:3),'(I2)') N
   do i=1,M
   write(*,FMT=for) (C(i,j),j=1,N)
   end do
 end subroutine printmatrixb
 subroutine printmatrixc(A,B,C,M,K,N)
  character :: for*20
  integer :: M,K,N,i,j
  integer :: A(M,K)
  real :: B(K,N)
  real :: C(M,N)
  for='(??(1X,I2))'
  write(*,*) 'A='
  write(for(2:3),'(I2)') K
   do i=1,M
   write(*,FMT=for) (A(i,j),j=1,k)
   end do
  write(*,*) 'B='
  write(for(2:3),'(I2)') N
   do i=1,K
   write(*,FMT=for) (B(i,j),j=1,N)
   end do
  write(*,*) 'C='
  write(for(2:3),'(I2)') N
   do i=1,M
   write(*,FMT=for) (C(i,j),j=1,N)
   end do
 end subroutine printmatrixc

end module


program main
use matrixxx
implicit none
integer,parameter :: M=2,N=2,K=3
integer :: A(M,K)
integer :: B(K,N)
integer :: C(M,N)
print *, "********************"
print *, "       matrix *     "
print *, "********************"
 DATA A /1,2,3,4,5,6/
 DATA B /6,5,4,3,2,1/
call matrix(A,B,C,M,K,N)
call printmatrix(A,B,C,M,K,N)
end program
!BY MATRIX

posted on 2010-11-26 17:08  XuDong Lee  阅读(63)  评论(0)    收藏  举报