Branch data Line data Source code
1 : : !!****m* ABINIT/m_opernlb_gemm
2 : : !! NAME
3 : : !! m_opernlb_gemm
4 : : !!
5 : : !! FUNCTION
6 : : !!
7 : : !! COPYRIGHT
8 : : !! Copyright (C) 2008-2026 ABINIT group (MT)
9 : : !! This file is distributed under the terms of the
10 : : !! GNU General Public License, see ~abinit/COPYING
11 : : !! or http://www.gnu.org/copyleft/gpl.txt .
12 : : !!
13 : : !! SOURCE
14 : :
15 : : #if defined HAVE_CONFIG_H
16 : : #include "config.h"
17 : : #endif
18 : :
19 : : #include "abi_common.h"
20 : :
21 : : module m_opernlb_gemm
22 : :
23 : : use defs_basis
24 : : use m_abicore
25 : : use m_errors
26 : : USE_MPI
27 : : use m_xmpi
28 : : use m_abi_linalg
29 : : use m_gputk
30 : : use m_gemm_nonlop_projectors
31 : :
32 : : use defs_abitypes, only : MPI_type
33 : : use m_time, only : timab
34 : :
35 : : use, intrinsic :: iso_c_binding, only : c_ptr,c_loc,c_size_t,c_f_pointer
36 : :
37 : : implicit none
38 : :
39 : : private
40 : : !!***
41 : :
42 : : public :: opernlb_gemm
43 : :
44 : : contains
45 : : !!***
46 : :
47 : :
48 : : !----------------------------------------------------------------------
49 : :
50 : : !!****f* m_opernlb_gemm/opernlb_gemm_distributed
51 : : !! NAME
52 : : !! opernlb_gemm_distributed
53 : : !!
54 : : !! FUNCTION
55 : : !! Distributed version of "opernlb" GEMM called in gemm_nonlop.
56 : : !!
57 : : !! INPUTS
58 : : !!
59 : : !! SOURCE
60 : 0 : subroutine opernlb_gemm_distributed(rank,nprocs,npw,ndat,&
61 : : & transa,transb,&
62 : : & nprojs,nprojs_blk,nprojs_last_blk,cplex,&
63 : 0 : & projs_local,projections,vectout,gpu_option)
64 : : integer, intent(in) :: rank,nprocs,npw,ndat,gpu_option
65 : : integer, intent(in) :: nprojs,nprojs_blk,nprojs_last_blk,cplex
66 : : character(len=1),intent(in) :: transa,transb
67 : : real(dp), intent(in), target :: projs_local(cplex,npw,nprojs_last_blk)
68 : : real(dp), intent(in), target :: projections(cplex,nprojs,ndat)
69 : : real(dp), intent(out), target :: vectout(cplex,npw,ndat)
70 : :
71 : : !Local variables
72 : : integer :: iblock,ibeg,req(2),ierr,nprojs_cur_blk,rank_prev,rank_next
73 : : complex(dp) :: beta
74 : 0 : real(dp), ABI_CONTIGUOUS pointer :: recv_buf(:,:,:), work_buf(:,:,:)
75 : 0 : real(dp), allocatable, target :: projs_recv(:,:,:)
76 : 0 : real(dp), ABI_CONTIGUOUS pointer :: projections_1d(:)
77 : : type(c_ptr) :: projections_cptr
78 : : ! *************************************************************************
79 : :
80 [ # # # # : 0 : ABI_MALLOC(projs_recv, (cplex, npw, nprojs_last_blk))
# # # # #
# # # # #
# # # # ]
81 : : #ifdef HAVE_OPENMP_OFFLOAD
82 : : !$OMP TARGET ENTER DATA MAP(alloc:projs_recv) IF(gpu_option==ABI_GPU_OPENMP)
83 : : #endif
84 : :
85 : 0 : rank_next=modulo(rank + 1,nprocs)
86 : 0 : rank_prev=rank - 1
87 [ # # ]: 0 : if(rank_prev == -1) rank_prev = nprocs - 1
88 : :
89 : 0 : beta = czero
90 : :
91 [ # # ]: 0 : do iblock=1,nprocs
92 : :
93 [ # # ]: 0 : if(rank+iblock == nprocs) then
94 : 0 : nprojs_cur_blk = nprojs_last_blk
95 : : else
96 : 0 : nprojs_cur_blk = nprojs_blk
97 : : end if
98 : :
99 [ # # ]: 0 : if(modulo(iblock,2)==1) then
100 : : ! XG20241028 : This coding confused the gnu_8.5 compiler of buda2_gnu_8.5_cuda, wrt the contiguous character of the target.
101 : : ! It declared an error. Make it simple !
102 : : ! work_buf => projs_local(1:cplex,1:npw,1:nprojs_last_blk)
103 : : ! recv_buf => projs_recv(1:cplex,1:npw,1:nprojs_last_blk)
104 : 0 : work_buf => projs_local
105 : 0 : recv_buf => projs_recv
106 : : else
107 : : ! XG20241028 : Same as above
108 : : ! work_buf => projs_recv(1:cplex,1:npw,1:nprojs_last_blk)
109 : : ! recv_buf => projs_local(1:cplex,1:npw,1:nprojs_last_blk)
110 : 0 : work_buf => projs_recv
111 : 0 : recv_buf => projs_local
112 : : end if
113 : :
114 : : #if defined HAVE_OPENMP_OFFLOAD && ! defined HAVE_GPU_MPI
115 : : ! GPU-aware MPI not available : perform MPI comms on CPU
116 : : !$OMP TARGET UPDATE FROM(work_buf) if(iblock==1 .and. gpu_option==ABI_GPU_OPENMP)
117 : : #endif
118 : : call xmpi_isend(work_buf,rank_prev,iblock,gemm_nonlop_block_comm,req(1),ierr,&
119 : 0 : & gpu_option==ABI_GPU_OPENMP)
120 : : call xmpi_irecv(recv_buf,rank_next,iblock,gemm_nonlop_block_comm,req(2),ierr,&
121 : 0 : & gpu_option==ABI_GPU_OPENMP)
122 : :
123 : 0 : ibeg = 1 + modulo(rank+iblock-1,nprocs)*nprojs_blk
124 : :
125 : : ! Small trickery here:
126 : : ! The multiplication is performed over a slice of projectors in 'work_buf' matrix.
127 : : ! In that case, 'projections' matrix is still sized by all projectors but only
128 : : ! a slice of the projectors present in work_buf is used.
129 : : !
130 : : ! Therefore, we need to provide GEMM with the start of the slice
131 : : ! with 'projections' rather than the start of 'projections' as usual.
132 : : !
133 : : ! For that reason, we turn 'projections' matrix into single-rank in order
134 : : ! to pass the right starting row.
135 : 0 : projections_cptr = c_loc(projections)
136 [ # # ]: 0 : call c_f_pointer(projections_cptr, projections_1d, [cplex * nprojs * ndat])
137 : :
138 : : call abi_xgemm(transa,transb,&
139 : : & npw, ndat, nprojs_cur_blk, cone, &
140 : : & work_buf, npw,&
141 : : & projections_1d(cplex*ibeg-(cplex-1):cplex*nprojs*ndat),nprojs,&
142 : : & beta, &
143 : : & vectout, npw, &
144 : 0 : & x_cplx=cplex,gpu_option=gpu_option)
145 : :
146 : 0 : beta = cone
147 : :
148 : 0 : call xmpi_wait(req(1),ierr)
149 : 0 : call xmpi_wait(req(2),ierr)
150 : : !call xmpi_waitall(req,ierr)
151 : :
152 : : #ifdef HAVE_OPENMP_OFFLOAD
153 : : #ifndef HAVE_GPU_MPI
154 : : ! If MPI is not GPU-aware, push received data to GPU
155 : : !$OMP TARGET UPDATE TO(recv_buf) IF(gpu_option==ABI_GPU_OPENMP)
156 : : #endif
157 : : #endif
158 : :
159 : : end do
160 : :
161 [ # # ]: 0 : if(modulo(iblock,2)==1) then
162 [ # # ]: 0 : if(gpu_option == ABI_GPU_DISABLED) then
163 : 0 : call DCOPY(cplex*npw*nprojs_cur_blk, recv_buf, 1, work_buf, 1)
164 : : else if(gpu_option == ABI_GPU_OPENMP) then
165 : : #ifdef HAVE_OPENMP_OFFLOAD
166 : : !$OMP TARGET DATA USE_DEVICE_ADDR(work_buf,recv_buf)
167 : : call copy_gpu_to_gpu(c_loc(work_buf), c_loc(recv_buf), INT(cplex, c_size_t)*npw*nprojs_last_blk*dp)
168 : : !$OMP END TARGET DATA
169 : : #endif
170 : : end if
171 : : end if
172 : :
173 : : #ifdef HAVE_OPENMP_OFFLOAD
174 : : !$OMP TARGET EXIT DATA MAP(delete:projs_recv) IF(gpu_option==ABI_GPU_OPENMP)
175 : : #endif
176 [ # # ]: 0 : ABI_FREE(projs_recv)
177 : :
178 [ # # ]: 0 : end subroutine opernlb_gemm_distributed
179 : : !!***
180 : :
181 : : !----------------------------------------------------------------------
182 : :
183 : 25082 : subroutine opernlb_xgemm(cplex,transa,transb,npw,ndat,nprojs,alpha,a,lda,b,ldb,beta,c,ldc,&
184 : : & rank, nprocs,&
185 : : & nprojs_blk, nprojs_last_blk,&
186 : : & iblock,&
187 : : & gpu_option,use_distrib,use_sliced_gemms)
188 : :
189 : : !Arguments ------------------------------------
190 : : integer,intent(in) :: cplex,lda,ldb,ldc,npw,ndat,nprojs,gpu_option
191 : : integer,intent(in) :: rank,nprocs,nprojs_blk,nprojs_last_blk
192 : : integer,intent(in) :: iblock
193 : : logical,intent(in) :: use_distrib,use_sliced_gemms
194 : : complex(dp),intent(in) :: alpha,beta
195 : : character(len=1),intent(in) :: transa,transb
196 : : real(dp),target,intent(in) :: a(cplex,lda,nprojs), b(cplex,ldb,ndat)
197 : : real(dp),target,intent(inout) :: c(cplex,ldc,ndat)
198 : :
199 : : integer :: ibeg
200 : 25082 : real(dp), ABI_CONTIGUOUS pointer :: b_1d(:)
201 : : type(c_ptr) :: b_cptr
202 : : ! *********************************************************************
203 : :
204 : : #ifdef FC_NVHPC
205 : : ! Silly fix for NVHPC
206 : : if(cplex == -42) write(100,*) cplex
207 : : #endif
208 : :
209 : 25082 : if(use_distrib) then
210 : : call opernlb_gemm_distributed(rank,nprocs,npw,ndat,&
211 : : & transa,transb,&
212 : : & nprojs,&
213 : : & nprojs_blk,&
214 : : & nprojs_last_blk,&
215 : : & cplex,&
216 : : & a,&
217 : 0 : & b,c,gpu_option)
218 : : else
219 : : ! Small trickery here:
220 : : ! When use_sliced_gemm is on, the multiplication is performed over
221 : : ! a slice of projectors in A matrix.
222 : : ! In that case, B matrix is still sized by all projectors but only
223 : : ! a slice matching the projectors present in A is used.
224 : : !
225 : : ! Therefore, we need to provide GEMM with the start of the slice
226 : : ! of relevant projectors within B rather than the start of B as usual.
227 : : !
228 : : ! For that reason, we turn B matrix into single-rank in order
229 : : ! to pass the right starting row.
230 : 25082 : ibeg = 1
231 [ - + ]: 25082 : if(use_sliced_gemms) ibeg = 1 + (iblock-1)*nprojs_blk
232 : 25082 : b_cptr = c_loc(b)
233 [ + + ]: 50164 : call c_f_pointer(b_cptr, b_1d, [cplex * ldb * ndat])
234 : :
235 : : call abi_xgemm(transa,transb,npw,ndat,nprojs,alpha,&
236 : : & a,lda,&
237 : : & b_1d(cplex*ibeg-(cplex-1):cplex*ldb*ndat),ldb,beta,&
238 : : & c,ldc,&
239 : 25082 : & x_cplx=cplex,gpu_option=gpu_option)
240 : : end if
241 : :
242 [ - + ]: 25082 : end subroutine opernlb_xgemm
243 : :
244 : : !----------------------------------------------------------------------
245 : :
246 : : !!****f* m_opernlb_gemm/opernlb_gemm
247 : : !! NAME
248 : : !! opernlb_gemm
249 : : !!
250 : : !! FUNCTION
251 : : !! For a given wave-function |c>, get all projected scalars
252 : : !! <p_lmn|c> where |p_lmn> are non-local projectors
253 : : !! With:
254 : : !! <p_lmn|c>=4pi/sqrt(vol) (i)^l Sum_g[c(g).f_nl(g).Y_lm(g).exp(2pi.i.g.R)]
255 : : !!
256 : : !! INPUTS
257 : : !! choice=chooses possible output:
258 : : !! if choice>=0: compute projected scalars
259 : : !! if choice<0: same as choice>0 but use already computed projected scalars
260 : : !! if ABS(choice)>1, then compute additional quantities:
261 : : !! 2: compute projected scalars and derivatives wrt atm pos.
262 : : !! 3: compute projected scalars and derivatives wrt strains
263 : : !! 22: compute projected scalars and 2nd derivatives wrt atm pos. and q-vector.
264 : : !! 23: compute projected scalars, derivatives wrt atm pos. and derivatives wrt strains
265 : : !! 25: compute projected scalars and 3rd derivatives wrt atm pos. and two q-vectors.
266 : : !! 4, 24: compute projected scalars, derivatives wrt atm pos.
267 : : !! and 2nd derivatives wrt atm pos.
268 : : !! 33: compute projected scalars and 2nd derivatives wrt strain and q-vector.
269 : : !! 5,51,52: compute projected scalars and derivatives wrt wave vector k
270 : : !! 53: compute projected scalars and derivatives wrt wave vector k in direction idir+1 and idir+2 mod 3
271 : : !! 54: compute projected scalars, deriv. wrt atm pos., deriv. wrt wave vector k
272 : : !! and 2nd derivatives wrt right wave vector k and atm pos.
273 : : !! 55: compute projected scalars, deriv. strains, deriv. wrt wave vector k
274 : : !! and 2nd derivatives wrt right wave vector k and strain
275 : : !! 6: compute projected scalars, derivatives wrt atm pos., derivatives wrt strains,
276 : : !! 2nd derivatives wrt 2 strains and derivatives wrt strain and atm pos.
277 : : !! 7: not available
278 : : !! 8: compute projected scalars, derivatives wrt wave vector k
279 : : !! and 2nd derivatives wrt 2 wave vectors k
280 : : !! cplex=1 if <p_lmn|c> scalars are real or pure imaginary (equivalent to istwfk>1)
281 : : !! 2 if <p_lmn|c> scalars are complex
282 : : !! dimffnl=second dimension of ffnl
283 : : !! ffnl(npw,dimffnl,nlmn)= nonlocal quantities containing nonlocal form factors
284 : : !! ia3=gives the number of the first atom in the subset presently treated
285 : : !! idir=direction of the - atom to be moved in the case (choice=2,signs=2) or (choice=22,signs=2)
286 : : !! - k point direction in the case (choice=5,signs=2)
287 : : !! - strain component (1:6) in the case (choice=3,signs=2) or (choice=6,signs=1)
288 : : !! - strain component (1:9) in the case (choice=33,signs=2)
289 : : !! - (1:9) components to specify the atom to be moved and the second q-gradient
290 : : !! direction in the case (choice=25,signs=2)
291 : : !! indlmn(6,nlmn)= array giving l,m,n,lm,ln,s for i=lmn
292 : : !! istwf_k=option parameter that describes the storage of wfs
293 : : !! kpg(npw,nkpg)=(k+G) components for ikpg=1...3 (if nkpg=3 or 9)
294 : : !! [(k+G)_a].[(k+G)_b] quantities for ikpg=4...9 (if nkpg=9)
295 : : !! (k+G) Cartesian components for choice==33
296 : : !! matblk=dimension of the array ph3d
297 : : !! mpi_enreg=information about MPI parallelization
298 : : !! ndgxdt=second dimension of dgxdt
299 : : !! nd2gxdt=second dimension of d2gxdt
300 : : !! nincat=number of atoms in the subset here treated
301 : : !! nkpg=second dimension of array kpg (0, 3 or 9)
302 : : !! nlmn=number of (l,m,n) numbers for current type of atom
303 : : !! nloalg(3)=governs the choice of the algorithm for non-local operator.
304 : : !! npw=number of plane waves in reciprocal space
305 : : !! nspinor=number of spinorial components of the wavefunctions (on current proc)
306 : : !! ph3d(2,npw,matblk)=three-dimensional phase factors
307 : : !! [qdir]= optional, direction of the q-gradient (only for choice=22 choice=25 and choice=33)
308 : : !! signs=chooses possible output:
309 : : !! signs=1: compute derivatives in all directions
310 : : !! signs=2: compute derivative in direction IDIR only
311 : : !! compatible only with 1st-order derivatives and "single" derivatives
312 : : !! ucvol=unit cell volume (bohr^3)
313 : : !! vect(2,npw*my_nspinor)=starting vector in reciprocal space
314 : : !!
315 : : !! OUTPUT
316 : : !! if (choice>1) dgxdt(cplex,ndgxdt,nlmn,nincat,nspinor)=
317 : : !! gradients of projected scalars wrt coords (choice=2, 23, 4, 54, 6)
318 : : !! wrt strains (choice=3, 23, 55)
319 : : !! wrt k wave vect. (choice=5, 51, 52, 53, 54, 55, 8)
320 : : !! wrt coords and q vect (choice=22)
321 : : !! wrt coords and two q vects (choice=25)
322 : : !! wrt strains and q vect (choice=33)
323 : : !! if (choice=4, 24, 33, 54, 55, 6, 8) d2gxdt(cplex,nd2gxdt,nlmn,nincat,nspinor)=
324 : : !! 2nd grads of projected scalars wrt 2 coords (choice=4 or 24)
325 : : !! wrt coords & k wave vect. (choice=54)
326 : : !! wrt strains & k wave vect. (choice=55)
327 : : !! wrt coords & strains (choice=6)
328 : : !! wrt 2 strains (choice=6)
329 : : !! wrt 2 k wave vect. (choice=8)
330 : : !! wrt strains and q vect (choice=33)
331 : : !! only compatible with signs=1
332 : : !! cplex_dgxdt(ndgxdt) = used only when cplex = 1
333 : : !! cplex_dgxdt(i) = 1 if dgxdt(1,i,:,:) is real, 2 if it is pure imaginary
334 : : !! cplex_d2gxdt(nd2gxdt) = used only when cplex = 1
335 : : !! cplex_d2gxdt(i) = 1 if d2gxdt(1,i,:,:) is real, 2 if it is pure imaginary
336 : : !!
337 : : !! SIDE EFFECTS
338 : : !! gx(cplex,nlmn,nincat,nspinor)= projected scalars - input if choice<0, output if choice>=0
339 : : !!
340 : : !! NOTES
341 : : !! 1-The openMP version is different from the standard version:
342 : : !! the standard version is more effifient on one CPU core.
343 : : !! 2-Operate for one type of atom, and within this given type of atom,
344 : : !! for a subset of at most nincat atoms.
345 : : !!
346 : : !! SOURCE
347 : 10902 : subroutine opernlb_gemm(choice,cplex,cplex_dgxdt,cplex_d2gxdt,cplex_fac,&
348 : 32706 : & d2gxdtfac,d2gxdtfac_sij,dgxdtfac,dgxdtfac_sij,&
349 : 21804 : & dimffnl,ffnl,gxfac,gxfac_sij,&
350 : 10902 : & idir,indlmn,kpg,matblk,istwf_k,&
351 : : & nd2gxdt,nd2gxdtfac,ndgxdt,ndgxdtfac,&
352 : 10902 : & nkpg,npw,nspinor,signs,ucvol,ndat,ntypat,lmnmax,nattyp,&
353 : : & is_kprime,iatom_only,atom_proj_shift,&
354 : 10902 : & paw_opt,ph3d,&
355 : : & nprojs,&
356 [ - + - + ]: 21804 : & vectin,vectout,svectout,&
357 [ - + + + : 11231 : & temp_realvec_r,temp_realvec_i,&
- + ]
358 : : & gpu_option,use_distrib)
359 : :
360 : : !Arguments ------------------------------------
361 : : !scalars
362 : : integer,intent(in) :: choice,cplex,cplex_fac,idir,istwf_k,nd2gxdt,nd2gxdtfac
363 : : integer,intent(in) :: ndgxdt,dimffnl,nkpg,lmnmax,ntypat,ndgxdtfac,matblk,npw,nspinor
364 : : integer,intent(in) :: paw_opt,signs,ndat,iatom_only,atom_proj_shift
365 : : integer,intent(in) :: nprojs
366 : : real(dp),intent(in) :: ucvol
367 : : integer,intent(in) :: gpu_option
368 : : logical,intent(in) :: use_distrib,is_kprime
369 : : !arrays
370 : : integer,intent(in) :: indlmn(6,lmnmax,ntypat),nattyp(ntypat)
371 : : integer,intent(in) :: cplex_dgxdt(ndgxdt),cplex_d2gxdt(nd2gxdt)
372 : : real(dp),intent(in) :: ffnl(npw,dimffnl,lmnmax,ntypat),kpg(npw,nkpg)
373 : : real(dp),intent(in) :: ph3d(2,npw,matblk)
374 : : real(dp),target,intent(in) :: vectin(:,:)
375 : : real(dp),target,intent(inout) :: vectout(:,:),svectout(:,:)
376 : : real(dp),target,intent(in) :: d2gxdtfac(cplex_fac,nd2gxdtfac,nprojs,ndat*nspinor)
377 : : real(dp),target,intent(in) :: d2gxdtfac_sij(cplex,nd2gxdtfac,nprojs,ndat*nspinor)
378 : : real(dp),target,intent(inout) :: dgxdtfac(cplex_fac,ndgxdtfac*nprojs,ndat*nspinor)
379 : : real(dp),target,intent(inout) :: dgxdtfac_sij(cplex,ndgxdtfac*nprojs,ndat*nspinor)
380 : : real(dp),target,intent(in) :: gxfac(cplex_fac,nprojs,ndat*nspinor)
381 : : real(dp),target,intent(in) :: gxfac_sij(cplex,nprojs,ndat*nspinor)
382 : : real(dp),target,intent(out) :: temp_realvec_r(:),temp_realvec_i(:)
383 : :
384 : : !Local variables-------------------------------
385 : : integer :: idat,i,ik,nprojs_all,iproj,iplex
386 : : integer :: projs_beg,projs_end,dprojs_beg,dprojs_end
387 : : integer :: nprojs_blk,nprojs_last_blk,nprojs_cur_blk,rank,nprocs,iblock,nblocks
388 : : logical :: use_sliced_gemms
389 : : complex(dp) :: beta
390 : 10902 : real(dp), ABI_CONTIGUOUS pointer :: projs(:,:,:),projs_r(:,:,:),projs_i(:,:,:)
391 : 10902 : real(dp), ABI_CONTIGUOUS pointer :: dprojs(:,:,:),dprojs_r(:,:,:),dprojs_i(:,:,:)
392 : :
393 : 0 : ik=1; if(is_kprime) ik=2
394 : : #ifndef HAVE_OPENMP_OFFLOAD
395 : : ABI_UNUSED((/iproj,idat,iplex/))
396 : : #endif
397 : : ABI_UNUSED(cplex_dgxdt)
398 : : ABI_UNUSED(cplex_d2gxdt)
399 : : ABI_UNUSED(d2gxdtfac)
400 : : ABI_UNUSED(d2gxdtfac_sij)
401 : :
402 : 10902 : nprojs_all=nprojs
403 [ - + ]: 10902 : if(iatom_only>0) then
404 : 0 : nprojs_all=0
405 [ # # ]: 0 : do i=1,ntypat
406 [ # # # # ]: 0 : nprojs_all = nprojs_all + count(indlmn(3,:,i)>0)*nattyp(i)
407 : : end do
408 : : end if
409 : 10902 : nprojs_last_blk=nprojs_all
410 : 10902 : iblock=1; nblocks=1
411 : 10902 : use_sliced_gemms=.false.
412 [ - + - - ]: 10902 : if(gemm_nonlop_block_size>1 .and. .not. use_distrib) then
413 : 0 : nblocks=gemm_nonlop_block_size
414 : 0 : use_sliced_gemms=.true.
415 : : end if
416 : :
417 : : call refresh_projectors(npw,istwf_k,nprojs_all,ndgxdt,nd2gxdt,&
418 : 10902 : & is_kprime,gpu_option)
419 [ - + ]: 10902 : if(nprojs_all/=gemm_nonlop_kpt(ik)%nprojs) ABI_BUG("Problem")
420 : 10902 : nprojs_blk = nprojs
421 : 10902 : nprojs_last_blk = nprojs
422 [ - + ]: 10902 : if(use_distrib) then
423 : 0 : rank=xmpi_comm_rank(gemm_nonlop_block_comm); nprocs=xmpi_comm_size(gemm_nonlop_block_comm)
424 : 0 : nprojs_blk = gemm_nonlop_kpt(ik)%nprojs_blk
425 : 0 : nprojs_last_blk = gemm_nonlop_kpt(ik)%nprojs_last_blk
426 : 0 : iblock=rank+1
427 [ - + ]: 10902 : else if(gemm_nonlop_block_size>1) then
428 : 0 : nprojs_blk = nprojs / gemm_nonlop_block_size
429 : 0 : nprojs_last_blk = nprojs_blk + modulo(nprojs,nprojs_blk)
430 : : end if
431 : :
432 : 10902 : projs_beg=1; projs_end=nprojs;
433 : 10902 : dprojs_beg=1; dprojs_end=max(1,nprojs*ndgxdt)
434 [ - + - - ]: 10902 : if((choice==2 .and. signs==2)) then
435 : 0 : projs_beg=atom_proj_shift+1
436 : 0 : projs_end=projs_beg+nprojs-1
437 : 0 : dprojs_beg=atom_proj_shift*ndgxdt+1
438 : 0 : dprojs_end=dprojs_beg+nprojs*ndgxdt-1
439 : : end if
440 : :
441 [ - + ]: 10902 : if(gemm_nonlop_block_size>1) then
442 : 0 : projs_beg=1; projs_end=nprojs_last_blk;
443 : 0 : dprojs_beg=1; dprojs_end=max(1,nprojs_last_blk*ndgxdt)
444 : : end if
445 : :
446 [ + + ]: 10902 : if(istwf_k == 1) then
447 : 7689 : projs => gemm_nonlop_kpt(ik)%projs(:,:,projs_beg:projs_end)
448 [ - + ]: 7689 : if(ndgxdt>0) dprojs => gemm_nonlop_kpt(ik)%dprojs(:,:,dprojs_beg:dprojs_end)
449 : : else
450 : 3213 : projs_r => gemm_nonlop_kpt(ik)%projs_r(:,:,projs_beg:projs_end)
451 : 3213 : projs_i => gemm_nonlop_kpt(ik)%projs_i(:,:,projs_beg:projs_end)
452 : : if(ndgxdt>0) dprojs_r => gemm_nonlop_kpt(ik)%dprojs_r(:,:,dprojs_beg:dprojs_end)
453 : : if(ndgxdt>0) dprojs_i => gemm_nonlop_kpt(ik)%dprojs_i(:,:,dprojs_beg:dprojs_end)
454 : : end if
455 : :
456 [ + - - + ]: 10902 : if(gemm_nonlop_kpt(ik)%ikpt/=gemm_nonlop_ikpt_this_proc_being_treated .or. use_sliced_gemms) then
457 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
458 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
459 : 0 : & nprojs_last_blk,is_kprime,gpu_option,iblock)
460 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
461 : : end if
462 [ + + - + ]: 10902 : if(choice>1 .and. ndgxdt>0) then
463 : : if( nd2gxdt/=gemm_nonlop_kpt(ik)%ngrads2 &
464 : : & .or. ndgxdt/=gemm_nonlop_kpt(ik)%ngrads &
465 : : & .or. choice/=gemm_nonlop_kpt(ik)%choice &
466 : : & .or. idir/=gemm_nonlop_kpt(ik)%idir &
467 [ # # # # : 0 : & .or. use_sliced_gemms) then
# # # # #
# ]
468 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
469 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
470 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
471 : 0 : & is_kprime,gpu_option,iblock)
472 : 0 : gemm_nonlop_kpt(ik)%choice = choice
473 : 0 : gemm_nonlop_kpt(ik)%idir = idir
474 : : end if
475 : : end if
476 : :
477 [ + + ]: 10902 : if(paw_opt == 3 .or. paw_opt == 4) then
478 : :
479 : : ! Get svectout from gxfac_sij
480 [ + + ]: 8822 : if(cplex == 2) then
481 : :
482 : : ! With many blocks, GEMM results will be summed using beta=cone
483 : 6101 : beta = czero
484 : :
485 [ + + ]: 12202 : do i=1,nblocks
486 [ - + ]: 6101 : if(use_sliced_gemms .and. i>1) then
487 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
488 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
489 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
490 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
491 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
492 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
493 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
494 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
495 : 0 : & is_kprime,gpu_option,i)
496 : 0 : gemm_nonlop_kpt(ik)%choice = choice
497 : 0 : gemm_nonlop_kpt(ik)%idir = idir
498 : : end if
499 : : end if
500 : :
501 : 6101 : nprojs_cur_blk=nprojs
502 [ - + ]: 6101 : if(use_sliced_gemms) then
503 [ # # ]: 0 : if(i<nblocks) then
504 : 0 : nprojs_cur_blk=nprojs_blk
505 : : else
506 : 0 : nprojs_cur_blk=nprojs_last_blk
507 : : end if
508 : : end if
509 : :
510 [ + - - - : 6101 : if(choice==1 .or. choice==7) then
- - ]
511 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
512 : : & projs, npw,&
513 : : & gxfac_sij, nprojs, beta, svectout, npw,&
514 : : & rank, nprocs,&
515 : : & nprojs_blk, nprojs_last_blk, i,&
516 [ - + - - : 6101 : & gpu_option, use_distrib, use_sliced_gemms)
- - - - -
+ - - -
- ]
517 : : else if(choice==2) then
518 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
519 : : & dprojs, npw, &
520 : : & gxfac_sij, nprojs, beta, svectout, npw,&
521 : : & rank, nprocs,&
522 : : & nprojs_blk, nprojs_last_blk, i,&
523 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
524 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
525 : : & projs, npw, &
526 : : & dgxdtfac_sij, nprojs, cone, svectout, npw,&
527 : : & rank, nprocs,&
528 : : & nprojs_blk, nprojs_last_blk, i,&
529 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
530 : : else if(choice==3) then
531 [ # # ]: 0 : if(idir<=3) then
532 [ # # ]: 0 : if(gpu_option == ABI_GPU_DISABLED) then
533 [ # # # # : 0 : dgxdtfac_sij(:,:,:) = dgxdtfac_sij(:,:,:) - gxfac_sij(:,:,:)
# # ]
534 : : else if(gpu_option == ABI_GPU_OPENMP) then
535 : : #ifdef HAVE_OPENMP_OFFLOAD
536 : : !$OMP TARGET TEAMS DISTRIBUTE &
537 : : !$OMP& MAP(to:gxfac_sij,dgxdtfac_sij) PRIVATE(idat)
538 : : do idat=1,ndat
539 : : !$OMP PARALLEL DO PRIVATE(iproj,iplex) COLLAPSE(2)
540 : : do iproj=1,nprojs
541 : : do iplex=1,cplex
542 : : dgxdtfac_sij(iplex,iproj,idat) = dgxdtfac_sij(iplex,iproj,idat) - gxfac_sij(iplex,iproj,idat)
543 : : end do
544 : : end do
545 : : end do
546 : : #endif
547 : : end if
548 : : end if
549 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
550 : : & projs, npw, &
551 : : & dgxdtfac_sij, nprojs, beta, svectout, npw,&
552 : : & rank, nprocs,&
553 : : & nprojs_blk, nprojs_last_blk, i,&
554 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
555 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
556 : : & dprojs, npw, &
557 : : & gxfac_sij, nprojs, cone, svectout, npw,&
558 : : & rank, nprocs,&
559 : : & nprojs_blk, nprojs_last_blk, i,&
560 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
561 : : else if(choice==5) then
562 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
563 : : & projs, npw, &
564 : : & dgxdtfac_sij, nprojs, beta, svectout, npw,&
565 : : & rank, nprocs,&
566 : : & nprojs_blk, nprojs_last_blk, i,&
567 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
568 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
569 : : & dprojs, npw, &
570 : : & gxfac_sij, nprojs, cone, svectout, npw,&
571 : : & rank, nprocs,&
572 : : & nprojs_blk, nprojs_last_blk, i,&
573 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
574 : : else if(choice==51) then
575 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
576 : : & projs, npw, &
577 : : & dgxdtfac_sij, nprojs, beta, svectout, npw,&
578 : : & rank, nprocs,&
579 : : & nprojs_blk, nprojs_last_blk, i,&
580 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
581 : : end if
582 : :
583 : 12202 : beta = cone
584 : : end do
585 : : else
586 : :
587 : : ! With many blocks, GEMM results will be summed using beta=cone
588 : 2721 : beta = czero
589 : :
590 [ + + ]: 5442 : do i=1,nblocks
591 [ - + - - ]: 2721 : if(use_sliced_gemms .and. i>1) then
592 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
593 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
594 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
595 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
596 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
597 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
598 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
599 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
600 : 0 : & is_kprime,gpu_option,i)
601 : 0 : gemm_nonlop_kpt(ik)%choice = choice
602 : 0 : gemm_nonlop_kpt(ik)%idir = idir
603 : : end if
604 : : end if
605 : :
606 : 2721 : nprojs_cur_blk=nprojs
607 [ - + ]: 2721 : if(use_sliced_gemms) then
608 [ # # ]: 0 : if(i<nblocks) then
609 : 0 : nprojs_cur_blk=nprojs_blk
610 : : else
611 : 0 : nprojs_cur_blk=nprojs_last_blk
612 : : end if
613 : : end if
614 : :
615 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
616 : : & projs_r, npw, &
617 : : & gxfac_sij, nprojs, beta, temp_realvec_r, npw,&
618 : : & rank, nprocs,&
619 : : & nprojs_blk, nprojs_last_blk, i,&
620 [ - + - - : 2721 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
621 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
622 : : & projs_i, npw,&
623 : : & gxfac_sij, nprojs, beta, temp_realvec_i, npw,&
624 : : & rank, nprocs,&
625 : : & nprojs_blk, nprojs_last_blk, i,&
626 [ - + - - : 2721 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
627 : :
628 : 5442 : beta=cone
629 : :
630 : : end do
631 : :
632 [ + - ]: 2721 : if(gpu_option == ABI_GPU_DISABLED) then
633 [ + - + + : 2919694 : svectout(1,1:npw*nspinor*ndat) = temp_realvec_r(1:npw*nspinor*ndat)
+ + ]
634 [ + + + + ]: 2919694 : svectout(2,1:npw*nspinor*ndat) = temp_realvec_i(1:npw*nspinor*ndat)
635 : : else if(gpu_option == ABI_GPU_OPENMP) then
636 : : #ifdef HAVE_OPENMP_OFFLOAD
637 : : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO &
638 : : !$OMP& MAP(to:temp_realvec_r,temp_realvec_i,svectout) PRIVATE(i)
639 : : do i=1, npw*nspinor*ndat
640 : : svectout(1,i) = temp_realvec_r(i)
641 : : svectout(2,i) = temp_realvec_i(i)
642 : : end do
643 : : #endif
644 : : end if
645 : :
646 : : end if ! cplex = 2
647 : :
648 [ + + ]: 8822 : if(choice /= 7 .and. choice /= 5 .and. choice/=51 .and. choice/=2 .and. choice/=3) then
649 [ + - ]: 8246 : if(gpu_option == ABI_GPU_DISABLED) then
650 [ + - + + : 47661172 : svectout = svectout + vectin ! TODO understand this
+ + + + +
+ ]
651 [ # # ]: 0 : else if(gpu_option == ABI_GPU_OPENMP) then
652 : : call abi_xaxpy( 2*npw*nspinor*ndat, cone, &
653 : 0 : & vectin, 1, svectout, 1, x_cplx=1, gpu_option=gpu_option)
654 : : end if
655 : : end if
656 : : end if ! (paw_opt == 3 .or. paw_opt == 4)
657 : :
658 [ + + ]: 10902 : if(paw_opt == 0 .or. paw_opt == 1 .or. paw_opt == 4) then
659 : : ! Get vectout from gxfac
660 [ + + ]: 10326 : if(cplex_fac == 2) then
661 : :
662 : : ! With many blocks, GEMM results will be summed using beta=cone
663 : 7113 : beta = czero
664 : :
665 [ + + ]: 14226 : do i=1,nblocks
666 [ - + - - : 7113 : if(use_sliced_gemms .and. (i>1 .or. paw_opt == 3 .or. paw_opt == 4)) then
- - - - ]
667 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
668 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
669 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
670 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
671 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
672 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
673 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
674 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
675 : 0 : & is_kprime,gpu_option,i)
676 : 0 : gemm_nonlop_kpt(ik)%choice = choice
677 : 0 : gemm_nonlop_kpt(ik)%idir = idir
678 : : end if
679 : : end if
680 : :
681 : 7113 : nprojs_cur_blk=nprojs
682 [ - + ]: 7113 : if(use_sliced_gemms) then
683 [ # # ]: 0 : if(i<nblocks) then
684 : 0 : nprojs_cur_blk=nprojs_blk
685 : : else
686 : 0 : nprojs_cur_blk=nprojs_last_blk
687 : : end if
688 : : end if
689 : :
690 [ + - - - : 7113 : if(choice==1 .or. choice==7) then
- - ]
691 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
692 : : & projs, npw, &
693 : : & gxfac, nprojs, beta, vectout, npw,&
694 : : & rank, nprocs,&
695 : : & nprojs_blk, nprojs_last_blk, i,&
696 [ - + - - : 7113 : & gpu_option, use_distrib, use_sliced_gemms)
- - - - -
+ - - -
- ]
697 : : else if(choice==2) then
698 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
699 : : & dprojs, npw, &
700 : : & gxfac, nprojs, beta, vectout, npw,&
701 : : & rank, nprocs,&
702 : : & nprojs_blk, nprojs_last_blk, i,&
703 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
704 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
705 : : & projs, npw, &
706 : : & dgxdtfac, nprojs, cone, vectout, npw,&
707 : : & rank, nprocs,&
708 : : & nprojs_blk, nprojs_last_blk, i,&
709 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
710 : : else if(choice==3) then
711 [ # # ]: 0 : if(idir<=3) then
712 [ # # ]: 0 : if(gpu_option == ABI_GPU_DISABLED) then
713 [ # # # # : 0 : dgxdtfac(:,:,:) = dgxdtfac(:,:,:) - gxfac(:,:,:)
# # ]
714 : : else if(gpu_option == ABI_GPU_OPENMP) then
715 : : #ifdef HAVE_OPENMP_OFFLOAD
716 : : !$OMP TARGET TEAMS DISTRIBUTE &
717 : : !$OMP& MAP(to:gxfac,dgxdtfac) PRIVATE(idat)
718 : : do idat=1,ndat
719 : : !$OMP PARALLEL DO PRIVATE(iproj,iplex) COLLAPSE(2)
720 : : do iproj=1,nprojs
721 : : do iplex=1,cplex_fac
722 : : dgxdtfac(iplex,iproj,idat) = dgxdtfac(iplex,iproj,idat) - gxfac(iplex,iproj,idat)
723 : : end do
724 : : end do
725 : : end do
726 : : #endif
727 : : end if
728 : : end if
729 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
730 : : & projs, npw, &
731 : : & dgxdtfac, nprojs, beta, vectout, npw,&
732 : : & rank, nprocs,&
733 : : & nprojs_blk, nprojs_last_blk, i,&
734 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
735 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
736 : : & dprojs, npw, &
737 : : & gxfac, nprojs, cone, vectout, npw,&
738 : : & rank, nprocs,&
739 : : & nprojs_blk, nprojs_last_blk, i,&
740 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
741 : : else if(choice==5) then
742 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
743 : : & projs, npw, &
744 : : & dgxdtfac, nprojs, beta, vectout, npw,&
745 : : & rank, nprocs,&
746 : : & nprojs_blk, nprojs_last_blk, i,&
747 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
748 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
749 : : & dprojs, npw, &
750 : : & gxfac, nprojs, cone, vectout, npw,&
751 : : & rank, nprocs,&
752 : : & nprojs_blk, nprojs_last_blk, i,&
753 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
754 : : else if(choice==51) then
755 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
756 : : & projs, npw, &
757 : : & dgxdtfac, nprojs, beta, vectout, npw,&
758 : : & rank, nprocs,&
759 : : & nprojs_blk, nprojs_last_blk, i,&
760 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
761 : : end if
762 : 14226 : beta = cone
763 : : end do
764 : : else
765 : :
766 : : ! With many blocks, GEMM results will be summed using beta=cone
767 : 3213 : beta = czero
768 : :
769 [ + + ]: 6426 : do i=1,nblocks
770 [ - + - - : 3213 : if(use_sliced_gemms .and. (i>1 .or. paw_opt == 3 .or. paw_opt == 4)) then
- - - - ]
771 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
772 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
773 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
774 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
775 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
776 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
777 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
778 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
779 : 0 : & is_kprime,gpu_option,i)
780 : 0 : gemm_nonlop_kpt(ik)%choice = choice
781 : 0 : gemm_nonlop_kpt(ik)%idir = idir
782 : : end if
783 : : end if
784 : :
785 : 3213 : nprojs_cur_blk=nprojs
786 [ - + ]: 3213 : if(use_sliced_gemms) then
787 [ # # ]: 0 : if(i<nblocks) then
788 : 0 : nprojs_cur_blk=nprojs_blk
789 : : else
790 : 0 : nprojs_cur_blk=nprojs_last_blk
791 : : end if
792 : : end if
793 : :
794 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
795 : : & projs_r, npw, &
796 : : & gxfac, nprojs, beta, temp_realvec_r, npw,&
797 : : & rank, nprocs,&
798 : : & nprojs_blk, nprojs_last_blk, i,&
799 [ - + - - : 3213 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
800 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
801 : : & projs_i, npw, &
802 : : & gxfac, nprojs, beta, temp_realvec_i, npw,&
803 : : & rank, nprocs,&
804 : : & nprojs_blk, nprojs_last_blk, i,&
805 [ - + - - : 3213 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
806 : :
807 : 6426 : beta=cone
808 : :
809 : : end do
810 : :
811 [ + - ]: 3213 : if(gpu_option == ABI_GPU_DISABLED) then
812 [ + - + + : 18660350 : vectout(1,1:npw*nspinor*ndat) = temp_realvec_r(1:npw*nspinor*ndat)
+ + ]
813 [ + + + + ]: 18660350 : vectout(2,1:npw*nspinor*ndat) = temp_realvec_i(1:npw*nspinor*ndat)
814 : : else if(gpu_option == ABI_GPU_OPENMP) then
815 : : #ifdef HAVE_OPENMP_OFFLOAD
816 : : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO &
817 : : !$OMP& MAP(to:temp_realvec_r,temp_realvec_i,vectout) PRIVATE(i)
818 : : do i=1, npw*nspinor*ndat
819 : : vectout(1,i) = temp_realvec_r(i)
820 : : vectout(2,i) = temp_realvec_i(i)
821 : : end do
822 : : #endif
823 : : end if
824 : : end if ! cplex_fac == 2
825 : : end if ! (paw_opt == 0 .or. paw_opt == 1 .or. paw_opt == 4)
826 : :
827 [ - + ]: 10902 : end subroutine opernlb_gemm
828 : : !!***
829 : :
830 : : end module m_opernlb_gemm
831 : : !!***
|
