Line data Source code
1 : !!****m* ABINIT/m_paw2wvl
2 : !! NAME
3 : !! paw2wvl
4 : !!
5 : !! FUNCTION
6 : !!
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 2011-2026 ABINIT group (T. Rangel, MT)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : module m_paw2wvl
23 :
24 : use defs_basis
25 : use defs_wvltypes
26 : use m_abicore
27 : use m_errors
28 :
29 : use m_pawtab, only : pawtab_type
30 : use m_paw_ij, only : paw_ij_type
31 :
32 : implicit none
33 :
34 : private
35 : !!***
36 :
37 : public :: paw2wvl
38 : public :: paw2wvl_ij
39 : public :: wvl_paw_free
40 : public :: wvl_cprjreorder
41 : !!***
42 :
43 : contains
44 : !!***
45 :
46 : !!****f* ABINIT/paw2wvl
47 : !! NAME
48 : !! paw2wvl
49 : !!
50 : !! FUNCTION
51 : !! Points WVL objects to PAW objects
52 : !!
53 : !! INPUTS
54 : !! argin(sizein)=description
55 : !!
56 : !! OUTPUT
57 : !! argout(sizeout)=description
58 : !!
59 : !! SIDE EFFECTS
60 : !!
61 : !! NOTES
62 : !!
63 : !! SOURCE
64 :
65 0 : subroutine paw2wvl(pawtab,proj,wvl)
66 :
67 : !Arguments ------------------------------------
68 : type(pawtab_type),intent(in)::pawtab(:)
69 : type(wvl_internal_type), intent(inout) :: wvl
70 : type(wvl_projectors_type),intent(inout)::proj
71 :
72 : !Local variables-------------------------------
73 : #if defined HAVE_BIGDFT
74 : integer :: ib,ig
75 : integer :: itypat,jb,ll,lmnmax,lmnsz,nn,ntypat,ll_,nn_
76 : integer ::maxmsz,msz1,ptotgau,max_lmn2_size
77 : logical :: test_wvl
78 : real(dp) :: a1
79 : integer,allocatable :: msz(:)
80 : #endif
81 :
82 : !extra variables, use to debug
83 : ! integer::nr,unitp,i_shell,ii,ir,ng
84 : ! real(dp)::step,rmax
85 : ! real(dp),allocatable::r(:), y(:)
86 : ! complex::fac,arg
87 : ! complex(dp),allocatable::f(:),g(:,:)
88 :
89 : ! *********************************************************************
90 :
91 : !DEBUG
92 : !write (std_out,*) ' paw2wvl : enter'
93 : !ENDDEBUG
94 :
95 : #if defined HAVE_BIGDFT
96 :
97 : ntypat=size(pawtab)
98 :
99 : !wvl object must be allocated in pawtab
100 : if (ntypat>0) then
101 : test_wvl=.true.
102 : do itypat=1,ntypat
103 : if (pawtab(itypat)%has_wvl==0.or.(.not.associated(pawtab(itypat)%wvl))) test_wvl=.false.
104 : end do
105 : if (.not.test_wvl) then
106 : ABI_BUG('pawtab%wvl must be allocated!')
107 : end if
108 : end if
109 :
110 : !Find max mesh size
111 : ABI_MALLOC(msz,(ntypat))
112 : do itypat=1,ntypat
113 : msz(itypat)=pawtab(itypat)%wvl%rholoc%msz
114 : end do
115 : maxmsz=maxval(msz(1:ntypat))
116 :
117 : ABI_MALLOC(wvl%rholoc%msz,(ntypat))
118 : ABI_MALLOC(wvl%rholoc%d,(maxmsz,4,ntypat))
119 : ABI_MALLOC(wvl%rholoc%rad,(maxmsz,ntypat))
120 : ABI_MALLOC(wvl%rholoc%radius,(ntypat))
121 :
122 : do itypat=1,ntypat
123 : msz1=pawtab(itypat)%wvl%rholoc%msz
124 : msz(itypat)=msz1
125 : wvl%rholoc%msz(itypat)=msz1
126 : wvl%rholoc%d(1:msz1,:,itypat)=pawtab(itypat)%wvl%rholoc%d(1:msz1,:)
127 : wvl%rholoc%rad(1:msz1,itypat)=pawtab(itypat)%wvl%rholoc%rad(1:msz1)
128 : wvl%rholoc%radius(itypat)=pawtab(itypat)%rpaw
129 : end do
130 : ABI_FREE(msz)
131 : !
132 : !Now fill projectors type:
133 : !
134 : ABI_MALLOC(proj%G,(ntypat))
135 : !
136 : !nullify all for security:
137 : !do itypat=1,ntypat
138 : !call nullify_gaussian_basis(proj%G(itypat))
139 : !end do
140 : proj%G(:)%nat=1 !not used
141 : proj%G(:)%ncplx=2 !Complex gaussians
142 : !
143 : !Obtain dimensions:
144 : !jb=0
145 : !ptotgau=0
146 : do itypat=1,ntypat
147 : ! do ib=1,pawtab(itypat)%basis_size
148 : ! jb=jb+1
149 : ! end do
150 : ! ptotgau=ptotgau+pawtab(itypat)%wvl%ptotgau
151 : ptotgau=pawtab(itypat)%wvl%ptotgau
152 : proj%G(itypat)%nexpo=ptotgau
153 : proj%G(itypat)%nshltot=pawtab(itypat)%basis_size
154 : end do
155 : !proj%G%nexpo=ptotgau
156 : !proj%G%nshltot=jb
157 : !
158 : !Allocations
159 : do itypat=1,ntypat
160 : ABI_MALLOC(proj%G(itypat)%ndoc ,(proj%G(itypat)%nshltot))
161 : ABI_MALLOC(proj%G(itypat)%nam ,(proj%G(itypat)%nshltot))
162 : ABI_MALLOC(proj%G(itypat)%xp ,(proj%G(itypat)%ncplx,proj%G(itypat)%nexpo))
163 : ABI_MALLOC(proj%G(itypat)%psiat,(proj%G(itypat)%ncplx,proj%G(itypat)%nexpo))
164 : end do
165 :
166 : !jb=0
167 : do itypat=1,ntypat
168 : proj%G(itypat)%ndoc(:)=pawtab(itypat)%wvl%pngau(:)
169 : end do
170 : !
171 : do itypat=1,ntypat
172 : proj%G(itypat)%xp(:,:)=pawtab(itypat)%wvl%parg(:,:)
173 : proj%G(itypat)%psiat(:,:)=pawtab(itypat)%wvl%pfac(:,:)
174 : end do
175 :
176 : !Change the real part of psiat to the form adopted in BigDFT:
177 : !Here we use exp{(a+ib)x^2}, where a is a negative number.
178 : !In BigDFT: exp{-0.5(x/c)^2}exp{i(bx)^2}, and c is positive
179 : !Hence c=sqrt(0.5/abs(a))
180 : do itypat=1,ntypat
181 : do ig=1,proj%G(itypat)%nexpo
182 : a1=proj%G(itypat)%xp(1,ig)
183 : a1=(sqrt(0.5/abs(a1)))
184 : proj%G(itypat)%xp(1,ig)=a1
185 : end do
186 : end do
187 :
188 : !debug
189 : !write(*,*)'paw2wvl 178: erase me set gaussians real equal to hgh (for Li)'
190 : !ABI_FREE(proj%G(1)%xp)
191 : !ABI_FREE(proj%G(1)%psiat)
192 : !ABI_MALLOC(proj%G(1)%psiat,(2,2))
193 : !ABI_MALLOC(proj%G(1)%xp,(2,2))
194 : !proj%G(1)%ndoc(:)=1 !1 gaussian per shell
195 : !proj%G(1)%nexpo=2 ! two gaussians in total
196 : !proj%G(1)%xp=zero
197 : !proj%G(1)%xp(1,1)=0.666375d0
198 : !proj%G(1)%xp(1,2)=1.079306d0
199 : !proj%G(1)%psiat(1,:)=1.d0
200 : !proj%G(1)%psiat(2,:)=zero
201 :
202 : !
203 : !begin debug
204 : !
205 : !write(*,*)'paw2wvl, comment me'
206 : !and comment out variables
207 : !rmax=2.d0
208 : !nr=rmax/(0.0001d0)
209 : !ABI_MALLOC(r,(nr))
210 : !ABI_MALLOC(f,(nr))
211 : !ABI_MALLOC(y,(nr))
212 : !step=rmax/real(nr-1,dp)
213 : !do ir=1,nr
214 : !r(ir)=real(ir-1,dp)*step
215 : !end do
216 : !!
217 : !unitp=400
218 : !do itypat=1,ntypat
219 : !ig=0
220 : !do i_shell=1,proj%G(itypat)%nshltot
221 : !unitp=unitp+1
222 : !f(:)=czero
223 : !ng=proj%G(itypat)%ndoc(i_shell)
224 : !ABI_MALLOC(g,(nr,ng))
225 : !do ii=1,ng
226 : !ig=ig+1
227 : !fac=cmplx(proj%G(itypat)%psiat(1,ig),proj%G(itypat)%psiat(2,ig))
228 : !a1=-0.5d0/(proj%G(itypat)%xp(1,ig)**2)
229 : !arg=cmplx(a1,proj%G(itypat)%xp(2,ig))
230 : !g(:,ii)=fac*exp(arg*r(:)**2)
231 : !f(:)=f(:)+g(:,ii)
232 : !end do
233 : !do ir=1,nr
234 : !write(unitp,'(9999f16.7)')r(ir),real(f(ir)),(real(g(ir,ii)),&
235 : !& ii=1,ng)
236 : !end do
237 : !ABI_FREE(g)
238 : !end do
239 : !end do
240 : !ABI_FREE(r)
241 : !ABI_FREE(f)
242 : !ABI_FREE(y)
243 : !stop
244 : !end debug
245 :
246 :
247 : !jb=0
248 : do itypat=1,ntypat
249 : jb=0
250 : ll_ = 0
251 : nn_ = 0
252 : do ib=1,pawtab(itypat)%lmn_size
253 : ll=pawtab(itypat)%indlmn(1,ib)
254 : nn=pawtab(itypat)%indlmn(3,ib)
255 : ! write(*,*)ll,pawtab(itypat)%indlmn(2,ib),nn
256 : if(ib>1 .and. ll == ll_ .and. nn==nn_) cycle
257 : jb=jb+1
258 : ! proj%G%nam(jb)= pawtab(itypat)%indlmn(1,ib)+1!l quantum number
259 : ! write(*,*)jb,proj%G%nshltot,proj%G%nam(jb)
260 : proj%G(itypat)%nam(jb)= pawtab(itypat)%indlmn(1,ib)+1 !l quantum number
261 : ! 1 is added due to BigDFT convention
262 : ! write(*,*)jb,pawtab(itypat)%indlmn(1:3,ib)
263 : ll_=ll
264 : nn_=nn
265 : end do
266 : end do
267 : !Nullify remaining objects
268 : do itypat=1,ntypat
269 : nullify(proj%G(itypat)%rxyz)
270 : nullify(proj%G(itypat)%nshell)
271 : end do
272 : !nullify(proj%G%rxyz)
273 :
274 : !now the index l,m,n objects:
275 : lmnmax=maxval(pawtab(:)%lmn_size)
276 : ABI_MALLOC(wvl%paw%indlmn,(6,lmnmax,ntypat))
277 : wvl%paw%lmnmax=lmnmax
278 : wvl%paw%ntypes=ntypat
279 : wvl%paw%indlmn=0
280 : do itypat=1,ntypat
281 : lmnsz=pawtab(itypat)%lmn_size
282 : wvl%paw%indlmn(1:6,1:lmnsz,itypat)=pawtab(itypat)%indlmn(1:6,1:lmnsz)
283 : end do
284 :
285 : !allocate and copy sij
286 : !max_lmn2_size=max(pawtab(:)%lmn2_size,1)
287 : max_lmn2_size=lmnmax*(lmnmax+1)/2
288 : ABI_MALLOC(wvl%paw%sij,(max_lmn2_size,ntypat))
289 : !sij is not yet calculated here.
290 : !We copy this in gstate after call to pawinit
291 : !do itypat=1,ntypat
292 : !wvl%paw%sij(1:pawtab(itypat)%lmn2_size,itypat)=pawtab(itypat)%sij(:)
293 : !end do
294 :
295 : ABI_MALLOC(wvl%paw%rpaw,(ntypat))
296 : do itypat=1,ntypat
297 : wvl%paw%rpaw(itypat)= pawtab(itypat)%rpaw
298 : end do
299 :
300 : if(allocated(wvl%npspcode_paw_init_guess)) then
301 : ABI_FREE(wvl%npspcode_paw_init_guess)
302 : end if
303 : ABI_MALLOC(wvl%npspcode_paw_init_guess,(ntypat))
304 : do itypat=1,ntypat
305 : wvl%npspcode_paw_init_guess(itypat)=pawtab(itypat)%wvl%npspcode_init_guess
306 : end do
307 :
308 : #else
309 : if (.false.) write(std_out) pawtab(1)%mesh_size,wvl%h(1),proj%nlpsp
310 : #endif
311 :
312 : !DEBUG
313 : !write (std_out,*) ' paw2wvl : exit'
314 : !stop
315 : !ENDDEBUG
316 :
317 0 : end subroutine paw2wvl
318 : !!***
319 :
320 : !!****f* ABINIT/paw2wvl_ij
321 : !! NAME
322 : !! paw2wvl_ij
323 : !!
324 : !! FUNCTION
325 : !! FIXME: add description.
326 : !!
327 : !! INPUTS
328 : !! argin(sizein)=description
329 : !!
330 : !! OUTPUT
331 : !! argout(sizeout)=description
332 : !!
333 : !! SIDE EFFECTS
334 : !!
335 : !! NOTES
336 : !!
337 : !! SOURCE
338 :
339 0 : subroutine paw2wvl_ij(option,paw_ij,wvl)
340 :
341 : #if defined HAVE_BIGDFT
342 : use BigDFT_API, only : nullify_paw_ij_objects
343 : #endif
344 :
345 : !Arguments ------------------------------------
346 : integer,intent(in)::option
347 : type(wvl_internal_type), intent(inout)::wvl
348 : type(paw_ij_type),intent(in) :: paw_ij(:)
349 : !Local variables-------------------------------
350 : #if defined HAVE_BIGDFT
351 : integer :: iatom,iaux,my_natom
352 : character(len=500) :: message
353 : #endif
354 :
355 : ! *************************************************************************
356 :
357 : DBG_ENTER("COLL")
358 :
359 : #if defined HAVE_BIGDFT
360 : my_natom=size(paw_ij)
361 :
362 : !Option==1: allocate and copy
363 : if(option==1) then
364 : ABI_MALLOC(wvl%paw%paw_ij,(my_natom))
365 : do iatom=1,my_natom
366 : call nullify_paw_ij_objects(wvl%paw%paw_ij(iatom))
367 : wvl%paw%paw_ij(iatom)%cplex =paw_ij(iatom)%qphase
368 : wvl%paw%paw_ij(iatom)%cplex_dij =paw_ij(iatom)%cplex_dij
369 : wvl%paw%paw_ij(iatom)%has_dij =paw_ij(iatom)%has_dij
370 : wvl%paw%paw_ij(iatom)%has_dijfr =0
371 : wvl%paw%paw_ij(iatom)%has_dijhartree =0
372 : wvl%paw%paw_ij(iatom)%has_dijhat =0
373 : wvl%paw%paw_ij(iatom)%has_dijso =0
374 : wvl%paw%paw_ij(iatom)%has_dijU =0
375 : wvl%paw%paw_ij(iatom)%has_dijxc =0
376 : wvl%paw%paw_ij(iatom)%has_dijxc_val =0
377 : wvl%paw%paw_ij(iatom)%has_exexch_pot =0
378 : wvl%paw%paw_ij(iatom)%has_pawu_occ =0
379 : wvl%paw%paw_ij(iatom)%lmn_size =paw_ij(iatom)%lmn_size
380 : wvl%paw%paw_ij(iatom)%lmn2_size =paw_ij(iatom)%lmn2_size
381 : wvl%paw%paw_ij(iatom)%ndij =paw_ij(iatom)%ndij
382 : wvl%paw%paw_ij(iatom)%nspden =paw_ij(iatom)%nspden
383 : wvl%paw%paw_ij(iatom)%nsppol =paw_ij(iatom)%nsppol
384 : if (paw_ij(iatom)%has_dij/=0) then
385 : iaux=paw_ij(iatom)%cplex_dij*paw_ij(iatom)%lmn2_size
386 : ABI_MALLOC(wvl%paw%paw_ij(iatom)%dij,(iaux,paw_ij(iatom)%ndij))
387 : wvl%paw%paw_ij(iatom)%dij(:,:)=paw_ij(iatom)%dij(:,:)
388 : end if
389 : end do
390 :
391 : ! Option==2: deallocate
392 : elseif(option==2) then
393 : do iatom=1,my_natom
394 : wvl%paw%paw_ij(iatom)%has_dij=0
395 : if (associated(wvl%paw%paw_ij(iatom)%dij)) then
396 : ABI_FREE(wvl%paw%paw_ij(iatom)%dij)
397 : end if
398 : end do
399 : ABI_FREE(wvl%paw%paw_ij)
400 :
401 : ! Option==3: only copy
402 : elseif(option==3) then
403 : do iatom=1,my_natom
404 : wvl%paw%paw_ij(iatom)%cplex =paw_ij(iatom)%qphase
405 : wvl%paw%paw_ij(iatom)%cplex_dij =paw_ij(iatom)%cplex_dij
406 : wvl%paw%paw_ij(iatom)%lmn_size =paw_ij(iatom)%lmn_size
407 : wvl%paw%paw_ij(iatom)%lmn2_size =paw_ij(iatom)%lmn2_size
408 : wvl%paw%paw_ij(iatom)%ndij =paw_ij(iatom)%ndij
409 : wvl%paw%paw_ij(iatom)%nspden =paw_ij(iatom)%nspden
410 : wvl%paw%paw_ij(iatom)%nsppol =paw_ij(iatom)%nsppol
411 : wvl%paw%paw_ij(iatom)%dij(:,:) =paw_ij(iatom)%dij(:,:)
412 : end do
413 :
414 : else
415 : message = 'paw2wvl_ij: option should be equal to 1, 2 or 3'
416 : ABI_ERROR(message)
417 : end if
418 :
419 : #else
420 : if (.false.) write(std_out,*) option,wvl%h(1),paw_ij(1)%ndij
421 : #endif
422 :
423 : DBG_EXIT("COLL")
424 :
425 0 : end subroutine paw2wvl_ij
426 : !!***
427 :
428 : !!****f* ABINIT/wvl_paw_free
429 : !! NAME
430 : !! wvl_paw_free
431 : !!
432 : !! FUNCTION
433 : !! Frees memory for WVL+PAW implementation
434 : !!
435 : !! INPUTS
436 : !! ntypat = number of atom types
437 : !! wvl= wvl type
438 : !! wvl_proj= wvl projector type
439 : !!
440 : !! OUTPUT
441 : !!
442 : !! SIDE EFFECTS
443 : !!
444 : !! NOTES
445 : !!
446 : !! SOURCE
447 :
448 :
449 0 : subroutine wvl_paw_free(wvl)
450 :
451 : !Arguments ------------------------------------
452 : type(wvl_internal_type),intent(inout) :: wvl
453 : ! *************************************************************************
454 :
455 : #if defined HAVE_BIGDFT
456 :
457 : !PAW objects
458 : if( associated(wvl%paw%spsi)) then
459 : ABI_FREE(wvl%paw%spsi)
460 : end if
461 : if( associated(wvl%paw%indlmn)) then
462 : ABI_FREE(wvl%paw%indlmn)
463 : end if
464 : if( associated(wvl%paw%sij)) then
465 : ABI_FREE(wvl%paw%sij)
466 : end if
467 : if( associated(wvl%paw%rpaw)) then
468 : ABI_FREE(wvl%paw%rpaw)
469 : end if
470 :
471 : !rholoc
472 : if( associated(wvl%rholoc%msz )) then
473 : ABI_FREE(wvl%rholoc%msz)
474 : end if
475 : if( associated(wvl%rholoc%d )) then
476 : ABI_FREE(wvl%rholoc%d)
477 : end if
478 : if( associated(wvl%rholoc%rad)) then
479 : ABI_FREE(wvl%rholoc%rad)
480 : end if
481 : if( associated(wvl%rholoc%radius)) then
482 : ABI_FREE(wvl%rholoc%radius)
483 : end if
484 :
485 : #else
486 : if (.false.) write(std_out,*) wvl%h(1)
487 : #endif
488 :
489 : !paw%paw_ij and paw%cprj are allocated and deallocated inside vtorho
490 :
491 0 : end subroutine wvl_paw_free
492 : !!***
493 :
494 :
495 : !!****f* ABINIT/wvl_cprjreorder
496 : !! NAME
497 : !! wvl_cprjreorder
498 : !!
499 : !! FUNCTION
500 : !! Change the order of a wvl-cprj datastructure
501 : !! From unsorted cprj to atom-sorted cprj (atm_indx=atindx)
502 : !! From atom-sorted cprj to unsorted cprj (atm_indx=atindx1)
503 : !!
504 : !! INPUTS
505 : !! atm_indx(natom)=index table for atoms
506 : !! From unsorted wvl%paw%cprj to atom-sorted wvl%paw%cprj (atm_indx=atindx)
507 : !! From atom-sorted wvl%paw%cprj to unsorted wvl%paw%cprj (atm_indx=atindx1)
508 : !!
509 : !! OUTPUT
510 : !!
511 : !! SOURCE
512 :
513 0 : subroutine wvl_cprjreorder(wvl,atm_indx)
514 :
515 : #if defined HAVE_BIGDFT
516 : use BigDFT_API,only : cprj_objects,cprj_paw_alloc,cprj_clean
517 : use dynamic_memory
518 : #endif
519 :
520 : !Arguments ------------------------------------
521 : !scalars
522 : !arrays
523 : integer,intent(in) :: atm_indx(:)
524 : type(wvl_internal_type),intent(inout),target :: wvl
525 :
526 : !Local variables-------------------------------
527 : #if defined HAVE_BIGDFT
528 : !scalars
529 : integer :: iexit,ii,jj,kk,n1atindx,n1cprj,n2cprj,ncpgr
530 : character(len=100) :: msg
531 : !arrays
532 : integer,allocatable :: nlmn(:)
533 : type(cprj_objects),pointer :: cprj(:,:)
534 : type(cprj_objects),allocatable :: cprj_tmp(:,:)
535 : #endif
536 :
537 : ! *************************************************************************
538 :
539 : DBG_ENTER("COLL")
540 :
541 : #if defined HAVE_BIGDFT
542 : cprj => wvl%paw%cprj
543 :
544 : n1cprj=size(cprj,dim=1);n2cprj=size(cprj,dim=2)
545 : n1atindx=size(atm_indx,dim=1)
546 : if (n1cprj==0.or.n2cprj==0.or.n1atindx<=1) return
547 : if (n1cprj/=n1atindx) then
548 : msg='wrong sizes!'
549 : ABI_BUG(msg)
550 : end if
551 :
552 : !Nothing to do when the atoms are already sorted
553 : iexit=1;ii=0
554 : do while (iexit==1.and.ii<n1atindx)
555 : ii=ii+1
556 : if (atm_indx(ii)/=ii) iexit=0
557 : end do
558 : if (iexit==1) return
559 :
560 : ABI_MALLOC(nlmn,(n1cprj))
561 : do ii=1,n1cprj
562 : nlmn(ii)=cprj(ii,1)%nlmn
563 : end do
564 : ncpgr=cprj(1,1)%ncpgr
565 :
566 : ABI_MALLOC(cprj_tmp,(n1cprj,n2cprj))
567 : call cprj_paw_alloc(cprj_tmp,ncpgr,nlmn)
568 : do jj=1,n2cprj
569 : do ii=1,n1cprj
570 : cprj_tmp(ii,jj)%nlmn=nlmn(ii)
571 : cprj_tmp(ii,jj)%ncpgr=ncpgr
572 : cprj_tmp(ii,jj)%cp(:,:)=cprj(ii,jj)%cp(:,:)
573 : if (ncpgr>0) cprj_tmp(ii,jj)%dcp(:,:,:)=cprj(ii,jj)%dcp(:,:,:)
574 : end do
575 : end do
576 :
577 : call cprj_clean(cprj)
578 :
579 : do jj=1,n2cprj
580 : do ii=1,n1cprj
581 : kk=atm_indx(ii)
582 : cprj(kk,jj)%nlmn=nlmn(ii)
583 : cprj(kk,jj)%ncpgr=ncpgr
584 : cprj(kk,jj)%cp=f_malloc_ptr((/2,nlmn(ii)/),id='cprj%cp')
585 : cprj(kk,jj)%cp(:,:)=cprj_tmp(ii,jj)%cp(:,:)
586 : if (ncpgr>0) then
587 : cprj(kk,jj)%dcp=f_malloc_ptr((/2,ncpgr,nlmn(ii)/),id='cprj%dcp')
588 : cprj(kk,jj)%dcp(:,:,:)=cprj_tmp(kk,jj)%dcp(:,:,:)
589 : end if
590 : end do
591 : end do
592 :
593 : call cprj_clean(cprj_tmp)
594 : ABI_FREE(cprj_tmp)
595 : ABI_FREE(nlmn)
596 :
597 : #else
598 : if (.false.) write(std_out,*) atm_indx(1),wvl%h(1)
599 : #endif
600 :
601 : DBG_EXIT("COLL")
602 :
603 0 : end subroutine wvl_cprjreorder
604 : !!***
605 :
606 : end module m_paw2wvl
607 : !!***
|
