Branch data Line data Source code
1 : : !{\src2tex{textfont=tt}}
2 : : !!****f* m_abi_linalg/abi_xtrsm
3 : : !! NAME
4 : : !! abi_xtrsm
5 : : !!
6 : : !! FUNCTION
7 : : !! abi_xtrsm is the generic function that solve :
8 : : !! * op( A )*X = alpha*B, or X*op( A ) = alpha*B,
9 : : !! *
10 : : !! * where alpha is a scalar, X and B are m by n matrices, A is a unit, or
11 : : !! * non-unit, upper or lower triangular matrix and op( A ) is one of
12 : : !! *
13 : : !! * op( A ) = A or op( A ) = A**T.
14 : : !! *
15 : : !! * The matrix X is overwritten on B.
16 : : !!
17 : : !! COPYRIGHT
18 : : !! Copyright (C) 2001-2026 ABINIT group (LNguyen,FDahm (CS))
19 : : !! This file is distributed under the terms of the
20 : : !! GNU General Public License, see ~abinit/COPYING
21 : : !! or http://www.gnu.org/copyleft/gpl.txt .
22 : : !!
23 : : !! SOURCE
24 : :
25 : : !!***
26 : :
27 : : !!****f* m_abi_linalg/abi_ztrsm
28 : : !! NAME
29 : : !! abi_ztrsm
30 : : !!
31 : : !! FUNCTION
32 : : !!
33 : : !! INPUTS
34 : : !!
35 : : !! SOURCE
36 : :
37 : 2077283 : subroutine abi_ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb,gpu_option)
38 : :
39 : : !Arguments-------------------------------------
40 : : character(len=1), intent(in) :: side
41 : : character(len=1), intent(in) :: uplo
42 : : character(len=1), intent(in) :: transa
43 : : character(len=1), intent(in) :: diag
44 : : integer, intent(in) :: m,n,ldb,lda
45 : : complex(dp), intent(in) :: alpha
46 : : complex(dp),target,intent(in) :: a(lda,*)
47 : : complex(dp),target,intent(inout) :: b(ldb,*)
48 : : !Optionals -----------------------------------
49 : : integer, intent(in), optional :: gpu_option
50 : :
51 : : !Local variables-------------------------------
52 : : integer :: gpu_option_
53 : : #ifdef HAVE_LINALG_PLASMA
54 : : integer :: info
55 : : #endif
56 : :
57 : : #ifdef DEV_LINALG_TIMING
58 : : real(dp) :: tsec(2)
59 : : call timab(TIMAB_XTRSM,1,tsec)
60 : : #endif
61 : :
62 [ + + ]: 2077251 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
63 : :
64 : : #if defined(DEBUG_VERBOSE) && defined(HAVE_OPENMP_OFFLOAD)
65 : : if ( gpu_option_ == ABI_GPU_OPENMP ) then
66 : : ABI_CHECK(xomp_target_is_present(c_loc(a)), "Array isn't mapped on GPU")
67 : : ABI_CHECK(xomp_target_is_present(c_loc(b)), "Array isn't mapped on GPU")
68 : : end if
69 : : #endif
70 : :
71 [ - + ]: 2077219 : if(gpu_option_/=ABI_GPU_DISABLED) then
72 : : #ifdef HAVE_OPENMP_OFFLOAD
73 : : !$OMP TARGET DATA USE_DEVICE_ADDR(a,b) IF(gpu_option_==ABI_GPU_OPENMP)
74 : : #endif
75 : : call abi_gpu_xtrsm_cptr(2,side,uplo,transa,diag,m,n,alpha,&
76 [ # # ]: 0 : c_loc(a),lda,c_loc(b),ldb)
77 : : #ifdef HAVE_OPENMP_OFFLOAD
78 : : !$OMP END TARGET DATA
79 : : #endif
80 [ + - + - ]: 2077283 : else if (ABI_LINALG_PLASMA_ISON) then
81 : : #ifdef HAVE_LINALG_PLASMA
82 : : info = PLASMA_ztrsm_c(side_plasma(side),uplo_plasma(uplo),trans_plasma(transa),diag_plasma(diag),&
83 : : & m,n,alpha,c_loc(a),lda,c_loc(b),ldb)
84 : : #endif
85 : : else
86 : 2077283 : call ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
87 : : end if
88 : :
89 : : #ifdef DEV_LINALG_TIMING
90 : : call timab(TIMAB_XTRSM,2,tsec)
91 : : #endif
92 : :
93 : 2077251 : end subroutine abi_ztrsm
94 : : !!***
95 : :
96 : : !----------------------------------------------------------------------
97 : :
98 : : !!****f* m_abi_linalg/abi_dtrsm
99 : : !! NAME
100 : : !! abi_dtrsm
101 : : !!
102 : : !! FUNCTION
103 : : !!
104 : : !! INPUTS
105 : : !!
106 : : !! SOURCE
107 : :
108 : 254188 : subroutine abi_dtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb,&
109 : : & x_cplx,gpu_option)
110 : :
111 : : !Arguments-------------------------------------
112 : : character(len=1), intent(in) :: side,uplo,transa,diag
113 : : integer, intent(in) :: m,n,lda,ldb
114 : : real(dp), intent(in) :: alpha
115 : : real(dp),target, intent(in) :: a(lda,*) ! FIXME should be lda * x_cplx
116 : : real(dp),target, intent(inout) :: b(ldb,*)
117 : : !Optionals -----------------------------------
118 : : integer, intent(in), optional :: x_cplx
119 : : integer, intent(in), optional :: gpu_option
120 : :
121 : : !Local variables-------------------------------
122 : : integer :: cplx_, gpu_option_
123 : : #ifdef HAVE_LINALG_PLASMA
124 : : integer :: info
125 : : #endif
126 : :
127 : : #ifdef DEV_LINALG_TIMING
128 : : real(dp) :: tsec(2)
129 : : call timab(TIMAB_XTRSM,1,tsec)
130 : : #endif
131 : :
132 [ - + ]: 254188 : cplx_=1 ; if(PRESENT(x_cplx)) cplx_ = x_cplx
133 [ + - ]: 254188 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
134 : :
135 : : #if defined(DEBUG_VERBOSE) && defined(HAVE_OPENMP_OFFLOAD)
136 : : if ( gpu_option_ == ABI_GPU_OPENMP ) then
137 : : ABI_CHECK(xomp_target_is_present(c_loc(a)), "Array isn't mapped on GPU")
138 : : ABI_CHECK(xomp_target_is_present(c_loc(b)), "Array isn't mapped on GPU")
139 : : end if
140 : : #endif
141 : :
142 [ - + ]: 254188 : if(gpu_option_/=ABI_GPU_DISABLED) then
143 : : #ifdef HAVE_OPENMP_OFFLOAD
144 : : !$OMP TARGET DATA USE_DEVICE_ADDR(a,b) IF(gpu_option_==ABI_GPU_OPENMP)
145 : : #endif
146 : : call abi_gpu_xtrsm_cptr(cplx_,side,uplo,transa,diag,m,n,cmplx(alpha,0.d0,dp),&
147 [ # # ]: 0 : c_loc(a),lda,c_loc(b),ldb)
148 : : #ifdef HAVE_OPENMP_OFFLOAD
149 : : !$OMP END TARGET DATA
150 : : #endif
151 [ + - ]: 254188 : else if (ABI_LINALG_PLASMA_ISON) then
152 : : #ifdef HAVE_LINALG_PLASMA
153 : : if(cplx_ == 2) then
154 : : info = PLASMA_ztrsm_c(side_plasma(side),uplo_plasma(uplo),trans_plasma(TRANSA),diag_plasma(diag),&
155 : : & m,n,cmplx(alpha,0.d0,dp),c_loc(a),lda,c_loc(b),ldb)
156 : : else
157 : : info = PLASMA_dtrsm_c(side_plasma(side),uplo_plasma(uplo),trans_plasma(TRANSA),diag_plasma(diag),&
158 : : & m,n,alpha,c_loc(a),lda,c_loc(b),ldb)
159 : : end if
160 : : #endif
161 : : else
162 [ - + ]: 254188 : if(cplx_ == 2) then
163 : 0 : call ztrsm(side,uplo,transa,diag,m,n,cmplx(alpha,0.d0,dp),a,lda,b,ldb)
164 : : else
165 : 254188 : call dtrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
166 : : end if
167 : : end if
168 : :
169 : : #ifdef DEV_LINALG_TIMING
170 : : call timab(TIMAB_XTRSM,2,tsec)
171 : : #endif
172 : :
173 : 254188 : end subroutine abi_dtrsm
174 : : !!***
175 : :
176 : : !----------------------------------------------------------------------
177 : :
178 : : !!****f* m_abi_linalg/abi_d2ztrsm
179 : : !! NAME
180 : : !! abi_d2ztrsm
181 : : !!
182 : : !! FUNCTION
183 : : !!
184 : : !! INPUTS
185 : : !!
186 : : !! SOURCE
187 : :
188 : 184606 : subroutine abi_d2ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb,&
189 : : & x_cplx,gpu_option)
190 : :
191 : : !Arguments-------------------------------------
192 : : character(len=1), intent(in) :: side,uplo,transa,diag
193 : : integer, intent(in) :: m,n,lda,ldb
194 : : complex(dp), intent(in) :: alpha
195 : : real(dp),target, intent(in) :: a(lda,*) ! FIXME should be lda * x_cplx
196 : : real(dp),target, intent(inout) :: b(ldb,*)
197 : : !Optionals -----------------------------------
198 : : integer, intent(in), optional :: x_cplx
199 : : integer, intent(in), optional :: gpu_option
200 : :
201 : : !Local variables-------------------------------
202 : : integer :: cplx_, gpu_option_
203 : : #ifdef HAVE_LINALG_PLASMA
204 : : integer :: info
205 : : #endif
206 : :
207 : : #ifdef DEV_LINALG_TIMING
208 : : real(dp) :: tsec(2)
209 : : call timab(TIMAB_XTRSM,1,tsec)
210 : : #endif
211 : :
212 [ + - ]: 184606 : cplx_=1 ; if(PRESENT(x_cplx)) cplx_ = x_cplx
213 [ - + ]: 184606 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
214 : :
215 [ # # ]: 0 : if(gpu_option_/=ABI_GPU_DISABLED) then
216 : : #ifdef HAVE_OPENMP_OFFLOAD
217 : : !$OMP TARGET DATA USE_DEVICE_ADDR(a,b) IF(gpu_option_==ABI_GPU_OPENMP)
218 : : #endif
219 : : call abi_gpu_xtrsm_cptr(cplx_,side,uplo,transa,diag,m,n,alpha,&
220 [ # # ]: 0 : c_loc(a),lda,c_loc(b),ldb)
221 : : #ifdef HAVE_OPENMP_OFFLOAD
222 : : !$OMP END TARGET DATA
223 : : #endif
224 [ + - ]: 184606 : else if (ABI_LINALG_PLASMA_ISON) then
225 : : #ifdef HAVE_LINALG_PLASMA
226 : : if(cplx_ == 2) then
227 : : info = PLASMA_ztrsm_c(side_plasma(side),uplo_plasma(uplo),trans_plasma(TRANSA),diag_plasma(diag),&
228 : : & m,n,alpha,c_loc(a),lda,c_loc(b),ldb)
229 : : else
230 : : info = PLASMA_dtrsm_c(side_plasma(side),uplo_plasma(uplo),trans_plasma(TRANSA),diag_plasma(diag),&
231 : : & m,n,real(alpha,dp),c_loc(a),lda,c_loc(b),ldb)
232 : : end if
233 : : #endif
234 : : else
235 [ + + ]: 184606 : if(cplx_ == 2) then
236 : 172036 : call ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
237 : : else
238 : 12570 : call dtrsm(side,uplo,transa,diag,m,n,real(alpha,dp),a,lda,b,ldb)
239 : : end if
240 : : end if
241 : :
242 : : #ifdef DEV_LINALG_TIMING
243 : : call timab(TIMAB_XTRSM,2,tsec)
244 : : #endif
245 : :
246 : 184606 : end subroutine abi_d2ztrsm
247 : : !!***
248 : :
249 : : !----------------------------------------------------------------------
250 : :
251 : : !!****f* m_abi_linalg/abi_d2ztrsm_3d
252 : : !! NAME
253 : : !! abi_d2ztrsm_3d
254 : : !!
255 : : !! FUNCTION
256 : : !!
257 : : !! INPUTS
258 : : !!
259 : : !! SOURCE
260 : : !!
261 : :
262 : 0 : subroutine abi_d2ztrsm_3d(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb,gpu_option)
263 : :
264 : : !Arguments-------------------------------------
265 : : character(len=1), intent(in) :: side,uplo,transa,diag
266 : : integer, intent(in) :: m,n,lda,ldb
267 : : complex(dp), intent(in) :: alpha
268 : : real(dp), target,intent(in) :: a(2,lda,*)
269 : : real(dp), target,intent(inout) :: b(2,ldb,*)
270 : : !Optionals -----------------------------------
271 : : integer, intent(in), optional :: gpu_option
272 : :
273 : : !Local variables-------------------------------
274 : : integer :: gpu_option_
275 : : #ifdef HAVE_LINALG_PLASMA
276 : : integer :: info
277 : : #endif
278 : :
279 : : #ifdef DEV_LINALG_TIMING
280 : : real(dp) :: tsec(2)
281 : : call timab(TIMAB_XTRSM,1,tsec)
282 : : #endif
283 : :
284 [ # # ]: 0 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
285 : :
286 [ # # ]: 0 : if(gpu_option_/=ABI_GPU_DISABLED) then
287 : : #ifdef HAVE_OPENMP_OFFLOAD
288 : : !$OMP TARGET DATA USE_DEVICE_ADDR(a,b) IF(gpu_option_==ABI_GPU_OPENMP)
289 : : #endif
290 : : call abi_gpu_xtrsm_cptr(2,side,uplo,transa,diag,m,n,alpha,&
291 [ # # ]: 0 : c_loc(a),lda,c_loc(b),ldb)
292 : : #ifdef HAVE_OPENMP_OFFLOAD
293 : : !$OMP END TARGET DATA
294 : : #endif
295 [ # # ]: 0 : else if (ABI_LINALG_PLASMA_ISON) then
296 : : #ifdef HAVE_LINALG_PLASMA
297 : : info = PLASMA_ztrsm_c(side_plasma(side),uplo_plasma(uplo),trans_plasma(TRANSA),diag_plasma(diag),&
298 : : & m,n,alpha,c_loc(a),lda,c_loc(b),ldb)
299 : : #endif
300 : : else
301 : 0 : call ztrsm(side,uplo,transa,diag,m,n,alpha,a,lda,b,ldb)
302 : : end if
303 : :
304 : : #ifdef DEV_LINALG_TIMING
305 : : call timab(TIMAB_XTRSM,2,tsec)
306 : : #endif
307 : :
308 : 0 : end subroutine abi_d2ztrsm_3d
309 : : !!***
310 : :
311 : : !----------------------------------------------------------------------
|
