Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This include file contains the implementations of the tests of procedures of [test_pm_complexCompareLex](@ref test_pm_complexCompareLex).
19 : !>
20 : !> \author
21 : !> \AmirShahmoradi, Sunday 4:33 PM, September 19, 2021, Dallas, TX
22 :
23 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
24 :
25 : use pm_distUnif, only: setUnifRand
26 : use pm_kind, only: SK, IK, LK
27 : use pm_val2str, only: getStr
28 :
29 : #if islexless_CK_ENABLED
30 : #define COMPARES_WITH <
31 : character(*, SK), parameter :: PROCEDURE_NAME = "islexless()"
32 : #elif islexleq_CK_ENABLED
33 : #define COMPARES_WITH <=
34 : character(*, SK), parameter :: PROCEDURE_NAME = "islexleq()"
35 : #elif islexmeq_CK_ENABLED
36 : #define COMPARES_WITH >=
37 : character(*, SK), parameter :: PROCEDURE_NAME = "islexmeq()"
38 : #elif islexmore_CK_ENABLED
39 : #define COMPARES_WITH >
40 : character(*, SK), parameter :: PROCEDURE_NAME = "islexmore()"
41 : #else
42 : #error "Unrecognized interface."
43 : #endif
44 :
45 : integer(IK) , parameter :: NP = 5_IK
46 : integer(IK) :: i, j
47 : logical(LK) :: result(NP,NP), result_def(NP,NP)
48 : complex(CKC) :: mat1(NP,NP)
49 : complex(CKC) :: mat2(NP,NP)
50 :
51 16 : assertion = .true._LK
52 :
53 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
54 :
55 :
56 96 : do j = 1, NP
57 496 : do i = 1, NP
58 400 : call setUnifRand(mat1(i,j))
59 400 : call setUnifRand(mat2(i,j))
60 400 : result(i,j) = mat1(i,j) COMPARES_WITH mat2(i,j)
61 400 : result_def(i,j) = iscomparable(mat1(i,j), mat2(i,j))
62 480 : assertion = assertion .and. (result(i,j) .eqv. result_def(i,j))
63 : end do
64 : end do
65 16 : call report()
66 16 : call test%assert(assertion, PROCEDURE_NAME//SK_" must return correctly compare scalar complex values.")
67 :
68 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
69 :
70 96 : do j = 1, NP
71 480 : call setUnifRand(mat1(:,j))
72 480 : call setUnifRand(mat2(:,j))
73 880 : result(:,j) = mat1(:,j) COMPARES_WITH mat2(:,j)
74 480 : result_def(:,j) = iscomparable(mat1(:,j), mat2(:,j))
75 496 : assertion = assertion .and. all(result(:,j) .eqv. result_def(:,j))
76 : end do
77 16 : call report()
78 16 : call test%assert(assertion, PROCEDURE_NAME//SK_" must return correctly compare vector complex values.")
79 :
80 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
81 :
82 496 : call setUnifRand(mat1(:,:))
83 496 : call setUnifRand(mat2(:,:))
84 976 : result(:,:) = mat1(:,:) COMPARES_WITH mat2(:,:)
85 496 : result_def(:,:) = iscomparable(mat1(:,:), mat2(:,:))
86 496 : assertion = assertion .and. all(result(:,:) .eqv. result_def(:,:))
87 16 : call report()
88 16 : call test%assert(assertion, PROCEDURE_NAME//SK_" must return correctly compare matrix complex values.")
89 :
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 :
92 : contains
93 :
94 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
95 :
96 : pure elemental function iscomparable(val1, val2) result(comparable)
97 : complex(CKC), intent(in) :: val1, val2
98 : logical(LK) :: comparable
99 : #if islexless_CK_ENABLED
100 300 : comparable = (val1%re < val2%re) .or. (val1%re == val2%re .and. val1%re < val2%re)
101 : #elif islexleq_CK_ENABLED
102 300 : comparable = (val1%re < val2%re) .or. (val1%re == val2%re .and. val1%re <= val2%re)
103 : #elif islexmeq_CK_ENABLED
104 300 : comparable = (val1%re > val2%re) .or. (val1%re == val2%re .and. val1%re >= val2%re)
105 : #elif islexmore_CK_ENABLED
106 300 : comparable = (val1%re > val2%re) .or. (val1%re == val2%re .and. val1%re > val2%re)
107 : #else
108 : #error "Unrecognized interface."
109 : #endif
110 : end function
111 :
112 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
113 :
114 48 : subroutine report()
115 48 : if (test%traceable .and. .not. assertion) then
116 : ! LCOV_EXCL_START
117 : loopOverRows: do j = 1, NP
118 : do i = 1, NP
119 : if (result(i,j) .neqv. result_def(i,j)) then
120 : write(test%disp%unit,"(*(g0,:,', '))")
121 : write(test%disp%unit,"(*(g0,:,', '))") "mat1(i,j) ", mat1(i,j)
122 : write(test%disp%unit,"(*(g0,:,', '))") "mat2(i,j) ", mat2(i,j)
123 : write(test%disp%unit,"(*(g0,:,', '))")
124 : exit loopOverRows
125 : end if
126 : end do
127 : end do loopOverRows
128 : ! LCOV_EXCL_STOP
129 : end if
130 48 : end subroutine
131 :
132 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
133 :
134 : #undef COMPARES_WITH_DEF
135 : #undef COMPARES_WITH
|
