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), contiguous, pointer :: recv_buf(:,:,:), work_buf(:,:,:)
75 : 0 : real(dp), allocatable, target :: projs_recv(:,:,:)
76 : 0 : real(dp), 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), 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 [ - + + + : 11229 : & 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), contiguous, pointer :: projs(:,:,:),projs_r(:,:,:),projs_i(:,:,:)
391 : 10902 : real(dp), 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 : : call refresh_projectors(npw,istwf_k,nprojs_all,ndgxdt,nd2gxdt,&
410 : 10902 : & is_kprime,gpu_option)
411 [ - + ]: 10902 : if(nprojs_all/=gemm_nonlop_kpt(ik)%nprojs) ABI_BUG("Problem")
412 : :
413 : : ! refresh_projectors may have reduced gemm_nonlop_block_size
414 : 10902 : iblock=1; nblocks=1
415 : 10902 : use_sliced_gemms=.false.
416 [ - + - - ]: 10902 : if(gemm_nonlop_block_size>1 .and. .not. use_distrib) then
417 : 0 : nblocks=gemm_nonlop_block_size
418 : 0 : use_sliced_gemms=.true.
419 : : end if
420 : :
421 : 10902 : nprojs_blk = nprojs
422 : 10902 : nprojs_last_blk = nprojs
423 [ - + ]: 10902 : if(use_distrib) then
424 : 0 : rank=xmpi_comm_rank(gemm_nonlop_block_comm); nprocs=xmpi_comm_size(gemm_nonlop_block_comm)
425 : 0 : nprojs_blk = gemm_nonlop_kpt(ik)%nprojs_blk
426 : 0 : nprojs_last_blk = gemm_nonlop_kpt(ik)%nprojs_last_blk
427 : 0 : iblock=rank+1
428 [ - + ]: 10902 : else if(gemm_nonlop_block_size>1) then
429 : 0 : nprojs_blk = nprojs / gemm_nonlop_block_size
430 : 0 : nprojs_last_blk = nprojs - (gemm_nonlop_block_size-1)*nprojs_blk
431 : : end if
432 : :
433 : 10902 : projs_beg=1; projs_end=nprojs;
434 : 10902 : dprojs_beg=1; dprojs_end=max(1,nprojs*ndgxdt)
435 [ - + - - ]: 10902 : if((choice==2 .and. signs==2)) then
436 : 0 : projs_beg=atom_proj_shift+1
437 : 0 : projs_end=projs_beg+nprojs-1
438 : 0 : dprojs_beg=atom_proj_shift*ndgxdt+1
439 : 0 : dprojs_end=dprojs_beg+nprojs*ndgxdt-1
440 : : end if
441 : :
442 [ - + ]: 10902 : if(gemm_nonlop_block_size>1) then
443 : 0 : projs_beg=1; projs_end=nprojs_last_blk;
444 : 0 : dprojs_beg=1; dprojs_end=max(1,nprojs_last_blk*ndgxdt)
445 : : end if
446 : :
447 [ + + ]: 10902 : if(istwf_k == 1) then
448 : 7689 : projs => gemm_nonlop_kpt(ik)%projs(:,:,projs_beg:projs_end)
449 [ - + ]: 7689 : if(ndgxdt>0) dprojs => gemm_nonlop_kpt(ik)%dprojs(:,:,dprojs_beg:dprojs_end)
450 : : else
451 : 3213 : projs_r => gemm_nonlop_kpt(ik)%projs_r(:,:,projs_beg:projs_end)
452 : 3213 : projs_i => gemm_nonlop_kpt(ik)%projs_i(:,:,projs_beg:projs_end)
453 : : if(ndgxdt>0) dprojs_r => gemm_nonlop_kpt(ik)%dprojs_r(:,:,dprojs_beg:dprojs_end)
454 : : if(ndgxdt>0) dprojs_i => gemm_nonlop_kpt(ik)%dprojs_i(:,:,dprojs_beg:dprojs_end)
455 : : end if
456 : :
457 [ + - - + ]: 10902 : if(gemm_nonlop_kpt(ik)%ikpt/=gemm_nonlop_ikpt_this_proc_being_treated .or. use_sliced_gemms) then
458 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
459 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
460 : 0 : & nprojs_last_blk,is_kprime,gpu_option,iblock)
461 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
462 : : end if
463 [ + + - + ]: 10902 : if(choice>1 .and. ndgxdt>0) then
464 : : if( nd2gxdt/=gemm_nonlop_kpt(ik)%ngrads2 &
465 : : & .or. ndgxdt/=gemm_nonlop_kpt(ik)%ngrads &
466 : : & .or. choice/=gemm_nonlop_kpt(ik)%choice &
467 : : & .or. idir/=gemm_nonlop_kpt(ik)%idir &
468 [ # # # # : 0 : & .or. use_sliced_gemms) then
# # # # #
# ]
469 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
470 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
471 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
472 : 0 : & is_kprime,gpu_option,iblock)
473 : 0 : gemm_nonlop_kpt(ik)%choice = choice
474 : 0 : gemm_nonlop_kpt(ik)%idir = idir
475 : : end if
476 : : end if
477 : :
478 [ + + ]: 10902 : if(paw_opt == 3 .or. paw_opt == 4) then
479 : :
480 : : ! Get svectout from gxfac_sij
481 [ + + ]: 8822 : if(cplex == 2) then
482 : :
483 : : ! With many blocks, GEMM results will be summed using beta=cone
484 : 6101 : beta = czero
485 : :
486 [ + + ]: 12202 : do i=1,nblocks
487 [ - + ]: 6101 : if(use_sliced_gemms .and. i>1) then
488 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
489 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
490 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
491 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
492 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
493 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
494 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
495 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
496 : 0 : & is_kprime,gpu_option,i)
497 : 0 : gemm_nonlop_kpt(ik)%choice = choice
498 : 0 : gemm_nonlop_kpt(ik)%idir = idir
499 : : end if
500 : : end if
501 : :
502 : 6101 : nprojs_cur_blk=nprojs
503 [ - + ]: 6101 : if(use_sliced_gemms) then
504 [ # # ]: 0 : if(i<nblocks) then
505 : 0 : nprojs_cur_blk=nprojs_blk
506 : : else
507 : 0 : nprojs_cur_blk=nprojs_last_blk
508 : : end if
509 : : end if
510 : :
511 [ + - - - : 6101 : if(choice==1 .or. choice==7) then
- - ]
512 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
513 : : & projs, npw,&
514 : : & gxfac_sij, nprojs, beta, svectout, npw,&
515 : : & rank, nprocs,&
516 : : & nprojs_blk, nprojs_last_blk, i,&
517 [ - + - - : 6101 : & gpu_option, use_distrib, use_sliced_gemms)
- - - - -
+ - - -
- ]
518 : : else if(choice==2) then
519 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
520 : : & dprojs, npw, &
521 : : & gxfac_sij, nprojs, beta, svectout, npw,&
522 : : & rank, nprocs,&
523 : : & nprojs_blk, nprojs_last_blk, i,&
524 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
525 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
526 : : & projs, npw, &
527 : : & dgxdtfac_sij, nprojs, cone, svectout, npw,&
528 : : & rank, nprocs,&
529 : : & nprojs_blk, nprojs_last_blk, i,&
530 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
531 : : else if(choice==3) then
532 : : ! Whole array updated: do it once, not for every block
533 [ # # # # ]: 0 : if(idir<=3 .and. i==1) then
534 [ # # ]: 0 : if(gpu_option == ABI_GPU_DISABLED) then
535 [ # # # # : 0 : dgxdtfac_sij(:,:,:) = dgxdtfac_sij(:,:,:) - gxfac_sij(:,:,:)
# # ]
536 : : else if(gpu_option == ABI_GPU_OPENMP) then
537 : : #ifdef HAVE_OPENMP_OFFLOAD
538 : : !$OMP TARGET TEAMS DISTRIBUTE &
539 : : !$OMP& MAP(to:gxfac_sij,dgxdtfac_sij) PRIVATE(idat)
540 : : do idat=1,ndat
541 : : !$OMP PARALLEL DO PRIVATE(iproj,iplex) COLLAPSE(2)
542 : : do iproj=1,nprojs
543 : : do iplex=1,cplex
544 : : dgxdtfac_sij(iplex,iproj,idat) = dgxdtfac_sij(iplex,iproj,idat) - gxfac_sij(iplex,iproj,idat)
545 : : end do
546 : : end do
547 : : end do
548 : : #endif
549 : : end if
550 : : end if
551 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
552 : : & projs, npw, &
553 : : & dgxdtfac_sij, nprojs, beta, svectout, npw,&
554 : : & rank, nprocs,&
555 : : & nprojs_blk, nprojs_last_blk, i,&
556 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
557 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
558 : : & dprojs, npw, &
559 : : & gxfac_sij, nprojs, cone, svectout, npw,&
560 : : & rank, nprocs,&
561 : : & nprojs_blk, nprojs_last_blk, i,&
562 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
563 : : else if(choice==5) then
564 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
565 : : & projs, npw, &
566 : : & dgxdtfac_sij, nprojs, beta, svectout, npw,&
567 : : & rank, nprocs,&
568 : : & nprojs_blk, nprojs_last_blk, i,&
569 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
570 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
571 : : & dprojs, npw, &
572 : : & gxfac_sij, nprojs, cone, svectout, npw,&
573 : : & rank, nprocs,&
574 : : & nprojs_blk, nprojs_last_blk, i,&
575 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
576 : : else if(choice==51) then
577 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
578 : : & projs, npw, &
579 : : & dgxdtfac_sij, nprojs, beta, svectout, npw,&
580 : : & rank, nprocs,&
581 : : & nprojs_blk, nprojs_last_blk, i,&
582 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
583 : : end if
584 : :
585 : 12202 : beta = cone
586 : : end do
587 : : else
588 : :
589 : : ! With many blocks, GEMM results will be summed using beta=cone
590 : 2721 : beta = czero
591 : :
592 [ + + ]: 5442 : do i=1,nblocks
593 [ - + - - ]: 2721 : if(use_sliced_gemms .and. i>1) then
594 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
595 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
596 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
597 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
598 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
599 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
600 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
601 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
602 : 0 : & is_kprime,gpu_option,i)
603 : 0 : gemm_nonlop_kpt(ik)%choice = choice
604 : 0 : gemm_nonlop_kpt(ik)%idir = idir
605 : : end if
606 : : end if
607 : :
608 : 2721 : nprojs_cur_blk=nprojs
609 [ - + ]: 2721 : if(use_sliced_gemms) then
610 [ # # ]: 0 : if(i<nblocks) then
611 : 0 : nprojs_cur_blk=nprojs_blk
612 : : else
613 : 0 : nprojs_cur_blk=nprojs_last_blk
614 : : end if
615 : : end if
616 : :
617 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
618 : : & projs_r, npw, &
619 : : & gxfac_sij, nprojs, beta, temp_realvec_r, npw,&
620 : : & rank, nprocs,&
621 : : & nprojs_blk, nprojs_last_blk, i,&
622 [ - + - - : 2721 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
623 : : call opernlb_xgemm(cplex, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
624 : : & projs_i, npw,&
625 : : & gxfac_sij, nprojs, beta, temp_realvec_i, npw,&
626 : : & rank, nprocs,&
627 : : & nprojs_blk, nprojs_last_blk, i,&
628 [ - + - - : 2721 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
629 : :
630 : 5442 : beta=cone
631 : :
632 : : end do
633 : :
634 [ + - ]: 2721 : if(gpu_option == ABI_GPU_DISABLED) then
635 [ + - + + : 2919694 : svectout(1,1:npw*nspinor*ndat) = temp_realvec_r(1:npw*nspinor*ndat)
+ + ]
636 [ + + + + ]: 2919694 : svectout(2,1:npw*nspinor*ndat) = temp_realvec_i(1:npw*nspinor*ndat)
637 : : else if(gpu_option == ABI_GPU_OPENMP) then
638 : : #ifdef HAVE_OPENMP_OFFLOAD
639 : : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO &
640 : : !$OMP& MAP(to:temp_realvec_r,temp_realvec_i,svectout) PRIVATE(i)
641 : : do i=1, npw*nspinor*ndat
642 : : svectout(1,i) = temp_realvec_r(i)
643 : : svectout(2,i) = temp_realvec_i(i)
644 : : end do
645 : : #endif
646 : : end if
647 : :
648 : : end if ! cplex = 2
649 : :
650 [ + + ]: 8822 : if(choice /= 7 .and. choice /= 5 .and. choice/=51 .and. choice/=2 .and. choice/=3) then
651 [ + - ]: 8246 : if(gpu_option == ABI_GPU_DISABLED) then
652 [ + - + + : 47661172 : svectout = svectout + vectin ! TODO understand this
+ + + + +
+ ]
653 [ # # ]: 0 : else if(gpu_option == ABI_GPU_OPENMP) then
654 : : call abi_xaxpy( 2*npw*nspinor*ndat, cone, &
655 : 0 : & vectin, 1, svectout, 1, x_cplx=1, gpu_option=gpu_option)
656 : : end if
657 : : end if
658 : : end if ! (paw_opt == 3 .or. paw_opt == 4)
659 : :
660 [ + + ]: 10902 : if(paw_opt == 0 .or. paw_opt == 1 .or. paw_opt == 4) then
661 : : ! Get vectout from gxfac
662 [ + + ]: 10326 : if(cplex_fac == 2) then
663 : :
664 : : ! With many blocks, GEMM results will be summed using beta=cone
665 : 7113 : beta = czero
666 : :
667 [ + + ]: 14226 : do i=1,nblocks
668 [ - + - - : 7113 : if(use_sliced_gemms .and. (i>1 .or. paw_opt == 3 .or. paw_opt == 4)) then
- - - - ]
669 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
670 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
671 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
672 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
673 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
674 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
675 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
676 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
677 : 0 : & is_kprime,gpu_option,i)
678 : 0 : gemm_nonlop_kpt(ik)%choice = choice
679 : 0 : gemm_nonlop_kpt(ik)%idir = idir
680 : : end if
681 : : end if
682 : :
683 : 7113 : nprojs_cur_blk=nprojs
684 [ - + ]: 7113 : if(use_sliced_gemms) then
685 [ # # ]: 0 : if(i<nblocks) then
686 : 0 : nprojs_cur_blk=nprojs_blk
687 : : else
688 : 0 : nprojs_cur_blk=nprojs_last_blk
689 : : end if
690 : : end if
691 : :
692 [ + - - - : 7113 : if(choice==1 .or. choice==7) then
- - ]
693 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
694 : : & projs, npw, &
695 : : & gxfac, nprojs, beta, vectout, npw,&
696 : : & rank, nprocs,&
697 : : & nprojs_blk, nprojs_last_blk, i,&
698 [ - + - - : 7113 : & gpu_option, use_distrib, use_sliced_gemms)
- - - - -
+ - - -
- ]
699 : : else if(choice==2) then
700 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
701 : : & dprojs, npw, &
702 : : & gxfac, nprojs, beta, vectout, npw,&
703 : : & rank, nprocs,&
704 : : & nprojs_blk, nprojs_last_blk, i,&
705 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
706 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
707 : : & projs, npw, &
708 : : & dgxdtfac, nprojs, cone, vectout, npw,&
709 : : & rank, nprocs,&
710 : : & nprojs_blk, nprojs_last_blk, i,&
711 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
712 : : else if(choice==3) then
713 : : ! Whole array updated: do it once, not for every block
714 [ # # # # ]: 0 : if(idir<=3 .and. i==1) then
715 [ # # ]: 0 : if(gpu_option == ABI_GPU_DISABLED) then
716 [ # # # # : 0 : dgxdtfac(:,:,:) = dgxdtfac(:,:,:) - gxfac(:,:,:)
# # ]
717 : : else if(gpu_option == ABI_GPU_OPENMP) then
718 : : #ifdef HAVE_OPENMP_OFFLOAD
719 : : !$OMP TARGET TEAMS DISTRIBUTE &
720 : : !$OMP& MAP(to:gxfac,dgxdtfac) PRIVATE(idat)
721 : : do idat=1,ndat
722 : : !$OMP PARALLEL DO PRIVATE(iproj,iplex) COLLAPSE(2)
723 : : do iproj=1,nprojs
724 : : do iplex=1,cplex_fac
725 : : dgxdtfac(iplex,iproj,idat) = dgxdtfac(iplex,iproj,idat) - gxfac(iplex,iproj,idat)
726 : : end do
727 : : end do
728 : : end do
729 : : #endif
730 : : end if
731 : : end if
732 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
733 : : & projs, npw, &
734 : : & dgxdtfac, nprojs, beta, vectout, npw,&
735 : : & rank, nprocs,&
736 : : & nprojs_blk, nprojs_last_blk, i,&
737 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
738 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
739 : : & dprojs, npw, &
740 : : & gxfac, nprojs, cone, vectout, npw,&
741 : : & rank, nprocs,&
742 : : & nprojs_blk, nprojs_last_blk, i,&
743 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
744 : : else if(choice==5) then
745 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
746 : : & projs, npw, &
747 : : & dgxdtfac, nprojs, beta, vectout, npw,&
748 : : & rank, nprocs,&
749 : : & nprojs_blk, nprojs_last_blk, i,&
750 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
751 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
752 : : & dprojs, npw, &
753 : : & gxfac, nprojs, cone, vectout, npw,&
754 : : & rank, nprocs,&
755 : : & nprojs_blk, nprojs_last_blk, i,&
756 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
757 : : else if(choice==51) then
758 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
759 : : & projs, npw, &
760 : : & dgxdtfac, nprojs, beta, vectout, npw,&
761 : : & rank, nprocs,&
762 : : & nprojs_blk, nprojs_last_blk, i,&
763 [ # # # # : 0 : & gpu_option, use_distrib, use_sliced_gemms)
# # # # #
# # # #
# ]
764 : : end if
765 : 14226 : beta = cone
766 : : end do
767 : : else
768 : :
769 : : ! With many blocks, GEMM results will be summed using beta=cone
770 : 3213 : beta = czero
771 : :
772 [ + + ]: 6426 : do i=1,nblocks
773 [ - + - - : 3213 : if(use_sliced_gemms .and. (i>1 .or. paw_opt == 3 .or. paw_opt == 4)) then
- - - - ]
774 : : call prep_projectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
775 : : & ucvol,ffnl,ph3d,dimffnl,matblk,&
776 : 0 : & nprojs_last_blk,is_kprime,gpu_option,i)
777 : 0 : gemm_nonlop_kpt(ik)%ikpt=gemm_nonlop_ikpt_this_proc_being_treated
778 [ # # # # ]: 0 : if(choice>1 .and. ndgxdt>0) then
779 : : call prep_dprojectors(npw,lmnmax,ntypat,indlmn,nattyp,istwf_k,&
780 : : & ucvol,ffnl,ph3d,kpg,nkpg,dimffnl,matblk,&
781 : : & nprojs_last_blk,ndgxdt,nd2gxdt,choice,signs,idir,&
782 : 0 : & is_kprime,gpu_option,i)
783 : 0 : gemm_nonlop_kpt(ik)%choice = choice
784 : 0 : gemm_nonlop_kpt(ik)%idir = idir
785 : : end if
786 : : end if
787 : :
788 : 3213 : nprojs_cur_blk=nprojs
789 [ - + ]: 3213 : if(use_sliced_gemms) then
790 [ # # ]: 0 : if(i<nblocks) then
791 : 0 : nprojs_cur_blk=nprojs_blk
792 : : else
793 : 0 : nprojs_cur_blk=nprojs_last_blk
794 : : end if
795 : : end if
796 : :
797 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
798 : : & projs_r, npw, &
799 : : & gxfac, nprojs, beta, temp_realvec_r, npw,&
800 : : & rank, nprocs,&
801 : : & nprojs_blk, nprojs_last_blk, i,&
802 [ - + - - : 3213 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
803 : : call opernlb_xgemm(cplex_fac, 'N', 'N', npw, ndat*nspinor, nprojs_cur_blk, cone, &
804 : : & projs_i, npw, &
805 : : & gxfac, nprojs, beta, temp_realvec_i, npw,&
806 : : & rank, nprocs,&
807 : : & nprojs_blk, nprojs_last_blk, i,&
808 [ - + - - : 3213 : & gpu_option, use_distrib, use_sliced_gemms)
- - - + -
- ]
809 : :
810 : 6426 : beta=cone
811 : :
812 : : end do
813 : :
814 [ + - ]: 3213 : if(gpu_option == ABI_GPU_DISABLED) then
815 [ + - + + : 18660350 : vectout(1,1:npw*nspinor*ndat) = temp_realvec_r(1:npw*nspinor*ndat)
+ + ]
816 [ + + + + ]: 18660350 : vectout(2,1:npw*nspinor*ndat) = temp_realvec_i(1:npw*nspinor*ndat)
817 : : else if(gpu_option == ABI_GPU_OPENMP) then
818 : : #ifdef HAVE_OPENMP_OFFLOAD
819 : : !$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO &
820 : : !$OMP& MAP(to:temp_realvec_r,temp_realvec_i,vectout) PRIVATE(i)
821 : : do i=1, npw*nspinor*ndat
822 : : vectout(1,i) = temp_realvec_r(i)
823 : : vectout(2,i) = temp_realvec_i(i)
824 : : end do
825 : : #endif
826 : : end if
827 : : end if ! cplex_fac == 2
828 : : end if ! (paw_opt == 0 .or. paw_opt == 1 .or. paw_opt == 4)
829 : :
830 [ - + ]: 10902 : end subroutine opernlb_gemm
831 : : !!***
832 : :
833 : : end module m_opernlb_gemm
834 : : !!***
|
