! { dg-do compile } | |
SUBROUTINE DGEMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, & | |
& BETA, Y, INCY ) | |
LOGICAL LSAME | |
IF ( .NOT.LSAME( TRANS, 'N' ).AND. & | |
& .NOT.LSAME( TRANS, 'C' ) )THEN | |
END IF | |
END | |
subroutine evlrnf (ptrs0t, nclsm, prnf0t) | |
real, dimension (1:nclsm,1:nclsm), intent (in) :: ptrs0t | |
real, dimension (1:nclsm,1:nclsm), intent (out):: prnf0t | |
real, allocatable, dimension (:,:) :: utrsft ! probas up | |
real, allocatable, dimension (:,:) :: dtrsft ! probas down | |
real, allocatable, dimension (:,:) :: xwrkt ! matrice | |
do icls = 1, nclsm | |
do ival = ipic - 1, 1, -1 | |
xwrkt = trs2a2 (ival, ipic, utrsft, dtrsft, ncls) | |
enddo | |
enddo | |
contains | |
function trs2a2 (j, k, u, d, m) | |
real, dimension (1:m,1:m) :: trs2a2 ! resultat | |
real, dimension (1:m,1:m) :: u, d ! matrices utrsft, dtrsft | |
end function trs2a2 | |
end | |
program rnflow | |
integer, parameter :: ncls = 256 ! nombre de classes | |
integer, dimension (1:ncls,1:ncls) :: mrnftt ! matrice theorique | |
real, dimension (1:ncls,1:ncls) :: ptrst ! matrice Markov | |
real, dimension (1:ncls,1:ncls) :: prnft ! matrice Rainflow | |
call evlrnf (ptrst, ncls, prnft) | |
mrnftt = nint (real (nsim) * real (npic) * prnft) | |
call cmpmat (mrnftt, mrnfst) | |
end program rnflow |