module precision_module implicit none integer, parameter :: sp = selected_real_kind(6, 37) integer, parameter :: dp = selected_real_kind(15, 307) integer, parameter :: qp = selected_real_kind(30, 291) end module precision_module module pdt_matrix_module use precision_module implicit none type pdt_matrix(k, row, col) integer, kind :: k integer, len :: row, col real (kind=k), dimension (row, col) :: m end type pdt_matrix interface scale_matrix module procedure scale_matrix_sp module procedure scale_matrix_dp end interface scale_matrix contains subroutine scale_matrix_sp(a, scale) type (pdt_matrix(sp,*,*)), intent (inout) :: a real (sp) :: scale a%m = a%m + scale end subroutine scale_matrix_sp subroutine scale_matrix_dp(a, scale) type (pdt_matrix(dp,*,*)), intent (inout) :: a real (dp) :: scale a%m = a%m + scale end subroutine scale_matrix_dp end module pdt_matrix_module program ch2703 use precision_module use pdt_matrix_module implicit none integer :: i real (sp) :: scs real (dp) :: scd integer, parameter :: nr = 2, nc = 3 type (pdt_matrix(sp,nr,nc)) :: as type (pdt_matrix(dp,nr,nc)) :: ad ! single precision do i = 1, nr print *, 'input row ', i, ' of sp matrix' read *, as%m(i, 1:nc) end do print *, 'input sp scaling factor' read *, scs call scale_matrix(as, scs) print *, 'updated matrix:' do i = 1, nr print 100, as%m(i, 1:nc) 100 format (10(f6.2,2x)) end do ! double precision do i = 1, nr print *, 'input row ', i, ' of dp matrix' read *, ad%m(i, 1:nc) end do print *, 'input dp scaling factor' read *, scd call scale_matrix(ad, scd) print *, 'updated matrix:' do i = 1, nr print 110, ad%m(i, 1:nc) 110 format (10(e12.5,2x)) end do end program ch2703