TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-07-18 08:53:47 +02:00
Code Issues Projects Releases Wiki Activity

Added checks for LDB and LDC in qmckl_distance. #15

Browse Source
This commit is contained in:
vijay gopal chilkuri 2021-05-26 14:08:09 +05:30
parent 43197f390a
commit 1208ddd73b
1 changed files with 56 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
org/qmckl_distance.org
View File

@ -520,6 +520,7 @@ integer function qmckl_distance_f(context, transa, transb, m, n, &
return
endif
! check for LDA
if (iand(transab,1) == 0 .and. LDA < 3) then
info = QMCKL_INVALID_ARG_7
return
@ -540,6 +541,33 @@ integer function qmckl_distance_f(context, transa, transb, m, n, &
return
endif
! check for LDB
if (iand(transab,1) == 0 .and. LDB < 3) then
info = QMCKL_INVALID_ARG_9
return
endif
if (iand(transab,1) == 1 .and. LDB < n) then
info = QMCKL_INVALID_ARG_9
return
endif
if (iand(transab,2) == 0 .and. LDB < 3) then
info = QMCKL_INVALID_ARG_9
return
endif
if (iand(transab,2) == 2 .and. LDB < n) then
info = QMCKL_INVALID_ARG_9
return
endif
! check for LDC
if (LDC < m) then
info = QMCKL_INVALID_ARG_11
return
endif
select case (transab)
@ -901,6 +929,7 @@ integer function qmckl_distance_rescaled_f(context, transa, transb, m, n, &
transab = -100
endif
! check for LDA
if (transab < 0) then
info = QMCKL_INVALID_ARG_1
return
@ -926,6 +955,33 @@ integer function qmckl_distance_rescaled_f(context, transa, transb, m, n, &
return
endif
! check for LDB
if (iand(transab,1) == 0 .and. LDB < 3) then
info = QMCKL_INVALID_ARG_9
return
endif
if (iand(transab,1) == 1 .and. LDB < n) then
info = QMCKL_INVALID_ARG_9
return
endif
if (iand(transab,2) == 0 .and. LDB < 3) then
info = QMCKL_INVALID_ARG_9
return
endif
if (iand(transab,2) == 2 .and. LDB < n) then
info = QMCKL_INVALID_ARG_9
return
endif
! check for LDC
if (LDC < m) then
info = QMCKL_INVALID_ARG_11
return
endif
select case (transab)