! --- subroutine LTxSxR(n, m, L, S, R, C) implicit none integer, intent(in) :: n, m double precision, intent(in) :: L(n,m), S(n,n), R(n,m) double precision, intent(out) :: C(m,m) integer :: i, j double precision :: accu_d, accu_nd double precision, allocatable :: tmp(:,:) ! L.T x S x R allocate(tmp(m,n)) call dgemm( 'T', 'N', m, n, n, 1.d0 & , L, size(L, 1), S, size(S, 1) & , 0.d0, tmp, size(tmp, 1) ) call dgemm( 'N', 'N', m, m, n, 1.d0 & , tmp, size(tmp, 1), R, size(R, 1) & , 0.d0, C, size(C, 1) ) deallocate(tmp) accu_d = 0.d0 accu_nd = 0.d0 do i = 1, m do j = 1, m if(j.eq.i) then accu_d += dabs(C(j,i)) else accu_nd += C(j,i) * C(j,i) endif enddo enddo accu_nd = dsqrt(accu_nd) print*, ' accu_d = ', accu_d print*, ' accu_nd = ', accu_nd end subroutine LTxR ! ---