Branch data Line data Source code
1 : : !!****m* ABINIT/m_opernlc_ylm_allwf
2 : : !! NAME
3 : : !! m_opernlc_ylm_allwf
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_opernlc_ylm_allwf
22 : :
23 : : use defs_basis
24 : : use m_errors
25 : : use m_abicore
26 : : use m_xmpi
27 : : use m_gputk
28 : : use m_abi_linalg
29 : : use, intrinsic :: iso_c_binding
30 : :
31 : : use defs_abitypes, only : MPI_type
32 : : use m_opernlc_ylm, only : ls_ylm
33 : :
34 : : implicit none
35 : :
36 : : private
37 : : !!***
38 : :
39 : : public :: opernlc_ylm_allwf
40 : : !!***
41 : :
42 : : ! Work buffers to be used when iphase==2
43 : : real(dp), allocatable, target :: d2gxdtfac_2ndphase(:,:,:,:,:)
44 : : real(dp), allocatable, target :: dgxdtfac_2ndphase(:,:,:,:,:)
45 : : real(dp), allocatable, target :: gxfac_2ndphase(:,:,:,:)
46 : :
47 : : !----------------------------------------------------------------------
48 : :
49 : : contains
50 : : !!***
51 : :
52 : : !----------------------------------------------------------------------
53 : :
54 : : !!****f* m_opernlc_ylm_allwf/alloc_work_arrays
55 : : !! NAME
56 : : !! alloc_work_arrays
57 : : !!
58 : : !! FUNCTION
59 : : !! Allocation of work arrays
60 : : !!
61 : : !! INPUTS
62 : : !!
63 : : !! SOURCE
64 : 0 : subroutine alloc_work_arrays(optder,cplex_fac,ndgxdtfac,nd2gxdtfac,nprojs,nspinor,ndat,gpu_option)
65 : :
66 : : integer,intent(in) :: optder,cplex_fac,ndgxdtfac,nd2gxdtfac,nprojs,nspinor,ndat,gpu_option
67 : :
68 : : ! *************************************************************************
69 : :
70 [ # # # # : 0 : ABI_MALLOC(gxfac_2ndphase,(cplex_fac,nprojs,nspinor,ndat))
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
71 : : #ifdef HAVE_OPENMP_OFFLOAD
72 : : !$OMP TARGET ENTER DATA MAP(alloc:gxfac_2ndphase) IF(gpu_option==ABI_GPU_OPENMP)
73 : : #endif
74 [ # # ]: 0 : if(gpu_option==ABI_GPU_OPENMP) then
75 : 0 : call gpu_set_to_zero(gxfac_2ndphase, int(cplex_fac,c_size_t)*nprojs*nspinor*ndat)
76 : : else
77 [ # # # # : 0 : gxfac_2ndphase(:,:,:,:) = zero
# # # # ]
78 : : end if
79 [ # # ]: 0 : if (optder>=1) then
80 [ # # # # : 0 : ABI_MALLOC(dgxdtfac_2ndphase,(cplex_fac,ndgxdtfac,nprojs,nspinor,ndat))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
81 : : #ifdef HAVE_OPENMP_OFFLOAD
82 : : !$OMP TARGET ENTER DATA MAP(alloc:dgxdtfac_2ndphase) IF(gpu_option==ABI_GPU_OPENMP)
83 : : #endif
84 [ # # ]: 0 : if(gpu_option==ABI_GPU_OPENMP) then
85 : 0 : call gpu_set_to_zero(dgxdtfac_2ndphase, int(cplex_fac,c_size_t)*ndgxdtfac*nprojs*nspinor*ndat)
86 : : else
87 [ # # # # : 0 : dgxdtfac_2ndphase(:,:,:,:,:) = zero
# # # # #
# ]
88 : : end if
89 : : end if
90 [ # # ]: 0 : if (optder>=2) then
91 [ # # # # : 0 : ABI_MALLOC(d2gxdtfac_2ndphase,(cplex_fac,nd2gxdtfac,nprojs,nspinor,ndat))
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# ]
92 : : #ifdef HAVE_OPENMP_OFFLOAD
93 : : !$OMP TARGET ENTER DATA MAP(alloc:dgxdtfac_2ndphase) IF(gpu_option==ABI_GPU_OPENMP)
94 : : #endif
95 [ # # ]: 0 : if(gpu_option==ABI_GPU_OPENMP) then
96 : 0 : call gpu_set_to_zero(d2gxdtfac_2ndphase, int(cplex_fac,c_size_t)*nd2gxdtfac*nprojs*nspinor*ndat)
97 : : else
98 [ # # # # : 0 : d2gxdtfac_2ndphase(:,:,:,:,:) = zero
# # # # #
# ]
99 : : end if
100 : : end if
101 : :
102 : 0 : end subroutine alloc_work_arrays
103 : : !!***
104 : :
105 : : !----------------------------------------------------------------------
106 : :
107 : : !!****f* m_opernlc_ylm_allwf/destroy_work_arrays
108 : : !! NAME
109 : : !! destroy_work_arrays
110 : : !!
111 : : !! FUNCTION
112 : : !! Destruction of work arrays
113 : : !!
114 : : !! INPUTS
115 : : !!
116 : : !! SOURCE
117 : 0 : subroutine destroy_work_arrays(gpu_option)
118 : :
119 : : integer,intent(in) :: gpu_option
120 : :
121 : : ! *************************************************************************
122 : :
123 : : ABI_UNUSED(gpu_option) !Silent abirules
124 : :
125 [ # # ]: 0 : if(allocated(gxfac_2ndphase)) then
126 : : #ifdef HAVE_OPENMP_OFFLOAD
127 : : !$OMP TARGET EXIT DATA MAP(delete:gxfac_2ndphase) IF(gpu_option==ABI_GPU_OPENMP)
128 : : #endif
129 : 0 : ABI_FREE(gxfac_2ndphase)
130 : : end if
131 [ # # ]: 0 : if(allocated(dgxdtfac_2ndphase)) then
132 : : #ifdef HAVE_OPENMP_OFFLOAD
133 : : !$OMP TARGET EXIT DATA MAP(delete:dgxdtfac_2ndphase) IF(gpu_option==ABI_GPU_OPENMP)
134 : : #endif
135 : 0 : ABI_FREE(dgxdtfac_2ndphase)
136 : : end if
137 [ # # ]: 0 : if(allocated(d2gxdtfac_2ndphase)) then
138 : : #ifdef HAVE_OPENMP_OFFLOAD
139 : : !$OMP TARGET EXIT DATA MAP(delete:d2gxdtfac_2ndphase) IF(gpu_option==ABI_GPU_OPENMP)
140 : : #endif
141 : 0 : ABI_FREE(d2gxdtfac_2ndphase)
142 : : end if
143 : :
144 : 0 : end subroutine destroy_work_arrays
145 : : !!***
146 : :
147 : : !----------------------------------------------------------------------
148 : :
149 : : !!****f* ABINIT/opernlc_ylm_allwf
150 : : !! NAME
151 : : !! opernlc_ylm_allwf
152 : : !!
153 : : !! FUNCTION
154 : : !! * Operate with the non-local part of the hamiltonian,
155 : : !! in order to reduce projected scalars
156 : : !! * Operate with the non-local projectors and the overlap matrix,
157 : : !! in order to reduce projected scalars
158 : : !!
159 : : !! INPUTS
160 : : !! atindx1(natom)=index table for atoms (gives the absolute index of
161 : : !! an atom from its rank in a block of atoms)
162 : : !! cplex=1 if <p_lmn|c> scalars are real (equivalent to istwfk>1)
163 : : !! 2 if <p_lmn|c> scalars are complex
164 : : !! cplex_dgxdt(ndgxdt) = used only when cplex = 1
165 : : !! cplex_dgxdt(i) = 1 if dgxdt(1,i,:,:) is real, 2 if it is pure imaginary
166 : : !! cplex_enl=1 if enl factors are real, 2 if they are complex
167 : : !! cplex_fac=1 if gxfac scalars are real, 2 if gxfac scalars are complex
168 : : !! dgxdt(cplex,ndgxdt,nlmn,nincat)=grads of projected scalars (only if optder>0)
169 : : !! dimenl1,dimenl2=dimensions of enl (see enl)
170 : : !! dimekbq=1 if enl factors do not contain a exp(-iqR) phase, 2 is they do
171 : : !! enl(cplex_enl*dimenl1,dimenl2,nspinortot**2,dimekbq)=
172 : : !! ->Norm conserving : ==== when paw_opt=0 ====
173 : : !! (Real) Kleinman-Bylander energies (hartree)
174 : : !! dimenl1=lmnmax - dimenl2=ntypat
175 : : !! dimekbq is 2 if Enl contains a exp(-iqR) phase, 1 otherwise
176 : : !! ->PAW : ==== when paw_opt=1, 2 or 4 ====
177 : : !! (Real or complex, hermitian) Dij coefs to connect projectors
178 : : !! dimenl1=cplex_enl*lmnmax*(lmnmax+1)/2 - dimenl2=natom
179 : : !! These are complex numbers if cplex_enl=2
180 : : !! enl(:,:,1) contains Dij^up-up
181 : : !! enl(:,:,2) contains Dij^dn-dn
182 : : !! enl(:,:,3) contains Dij^up-dn (only if nspinor=2)
183 : : !! enl(:,:,4) contains Dij^dn-up (only if nspinor=2)
184 : : !! dimekbq is 2 if Dij contains a exp(-iqR) phase, 1 otherwise
185 : : !! gx(cplex,nlmn,nincat*abs(enl_opt))= projected scalars
186 : : !! iatm=absolute rank of first atom of the current block of atoms
187 : : !! indlmn(6,nlmn)= array giving l,m,n,lm,ln,s for i=lmn
188 : : !! itypat=type of atoms
189 : : !! lambda=factor to be used when computing (Vln-lambda.S) - only for paw_opt=2
190 : : !! mpi_enreg=information about MPI parallelization
191 : : !! natom=number of atoms in cell
192 : : !! ndgxdt=second dimension of dgxdt
193 : : !! ndgxdtfac=second dimension of dgxdtfac
194 : : !! nincat=number of atoms in the subset here treated
195 : : !! nlmn=number of (l,m,n) numbers for current type of atom
196 : : !! nspinor= number of spinorial components of the wavefunctions (on current proc)
197 : : !! nspinortot=total number of spinorial components of the wavefunctions
198 : : !! optder=0=only gxfac is computed, 1=both gxfac and dgxdtfac are computed
199 : : !! 2=gxfac, dgxdtfac and d2gxdtfac are computed
200 : : !! paw_opt= define the nonlocal operator concerned with:
201 : : !! paw_opt=0 : Norm-conserving Vnl (use of Kleinman-Bylander ener.)
202 : : !! paw_opt=1 : PAW nonlocal part of H (use of Dij coeffs)
203 : : !! paw_opt=2 : PAW: (Vnl-lambda.Sij) (Sij=overlap matrix)
204 : : !! paw_opt=3 : PAW overlap matrix (Sij)
205 : : !! paw_opt=4 : both PAW nonlocal part of H (Dij) and overlap matrix (Sij)
206 : : !! sij(nlm*(nlmn+1)/2)=overlap matrix components (only if paw_opt=2, 3 or 4)
207 : : !!
208 : : !! OUTPUT
209 : : !! if (paw_opt=0, 1, 2 or 4)
210 : : !! gxfac(cplex_fac,nlmn,nincat,nspinor)= reduced projected scalars related to Vnl (NL operator)
211 : : !! if (paw_opt=3 or 4)
212 : : !! gxfac_sij(cplex,nlmn,nincat,nspinor)= reduced projected scalars related to Sij (overlap)
213 : : !! if (optder==1.and.paw_opt=0, 1, 2 or 4)
214 : : !! dgxdtfac(cplex_fac,ndgxdtfac,nlmn,nincat,nspinor)= gradients of gxfac related to Vnl (NL operator)
215 : : !! if (optder==1.and.paw_opt=3 or 4)
216 : : !! dgxdtfac_sij(cplex,ndgxdtfac,nlmn,nincat,nspinor)= gradients of gxfac related to Sij (overlap)
217 : : !!
218 : : !! NOTES
219 : : !! This routine operates for one type of atom, and within this given type of atom,
220 : : !! for a subset of at most nincat atoms.
221 : : !!
222 : : !! About the non-local factors symmetry:
223 : : !! - The lower triangular part of the Dij matrix can be deduced from the upper one
224 : : !! with the following relation: D^s2s1_ji = (D^s1s2_ij)^*
225 : : !! where s1,s2 are spinor components
226 : : !! - The Dij factors can contain a exp(-iqR) phase
227 : : !! This phase does not have to be included in the symmetry rule
228 : : !! For that reason, we first apply the real part (cos(qR).D^s1s2_ij)
229 : : !! then, we apply the imaginary part (-sin(qR).D^s1s2_ij)
230 : : !!
231 : : !! SOURCE
232 : :
233 : 36992 : subroutine opernlc_ylm_allwf(atindx1,cplex,cplex_dgxdt,cplex_d2gxdt,cplex_enl,cplex_fac,&
234 : 36992 : & dgxdt,dgxdtfac,dgxdtfac_sij,d2gxdt,d2gxdtfac,d2gxdtfac_sij,dimenl1,dimenl2,dimekbq,enl,&
235 : 36992 : & gx,gxfac,gxfac_sij,iatm,indlmn,itypat,lambda,mpi_enreg,natom,ndgxdt,ndgxdtfac,&
236 [ - + ]: 18496 : & nd2gxdt,nd2gxdtfac,nincat,nlmn,nspinor,nspinortot,optder,paw_opt,sij,ndat,ibeg,iend,nprojs,ndat_enl,gpu_option)
237 : :
238 : : !Arguments ------------------------------------
239 : : !scalars
240 : : integer,intent(in) :: cplex,cplex_enl,cplex_fac,dimenl1,dimenl2,dimekbq,iatm,itypat
241 : : integer,intent(in) :: natom,ndgxdt,ndgxdtfac,nd2gxdt,nd2gxdtfac,nincat,nspinor,nspinortot,optder,paw_opt,gpu_option
242 : : integer,intent(inout) :: nlmn
243 : : integer,intent(in) :: ndat,ibeg,iend,nprojs,ndat_enl
244 : : real(dp) :: lambda(ndat)
245 : : type(MPI_type) , intent(in) :: mpi_enreg
246 : : !arrays
247 : : integer,intent(in) :: atindx1(natom),indlmn(6,nlmn),cplex_dgxdt(ndgxdt),cplex_d2gxdt(nd2gxdt)
248 : : real(dp),intent(in) :: dgxdt(cplex,ndgxdt,nprojs,nspinor,ndat)
249 : : real(dp),intent(in) :: d2gxdt(cplex,nd2gxdt,nlmn,nincat,nspinor,ndat)
250 : : real(dp),intent(in),target :: enl(dimenl1,dimenl2,nspinortot**2,ndat_enl,dimekbq)
251 : : real(dp),intent(inout) :: gx(cplex,nprojs,nspinor,ndat)
252 : : real(dp),intent(in) :: sij(:)
253 : : real(dp),intent(out),target :: dgxdtfac(cplex_fac,ndgxdtfac,nprojs,nspinor,ndat)
254 : : real(dp),intent(out) :: dgxdtfac_sij(cplex,ndgxdtfac,nprojs,nspinor,ndat*(paw_opt/3))
255 : : real(dp),intent(out),target :: d2gxdtfac(cplex_fac,nd2gxdtfac,nprojs,nspinor,ndat)
256 : : real(dp),intent(out) :: d2gxdtfac_sij(cplex,nd2gxdtfac,nprojs,nspinor,ndat*(paw_opt/3))
257 : : real(dp),intent(out),target :: gxfac(cplex_fac,nprojs,nspinor,ndat)
258 : : real(dp),intent(out) :: gxfac_sij(cplex,nprojs,nspinor,ndat)
259 : :
260 : : !Local variables-------------------------------
261 : : !Arrays
262 : : !scalars
263 : : integer :: cplex_,ia,ijlmn,ilm,ilmn,i0lmn,iln,index_enl,iphase,ispinor,ispinor_index,idat
264 : : integer :: jlm,j0lmn,jjlmn,jlmn,jspinor,mu,shift,ii
265 : : integer :: ll_so,klm_so,lmax_so,nlmso,sign_so
266 : : real(dp) :: ekb_so_1,ekb_so_2,ls_uu_im,ls_ud_re,ls_ud_im
267 : : !arrays
268 : 36992 : real(dp) :: enl_(2),gxfi(2),gxi(cplex),gxj(cplex)
269 : 18496 : real(dp), contiguous, pointer :: d2gxdtfac_(:,:,:,:,:),dgxdtfac_(:,:,:,:,:),gxfac_(:,:,:,:)
270 : 18496 : real(dp), contiguous, pointer :: enl_ptr(:,:,:),enl_ptr2(:,:,:,:)
271 : 18496 : real(dp), allocatable :: ls_ylm_so(:,:,:)
272 : :
273 : : ! *************************************************************************
274 : :
275 [ # # ]: 0 : if (gpu_option/=ABI_GPU_DISABLED.and.mpi_enreg%paral_spinor==1) then
276 : 0 : ABI_ERROR('parallelization over spinors (npspinor=2) not allowed with GPU!')
277 : : end if
278 : :
279 : : ABI_UNUSED(iend)
280 : : ABI_UNUSED(d2gxdt)
281 : : ABI_UNUSED(cplex_d2gxdt)
282 : : ABI_UNUSED(d2gxdtfac_sij)
283 : : DBG_ENTER("COLL")
284 : :
285 : : !Parallelization over spinors treatment
286 [ - + ]: 18496 : shift=0;if (mpi_enreg%paral_spinor==1) shift=mpi_enreg%me_spinor
287 : : !When Enl factors contain a exp(-iqR) phase:
288 : : ! - We loop over the real and imaginary parts
289 : : ! - We need an additional memory space
290 [ + + ]: 36992 : do iphase=1,dimekbq
291 [ + - ]: 18496 : if (paw_opt==3) cycle
292 [ + - ]: 18496 : if (iphase==1) then
293 : 18496 : gxfac_ => gxfac ; dgxdtfac_ => dgxdtfac ; d2gxdtfac_ => d2gxdtfac
294 : : else
295 [ # # ]: 0 : ABI_CHECK(cplex_fac==2,"BUG: invalid cplex_fac==1 when dimekbq=2!")
296 : 0 : call alloc_work_arrays(optder,cplex_fac,ndgxdtfac,nd2gxdtfac,nprojs,nspinor,ndat,gpu_option)
297 : 0 : gxfac_ => gxfac_2ndphase
298 [ # # ]: 0 : if(optder>=1) dgxdtfac_ => dgxdtfac_2ndphase
299 [ # # ]: 0 : if(optder>=2) d2gxdtfac_ => d2gxdtfac_2ndphase
300 : : end if
301 : 18496 : enl_ptr => enl(:,:,:,1,iphase)
302 : 18496 : enl_ptr2 => enl(:,:,:,:,iphase)
303 : :
304 : : !NC+SO: precompute L.S matrix once
305 : 18496 : lmax_so = 0
306 [ + + - + : 18496 : if (paw_opt==0.and.nspinortot==2.and.nspinor==nspinortot) then
- - ]
307 [ # # # # : 0 : if (any(indlmn(6,1:nlmn)==2)) then
# # ]
308 [ # # ]: 0 : do ilmn=1,nlmn
309 [ # # ]: 0 : if (indlmn(6,ilmn)==2) lmax_so = max(lmax_so, indlmn(1,ilmn))
310 : : end do
311 [ # # ]: 0 : if (lmax_so > 0) then
312 : 0 : nlmso = (lmax_so+1)**2*((lmax_so+1)**2+1)/2
313 [ # # # # : 0 : ABI_MALLOC(ls_ylm_so,(2,nlmso,2))
# # # # #
# # # #
# ]
314 : 0 : call ls_ylm(ls_ylm_so, lmax_so)
315 : : #ifdef HAVE_OPENMP_OFFLOAD
316 : : if(gpu_option==ABI_GPU_OPENMP) call ompgpu_enter_map_to(ls_ylm_so)
317 : : #endif
318 : : end if
319 : : end if
320 : : end if
321 [ + + - + : 18496 : if (paw_opt==0.and.mpi_enreg%paral_spinor==1.and.lmax_so>0) then
- - ]
322 : 0 : ABI_ERROR('parallelization over spinors, spin-orbit and norm-conserving psps not implemented!')
323 : : end if
324 : :
325 : :
326 : : !Accumulate gxfac related to non-local operator (Norm-conserving)
327 : : !-------------------------------------------------------------------
328 [ + + ]: 18496 : if (paw_opt==0) then
329 : :
330 : : !Enl is E(Kleinman-Bylander)
331 [ - + ]: 3200 : ABI_CHECK(cplex_enl/=2,"BUG: invalid cplex_enl=2!")
332 [ - + ]: 3200 : ABI_CHECK(cplex_fac==cplex,"BUG: invalid cplex_fac/=cplex!")
333 : :
334 [ - + ]: 3200 : if (lmax_so == 0) then
335 : :
336 : : ! NC+SR ---
337 : : #ifdef HAVE_OPENMP_OFFLOAD
338 : : !$OMP TARGET TEAMS DISTRIBUTE &
339 : : !$OMP& MAP(to:gxfac_,gx,enl_ptr2,indlmn) &
340 : : !$OMP& PRIVATE(idat,ispinor) &
341 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
342 : : #endif
343 [ + + ]: 39552 : do idat=1,ndat
344 [ + + ]: 75904 : do ispinor=1,nspinor
345 : : !$OMP PARALLEL DO COLLAPSE(3) PRIVATE(ia,ilmn,iln,ii)
346 [ + + ]: 236288 : do ia=1,nincat
347 [ + + ]: 2599168 : do ilmn=1,nlmn
348 [ + + ]: 6761472 : do ii=1,cplex
349 [ - + ]: 6597888 : if (indlmn(6,ilmn)==2) then
350 : 0 : gxfac_(ii,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat) = zero
351 : : else
352 : 4198656 : iln = indlmn(5,ilmn)
353 : : gxfac_(ii,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
354 : 4198656 : & enl_ptr2(iln,itypat,ispinor+shift,min(ndat_enl,idat))*gx(ii,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
355 : : end if
356 : : end do
357 : : end do
358 : : end do
359 : : end do
360 : : end do
361 : :
362 : : else
363 : :
364 : : ! NC+SR+SO: real-Ylm L.S coupling ---
365 : : #ifdef HAVE_OPENMP_OFFLOAD
366 : : !$OMP TARGET TEAMS DISTRIBUTE &
367 : : !$OMP& MAP(to:gxfac_,gx,enl_ptr2,indlmn,ls_ylm_so) &
368 : : !$OMP& PRIVATE(idat) &
369 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
370 : : #endif
371 [ # # ]: 0 : do idat=1,ndat
372 : : !$OMP PARALLEL DO COLLAPSE(2) &
373 : : !$OMP& PRIVATE(ia,ilmn,iln,ekb_so_1,ekb_so_2,ll_so,ilm,jlmn,jlm,klm_so,sign_so,ls_uu_im,ls_ud_re,ls_ud_im)
374 [ # # ]: 0 : do ia=1,nincat
375 [ # # ]: 0 : do ilmn=1,nlmn
376 : 0 : iln = indlmn(5,ilmn)
377 : :
378 [ # # ]: 0 : if (indlmn(6,ilmn)/=2) then
379 : 0 : ekb_so_1 = enl_ptr2(iln,itypat,1,min(ndat_enl,idat))
380 : 0 : ekb_so_2 = enl_ptr2(iln,itypat,2,min(ndat_enl,idat))
381 : 0 : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat)=ekb_so_1*gx(1,ilmn+(ia-1)*nlmn+ibeg,1,idat)
382 : 0 : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat)=ekb_so_1*gx(2,ilmn+(ia-1)*nlmn+ibeg,1,idat)
383 : 0 : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,2,idat)=ekb_so_2*gx(1,ilmn+(ia-1)*nlmn+ibeg,2,idat)
384 : 0 : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,2,idat)=ekb_so_2*gx(2,ilmn+(ia-1)*nlmn+ibeg,2,idat)
385 : :
386 : : else
387 : 0 : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat) = zero
388 : 0 : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat) = zero
389 : 0 : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,2,idat) = zero
390 : 0 : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,2,idat) = zero
391 : :
392 : 0 : ekb_so_1 = enl_ptr2(iln,itypat,1,min(ndat_enl,idat))
393 [ # # ]: 0 : if (abs(ekb_so_1)<tol16) cycle
394 : 0 : ll_so = indlmn(1,ilmn)
395 : 0 : ilm = indlmn(4,ilmn)
396 [ # # ]: 0 : do jlmn=1,nlmn
397 [ # # ]: 0 : if (indlmn(6,jlmn)/=2) cycle
398 [ # # ]: 0 : if (indlmn(1,jlmn)/=ll_so) cycle
399 [ # # ]: 0 : if (indlmn(3,jlmn)/=indlmn(3,ilmn)) cycle
400 : 0 : jlm = indlmn(4,jlmn)
401 [ # # ]: 0 : if (ilm<=jlm) then
402 : 0 : klm_so = jlm*(jlm-1)/2 + ilm
403 : 0 : sign_so = 1
404 : : else
405 : 0 : klm_so = ilm*(ilm-1)/2 + jlm
406 : 0 : sign_so = -1
407 : : end if
408 : 0 : ls_uu_im = sign_so * ls_ylm_so(2,klm_so,1)
409 : 0 : ls_ud_re = sign_so * ls_ylm_so(1,klm_so,2)
410 : 0 : ls_ud_im = sign_so * ls_ylm_so(2,klm_so,2)
411 : :
412 : : ! up-up
413 : : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
414 : 0 : & - ekb_so_1*ls_uu_im*gx(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)
415 : : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
416 : 0 : & + ekb_so_1*ls_uu_im*gx(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)
417 : : ! up-dn
418 : : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
419 : 0 : & + ekb_so_1*(ls_ud_re*gx(1,jlmn+(ia-1)*nlmn+ibeg,2,idat) - ls_ud_im*gx(2,jlmn+(ia-1)*nlmn+ibeg,2,idat))
420 : : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
421 : 0 : & + ekb_so_1*(ls_ud_re*gx(2,jlmn+(ia-1)*nlmn+ibeg,2,idat) + ls_ud_im*gx(1,jlmn+(ia-1)*nlmn+ibeg,2,idat))
422 : : ! dn-up
423 : : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,2,idat)=gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
424 : 0 : & + ekb_so_1*(-ls_ud_re*gx(1,jlmn+(ia-1)*nlmn+ibeg,1,idat) - ls_ud_im*gx(2,jlmn+(ia-1)*nlmn+ibeg,1,idat))
425 : : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,2,idat)=gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
426 : 0 : & + ekb_so_1*(-ls_ud_re*gx(2,jlmn+(ia-1)*nlmn+ibeg,1,idat) + ls_ud_im*gx(1,jlmn+(ia-1)*nlmn+ibeg,1,idat))
427 : : ! dn-dn
428 : : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,2,idat)=gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
429 : 0 : & + ekb_so_1*ls_uu_im*gx(2,jlmn+(ia-1)*nlmn+ibeg,2,idat)
430 : : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,2,idat)=gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
431 : 0 : & - ekb_so_1*ls_uu_im*gx(1,jlmn+(ia-1)*nlmn+ibeg,2,idat)
432 : : end do ! jlmn
433 : : end if ! indlmn(:,6)==2
434 : : end do ! ilmn
435 : : end do ! ia
436 : : !$OMP END PARALLEL DO
437 : :
438 : : end do ! idat
439 : : end if ! NC+SO
440 : : end if ! NC
441 : :
442 : : !Accumulate gxfac related to nonlocal operator (PAW)
443 : : !-------------------------------------------------------------------
444 [ + + ]: 18496 : if (paw_opt==1.or.paw_opt==2.or.paw_opt==4) then
445 : : !Enl is psp strength Dij or (Dij-lambda.Sij)
446 : :
447 : : ! === Diagonal term(s) (up-up, down-down)
448 : :
449 : : ! 1-Enl is real
450 [ + - ]: 15296 : if (cplex_enl==1) then
451 [ + + ]: 15296 : if (paw_opt==2) then
452 : : #ifdef HAVE_OPENMP_OFFLOAD
453 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
454 : : !$OMP& MAP(to:gxfac_,enl_ptr2,atindx1,gx,sij,lambda) &
455 : : !$OMP& PRIVATE(idat,ispinor) &
456 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
457 : : #endif
458 [ + + ]: 1576 : do idat=1,ndat
459 [ + + ]: 2568 : do ispinor=1,nspinor
460 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,ispinor_index,index_enl,j0lmn,i0lmn,ii)
461 [ + + ]: 3520 : do ia=1,nincat
462 [ + + ]: 19296 : do jlmn=1,nlmn
463 : 16768 : ispinor_index=ispinor+shift
464 : 16768 : index_enl=atindx1(iatm+ia)
465 : 16768 : j0lmn=jlmn*(jlmn-1)/2
466 [ + + ]: 46256 : do ii=1,cplex
467 : : gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
468 : : & gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat) + &
469 : : & (enl_ptr2(j0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat))-lambda(idat) * sij(j0lmn+jlmn)) * &
470 : 46256 : & gx(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
471 : : end do
472 [ + + ]: 115776 : do ilmn=1,jlmn-1
473 [ + + ]: 284504 : do ii=1,cplex
474 : : gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
475 : : & gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat) + &
476 : : & (enl_ptr2(j0lmn+ilmn,index_enl,ispinor_index,min(ndat_enl,idat))-lambda(idat) * sij(j0lmn+ilmn)) * &
477 : 267736 : & gx(ii,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
478 : : end do
479 : : end do
480 [ + + ]: 18304 : if(jlmn<nlmn) then
481 [ + + ]: 114240 : do ilmn=jlmn+1,nlmn
482 : 99008 : i0lmn=(ilmn*(ilmn-1)/2)
483 [ + + ]: 282968 : do ii=1,cplex
484 : : gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
485 : : & gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat) + &
486 : : & (enl_ptr2(i0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat))-lambda(idat) * sij(i0lmn+jlmn)) *&
487 : 267736 : & gx(ii,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
488 : : end do
489 : : end do
490 : : end if
491 : : end do
492 : : end do
493 : : end do
494 : : end do
495 : :
496 : : else
497 : : #ifdef HAVE_OPENMP_OFFLOAD
498 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
499 : : !$OMP& MAP(to:enl_ptr2,atindx1,gx,gxfac_) &
500 : : !$OMP& PRIVATE(idat,ispinor) &
501 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
502 : : #endif
503 [ + + ]: 47206 : do idat=1,ndat
504 [ + + ]: 79700 : do ispinor=1,nspinor
505 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(jlmn,j0lmn,ii,ia,ispinor_index,index_enl)
506 [ + + ]: 107874 : do ia=1,nincat
507 [ + + ]: 639488 : do jlmn=1,nlmn
508 : 564108 : ispinor_index=ispinor+shift
509 : 564108 : index_enl=atindx1(iatm+ia)
510 : 564108 : j0lmn=jlmn*(jlmn-1)/2
511 [ + + ]: 1559602 : do ii=1,cplex
512 : : gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
513 : : & gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat) + &
514 : : & enl_ptr2(j0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat)) * &
515 : 1516716 : & gx(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat)
516 : : end do
517 : : end do
518 : : end do
519 : : end do
520 : : end do
521 : :
522 : : #ifdef HAVE_OPENMP_OFFLOAD
523 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(3) &
524 : : !$OMP& MAP(to:enl_ptr2,atindx1,gx,gxfac_) &
525 : : !$OMP& PRIVATE(idat,ispinor,ia,ispinor_index,index_enl) &
526 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
527 : : #endif
528 [ + + ]: 47206 : do idat=1,ndat
529 [ + + ]: 79700 : do ispinor=1,nspinor
530 [ + + ]: 107874 : do ia=1,nincat
531 : 42886 : ispinor_index=ispinor+shift
532 : 42886 : index_enl=atindx1(iatm+ia)
533 : : !$OMP PARALLEL DO PRIVATE(j0lmn,jlmn,ilmn,i0lmn,ii)
534 [ + + ]: 639488 : do jlmn=1,nlmn
535 : 564108 : j0lmn=jlmn*(jlmn-1)/2
536 [ + + ]: 4527666 : do ilmn=1,jlmn-1
537 [ + + ]: 11094594 : do ii=1,cplex
538 : : gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat) + &
539 : 10530486 : & enl_ptr2(j0lmn+ilmn,index_enl,ispinor_index,min(ndat_enl,idat)) * gx(ii,ibeg+ilmn+(ia-1)*nlmn,ispinor,idat)
540 : : end do
541 : : end do
542 [ + + ]: 606994 : if(jlmn<nlmn) then
543 [ + + ]: 4484780 : do ilmn=jlmn+1,nlmn
544 : 3963558 : i0lmn=(ilmn*(ilmn-1)/2)
545 [ + + ]: 11051708 : do ii=1,cplex
546 : : gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(ii,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat) &
547 : : & + enl_ptr2(i0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat)) &
548 : 10530486 : & * gx(ii,ibeg+ilmn+(ia-1)*nlmn,ispinor,idat)
549 : : end do
550 : : end do
551 : : end if
552 : : end do
553 : : end do
554 : : end do
555 : : end do
556 : : endif
557 : :
558 : :
559 : : ! 2-Enl is complex ===== D^ss'_ij=D^s's_ji^*
560 : : else
561 [ # # ]: 0 : ABI_CHECK(cplex_fac==cplex_enl,"BUG: invalid cplex_fac/=cplex_enl!")
562 : :
563 [ # # ]: 0 : if (nspinortot==1) then ! -------------> NO SPINORS
564 [ # # ]: 0 : if(paw_opt==2) then
565 : : #ifdef HAVE_OPENMP_OFFLOAD
566 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
567 : : !$OMP& MAP(to:gxfac_,gx,gxi,atindx1,gxj,sij,enl_ptr2,lambda) &
568 : : !$OMP& PRIVATE(idat,ia) &
569 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
570 : : #endif
571 [ # # ]: 0 : do idat=1,ndat
572 [ # # ]: 0 : do ia=1,nincat
573 : : !$OMP PARALLEL DO PRIVATE(index_enl,jlmn,j0lmn,enl_,gxj,ilmn,i0lmn,gxi)
574 [ # # ]: 0 : do jlmn=1,nlmn
575 : 0 : index_enl=atindx1(iatm+ia)
576 : 0 : j0lmn=jlmn*(jlmn-1)/2
577 : 0 : enl_(1)=enl_ptr2(2*j0lmn+jlmn-1,index_enl,1,min(ndat_enl,idat))-lambda(idat)*sij(j0lmn+jlmn)
578 : 0 : gxj(1 )=gx(1 ,jlmn+(ia-1)*nlmn+ibeg,1,idat)
579 : 0 : gxj(cplex)=gx(cplex,jlmn+(ia-1)*nlmn+ibeg,1,idat)
580 : : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
581 : 0 : & gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(1)
582 [ # # ]: 0 : if (cplex==2) then
583 : : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
584 : 0 : & gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(2)
585 : : end if
586 [ # # ]: 0 : do ilmn=1,jlmn-1
587 : 0 : enl_(1)=enl_ptr2(2*j0lmn+ilmn-1,index_enl,1,min(ndat_enl,idat))
588 : 0 : enl_(2)=enl_ptr2(2*j0lmn+ilmn ,index_enl,1,min(ndat_enl,idat))
589 : 0 : enl_(1)=enl_(1)-lambda(idat)*sij(j0lmn+ilmn)
590 : 0 : gxi(1 )=gx(1 ,ilmn+(ia-1)*nlmn+ibeg,1,idat)
591 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,1,idat)
592 : : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
593 : 0 : & gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(1)
594 : : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
595 : 0 : & gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxi(1)
596 : : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat) = &
597 : 0 : & gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(1)
598 : : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat) = &
599 : 0 : & gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxj(1)
600 [ # # ]: 0 : if (cplex==2) then
601 : : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
602 : 0 : & gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxi(2)
603 : : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
604 : 0 : & gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(2)
605 : : gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat) = &
606 : 0 : & gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxj(2)
607 : : gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat) = &
608 : 0 : & gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(2)
609 : : end if
610 : : end do
611 [ # # ]: 0 : if(jlmn<nlmn) then
612 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
613 : 0 : i0lmn=ilmn*(ilmn-1)/2
614 : 0 : enl_(1)=enl_ptr2(2*i0lmn+jlmn-1,index_enl,1,min(ndat_enl,idat))
615 : 0 : enl_(2)=enl_ptr2(2*i0lmn+jlmn ,index_enl,1,min(ndat_enl,idat))
616 : 0 : enl_(1)=enl_(1)-lambda(idat)*sij(i0lmn+jlmn)
617 : 0 : gxi(1 )=gx(1 ,ilmn+(ia-1)*nlmn+ibeg,1,idat)
618 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,1,idat)
619 : : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
620 : 0 : & gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(1)
621 : : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)= &
622 : 0 : & gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxi(1)
623 [ # # ]: 0 : if (cplex==2) then
624 : : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
625 : 0 : & gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxi(2)
626 : : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat) = &
627 : 0 : & gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(2)
628 : : end if
629 : : end do
630 : : end if
631 : : end do
632 : : end do
633 : : end do
634 : : else
635 : : #ifdef HAVE_OPENMP_OFFLOAD
636 : : !$OMP TARGET TEAMS DISTRIBUTE &
637 : : !$OMP& MAP(to:gxfac_,gx,gxi,atindx1,gxj,enl_ptr2) &
638 : : !$OMP& PRIVATE(idat) &
639 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
640 : : #endif
641 [ # # ]: 0 : do idat=1,ndat
642 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,index_enl,jlmn,j0lmn,enl_,gxj,ilmn,i0lmn,jjlmn,ijlmn,gxi)
643 [ # # ]: 0 : do ia=1,nincat
644 [ # # ]: 0 : do jlmn=1,nlmn
645 : 0 : index_enl=atindx1(iatm+ia)
646 : 0 : j0lmn=jlmn*(jlmn-1)/2
647 : 0 : jjlmn=j0lmn+jlmn
648 : 0 : enl_(1)=enl_ptr2(2*jjlmn-1,index_enl,1,min(ndat_enl,idat))
649 : 0 : gxj(1 )=gx(1 ,jlmn+(ia-1)*nlmn+ibeg,1,idat)
650 : 0 : gxj(cplex)=gx(cplex,jlmn+(ia-1)*nlmn+ibeg,1,idat)
651 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(1)
652 [ # # ]: 0 : if (cplex==2) gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(2)
653 [ # # ]: 0 : do ilmn=1,jlmn-1
654 : 0 : ijlmn=j0lmn+ilmn
655 : 0 : enl_(1)=enl_ptr2(2*ijlmn-1,index_enl,1,min(ndat_enl,idat))
656 : 0 : enl_(2)=enl_ptr2(2*ijlmn ,index_enl,1,min(ndat_enl,idat))
657 : 0 : gxi(1 )=gx(1 ,ilmn+(ia-1)*nlmn+ibeg,1,idat)
658 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,1,idat)
659 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(1)
660 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxi(1)
661 [ # # ]: 0 : if (cplex==2) then
662 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxi(2)
663 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(2)
664 : : end if
665 : : end do
666 [ # # ]: 0 : if(jlmn<nlmn) then
667 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
668 : 0 : i0lmn=ilmn*(ilmn-1)/2
669 : 0 : ijlmn=i0lmn+jlmn
670 : 0 : enl_(1)=enl_ptr2(2*ijlmn-1,index_enl,1,min(ndat_enl,idat))
671 : 0 : enl_(2)=enl_ptr2(2*ijlmn ,index_enl,1,min(ndat_enl,idat))
672 : 0 : gxi(1 )=gx(1 ,ilmn+(ia-1)*nlmn+ibeg,1,idat)
673 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,1,idat)
674 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(1)
675 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxi(1)
676 [ # # ]: 0 : if (cplex==2) then
677 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxi(2)
678 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxi(2)
679 : : end if
680 : : end do
681 : : end if
682 : : end do
683 : : end do
684 : : end do
685 : : end if
686 : :
687 : : else ! -------------> SPINORIAL CASE
688 : :
689 : : ! === Diagonal term(s) (up-up, down-down)
690 : :
691 : : #ifdef HAVE_OPENMP_OFFLOAD
692 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
693 : : !$OMP& MAP(to:gxfac_,gx,enl_ptr,atindx1,sij) PRIVATE(idat,ispinor) &
694 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
695 : : #endif
696 [ # # ]: 0 : do idat=1,ndat
697 [ # # ]: 0 : do ispinor=1,nspinor
698 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,ispinor_index,index_enl,j0lmn,jjlmn,i0lmn,ijlmn,gxi,gxj,enl_)
699 [ # # ]: 0 : do ia=1,nincat
700 [ # # ]: 0 : do jlmn=1,nlmn
701 : 0 : ispinor_index=ispinor+shift
702 : 0 : index_enl=atindx1(iatm+ia)
703 : 0 : j0lmn=jlmn*(jlmn-1)/2
704 : 0 : jjlmn=j0lmn+jlmn
705 : 0 : enl_(1)=enl_ptr(2*jjlmn-1,index_enl,ispinor_index)
706 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(jjlmn)
707 : 0 : gxj(1) =gx(1 ,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
708 : 0 : gxj(cplex)=gx(cplex,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
709 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxj(1)
710 [ # # ]: 0 : if (cplex==2) then
711 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxj(2)
712 : : end if
713 [ # # ]: 0 : do ilmn=1,jlmn-1
714 : 0 : ijlmn=j0lmn+ilmn
715 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,ispinor_index)
716 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,ispinor_index)
717 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(ijlmn)
718 : 0 : gxi(1) =gx(1 ,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
719 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
720 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxi(1)
721 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)-enl_(2)*gxi(1)
722 [ # # ]: 0 : if (cplex==2) then
723 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(2)*gxi(2)
724 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxi(2)
725 : : end if
726 : : end do
727 : : end do
728 : : end do
729 : : end do
730 : : end do
731 : : #ifdef HAVE_OPENMP_OFFLOAD
732 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
733 : : !$OMP& MAP(to:gxfac_,gx,enl_ptr,atindx1) PRIVATE(idat,ispinor) &
734 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
735 : : #endif
736 [ # # ]: 0 : do idat=1,ndat
737 [ # # ]: 0 : do ispinor=1,nspinor
738 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,ilmn,ispinor_index,index_enl,i0lmn,ijlmn,gxi,gxj,enl_)
739 [ # # ]: 0 : do ia=1,nincat
740 [ # # ]: 0 : do jlmn=1,nlmn-1
741 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
742 : 0 : ispinor_index=ispinor+shift
743 : 0 : index_enl=atindx1(iatm+ia)
744 : 0 : i0lmn=ilmn*(ilmn-1)/2
745 : 0 : ijlmn=i0lmn+jlmn
746 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,ispinor_index)
747 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,ispinor_index)
748 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(ijlmn)
749 : 0 : gxi(1) =gx(1 ,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
750 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
751 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxi(1)
752 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(2)*gxi(1)
753 [ # # ]: 0 : if (cplex==2) then
754 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)-enl_(2)*gxi(2)
755 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxi(2)
756 : : end if
757 : : end do
758 : : end do
759 : : end do
760 : : end do
761 : : end do
762 : : end if !nspinortot
763 : : end if !complex_enl
764 : :
765 : : ! === Off-diagonal term(s) (up-down, down-up)
766 : :
767 : : ! --- No parallelization over spinors ---
768 [ - + - - ]: 15296 : if (nspinortot==2.and.nspinor==nspinortot) then
769 [ # # ]: 0 : ABI_CHECK(cplex_enl==2,"BUG: invalid cplex_enl/=2!")
770 [ # # ]: 0 : ABI_CHECK(cplex_fac==cplex,"BUG: invalid cplex_fac/=cplex)!")
771 : : #ifdef HAVE_OPENMP_OFFLOAD
772 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
773 : : !$OMP& MAP(to:gxfac_,gx,enl_ptr,atindx1) PRIVATE(idat,ispinor) &
774 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
775 : : #endif
776 [ # # ]: 0 : do idat=1,ndat
777 [ # # ]: 0 : do ispinor=1,nspinortot
778 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,jspinor,index_enl,j0lmn,jjlmn,i0lmn,ijlmn,gxi,enl_)
779 [ # # ]: 0 : do ia=1,nincat
780 [ # # ]: 0 : do jlmn=1,nlmn
781 : 0 : jspinor=3-ispinor
782 : 0 : index_enl=atindx1(iatm+ia)
783 : 0 : j0lmn=jlmn*(jlmn-1)/2
784 : 0 : jjlmn=j0lmn+jlmn
785 : 0 : enl_(1)=enl_ptr(2*jjlmn-1,index_enl,2+ispinor )
786 : 0 : enl_(2)=enl_ptr(2*jjlmn ,index_enl,2+ispinor )
787 : 0 : gxi(1) =gx(1 ,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
788 : 0 : gxi(cplex)=gx(cplex,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
789 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxi(1)
790 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)-enl_(2)*gxi(1)
791 [ # # ]: 0 : if (cplex==2) then
792 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(2)*gxi(2)
793 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxi(2)
794 : : end if
795 [ # # ]: 0 : do ilmn=1,jlmn-1
796 : 0 : j0lmn=jlmn*(jlmn-1)/2
797 : 0 : ijlmn=j0lmn+ilmn
798 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,2+ispinor)
799 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,2+ispinor)
800 : 0 : gxi(1) =gx(1 ,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
801 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
802 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxi(1)
803 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)-enl_(2)*gxi(1)
804 [ # # ]: 0 : if (cplex==2) then
805 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(2)*gxi(2)
806 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxi(2)
807 : : end if
808 : : end do
809 : : end do
810 : : end do
811 : : end do
812 : : end do
813 : : #ifdef HAVE_OPENMP_OFFLOAD
814 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
815 : : !$OMP& MAP(to:gxfac_,gx,enl_ptr,atindx1) PRIVATE(idat,ispinor) &
816 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
817 : : #endif
818 [ # # ]: 0 : do idat=1,ndat
819 [ # # ]: 0 : do ispinor=1,nspinortot
820 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,ilmn,jspinor,index_enl,i0lmn,ijlmn,gxi,enl_)
821 [ # # ]: 0 : do ia=1,nincat
822 [ # # ]: 0 : do jlmn=1,nlmn-1
823 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
824 : 0 : jspinor=3-ispinor
825 : 0 : index_enl=atindx1(iatm+ia)
826 : 0 : i0lmn=ilmn*(ilmn-1)/2
827 : 0 : ijlmn=i0lmn+jlmn
828 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,2+ispinor)
829 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,2+ispinor)
830 : 0 : gxi(1) =gx(1 ,ilmn+(ia-1)*nlmn+ibeg,jspinor,idat)
831 : 0 : gxi(cplex)=gx(cplex,ilmn+(ia-1)*nlmn+ibeg,jspinor,idat)
832 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxi(1)
833 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(2)*gxi(1)
834 [ # # ]: 0 : if (cplex==2) then
835 : 0 : gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(1,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)-enl_(2)*gxi(2)
836 : 0 : gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=gxfac_(2,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxi(2)
837 : : end if
838 : : end do
839 : : end do
840 : : end do
841 : : end do
842 : : end do
843 : :
844 : : ! --- Parallelization over spinors ---
845 [ - + - - ]: 15296 : else if (nspinortot==2.and.nspinor/=nspinortot) then
846 : 0 : ABI_BUG("npspinor==2 not supported with OpenMP GPU")
847 : : end if
848 : :
849 : : end if !paw_opt
850 : :
851 : :
852 : : !Accumulate dgxdtfac related to nonlocal operator (Norm-conserving)
853 : : !-------------------------------------------------------------------
854 [ - + - - ]: 18496 : if (optder>=1.and.paw_opt==0) then
855 : : !Enl is E(Kleinman-Bylander)
856 [ # # ]: 0 : ABI_CHECK(cplex_enl==1,"BUG: invalid cplex_enl/=1!")
857 [ # # ]: 0 : ABI_CHECK(cplex_fac==cplex,"BUG: invalid cplex_fac/=cplex!")
858 : :
859 [ # # ]: 0 : if (lmax_so == 0) then
860 : :
861 : : ! NC+SR ---
862 : : #ifdef HAVE_OPENMP_OFFLOAD
863 : : !$OMP TARGET TEAMS DISTRIBUTE &
864 : : !$OMP& MAP(to:dgxdtfac_,dgxdt,enl_ptr2,indlmn) &
865 : : !$OMP& PRIVATE(idat,ispinor,ispinor_index) &
866 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
867 : : #endif
868 [ # # ]: 0 : do idat=1,ndat
869 [ # # ]: 0 : do ispinor=1,nspinor
870 : 0 : ispinor_index = ispinor + shift
871 : : !$OMP PARALLEL DO COLLAPSE(3) PRIVATE(ia,ilmn,mu,ii)
872 [ # # ]: 0 : do ia=1,nincat
873 [ # # ]: 0 : do ilmn=1,nlmn
874 [ # # ]: 0 : do mu=1,ndgxdtfac
875 [ # # ]: 0 : do ii=1,cplex
876 [ # # ]: 0 : if (indlmn(6,ilmn)==2) then
877 : 0 : dgxdtfac_(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat) = zero
878 : : else
879 : : dgxdtfac_(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
880 : : & enl_ptr2(indlmn(5,ilmn),itypat,ispinor_index,min(ndat_enl,idat)) &
881 : 0 : & *dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
882 : : end if
883 : : end do
884 : : end do
885 : : end do
886 : : end do
887 : : end do
888 : : end do
889 : :
890 : : else
891 : :
892 : : ! NC+SR+SO: real-Ylm L.S coupling ---
893 : : #ifdef HAVE_OPENMP_OFFLOAD
894 : : !$OMP TARGET TEAMS DISTRIBUTE &
895 : : !$OMP& MAP(to:dgxdtfac_,dgxdt,enl_ptr2,indlmn,ls_ylm_so) &
896 : : !$OMP& PRIVATE(idat) &
897 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
898 : : #endif
899 [ # # ]: 0 : do idat=1,ndat
900 : : !$OMP PARALLEL DO COLLAPSE(2) &
901 : : !$OMP& PRIVATE(ia,ilmn,iln,ekb_so_1,ekb_so_2,ll_so,ilm,jlmn,jlm,klm_so,sign_so,ls_uu_im,ls_ud_re,ls_ud_im,mu)
902 [ # # ]: 0 : do ia=1,nincat
903 [ # # ]: 0 : do ilmn=1,nlmn
904 : 0 : iln = indlmn(5,ilmn)
905 : :
906 [ # # ]: 0 : if (indlmn(6,ilmn)/=2) then
907 : 0 : ekb_so_1 = enl_ptr2(iln,itypat,1,min(ndat_enl,idat))
908 : 0 : ekb_so_2 = enl_ptr2(iln,itypat,2,min(ndat_enl,idat))
909 [ # # ]: 0 : do mu=1,ndgxdtfac
910 : : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)= &
911 : 0 : & ekb_so_1*dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
912 : : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)= &
913 : 0 : & ekb_so_1*dgxdt(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
914 : : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)= &
915 : 0 : & ekb_so_2*dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)
916 : : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)= &
917 : 0 : & ekb_so_2*dgxdt(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)
918 : : end do
919 : :
920 : : else
921 : :
922 [ # # ]: 0 : do mu=1,ndgxdtfac
923 : 0 : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat) = zero
924 : 0 : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat) = zero
925 : 0 : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat) = zero
926 : 0 : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat) = zero
927 : : end do
928 : :
929 : 0 : ekb_so_1 = enl_ptr2(iln,itypat,1,min(ndat_enl,idat))
930 [ # # ]: 0 : if (abs(ekb_so_1)<tol16) cycle
931 : 0 : ll_so = indlmn(1,ilmn)
932 : 0 : ilm = indlmn(4,ilmn)
933 [ # # ]: 0 : do jlmn=1,nlmn
934 [ # # ]: 0 : if (indlmn(6,jlmn)/=2) cycle
935 [ # # ]: 0 : if (indlmn(1,jlmn)/=ll_so) cycle
936 [ # # ]: 0 : if (indlmn(3,jlmn)/=indlmn(3,ilmn)) cycle
937 : 0 : jlm = indlmn(4,jlmn)
938 [ # # ]: 0 : if (ilm<=jlm) then
939 : 0 : klm_so = jlm*(jlm-1)/2 + ilm
940 : 0 : sign_so = 1
941 : : else
942 : 0 : klm_so = ilm*(ilm-1)/2 + jlm
943 : 0 : sign_so = -1
944 : : end if
945 : 0 : ls_uu_im = sign_so * ls_ylm_so(2,klm_so,1)
946 : 0 : ls_ud_re = sign_so * ls_ylm_so(1,klm_so,2)
947 : 0 : ls_ud_im = sign_so * ls_ylm_so(2,klm_so,2)
948 : :
949 [ # # ]: 0 : do mu=1,ndgxdtfac
950 : : ! up-up
951 : : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
952 : 0 : & - ekb_so_1*ls_uu_im*dgxdt(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)
953 : : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
954 : 0 : & + ekb_so_1*ls_uu_im*dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)
955 : : ! up-dn
956 : : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
957 : 0 : & + ekb_so_1*(ls_ud_re*dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,2,idat) - ls_ud_im*dgxdt(2,mu,jlmn+(ia-1)*nlmn+ibeg,2,idat))
958 : : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat) &
959 : 0 : & + ekb_so_1*(ls_ud_re*dgxdt(2,mu,jlmn+(ia-1)*nlmn+ibeg,2,idat) + ls_ud_im*dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,2,idat))
960 : : ! dn-up
961 : : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)=dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
962 : 0 : & + ekb_so_1*(-ls_ud_re*dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat) - ls_ud_im*dgxdt(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat))
963 : : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)=dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
964 : 0 : & + ekb_so_1*(-ls_ud_re*dgxdt(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat) + ls_ud_im*dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat))
965 : : ! dn-dn
966 : : dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)=dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
967 : 0 : & + ekb_so_1*ls_uu_im*dgxdt(2,mu,jlmn+(ia-1)*nlmn+ibeg,2,idat)
968 : : dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat)=dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,2,idat) &
969 : 0 : & - ekb_so_1*ls_uu_im*dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,2,idat)
970 : : end do ! mu
971 : : end do ! jlmn
972 : : end if ! indlmn(:,6)==2
973 : : end do ! ilmn
974 : : end do ! ia
975 : : !$OMP END PARALLEL DO
976 : :
977 : : end do ! idat
978 : : end if ! NC+SO
979 : : end if ! NC
980 : :
981 [ - + ]: 18496 : if (lmax_so > 0) then
982 : : #ifdef HAVE_OPENMP_OFFLOAD
983 : : if(gpu_option==ABI_GPU_OPENMP) call ompgpu_exit_map_delete(ls_ylm_so)
984 : : #endif
985 [ # # ]: 0 : ABI_FREE(ls_ylm_so)
986 : : end if
987 : :
988 : : !Accumulate dgxdtfac related to nonlocal operator (PAW)
989 : : !-------------------------------------------------------------------
990 [ - + - - ]: 18496 : if (optder>=1.and.(paw_opt==1.or.paw_opt==2.or.paw_opt==4)) then
991 : : !Enl is psp strength Dij or (Dij-lambda.Sij)
992 : :
993 : : ! === Diagonal term(s) (up-up, down-down)
994 : :
995 : : ! 1-Enl is real
996 [ # # ]: 0 : if (cplex_enl==1) then
997 [ # # ]: 0 : if (paw_opt/=2) then
998 : : #ifdef HAVE_OPENMP_OFFLOAD
999 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(3) &
1000 : : !$OMP& MAP(to:dgxdtfac_,enl_ptr2,atindx1,dgxdt) &
1001 : : !$OMP& PRIVATE(idat,ispinor,ia) &
1002 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1003 : : #endif
1004 [ # # ]: 0 : do idat=1,ndat
1005 [ # # ]: 0 : do ispinor=1,nspinor
1006 [ # # ]: 0 : do ia=1,nincat
1007 : : !$OMP PARALLEL DO &
1008 : : !$OMP& PRIVATE(ispinor_index,index_enl,j0lmn,i0lmn,jlmn,ilmn,mu,ii)
1009 [ # # ]: 0 : do jlmn=1,nlmn
1010 : 0 : ispinor_index=ispinor+shift
1011 : 0 : index_enl=atindx1(iatm+ia)
1012 : 0 : j0lmn=jlmn*(jlmn-1)/2
1013 [ # # ]: 0 : do mu=1,ndgxdtfac
1014 [ # # ]: 0 : do ii=1,cplex
1015 : : dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1016 : : & dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1017 : : & + enl_ptr2(j0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat)) &
1018 : 0 : & * dgxdt(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1019 : : end do
1020 : : end do
1021 [ # # ]: 0 : do ilmn=1,jlmn-1
1022 [ # # ]: 0 : do mu=1,ndgxdtfac
1023 [ # # ]: 0 : do ii=1,cplex
1024 : : dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1025 : : & dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1026 : : & + enl_ptr2(j0lmn+ilmn,index_enl,ispinor_index,min(ndat_enl,idat)) &
1027 : 0 : & * dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1028 : : end do
1029 : : end do
1030 : : end do
1031 [ # # ]: 0 : if(jlmn<nlmn) then
1032 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
1033 [ # # ]: 0 : do mu=1,ndgxdtfac
1034 [ # # ]: 0 : do ii=1,cplex
1035 : 0 : i0lmn=ilmn*(ilmn-1)/2
1036 : : dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1037 : : & dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1038 : : & + enl_ptr2(i0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat)) &
1039 : 0 : & * dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1040 : : end do
1041 : : end do
1042 : : end do
1043 : : end if
1044 : : end do
1045 : : end do
1046 : : end do
1047 : : end do
1048 : : else
1049 : : #ifdef HAVE_OPENMP_OFFLOAD
1050 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1051 : : !$OMP& MAP(to:dgxdtfac_,enl_ptr2,atindx1,dgxdt,sij,lambda) &
1052 : : !$OMP& PRIVATE(idat,ispinor) &
1053 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1054 : : #endif
1055 [ # # ]: 0 : do idat=1,ndat
1056 [ # # ]: 0 : do ispinor=1,nspinor
1057 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ispinor_index,ia,index_enl,jlmn,j0lmn,ilmn,i0lmn,ii)
1058 [ # # ]: 0 : do ia=1,nincat
1059 [ # # ]: 0 : do jlmn=1,nlmn
1060 : 0 : ispinor_index=ispinor+shift
1061 : 0 : index_enl=atindx1(iatm+ia)
1062 : 0 : j0lmn=jlmn*(jlmn-1)/2
1063 [ # # ]: 0 : do mu=1,ndgxdtfac
1064 [ # # ]: 0 : do ii=1,cplex
1065 : : dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1066 : : & dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1067 : : & + (enl_ptr2(j0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat))-lambda(idat)*sij(j0lmn+jlmn)) &
1068 : 0 : & * dgxdt(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1069 : : end do
1070 : : end do
1071 [ # # ]: 0 : do ilmn=1,jlmn-1
1072 [ # # ]: 0 : do mu=1,ndgxdtfac
1073 [ # # ]: 0 : do ii=1,cplex
1074 : : dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1075 : : & dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1076 : : & + (enl_ptr2(j0lmn+ilmn,index_enl,ispinor_index,min(ndat_enl,idat))-lambda(idat)*sij(j0lmn+ilmn)) &
1077 : 0 : & * dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1078 : : end do
1079 : : end do
1080 : : end do
1081 [ # # ]: 0 : if(jlmn<nlmn) then
1082 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
1083 : 0 : i0lmn=ilmn*(ilmn-1)/2
1084 [ # # ]: 0 : do mu=1,ndgxdtfac
1085 [ # # ]: 0 : do ii=1,cplex
1086 : : dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1087 : : & dgxdtfac_(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1088 : : & + (enl_ptr2(i0lmn+jlmn,index_enl,ispinor_index,min(ndat_enl,idat))-lambda(idat)*sij(i0lmn+jlmn)) &
1089 : 0 : & * dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1090 : : end do
1091 : : end do
1092 : : end do
1093 : : end if
1094 : : end do
1095 : : end do
1096 : : end do
1097 : : end do
1098 : : end if
1099 : :
1100 : : ! 2-Enl is complex ===== D^ss'_ij=D^s's_ji^*
1101 : : else
1102 [ # # ]: 0 : ABI_CHECK(cplex_fac==cplex_enl,"BUG: invalid cplex_fac/=cplex_enl!")
1103 : :
1104 [ # # ]: 0 : if (nspinortot==1) then ! -------------> NO SPINORS
1105 : :
1106 : : #ifdef HAVE_OPENMP_OFFLOAD
1107 : : !$OMP TARGET TEAMS DISTRIBUTE &
1108 : : !$OMP& MAP(to:dgxdtfac_,enl_,atindx1,dgxdt,sij,lambda,enl_ptr2,gxfi,gxj) &
1109 : : !$OMP& PRIVATE(idat) &
1110 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1111 : : #endif
1112 [ # # ]: 0 : do idat=1,ndat
1113 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,index_enl,jlmn,j0lmn,jjlmn,ilmn,i0lmn,ijlmn,gxfi,gxj,mu,cplex_,enl_)
1114 [ # # ]: 0 : do ia=1,nincat
1115 [ # # ]: 0 : do jlmn=1,nlmn
1116 : 0 : index_enl=atindx1(iatm+ia)
1117 : 0 : j0lmn=jlmn*(jlmn-1)/2
1118 : 0 : jjlmn=j0lmn+jlmn
1119 : 0 : enl_(1)=enl_ptr2(2*jjlmn-1,index_enl,1,min(ndat_enl,idat))
1120 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(jjlmn)
1121 [ # # ]: 0 : do mu=1,ndgxdtfac
1122 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1123 : 0 : cplex_ = 2 ; gxj(1) = zero ; gxj(2) = dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)
1124 : : else
1125 : 0 : cplex_ = cplex ;
1126 : 0 : gxj(1 )=dgxdt(1 ,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)
1127 : 0 : gxj(cplex)=dgxdt(cplex,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)
1128 : : end if
1129 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(1)
1130 [ # # ]: 0 : if (cplex_==2) then
1131 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxj(2)
1132 : : end if
1133 : : end do
1134 [ # # ]: 0 : do ilmn=1,jlmn-1
1135 : 0 : ijlmn=j0lmn+ilmn
1136 : 0 : enl_(1)=enl_ptr2(2*ijlmn-1,index_enl,1,min(ndat_enl,idat))
1137 : 0 : enl_(2)=enl_ptr2(2*ijlmn ,index_enl,1,min(ndat_enl,idat))
1138 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(ijlmn)
1139 [ # # ]: 0 : do mu=1,ndgxdtfac
1140 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1141 : 0 : cplex_ = 2 ; gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
1142 : : else
1143 : 0 : cplex_ = cplex ;
1144 : 0 : gxfi(1 )=dgxdt(1 ,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
1145 : 0 : gxfi(cplex)=dgxdt(cplex,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
1146 : : end if
1147 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxfi(1)
1148 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxfi(1)
1149 [ # # ]: 0 : if (cplex_==2) then
1150 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxfi(2)
1151 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxfi(2)
1152 : : end if
1153 : : end do
1154 : : end do
1155 [ # # ]: 0 : if(jlmn<nlmn) then
1156 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
1157 : 0 : i0lmn=ilmn*(ilmn-1)/2
1158 : 0 : ijlmn=i0lmn+jlmn
1159 : 0 : enl_(1)=enl_ptr2(2*ijlmn-1,index_enl,1,min(ndat_enl,idat))
1160 : 0 : enl_(2)=enl_ptr2(2*ijlmn ,index_enl,1,min(ndat_enl,idat))
1161 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(ijlmn)
1162 [ # # ]: 0 : do mu=1,ndgxdtfac
1163 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1164 : 0 : cplex_ = 2 ; gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
1165 : : else
1166 : 0 : cplex_ = cplex ;
1167 : 0 : gxfi(1 )=dgxdt(1 ,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
1168 : 0 : gxfi(cplex)=dgxdt(cplex,mu,ilmn+(ia-1)*nlmn+ibeg,1,idat)
1169 : : end if
1170 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxfi(1)
1171 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(2)*gxfi(1)
1172 [ # # ]: 0 : if (cplex_==2) then
1173 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)-enl_(2)*gxfi(2)
1174 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,1,idat)+enl_(1)*gxfi(2)
1175 : : end if
1176 : : end do
1177 : : end do
1178 : : end if
1179 : : end do
1180 : : end do
1181 : : end do
1182 : : else ! -------------> SPINORIAL CASE
1183 : :
1184 : : ! === Diagonal term(s) (up-up, down-down)
1185 : :
1186 : : #ifdef HAVE_OPENMP_OFFLOAD
1187 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1188 : : !$OMP& MAP(to:atindx1,dgxdtfac_,enl_ptr,dgxdt,sij,lambda) PRIVATE(idat,ispinor) &
1189 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1190 : : #endif
1191 [ # # ]: 0 : do idat=1,ndat
1192 [ # # ]: 0 : do ispinor=1,nspinor
1193 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,ispinor_index,index_enl,j0lmn,jjlmn,ilmn,ijlmn,cplex_,enl_,gxj,gxfi)
1194 [ # # ]: 0 : do ia=1,nincat
1195 [ # # ]: 0 : do jlmn=1,nlmn
1196 : 0 : ispinor_index = ispinor + shift
1197 : 0 : index_enl=atindx1(iatm+ia)
1198 : 0 : j0lmn=jlmn*(jlmn-1)/2
1199 : 0 : jjlmn=j0lmn+jlmn
1200 : 0 : enl_(1)=enl_ptr(2*jjlmn-1,index_enl,ispinor_index)
1201 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(jjlmn)
1202 [ # # ]: 0 : do mu=1,ndgxdtfac
1203 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1204 : 0 : cplex_ = 2
1205 : 0 : gxj(1) = zero ; gxj(2) = dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1206 : : else
1207 : 0 : cplex_ = cplex
1208 : 0 : gxj(1 )=dgxdt(1 ,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1209 : 0 : gxj(cplex)=dgxdt(cplex,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1210 : : end if
1211 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxj(1)
1212 [ # # ]: 0 : if (cplex_==2) then
1213 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxj(2)
1214 : : end if
1215 : : end do
1216 [ # # ]: 0 : do ilmn=1,jlmn-1
1217 : 0 : ijlmn=j0lmn+ilmn
1218 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,ispinor_index)
1219 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,ispinor_index)
1220 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(ijlmn)
1221 [ # # ]: 0 : do mu=1,ndgxdtfac
1222 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1223 : 0 : cplex_ = 2 ; gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1224 : : else
1225 : 0 : cplex_ = cplex
1226 : 0 : gxfi(1) =dgxdt(1 ,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1227 : 0 : gxfi(cplex)=dgxdt(cplex,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1228 : : end if
1229 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxfi(1)
1230 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)-enl_(2)*gxfi(1)
1231 [ # # ]: 0 : if (cplex_==2) then
1232 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(2)*gxfi(2)
1233 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxfi(2)
1234 : : end if
1235 : : end do
1236 : : end do
1237 : : end do
1238 : : end do
1239 : : end do
1240 : : end do
1241 : : #ifdef HAVE_OPENMP_OFFLOAD
1242 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1243 : : !$OMP& MAP(to:atindx1,dgxdtfac_,enl_ptr,dgxdt,sij,lambda) PRIVATE(idat,ispinor) &
1244 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1245 : : #endif
1246 [ # # ]: 0 : do idat=1,ndat
1247 [ # # ]: 0 : do ispinor=1,nspinor
1248 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,ispinor_index,index_enl,i0lmn,ilmn,ijlmn,cplex_,enl_,gxfi)
1249 [ # # ]: 0 : do ia=1,nincat
1250 [ # # ]: 0 : do jlmn=1,nlmn-1
1251 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
1252 : 0 : ispinor_index = ispinor + shift
1253 : 0 : index_enl=atindx1(iatm+ia)
1254 : 0 : i0lmn=ilmn*(ilmn-1)/2
1255 : 0 : ijlmn=i0lmn+jlmn
1256 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,ispinor_index)
1257 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,ispinor_index)
1258 [ # # ]: 0 : if (paw_opt==2) enl_(1)=enl_(1)-lambda(idat)*sij(ijlmn)
1259 [ # # ]: 0 : do mu=1,ndgxdtfac
1260 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1261 : 0 : cplex_ = 2 ; gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1262 : : else
1263 : 0 : cplex_ = cplex ;
1264 : 0 : gxfi(1 )=dgxdt(1 ,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1265 : 0 : gxfi(cplex)=dgxdt(cplex,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1266 : : end if
1267 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxfi(1)
1268 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(2)*gxfi(1)
1269 [ # # ]: 0 : if (cplex_==2) then
1270 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)-enl_(2)*gxfi(2)
1271 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxfi(2)
1272 : : end if
1273 : : end do
1274 : : end do
1275 : : end do
1276 : : end do
1277 : : end do
1278 : : end do
1279 : : end if !nspinortot
1280 : : end if !complex
1281 : :
1282 : : ! === Off-diagonal term(s) (up-down, down-up)
1283 : :
1284 : : ! --- No parallelization over spinors ---
1285 [ # # # # ]: 0 : if (nspinortot==2.and.nspinor==nspinortot) then
1286 [ # # ]: 0 : ABI_CHECK(cplex_enl==2,"BUG: invalid cplex_enl/=2!")
1287 [ # # ]: 0 : ABI_CHECK(cplex_fac==2,"BUG: invalid cplex_fac/=2!")
1288 : : #ifdef HAVE_OPENMP_OFFLOAD
1289 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1290 : : !$OMP& MAP(to:atindx1,dgxdtfac_,enl_ptr,dgxdt) PRIVATE(idat,ispinor) &
1291 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1292 : : #endif
1293 [ # # ]: 0 : do idat=1,ndat
1294 [ # # ]: 0 : do ispinor=1,nspinor
1295 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,jspinor,index_enl,j0lmn,jjlmn,ilmn,ijlmn,cplex_,enl_,gxj,gxfi)
1296 [ # # ]: 0 : do ia=1,nincat
1297 [ # # ]: 0 : do jlmn=1,nlmn
1298 : 0 : jspinor=3-ispinor
1299 : 0 : index_enl=atindx1(iatm+ia)
1300 : 0 : j0lmn=jlmn*(jlmn-1)/2
1301 : 0 : jjlmn=j0lmn+jlmn
1302 : 0 : enl_(1)=enl_ptr(2*jjlmn-1,index_enl,2+ispinor)
1303 : 0 : enl_(2)=enl_ptr(2*jjlmn ,index_enl,2+ispinor)
1304 [ # # ]: 0 : do mu=1,ndgxdtfac
1305 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1306 : 0 : cplex_ = 2 ;
1307 : 0 : gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1308 : : else
1309 : 0 : cplex_ = cplex ;
1310 : 0 : gxfi(1) =dgxdt(1 ,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1311 : 0 : gxfi(cplex)=dgxdt(cplex,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1312 : : end if
1313 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxfi(1)
1314 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)-enl_(2)*gxfi(1)
1315 [ # # ]: 0 : if (cplex_==2) then
1316 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(2)*gxfi(2)
1317 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxfi(2)
1318 : : end if
1319 : : end do
1320 [ # # ]: 0 : do ilmn=1,jlmn-1
1321 : 0 : ijlmn=j0lmn+ilmn
1322 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,2+ispinor)
1323 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,2+ispinor)
1324 [ # # ]: 0 : do mu=1,ndgxdtfac
1325 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1326 : 0 : cplex_ = 2 ; gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1327 : : else
1328 : 0 : cplex_ = cplex
1329 : 0 : gxfi(1) =dgxdt(1 ,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1330 : 0 : gxfi(cplex)=dgxdt(cplex,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1331 : : end if
1332 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxfi(1)
1333 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)-enl_(2)*gxfi(1)
1334 [ # # ]: 0 : if (cplex_==2) then
1335 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(2)*gxfi(2)
1336 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,jspinor,idat)+enl_(1)*gxfi(2)
1337 : : end if
1338 : : end do !mu
1339 : : end do !ilmn
1340 : : end do !jmln
1341 : : end do !ia
1342 : : end do !ispinor
1343 : : end do !idat
1344 : : #ifdef HAVE_OPENMP_OFFLOAD
1345 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1346 : : !$OMP& MAP(to:atindx1,dgxdtfac_,enl_ptr,dgxdt) PRIVATE(idat,ispinor) &
1347 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1348 : : #endif
1349 [ # # ]: 0 : do idat=1,ndat
1350 [ # # ]: 0 : do ispinor=1,nspinor
1351 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,jspinor,index_enl,i0lmn,ilmn,ijlmn,cplex_,enl_,gxfi)
1352 [ # # ]: 0 : do ia=1,nincat
1353 [ # # ]: 0 : do jlmn=1,nlmn
1354 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
1355 : 0 : jspinor=3-ispinor
1356 : 0 : index_enl=atindx1(iatm+ia)
1357 : 0 : i0lmn=ilmn*(ilmn-1)/2
1358 : 0 : ijlmn=i0lmn+jlmn
1359 : 0 : enl_(1)=enl_ptr(2*ijlmn-1,index_enl,2+ispinor)
1360 : 0 : enl_(2)=enl_ptr(2*ijlmn ,index_enl,2+ispinor)
1361 [ # # ]: 0 : do mu=1,ndgxdtfac
1362 [ # # ]: 0 : if(cplex_dgxdt(mu)==2)then
1363 : 0 : cplex_ = 2 ; gxfi(1) = zero ; gxfi(2) = dgxdt(1,mu,ilmn+(ia-1)*nlmn+ibeg,jspinor,idat)
1364 : : else
1365 : 0 : cplex_ = cplex
1366 : 0 : gxfi(1) =dgxdt(1 ,mu,ilmn+(ia-1)*nlmn+ibeg,jspinor,idat)
1367 : 0 : gxfi(cplex)=dgxdt(cplex,mu,ilmn+(ia-1)*nlmn+ibeg,jspinor,idat)
1368 : : end if
1369 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxfi(1)
1370 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(2)*gxfi(1)
1371 [ # # ]: 0 : if (cplex_==2) then
1372 : 0 : dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(1,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)-enl_(2)*gxfi(2)
1373 : 0 : dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=dgxdtfac_(2,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)+enl_(1)*gxfi(2)
1374 : : end if
1375 : : end do !mu
1376 : : end do !ilmn
1377 : : end do !jmln
1378 : : end do !ia
1379 : : end do !ispinor
1380 : : end do !idat
1381 : :
1382 : : ! --- Parallelization over spinors ---
1383 [ # # # # ]: 0 : else if (nspinortot==2.and.nspinor/=nspinortot) then
1384 : 0 : ABI_BUG("nspinor==2 not supported with OpenMP GPU")
1385 : : end if !nspinortot
1386 : :
1387 : : end if ! pawopt & optder
1388 : :
1389 : : !End of loop when a exp(-iqR) phase is present
1390 : : !------------------------------------------- ------------------------
1391 : :
1392 : : !When iphase=1, gxfac and gxfac_ point to the same memory space
1393 : : !When iphase=2, we add i.gxfac_ to gxfac
1394 [ - + ]: 36992 : if (iphase==2) then
1395 : : #ifdef HAVE_OPENMP_OFFLOAD
1396 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(3) &
1397 : : !$OMP& PRIVATE(idat,ia) MAP(to:gxfac,gxfac_) &
1398 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1399 : : #endif
1400 [ # # ]: 0 : do idat=1,ndat
1401 [ # # ]: 0 : do ispinor=1,nspinor
1402 [ # # ]: 0 : do ia=1,nincat
1403 : : !$OMP PARALLEL DO PRIVATE(ilmn)
1404 [ # # ]: 0 : do ilmn=1,nlmn
1405 : : gxfac(1,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1406 : 0 : & gxfac(1,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)-gxfac_(2,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1407 : : gxfac(2,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1408 : 0 : & gxfac(2,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)+gxfac_(1,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1409 : : end do
1410 : : end do
1411 : : end do
1412 : : end do
1413 [ # # ]: 0 : if (optder>=1) then
1414 : : #ifdef HAVE_OPENMP_OFFLOAD
1415 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(3) &
1416 : : !$OMP& PRIVATE(idat,ia,ilmn,mu) MAP(to:dgxdtfac,dgxdtfac_) &
1417 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1418 : : #endif
1419 [ # # ]: 0 : do idat=1,ndat
1420 [ # # ]: 0 : do ispinor=1,nspinor
1421 [ # # ]: 0 : do ia=1,nincat
1422 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ilmn,mu)
1423 [ # # ]: 0 : do ilmn=1,nlmn
1424 [ # # ]: 0 : do mu=1,ndgxdtfac
1425 : : dgxdtfac(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1426 : 0 : & dgxdtfac(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)-dgxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1427 : : dgxdtfac(2,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1428 : 0 : & dgxdtfac(2,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)+dgxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1429 : : end do
1430 : : end do
1431 : : end do
1432 : : end do
1433 : : end do
1434 : : end if
1435 [ # # ]: 0 : if (optder>=2) then
1436 : : #ifdef HAVE_OPENMP_OFFLOAD
1437 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(3) &
1438 : : !$OMP& PRIVATE(idat,ia) MAP(to:d2gxdtfac,d2gxdtfac_) &
1439 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1440 : : #endif
1441 [ # # ]: 0 : do idat=1,ndat
1442 [ # # ]: 0 : do ispinor=1,nspinor
1443 [ # # ]: 0 : do ia=1,nincat
1444 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ilmn,mu)
1445 [ # # ]: 0 : do ilmn=1,nlmn
1446 [ # # ]: 0 : do mu=1,nd2gxdtfac
1447 : : d2gxdtfac(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1448 : 0 : & d2gxdtfac(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)-d2gxdtfac_(2,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1449 : : d2gxdtfac(2,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1450 : 0 : & d2gxdtfac(2,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)+d2gxdtfac_(1,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1451 : : end do
1452 : : end do
1453 : : end do
1454 : : end do
1455 : : end do
1456 : : end if
1457 : 0 : call destroy_work_arrays(gpu_option)
1458 : : end if
1459 : :
1460 : : !End loop over real/imaginary part of the exp(-iqR) phase
1461 : : end do
1462 : :
1463 : :
1464 : : !Accumulate gxfac related to overlap (Sij) (PAW)
1465 : : !------------------------------------------- ------------------------
1466 [ + + ]: 18496 : if (paw_opt==3.or.paw_opt==4) then ! Use Sij, overlap contribution
1467 : : #ifdef HAVE_OPENMP_OFFLOAD
1468 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1469 : : !$OMP& MAP(to:sij,gx,gxfac_sij) &
1470 : : !$OMP& PRIVATE(idat,ispinor) &
1471 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1472 : : #endif
1473 [ + + ]: 43782 : do idat=1,ndat
1474 [ + + ]: 73844 : do ispinor=1,nspinor
1475 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,j0lmn,jjlmn,ilmn,i0lmn,ijlmn,ii)
1476 [ + + ]: 98850 : do ia=1,nincat
1477 [ + + ]: 592576 : do jlmn=1,nlmn
1478 : 523788 : j0lmn=jlmn*(jlmn-1)/2
1479 : 523788 : jjlmn=j0lmn+jlmn
1480 [ + + ]: 1400508 : do ii=1,cplex
1481 : : gxfac_sij(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat)= &
1482 : : gxfac_sij(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat) &
1483 : 1400508 : + sij(jjlmn) * gx(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat)
1484 : : end do
1485 [ + + ]: 4282866 : do ilmn=1,jlmn-1
1486 : 3759078 : ijlmn=j0lmn+ilmn
1487 [ + + ]: 10481226 : do ii=1,cplex
1488 : : gxfac_sij(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat)= &
1489 : : gxfac_sij(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat) &
1490 : 9957438 : + sij(ijlmn) * gx(ii,ibeg+ilmn+(ia-1)*nlmn,ispinor,idat)
1491 : : end do
1492 : : end do
1493 [ + + ]: 562514 : if(jlmn<nlmn) then
1494 [ + + ]: 4244140 : do ilmn=jlmn+1,nlmn
1495 : 3759078 : i0lmn=ilmn*(ilmn-1)/2
1496 : 3759078 : ijlmn=i0lmn+jlmn
1497 [ + + ]: 10442500 : do ii=1,cplex
1498 : : gxfac_sij(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat)=&
1499 : : gxfac_sij(ii,ibeg+jlmn+(ia-1)*nlmn,ispinor,idat) &
1500 : 9957438 : + sij(ijlmn) * gx(ii,ibeg+ilmn+(ia-1)*nlmn,ispinor,idat)
1501 : : end do
1502 : : end do
1503 : : end if
1504 : : end do
1505 : : end do
1506 : : end do
1507 : : end do
1508 : : end if
1509 : :
1510 : : !Accumulate dgxdtfac related to overlap (Sij) (PAW)
1511 : : !-------------------------------------------------------------------
1512 [ - + - - ]: 18496 : if (optder>=1.and.(paw_opt==3.or.paw_opt==4)) then ! Use Sij, overlap contribution
1513 : : #ifdef HAVE_OPENMP_OFFLOAD
1514 : : !$OMP TARGET TEAMS DISTRIBUTE COLLAPSE(2) &
1515 : : !$OMP& MAP(to:sij,dgxdt,dgxdtfac_sij) &
1516 : : !$OMP& PRIVATE(idat,ispinor) &
1517 : : !$OMP& IF(gpu_option==ABI_GPU_OPENMP)
1518 : : #endif
1519 [ # # ]: 0 : do idat=1,ndat
1520 [ # # ]: 0 : do ispinor=1,nspinor
1521 : : !$OMP PARALLEL DO COLLAPSE(2) PRIVATE(ia,jlmn,j0lmn,jjlmn,ilmn,i0lmn,ijlmn,ii)
1522 [ # # ]: 0 : do ia=1,nincat
1523 [ # # ]: 0 : do jlmn=1,nlmn
1524 : 0 : j0lmn=jlmn*(jlmn-1)/2
1525 : 0 : jjlmn=j0lmn+jlmn
1526 [ # # ]: 0 : do mu=1,ndgxdtfac
1527 [ # # ]: 0 : do ii=1,cplex
1528 : : dgxdtfac_sij(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1529 : : & dgxdtfac_sij(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1530 : 0 : & + sij(jjlmn) * dgxdt(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1531 : : end do
1532 : : end do
1533 [ # # ]: 0 : do ilmn=1,jlmn-1
1534 : 0 : ijlmn=j0lmn+ilmn
1535 [ # # ]: 0 : do mu=1,ndgxdtfac
1536 [ # # ]: 0 : do ii=1,cplex
1537 : : dgxdtfac_sij(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1538 : : & dgxdtfac_sij(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1539 : 0 : & + sij(ijlmn) * dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1540 : : end do
1541 : : end do
1542 : : end do
1543 [ # # ]: 0 : if(jlmn<nlmn) then
1544 [ # # ]: 0 : do ilmn=jlmn+1,nlmn
1545 : 0 : i0lmn=ilmn*(ilmn-1)/2
1546 : 0 : ijlmn=i0lmn+jlmn
1547 [ # # ]: 0 : do mu=1,ndgxdtfac
1548 [ # # ]: 0 : do ii=1,cplex
1549 : : dgxdtfac_sij(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)=&
1550 : : & dgxdtfac_sij(ii,mu,jlmn+(ia-1)*nlmn+ibeg,ispinor,idat)&
1551 : 0 : & + sij(ijlmn) * dgxdt(ii,mu,ilmn+(ia-1)*nlmn+ibeg,ispinor,idat)
1552 : : end do
1553 : : end do
1554 : : end do
1555 : : end if
1556 : : end do
1557 : : end do
1558 : : end do
1559 : : end do
1560 : : end if
1561 : :
1562 : : !NOTE: These subroutines were placed here because NVHPC would cause issues when
1563 : : ! processing OpenMP directives below by creating artifacts :
1564 : : !318, Generating target enter data map(to: ls_ylm_so(:,:,:),gxfac_$sd(:),enl_ptr2$sd(:))
1565 : : !
1566 : : ! Tested with NVHPC 25.7
1567 : : ! The name 'ls_ylm_so' is for debugging purposes, because it is the only
1568 : : ! array mapped in this routine.
1569 : : #ifdef HAVE_OPENMP_OFFLOAD
1570 : : contains
1571 : : subroutine ompgpu_enter_map_to(ls_ylm_so)
1572 : : real(dp),intent(inout) :: ls_ylm_so(:,:,:)
1573 : : !$OMP TARGET ENTER DATA MAP(to:ls_ylm_so)
1574 : : end subroutine ompgpu_enter_map_to
1575 : :
1576 : : subroutine ompgpu_exit_map_delete(ls_ylm_so)
1577 : : real(dp),intent(inout) :: ls_ylm_so(:,:,:)
1578 : : !$OMP TARGET EXIT DATA MAP(delete:ls_ylm_so)
1579 : : end subroutine ompgpu_exit_map_delete
1580 : :
1581 : : #endif
1582 : :
1583 [ - + - + ]: 36992 : end subroutine opernlc_ylm_allwf
1584 : : !!***
1585 : :
1586 : : end module m_opernlc_ylm_allwf
1587 : : !!***
|
