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 file contains procedure implementations of [pm_matrixTrans](@ref pm_matrixTrans).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \AmirShahmoradi, September 1, 2017, 12:00 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : !%%%%%%%%%%%%%%%%%%
28 : #if setMatTrans_ENABLED
29 : !%%%%%%%%%%%%%%%%%%
30 :
31 : ! Set transposition type.
32 : #if Herm_ENABLED
33 : #define OPERATION, operation
34 : #define GET_CONJG(X) conjg(X)
35 : #elif Symm_ENABLED
36 : #define OPERATION
37 : #define GET_CONJG(X) X
38 : #else
39 : #error "Unrecognized interface."
40 : #endif
41 : integer(IK) :: imid ! middle row/column of source.
42 : integer(IK) :: nrow, ncol ! number of row and column of source.
43 : #if Fix_ENABLED
44 : #define BSIZE_ARG
45 : integer(IK) , parameter :: BSIZE = 32_IK
46 : #elif Arb_ENABLED
47 : #define BSIZE_ARG , bsize
48 0 : CHECK_ASSERTION(__LINE__, 0_IK < bsize, SK_"@setMatTrans(): The condition `0 < bsize` must hold. bsize = "//getStr(bsize))
49 : #else
50 : #error "Unrecognized interface."
51 : #endif
52 : ! Set in-place transposition rule.
53 : #if Old_ENABLED
54 : #define destin source
55 1 : CHECK_ASSERTION(__LINE__, size(source, 1, IK) == size(source, 2, IK), \
56 : SK_"@setMatTrans(): The condition `size(source, 1) == size(source, 2)` must hold. shape(source) = "//getStr(shape(source, IK)))
57 : #elif New_ENABLED
58 9 : CHECK_ASSERTION(__LINE__, size(source, 1, IK) == size(destin, 2, IK) .and. size(source, 2, IK) == size(destin, 1, IK), \
59 : SK_"@setMatTrans(): The condition `size(source, 1) == size(destin, 2) .and. size(source, 2) == size(destin,1)` must hold. shape(source), shape(destin) = "//\
60 : getStr([shape(source, IK), shape(destin, IK)]))
61 : #else
62 : #error "Unrecognized interface."
63 : #endif
64 : nrow = size(source, 1, IK)
65 1 : ncol = size(source, 2, IK)
66 2 : if (nrow <= BSIZE .and. ncol <= BSIZE) then
67 278 : destin = transpose(GET_CONJG(source))
68 0 : elseif (nrow < ncol) then
69 0 : imid = ncol / 2_IK
70 0 : call setMatTrans(source(1 : nrow, 1 : imid), destin(1 : imid, 1 : nrow)OPERATION BSIZE_ARG)
71 0 : call setMatTrans(source(1 : nrow, imid + 1 : ncol), destin(imid + 1 : ncol, 1 : nrow)OPERATION BSIZE_ARG)
72 : else
73 0 : imid = nrow / 2_IK
74 0 : call setMatTrans(source(1 : imid, 1 : ncol), destin(1 : ncol, 1 : imid)OPERATION BSIZE_ARG)
75 0 : call setMatTrans(source(imid + 1 : nrow, 1 : ncol), destin(1 : ncol, imid + 1 : nrow)OPERATION BSIZE_ARG)
76 : end if
77 : #undef OPERATION
78 : #undef GET_CONJG
79 : #undef BSIZE_ARG
80 : #undef destin
81 :
82 : #else
83 : !%%%%%%%%%%%%%%%%%%%%%%%%
84 : #error "Unrecognized interface."
85 : !%%%%%%%%%%%%%%%%%%%%%%%%
86 : #endif
|