Line data Source code
1 : !{\src2tex{textfont=tt}}
2 : !!****f* m_abi_linalg/abi_xpotrf
3 : !! NAME
4 : !! abi_xpotrf
5 : !!
6 : !! FUNCTION
7 : !! abi_xpotrf is the generic function for computing the
8 : !! Cholesky factorization of a real symmetric (or hermitian)
9 : !! positive definite matrix A.
10 : !! The factorization has the form
11 : !! A = U**T * U, if UPLO = 'U', or
12 : !! A = L * L**T, if UPLO = 'L',
13 : !! where U is an upper triangular matrix and L is lower triangular.
14 : !!
15 : !! COPYRIGHT
16 : !! Copyright (C) 2001-2026 ABINIT group (LNguyen,FDahm (CS))
17 : !! This file is distributed under the terms of the
18 : !! GNU General Public License, see ~abinit/COPYING
19 : !! or http://www.gnu.org/copyleft/gpl.txt .
20 : !!
21 : !! SOURCE
22 :
23 : !!***
24 :
25 : !!****f* m_abi_linalg/abi_dpotrf
26 : !! NAME
27 : !! abi_dpotrf
28 : !!
29 : !! FUNCTION
30 : !!
31 : !! INPUTS
32 : !!
33 : !! SOURCE
34 :
35 0 : subroutine abi_dpotrf(uplo,n,a,lda,info,gpu_option)
36 :
37 : !Arguments ------------------------------------
38 : character(len=1), intent(in) :: uplo
39 : integer, intent(in) :: n,lda
40 : integer, intent(out) :: info
41 : real(dp), target, intent(inout) :: a(*)
42 : !Optionals -----------------------------------
43 : integer, intent(in), optional :: gpu_option
44 :
45 : !Local variables ------------------------------
46 : integer :: gpu_option_
47 :
48 : ! *********************************************************************
49 :
50 0 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
51 :
52 : #if defined(DEBUG_VERBOSE) && defined(HAVE_OPENMP_OFFLOAD)
53 : if ( gpu_option_ == ABI_GPU_OPENMP ) then
54 : ABI_CHECK(xomp_target_is_present(c_loc(a)), "Array isn't mapped on GPU")
55 : end if
56 : #endif
57 :
58 0 : if(gpu_option_/=ABI_GPU_DISABLED) then
59 : #ifdef HAVE_OPENMP_OFFLOAD
60 : !$OMP TARGET DATA USE_DEVICE_ADDR(a) IF(gpu_option_==ABI_GPU_OPENMP)
61 : #endif
62 0 : call abi_gpu_xpotrf_cptr(1, uplo, n, c_loc(a), lda, info)
63 : #ifdef HAVE_OPENMP_OFFLOAD
64 : !$OMP END TARGET DATA
65 : #endif
66 : else
67 : #ifdef HAVE_LINALG_PLASMA
68 : if (ABI_LINALG_PLASMA_ISON) then
69 : call PLASMA_dpotrf(uplo_plasma(uplo),n,a,lda,info)
70 : return
71 : end if
72 : #endif
73 0 : call dpotrf(uplo,n,a,lda,info)
74 : end if
75 :
76 0 : end subroutine abi_dpotrf
77 : !!***
78 :
79 : !!****f* m_abi_linalg/abi_zpotrf_2d
80 : !! NAME
81 : !! abi_zpotrf_2d
82 : !!
83 : !! FUNCTION
84 : !!
85 : !! INPUTS
86 : !!
87 : !! SOURCE
88 :
89 698794 : subroutine abi_zpotrf_2d(uplo,n,a,lda,info,gpu_option)
90 :
91 : !Arguments ------------------------------------
92 : character(len=1), intent(in) :: uplo
93 : integer, intent(in) :: lda,n
94 : integer, intent(out) :: info
95 : complex(dp), target, intent(inout) :: a(lda,*)
96 : !Optionals -----------------------------------
97 : integer, intent(in), optional :: gpu_option
98 :
99 : ! *********************************************************************
100 :
101 698794 : call abi_zpotrf(uplo,n,a(1,1),lda,info,gpu_option=gpu_option)
102 :
103 698762 : end subroutine abi_zpotrf_2d
104 : !!***
105 :
106 : !!****f* m_abi_linalg/abi_d2zpotrf_3d
107 : !! NAME
108 : !! abi_d2zpotrf
109 : !!
110 : !! FUNCTION
111 : !!
112 : !! INPUTS
113 : !!
114 : !! SOURCE
115 :
116 5578 : subroutine abi_d2zpotrf_3d(uplo,n,a,lda,info,x_cplx,gpu_option)
117 :
118 : !Arguments ------------------------------------
119 : character(len=1), intent(in) :: uplo
120 : integer, intent(in) :: n,lda
121 : integer, intent(out) :: info
122 : integer, intent(in), optional :: x_cplx
123 : integer, intent(in), optional :: gpu_option
124 : real(dp),target, intent(inout) :: a(:,:,:)
125 :
126 : !Local Variables -----------------------------
127 : integer :: cplx_, gpu_option_
128 :
129 : ! *********************************************************************
130 :
131 5578 : cplx_=1 ; if(PRESENT(x_cplx)) cplx_ = x_cplx
132 5578 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
133 :
134 5578 : call abi_d2zpotrf(uplo,n,a,lda,info,x_cplx=cplx_,gpu_option=gpu_option_)
135 :
136 5578 : end subroutine abi_d2zpotrf_3d
137 : !!***
138 :
139 : !!****f* m_abi_linalg/abi_d2zpotrf
140 : !! NAME
141 : !! abi_d2zpotrf
142 : !!
143 : !! FUNCTION
144 : !!
145 : !! INPUTS
146 : !!
147 : !! SOURCE
148 :
149 158468 : subroutine abi_d2zpotrf(uplo,n,a,lda,info,x_cplx,gpu_option)
150 :
151 : !Arguments ------------------------------------
152 : character(len=1), intent(in) :: uplo
153 : integer, intent(in) :: n,lda
154 : integer, intent(out) :: info
155 : integer, intent(in), optional :: x_cplx
156 : integer, intent(in), optional :: gpu_option
157 : real(dp),target, intent(inout) :: a(lda,*) ! FIXME should be x_cplx * lda
158 :
159 : !Local Variables -----------------------------
160 : integer :: cplx_, gpu_option_
161 :
162 : ! *********************************************************************
163 :
164 158468 : cplx_=1 ; if(PRESENT(x_cplx)) cplx_ = x_cplx
165 158468 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
166 :
167 : #if defined(DEBUG_VERBOSE) && defined(HAVE_OPENMP_OFFLOAD)
168 : if ( gpu_option_ == ABI_GPU_OPENMP ) then
169 : ABI_CHECK(xomp_target_is_present(c_loc(a)), "Array isn't mapped on GPU")
170 : end if
171 : #endif
172 :
173 100634 : if(gpu_option_/=ABI_GPU_DISABLED) then
174 : #ifdef HAVE_OPENMP_OFFLOAD
175 : !$OMP TARGET DATA USE_DEVICE_ADDR(a) IF(gpu_option_==ABI_GPU_OPENMP)
176 : #endif
177 0 : call abi_gpu_xpotrf_cptr(cplx_, uplo, n, c_loc(a), lda, info)
178 : #ifdef HAVE_OPENMP_OFFLOAD
179 : !$OMP END TARGET DATA
180 : #endif
181 : else
182 : #ifdef HAVE_LINALG_PLASMA
183 : if (ABI_LINALG_PLASMA_ISON) then
184 : if(cplx_ == 2) then
185 : info = PLASMA_zpotrf_c(uplo_plasma(uplo),n,c_loc(a),lda)
186 : else
187 : info = PLASMA_dpotrf_c(uplo_plasma(uplo),n,c_loc(a),lda)
188 : end if
189 : return
190 : end if
191 : #endif
192 158468 : if(cplx_ == 2) then
193 59788 : call zpotrf(uplo,n,a,lda,info)
194 : else
195 98680 : call dpotrf(uplo,n,a,lda,info)
196 : end if
197 : end if
198 :
199 158468 : end subroutine abi_d2zpotrf
200 : !!***
201 :
202 : !!****f* m_abi_linalg/abi_zpotrf
203 : !! NAME
204 : !! abi_zpotrf
205 : !!
206 : !! FUNCTION
207 : !!
208 : !! INPUTS
209 : !!
210 : !! SOURCE
211 :
212 698794 : subroutine abi_zpotrf(uplo,n,a,lda,info,gpu_option)
213 :
214 : !Arguments ------------------------------------
215 : character(len=1), intent(in) :: uplo
216 : integer, intent(in) :: lda,n
217 : integer, intent(out) :: info
218 : complex(dp), target, intent(inout) :: a(*)
219 : !Optionals -----------------------------------
220 : integer, intent(in), optional :: gpu_option
221 :
222 : !Local variables ------------------------------
223 : integer :: gpu_option_
224 :
225 : ! *********************************************************************
226 :
227 698794 : gpu_option_=ABI_GPU_DISABLED ; if(PRESENT(gpu_option)) gpu_option_ = gpu_option
228 :
229 : #if defined(DEBUG_VERBOSE) && defined(HAVE_OPENMP_OFFLOAD)
230 : if ( gpu_option_ == ABI_GPU_OPENMP ) then
231 : ABI_CHECK(xomp_target_is_present(c_loc(a)), "Array isn't mapped on GPU")
232 : end if
233 : #endif
234 :
235 698587 : if(gpu_option_/=ABI_GPU_DISABLED) then
236 : #ifdef HAVE_OPENMP_OFFLOAD
237 : !$OMP TARGET DATA USE_DEVICE_ADDR(a) IF(gpu_option_==ABI_GPU_OPENMP)
238 : #endif
239 0 : call abi_gpu_xpotrf_cptr(2, uplo, n, c_loc(a), lda, info)
240 : #ifdef HAVE_OPENMP_OFFLOAD
241 : !$OMP END TARGET DATA
242 : #endif
243 : else
244 : #ifdef HAVE_LINALG_PLASMA
245 : if (ABI_LINALG_PLASMA_ISON) then
246 : call PLASMA_zpotrf(uplo_plasma(uplo),n,a,lda,info)
247 : return
248 : end if
249 : #endif
250 698794 : call zpotrf(uplo,n,a,lda,info)
251 : end if
252 :
253 698794 : end subroutine abi_zpotrf
254 : !!***
|
