Add original testcase from issue 602

This commit is contained in:
Martin Kroeker 2020-11-17 14:42:15 +01:00 committed by GitHub
parent eead529d38
commit c1f52d3589
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 22 additions and 0 deletions

View File

@ -1 +1,23 @@
SUBROUTINE tester(i)
REAL_8, DIMENSION(:), ALLOCATABLE :: A,B,C
REAL_8 :: rnd(3)
INTEGER :: i
INTEGER :: M,N,K
! test random sizes
CALL RANDOM_NUMBER(rnd)
M=rnd(1)_37+1 ; N=rnd(2)_37+1 ; K=rnd(3)_37+1
ALLOCATE(C(M_N),A(M_K),B(K_N))
A=0 ; B=0 ; C=0
CALL DGEMM("N","N",M,N,K,1.0D0,A,M,B,K,0.0D0,C,M)
CALL DGEMM("T","N",M,N,K,1.0D0,A,K,B,K,0.0D0,C,M)
CALL DGEMM("N","T",M,N,K,1.0D0,A,M,B,N,0.0D0,C,M)
CALL DGEMM("T","T",M,N,K,1.0D0,A,K,B,N,0.0D0,C,M)
END SUBROUTINE tester
PROGRAM TEST_THREAD_SAFE
!$OMP PARALLEL DO
DO i=1,30
CALL tester(i)
ENDDO
END PROGRAM