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 2075699 : 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 2075667 : 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 2075635 : 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 2075699 : 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 2075699 : 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 2075667 : 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 : !----------------------------------------------------------------------
|
