TABLE OF CONTENTS
- ABINIT/m_pawrhoij
- m_pawrhoij/pawrhoij_alloc
- m_pawrhoij/pawrhoij_bcast
- m_pawrhoij/pawrhoij_copy
- m_pawrhoij/pawrhoij_free
- m_pawrhoij/pawrhoij_free_unpacked
- m_pawrhoij/pawrhoij_gather
- m_pawrhoij/pawrhoij_get_nspden
- m_pawrhoij/pawrhoij_init_unpacked
- m_pawrhoij/pawrhoij_io
- m_pawrhoij/pawrhoij_isendreceive_fillbuffer
- m_pawrhoij/pawrhoij_isendreceive_getbuffer
- m_pawrhoij/pawrhoij_mpisum_unpacked_1D
- m_pawrhoij/pawrhoij_mpisum_unpacked_2D
- m_pawrhoij/pawrhoij_nullify
- m_pawrhoij/pawrhoij_redistribute
- m_pawrhoij/pawrhoij_type
- m_pawrhoij/pawrhoij_unpack
- m_pawrhoij/symrhoij
ABINIT/m_pawrhoij [ Modules ]
NAME
m_pawrhoij
FUNCTION
This module contains the definition of the pawrhoij_type structured datatype, as well as related functions and methods. pawrhoij_type variables define rhoij occupancies matrixes used within PAW formalism.
COPYRIGHT
Copyright (C) 2012-2018 ABINIT group (MT, FJ) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
NOTES
FOR DEVELOPPERS: in order to preserve the portability of libPAW library, please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt
SOURCE
23 #include "libpaw.h" 24 25 MODULE m_pawrhoij 26 27 USE_DEFS 28 USE_MSG_HANDLING 29 USE_MPI_WRAPPERS 30 USE_MEMORY_PROFILING 31 #ifdef LIBPAW_HAVE_NETCDF 32 use netcdf 33 #endif 34 35 use m_libpaw_tools, only : libpaw_flush, libpaw_to_upper 36 37 use m_paw_io, only : pawio_print_ij 38 use m_pawang, only : pawang_type 39 use m_pawtab, only : pawtab_type 40 use m_paral_atom, only : get_my_atmtab, free_my_atmtab, get_my_natom 41 42 implicit none 43 44 private 45 46 !public procedures. 47 public :: pawrhoij_alloc 48 public :: pawrhoij_free 49 public :: pawrhoij_nullify 50 public :: pawrhoij_copy 51 public :: pawrhoij_gather 52 public :: pawrhoij_bcast 53 public :: pawrhoij_redistribute 54 public :: pawrhoij_io 55 public :: pawrhoij_unpack 56 public :: pawrhoij_init_unpacked 57 public :: pawrhoij_free_unpacked 58 public :: pawrhoij_get_nspden 59 public :: symrhoij 60 61 public :: pawrhoij_mpisum_unpacked 62 63 interface pawrhoij_mpisum_unpacked 64 module procedure pawrhoij_mpisum_unpacked_1D 65 module procedure pawrhoij_mpisum_unpacked_2D 66 end interface pawrhoij_mpisum_unpacked 67 68 !private procedures. 69 private :: pawrhoij_isendreceive_getbuffer 70 private :: pawrhoij_isendreceive_fillbuffer
m_pawrhoij/pawrhoij_alloc [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_alloc
FUNCTION
Initialize and allocate a pawrhoij datastructure
INPUTS
[comm_atom] = communicator over atoms (OPTIONAL)
cplex=1 if rhoij is REAL,2 if COMPLEX
[my_atmtab(:)] = Index of atoms treated by current proc (OPTIONAL)
nspden=number of spin-components for rhoij
nsppol=number of spinorial components for rhoij
nsppol=number of independant spin-components for rhoij
typat(:)=types of atoms
[lmnsize(:)]=array of (l,m,n) sizes for rhoij for each type of atom (OPTIONAL)
must be present if [pawtab] argument is not passed
[ngrhoij]=number of gradients to be allocated (OPTIONAL, default=0)
[nlmnmix]=number of rhoij elements to be mixed during SCF cycle (OPTIONAL, default=0)
[pawtab(:)] <type(pawtab_type)>=paw tabulated starting data (OPTIONAL)
must be present if [lmnsize(:)] argument is not passed
[use_rhoij_]=1 if pawrhoij(:)%rhoij_ has to be allocated (OPTIONAL, default=0)
[use_rhoijp]=1 if pawrhoij(:)%rhoijp has to be allocated (OPTIONAL, default=1)
(in that case, pawrhoij%rhoijselect is also allocated)
[use_rhoijres]=1 if pawrhoij(:)%rhoijres has to be allocated (OPTIONAL, default=0)
[use_rhoijim]=1 if pawrhoij(:)%rhoijim has to be allocated (OPTIONAL, default=0)
SIDE EFFECTS
pawrhoij(:)<type(pawrhoij_type)>= rhoij datastructure
NOTES
One of the two optional arguments lmnsize(:) or pawtab(:) must be present ! If both are present, only pawtab(:) is used.
PARENTS
bethe_salpeter,dfpt_looppert,dfpt_nstpaw,dfpt_rhofermi,dfpt_scfcv dfpt_vtorho,energy,extraprho,initrhoij,m_electronpositron,m_hdr,m_ioarr m_pawrhoij,m_qparticles,paw_qpscgw,posdoppler,respfn,screening setup_bse,setup_positron,setup_screening,setup_sigma,sigma,vtorho wfk_analyze
CHILDREN
SOURCE
224 subroutine pawrhoij_alloc(pawrhoij,cplex,nspden,nspinor,nsppol,typat,& 225 & lmnsize,ngrhoij,nlmnmix,pawtab,use_rhoij_,use_rhoijp,& ! Optional 226 & use_rhoijres,use_rhoijim,comm_atom,mpi_atmtab) ! Optional 227 228 229 !This section has been created automatically by the script Abilint (TD). 230 !Do not modify the following lines by hand. 231 #undef ABI_FUNC 232 #define ABI_FUNC 'pawrhoij_alloc' 233 !End of the abilint section 234 235 implicit none 236 237 !Arguments ------------------------------------ 238 !scalars 239 integer,intent(in) :: cplex,nspden,nspinor,nsppol 240 integer,optional,intent(in):: comm_atom,ngrhoij,nlmnmix,use_rhoij_,use_rhoijp,use_rhoijres,use_rhoijim 241 integer,optional,target,intent(in) :: mpi_atmtab(:) 242 !arrays 243 integer,intent(in) :: typat(:) 244 integer,optional,target,intent(in) :: lmnsize(:) 245 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 246 type(pawtab_type),optional,intent(in) :: pawtab(:) 247 248 !Local variables------------------------------- 249 !scalars 250 integer :: irhoij,irhoij_,itypat,lmn2_size,my_comm_atom,nn1,natom,nrhoij 251 logical :: has_rhoijp,my_atmtab_allocated,paral_atom 252 character(len=500) :: msg 253 !array 254 integer,pointer :: lmn_size(:),my_atmtab(:) 255 256 ! ************************************************************************* 257 258 nrhoij=size(pawrhoij);natom=size(typat) 259 if (nrhoij>natom) then 260 msg=' wrong sizes (1) !' 261 MSG_BUG(msg) 262 end if 263 264 !Select lmn_size for each atom type 265 if (present(pawtab)) then 266 nn1=size(pawtab) 267 if (maxval(typat)>nn1) then 268 msg=' wrong sizes (2) !' 269 MSG_BUG(msg) 270 end if 271 LIBPAW_POINTER_ALLOCATE(lmn_size,(nn1)) 272 do itypat=1,nn1 273 lmn_size(itypat)=pawtab(itypat)%lmn_size 274 end do 275 else if (present(lmnsize)) then 276 nn1=size(lmnsize) 277 if (maxval(typat)>nn1) then 278 msg=' wrong sizes (3) !' 279 MSG_BUG(msg) 280 end if 281 lmn_size => lmnsize 282 else 283 msg=' one of the 2 arguments pawtab or lmnsize must be present !' 284 MSG_BUG(msg) 285 end if 286 287 !Set up parallelism over atoms 288 paral_atom=(present(comm_atom).and.(nrhoij/=natom)) 289 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 290 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 291 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom) 292 293 if (nrhoij>0) then 294 do irhoij=1,nrhoij 295 irhoij_=irhoij;if (paral_atom) irhoij_=my_atmtab(irhoij) 296 itypat=typat(irhoij_) 297 298 lmn2_size=lmn_size(itypat)*(lmn_size(itypat)+1)/2 299 300 ! Scalars initializations 301 pawrhoij(irhoij)%cplex=cplex 302 pawrhoij(irhoij)%itypat=itypat 303 pawrhoij(irhoij)%lmn_size=lmn_size(itypat) 304 pawrhoij(irhoij)%lmn2_size=lmn2_size 305 pawrhoij(irhoij)%nspden=nspden 306 pawrhoij(irhoij)%nspinor=nspinor 307 pawrhoij(irhoij)%nsppol=nsppol 308 pawrhoij(irhoij)%nrhoijsel=0 309 pawrhoij(irhoij)%lmnmix_sz=0 310 pawrhoij(irhoij)%ngrhoij=0 311 pawrhoij(irhoij)%use_rhoij_=0 312 pawrhoij(irhoij)%use_rhoijres=0 313 pawrhoij(irhoij)%use_rhoijim=0 314 315 ! Arrays allocations 316 has_rhoijp=.true.; if (present(use_rhoijp)) has_rhoijp=(use_rhoijp>0) 317 if (has_rhoijp) then 318 pawrhoij(irhoij)%use_rhoijp=1 319 LIBPAW_ALLOCATE(pawrhoij(irhoij)%rhoijselect,(lmn2_size)) 320 LIBPAW_ALLOCATE(pawrhoij(irhoij)%rhoijp,(cplex*lmn2_size,nspden)) 321 pawrhoij(irhoij)%rhoijselect(:)=0 322 pawrhoij(irhoij)%rhoijp(:,:)=zero 323 end if 324 325 if (present(ngrhoij)) then 326 if (ngrhoij>0) then 327 pawrhoij(irhoij)%ngrhoij=ngrhoij 328 LIBPAW_ALLOCATE(pawrhoij(irhoij)%grhoij,(ngrhoij,cplex*lmn2_size,nspden)) 329 pawrhoij(irhoij)%grhoij=zero 330 end if 331 end if 332 if (present(nlmnmix)) then 333 if (nlmnmix>0) then 334 pawrhoij(irhoij)%lmnmix_sz=nlmnmix 335 LIBPAW_ALLOCATE(pawrhoij(irhoij)%kpawmix,(nlmnmix)) 336 pawrhoij(irhoij)%kpawmix=0 337 end if 338 end if 339 if (present(use_rhoij_)) then 340 if (use_rhoij_>0) then 341 pawrhoij(irhoij)%use_rhoij_=use_rhoij_ 342 LIBPAW_ALLOCATE(pawrhoij(irhoij)%rhoij_,(cplex*lmn2_size,nspden)) 343 pawrhoij(irhoij)%rhoij_=zero 344 end if 345 end if 346 if (present(use_rhoijres)) then 347 if (use_rhoijres>0) then 348 pawrhoij(irhoij)%use_rhoijres=use_rhoijres 349 LIBPAW_ALLOCATE(pawrhoij(irhoij)%rhoijres,(cplex*lmn2_size,nspden)) 350 pawrhoij(irhoij)%rhoijres=zero 351 end if 352 end if 353 if (present(use_rhoijim)) then 354 if (use_rhoijim>0) then 355 pawrhoij(irhoij)%use_rhoijim=use_rhoijim 356 LIBPAW_ALLOCATE(pawrhoij(irhoij)%rhoijim,(lmn2_size,nspden)) 357 pawrhoij(irhoij)%rhoijim=zero 358 end if 359 end if 360 361 end do 362 end if 363 364 if (present(pawtab)) then 365 LIBPAW_POINTER_DEALLOCATE(lmn_size) 366 end if 367 368 !Destroy atom table used for parallelism 369 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 370 371 end subroutine pawrhoij_alloc
m_pawrhoij/pawrhoij_bcast [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_bcast
FUNCTION
Broadcast pawrhoij datastructures Can take into account a distribution of data over a "atom" communicator
INPUTS
master=master communicator receiving data mpicomm= MPI communicator comm_atom= --optional-- MPI communicator over atoms pawrhoij_in(:)<type(pawrhoij_type)>= input rhoij datastructures on master process
OUTPUT
pawrhoij_out(:)<type(pawrhoij_type)>= output rhoij datastructure on every process Eventually distributed according to comm_atom communicator
PARENTS
respfn
CHILDREN
SOURCE
1581 subroutine pawrhoij_bcast(pawrhoij_in,pawrhoij_out,master,mpicomm,comm_atom) 1582 1583 1584 !This section has been created automatically by the script Abilint (TD). 1585 !Do not modify the following lines by hand. 1586 #undef ABI_FUNC 1587 #define ABI_FUNC 'pawrhoij_bcast' 1588 !End of the abilint section 1589 1590 implicit none 1591 1592 !Arguments ------------------------------------ 1593 !scalars 1594 integer,intent(in) :: master,mpicomm 1595 integer,intent(in),optional :: comm_atom 1596 !arrays 1597 type(pawrhoij_type),intent(in) :: pawrhoij_in(:) 1598 type(pawrhoij_type),intent(inout) :: pawrhoij_out(:) 1599 !Local variables------------------------------- 1600 !scalars 1601 integer :: buf_dp_size,buf_dp_size_all,buf_int_size,buf_int_size_all 1602 integer :: cplex,ierr,ii,indx_dp,indx_int,iproc,irhoij,isp,jrhoij,lmn2_size,lmnmix,me,me_atom 1603 integer :: my_comm_atom,ngrhoij,nproc,nproc_atom,nrhoij_in,nrhoij_out,nrhoij_out_all 1604 integer :: nselect,nspden,rhoij_size2,use_rhoijp,use_rhoijres,use_rhoijim,use_rhoij_ 1605 logical :: my_atmtab_allocated,paral_atom 1606 character(len=500) :: msg 1607 !arrays 1608 integer :: buf_size(2) 1609 integer,allocatable :: atmtab(:),buf_int_size_i(:),buf_dp_size_i(:) 1610 integer,allocatable :: count_dp(:),count_int(:),disp_dp(:),disp_int(:),nrhoij_out_i(:) 1611 integer,allocatable,target :: buf_int(:) 1612 integer,pointer :: buf_int_all(:),my_atmtab(:) 1613 real(dp),allocatable,target :: buf_dp(:) 1614 real(dp),pointer :: buf_dp_all(:) 1615 1616 ! ************************************************************************* 1617 1618 !Load MPI "atom" distribution data 1619 my_comm_atom=xmpi_comm_self;nproc_atom=1;me_atom=0 1620 if (present(comm_atom)) then 1621 my_comm_atom=comm_atom 1622 me_atom=xmpi_comm_rank(my_comm_atom) 1623 nproc_atom=xmpi_comm_size(my_comm_atom) 1624 paral_atom=(nproc_atom>1) 1625 if (my_comm_atom/=mpicomm.and.nproc_atom/=1) then 1626 msg='wrong comm_atom communicator !' 1627 MSG_BUG(msg) 1628 end if 1629 end if 1630 1631 !Load global MPI data 1632 me=xmpi_comm_rank(mpicomm) 1633 nproc=xmpi_comm_size(mpicomm) 1634 1635 !Just copy in case of a sequential run 1636 if (nproc==1.and.nproc_atom==1) then 1637 call pawrhoij_copy(pawrhoij_in,pawrhoij_out,.false.,.false.,.false.) 1638 return 1639 end if 1640 1641 !Retrieve and test pawrhoij sizes 1642 nrhoij_in=0;if (me==master) nrhoij_in=size(pawrhoij_in) 1643 nrhoij_out=size(pawrhoij_out);nrhoij_out_all=nrhoij_out 1644 if (paral_atom) then 1645 LIBPAW_ALLOCATE(nrhoij_out_i,(nproc_atom)) 1646 buf_size(1)=nrhoij_out 1647 call xmpi_allgather(buf_size,1,nrhoij_out_i,my_comm_atom,ierr) 1648 nrhoij_out_all=sum(nrhoij_out_i) 1649 end if 1650 if (me==master.and.nrhoij_in/=nrhoij_out_all) then 1651 msg='pawrhoij_in or pawrhoij_out wrongly allocated!' 1652 MSG_BUG(msg) 1653 end if 1654 1655 !Retrieve table(s) of atoms (if necessary) 1656 if (paral_atom) then 1657 nullify(my_atmtab) 1658 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom, & 1659 & nrhoij_out_all,my_natom_ref=nrhoij_out) 1660 LIBPAW_ALLOCATE(disp_int,(nproc_atom)) 1661 disp_int(1)=0 1662 do iproc=2,nproc_atom 1663 disp_int(iproc)=disp_int(iproc-1)+nrhoij_out_i(iproc-1) 1664 end do 1665 LIBPAW_ALLOCATE(atmtab,(nrhoij_in)) 1666 call xmpi_gatherv(my_atmtab,nrhoij_out,atmtab,nrhoij_out_i,disp_int,& 1667 & master,my_comm_atom,ierr) 1668 LIBPAW_DEALLOCATE(disp_int) 1669 end if 1670 1671 !Compute sizes of input buffers and broadcast them 1672 LIBPAW_ALLOCATE(buf_int_size_i,(nrhoij_out_all)) 1673 LIBPAW_ALLOCATE(buf_dp_size_i ,(nrhoij_out_all)) 1674 if (me==master) then 1675 buf_int_size_i(:)=0;buf_dp_size_i(:)=0 1676 do irhoij=1,nrhoij_in 1677 jrhoij=irhoij;if (paral_atom) jrhoij=atmtab(irhoij) 1678 cplex =pawrhoij_in(jrhoij)%cplex 1679 lmn2_size =pawrhoij_in(jrhoij)%lmn2_size 1680 nspden =pawrhoij_in(jrhoij)%nspden 1681 lmnmix =pawrhoij_in(jrhoij)%lmnmix_sz 1682 ngrhoij =pawrhoij_in(jrhoij)%ngrhoij 1683 use_rhoijp =pawrhoij_in(jrhoij)%use_rhoijp 1684 use_rhoijres=pawrhoij_in(jrhoij)%use_rhoijres 1685 use_rhoijim =pawrhoij_in(jrhoij)%use_rhoijim 1686 use_rhoij_ =pawrhoij_in(jrhoij)%use_rhoij_ 1687 buf_int_size_i(irhoij)=buf_int_size_i(irhoij)+16 1688 if (ngrhoij>0) buf_dp_size_i(irhoij)=buf_dp_size_i(irhoij)+cplex*lmn2_size*nspden*ngrhoij 1689 if (use_rhoijres>0) buf_dp_size_i(irhoij)=buf_dp_size_i(irhoij)+cplex*lmn2_size*nspden 1690 if (use_rhoijim>0) buf_dp_size_i(irhoij)=buf_dp_size_i(irhoij)+lmn2_size*nspden 1691 if (use_rhoijp>0) then 1692 nselect=pawrhoij_in(jrhoij)%nrhoijsel 1693 buf_int_size_i(irhoij)=buf_int_size_i(irhoij)+nselect 1694 buf_dp_size_i(irhoij)=buf_dp_size_i(irhoij)+cplex*nselect*nspden 1695 end if 1696 if (use_rhoij_>0) then 1697 rhoij_size2=size(pawrhoij_in(jrhoij)%rhoij_,dim=2) 1698 buf_dp_size_i(irhoij)=buf_dp_size_i(irhoij)+cplex*lmn2_size*rhoij_size2 1699 end if 1700 end do 1701 end if 1702 call xmpi_bcast(buf_int_size_i,master,mpicomm,ierr) 1703 call xmpi_bcast(buf_dp_size_i,master,mpicomm,ierr) 1704 buf_int_size_all=sum(buf_int_size_i) ; buf_dp_size_all=sum(buf_dp_size_i) 1705 1706 !Prepare buffers/tabs for communication 1707 if (paral_atom) then 1708 LIBPAW_ALLOCATE(count_int,(nproc_atom)) 1709 LIBPAW_ALLOCATE(count_dp,(nproc_atom)) 1710 LIBPAW_ALLOCATE(disp_int,(nproc_atom)) 1711 LIBPAW_ALLOCATE(disp_dp,(nproc_atom)) 1712 indx_int=0 1713 do iproc=1,nproc_atom 1714 ii=nrhoij_out_i(iproc) 1715 count_int(iproc)=sum(buf_int_size_i(indx_int+1:indx_int+ii)) 1716 count_dp (iproc)=sum(buf_dp_size_i (indx_int+1:indx_int+ii)) 1717 indx_int=indx_int+ii 1718 end do 1719 disp_int(1)=0;disp_dp(1)=0 1720 do iproc=2,nproc_atom 1721 disp_int(iproc)=disp_int(iproc-1)+count_int(iproc-1) 1722 disp_dp (iproc)=disp_dp (iproc-1)+count_dp (iproc-1) 1723 end do 1724 if (buf_int_size_all/=sum(count_int).or.buf_dp_size_all/=sum(count_dp)) then 1725 msg='(1) Wrong buffer sizes !' 1726 MSG_BUG(msg) 1727 end if 1728 buf_int_size=count_int(me_atom+1) 1729 buf_dp_size =count_dp(me_atom+1) 1730 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 1731 LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size)) 1732 if (me==master) then 1733 LIBPAW_POINTER_ALLOCATE(buf_int_all,(buf_int_size_all)) 1734 LIBPAW_POINTER_ALLOCATE(buf_dp_all ,(buf_dp_size_all)) 1735 else 1736 LIBPAW_POINTER_ALLOCATE(buf_int_all,(1)) 1737 LIBPAW_POINTER_ALLOCATE(buf_dp_all ,(1)) 1738 end if 1739 LIBPAW_DEALLOCATE(nrhoij_out_i) 1740 else 1741 buf_int_size=buf_int_size_all 1742 buf_dp_size =buf_dp_size_all 1743 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 1744 LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size)) 1745 buf_int_all => buf_int 1746 buf_dp_all => buf_dp 1747 end if 1748 LIBPAW_DEALLOCATE(buf_int_size_i) 1749 LIBPAW_DEALLOCATE(buf_dp_size_i) 1750 1751 !Fill input buffers 1752 if (me==master) then 1753 indx_int=1;indx_dp =1 1754 do irhoij=1,nrhoij_in 1755 jrhoij=irhoij;if (paral_atom) jrhoij=atmtab(irhoij) 1756 cplex =pawrhoij_in(jrhoij)%cplex 1757 lmn2_size =pawrhoij_in(jrhoij)%lmn2_size 1758 nspden =pawrhoij_in(jrhoij)%nspden 1759 lmnmix =pawrhoij_in(jrhoij)%lmnmix_sz 1760 ngrhoij =pawrhoij_in(jrhoij)%ngrhoij 1761 use_rhoijp =pawrhoij_in(jrhoij)%use_rhoijp 1762 nselect =pawrhoij_in(jrhoij)%nrhoijsel 1763 use_rhoijres=pawrhoij_in(jrhoij)%use_rhoijres 1764 use_rhoijim =pawrhoij_in(jrhoij)%use_rhoijim 1765 use_rhoij_ =pawrhoij_in(jrhoij)%use_rhoij_ 1766 rhoij_size2 =size(pawrhoij_in(jrhoij)%rhoij_,dim=2) 1767 buf_int_all(indx_int)=jrhoij ;indx_int=indx_int+1 ! Not used ! 1768 buf_int_all(indx_int)=cplex ;indx_int=indx_int+1 1769 buf_int_all(indx_int)=lmn2_size ;indx_int=indx_int+1 1770 buf_int_all(indx_int)=nspden ;indx_int=indx_int+1 1771 buf_int_all(indx_int)=nselect ;indx_int=indx_int+1 1772 buf_int_all(indx_int)=lmnmix ;indx_int=indx_int+1 1773 buf_int_all(indx_int)=ngrhoij ;indx_int=indx_int+1 1774 buf_int_all(indx_int)=use_rhoijp ;indx_int=indx_int+1 1775 buf_int_all(indx_int)=use_rhoijres ;indx_int=indx_int+1 1776 buf_int_all(indx_int)=use_rhoijim ;indx_int=indx_int+1 1777 buf_int_all(indx_int)=use_rhoij_ ;indx_int=indx_int+1 1778 buf_int_all(indx_int)=rhoij_size2 ;indx_int=indx_int+1 1779 buf_int_all(indx_int)=pawrhoij_in(jrhoij)%itypat ;indx_int=indx_int+1 1780 buf_int_all(indx_int)=pawrhoij_in(jrhoij)%lmn_size;indx_int=indx_int+1 1781 buf_int_all(indx_int)=pawrhoij_in(jrhoij)%nsppol ;indx_int=indx_int+1 1782 buf_int_all(indx_int)=pawrhoij_in(jrhoij)%nspinor ;indx_int=indx_int+1 1783 if (use_rhoijp>0) then 1784 buf_int_all(indx_int:indx_int+nselect-1)=pawrhoij_in(jrhoij)%rhoijselect(1:nselect) 1785 indx_int=indx_int+nselect 1786 do isp=1,nspden 1787 buf_dp_all(indx_dp:indx_dp+cplex*nselect-1)=pawrhoij_in(jrhoij)%rhoijp(1:cplex*nselect,isp) 1788 indx_dp=indx_dp+cplex*nselect 1789 end do 1790 end if 1791 if (lmnmix>0) then 1792 buf_int_all(indx_int:indx_int+lmnmix-1)=pawrhoij_in(jrhoij)%kpawmix(1:lmnmix) 1793 indx_int=indx_int+lmnmix 1794 end if 1795 if (ngrhoij>0) then 1796 do isp=1,nspden 1797 do ii=1,cplex*lmn2_size 1798 buf_dp_all(indx_dp:indx_dp+ngrhoij-1)=pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,ii,isp) 1799 indx_dp=indx_dp+ngrhoij 1800 end do 1801 end do 1802 end if 1803 if (use_rhoijres>0) then 1804 do isp=1,nspden 1805 buf_dp_all(indx_dp:indx_dp+cplex*lmn2_size-1)=pawrhoij_in(jrhoij)%rhoijres(1:cplex*lmn2_size,isp) 1806 indx_dp=indx_dp+cplex*lmn2_size 1807 end do 1808 end if 1809 if (use_rhoijim>0) then 1810 do isp=1,nspden 1811 buf_dp_all(indx_dp:indx_dp+lmn2_size-1)=pawrhoij_in(jrhoij)%rhoijim(1:lmn2_size,isp) 1812 indx_dp=indx_dp+lmn2_size 1813 end do 1814 end if 1815 if (use_rhoij_>0) then 1816 do isp=1,rhoij_size2 1817 buf_dp_all(indx_dp:indx_dp+cplex*lmn2_size-1)=pawrhoij_in(jrhoij)%rhoij_(1:cplex*lmn2_size,isp) 1818 indx_dp=indx_dp+cplex*lmn2_size 1819 end do 1820 end if 1821 end do 1822 ! Check 1823 if ((indx_int-1/=buf_int_size_all).or.(indx_dp-1/=buf_dp_size_all)) then 1824 msg='(2) Wrong buffer sizes !' 1825 MSG_BUG(msg) 1826 end if 1827 end if ! me=master 1828 1829 !Communicate 1830 if (paral_atom) then 1831 call xmpi_scatterv(buf_int_all,count_int,disp_int,buf_int,buf_int_size,master,mpicomm,ierr) 1832 call xmpi_scatterv(buf_dp_all ,count_dp ,disp_dp ,buf_dp ,buf_dp_size ,master,mpicomm,ierr) 1833 else 1834 call xmpi_bcast(buf_int,master,mpicomm,ierr) 1835 call xmpi_bcast(buf_dp ,master,mpicomm,ierr) 1836 end if 1837 1838 !Retrieve data from output buffer 1839 indx_int=1;indx_dp=1 1840 call pawrhoij_free(pawrhoij_out) 1841 do irhoij=1,nrhoij_out 1842 jrhoij =buf_int(indx_int);indx_int=indx_int+1 ! Not used ! 1843 cplex =buf_int(indx_int);indx_int=indx_int+1 1844 lmn2_size =buf_int(indx_int);indx_int=indx_int+1 1845 nspden =buf_int(indx_int);indx_int=indx_int+1 1846 nselect =buf_int(indx_int);indx_int=indx_int+1 1847 lmnmix =buf_int(indx_int);indx_int=indx_int+1 1848 ngrhoij =buf_int(indx_int);indx_int=indx_int+1 1849 use_rhoijp =buf_int(indx_int);indx_int=indx_int+1 1850 use_rhoijres=buf_int(indx_int);indx_int=indx_int+1 1851 use_rhoijim =buf_int(indx_int);indx_int=indx_int+1 1852 use_rhoij_ =buf_int(indx_int);indx_int=indx_int+1 1853 rhoij_size2 =buf_int(indx_int);indx_int=indx_int+1 1854 pawrhoij_out(irhoij)%itypat=buf_int(indx_int) ;indx_int=indx_int+1 1855 pawrhoij_out(irhoij)%lmn_size=buf_int(indx_int);indx_int=indx_int+1 1856 pawrhoij_out(irhoij)%nsppol=buf_int(indx_int) ;indx_int=indx_int+1 1857 pawrhoij_out(irhoij)%nspinor=buf_int(indx_int) ;indx_int=indx_int+1 1858 pawrhoij_out(irhoij)%cplex=cplex 1859 pawrhoij_out(irhoij)%lmn2_size=lmn2_size 1860 pawrhoij_out(irhoij)%nspden=nspden 1861 pawrhoij_out(irhoij)%nrhoijsel=nselect 1862 pawrhoij_out(irhoij)%lmnmix_sz=lmnmix 1863 pawrhoij_out(irhoij)%ngrhoij=ngrhoij 1864 pawrhoij_out(irhoij)%use_rhoijp=use_rhoijp 1865 pawrhoij_out(irhoij)%use_rhoijres=use_rhoijres 1866 pawrhoij_out(irhoij)%use_rhoijim =use_rhoijim 1867 pawrhoij_out(irhoij)%use_rhoij_=use_rhoij_ 1868 if (use_rhoijp>0) then 1869 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijselect,(nselect)) 1870 pawrhoij_out(irhoij)%rhoijselect(1:nselect)=buf_int(indx_int:indx_int+nselect-1) 1871 indx_int=indx_int+nselect 1872 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijp,(cplex*nselect,nspden)) 1873 do isp=1,nspden 1874 pawrhoij_out(irhoij)%rhoijp(1:cplex*nselect,isp)=buf_dp(indx_dp:indx_dp+cplex*nselect-1) 1875 indx_dp=indx_dp+cplex*nselect 1876 end do 1877 end if 1878 if (lmnmix>0) then 1879 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%kpawmix,(lmnmix)) 1880 pawrhoij_out(irhoij)%kpawmix(1:lmnmix)=buf_int(indx_int:indx_int+lmnmix-1) 1881 indx_int=indx_int+lmnmix 1882 end if 1883 if (ngrhoij>0) then 1884 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%grhoij,(ngrhoij,cplex*lmn2_size,nspden)) 1885 do isp=1,nspden 1886 do ii=1,cplex*lmn2_size 1887 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,ii,isp)=buf_dp(indx_dp:indx_dp+ngrhoij-1) 1888 indx_dp=indx_dp+ngrhoij 1889 end do 1890 end do 1891 end if 1892 if (use_rhoijres>0) then 1893 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijres,(cplex*lmn2_size,nspden)) 1894 do isp=1,nspden 1895 pawrhoij_out(irhoij)%rhoijres(1:cplex*lmn2_size,isp)=buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1) 1896 indx_dp=indx_dp+cplex*lmn2_size 1897 end do 1898 end if 1899 if (use_rhoijim>0) then 1900 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijim,(lmn2_size,nspden)) 1901 do isp=1,nspden 1902 pawrhoij_out(irhoij)%rhoijim(1:cplex*lmn2_size,isp)=buf_dp(indx_dp:indx_dp+lmn2_size-1) 1903 indx_dp=indx_dp+lmn2_size 1904 end do 1905 end if 1906 if (use_rhoij_>0) then 1907 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoij_,(cplex*lmn2_size,rhoij_size2)) 1908 do isp=1,rhoij_size2 1909 pawrhoij_out(irhoij)%rhoij_(1:cplex*lmn2_size,isp)=buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1) 1910 indx_dp=indx_dp+cplex*lmn2_size 1911 end do 1912 end if 1913 end do 1914 !Check 1915 if ((indx_int/=1+buf_int_size).or.(indx_dp/=1+buf_dp_size)) then 1916 msg='(3) Wrong buffer sizes !' 1917 MSG_BUG(msg) 1918 end if 1919 1920 !Free memory 1921 LIBPAW_DEALLOCATE(buf_int) 1922 LIBPAW_DEALLOCATE(buf_dp) 1923 if (paral_atom) then 1924 LIBPAW_POINTER_DEALLOCATE(buf_int_all) 1925 LIBPAW_POINTER_DEALLOCATE(buf_dp_all) 1926 LIBPAW_DEALLOCATE(count_int) 1927 LIBPAW_DEALLOCATE(count_dp) 1928 LIBPAW_DEALLOCATE(disp_int) 1929 LIBPAW_DEALLOCATE(disp_dp) 1930 LIBPAW_DEALLOCATE(atmtab) 1931 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 1932 end if 1933 1934 end subroutine pawrhoij_bcast
m_pawrhoij/pawrhoij_copy [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_copy
FUNCTION
Copy one pawrhoij datastructure into another Can take into accound changes of dimensions Can copy a shared pawrhoij into distributed ones (when parallelism is activated)
INPUTS
keep_cplex= optional argument (logical, default=.TRUE.)
if .TRUE. pawrhoij_out(:)%cplex is NOT MODIFIED,
even if different from pawrhoij_in(:)%cplex
keep_itypat= optional argument (logical, default=.FALSE.)
if .TRUE. pawrhoij_out(:)%ityp is NOT MODIFIED,
even if different from pawrhoij_in(:)%ityp
keep_nspden= optional argument (logical, default=.TRUE.)
if .TRUE. pawrhoij_out(:)%nspden is NOT MODIFIED,
even if different from pawrhoij_in(:)%nspden
mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc
comm_atom=--optional-- MPI communicator over atoms
pawrhoij_in(:)<type(pawrhoij_type)>= input rhoij datastructure
SIDE EFFECTS
pawrhoij_out(:)<type(pawrhoij_type)>= output rhoij datastructure
NOTES
In case of a single copy operation pawrhoij_out must have been allocated.
PARENTS
bethe_salpeter,dfpt_looppert,gstate,inwffil,m_electronpositron,m_hdr m_ioarr,m_pawrhoij,m_wfk,outscfcv,pawmkrho,respfn,screening,setup_bse setup_positron,setup_screening,setup_sigma,sigma,wfk_analyze
CHILDREN
SOURCE
558 subroutine pawrhoij_copy(pawrhoij_in,pawrhoij_cpy, & 559 & keep_cplex,keep_itypat,keep_nspden,& ! optional arguments 560 & mpi_atmtab,comm_atom) ! optional arguments (parallelism) 561 562 563 !This section has been created automatically by the script Abilint (TD). 564 !Do not modify the following lines by hand. 565 #undef ABI_FUNC 566 #define ABI_FUNC 'pawrhoij_copy' 567 !End of the abilint section 568 569 implicit none 570 571 !Arguments ------------------------------------ 572 !scalars 573 integer,optional,intent(in) :: comm_atom 574 logical,intent(in),optional :: keep_cplex,keep_itypat,keep_nspden 575 !arrays 576 integer,optional,target,intent(in) :: mpi_atmtab(:) 577 type(pawrhoij_type),intent(in) :: pawrhoij_in(:) 578 type(pawrhoij_type),intent(inout),target :: pawrhoij_cpy(:) 579 580 !Local variables------------------------------- 581 !scalars 582 integer :: cplex_in,cplex_out,dplex,dplex_in,dplex_out,i_in,i_out,ilmn 583 integer :: irhoij,ispden,jrhoij,lmn2_size_out,lmnmix,my_comm_atom,my_nrhoij 584 integer :: ngrhoij,nrhoij_in,nrhoij_max,nrhoij_out,nselect,nselect_out 585 integer :: nspden_in,nspden_out,paral_case,use_rhoij_,use_rhoijp,use_rhoijres,use_rhoijim 586 logical :: change_dim,keep_cplex_,keep_itypat_,keep_nspden_,my_atmtab_allocated,paral_atom 587 character(len=500) :: msg 588 !arrays 589 integer,pointer :: my_atmtab(:) 590 integer,allocatable :: nlmn(:),typat(:) 591 type(pawrhoij_type),pointer :: pawrhoij_out(:) 592 593 ! ************************************************************************* 594 595 !Retrieve sizes 596 nrhoij_in=size(pawrhoij_in);nrhoij_out=size(pawrhoij_cpy) 597 598 !Init flags 599 keep_cplex_=.true. 600 if (present(keep_cplex)) keep_cplex_=keep_cplex 601 keep_itypat_=.false. 602 if (present(keep_itypat)) keep_itypat_=keep_itypat 603 keep_nspden_=.true. 604 if (present(keep_nspden)) keep_nspden_=keep_nspden 605 606 !Set up parallelism over atoms 607 paral_atom=(present(comm_atom));if (paral_atom) paral_atom=(xmpi_comm_size(comm_atom)>1) 608 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 609 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 610 my_atmtab_allocated=.false. 611 612 !Determine in which case we are (parallelism, ...) 613 !No parallelism: a single copy operation 614 paral_case=0;nrhoij_max=nrhoij_in 615 pawrhoij_out => pawrhoij_cpy 616 if (paral_atom) then 617 if (nrhoij_out<nrhoij_in) then ! Parallelism: the copy operation is a scatter 618 call get_my_natom(my_comm_atom,my_nrhoij,nrhoij_in) 619 if (my_nrhoij==nrhoij_out) then 620 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,nrhoij_in) 621 paral_case=1;nrhoij_max=nrhoij_out 622 pawrhoij_out => pawrhoij_cpy 623 else 624 msg=' nrhoij_out should be equal to my_natom !' 625 MSG_BUG(msg) 626 end if 627 else ! Parallelism: the copy operation is a gather 628 call get_my_natom(my_comm_atom,my_nrhoij,nrhoij_out) 629 if (my_nrhoij==nrhoij_in) then 630 paral_case=2;nrhoij_max=nrhoij_in 631 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_out,(nrhoij_in)) 632 call pawrhoij_nullify(pawrhoij_out) 633 if (nrhoij_in>0) then 634 LIBPAW_ALLOCATE(typat,(nrhoij_in)) 635 LIBPAW_ALLOCATE(nlmn,(nrhoij_in)) 636 do irhoij=1,nrhoij_in 637 typat(irhoij)=irhoij;nlmn(irhoij)=pawrhoij_in(irhoij)%lmn_size 638 end do 639 call pawrhoij_alloc(pawrhoij_out,pawrhoij_cpy(1)%cplex,pawrhoij_cpy(1)%nspden,& 640 & pawrhoij_cpy(1)%nspinor,pawrhoij_cpy(1)%nsppol,typat,& 641 & lmnsize=nlmn,ngrhoij=pawrhoij_cpy(1)%ngrhoij,nlmnmix=pawrhoij_cpy(1)%lmnmix_sz,& 642 & use_rhoij_=pawrhoij_cpy(1)%use_rhoij_,& 643 & use_rhoijp=pawrhoij_cpy(1)%use_rhoijp,& 644 & use_rhoijres=pawrhoij_cpy(1)%use_rhoijres,& 645 & use_rhoijim=pawrhoij_cpy(1)%use_rhoijim) 646 LIBPAW_DEALLOCATE(typat) 647 LIBPAW_DEALLOCATE(nlmn) 648 end if 649 else 650 msg=' nrhoij_in should be equal to my_natom !' 651 MSG_BUG(msg) 652 end if 653 end if 654 end if 655 656 !Loop on rhoij components 657 if (nrhoij_max>0) then 658 do irhoij=1,nrhoij_max 659 jrhoij=irhoij;if (paral_case==1) jrhoij=my_atmtab(irhoij) 660 661 lmn2_size_out=pawrhoij_in(jrhoij)%lmn2_size 662 cplex_in=pawrhoij_in(jrhoij)%cplex 663 cplex_out=cplex_in;if(keep_cplex_)cplex_out=pawrhoij_out(irhoij)%cplex 664 nspden_in=pawrhoij_in(jrhoij)%nspden 665 nselect=pawrhoij_in(jrhoij)%nrhoijsel 666 nselect_out=pawrhoij_out(irhoij)%nrhoijsel 667 nspden_out=nspden_in;if(keep_nspden_)nspden_out=pawrhoij_out(irhoij)%nspden 668 669 change_dim=(pawrhoij_out(irhoij)%cplex/=cplex_out.or. & 670 & pawrhoij_out(irhoij)%lmn2_size/=lmn2_size_out.or. & 671 & pawrhoij_out(irhoij)%nspden/=nspden_out.or. & 672 & nselect/=nselect_out) 673 dplex_in=cplex_in-1;dplex_out=cplex_out-1 674 dplex=min(dplex_in,dplex_out) 675 676 ! Scalars 677 pawrhoij_out(irhoij)%cplex=cplex_out+0 678 pawrhoij_out(irhoij)%nspden=nspden_out+0 679 pawrhoij_out(irhoij)%lmn2_size=lmn2_size_out+0 680 pawrhoij_out(irhoij)%lmn_size=pawrhoij_in(jrhoij)%lmn_size+0 681 if(.not.keep_itypat_) pawrhoij_out(irhoij)%itypat =pawrhoij_in(jrhoij)%itypat+0 682 if(.not.keep_nspden_) pawrhoij_out(irhoij)%nsppol =pawrhoij_in(jrhoij)%nsppol+0 683 if(.not.keep_nspden_) pawrhoij_out(irhoij)%nspinor=pawrhoij_in(jrhoij)%nspinor+0 684 pawrhoij_out(irhoij)%nrhoijsel=nselect+0 685 ! if (pawrhoij_out(irhoij)%itypat/=pawrhoij_in(jrhoij)%itypat) then 686 ! write(unit=msg,fmt='(a,i3,a)') 'Type of atom ',jrhoij,' is different (dont copy it) !' 687 ! MSG_COMMENT(msg) 688 ! end if 689 690 ! Optional pointer: non-zero elements of rhoij 691 use_rhoijp=pawrhoij_in(jrhoij)%use_rhoijp 692 if (pawrhoij_out(irhoij)%use_rhoijp/=use_rhoijp) then 693 if (pawrhoij_out(irhoij)%use_rhoijp>0) then 694 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijp) 695 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijselect) 696 end if 697 if (use_rhoijp>0) then 698 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijp,(cplex_out*lmn2_size_out,nspden_out)) 699 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijselect,(lmn2_size_out)) 700 end if 701 pawrhoij_out(irhoij)%use_rhoijp=use_rhoijp 702 end if 703 if (use_rhoijp>0) then 704 if (change_dim) then 705 if(allocated(pawrhoij_out(irhoij)%rhoijp)) then 706 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijp) 707 end if 708 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijp,(cplex_out*lmn2_size_out,nspden_out)) 709 end if 710 if (cplex_out==cplex_in.and.nspden_out==nspden_in) then 711 do ispden=1,nspden_out 712 pawrhoij_out(irhoij)%rhoijp(1:cplex_out*nselect,ispden)=pawrhoij_in(jrhoij)%rhoijp(1:cplex_out*nselect,ispden)+zero 713 if ( (nselect<lmn2_size_out) .and. & 714 & (size(pawrhoij_out(irhoij)%rhoijp(:,ispden))==cplex_out*lmn2_size_out) ) then 715 pawrhoij_out(irhoij)%rhoijp(cplex_out*nselect+1:cplex_out*lmn2_size_out,ispden)=zero 716 end if 717 end do 718 else 719 pawrhoij_out(irhoij)%rhoijp(:,:)=zero 720 if (nspden_out==1) then 721 if (nspden_in==2) then 722 do ilmn=1,nselect 723 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 724 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1) & 725 & +pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,2)+zero 726 end do 727 else ! nspden_in==1 or nspden_in=4 728 do ilmn=1,nselect 729 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 730 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1)+zero 731 end do 732 end if 733 else if (nspden_out==2) then 734 if (nspden_in==1) then 735 do ilmn=1,nselect 736 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 737 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1)=half*pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1)+zero 738 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,2)=half*pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1)+zero 739 end do 740 else if (nspden_in==2) then 741 do ilmn=1,nselect 742 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 743 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1:2)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1:2)+zero 744 end do 745 else ! nspden_in==4 746 do ilmn=1,nselect 747 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 748 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1)=half*(pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1) & 749 & +pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,4))+zero 750 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,2)=half*(pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1) & 751 & -pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,4))+zero 752 end do 753 end if 754 else if (nspden_out==4) then 755 if (nspden_in==1) then 756 do ilmn=1,nselect 757 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 758 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1)+zero 759 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,2:4)=zero 760 end do 761 else if (nspden_in==2) then 762 do ilmn=1,nselect 763 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 764 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1) & 765 & +pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,2)+zero 766 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,4)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1) & 767 & -pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,2)+zero 768 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,2:3)=zero 769 end do 770 else ! nspden_in==4 771 do ilmn=1,nselect 772 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 773 pawrhoij_out(irhoij)%rhoijp(i_out:i_out+dplex,1:4)=pawrhoij_in(jrhoij)%rhoijp(i_in:i_in+dplex,1:4)+zero 774 end do 775 end if 776 end if 777 end if 778 end if 779 780 ! Optional pointer: indexes for non-zero elements selection 781 if (use_rhoijp>0) then 782 if (change_dim) then 783 if(allocated(pawrhoij_out(irhoij)%rhoijselect)) then 784 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijselect) 785 end if 786 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijselect,(lmn2_size_out)) 787 end if 788 pawrhoij_out(irhoij)%rhoijselect(1:nselect)=pawrhoij_in(jrhoij)%rhoijselect(1:nselect)+0 789 if ( (nselect<lmn2_size_out) .and. & 790 & (size(pawrhoij_out(irhoij)%rhoijselect(:))==lmn2_size_out) ) then 791 pawrhoij_out(irhoij)%rhoijselect(nselect+1:lmn2_size_out)=0 792 end if 793 end if 794 795 ! Optional pointer: indexes of rhoij to be mixed 796 lmnmix=pawrhoij_in(jrhoij)%lmnmix_sz 797 if (pawrhoij_out(irhoij)%lmnmix_sz/=lmnmix) then 798 if (pawrhoij_out(irhoij)%lmnmix_sz>0) then 799 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%kpawmix) 800 end if 801 if (lmnmix>0) then 802 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%kpawmix,(lmnmix)) 803 end if 804 pawrhoij_out(irhoij)%lmnmix_sz=lmnmix 805 end if 806 if (lmnmix>0) pawrhoij_out(irhoij)%kpawmix(1:lmnmix)=pawrhoij_in(jrhoij)%kpawmix(1:lmnmix) 807 808 ! Optional pointer: gradients of rhoij 809 ngrhoij=pawrhoij_in(jrhoij)%ngrhoij 810 if (pawrhoij_out(irhoij)%ngrhoij/=ngrhoij) then 811 if (pawrhoij_out(irhoij)%ngrhoij>0) then 812 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%grhoij) 813 end if 814 if (ngrhoij>0) then 815 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%grhoij,(ngrhoij,cplex_out*lmn2_size_out,nspden_out)) 816 end if 817 pawrhoij_out(irhoij)%ngrhoij=ngrhoij 818 end if 819 if (ngrhoij>0) then 820 if (change_dim) then 821 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%grhoij) 822 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%grhoij,(ngrhoij,cplex_out*lmn2_size_out,nspden_out)) 823 end if 824 if (cplex_out==cplex_in.and.nspden_out==nspden_in) then 825 do ispden=1,nspden_out 826 do ilmn=1,cplex_out*lmn2_size_out 827 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,ilmn,ispden)= & 828 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,ilmn,ispden)+zero 829 end do 830 end do 831 else 832 pawrhoij_out(irhoij)%grhoij(:,:,:)=zero 833 if (nspden_out==1) then 834 if (nspden_in==2) then 835 do ilmn=1,lmn2_size_out 836 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 837 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1)= & 838 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1) & 839 & +pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,2)+zero 840 end do 841 else ! nspden_in==4 842 do ilmn=1,lmn2_size_out 843 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 844 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1)= & 845 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1)+zero 846 end do 847 end if 848 else if (nspden_out==2) then 849 if (nspden_in==1) then 850 do ilmn=1,lmn2_size_out 851 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 852 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1)= & 853 & half*pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1)+zero 854 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,2)= & 855 & half*pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1)+zero 856 end do 857 else if (nspden_in==2) then 858 do ilmn=1,lmn2_size_out 859 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 860 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1:2)= & 861 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1:2)+zero 862 end do 863 else ! nspden_in==4 864 do ilmn=1,lmn2_size_out 865 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 866 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1)= & 867 & half*(pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1) & 868 & +pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,4))+zero 869 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,2)= & 870 & half*(pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1) & 871 & -pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,4))+zero 872 end do 873 end if 874 else if (nspden_out==4) then 875 if (nspden_in==1) then 876 do ilmn=1,lmn2_size_out 877 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 878 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1)= & 879 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1)+zero 880 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,2:4)=zero 881 end do 882 else if (nspden_in==2) then 883 do ilmn=1,lmn2_size_out 884 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 885 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1)= & 886 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1) & 887 & +pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,2)+zero 888 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,4)= & 889 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1) & 890 & -pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,2)+zero 891 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,2:3)=zero 892 end do 893 else ! nspden_in==4 894 do ilmn=1,lmn2_size_out 895 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 896 pawrhoij_out(irhoij)%grhoij(1:ngrhoij,i_out:i_out+dplex,1:4)= & 897 & pawrhoij_in(jrhoij)%grhoij(1:ngrhoij,i_in:i_in+dplex,1:4)+zero 898 end do 899 end if 900 end if 901 end if 902 end if 903 904 ! Optional pointer: residuals of rhoij 905 use_rhoijres=pawrhoij_in(jrhoij)%use_rhoijres 906 if (pawrhoij_out(irhoij)%use_rhoijres/=use_rhoijres) then 907 if (pawrhoij_out(irhoij)%use_rhoijres>0) then 908 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijres) 909 end if 910 if (use_rhoijres>0) then 911 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijres,(cplex_out*lmn2_size_out,nspden_out)) 912 end if 913 pawrhoij_out(irhoij)%use_rhoijres=use_rhoijres 914 end if 915 if (use_rhoijres>0) then 916 if (change_dim) then 917 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijres) 918 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijres,(cplex_out*lmn2_size_out,nspden_out)) 919 end if 920 if (cplex_out==cplex_in.and.nspden_out==nspden_in) then 921 do ispden=1,nspden_out 922 do ilmn=1,cplex_out*lmn2_size_out 923 pawrhoij_out(irhoij)%rhoijres(ilmn,ispden)=pawrhoij_in(jrhoij)%rhoijres(ilmn,ispden)+zero 924 end do 925 end do 926 else 927 pawrhoij_out(irhoij)%rhoijres(:,:)=zero 928 if (nspden_out==1) then 929 if (nspden_in==2) then 930 do ilmn=1,lmn2_size_out 931 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 932 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1) & 933 & +pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,2)+zero 934 end do 935 else ! nspden_in==4 936 do ilmn=1,lmn2_size_out 937 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 938 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1)+zero 939 end do 940 end if 941 else if (nspden_out==2) then 942 if (nspden_in==1) then 943 do ilmn=1,lmn2_size_out 944 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 945 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1)=half*pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1)+zero 946 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,2)=half*pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1)+zero 947 end do 948 else if (nspden_in==2) then 949 do ilmn=1,lmn2_size_out 950 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 951 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1:2)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1:2)+zero 952 end do 953 else ! nspden_in==4 954 do ilmn=1,lmn2_size_out 955 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 956 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1)=half*(pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1) & 957 & +pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,4))+zero 958 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,2)=half*(pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1) & 959 & -pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,4))+zero 960 end do 961 end if 962 else if (nspden_out==4) then 963 if (nspden_in==1) then 964 do ilmn=1,lmn2_size_out 965 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 966 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1)+zero 967 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,2:4)=zero 968 end do 969 else if (nspden_in==2) then 970 do ilmn=1,lmn2_size_out 971 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 972 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1) & 973 & +pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,2)+zero 974 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,4)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1) & 975 & -pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,2)+zero 976 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,2:3)=zero 977 end do 978 else ! nspden_in==4 979 do ilmn=1,lmn2_size_out 980 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 981 pawrhoij_out(irhoij)%rhoijres(i_out:i_out+dplex,1:4)=pawrhoij_in(jrhoij)%rhoijres(i_in:i_in+dplex,1:4)+zero 982 end do 983 end if 984 end if 985 end if 986 end if 987 988 ! Optional pointer: imaginary part of rhoij 989 use_rhoijim=pawrhoij_in(jrhoij)%use_rhoijim 990 if (pawrhoij_out(irhoij)%use_rhoijim/=use_rhoijim) then 991 if (pawrhoij_out(irhoij)%use_rhoijim>0) then 992 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijim) 993 end if 994 if (use_rhoijim>0) then 995 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijim,(lmn2_size_out,nspden_out)) 996 end if 997 pawrhoij_out(irhoij)%use_rhoijim=use_rhoijim 998 end if 999 if (use_rhoijim>0) then 1000 if (change_dim) then 1001 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoijim) 1002 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoijim,(lmn2_size_out,nspden_out)) 1003 end if 1004 if (nspden_out==nspden_in) then 1005 do ispden=1,nspden_out 1006 do ilmn=1,lmn2_size_out 1007 pawrhoij_out(irhoij)%rhoijim(ilmn,ispden)=pawrhoij_in(jrhoij)%rhoijim(ilmn,ispden)+zero 1008 end do 1009 end do 1010 else 1011 pawrhoij_out(irhoij)%rhoijim(:,:)=zero 1012 if (nspden_out==1) then 1013 if (nspden_in==2) then 1014 do ilmn=1,lmn2_size_out 1015 i_in=ilmn;i_out=ilmn 1016 pawrhoij_out(irhoij)%rhoijim(i_out,1)=pawrhoij_in(jrhoij)%rhoijim(i_in,1) & 1017 & +pawrhoij_in(jrhoij)%rhoijim(i_in,2)+zero 1018 end do 1019 else ! nspden_in==4 1020 do ilmn=1,lmn2_size_out 1021 i_in=ilmn;i_out=ilmn 1022 pawrhoij_out(irhoij)%rhoijim(i_out,1)=pawrhoij_in(jrhoij)%rhoijim(i_in,1)+zero 1023 end do 1024 end if 1025 else if (nspden_out==2) then 1026 if (nspden_in==1) then 1027 do ilmn=1,lmn2_size_out 1028 i_in=ilmn;i_out=ilmn 1029 pawrhoij_out(irhoij)%rhoijim(i_out,1)=half*pawrhoij_in(jrhoij)%rhoijim(i_in,1)+zero 1030 pawrhoij_out(irhoij)%rhoijim(i_out,2)=half*pawrhoij_in(jrhoij)%rhoijim(i_in,1)+zero 1031 end do 1032 else if (nspden_in==2) then 1033 do ilmn=1,lmn2_size_out 1034 i_in=ilmn;i_out=ilmn 1035 pawrhoij_out(irhoij)%rhoijim(i_out,1:2)=pawrhoij_in(jrhoij)%rhoijim(i_in,1:2)+zero 1036 end do 1037 else ! nspden_in==4 1038 do ilmn=1,lmn2_size_out 1039 i_in=ilmn;i_out=ilmn 1040 pawrhoij_out(irhoij)%rhoijim(i_out,1)=half*(pawrhoij_in(jrhoij)%rhoijim(i_in,1) & 1041 & +pawrhoij_in(jrhoij)%rhoijim(i_in,4))+zero 1042 pawrhoij_out(irhoij)%rhoijim(i_out,2)=half*(pawrhoij_in(jrhoij)%rhoijim(i_in,1) & 1043 & -pawrhoij_in(jrhoij)%rhoijim(i_in,4))+zero 1044 end do 1045 end if 1046 else if (nspden_out==4) then 1047 if (nspden_in==1) then 1048 do ilmn=1,lmn2_size_out 1049 i_in=ilmn;i_out=ilmn 1050 pawrhoij_out(irhoij)%rhoijim(i_out,1)=pawrhoij_in(jrhoij)%rhoijim(i_in,1)+zero 1051 pawrhoij_out(irhoij)%rhoijim(i_out,2:4)=zero 1052 end do 1053 else if (nspden_in==2) then 1054 do ilmn=1,lmn2_size_out 1055 i_in=ilmn;i_out=ilmn 1056 pawrhoij_out(irhoij)%rhoijim(i_out,1)=pawrhoij_in(jrhoij)%rhoijim(i_in,1) & 1057 & +pawrhoij_in(jrhoij)%rhoijim(i_in,2)+zero 1058 pawrhoij_out(irhoij)%rhoijim(i_out,4)=pawrhoij_in(jrhoij)%rhoijim(i_in,1) & 1059 & -pawrhoij_in(jrhoij)%rhoijim(i_in,2)+zero 1060 pawrhoij_out(irhoij)%rhoijim(i_out,2:3)=zero 1061 end do 1062 else ! nspden_in==4 1063 do ilmn=1,lmn2_size_out 1064 i_in=ilmn;i_out=ilmn 1065 pawrhoij_out(irhoij)%rhoijim(i_out,1:4)=pawrhoij_in(jrhoij)%rhoijim(i_in,1:4)+zero 1066 end do 1067 end if 1068 end if 1069 end if 1070 end if 1071 1072 ! Optional pointer: non-symmetrized rhoij 1073 use_rhoij_=pawrhoij_in(jrhoij)%use_rhoij_ 1074 if (pawrhoij_out(irhoij)%use_rhoij_/=use_rhoij_) then 1075 if (pawrhoij_out(irhoij)%use_rhoij_>0) then 1076 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoij_) 1077 end if 1078 if (use_rhoij_>0) then 1079 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoij_,(cplex_out*lmn2_size_out,nspden_out)) 1080 end if 1081 pawrhoij_out(irhoij)%use_rhoij_=use_rhoij_ 1082 end if 1083 if (use_rhoij_>0) then 1084 if (change_dim) then 1085 if(allocated(pawrhoij_out(irhoij)%rhoij_)) then 1086 LIBPAW_DEALLOCATE(pawrhoij_out(irhoij)%rhoij_) 1087 end if 1088 LIBPAW_ALLOCATE(pawrhoij_out(irhoij)%rhoij_,(cplex_out*lmn2_size_out,nspden_out)) 1089 end if 1090 if (cplex_out==cplex_in.and.nspden_out==nspden_in) then 1091 do ispden=1,nspden_out 1092 do ilmn=1,cplex_out*lmn2_size_out 1093 pawrhoij_out(irhoij)%rhoij_(ilmn,ispden)=pawrhoij_in(jrhoij)%rhoij_(ilmn,ispden)+zero 1094 end do 1095 end do 1096 else 1097 pawrhoij_out(irhoij)%rhoij_(:,:)=zero 1098 if (nspden_out==1) then 1099 if (nspden_in==2) then 1100 do ilmn=1,lmn2_size_out 1101 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1102 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1) & 1103 & +pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,2)+zero 1104 end do 1105 else ! nspden_in==1 or nspden_in==4 1106 do ilmn=1,lmn2_size_out 1107 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1108 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1)+zero 1109 end do 1110 end if 1111 else if (nspden_out==2) then 1112 if (nspden_in==1) then 1113 do ilmn=1,lmn2_size_out 1114 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1115 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1)=half*pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1)+zero 1116 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,2)=half*pawrhoij_in(irhoij)%rhoij_(i_in:i_in+dplex,1)+zero 1117 end do 1118 else if (nspden_in==2) then 1119 do ilmn=1,lmn2_size_out 1120 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1121 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1:2)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1:2)+zero 1122 end do 1123 else ! nspden_in==4 1124 do ilmn=1,lmn2_size_out 1125 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1126 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1)=half*(pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1) & 1127 & +pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,4))+zero 1128 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,2)=half*(pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1) & 1129 & -pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,4))+zero 1130 end do 1131 end if 1132 else if (nspden_out==4) then 1133 if (nspden_in==1) then 1134 do ilmn=1,lmn2_size_out 1135 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1136 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1)+zero 1137 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,2:4)=zero 1138 end do 1139 else if (nspden_in==2) then 1140 do ilmn=1,lmn2_size_out 1141 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1142 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1) & 1143 & +pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,2)+zero 1144 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,4)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1) & 1145 & -pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,2)+zero 1146 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,2:3)=zero 1147 end do 1148 else ! nspden_in==4 1149 do ilmn=1,lmn2_size_out 1150 i_in=cplex_in*ilmn-dplex_in;i_out=cplex_out*ilmn-dplex_out 1151 pawrhoij_out(irhoij)%rhoij_(i_out:i_out+dplex,1:4)=pawrhoij_in(jrhoij)%rhoij_(i_in:i_in+dplex,1:4)+zero 1152 end do 1153 end if 1154 end if 1155 end if 1156 end if 1157 1158 end do ! irhoij 1159 end if 1160 1161 !Parallel case: do a gather if needed 1162 if (paral_case==2) then 1163 call pawrhoij_free(pawrhoij_cpy) 1164 call pawrhoij_gather(pawrhoij_out,pawrhoij_cpy,-1,my_comm_atom) 1165 call pawrhoij_free(pawrhoij_out) 1166 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij_out) 1167 1168 ! Sequential case: fill missing elements 1169 else if (paral_case==0) then 1170 if (nrhoij_in<nrhoij_out) then 1171 do irhoij=nrhoij_in+1,nrhoij_out 1172 pawrhoij_cpy(irhoij)%nrhoijsel=0 1173 if (pawrhoij_cpy(irhoij)%use_rhoijp>0) then 1174 pawrhoij_cpy(irhoij)%rhoijselect=0 1175 pawrhoij_cpy(irhoij)%rhoijp=zero 1176 end if 1177 if (pawrhoij_cpy(irhoij)%lmnmix_sz>0) pawrhoij_cpy(irhoij)%kpawmix=0 1178 if (pawrhoij_cpy(irhoij)%ngrhoij>0) pawrhoij_cpy(irhoij)%grhoij=zero 1179 if (pawrhoij_cpy(irhoij)%use_rhoij_>0) pawrhoij_cpy(irhoij)%rhoij_=zero 1180 if (pawrhoij_cpy(irhoij)%use_rhoijres>0) pawrhoij_cpy(irhoij)%rhoijres=zero 1181 if (pawrhoij_cpy(irhoij)%use_rhoijim>0) pawrhoij_cpy(irhoij)%rhoijim=zero 1182 end do 1183 end if 1184 end if 1185 1186 !Destroy atom table used for parallelism 1187 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 1188 1189 end subroutine pawrhoij_copy
m_pawrhoij/pawrhoij_free [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_free
FUNCTION
Destroy a pawrhoij datastructure
SIDE EFFECTS
pawrhoij(:)<type(pawrhoij_type)>= rhoij datastructure
PARENTS
bethe_salpeter,d2frnl,dfpt_looppert,dfpt_nstpaw,dfpt_rhofermi dfpt_scfcv,dfpt_vtorho,energy,gstate,m_electronpositron,m_hdr,m_ioarr m_paral_pert,m_pawrhoij,m_scf_history,mrgscr,pawgrnl,pawmkrho pawmkrhoij,pawprt,posdoppler,respfn,screening,setup_bse,setup_positron setup_screening,setup_sigma,sigma,vtorho,wfk_analyze
CHILDREN
SOURCE
397 subroutine pawrhoij_free(pawrhoij) 398 399 400 !This section has been created automatically by the script Abilint (TD). 401 !Do not modify the following lines by hand. 402 #undef ABI_FUNC 403 #define ABI_FUNC 'pawrhoij_free' 404 !End of the abilint section 405 406 implicit none 407 408 !Arguments ------------------------------------ 409 !arrays 410 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 411 412 !Local variables------------------------------- 413 !scalars 414 integer :: irhoij,nrhoij 415 416 ! ************************************************************************* 417 418 nrhoij=size(pawrhoij) 419 420 if (nrhoij>0) then 421 do irhoij=1,nrhoij 422 pawrhoij(irhoij)%nrhoijsel=0 423 pawrhoij(irhoij)%ngrhoij=0 424 pawrhoij(irhoij)%lmnmix_sz=0 425 pawrhoij(irhoij)%use_rhoij_=0 426 pawrhoij(irhoij)%use_rhoijp=0 427 pawrhoij(irhoij)%use_rhoijres=0 428 pawrhoij(irhoij)%use_rhoijim=0 429 if (allocated(pawrhoij(irhoij)%rhoijp)) then 430 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%rhoijp) 431 end if 432 if (allocated(pawrhoij(irhoij)%rhoijselect)) then 433 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%rhoijselect) 434 end if 435 if (allocated(pawrhoij(irhoij)%grhoij)) then 436 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%grhoij) 437 end if 438 if (allocated(pawrhoij(irhoij)%kpawmix)) then 439 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%kpawmix) 440 end if 441 if (allocated(pawrhoij(irhoij)%rhoij_)) then 442 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%rhoij_) 443 end if 444 if (allocated(pawrhoij(irhoij)%rhoijres)) then 445 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%rhoijres) 446 end if 447 if (allocated(pawrhoij(irhoij)%rhoijim)) then 448 LIBPAW_DEALLOCATE(pawrhoij(irhoij)%rhoijim) 449 end if 450 end do 451 end if 452 453 end subroutine pawrhoij_free
m_pawrhoij/pawrhoij_free_unpacked [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_free_unpacked
FUNCTION
Destroy field of rhoij datastructure for unpacked values (pawrhoij%rhoij_ array)
SIDE EFFECTS
rhoij(:) <pawrhoij_type)>= input/output datastructure * In output the rhoij_ array is deallocated
PARENTS
dfpt_rhofermi,energy,pawmkrho
CHILDREN
SOURCE
2853 subroutine pawrhoij_free_unpacked(rhoij) 2854 2855 2856 !This section has been created automatically by the script Abilint (TD). 2857 !Do not modify the following lines by hand. 2858 #undef ABI_FUNC 2859 #define ABI_FUNC 'pawrhoij_free_unpacked' 2860 !End of the abilint section 2861 2862 implicit none 2863 2864 !Arguments ------------------------------------ 2865 !scalars 2866 !arrays 2867 type(pawrhoij_type),intent(inout) :: rhoij(:) 2868 2869 !Local variables------------------------------- 2870 integer :: iat,nrhoij 2871 2872 ! ************************************************************************* 2873 2874 nrhoij=SIZE(rhoij);if (nrhoij==0) return 2875 2876 do iat=1,nrhoij 2877 2878 if (allocated(rhoij(iat)%rhoij_)) then 2879 LIBPAW_DEALLOCATE(rhoij(iat)%rhoij_) 2880 end if 2881 rhoij(iat)%use_rhoij_=0 2882 2883 end do 2884 2885 end subroutine pawrhoij_free_unpacked
m_pawrhoij/pawrhoij_gather [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_gather
FUNCTION
(All)Gather pawrhoij datastructures
INPUTS
master=master communicator receiving data ; if -1 do a ALLGATHER comm_atom= communicator pawrhoij_in(:)<type(pawrhoij_type)>= input rhoij datastructures on every process with_grhoij : optional argument (logical, default=.TRUE.) TRUE if pawrhoij%grhoij field is included in the gather operation with_lmnmix : optional argument (logical, default=.TRUE.) TRUE if pawrhoij%lmnmix field is included in the gather operation with_rhoijp : optional argument (logical, default=.TRUE.) TRUE if pawrhoij%rhoijp and pawrhoij%rhoijselect fields are included in the gather operation with_rhoijres : optional argument (logical, default=.TRUE.) TRUE if pawrhoij%rhoijres field is included in the gather operation with_rhoijim : optional argument (logical, default=.TRUE.) TRUE if pawrhoij%rhoijim field is included in the gather operation with_rhoij_ : optional argument (logical, default=.TRUE.) TRUE if pawrhoij%rhoij_ field is included in the gather operation
OUTPUT
pawrhoij_gathered(:)<type(pawrhoij_type)>= output rhoij datastructure
NOTES
The gathered structure are ordered like in sequential mode.
PARENTS
d2frnl,m_pawrhoij,pawgrnl,pawprt,posdoppler
CHILDREN
SOURCE
1233 subroutine pawrhoij_gather(pawrhoij_in,pawrhoij_gathered,master,comm_atom, & 1234 & with_grhoij,with_lmnmix,with_rhoijp,with_rhoijres,with_rhoijim,with_rhoij_) ! optional arguments 1235 1236 1237 !This section has been created automatically by the script Abilint (TD). 1238 !Do not modify the following lines by hand. 1239 #undef ABI_FUNC 1240 #define ABI_FUNC 'pawrhoij_gather' 1241 !End of the abilint section 1242 1243 implicit none 1244 1245 !Arguments ------------------------------------ 1246 !scalars 1247 integer,intent(in) :: master,comm_atom 1248 logical,intent(in),optional :: with_grhoij,with_lmnmix,with_rhoijp,with_rhoijres,with_rhoijim,with_rhoij_ 1249 !arrays 1250 type(pawrhoij_type),intent(in) :: pawrhoij_in(:) 1251 type(pawrhoij_type),intent(inout) :: pawrhoij_gathered(:) 1252 !Local variables------------------------------- 1253 !scalars 1254 integer :: buf_dp_size,buf_dp_size_all,buf_int_size,buf_int_size_all 1255 integer :: cplex,ierr,ii,indx_dp,indx_int,irhoij,isp,jrhoij,lmn2_size,lmnmix,me_atom 1256 integer :: ngrhoij,nproc_atom,nrhoij_in,nrhoij_in_sum,nrhoij_out,nselect,nspden 1257 integer :: rhoij_size2,use_rhoijp,use_rhoijres,use_rhoijim,use_rhoij_ 1258 logical :: my_atmtab_allocated,paral_atom 1259 logical :: with_grhoij_,with_lmnmix_,with_rhoijp_,with_rhoijres_,with_rhoijim_,with_rhoij__ 1260 character(len=500) :: msg 1261 !arrays 1262 integer :: bufsz(2) 1263 integer,allocatable :: buf_int(:),buf_int_all(:) 1264 integer,allocatable :: count_dp(:),count_int(:),count_tot(:),displ_dp(:),displ_int(:) 1265 integer, pointer :: my_atmtab(:) 1266 real(dp),allocatable :: buf_dp(:),buf_dp_all(:) 1267 1268 ! ************************************************************************* 1269 1270 nrhoij_in=size(pawrhoij_in);nrhoij_out=size(pawrhoij_gathered) 1271 1272 nproc_atom=xmpi_comm_size(comm_atom) 1273 me_atom=xmpi_comm_rank(comm_atom) 1274 1275 if (nproc_atom==1) then 1276 if (master==-1.or.me_atom==master) then 1277 call pawrhoij_copy(pawrhoij_in,pawrhoij_gathered,.false.,.false.,.false.) 1278 end if 1279 return 1280 end if 1281 1282 !Test on sizes 1283 nrhoij_in_sum=nrhoij_in 1284 call xmpi_sum(nrhoij_in_sum,comm_atom,ierr) 1285 if (master==-1) then 1286 if (nrhoij_out/=nrhoij_in_sum) then 1287 msg='Wrong sizes sum[nrhoij_ij]/=nrhoij_out !' 1288 MSG_BUG(msg) 1289 end if 1290 else 1291 if (me_atom==master.and.nrhoij_out/=nrhoij_in_sum) then 1292 msg='(2) pawrhoij_gathered wrongly allocated !' 1293 MSG_BUG(msg) 1294 end if 1295 end if 1296 1297 !Optional arguments 1298 with_grhoij_ =.true.;if (present(with_grhoij)) with_grhoij_ =with_grhoij 1299 with_lmnmix_ =.true.;if (present(with_lmnmix)) with_lmnmix_ =with_lmnmix 1300 with_rhoijp_ =.true.;if (present(with_rhoijp)) with_rhoijp_ =with_rhoijp 1301 with_rhoijres_=.true.;if (present(with_rhoijres))with_rhoijres_=with_rhoijres 1302 with_rhoijim_ =.true.;if (present(with_rhoijim)) with_rhoijim_ =with_rhoijim 1303 with_rhoij__ =.true.;if (present(with_rhoij_)) with_rhoij__ =with_rhoij_ 1304 1305 !Retrieve table of atoms 1306 paral_atom=.true.;nullify(my_atmtab) 1307 call get_my_atmtab(comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,nrhoij_in_sum, & 1308 & my_natom_ref=nrhoij_in) 1309 1310 !Compute sizes of buffers 1311 buf_int_size=0;buf_dp_size=0 1312 nselect=0;lmnmix=0;ngrhoij=0;rhoij_size2=0 1313 use_rhoijp=0;use_rhoijres=0;use_rhoijim=0;use_rhoij_=0 1314 do irhoij=1,nrhoij_in 1315 cplex =pawrhoij_in(irhoij)%cplex 1316 lmn2_size=pawrhoij_in(irhoij)%lmn2_size 1317 nspden =pawrhoij_in(irhoij)%nspden 1318 if (with_lmnmix_) lmnmix=pawrhoij_in(irhoij)%lmnmix_sz 1319 if (with_grhoij_) ngrhoij=pawrhoij_in(irhoij)%ngrhoij 1320 if (with_rhoijp_) use_rhoijp=pawrhoij_in(irhoij)%use_rhoijp 1321 if (with_rhoijres_)use_rhoijres=pawrhoij_in(irhoij)%use_rhoijres 1322 if (with_rhoijim_)use_rhoijim=pawrhoij_in(irhoij)%use_rhoijim 1323 if (with_rhoij__) use_rhoij_=pawrhoij_in(irhoij)%use_rhoij_ 1324 buf_int_size=buf_int_size+16 1325 if (use_rhoijp>0) then 1326 nselect=pawrhoij_in(irhoij)%nrhoijsel 1327 buf_int_size=buf_int_size+nselect 1328 buf_dp_size=buf_dp_size + cplex*nselect*nspden 1329 end if 1330 if (lmnmix>0) buf_int_size=buf_int_size+lmnmix 1331 if (ngrhoij>0) buf_dp_size=buf_dp_size + cplex*lmn2_size*nspden*ngrhoij 1332 if (use_rhoijres>0) buf_dp_size=buf_dp_size + cplex*lmn2_size*nspden 1333 if (use_rhoijim>0) buf_dp_size=buf_dp_size + lmn2_size*nspden 1334 if (use_rhoij_>0) then 1335 rhoij_size2=size(pawrhoij_in(irhoij)%rhoij_,dim=2) 1336 buf_dp_size=buf_dp_size + cplex*lmn2_size*rhoij_size2 1337 end if 1338 end do 1339 1340 !Fill input buffers 1341 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 1342 LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size)) 1343 indx_int=1;indx_dp =1 1344 lmnmix=0;ngrhoij=0;nselect=0;rhoij_size2=0 1345 use_rhoijp=0;use_rhoijres=0;use_rhoijim=0;use_rhoij_=0 1346 do irhoij=1,nrhoij_in 1347 cplex =pawrhoij_in(irhoij)%cplex 1348 lmn2_size=pawrhoij_in(irhoij)%lmn2_size 1349 nspden =pawrhoij_in(irhoij)%nspden 1350 if (with_lmnmix_) lmnmix=pawrhoij_in(irhoij)%lmnmix_sz 1351 if (with_grhoij_) ngrhoij=pawrhoij_in(irhoij)%ngrhoij 1352 if (with_rhoijp_) use_rhoijp=pawrhoij_in(irhoij)%use_rhoijp 1353 if (use_rhoijp > 0) nselect=pawrhoij_in(irhoij)%nrhoijsel 1354 if (with_rhoijres_)use_rhoijres=pawrhoij_in(irhoij)%use_rhoijres 1355 if (with_rhoijim_) use_rhoijim =pawrhoij_in(irhoij)%use_rhoijim 1356 if (with_rhoij__) use_rhoij_ =pawrhoij_in(irhoij)%use_rhoij_ 1357 if (use_rhoij_> 0) rhoij_size2 =size(pawrhoij_in(irhoij)%rhoij_,dim=2) 1358 buf_int(indx_int)=my_atmtab(irhoij) ;indx_int=indx_int+1 1359 buf_int(indx_int)=cplex ;indx_int=indx_int+1 1360 buf_int(indx_int)=lmn2_size ;indx_int=indx_int+1 1361 buf_int(indx_int)=nspden ;indx_int=indx_int+1 1362 buf_int(indx_int)=nselect ;indx_int=indx_int+1 1363 buf_int(indx_int)=lmnmix ;indx_int=indx_int+1 1364 buf_int(indx_int)=ngrhoij ;indx_int=indx_int+1 1365 buf_int(indx_int)=use_rhoijp ;indx_int=indx_int+1 1366 buf_int(indx_int)=use_rhoijres ;indx_int=indx_int+1 1367 buf_int(indx_int)=use_rhoijim ;indx_int=indx_int+1 1368 buf_int(indx_int)=use_rhoij_ ;indx_int=indx_int+1 1369 buf_int(indx_int)=rhoij_size2 ;indx_int=indx_int+1 1370 buf_int(indx_int)=pawrhoij_in(irhoij)%itypat ;indx_int=indx_int+1 1371 buf_int(indx_int)=pawrhoij_in(irhoij)%lmn_size ;indx_int=indx_int+1 1372 buf_int(indx_int)=pawrhoij_in(irhoij)%nsppol ;indx_int=indx_int+1 1373 buf_int(indx_int)=pawrhoij_in(irhoij)%nspinor ;indx_int=indx_int+1 1374 if (use_rhoijp>0) then 1375 buf_int(indx_int:indx_int+nselect-1)=pawrhoij_in(irhoij)%rhoijselect(1:nselect) 1376 indx_int=indx_int+nselect 1377 do isp=1,nspden 1378 buf_dp(indx_dp:indx_dp+cplex*nselect-1)=pawrhoij_in(irhoij)%rhoijp(1:cplex*nselect,isp) 1379 indx_dp=indx_dp+cplex*nselect 1380 end do 1381 end if 1382 if (lmnmix>0) then 1383 buf_int(indx_int:indx_int+lmnmix-1)=pawrhoij_in(irhoij)%kpawmix(1:lmnmix) 1384 indx_int=indx_int+lmnmix 1385 end if 1386 if (ngrhoij>0) then 1387 do isp=1,nspden 1388 do ii=1,cplex*lmn2_size 1389 buf_dp(indx_dp:indx_dp+ngrhoij-1)=pawrhoij_in(irhoij)%grhoij(1:ngrhoij,ii,isp) 1390 indx_dp=indx_dp+ngrhoij 1391 end do 1392 end do 1393 end if 1394 if (use_rhoijres>0) then 1395 do isp=1,nspden 1396 buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1)=pawrhoij_in(irhoij)%rhoijres(1:cplex*lmn2_size,isp) 1397 indx_dp=indx_dp+cplex*lmn2_size 1398 end do 1399 end if 1400 if (use_rhoijim>0) then 1401 do isp=1,nspden 1402 buf_dp(indx_dp:indx_dp+lmn2_size-1)=pawrhoij_in(irhoij)%rhoijim(1:lmn2_size,isp) 1403 indx_dp=indx_dp+lmn2_size 1404 end do 1405 end if 1406 if (use_rhoij_>0) then 1407 do isp=1,rhoij_size2 1408 buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1)=pawrhoij_in(irhoij)%rhoij_(1:cplex*lmn2_size,isp) 1409 indx_dp=indx_dp+cplex*lmn2_size 1410 end do 1411 end if 1412 end do 1413 1414 !Check 1415 if ((indx_int-1/=buf_int_size).or.(indx_dp-1/=buf_dp_size)) then 1416 write(msg,*) 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size 1417 MSG_BUG(msg) 1418 end if 1419 1420 !Communicate (1 gather for integers, 1 gather for reals) 1421 LIBPAW_ALLOCATE(count_int,(nproc_atom)) 1422 LIBPAW_ALLOCATE(displ_int,(nproc_atom)) 1423 LIBPAW_ALLOCATE(count_dp ,(nproc_atom)) 1424 LIBPAW_ALLOCATE(displ_dp ,(nproc_atom)) 1425 LIBPAW_ALLOCATE(count_tot,(2*nproc_atom)) 1426 bufsz(1)=buf_int_size; bufsz(2)=buf_dp_size 1427 call xmpi_allgather(bufsz,2,count_tot,comm_atom,ierr) 1428 do ii=1,nproc_atom 1429 count_int(ii)=count_tot(2*ii-1) 1430 count_dp (ii)=count_tot(2*ii) 1431 end do 1432 displ_int(1)=0;displ_dp(1)=0 1433 do ii=2,nproc_atom 1434 displ_int(ii)=displ_int(ii-1)+count_int(ii-1) 1435 displ_dp (ii)=displ_dp (ii-1)+count_dp (ii-1) 1436 end do 1437 buf_int_size_all=sum(count_int) 1438 buf_dp_size_all =sum(count_dp) 1439 LIBPAW_DEALLOCATE(count_tot) 1440 if (master==-1.or.me_atom==master) then 1441 LIBPAW_ALLOCATE(buf_int_all,(buf_int_size_all)) 1442 LIBPAW_ALLOCATE(buf_dp_all ,(buf_dp_size_all)) 1443 else 1444 LIBPAW_ALLOCATE(buf_int_all,(0)) 1445 LIBPAW_ALLOCATE(buf_dp_all ,(0)) 1446 end if 1447 if (master==-1) then 1448 call xmpi_allgatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,comm_atom,ierr) 1449 call xmpi_allgatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,comm_atom,ierr) 1450 else 1451 call xmpi_gatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,master,comm_atom,ierr) 1452 call xmpi_gatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,master,comm_atom,ierr) 1453 end if 1454 LIBPAW_DEALLOCATE(count_int) 1455 LIBPAW_DEALLOCATE(displ_int) 1456 LIBPAW_DEALLOCATE(count_dp) 1457 LIBPAW_DEALLOCATE(displ_dp) 1458 1459 !Retrieve data from output buffer 1460 if (master==-1.or.me_atom==master) then 1461 indx_int=1;indx_dp=1 1462 call pawrhoij_free(pawrhoij_gathered) 1463 do irhoij=1,nrhoij_out 1464 jrhoij =buf_int_all(indx_int) ;indx_int=indx_int+1 1465 cplex =buf_int_all(indx_int) ;indx_int=indx_int+1 1466 lmn2_size =buf_int_all(indx_int) ;indx_int=indx_int+1 1467 nspden =buf_int_all(indx_int) ;indx_int=indx_int+1 1468 nselect =buf_int_all(indx_int) ;indx_int=indx_int+1 1469 lmnmix =buf_int_all(indx_int) ;indx_int=indx_int+1 1470 ngrhoij =buf_int_all(indx_int) ;indx_int=indx_int+1 1471 use_rhoijp =buf_int_all(indx_int) ;indx_int=indx_int+1 1472 use_rhoijres=buf_int_all(indx_int) ;indx_int=indx_int+1 1473 use_rhoijim =buf_int_all(indx_int) ;indx_int=indx_int+1 1474 use_rhoij_ =buf_int_all(indx_int) ;indx_int=indx_int+1 1475 rhoij_size2 =buf_int_all(indx_int) ;indx_int=indx_int+1 1476 pawrhoij_gathered(jrhoij)%itypat=buf_int_all(indx_int) ;indx_int=indx_int+1 1477 pawrhoij_gathered(jrhoij)%lmn_size=buf_int_all(indx_int) ;indx_int=indx_int+1 1478 pawrhoij_gathered(jrhoij)%nsppol=buf_int_all(indx_int) ;indx_int=indx_int+1 1479 pawrhoij_gathered(jrhoij)%nspinor=buf_int_all(indx_int) ;indx_int=indx_int+1 1480 pawrhoij_gathered(jrhoij)%cplex=cplex 1481 pawrhoij_gathered(jrhoij)%lmn2_size=lmn2_size 1482 pawrhoij_gathered(jrhoij)%nspden=nspden 1483 pawrhoij_gathered(jrhoij)%nrhoijsel=nselect 1484 pawrhoij_gathered(jrhoij)%lmnmix_sz=lmnmix 1485 pawrhoij_gathered(jrhoij)%ngrhoij=ngrhoij 1486 pawrhoij_gathered(jrhoij)%use_rhoijp=use_rhoijp 1487 pawrhoij_gathered(jrhoij)%use_rhoijres=use_rhoijres 1488 pawrhoij_gathered(jrhoij)%use_rhoijim =use_rhoijim 1489 pawrhoij_gathered(jrhoij)%use_rhoij_=use_rhoij_ 1490 if (use_rhoijp>0) then 1491 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%rhoijselect,(lmn2_size)) 1492 pawrhoij_gathered(jrhoij)%rhoijselect(1:nselect)=buf_int_all(indx_int:indx_int+nselect-1) 1493 if (nselect < lmn2_size )pawrhoij_gathered(jrhoij)%rhoijselect(nselect+1:lmn2_size)=zero 1494 indx_int=indx_int+nselect 1495 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%rhoijp,(cplex*lmn2_size,nspden)) 1496 do isp=1,nspden 1497 pawrhoij_gathered(jrhoij)%rhoijp(1:cplex*nselect,isp)=buf_dp_all(indx_dp:indx_dp+cplex*nselect-1) 1498 if (nselect < lmn2_size )pawrhoij_gathered(jrhoij)%rhoijp(cplex*nselect+1:cplex*lmn2_size,isp)=zero 1499 indx_dp=indx_dp+cplex*nselect 1500 end do 1501 end if 1502 if (lmnmix>0) then 1503 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%kpawmix,(lmnmix)) 1504 pawrhoij_gathered(jrhoij)%kpawmix(1:lmnmix)=buf_int_all(indx_int:indx_int+lmnmix-1) 1505 indx_int=indx_int+lmnmix 1506 end if 1507 if (ngrhoij>0) then 1508 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%grhoij,(ngrhoij,cplex*lmn2_size,nspden)) 1509 do isp=1,nspden 1510 do ii=1,cplex*lmn2_size 1511 pawrhoij_gathered(jrhoij)%grhoij(1:ngrhoij,ii,isp)=buf_dp_all(indx_dp:indx_dp+ngrhoij-1) 1512 indx_dp=indx_dp+ngrhoij 1513 end do 1514 end do 1515 end if 1516 if (use_rhoijres>0) then 1517 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%rhoijres,(cplex*lmn2_size,nspden)) 1518 do isp=1,nspden 1519 pawrhoij_gathered(jrhoij)%rhoijres(1:cplex*lmn2_size,isp)=buf_dp_all(indx_dp:indx_dp+cplex*lmn2_size-1) 1520 indx_dp=indx_dp+cplex*lmn2_size 1521 end do 1522 end if 1523 if (use_rhoijim>0) then 1524 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%rhoijim,(lmn2_size,nspden)) 1525 do isp=1,nspden 1526 pawrhoij_gathered(jrhoij)%rhoijim(1:lmn2_size,isp)=buf_dp_all(indx_dp:indx_dp+lmn2_size-1) 1527 indx_dp=indx_dp+lmn2_size 1528 end do 1529 end if 1530 if (use_rhoij_>0) then 1531 LIBPAW_ALLOCATE(pawrhoij_gathered(jrhoij)%rhoij_,(cplex*lmn2_size,rhoij_size2)) 1532 do isp=1,rhoij_size2 1533 pawrhoij_gathered(jrhoij)%rhoij_(1:cplex*lmn2_size,isp)=buf_dp_all(indx_dp:indx_dp+cplex*lmn2_size-1) 1534 indx_dp=indx_dp+cplex*lmn2_size 1535 end do 1536 end if 1537 end do 1538 if ((indx_int/=1+buf_int_size_all).or.(indx_dp/=1+buf_dp_size_all)) then 1539 write(msg,*) 'Wrong buffer sizes: buf_int_size_all=',buf_int_size_all,' buf_dp_size_all=',buf_dp_size_all 1540 MSG_BUG(msg) 1541 end if 1542 end if 1543 1544 !Free memory 1545 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 1546 LIBPAW_DEALLOCATE(buf_int) 1547 LIBPAW_DEALLOCATE(buf_dp) 1548 LIBPAW_DEALLOCATE(buf_int_all) 1549 LIBPAW_DEALLOCATE(buf_dp_all) 1550 1551 end subroutine pawrhoij_gather
m_pawrhoij/pawrhoij_get_nspden [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_get_nspden
FUNCTION
Compute the value of nspden (number of spin component) for a pawrhoij datastructure. This one depends on the number of spinorial components, the number of components of the density and use of the spin-orbit coupling.
INPUTS
nspden= number of spin-density components nspinor= number of spinorial components spnorb= flag: 1 if spin-orbit coupling is activated
OUTPUT
pawrhoij_get_nspden= value of nspden associated to pawrhoij
PARENTS
CHILDREN
SOURCE
3112 function pawrhoij_get_nspden(nspden,nspinor,spnorb) 3113 3114 3115 !This section has been created automatically by the script Abilint (TD). 3116 !Do not modify the following lines by hand. 3117 #undef ABI_FUNC 3118 #define ABI_FUNC 'pawrhoij_get_nspden' 3119 !End of the abilint section 3120 3121 implicit none 3122 3123 !Arguments --------------------------------------------- 3124 !scalars 3125 integer,intent(in) :: nspden,nspinor,spnorb 3126 integer :: pawrhoij_get_nspden 3127 !arrays 3128 3129 !Local variables --------------------------------------- 3130 3131 !************************************************************************ 3132 3133 pawrhoij_get_nspden=nspden 3134 if (nspinor==2.and.spnorb>0) pawrhoij_get_nspden=4 3135 3136 end function pawrhoij_get_nspden
m_pawrhoij/pawrhoij_init_unpacked [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_init_unpacked
FUNCTION
Initialize field of rhoij datastructure for unpacked values (pawrhoij%rhoij_ array)
SIDE EFFECTS
rhoij(:) <pawrhoij_type)>= input/output datastructure * In output the rhoij_ array is allocated
PARENTS
dfpt_nstpaw,dfpt_rhofermi,dfpt_vtorho,energy,pawmkrhoij
CHILDREN
SOURCE
2795 subroutine pawrhoij_init_unpacked(rhoij) 2796 2797 2798 !This section has been created automatically by the script Abilint (TD). 2799 !Do not modify the following lines by hand. 2800 #undef ABI_FUNC 2801 #define ABI_FUNC 'pawrhoij_init_unpacked' 2802 !End of the abilint section 2803 2804 implicit none 2805 2806 !Arguments ------------------------------------ 2807 !scalars 2808 !arrays 2809 type(pawrhoij_type),intent(inout) :: rhoij(:) 2810 2811 !Local variables------------------------------- 2812 integer :: iat,nrhoij,nsp2 2813 2814 ! ************************************************************************* 2815 2816 nrhoij=SIZE(rhoij);if (nrhoij==0) return 2817 nsp2=rhoij(1)%nsppol;if (rhoij(1)%nspden==4) nsp2=4 2818 2819 do iat=1,nrhoij 2820 2821 if (allocated(rhoij(iat)%rhoij_)) then 2822 LIBPAW_DEALLOCATE(rhoij(iat)%rhoij_) 2823 end if 2824 LIBPAW_ALLOCATE(rhoij(iat)%rhoij_,(rhoij(iat)%cplex*rhoij(iat)%lmn2_size,nsp2)) 2825 rhoij(iat)%use_rhoij_=1 2826 rhoij(iat)%rhoij_=zero 2827 2828 end do 2829 2830 end subroutine pawrhoij_init_unpacked
m_pawrhoij/pawrhoij_io [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_io
FUNCTION
IO method for pawrhoij datastructures.
INPUTS
unitfi=Unit number for IO file or netcdf file handler (already opened in the caller). nsppol_in=Number of independent spin polarizations. Only used for reading. nspinor_in=Number of spinorial components. Only used for reading. nspden_in=Number of spin-density components. only used for reading. nlmn_type(ntypat)= Number of (l,m,n) elements for the paw basis for each type of atom. Only used for reading. typat(natom) =Type of each atom. headform=Format of the abinit header (only used for reading as we need to know how to read the data. Writing is always done using the latest headform. rdwr_mode(len=*)=String defining the IO mode. Possible values (not case sensitive): "W"= For writing to unitfi "R"= For reading from unitfi "E"= For echoing. "D"= for debug [form(len=*)]= String defining the file format. Defaults to Fortran binary mode i.e., "unformatted" Other possible values are (case insensitive): "formatted"=For IO on a file open in formatted mode. "netcdf"=For IO on a netcdf file. [natinc]=Defines the increment in the loop over natom used for echoing the pawrhoij(natom) datastructures. If not specified, only the first and the last atom will be printed.
SIDE EFFECTS
pawrhoij(:)<type(pawrhoij_type)>= rhoij datastructure. if rdwr_mode="W", it will be written on unit unitfi using the file format given by form. if rdwr_mode="R", pawrhoij will be read and initialized from unit unitfi that has been opened with form=form. if rdwr_mode="E", the routines only echoes the content of the structure.
PARENTS
m_hdr,m_qparticles
CHILDREN
SOURCE
2349 subroutine pawrhoij_io(pawrhoij,unitfi,nsppol_in,nspinor_in,nspden_in,nlmn_type,typat,& 2350 & headform,rdwr_mode,form,natinc,mpi_atmtab) 2351 2352 2353 !This section has been created automatically by the script Abilint (TD). 2354 !Do not modify the following lines by hand. 2355 #undef ABI_FUNC 2356 #define ABI_FUNC 'pawrhoij_io' 2357 !End of the abilint section 2358 2359 implicit none 2360 2361 !Arguments ------------------------------------ 2362 !scalars 2363 integer,intent(in) :: unitfi,headform,nspden_in,nspinor_in,nsppol_in 2364 integer,optional,intent(in) :: natinc 2365 character(len=*),intent(in) :: rdwr_mode 2366 character(len=*),optional,intent(in) :: form 2367 integer, intent(in), optional, pointer :: mpi_atmtab(:) 2368 !arrays 2369 integer,intent(in) :: typat(:),nlmn_type(:) 2370 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 2371 2372 !Local variables------------------------------- 2373 !scalars 2374 integer,parameter :: fort_formatted=1,fort_binary=2,netcdf_io=3 2375 integer :: cplex,i1,i2,iatom,iatom_tot,natom,ispden,bsize,ii,jj,lmn2_size 2376 integer :: nselect,my_cplex,my_natinc,my_natom,my_nspden,ngrhoijmx,size_rhoij2 2377 integer :: iomode,ncid,natom_id,cplex_id,nspden_id,nsel56_id,buffer_id,ibuffer_id,ncerr 2378 integer :: bsize_id,bufsize_id 2379 logical :: paral_atom 2380 character(len=500) :: msg 2381 !arrays 2382 integer,allocatable :: ibuffer(:),nsel44(:,:),nsel56(:) 2383 integer,pointer :: my_atmtab(:) 2384 real(dp), allocatable :: buffer(:) 2385 2386 ! ************************************************************************* 2387 2388 my_natom=SIZE(pawrhoij);if (my_natom==0) return 2389 my_nspden=nspden_in 2390 natom=size(typat) 2391 paral_atom=(my_natom/=natom) 2392 if (present(mpi_atmtab)) then 2393 if (.not.associated(mpi_atmtab)) then 2394 msg='mpi_atmtab not associated (pawrhoij_io)' 2395 MSG_BUG(msg) 2396 end if 2397 my_atmtab=>mpi_atmtab 2398 else if (my_natom/=natom) then 2399 msg='my_natom /=natom, mpi_atmtab should be in argument (pawrhoij_io)' 2400 MSG_BUG(msg) 2401 end if 2402 2403 iomode = fort_binary 2404 if (PRESENT(form)) then 2405 select case (libpaw_to_upper(form)) 2406 case ("FORMATTED") 2407 iomode = fort_formatted 2408 case ("NETCDF") 2409 iomode = netcdf_io 2410 case default 2411 MSG_ERROR("Wrong form: "//trim(form)) 2412 end select 2413 end if 2414 2415 #ifndef LIBPAW_HAVE_NETCDF 2416 if (iomode == netcdf_io) then 2417 MSG_ERROR("iomode == netcdf_io but netcdf library is missing.") 2418 end if 2419 #endif 2420 ncid = unitfi 2421 2422 select case (rdwr_mode(1:1)) 2423 2424 case ("R","r") ! Reading the Rhoij tab 2425 2426 if ((headform>=44).and.(headform<56)) then 2427 LIBPAW_ALLOCATE(nsel44,(nspden_in,natom)) 2428 if (iomode == fort_binary) then 2429 read(unitfi ) ((nsel44(ispden,iatom),ispden=1,nspden_in),iatom=1,natom) 2430 else if (iomode == fort_formatted) then 2431 read(unitfi,*) ((nsel44(ispden,iatom),ispden=1,nspden_in),iatom=1,natom) 2432 #ifdef LIBPAW_HAVE_NETCDF 2433 else if (iomode == netcdf_io) then 2434 MSG_ERROR("header in 44-56 not compatible with Netcdf") 2435 #endif 2436 end if 2437 call pawrhoij_alloc(pawrhoij,1,nspden_in,nspinor_in,nsppol_in,typat,lmnsize=nlmn_type) 2438 do iatom=1,natom 2439 pawrhoij(iatom)%nrhoijsel=nsel44(1,iatom) 2440 end do 2441 bsize=sum(nsel44) 2442 LIBPAW_ALLOCATE(ibuffer,(bsize)) 2443 LIBPAW_ALLOCATE(buffer,(bsize)) 2444 if (iomode == fort_binary) then 2445 read(unitfi ) ibuffer(:),buffer(:) 2446 else if (iomode == fort_formatted) then 2447 read(unitfi,*) ibuffer(:),buffer(:) 2448 end if 2449 ii=0 2450 do iatom=1,natom 2451 nselect=nsel44(1,iatom) 2452 pawrhoij(iatom)%rhoijselect(1:nselect)=ibuffer(ii+1:ii+nselect) 2453 do ispden=1,nspden_in 2454 pawrhoij(iatom)%rhoijp(1:nselect,ispden)=buffer(ii+1:ii+nselect) 2455 ii=ii+nselect 2456 end do 2457 end do 2458 LIBPAW_DEALLOCATE(ibuffer) 2459 LIBPAW_DEALLOCATE(buffer) 2460 LIBPAW_DEALLOCATE(nsel44) 2461 else if (headform>=56) then 2462 LIBPAW_ALLOCATE(nsel56,(natom)) 2463 if (headform==56) then 2464 if (iomode == fort_binary) then 2465 read(unitfi ) (nsel56(iatom),iatom=1,natom),my_cplex 2466 else if (iomode == fort_formatted) then 2467 read(unitfi,*) (nsel56(iatom),iatom=1,natom),my_cplex 2468 #ifdef LIBPAW_HAVE_NETCDF 2469 else if (iomode == netcdf_io) then 2470 NCF_CHECK(nf90_inq_dimid(ncid, "pawrhoij_cplex", cplex_id)) 2471 NCF_CHECK(nf90_inquire_dimension(ncid, cplex_id, len=my_cplex)) 2472 2473 NCF_CHECK(nf90_inq_varid(ncid, "rhoijsel_atoms", nsel56_id)) 2474 NCF_CHECK(nf90_get_var(ncid, nsel56_id, nsel56)) 2475 #endif 2476 end if 2477 else 2478 if (iomode == fort_binary) then 2479 read(unitfi ) (nsel56(iatom),iatom=1,natom),my_cplex,my_nspden 2480 else if (iomode == fort_formatted) then 2481 read(unitfi,*) (nsel56(iatom),iatom=1,natom),my_cplex,my_nspden 2482 #ifdef LIBPAW_HAVE_NETCDF 2483 else if (iomode == netcdf_io) then 2484 NCF_CHECK(nf90_inq_dimid(ncid, "pawrhoij_cplex", cplex_id)) 2485 NCF_CHECK(nf90_inquire_dimension(ncid, cplex_id, len=my_cplex)) 2486 NCF_CHECK(nf90_inq_dimid(ncid, "pawrhoij_nspden", nspden_id)) 2487 NCF_CHECK(nf90_inquire_dimension(ncid, nspden_id, len=my_nspden)) 2488 NCF_CHECK(nf90_inq_varid(ncid, "nrhoijsel_atoms", nsel56_id)) 2489 NCF_CHECK(nf90_get_var(ncid, nsel56_id, nsel56)) 2490 #endif 2491 end if 2492 end if 2493 call pawrhoij_alloc(pawrhoij,my_cplex,my_nspden,nspinor_in,nsppol_in,typat,lmnsize=nlmn_type) 2494 do iatom=1,natom 2495 pawrhoij(iatom)%nrhoijsel=nsel56(iatom) 2496 end do 2497 bsize=sum(nsel56) 2498 LIBPAW_ALLOCATE(ibuffer,(bsize)) 2499 LIBPAW_ALLOCATE(buffer,(bsize*my_nspden*my_cplex)) 2500 if (iomode == fort_binary) then 2501 read(unitfi ) ibuffer(:),buffer(:) 2502 else if (iomode == fort_formatted) then 2503 read(unitfi,*) ibuffer(:),buffer(:) 2504 #ifdef LIBPAW_HAVE_NETCDF 2505 else if (iomode == netcdf_io) then 2506 if (bsize > 0) then 2507 NCF_CHECK(nf90_inq_varid(ncid, "rhoijselect_atoms", ibuffer_id)) 2508 NCF_CHECK(nf90_get_var(ncid, ibuffer_id, ibuffer)) 2509 NCF_CHECK(nf90_inq_varid(ncid, "rhoijp_atoms", buffer_id)) 2510 NCF_CHECK(nf90_get_var(ncid, buffer_id, buffer)) 2511 end if 2512 #endif 2513 end if 2514 ii=0;jj=0 2515 do iatom=1,natom 2516 nselect=nsel56(iatom) 2517 pawrhoij(iatom)%rhoijselect(1:nselect)=ibuffer(ii+1:ii+nselect) 2518 ii=ii+nselect 2519 do ispden=1,my_nspden 2520 pawrhoij(iatom)%rhoijp(1:my_cplex*nselect,ispden)=buffer(jj+1:jj+my_cplex*nselect) 2521 jj=jj+my_cplex*nselect 2522 end do 2523 end do 2524 LIBPAW_DEALLOCATE(ibuffer) 2525 LIBPAW_DEALLOCATE(buffer) 2526 LIBPAW_DEALLOCATE(nsel56) 2527 end if 2528 2529 case ("W","w") ! Writing the Rhoij tab (latest format is used) 2530 2531 LIBPAW_ALLOCATE(nsel56,(natom)) 2532 my_cplex =pawrhoij(1)%cplex 2533 my_nspden=pawrhoij(1)%nspden 2534 do iatom=1,natom 2535 nsel56(iatom)=pawrhoij(iatom)%nrhoijsel 2536 end do 2537 bsize=sum(nsel56) 2538 2539 if (iomode == fort_binary) then 2540 write(unitfi ) (nsel56(iatom),iatom=1,natom),my_cplex,my_nspden 2541 else if (iomode == fort_formatted) then 2542 write(unitfi,*) (nsel56(iatom),iatom=1,natom),my_cplex,my_nspden 2543 #ifdef LIBPAW_HAVE_NETCDF 2544 else if (iomode == netcdf_io) then 2545 ncerr = nf90_redef(ncid) 2546 2547 ! Define dimensions. 2548 ncerr = nf90_inq_dimid(ncid, "number_of_atoms", natom_id) 2549 if (ncerr /= nf90_noerr) then 2550 NCF_CHECK(nf90_def_dim(ncid, "number_of_atoms", natom, natom_id)) 2551 end if 2552 NCF_CHECK(nf90_def_var(ncid, "nrhoijsel_atoms", NF90_INT, natom_id, nsel56_id)) 2553 2554 NCF_CHECK(nf90_def_dim(ncid, "pawrhoij_cplex", my_cplex, cplex_id)) 2555 NCF_CHECK(nf90_def_dim(ncid, "pawrhoij_nspden", my_nspden, nspden_id)) 2556 !write(std_out,*)"bsize,my_nspden,my_cplex",bsize, my_nspden, my_cplex 2557 if (bsize > 0) then 2558 NCF_CHECK(nf90_def_dim(ncid, "rhoijselect_atoms_dim", bsize, bsize_id)) 2559 NCF_CHECK(nf90_def_dim(ncid, "rhoijp_atoms_dim", bsize*my_nspden*my_cplex, bufsize_id)) 2560 ! Define variables. 2561 NCF_CHECK(nf90_def_var(ncid, "rhoijselect_atoms", NF90_INT, bsize_id, ibuffer_id)) 2562 NCF_CHECK(nf90_def_var(ncid, "rhoijp_atoms", NF90_DOUBLE, bufsize_id, buffer_id)) 2563 else 2564 ! This happens in v5[40] and bsize == 0 corresponds to NC_UNLIMITED 2565 MSG_COMMENT("All rhoij entries are zero. No netcdf entry produced") 2566 end if 2567 2568 ! Write nsel56 2569 NCF_CHECK(nf90_enddef(ncid)) 2570 NCF_CHECK(nf90_put_var(ncid, nsel56_id, nsel56)) 2571 #endif 2572 end if 2573 2574 LIBPAW_ALLOCATE(ibuffer,(bsize)) 2575 LIBPAW_ALLOCATE(buffer,(bsize*my_nspden*my_cplex)) 2576 ii=0;jj=0 2577 do iatom=1,natom 2578 nselect=nsel56(iatom) 2579 ibuffer(ii+1:ii+nselect)=pawrhoij(iatom)%rhoijselect(1:nselect) 2580 ii=ii+nselect 2581 do ispden=1,my_nspden 2582 buffer(jj+1:jj+my_cplex*nselect)=pawrhoij(iatom)%rhoijp(1:my_cplex*nselect,ispden) 2583 jj=jj+my_cplex*nselect 2584 end do 2585 end do 2586 if (iomode == fort_binary) then 2587 write(unitfi ) ibuffer(:),buffer(:) 2588 else if (iomode == fort_formatted) then 2589 write(unitfi,*) ibuffer(:),buffer(:) 2590 #ifdef LIBPAW_HAVE_NETCDF 2591 else if (iomode == netcdf_io) then 2592 if (bsize > 0) then 2593 NCF_CHECK(nf90_put_var(ncid, ibuffer_id, ibuffer)) 2594 NCF_CHECK(nf90_put_var(ncid, buffer_id, buffer)) 2595 end if 2596 #endif 2597 end if 2598 LIBPAW_DEALLOCATE(ibuffer) 2599 LIBPAW_DEALLOCATE(buffer) 2600 LIBPAW_DEALLOCATE(nsel56) 2601 2602 case ("E","e") ! Echoing the Rhoij tab 2603 2604 my_natinc=1; if(natom>1) my_natinc=natom-1 2605 if (PRESENT(natinc)) my_natinc = natinc ! user-defined increment. 2606 LIBPAW_ALLOCATE(ibuffer,(0)) 2607 do iatom=1,my_natom,my_natinc 2608 iatom_tot=iatom;if(paral_atom)iatom_tot=my_atmtab(iatom) 2609 do ispden=1,pawrhoij(iatom)%nspden 2610 write(unitfi, '(a,i4,a,i1,a)' ) ' rhoij(',iatom_tot,',',ispden,')= (max 12 non-zero components will be written)' 2611 call pawio_print_ij(unitfi,pawrhoij(iatom)%rhoijp(:,ispden),& 2612 & pawrhoij(iatom)%nrhoijsel,& 2613 & pawrhoij(iatom)%cplex,& 2614 & pawrhoij(iatom)%lmn_size,-1,ibuffer,1,0,& 2615 & pawrhoij(iatom)%rhoijselect(:),-1.d0,1,mode_paral='PERS') 2616 end do 2617 end do 2618 LIBPAW_DEALLOCATE(ibuffer) 2619 2620 case ("D","d") ! Debug 2621 2622 write(unitfi,'(a,i4)' ) 'size pawmkrhoij , natom = ' , my_natom 2623 my_natinc=1; if(natom>1) my_natinc=natom-1 2624 if (PRESENT(natinc)) my_natinc = natinc ! user-defined increment. 2625 LIBPAW_ALLOCATE(ibuffer,(0)) 2626 do iatom=1,my_natom,my_natinc 2627 iatom_tot=iatom;if(paral_atom) iatom_tot=my_atmtab(iatom) 2628 if (iatom_tot/=1) cycle 2629 write(unitfi,'(a,i4,a)' ) ' ******* rhoij (Atom # ',iatom_tot,' ********)' 2630 write(unitfi,'(a,i4,a,i4)' ) 'cplx=',pawrhoij(iatom)%cplex, ' nselect=', pawrhoij(iatom)%nrhoijsel 2631 write(unitfi,'(a,i4,a,i4)' ) 'nspden=',pawrhoij(iatom)%nspden, ' lmn2size=',pawrhoij(iatom)%lmn2_size 2632 write(unitfi,'(a,i4,a,i4)' ) 'lmnmix=',pawrhoij(iatom)%lmnmix_sz, ' ngrhoij=',pawrhoij(iatom)%ngrhoij 2633 write(unitfi,'(a,i4,a,i4)' ) 'use_rhoijres=',pawrhoij(iatom)%use_rhoijres, & 2634 & 'use_rhoij_=',pawrhoij(iatom)%use_rhoij_ 2635 write(unitfi,'(a,i4)' ) 'use_rhoijim=',pawrhoij(iatom)%use_rhoijim 2636 write(unitfi,'(a,i4,a,i4)' ) 'itypat=',pawrhoij(iatom)%itypat, ' lmn_size=',pawrhoij(iatom)%lmn_size 2637 write(unitfi,'(a,i4,a,i4)' ) 'nsppol=',pawrhoij(iatom)%nsppol, ' nspinor=',pawrhoij(iatom)%nspinor 2638 cplex=pawrhoij(iatom)%cplex 2639 lmn2_size=pawrhoij(iatom)%lmn2_size 2640 do i2=1,pawrhoij(iatom)%nrhoijsel 2641 write(unitfi,'(a,i4,a,i4,a,i4,a,f9.5)') 'rhoijselect(,',i2,')=',& 2642 & pawrhoij(iatom)%rhoijselect(i2) 2643 end do 2644 if (pawrhoij(iatom)%ngrhoij>0) then 2645 ngrhoijmx=2; if (pawrhoij(iatom)%ngrhoij<ngrhoijmx) ngrhoijmx=pawrhoij(iatom)%ngrhoij 2646 do ispden=1,pawrhoij(iatom)%nspden 2647 do i1=ngrhoijmx,ngrhoijmx 2648 do i2=cplex*lmn2_size,cplex*lmn2_size 2649 write(unitfi,'(a,i4,a,i4,a,i4,a,f9.5)') ' grhoij(,',i1,',',i2,',',ispden,')=',& 2650 & pawrhoij(iatom)%grhoij(i1,i2,ispden) 2651 end do 2652 end do 2653 end do 2654 call libpaw_flush(unitfi) 2655 end if 2656 if (pawrhoij(iatom)%use_rhoijres>0) then 2657 do ispden=1,pawrhoij(iatom)%nspden 2658 do i2=cplex*lmn2_size,cplex*lmn2_size 2659 write(unitfi,'(a,i4,a,i4,a,f9.5)') ' rhoijres(,',i2,',ispden=',ispden,')=',& 2660 & pawrhoij(iatom)%rhoijres(i2,ispden) 2661 end do 2662 end do 2663 call libpaw_flush(unitfi) 2664 end if 2665 if (pawrhoij(iatom)%use_rhoijim>0) then 2666 do ispden=1,pawrhoij(iatom)%nspden 2667 do i2=lmn2_size,lmn2_size 2668 write(unitfi,'(a,i4,a,i4,a,f9.5)') ' rhoijim(,',i2,',ispden=',ispden,')=',& 2669 & pawrhoij(iatom)%rhoijim(i2,ispden) 2670 end do 2671 end do 2672 call libpaw_flush(unitfi) 2673 end if 2674 if (pawrhoij(iatom)%nrhoijsel>0) then 2675 do ispden=1,pawrhoij(iatom)%nspden 2676 do i2=cplex*pawrhoij(iatom)%nrhoijsel ,cplex*pawrhoij(iatom)%nrhoijsel 2677 write(unitfi,'(a,i4,a,i4,a,f9.5)') ' rhoijp!(nrhoijselec=,',i2,',ispden=',ispden,')=',& 2678 & pawrhoij(iatom)%rhoijp(i2,ispden) 2679 end do 2680 end do 2681 call libpaw_flush(unitfi) 2682 end if 2683 if (pawrhoij(iatom)%use_rhoij_>0) then 2684 size_rhoij2=size(pawrhoij(iatom)%rhoij_,2) 2685 do ispden=1,size_rhoij2 2686 do i2=cplex*lmn2_size,cplex*lmn2_size 2687 write(unitfi,'(a,i4,a,i4,a,f9.5)') ' rhoij_(,',i2,',ispden=',ispden,')=',& 2688 & pawrhoij(iatom)%rhoij_(i2,ispden) 2689 end do 2690 end do 2691 end if 2692 call libpaw_flush(unitfi) 2693 if (pawrhoij(iatom)%lmnmix_sz>0) then 2694 write(unitfi,'(a)') 'kpawmix ' 2695 write(unitfi,'(i4,i4,i4,i4)') pawrhoij(iatom)%kpawmix(:) 2696 end if 2697 call libpaw_flush(unitfi) 2698 end do 2699 2700 case default 2701 msg='Wrong rdwr_mode'//TRIM(rdwr_mode) 2702 MSG_ERROR(msg) 2703 2704 end select 2705 2706 end subroutine pawrhoij_io
m_pawrhoij/pawrhoij_isendreceive_fillbuffer [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_isendreceive_fillbuffer
FUNCTION
Extract from pawrhoij and from the global index of atoms the buffers to send in a sending operation This function has to be coupled with a call to pawrhoij_isendreceive_getbuffer
INPUTS
atm_indx_send(1:total number of atoms)= array for send operation,
Given an index of atom in global numbering, give its index
in the table of atoms treated by current processor
or -1 if the atoms is not treated by current processor
nrhoij_send= number of sent atoms
pawrhoij= data structure from which are extract buffer int and buffer dp
OUTPUT
buf_int= buffer of integers to be sent buf_int_size= size of buffer of integers buf_dp= buffer of double precision numbers to be sent buf_dp_size= size of buffer of double precision numbers
PARENTS
m_pawrhoij
CHILDREN
SOURCE
4236 subroutine pawrhoij_isendreceive_fillbuffer(pawrhoij,atmtab_send, atm_indx_send,nrhoij_send,& 4237 & buf_int,buf_int_size,buf_dp,buf_dp_size) 4238 4239 4240 !This section has been created automatically by the script Abilint (TD). 4241 !Do not modify the following lines by hand. 4242 #undef ABI_FUNC 4243 #define ABI_FUNC 'pawrhoij_isendreceive_fillbuffer' 4244 !End of the abilint section 4245 4246 implicit none 4247 4248 !Arguments ------------------------------------ 4249 !scalars 4250 integer,intent(out) :: buf_dp_size,buf_int_size 4251 integer,intent(in) :: nrhoij_send 4252 !arrays 4253 integer,intent(in) :: atmtab_send(:),atm_indx_send(:) 4254 integer,intent(out),allocatable :: buf_int(:) 4255 real(dp),intent(out),allocatable :: buf_dp(:) 4256 type(pawrhoij_type),target,intent(in) :: pawrhoij(:) 4257 4258 !Local variables------------------------------- 4259 !scalars 4260 integer :: cplex,ii,indx_int,indx_dp, iatom_tot,irhoij,irhoij_send,isp,lmn2_size,lmnmix 4261 integer :: ngrhoij,nselect,nspden,rhoij_size2,use_rhoijp,use_rhoijres,use_rhoijim,use_rhoij_ 4262 character(len=500) :: msg 4263 type(pawrhoij_type),pointer :: pawrhoij1 4264 !arrays 4265 4266 ! ********************************************************************* 4267 4268 !Compute sizes of buffers 4269 buf_int_size=0;buf_dp_size=0 4270 nselect=0;lmnmix=0;ngrhoij=0;rhoij_size2=0 4271 use_rhoijp=0;use_rhoijres=0;use_rhoijim=0;use_rhoij_=0 4272 do irhoij_send=1,nrhoij_send 4273 iatom_tot=atmtab_send(irhoij_send) 4274 irhoij=atm_indx_send(iatom_tot) 4275 if (irhoij == -1) then 4276 msg="Error in pawrhoij_isendreceive_fillbuffer atom not found" 4277 MSG_BUG(msg) 4278 end if 4279 pawrhoij1=>pawrhoij(irhoij) 4280 cplex =pawrhoij1%cplex 4281 lmn2_size=pawrhoij1%lmn2_size 4282 nspden =pawrhoij1%nspden 4283 lmnmix=pawrhoij1%lmnmix_sz 4284 ngrhoij=pawrhoij1%ngrhoij 4285 use_rhoijp=pawrhoij1%use_rhoijp 4286 use_rhoijres=pawrhoij1%use_rhoijres 4287 use_rhoijim=pawrhoij1%use_rhoijim 4288 use_rhoij_=pawrhoij1%use_rhoij_ 4289 buf_int_size=buf_int_size+16 4290 if (use_rhoijp>0) then 4291 nselect=pawrhoij1%nrhoijsel 4292 buf_int_size=buf_int_size+nselect 4293 buf_dp_size=buf_dp_size + cplex*nselect*nspden 4294 end if 4295 if (lmnmix>0) buf_int_size=buf_int_size+lmnmix 4296 if (ngrhoij>0) buf_dp_size=buf_dp_size + cplex*lmn2_size*nspden*ngrhoij 4297 if (use_rhoijres>0) buf_dp_size=buf_dp_size + cplex*lmn2_size*nspden 4298 if (use_rhoijim>0) buf_dp_size=buf_dp_size + lmn2_size*nspden 4299 if (use_rhoij_>0) then 4300 rhoij_size2=size(pawrhoij1%rhoij_,dim=2) 4301 buf_dp_size=buf_dp_size + cplex*lmn2_size*rhoij_size2 4302 end if 4303 end do 4304 4305 !Fill input buffers 4306 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 4307 LIBPAW_ALLOCATE(buf_dp,(buf_dp_size)) 4308 indx_int=1;indx_dp =1 4309 lmnmix=0;ngrhoij=0;nselect=0;rhoij_size2=0 4310 use_rhoijp=0;use_rhoijres=0;use_rhoijim=0;use_rhoij_=0 4311 do irhoij_send=1,nrhoij_send 4312 iatom_tot=atmtab_send(irhoij_send) 4313 irhoij=atm_indx_send(iatom_tot) 4314 pawrhoij1=>pawrhoij(irhoij) 4315 cplex =pawrhoij1%cplex 4316 lmn2_size=pawrhoij1%lmn2_size 4317 nspden =pawrhoij1%nspden 4318 lmnmix=pawrhoij1%lmnmix_sz 4319 ngrhoij=pawrhoij1%ngrhoij 4320 use_rhoijp=pawrhoij1%use_rhoijp 4321 nselect=pawrhoij1%nrhoijsel 4322 use_rhoijres=pawrhoij1%use_rhoijres 4323 use_rhoijim =pawrhoij1%use_rhoijim 4324 use_rhoij_ =pawrhoij1%use_rhoij_ 4325 rhoij_size2 =size(pawrhoij1%rhoij_,dim=2) 4326 buf_int(indx_int)=atmtab_send(irhoij_send) ;indx_int=indx_int+1 4327 buf_int(indx_int)=cplex ;indx_int=indx_int+1 4328 buf_int(indx_int)=lmn2_size ;indx_int=indx_int+1 4329 buf_int(indx_int)=nspden ;indx_int=indx_int+1 4330 buf_int(indx_int)=nselect ;indx_int=indx_int+1 4331 buf_int(indx_int)=lmnmix ;indx_int=indx_int+1 4332 buf_int(indx_int)=ngrhoij ;indx_int=indx_int+1 4333 buf_int(indx_int)=use_rhoijp ;indx_int=indx_int+1 4334 buf_int(indx_int)=use_rhoijres ;indx_int=indx_int+1 4335 buf_int(indx_int)=use_rhoijim ;indx_int=indx_int+1 4336 buf_int(indx_int)=use_rhoij_ ;indx_int=indx_int+1 4337 buf_int(indx_int)=rhoij_size2 ;indx_int=indx_int+1 4338 buf_int(indx_int)=pawrhoij1%itypat ;indx_int=indx_int+1 4339 buf_int(indx_int)=pawrhoij1%lmn_size ;indx_int=indx_int+1 4340 buf_int(indx_int)=pawrhoij1%nsppol ;indx_int=indx_int+1 4341 buf_int(indx_int)=pawrhoij1%nspinor ;indx_int=indx_int+1 4342 if (use_rhoijp>0) then 4343 buf_int(indx_int:indx_int+nselect-1)=pawrhoij1%rhoijselect(1:nselect) 4344 indx_int=indx_int+nselect 4345 do isp=1,nspden 4346 buf_dp(indx_dp:indx_dp+cplex*nselect-1)=pawrhoij1%rhoijp(1:cplex*nselect,isp) 4347 indx_dp=indx_dp+cplex*nselect 4348 end do 4349 end if 4350 if (lmnmix>0) then 4351 buf_int(indx_int:indx_int+lmnmix-1)=pawrhoij1%kpawmix(1:lmnmix) 4352 indx_int=indx_int+lmnmix 4353 end if 4354 if (ngrhoij>0) then 4355 do isp=1,nspden 4356 do ii=1,cplex*lmn2_size 4357 buf_dp(indx_dp:indx_dp+ngrhoij-1)=pawrhoij1%grhoij(1:ngrhoij,ii,isp) 4358 indx_dp=indx_dp+ngrhoij 4359 end do 4360 end do 4361 end if 4362 if (use_rhoijres>0) then 4363 do isp=1,nspden 4364 buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1)=pawrhoij1%rhoijres(1:cplex*lmn2_size,isp) 4365 indx_dp=indx_dp+cplex*lmn2_size 4366 end do 4367 end if 4368 if (use_rhoijim>0) then 4369 do isp=1,nspden 4370 buf_dp(indx_dp:indx_dp+lmn2_size-1)=pawrhoij1%rhoijim(1:lmn2_size,isp) 4371 indx_dp=indx_dp+lmn2_size 4372 end do 4373 end if 4374 if (use_rhoij_>0) then 4375 do isp=1,rhoij_size2 4376 buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1)=pawrhoij1%rhoij_(1:cplex*lmn2_size,isp) 4377 indx_dp=indx_dp+cplex*lmn2_size 4378 end do 4379 end if 4380 end do !irhoij_send 4381 4382 !Check 4383 if ((indx_int-1/=buf_int_size).or.(indx_dp-1/=buf_dp_size)) then 4384 write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size 4385 MSG_BUG(msg) 4386 end if 4387 4388 end subroutine pawrhoij_isendreceive_fillbuffer
m_pawrhoij/pawrhoij_isendreceive_getbuffer [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_isendreceive_getbuffer
FUNCTION
Fill a pawrhoij structure with the buffers received in a receive operation This buffer should have been first extracted by a call to pawrhoij_isendreceive_fillbuffer
INPUTS
atm_indx_recv(1:total number of atoms)= array for receive operation
Given an index of atom in global numbering, give its index
in the table of atoms treated by current processor
or -1 if the atoms is not treated by current processor
buf_int= buffer of receive integers
buf_dp= buffer of receive double precision numbers
nrhoij_send= number of sent atoms
OUTPUT
pawrhoij= output datastructure filled with buffers receive in a receive operation
PARENTS
m_pawrhoij
CHILDREN
SOURCE
4079 subroutine pawrhoij_isendreceive_getbuffer(pawrhoij,nrhoij_send,atm_indx_recv,buf_int,buf_dp) 4080 4081 4082 !This section has been created automatically by the script Abilint (TD). 4083 !Do not modify the following lines by hand. 4084 #undef ABI_FUNC 4085 #define ABI_FUNC 'pawrhoij_isendreceive_getbuffer' 4086 !End of the abilint section 4087 4088 implicit none 4089 4090 !Arguments ------------------------------------ 4091 !scalars 4092 integer,intent(in) :: nrhoij_send 4093 !arrays 4094 integer,intent(in) ::atm_indx_recv(:),buf_int(:) 4095 real(dp),intent(in) :: buf_dp(:) 4096 type(pawrhoij_type),target,intent(inout) :: pawrhoij(:) 4097 4098 !Local variables------------------------------- 4099 !scalars 4100 integer :: buf_dp_size,buf_int_size,cplex,ii,indx_int,indx_dp,iatom_tot,irhoij_send 4101 integer :: isp,jrhoij,lmn2_size,lmnmix,ngrhoij,nselect,nspden,rhoij_size2,use_rhoijp 4102 integer :: use_rhoijres,use_rhoijim,use_rhoij_ 4103 character(len=500) :: msg 4104 type(pawrhoij_type),pointer :: pawrhoij1 4105 !arrays 4106 4107 ! ********************************************************************* 4108 4109 buf_int_size=size(buf_int) 4110 buf_dp_size=size(buf_dp) 4111 indx_int=1;indx_dp=1 4112 4113 do irhoij_send=1,nrhoij_send 4114 4115 iatom_tot=buf_int(indx_int) ; indx_int=indx_int+1 4116 jrhoij= atm_indx_recv(iatom_tot) 4117 if (jrhoij==-1) then 4118 msg="Error in pawrhoij_isendreceive_getbuffer atom not found" 4119 MSG_BUG(msg) 4120 end if 4121 pawrhoij1=>pawrhoij(jrhoij) 4122 4123 cplex =buf_int(indx_int) ;indx_int=indx_int+1 4124 lmn2_size =buf_int(indx_int) ;indx_int=indx_int+1 4125 nspden =buf_int(indx_int) ;indx_int=indx_int+1 4126 nselect =buf_int(indx_int) ;indx_int=indx_int+1 4127 lmnmix =buf_int(indx_int) ;indx_int=indx_int+1 4128 ngrhoij =buf_int(indx_int) ;indx_int=indx_int+1 4129 use_rhoijp =buf_int(indx_int) ;indx_int=indx_int+1 4130 use_rhoijres=buf_int(indx_int) ;indx_int=indx_int+1 4131 use_rhoijim =buf_int(indx_int) ;indx_int=indx_int+1 4132 use_rhoij_ =buf_int(indx_int) ;indx_int=indx_int+1 4133 rhoij_size2 =buf_int(indx_int) ;indx_int=indx_int+1 4134 pawrhoij1%itypat=buf_int(indx_int) ;indx_int=indx_int+1 4135 pawrhoij1%lmn_size=buf_int(indx_int) ;indx_int=indx_int+1 4136 pawrhoij1%nsppol=buf_int(indx_int) ;indx_int=indx_int+1 4137 pawrhoij1%nspinor=buf_int(indx_int) ;indx_int=indx_int+1 4138 pawrhoij1%cplex=cplex 4139 pawrhoij1%lmn2_size=lmn2_size 4140 pawrhoij1%nspden=nspden 4141 pawrhoij1%nrhoijsel=nselect 4142 pawrhoij1%lmnmix_sz=lmnmix 4143 pawrhoij1%ngrhoij=ngrhoij 4144 pawrhoij1%use_rhoijp=use_rhoijp 4145 pawrhoij1%use_rhoijres=use_rhoijres 4146 pawrhoij1%use_rhoijim =use_rhoijim 4147 pawrhoij1%use_rhoij_=use_rhoij_ 4148 if (use_rhoijp>0) then 4149 LIBPAW_ALLOCATE(pawrhoij1%rhoijselect,(lmn2_size)) 4150 pawrhoij1%rhoijselect(1:nselect)=buf_int(indx_int:indx_int+nselect-1) 4151 if (nselect < lmn2_size )pawrhoij1%rhoijselect(nselect+1:lmn2_size)=zero 4152 indx_int=indx_int+nselect 4153 LIBPAW_ALLOCATE(pawrhoij1%rhoijp,(cplex*lmn2_size,nspden)) 4154 do isp=1,nspden 4155 pawrhoij1%rhoijp(1:cplex*nselect,isp)=buf_dp(indx_dp:indx_dp+cplex*nselect-1) 4156 if (nselect < lmn2_size )pawrhoij1%rhoijp(cplex*nselect+1:cplex*lmn2_size,isp)=zero 4157 indx_dp=indx_dp+cplex*nselect 4158 end do 4159 end if 4160 if (lmnmix>0) then 4161 LIBPAW_ALLOCATE(pawrhoij1%kpawmix,(lmnmix)) 4162 pawrhoij1%kpawmix(1:lmnmix)=buf_int(indx_int:indx_int+lmnmix-1) 4163 indx_int=indx_int+lmnmix 4164 end if 4165 if (ngrhoij>0) then 4166 LIBPAW_ALLOCATE(pawrhoij1%grhoij,(ngrhoij,cplex*lmn2_size,nspden)) 4167 do isp=1,nspden 4168 do ii=1,cplex*lmn2_size 4169 pawrhoij1%grhoij(1:ngrhoij,ii,isp)=buf_dp(indx_dp:indx_dp+ngrhoij-1) 4170 indx_dp=indx_dp+ngrhoij 4171 end do 4172 end do 4173 end if 4174 if (use_rhoijres>0) then 4175 LIBPAW_ALLOCATE(pawrhoij1%rhoijres,(cplex*lmn2_size,nspden)) 4176 do isp=1,nspden 4177 pawrhoij1%rhoijres(1:cplex*lmn2_size,isp)=buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1) 4178 indx_dp=indx_dp+cplex*lmn2_size 4179 end do 4180 end if 4181 if (use_rhoijim>0) then 4182 LIBPAW_ALLOCATE(pawrhoij1%rhoijim,(lmn2_size,nspden)) 4183 do isp=1,nspden 4184 pawrhoij1%rhoijim(1:lmn2_size,isp)=buf_dp(indx_dp:indx_dp+lmn2_size-1) 4185 indx_dp=indx_dp+lmn2_size 4186 end do 4187 end if 4188 if (use_rhoij_>0) then 4189 LIBPAW_ALLOCATE(pawrhoij1%rhoij_,(cplex*lmn2_size,rhoij_size2)) 4190 do isp=1,rhoij_size2 4191 pawrhoij1%rhoij_(1:cplex*lmn2_size,isp)=buf_dp(indx_dp:indx_dp+cplex*lmn2_size-1) 4192 indx_dp=indx_dp+cplex*lmn2_size 4193 end do 4194 end if 4195 end do !irhoij_send 4196 if ((indx_int/=1+buf_int_size).or.(indx_dp/=1+buf_dp_size)) then 4197 write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size 4198 MSG_BUG(msg) 4199 end if 4200 4201 end subroutine pawrhoij_isendreceive_getbuffer
m_pawrhoij/pawrhoij_mpisum_unpacked_1D [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_mpisum_unpacked_1D
FUNCTION
Build the MPI sum of the unsymmetrized PAW rhoij_ (augmentation occupancies)
Remember:for each atom, rho_ij=Sum_{n,k} {occ(n,k)*<Cnk|p_i><p_j|Cnk>}
Target: 1D array of pawrhoij datastructures
INPUTS
comm1=MPI communicator. Data will be MPI summed inside comm1
[comm2]=second MPI communicator. If present, rhoij_ will be
MPI summed inside comm2 after the collective sum in comm1.
SIDE EFFECTS
pawrhoij(:) <type(pawrhoij_type)>= paw rhoij occupancies and related data Input: the data calculateed by this processor. Output: the final MPI sum over comm1 and comm2.
PARENTS
CHILDREN
SOURCE
2915 subroutine pawrhoij_mpisum_unpacked_1D(pawrhoij,comm1,comm2) 2916 2917 2918 !This section has been created automatically by the script Abilint (TD). 2919 !Do not modify the following lines by hand. 2920 #undef ABI_FUNC 2921 #define ABI_FUNC 'pawrhoij_mpisum_unpacked_1D' 2922 !End of the abilint section 2923 2924 implicit none 2925 2926 !Arguments --------------------------------------------- 2927 !scalars 2928 integer,intent(in) :: comm1 2929 integer,optional,intent(in) :: comm2 2930 !arrays 2931 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 2932 2933 !Local variables --------------------------------------- 2934 !scalars 2935 integer :: bufdim,iatom,ierr,isppol,jdim,nsp2,natom 2936 integer :: nproc1,nproc2 2937 !character(len=500) :: msg 2938 !arrays 2939 integer,allocatable :: dimlmn(:) 2940 real(dp),allocatable :: buffer(:) 2941 2942 !************************************************************************ 2943 2944 natom=SIZE(pawrhoij);if (natom==0) return 2945 2946 nproc1 = xmpi_comm_size(comm1) 2947 nproc2=1; if (PRESENT(comm2)) nproc2 = xmpi_comm_size(comm2) 2948 if (nproc1==1.and.nproc2==1) RETURN 2949 2950 !Fill the MPI buffer from the local rhoij_ 2951 LIBPAW_ALLOCATE(dimlmn,(natom)) 2952 dimlmn(1:natom)=pawrhoij(1:natom)%cplex*pawrhoij(1:natom)%lmn2_size 2953 nsp2=pawrhoij(1)%nsppol; if (pawrhoij(1)%nspden==4) nsp2=4 2954 bufdim=sum(dimlmn)*nsp2 2955 LIBPAW_ALLOCATE(buffer,(bufdim)) 2956 jdim=0 2957 do iatom=1,natom 2958 do isppol=1,nsp2 2959 buffer(jdim+1:jdim+dimlmn(iatom))=pawrhoij(iatom)%rhoij_(:,isppol) 2960 jdim=jdim+dimlmn(iatom) 2961 end do 2962 end do 2963 2964 !Build sum of pawrhoij%rhoij_ 2965 call xmpi_sum(buffer,comm1,ierr) ! Sum over the first communicator. 2966 if (PRESENT(comm2)) then 2967 call xmpi_sum(buffer,comm2,ierr) ! Sum over the second communicator. 2968 end if 2969 2970 !Unpack the MPI packet filling rhoij_ 2971 jdim=0 2972 do iatom=1,natom 2973 do isppol=1,nsp2 2974 pawrhoij(iatom)%rhoij_(:,isppol)=buffer(jdim+1:jdim+dimlmn(iatom)) 2975 jdim=jdim+dimlmn(iatom) 2976 end do 2977 end do 2978 2979 LIBPAW_DEALLOCATE(buffer) 2980 LIBPAW_DEALLOCATE(dimlmn) 2981 2982 end subroutine pawrhoij_mpisum_unpacked_1D
m_pawrhoij/pawrhoij_mpisum_unpacked_2D [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_mpisum_unpacked_2D
FUNCTION
Build the MPI sum of the unsymmetrized PAW rhoij_ (augmentation occupancies)
Remember:for each atom, rho_ij=Sum_{n,k} {occ(n,k)*<Cnk|p_i><p_j|Cnk>}
Target: 2D array of pawrhoij datastructures
INPUTS
comm1=MPI communicator. Data will be MPI summed inside comm1
[comm2]=second MPI communicator. If present, rhoij_ will be
MPI summed inside comm2 after the collective sum in comm1.
SIDE EFFECTS
pawrhoij(:,:) <type(pawrhoij_type)>= paw rhoij occupancies and related data Input: the data calculateed by this processor. Output: the final MPI sum over comm1 and comm2.
PARENTS
CHILDREN
SOURCE
3012 subroutine pawrhoij_mpisum_unpacked_2D(pawrhoij,comm1,comm2) 3013 3014 3015 !This section has been created automatically by the script Abilint (TD). 3016 !Do not modify the following lines by hand. 3017 #undef ABI_FUNC 3018 #define ABI_FUNC 'pawrhoij_mpisum_unpacked_2D' 3019 !End of the abilint section 3020 3021 implicit none 3022 3023 !Arguments --------------------------------------------- 3024 !scalars 3025 integer,intent(in) :: comm1 3026 integer,optional,intent(in) :: comm2 3027 !arrays 3028 type(pawrhoij_type),intent(inout) :: pawrhoij(:,:) 3029 3030 !Local variables --------------------------------------- 3031 !scalars 3032 integer :: bufdim,iatom,ierr,irhoij,isppol,jdim,nsp2,natom,nrhoij 3033 integer :: nproc1,nproc2 3034 !character(len=500) :: msg 3035 !arrays 3036 integer,allocatable :: dimlmn(:,:) 3037 real(dp),allocatable :: buffer(:) 3038 3039 !************************************************************************ 3040 3041 natom =SIZE(pawrhoij,1);if (natom ==0) return 3042 nrhoij=SIZE(pawrhoij,2);if (nrhoij==0) return 3043 3044 nproc1 = xmpi_comm_size(comm1) 3045 nproc2=1; if (PRESENT(comm2)) nproc2 = xmpi_comm_size(comm2) 3046 if (nproc1==1.and.nproc2==1) RETURN 3047 3048 !Fill the MPI buffer from the local rhoij_ 3049 LIBPAW_ALLOCATE(dimlmn,(natom,nrhoij)) 3050 dimlmn(1:natom,1:nrhoij)=pawrhoij(1:natom,1:nrhoij)%cplex*pawrhoij(1:natom,1:nrhoij)%lmn2_size 3051 nsp2=pawrhoij(1,1)%nsppol; if (pawrhoij(1,1)%nspden==4) nsp2=4 3052 bufdim=sum(dimlmn)*nsp2 3053 LIBPAW_ALLOCATE(buffer,(bufdim)) 3054 jdim=0 3055 do irhoij=1,nrhoij 3056 do iatom=1,natom 3057 do isppol=1,nsp2 3058 buffer(jdim+1:jdim+dimlmn(iatom,irhoij))=pawrhoij(iatom,irhoij)%rhoij_(:,isppol) 3059 jdim=jdim+dimlmn(iatom,irhoij) 3060 end do 3061 end do 3062 end do 3063 3064 !Build sum of pawrhoij%rhoij_ 3065 call xmpi_sum(buffer,comm1,ierr) ! Sum over the first communicator. 3066 if (PRESENT(comm2)) then 3067 call xmpi_sum(buffer,comm2,ierr) ! Sum over the second communicator. 3068 end if 3069 3070 !Unpack the MPI packet filling rhoij_ 3071 jdim=0 3072 do irhoij=1,nrhoij 3073 do iatom=1,natom 3074 do isppol=1,nsp2 3075 pawrhoij(iatom,irhoij)%rhoij_(:,isppol)=buffer(jdim+1:jdim+dimlmn(iatom,irhoij)) 3076 jdim=jdim+dimlmn(iatom,irhoij) 3077 end do 3078 end do 3079 end do 3080 3081 LIBPAW_DEALLOCATE(buffer) 3082 LIBPAW_DEALLOCATE(dimlmn) 3083 3084 end subroutine pawrhoij_mpisum_unpacked_2D
m_pawrhoij/pawrhoij_nullify [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_nullify
FUNCTION
Nullify (initialize to null) a pawrhoij datastructure
SIDE EFFECTS
pawrhoij(:)<type(pawrhoij_type)>= rhoij datastructure
PARENTS
d2frnl,dfpt_looppert,m_ioarr,m_pawrhoij,m_scf_history,outscfcv,pawgrnl pawmkrho,pawprt,posdoppler,respfn
CHILDREN
SOURCE
476 subroutine pawrhoij_nullify(pawrhoij) 477 478 479 !This section has been created automatically by the script Abilint (TD). 480 !Do not modify the following lines by hand. 481 #undef ABI_FUNC 482 #define ABI_FUNC 'pawrhoij_nullify' 483 !End of the abilint section 484 485 implicit none 486 487 !Arguments ------------------------------------ 488 !arrays 489 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 490 491 !Local variables------------------------------- 492 !scalars 493 integer :: irhoij,nrhoij 494 495 ! ************************************************************************* 496 497 ! MGPAW: This one could be removed/renamed, 498 ! variables can be initialized in the datatype declaration 499 ! Do we need to expose this in the public API? 500 501 nrhoij=size(pawrhoij) 502 503 if (nrhoij>0) then 504 do irhoij=1,nrhoij 505 pawrhoij(irhoij)%nrhoijsel=0 506 pawrhoij(irhoij)%ngrhoij=0 507 pawrhoij(irhoij)%lmnmix_sz=0 508 pawrhoij(irhoij)%use_rhoij_=0 509 pawrhoij(irhoij)%use_rhoijp=0 510 pawrhoij(irhoij)%use_rhoijres=0 511 pawrhoij(irhoij)%use_rhoijim=0 512 end do 513 end if 514 515 end subroutine pawrhoij_nullify
m_pawrhoij/pawrhoij_redistribute [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_redistribute
FUNCTION
Redistribute an array of pawrhoij datastructures Input pawrhoij is given on a MPI communicator Output pawrhoij is redistributed on another MPI communicator
INPUTS
mpi_comm_in= input MPI (atom) communicator
mpi_comm_out= output MPI (atom) communicator
mpi_atmtab_in= --optional-- indexes of the input pawrhoij treated by current proc
if not present, will be calculated in the present routine
mpi_atmtab_out= --optional-- indexes of the output pawrhoij treated by current proc
if not present, will be calculated in the present routine
natom= --optional-- total number of atoms
----- Optional arguments used only for asynchronous communications -----
RecvAtomProc(:)= rank of processor from which I expect atom (in mpi_comm_in)
RecvAtomList(:)= indexes of atoms to be received by me
RecvAtomList(irecv) are the atoms I expect from RecvAtomProc(irecv)
SendAtomProc(:)= ranks of process destination of atom (in mpi_comm_in)
SendAtomList(:)= indexes of atoms to be sent by me
SendAtomList(isend) are the atoms sent to SendAtomProc(isend)
OUTPUT
[pawrhoij_out(:)]<type(pawrhoij_type)>= --optional-- if present, the redistributed datastructure does not replace the input one but is delivered in pawrhoij_out if not present, input and output datastructure are the same.
SIDE EFFECTS
pawrhoij(:)<type(pawrhoij_type)>= input (and eventually output) pawrhoij datastructures
PARENTS
m_paral_pert
CHILDREN
SOURCE
1980 subroutine pawrhoij_redistribute(pawrhoij,mpi_comm_in,mpi_comm_out,& 1981 & natom,mpi_atmtab_in,mpi_atmtab_out,pawrhoij_out,& 1982 & SendAtomProc,SendAtomList,RecvAtomProc,RecvAtomList) 1983 1984 1985 !This section has been created automatically by the script Abilint (TD). 1986 !Do not modify the following lines by hand. 1987 #undef ABI_FUNC 1988 #define ABI_FUNC 'pawrhoij_redistribute' 1989 !End of the abilint section 1990 1991 implicit none 1992 1993 !Arguments ------------------------------------ 1994 !scalars 1995 integer,intent(in) :: mpi_comm_in,mpi_comm_out 1996 integer,optional,intent(in) :: natom 1997 !arrays 1998 integer,intent(in),optional,target :: mpi_atmtab_in(:),mpi_atmtab_out(:) 1999 integer,intent(in),optional :: SendAtomProc(:),SendAtomList(:),RecvAtomProc(:),RecvAtomList(:) 2000 type(pawrhoij_type),allocatable,intent(inout) :: pawrhoij(:) 2001 type(pawrhoij_type),pointer,intent(out),optional :: pawrhoij_out(:) 2002 2003 !Local variables------------------------------- 2004 !scalars 2005 integer :: algo_option,i1,iat_in,iat_out,iatom,ierr,ireq,iircv,iisend,imsg,imsg_current,imsg1 2006 integer :: iproc_rcv,iproc_send,me_exch,mpi_comm_exch,my_natom_in,my_natom_out,my_tag,natom_tot,nb_dp,nb_int 2007 integer :: nb_msg,nbmsg_incoming,nbrecv,nbrecvmsg,nbsend,nbsendreq,nbsent,next,npawrhoij_sent 2008 integer :: nproc_in,nproc_out 2009 logical :: flag,in_place,message_yet_prepared,my_atmtab_in_allocated,my_atmtab_out_allocated,paral_atom 2010 !arrays 2011 integer :: buf_size(3),request1(3) 2012 integer,pointer :: my_atmtab_in(:),my_atmtab_out(:) 2013 integer,allocatable :: atmtab_send(:),atm_indx_in(:),atm_indx_out(:),buf_int1(:),From(:),request(:) 2014 integer,allocatable,target :: buf_int(:) 2015 integer,pointer:: buf_ints(:) 2016 logical,allocatable :: msg_pick(:) 2017 real(dp),allocatable :: buf_dp1(:) 2018 real(dp),allocatable,target :: buf_dp(:) 2019 real(dp),pointer :: buf_dps(:) 2020 type(coeffi1_type),target,allocatable :: tab_buf_int(:),tab_buf_atom(:) 2021 type(coeff1_type),target,allocatable :: tab_buf_dp(:) 2022 type(pawrhoij_type),pointer :: pawrhoij_out1(:) 2023 type(pawrhoij_type),allocatable :: pawrhoij_all(:) 2024 2025 ! ************************************************************************* 2026 2027 !@pawrhoij_type 2028 2029 in_place=(.not.present(pawrhoij_out)) 2030 my_natom_in=size(pawrhoij) 2031 2032 !If not "in_place", destroy the output datastructure 2033 if (.not.in_place) then 2034 if (associated(pawrhoij_out)) then 2035 call pawrhoij_free(pawrhoij_out) 2036 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij_out) 2037 end if 2038 end if 2039 2040 !Special sequential case 2041 if (mpi_comm_in==xmpi_comm_self.and.mpi_comm_out==xmpi_comm_self) then 2042 if ((.not.in_place).and.(my_natom_in>0)) then 2043 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_out,(my_natom_in)) 2044 call pawrhoij_nullify(pawrhoij_out) 2045 call pawrhoij_copy(pawrhoij,pawrhoij_out,& 2046 & keep_cplex=.false.,keep_itypat=.false.,keep_nspden=.false.) 2047 end if 2048 return 2049 end if 2050 2051 !Get total natom 2052 if (present(natom)) then 2053 natom_tot=natom 2054 else 2055 natom_tot=my_natom_in 2056 call xmpi_sum(natom_tot,mpi_comm_in,ierr) 2057 end if 2058 2059 !Select input distribution 2060 if (present(mpi_atmtab_in)) then 2061 my_atmtab_in => mpi_atmtab_in 2062 my_atmtab_in_allocated=.false. 2063 else 2064 call get_my_atmtab(mpi_comm_in,my_atmtab_in,my_atmtab_in_allocated,& 2065 & paral_atom,natom_tot,my_natom_in) 2066 end if 2067 2068 !Select output distribution 2069 if (present(mpi_atmtab_out)) then 2070 my_natom_out=size(mpi_atmtab_out) 2071 my_atmtab_out => mpi_atmtab_out 2072 my_atmtab_out_allocated=.false. 2073 else 2074 call get_my_atmtab(mpi_comm_out,my_atmtab_out,my_atmtab_out_allocated,& 2075 & paral_atom,natom_tot) 2076 end if 2077 2078 !Select algo according to optional input arguments 2079 algo_option=1 2080 if (present(SendAtomProc).and.present(SendAtomList).and.& 2081 & present(RecvAtomProc).and.present(RecvAtomList)) algo_option=2 2082 2083 2084 !Brute force algorithm (allgather + scatter) 2085 !--------------------------------------------------------- 2086 if (algo_option==1) then 2087 2088 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_all,(natom_tot)) 2089 call pawrhoij_nullify(pawrhoij_all) 2090 call pawrhoij_copy(pawrhoij,pawrhoij_all,comm_atom=mpi_comm_in,mpi_atmtab=my_atmtab_in,& 2091 & keep_cplex=.false.,keep_itypat=.false.,keep_nspden=.false.) 2092 if (in_place) then 2093 call pawrhoij_free(pawrhoij) 2094 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij) 2095 LIBPAW_DATATYPE_ALLOCATE(pawrhoij,(my_natom_out)) 2096 call pawrhoij_nullify(pawrhoij) 2097 call pawrhoij_copy(pawrhoij_all,pawrhoij,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out,& 2098 & keep_cplex=.false.,keep_itypat=.false.,keep_nspden=.false.) 2099 else 2100 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_out,(my_natom_out)) 2101 call pawrhoij_nullify(pawrhoij_out) 2102 call pawrhoij_copy(pawrhoij_all,pawrhoij_out,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out,& 2103 & keep_cplex=.false.,keep_itypat=.false.,keep_nspden=.false.) 2104 end if 2105 call pawrhoij_free(pawrhoij_all) 2106 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij_all) 2107 2108 2109 !Asynchronous algorithm (asynchronous communications) 2110 !--------------------------------------------------------- 2111 else if (algo_option==2) then 2112 2113 nbsend=size(SendAtomProc) ; nbrecv=size(RecvAtomProc) 2114 2115 if (in_place) then 2116 if ( my_natom_out > 0 ) then 2117 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_out1,(my_natom_out)) 2118 call pawrhoij_nullify(pawrhoij_out1) 2119 else 2120 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_out1,(0)) 2121 end if 2122 else 2123 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_out,(my_natom_out)) 2124 call pawrhoij_nullify(pawrhoij_out) 2125 pawrhoij_out1=>pawrhoij_out 2126 end if 2127 2128 nproc_in=xmpi_comm_size(mpi_comm_in) 2129 nproc_out=xmpi_comm_size(mpi_comm_out) 2130 if (nproc_in<=nproc_out) mpi_comm_exch=mpi_comm_out 2131 if (nproc_in>nproc_out) mpi_comm_exch=mpi_comm_in 2132 me_exch=xmpi_comm_rank(mpi_comm_exch) 2133 2134 ! Dimension put to the maximum to send 2135 LIBPAW_ALLOCATE(atmtab_send,(nbsend)) 2136 LIBPAW_ALLOCATE(atm_indx_in,(natom_tot)) 2137 atm_indx_in=-1 2138 do iatom=1,my_natom_in 2139 atm_indx_in(my_atmtab_in(iatom))=iatom 2140 end do 2141 LIBPAW_ALLOCATE(atm_indx_out,(natom_tot)) 2142 atm_indx_out=-1 2143 do iatom=1,my_natom_out 2144 atm_indx_out(my_atmtab_out(iatom))=iatom 2145 end do 2146 2147 LIBPAW_DATATYPE_ALLOCATE(tab_buf_int,(nbsend)) 2148 LIBPAW_DATATYPE_ALLOCATE(tab_buf_dp,(nbsend)) 2149 LIBPAW_DATATYPE_ALLOCATE(tab_buf_atom,(nbsend)) 2150 LIBPAW_ALLOCATE(request,(3*nbsend)) 2151 2152 ! A send buffer in an asynchrone communication couldn't be deallocate before it has been receive 2153 nbsent=0 ; ireq=0 ; iisend=0 ; nbsendreq=0 ; nb_msg=0 2154 do iisend=1,nbsend 2155 iproc_rcv=SendAtomProc(iisend) 2156 next=-1 2157 if (iisend < nbsend) next=SendAtomProc(iisend+1) 2158 if (iproc_rcv /= me_exch) then 2159 nbsent=nbsent+1 2160 atmtab_send(nbsent)=SendAtomList(iisend) ! we groups the atoms sends to the same process 2161 if (iproc_rcv /= next) then 2162 if (nbsent > 0) then 2163 ! Check if message has been yet prepared 2164 message_yet_prepared=.false. 2165 do imsg=1,nb_msg 2166 if (size(tab_buf_atom(imsg)%value) /= nbsent) then 2167 cycle 2168 else 2169 do imsg1=1,nbsent 2170 if (tab_buf_atom(imsg)%value(imsg1)/=atmtab_send(imsg1)) exit 2171 message_yet_prepared=.true. 2172 imsg_current=imsg 2173 end do 2174 end if 2175 end do 2176 ! Create the message 2177 if (.not.message_yet_prepared) then 2178 nb_msg=nb_msg+1 2179 call pawrhoij_isendreceive_fillbuffer( & 2180 & pawrhoij,atmtab_send,atm_indx_in,nbsent,buf_int,nb_int,buf_dp,nb_dp) 2181 LIBPAW_ALLOCATE(tab_buf_int(nb_msg)%value,(nb_int)) 2182 LIBPAW_ALLOCATE(tab_buf_dp(nb_msg)%value,(nb_dp)) 2183 tab_buf_int(nb_msg)%value(1:nb_int)=buf_int(1:nb_int) 2184 tab_buf_dp(nb_msg)%value(1:nb_dp)=buf_dp(1:nb_dp) 2185 LIBPAW_DEALLOCATE(buf_int) 2186 LIBPAW_DEALLOCATE(buf_dp) 2187 LIBPAW_ALLOCATE(tab_buf_atom(nb_msg)%value, (nbsent)) 2188 tab_buf_atom(nb_msg)%value(1:nbsent)=atmtab_send(1:nbsent) 2189 imsg_current=nb_msg 2190 end if 2191 ! Communicate 2192 buf_size(1)=size(tab_buf_int(imsg_current)%value) 2193 buf_size(2)=size(tab_buf_dp(imsg_current)%value) 2194 buf_size(3)=nbsent 2195 buf_ints=>tab_buf_int(imsg_current)%value 2196 buf_dps=>tab_buf_dp(imsg_current)%value 2197 my_tag=100 2198 ireq=ireq+1 2199 call xmpi_isend(buf_size,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr) 2200 my_tag=101 2201 ireq=ireq+1 2202 call xmpi_isend(buf_ints,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr) 2203 my_tag=102 2204 ireq=ireq+1 2205 call xmpi_isend(buf_dps,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr) 2206 nbsendreq=ireq 2207 nbsent=0 2208 end if 2209 end if 2210 else ! Just a renumbering, not a sending 2211 iat_in=atm_indx_in(SendAtomList(iisend)) 2212 iat_out=atm_indx_out(my_atmtab_in(iat_in)) 2213 call pawrhoij_copy(pawrhoij(iat_in:iat_in),pawrhoij_out1(iat_out:iat_out), & 2214 & keep_cplex=.false.,keep_itypat=.false.,keep_nspden=.false.) 2215 nbsent=0 2216 end if 2217 end do 2218 2219 LIBPAW_ALLOCATE(From,(nbrecv)) 2220 From(:)=-1 ; nbrecvmsg=0 2221 do iircv=1,nbrecv 2222 iproc_send=RecvAtomProc(iircv) !receive from (RcvAtomProc is sorted by growing process) 2223 next=-1 2224 if (iircv < nbrecv) next=RecvAtomProc(iircv+1) 2225 if (iproc_send /= me_exch .and. iproc_send/=next) then 2226 nbrecvmsg=nbrecvmsg+1 2227 From(nbrecvmsg)=iproc_send 2228 end if 2229 end do 2230 2231 LIBPAW_ALLOCATE(msg_pick,(nbrecvmsg)) 2232 msg_pick=.false. 2233 nbmsg_incoming=nbrecvmsg 2234 do while (nbmsg_incoming > 0) 2235 do i1=1,nbrecvmsg 2236 if (.not.msg_pick(i1)) then 2237 iproc_send=From(i1) 2238 flag=.false. 2239 my_tag=100 2240 call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr) 2241 if (flag) then 2242 msg_pick(i1)=.true. 2243 call xmpi_irecv(buf_size,iproc_send,my_tag,mpi_comm_exch,request1(1),ierr) 2244 call xmpi_wait(request1(1),ierr) 2245 nb_int=buf_size(1) 2246 nb_dp=buf_size(2) 2247 npawrhoij_sent=buf_size(3) 2248 LIBPAW_ALLOCATE(buf_int1,(nb_int)) 2249 LIBPAW_ALLOCATE(buf_dp1,(nb_dp)) 2250 my_tag=101 2251 call xmpi_irecv(buf_int1,iproc_send,my_tag,mpi_comm_exch,request1(2),ierr) 2252 my_tag=102 2253 call xmpi_irecv(buf_dp1,iproc_send,my_tag,mpi_comm_exch,request1(3),ierr) 2254 call xmpi_waitall(request1(2:3),ierr) 2255 call pawrhoij_isendreceive_getbuffer(pawrhoij_out1,npawrhoij_sent,atm_indx_out,buf_int1,buf_dp1) 2256 nbmsg_incoming=nbmsg_incoming-1 2257 LIBPAW_DEALLOCATE(buf_int1) 2258 LIBPAW_DEALLOCATE(buf_dp1) 2259 end if 2260 end if 2261 end do 2262 end do 2263 LIBPAW_DEALLOCATE(msg_pick) 2264 2265 if (in_place) then 2266 call pawrhoij_free(pawrhoij) 2267 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij) 2268 LIBPAW_DATATYPE_ALLOCATE(pawrhoij,(my_natom_out)) 2269 call pawrhoij_nullify(pawrhoij) 2270 call pawrhoij_copy(pawrhoij_out1,pawrhoij, & 2271 & keep_cplex=.false.,keep_itypat=.false.,keep_nspden=.false.) 2272 call pawrhoij_free(pawrhoij_out1) 2273 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij_out1) 2274 end if 2275 2276 ! Wait for deallocating arrays that all sending operations has been realized 2277 if (nbsendreq > 0) then 2278 call xmpi_waitall(request(1:nbsendreq),ierr) 2279 end if 2280 2281 ! Deallocate buffers 2282 do i1=1,nb_msg 2283 LIBPAW_DEALLOCATE(tab_buf_int(i1)%value) 2284 LIBPAW_DEALLOCATE(tab_buf_dp(i1)%value) 2285 LIBPAW_DEALLOCATE(tab_buf_atom(i1)%value) 2286 end do 2287 LIBPAW_DATATYPE_DEALLOCATE(tab_buf_int) 2288 LIBPAW_DATATYPE_DEALLOCATE(tab_buf_dp) 2289 LIBPAW_DATATYPE_DEALLOCATE(tab_buf_atom) 2290 LIBPAW_DEALLOCATE(From) 2291 LIBPAW_DEALLOCATE(request) 2292 LIBPAW_DEALLOCATE(atmtab_send) 2293 LIBPAW_DEALLOCATE(atm_indx_in) 2294 LIBPAW_DEALLOCATE(atm_indx_out) 2295 2296 end if !algo_option 2297 2298 !Eventually release temporary pointers 2299 call free_my_atmtab(my_atmtab_in,my_atmtab_in_allocated) 2300 call free_my_atmtab(my_atmtab_out,my_atmtab_out_allocated) 2301 2302 end subroutine pawrhoij_redistribute
m_pawrhoij/pawrhoij_type [ Types ]
[ Top ] [ m_pawrhoij ] [ Types ]
NAME
pawrhoij_type
FUNCTION
This structured datatype contains rhoij quantities (occucpancies) and related data, used in PAW calculations.
SOURCE
83 type,public :: pawrhoij_type 84 85 !Integer scalars 86 87 integer :: cplex 88 ! cplex=1 if rhoij are real, 2 if rhoij are complex 89 ! For GS calculations: rhoij are real provided that time-reversal can be used. 90 91 integer :: itypat 92 ! itypat=type of the atom 93 94 integer :: lmn_size 95 ! Number of (l,m,n) elements for the paw basis 96 97 integer :: lmn2_size 98 ! lmn2_size=lmn_size*(lmn_size+1)/2 99 ! where lmn_size is the number of (l,m,n) elements for the paw basis 100 101 integer :: lmnmix_sz=0 102 ! lmnmix_sz=number of (lmn,lmn_prime) verifying l<=lmix and l_prime<=lmix 103 ! i.e. number of rhoij elements being mixed during SCF cycle 104 ! lmnmix_sz=0 if mixing data are not used 105 106 integer :: ngrhoij=0 107 ! First dimension of array grhoij 108 109 integer :: nrhoijsel=0 110 ! nrhoijsel 111 ! Number of non-zero value of rhoij 112 ! This is the size of rhoijp(:,:) (see below in this datastructure) 113 114 integer :: nspden 115 ! Number of spin-density components for rhoij (may be different from nspden for density) 116 117 integer :: nspinor 118 ! Number of spinorial components 119 120 integer :: nsppol 121 ! Number of independent spin-components 122 123 integer :: use_rhoij_=0 124 ! 1 if pawrhoij%rhoij_ is allocated 125 126 integer :: use_rhoijp=0 127 ! 1 if pawrhoij%rhoijp and pawrhoij%rhoijselect are allocated 128 129 integer :: use_rhoijres=0 130 ! 1 if pawrhoij%rhoijres is allocated 131 132 integer :: use_rhoijim=0 133 ! 1 if pawrhoij%rhoijim is allocated 134 135 !Integer arrays 136 137 integer, allocatable :: kpawmix(:) 138 ! kpawmix(lmnmix_sz) 139 ! Indirect array selecting the elements of rhoij 140 ! being mixed during SCF cycle 141 142 integer, allocatable :: rhoijselect(:) 143 ! rhoijselect(lmn2_size) 144 ! Indirect array selecting the non-zero elements of rhoij: 145 ! rhoijselect(isel,ispden)=klmn if rhoij(klmn,ispden) is non-zero 146 147 !Real (real(dp)) arrays 148 149 real(dp), allocatable :: grhoij (:,:,:) 150 ! grhoij(ngrhoij,cplex*lmn2_size,nspden) 151 ! Gradients of Rho_ij wrt xred, strains, ... (non-packed storage) 152 153 real(dp), allocatable :: rhoij_ (:,:) 154 ! rhoij_(cplex*lmn2_size,nspden) 155 ! Array used to (temporary) store Rho_ij in a non-packed storage mode 156 157 real(dp), allocatable :: rhoijp (:,:) 158 ! rhoijp(cplex*lmn2_size,nspden) 159 ! Augmentation waves occupancies Rho_ij in PACKED STORAGE (only non-zero elements are stored) 160 161 real(dp), allocatable :: rhoijres (:,:) 162 ! rhoijres(cplex*lmn2_size,nspden) 163 ! Rho_ij residuals during SCF cycle (non-packed storage) 164 165 real(dp), allocatable :: rhoijim (:,:) 166 ! rhoijim(lmn2_size,nspden) 167 ! Missing term of the imaginary part of Rho_ij (non-packed storage) 168 169 end type pawrhoij_type
m_pawrhoij/pawrhoij_unpack [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
pawrhoij_unpack
FUNCTION
Unpack the values store in rhoijp copying them to the rhoij_ array.
SIDE EFFECTS
rhoij(:) <pawrhoij_type)>= input/output datastructure * In output the rhoij_ array is filled with the values stored in the packed array rhoijp. * If use_rhoij_/=1, rhoij_ is allocated and the corresponding flag is set to 1.
PARENTS
paw_qpscgw
CHILDREN
SOURCE
2730 subroutine pawrhoij_unpack(rhoij) 2731 2732 2733 !This section has been created automatically by the script Abilint (TD). 2734 !Do not modify the following lines by hand. 2735 #undef ABI_FUNC 2736 #define ABI_FUNC 'pawrhoij_unpack' 2737 !End of the abilint section 2738 2739 implicit none 2740 2741 !Arguments ------------------------------------ 2742 !scalars 2743 !arrays 2744 type(pawrhoij_type),intent(inout) :: rhoij(:) 2745 2746 !Local variables------------------------------- 2747 integer :: natom,iat,lmn2_size,isel,klmn,nspden,cplex 2748 2749 ! ************************************************************************* 2750 2751 natom = SIZE(rhoij) ; if (natom==0) return 2752 nspden = rhoij(1)%nspden ! MT jan-2010: this should not be nspden but nsppol or 4 if nspden=4 2753 cplex = rhoij(1)%cplex 2754 2755 do iat=1,natom 2756 2757 lmn2_size =rhoij(iat)%lmn2_size 2758 2759 if (rhoij(iat)%use_rhoij_/=1) then ! Have to allocate rhoij 2760 LIBPAW_ALLOCATE(rhoij(iat)%rhoij_,(cplex*lmn2_size,nspden)) 2761 rhoij(iat)%use_rhoij_=1 2762 end if 2763 rhoij(iat)%rhoij_ = zero 2764 2765 do isel=1,rhoij(iat)%nrhoijsel ! Looping over non-zero ij elements. 2766 klmn = rhoij(iat)%rhoijselect(isel) 2767 rhoij(iat)%rhoij_(klmn,:) = rhoij(iat)%rhoijp(isel,:) 2768 end do 2769 2770 end do ! natom 2771 2772 end subroutine pawrhoij_unpack
m_pawrhoij/symrhoij [ Functions ]
[ Top ] [ m_pawrhoij ] [ Functions ]
NAME
symrhoij
FUNCTION
Symmetrize rhoij quantities (augmentation occupancies) and/or gradients Compute also rhoij residuals (new-old values of rhoij and gradients)
INPUTS
choice=select then type of rhoij gradients to symmetrize.
choice=1 => no gradient
choice=2 => gradient with respect to atomic position(s)
=3 => a gradient with respect to strain(s)
=4 => 2nd gradient with respect to atomic position(s)
=23=> a gradient with respect to atm. pos. and strain(s)
=24=> 1st and 2nd gradient with respect to atomic position(s)
gprimd(3,3)=dimensional primitive translations for reciprocal space(bohr^-1).
indsym(4,nsym,natom)=indirect indexing array for atom labels
ipert=index of perturbation if pawrhoij is a pertubed rhoij
no meaning for ground-state calculations (should be 0)
[mpi_atmtab(:)]=--optional-- indexes of the atoms treated by current proc
[comm_atom]=--optional-- MPI communicator over atoms
natom=number of atoms in cell
nsym=number of symmetry elements in space group
ntypat=number of types of atoms in unit cell.
optrhoij= 1 if rhoij quantities have to be symmetrized
pawrhoij_unsym(:) <type(pawrhoij_type)>= datastructure containing PAW rhoij occupancies
(and related data) non symmetrized in an unpacked storage (pawrhoij_unsym%rhoij_)
Contains eventually unsymmetrized rhoij gradients (grhoij)
pawang <type(pawang_type)>=angular mesh discretization and related data
pawprtvol=control print volume and debugging output for PAW
Note: if pawprtvol=-10001, nothing is printed out
pawtab(ntypat) <type(pawtab_type)>=paw tabulated starting data
[qphon(3)]=--optional-- (RF calculations only) - wavevector of the phonon
rprimd(3,3)=real space primitive translations.
symafm(nsym)=(anti)ferromagnetic part of symmetry operations
symrec(3,3,nsym)=symmetries of group in terms of operations on
reciprocal space primitive translations
typat(natom)=type for each atom
OUTPUT
SIDE EFFECTS
pawrhoij(natom) <type(pawrhoij_type)>= datastructure containing PAW rhoij occupancies (and related data) SYMMETRIZED in a packed storage (pawrhoij%rhoijp). if (optrhoij==1) pawrhoij(natom)%nrhoijsel=number of non-zero values of rhoij pawrhoij(natom)%rhoijp(cplex*lmn2_size,nspden)=symetrized paw rhoij quantities in PACKED STORAGE (only non-zero values) pawrhoij(natom)%rhoijres(cplex*lmn2_size,nspden)=paw rhoij quantities residuals (new values - old values) pawrhoij(natom)%rhoijselect(lmn2_size)=select the non-zero values of rhoij!! if (pawrhoij(:)%ngrhoij>0) (equivalent to choice>1) pawrhoij(natom)%grhoij(ngrhoij,cplex*lmn2_size,nspden)=symetrized gradients of rhoij
NOTES
pawrhoij and pawrhoij_unsym can be identical (refer to the same pawrhoij datastructure). They should be different only if pawrhoij is distributed over atomic sites (in that case pawrhoij_unsym should not be distributed over atomic sites).
PARENTS
d2frnl,energy,paw_qpscgw,pawmkrho,posdoppler
CHILDREN
SOURCE
3206 subroutine symrhoij(pawrhoij,pawrhoij_unsym,choice,gprimd,indsym,ipert,natom,nsym,& 3207 & ntypat,optrhoij,pawang,pawprtvol,pawtab,rprimd,symafm,symrec,typat, & 3208 & mpi_atmtab,comm_atom,qphon) ! optional arguments (parallelism) 3209 3210 3211 !This section has been created automatically by the script Abilint (TD). 3212 !Do not modify the following lines by hand. 3213 #undef ABI_FUNC 3214 #define ABI_FUNC 'symrhoij' 3215 !End of the abilint section 3216 3217 implicit none 3218 3219 !Arguments --------------------------------------------- 3220 !scalars 3221 integer,intent(in) :: choice,ipert,natom,nsym,ntypat,optrhoij,pawprtvol 3222 integer,optional,intent(in) :: comm_atom 3223 type(pawang_type),intent(in) :: pawang 3224 !arrays 3225 integer,intent(in) :: indsym(4,nsym,natom) 3226 integer,optional,target,intent(in) :: mpi_atmtab(:) 3227 integer,intent(in) :: symafm(nsym),symrec(3,3,nsym),typat(natom) 3228 real(dp),intent(in) :: gprimd(3,3),rprimd(3,3) 3229 real(dp),intent(in),optional :: qphon(3) 3230 type(pawrhoij_type),intent(inout) :: pawrhoij(:) 3231 type(pawrhoij_type),target,intent(inout) :: pawrhoij_unsym(:) 3232 type(pawtab_type),target,intent(in) :: pawtab(ntypat) 3233 3234 !Local variables --------------------------------------- 3235 character(len=8),parameter :: dspin(6)=(/"up ","down ","dens (n)","magn (x)","magn (y)","magn (z)"/) 3236 !scalars 3237 integer :: at_indx,cplex,cplex_eff,iafm,iatm,iatom,idum1,il,il0,ilmn,iln,iln0,ilpm,indexi 3238 integer :: indexii,indexj,indexjj,indexjj0,indexk,indexk1,iplex,irhoij,irot,ishift2,ishift3 3239 integer :: ishift4,ispden,itypat,j0lmn,jj,jl,jl0,jlmn,jln,jln0,jlpm,jrhoij,jspden,klmn,klmn1,kspden 3240 integer :: lmn_size,mi,mj,my_comm_atom,mu,mua,mub,mushift,natinc,ngrhoij,nrhoij,nrhoij1,nrhoij_unsym 3241 integer :: nselect,nselect1,nspinor,nu,nushift,sz1,sz2 3242 logical,parameter :: afm_noncoll=.true. ! TRUE if antiferro symmetries are used with non-collinear magnetism 3243 real(dp) :: arg,factafm,syma,zarot2 3244 logical :: antiferro,have_phase,my_atmtab_allocated,noncoll,paral_atom,paral_atom_unsym,use_afm,use_res 3245 character(len=8) :: pertstrg,wrt_mode 3246 character(len=500) :: msg 3247 !arrays 3248 integer,parameter :: alpha(6)=(/1,2,3,3,3,2/),beta(6)=(/1,2,3,2,1,1/) 3249 integer :: nsym_used(2) 3250 integer, pointer :: indlmn(:,:) 3251 integer,pointer :: my_atmtab(:) 3252 integer :: idum(0) 3253 real(dp) :: factsym(2),phase(2),rhoijc(2),ro(2),sumrho(2,2),sum1(2),rotrho(2,2),xsym(3) 3254 real(dp),allocatable :: rotgr(:,:,:),rotmag(:,:),rotmaggr(:,:,:) 3255 real(dp),allocatable :: sumgr(:,:),summag(:,:),summaggr(:,:,:),symrec_cart(:,:,:),work1(:,:,:) 3256 real(dp),pointer :: grad(:,:,:) 3257 type(coeff3_type),target,allocatable :: tmp_grhoij(:) 3258 type(pawrhoij_type),pointer :: pawrhoij_unsym_all(:) 3259 3260 ! ********************************************************************* 3261 3262 !Sizes of pawrhoij datastructures 3263 nrhoij=size(pawrhoij) 3264 nrhoij_unsym=size(pawrhoij_unsym) 3265 3266 !Set up parallelism over atoms 3267 paral_atom=(present(comm_atom).and.(nrhoij/=natom)) 3268 paral_atom_unsym=(present(comm_atom).and.(nrhoij_unsym/=natom)) 3269 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 3270 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 3271 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom) 3272 3273 !Symetrization occurs only when nsym>1 3274 if (nsym>1) then 3275 3276 ! Test: consistency between choice and ngrhoij 3277 ngrhoij=0 3278 if (nrhoij>0) then 3279 ngrhoij=pawrhoij(1)%ngrhoij 3280 if(choice==2) ngrhoij=min(3,pawrhoij(1)%ngrhoij) 3281 if(choice==3.or.choice==4) ngrhoij=min(6,pawrhoij(1)%ngrhoij) 3282 if(choice==23.or.choice==24) ngrhoij=min(9,pawrhoij(1)%ngrhoij) 3283 if ((choice==1.and.ngrhoij/=0).or.(choice==2.and.ngrhoij/=3).or. & 3284 & (choice==3.and.ngrhoij/=6).or.(choice==23.and.ngrhoij/=9).or. & 3285 & (choice==4.and.ngrhoij/=6).or.(choice==24.and.ngrhoij/=9) ) then 3286 msg='Inconsistency between variables choice and ngrhoij !' 3287 MSG_BUG(msg) 3288 end if 3289 end if 3290 3291 ! Symetrization of gradients not compatible with nspden=4 3292 if (nrhoij>0) then 3293 if (choice>2.and.pawrhoij(1)%nspden==4) then 3294 msg='For the time being, choice>2 is not compatible with nspden=4 !' 3295 MSG_BUG(msg) 3296 end if 3297 end if 3298 3299 ! Symetry matrixes must be in memory 3300 if (pawang%nsym==0) then 3301 msg='pawang%zarot must be allocated !' 3302 MSG_BUG(msg) 3303 end if 3304 3305 ! Antiferro case ? 3306 antiferro=.false.;if (nrhoij>0) antiferro=(pawrhoij(1)%nspden==2.and.pawrhoij(1)%nsppol==1) 3307 ! Non-collinear case 3308 noncoll=.false.;if (nrhoij>0) noncoll=(pawrhoij(1)%nspden==4) 3309 ! Do we use antiferro symmetries ? 3310 use_afm=((antiferro).or.(noncoll.and.afm_noncoll)) 3311 3312 cplex_eff=1 3313 if (nrhoij>0.and.(ipert>0.or.antiferro.or.noncoll)) cplex_eff=pawrhoij(1)%cplex ! Does not symmetrize imaginary part for GS calculations 3314 3315 ! Do we have a phase due to q-vector (phonons only) ? 3316 have_phase=.false. 3317 if (ipert>0.and.present(qphon).and.nrhoij>0) then 3318 have_phase=(abs(qphon(1))>tol8.or.abs(qphon(2))>tol8.or.abs(qphon(3))>tol8) 3319 if (choice>1) then 3320 msg='choice>1 not compatible with q-phase !' 3321 MSG_BUG(msg) 3322 end if 3323 if (have_phase.and.cplex_eff==1) then 3324 msg='Should have cplex_dij=2 for a non-zero q!' 3325 MSG_BUG(msg) 3326 end if 3327 end if 3328 3329 ! Several inits/allocations 3330 if (noncoll.and.optrhoij==1) then 3331 LIBPAW_ALLOCATE(summag,(cplex_eff,3)) 3332 LIBPAW_ALLOCATE(rotmag,(cplex_eff,3)) 3333 end if 3334 if (noncoll) then 3335 LIBPAW_ALLOCATE(symrec_cart,(3,3,nsym)) 3336 do irot=1,nsym 3337 symrec_cart(:,:,irot)=symrhoij_symcart(gprimd,rprimd,symrec(:,:,irot)) 3338 end do 3339 end if 3340 ishift2=0;ishift3=0;ishift4=0 3341 if (choice>1) then 3342 LIBPAW_ALLOCATE(sumgr,(cplex_eff,ngrhoij)) 3343 if (choice>2) then 3344 LIBPAW_ALLOCATE(work1,(cplex_eff,3,3)) 3345 end if 3346 if (antiferro) then 3347 LIBPAW_ALLOCATE(rotgr,(cplex_eff,ngrhoij,2)) 3348 else 3349 LIBPAW_ALLOCATE(rotgr,(cplex_eff,ngrhoij,1)) 3350 end if 3351 if (noncoll) then 3352 LIBPAW_ALLOCATE(summaggr,(cplex_eff,ngrhoij,3)) 3353 LIBPAW_ALLOCATE(rotmaggr,(cplex_eff,ngrhoij,3)) 3354 end if 3355 if (choice==23) ishift2=6 3356 if (choice==24) ishift4=3 3357 if (.not.paral_atom_unsym) then 3358 ! Have to make a temporary copy of grhoij 3359 LIBPAW_DATATYPE_ALLOCATE(tmp_grhoij,(nrhoij)) 3360 do iatm=1,nrhoij 3361 sz1=pawrhoij_unsym(iatm)%cplex*pawrhoij_unsym(iatm)%lmn2_size 3362 sz2=pawrhoij_unsym(iatm)%nspden 3363 LIBPAW_ALLOCATE(tmp_grhoij(iatm)%value,(ngrhoij,sz1,sz2)) 3364 tmp_grhoij(iatm)%value(1:ngrhoij,1:sz1,1:sz2)=pawrhoij_unsym(iatm)%grhoij(1:ngrhoij,1:sz1,1:sz2) 3365 end do 3366 end if 3367 end if 3368 3369 ! In case of paw_rhoij_unsym distributed over atomic sites, gather it 3370 if (paral_atom_unsym) then 3371 LIBPAW_DATATYPE_ALLOCATE(pawrhoij_unsym_all,(natom)) 3372 call pawrhoij_nullify(pawrhoij_unsym_all) 3373 call pawrhoij_gather(pawrhoij_unsym,pawrhoij_unsym_all,-1,my_comm_atom,& 3374 & with_lmnmix=.false.,with_rhoijp=.false.,& 3375 & with_rhoijres=.false.,with_rhoijim=.false.,with_grhoij=(choice>1)) 3376 nrhoij1=natom 3377 else 3378 pawrhoij_unsym_all=>pawrhoij_unsym 3379 nrhoij1=nrhoij_unsym 3380 end if 3381 3382 ! Loops over atoms and spin components 3383 ! ------------------------------------ 3384 do iatm=1,nrhoij 3385 iatom=iatm;if (paral_atom) iatom=my_atmtab(iatm) 3386 if (nrhoij==1.and.ipert>0.and.ipert<=natom.and.(.not.paral_atom)) iatom=ipert 3387 itypat=typat(iatom) 3388 lmn_size=pawrhoij(iatm)%lmn_size 3389 nspinor=pawrhoij(iatm)%nspinor 3390 cplex=pawrhoij(iatm)%cplex 3391 cplex_eff=1;if (ipert>0.or.antiferro.or.noncoll) cplex_eff=cplex 3392 use_res=(pawrhoij(iatm)%use_rhoijres>0) 3393 indlmn => pawtab(itypat)%indlmn 3394 3395 nselect=0 3396 do ispden=1,pawrhoij(iatm)%nsppol 3397 jspden=min(3-ispden,pawrhoij(iatm)%nsppol) 3398 3399 ! Store old -rhoij in residual 3400 if (optrhoij==1.and.use_res) then 3401 pawrhoij(iatm)%rhoijres(:,ispden)=zero 3402 if (cplex==1) then 3403 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3404 klmn=pawrhoij(iatm)%rhoijselect(irhoij) 3405 pawrhoij(iatm)%rhoijres(klmn,ispden)=-pawrhoij(iatm)%rhoijp(irhoij,ispden) 3406 end do 3407 else 3408 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3409 klmn1=2*pawrhoij(iatm)%rhoijselect(irhoij);jrhoij=2*irhoij 3410 pawrhoij(iatm)%rhoijres(klmn1-1:klmn1,ispden)=-pawrhoij(iatm)%rhoijp(jrhoij-1:jrhoij,ispden) 3411 end do 3412 end if 3413 if (noncoll) then 3414 pawrhoij(iatm)%rhoijres(:,2:4)=zero 3415 if (cplex==1) then 3416 do mu=2,4 3417 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3418 klmn=pawrhoij(iatm)%rhoijselect(irhoij) 3419 pawrhoij(iatm)%rhoijres(klmn,mu)=-pawrhoij(iatm)%rhoijp(irhoij,mu) 3420 end do 3421 end do 3422 else 3423 do mu=2,4 3424 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3425 klmn1=2*pawrhoij(iatm)%rhoijselect(irhoij);jrhoij=2*irhoij 3426 pawrhoij(iatm)%rhoijres(klmn1-1:klmn1,mu)=-pawrhoij(iatm)%rhoijp(jrhoij-1:jrhoij,mu) 3427 end do 3428 end do 3429 end if 3430 end if 3431 if (antiferro) then 3432 pawrhoij(iatm)%rhoijres(:,2)=zero 3433 if (cplex==1) then 3434 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3435 klmn=pawrhoij(iatm)%rhoijselect(irhoij) 3436 pawrhoij(iatm)%rhoijres(klmn,2)=-pawrhoij(iatm)%rhoijp(irhoij,2) 3437 end do 3438 else 3439 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3440 klmn1=2*pawrhoij(iatm)%rhoijselect(irhoij);jrhoij=2*irhoij 3441 pawrhoij(iatm)%rhoijres(klmn1-1:klmn1,2)=-pawrhoij(iatm)%rhoijp(jrhoij-1:jrhoij,2) 3442 end do 3443 end if 3444 end if 3445 end if 3446 3447 ! Loops over (il,im) and (jl,jm) 3448 ! ------------------------------ 3449 jl0=-1;jln0=-1;indexj=1 3450 do jlmn=1,lmn_size 3451 jl=indlmn(1,jlmn) 3452 jlpm=1+jl+indlmn(2,jlmn) 3453 jln=indlmn(5,jlmn) 3454 if (jln/=jln0) indexj=indexj+2*jl0+1 3455 j0lmn=jlmn*(jlmn-1)/2 3456 il0=-1;iln0=-1;indexi=1 3457 do ilmn=1,jlmn 3458 il=indlmn(1,ilmn) 3459 ilpm=1+il+indlmn(2,ilmn) 3460 iln=indlmn(5,ilmn) 3461 if (iln/=iln0) indexi=indexi+2*il0+1 3462 klmn=j0lmn+ilmn;klmn1=cplex*klmn 3463 3464 nsym_used(:)=0 3465 if (optrhoij==1) rotrho(:,:)=zero 3466 if (optrhoij==1.and.noncoll) rotmag(:,:)=zero 3467 if (choice>1) rotgr(:,:,:)=zero 3468 if (choice>1.and.noncoll) rotmaggr(:,:,:)=zero 3469 3470 ! Loop over symmetries 3471 ! -------------------- 3472 do irot=1,nsym 3473 3474 if ((symafm(irot)/=1).and.(.not.use_afm)) cycle 3475 kspden=ispden;if (symafm(irot)==-1) kspden=jspden 3476 iafm=1;if ((antiferro).and.(symafm(irot)==-1)) iafm=2 3477 factafm=dble(symafm(irot)) 3478 3479 nsym_used(iafm)=nsym_used(iafm)+1 3480 at_indx=min(indsym(4,irot,iatom),nrhoij1) 3481 3482 if (have_phase) then 3483 arg=two_pi*(qphon(1)*indsym(1,irot,iatom)+qphon(2)*indsym(2,irot,iatom) & 3484 & +qphon(3)*indsym(3,irot,iatom)) 3485 phase(1)=cos(arg);phase(2)=sin(arg) 3486 end if 3487 3488 ! Accumulate values over (mi,mj) 3489 ! ------------------------------ 3490 if (optrhoij==1) sumrho(:,:)=zero 3491 if (optrhoij==1.and.noncoll) summag(:,:)=zero 3492 if (choice>1) sumgr(:,:)=zero 3493 if (choice>1.and.noncoll) summaggr(:,:,:)=zero 3494 do mj=1,2*jl+1 3495 indexjj=indexj+mj;indexjj0=indexjj*(indexjj-1)/2 3496 do mi=1,2*il+1 3497 factsym(:)=one 3498 indexii=indexi+mi 3499 if (indexii<=indexjj) then 3500 indexk=indexjj0+indexii 3501 if(cplex_eff==2.and.nspinor==2) factsym(2)=one 3502 else 3503 indexk=indexii*(indexii-1)/2+indexjj 3504 if(cplex_eff==2.and.nspinor==2) factsym(2)=-one 3505 end if 3506 ! Be careful: use here R_rel^-1 in term of spherical harmonics 3507 ! which is tR_rec in term of spherical harmonics 3508 ! so, use transpose[zarot] 3509 zarot2=pawang%zarot(mi,ilpm,il+1,irot)*pawang%zarot(mj,jlpm,jl+1,irot) 3510 ! zarot2=pawang%zarot(ilpm,mi,il+1,irot)*pawang%zarot(jlpm,mj,jl+1,irot) 3511 3512 ! Rotate rhoij 3513 if (optrhoij==1) then 3514 if (cplex==1) then 3515 sumrho(1,iafm)=sumrho(1,iafm)+zarot2*pawrhoij_unsym_all(at_indx)%rhoij_(indexk,kspden) 3516 else 3517 indexk1=2*(indexk-1) 3518 sumrho(1,iafm)=sumrho(1,iafm)+factsym(1)*zarot2*pawrhoij_unsym_all(at_indx)%rhoij_(indexk1+1,kspden) 3519 if(cplex_eff==2) sumrho(2,iafm)= & 3520 & sumrho(2,iafm)+factsym(2)*factafm*zarot2*pawrhoij_unsym_all(at_indx)%rhoij_(indexk1+2,kspden) 3521 end if 3522 end if 3523 3524 ! If non-collinear case, rotate rhoij magnetization 3525 if (optrhoij==1.and.noncoll) then 3526 if (cplex==1) then 3527 do mu=1,3 3528 summag(1,mu)=summag(1,mu)+zarot2*factafm*pawrhoij_unsym_all(at_indx)%rhoij_(indexk,1+mu) 3529 end do 3530 else 3531 indexk1=2*(indexk-1) 3532 do mu=1,3 3533 summag(1,mu)=summag(1,mu) & 3534 & +zarot2*factsym(1)*factafm*pawrhoij_unsym_all(at_indx)%rhoij_(indexk1+1,1+mu) 3535 if(cplex_eff==2) summag(2,mu)=summag(2,mu)& 3536 & +zarot2*factsym(2)*pawrhoij_unsym_all(at_indx)%rhoij_(indexk1+2,1+mu) 3537 end do 3538 end if 3539 end if 3540 3541 ! Rotate gradients of rhoij 3542 if (choice>1) then 3543 if (paral_atom_unsym) then 3544 grad => pawrhoij_unsym_all(at_indx)%grhoij 3545 else 3546 grad => tmp_grhoij(at_indx)%value 3547 end if 3548 if (cplex==1) then 3549 do mu=1,ngrhoij 3550 sumgr(1,mu)=sumgr(1,mu)+zarot2*grad(mu,indexk,kspden) 3551 end do 3552 if (noncoll) then 3553 do mu=1,3 3554 do nu=1,ngrhoij 3555 summaggr(1,nu,mu)=summaggr(1,nu,mu)+zarot2*factafm*grad(nu,indexk,1+mu) 3556 end do 3557 end do 3558 end if 3559 else 3560 indexk1=2*(indexk-1) 3561 do mu=1,ngrhoij 3562 sumgr(1:cplex_eff,mu)=sumgr(1:cplex_eff,mu) & 3563 & +zarot2*factsym(1:cplex_eff)*grad(mu,indexk1+1:indexk1+cplex_eff,kspden) 3564 end do 3565 if (noncoll) then 3566 do mu=1,3 3567 do nu=1,ngrhoij 3568 summaggr(1:cplex_eff,nu,mu)=summaggr(1:cplex_eff,nu,mu) & 3569 & +zarot2*factsym(1:cplex_eff)*factafm*grad(nu,indexk1+1:indexk1+cplex_eff,1+mu) 3570 end do 3571 end do 3572 end if 3573 end if 3574 end if 3575 3576 end do 3577 end do 3578 3579 ! Apply phase for phonons 3580 if (have_phase) then 3581 if(optrhoij==1) then 3582 rhoijc(1:2)=sumrho(1:2,iafm) 3583 sumrho(1,iafm)=phase(1)*rhoijc(1)-phase(2)*rhoijc(2) 3584 sumrho(2,iafm)=phase(1)*rhoijc(2)+phase(2)*rhoijc(1) 3585 end if 3586 if (noncoll) then 3587 do mu=1,3 3588 rhoijc(1:2)=summag(1:2,mu) 3589 summag(1,mu)=phase(1)*rhoijc(1)-phase(2)*rhoijc(2) 3590 summag(2,mu)=phase(1)*rhoijc(2)+phase(2)*rhoijc(1) 3591 end do 3592 end if 3593 if (choice>1) then 3594 do mu=1,ngrhoij 3595 rhoijc(1:2)=sumgr(1:2,mu) 3596 sumgr(1,mu)=phase(1)*rhoijc(1)-phase(2)*rhoijc(2) 3597 sumgr(2,mu)=phase(1)*rhoijc(2)+phase(2)*rhoijc(1) 3598 end do 3599 if (noncoll) then 3600 do mu=1,3 3601 do nu=1,ngrhoij 3602 rhoijc(1:2)=summaggr(1:2,nu,mu) 3603 summaggr(1,nu,mu)=phase(1)*rhoijc(1)-phase(2)*rhoijc(2) 3604 summaggr(2,nu,mu)=phase(1)*rhoijc(2)+phase(2)*rhoijc(1) 3605 end do 3606 end do 3607 end if 3608 end if 3609 end if 3610 3611 ! Add contribution of this rotation 3612 if (optrhoij==1) then 3613 rotrho(1:cplex_eff,iafm)=rotrho(1:cplex_eff,iafm)+sumrho(1:cplex_eff,iafm) 3614 end if 3615 3616 ! Rotate vector fields in real space (forces, magnetization, etc...) 3617 ! Should use symrel^-1 but use transpose[symrec] instead 3618 ! --------------------------------- 3619 ! ===== Rhoij magnetization ==== 3620 if (noncoll.and.optrhoij==1) then 3621 do nu=1,3 3622 do mu=1,3 3623 rotmag(1:cplex_eff,mu)=rotmag(1:cplex_eff,mu)+symrec_cart(mu,nu,irot)*summag(1:cplex_eff,nu) 3624 end do 3625 end do 3626 end if 3627 ! ===== Derivatives vs atomic positions ==== 3628 if (choice==2.or.choice==23.or.choice==24) then 3629 do nu=1,3 3630 nushift=nu+ishift2 3631 do mu=1,3 3632 mushift=mu+ishift2 3633 rotgr(1:cplex_eff,mushift,iafm)=& 3634 & rotgr(1:cplex_eff,mushift,iafm)+dble(symrec(mu,nu,irot))*sumgr(1:cplex_eff,nushift) 3635 end do 3636 end do 3637 if (noncoll) then 3638 do mub=1,3 ! Loop on magnetization components 3639 do mua=1,3 ! Loop on gradients 3640 mushift=mua+ishift2 3641 sum1(:)=zero;xsym(1:3)=dble(symrec(mua,1:3,irot)) 3642 do nu=1,3 3643 syma=symrec_cart(mub,nu,irot) 3644 sum1(1:cplex_eff)=sum1(1:cplex_eff)+syma*(summaggr(1:cplex_eff,ishift2+1,nu)*xsym(1) & 3645 & +summaggr(1:cplex_eff,ishift2+2,nu)*xsym(2) & 3646 & +summaggr(1:cplex_eff,ishift2+3,nu)*xsym(3)) 3647 end do 3648 rotmaggr(1:cplex_eff,mushift,mub)=rotmaggr(1:cplex_eff,mushift,mub)+sum1(1:cplex_eff) 3649 end do 3650 end do 3651 end if 3652 end if 3653 ! ===== Derivatives vs strain ==== 3654 if (choice==3.or.choice==23) then 3655 work1(1:cplex_eff,1,1)=sumgr(1:cplex_eff,1+ishift3);work1(1:cplex_eff,2,2)=sumgr(1:cplex_eff,2+ishift3) 3656 work1(1:cplex_eff,3,3)=sumgr(1:cplex_eff,3+ishift3);work1(1:cplex_eff,2,3)=sumgr(1:cplex_eff,4+ishift3) 3657 work1(1:cplex_eff,1,3)=sumgr(1:cplex_eff,5+ishift3);work1(1:cplex_eff,1,2)=sumgr(1:cplex_eff,6+ishift3) 3658 work1(1:cplex_eff,3,1)=work1(1:cplex_eff,1,3);work1(1:cplex_eff,3,2)=work1(1:cplex_eff,2,3) 3659 work1(1:cplex_eff,2,1)=work1(1:cplex_eff,1,2) 3660 do mu=1,6 3661 mushift=mu+ishift3 3662 mua=alpha(mu);mub=beta(mu) 3663 sum1(:)=zero;xsym(1:3)=dble(symrec(mub,1:3,irot)) 3664 do nu=1,3 3665 syma=dble(symrec(mua,nu,irot)) 3666 sum1(1:cplex_eff)=sum1(1:cplex_eff)+syma*(work1(1:cplex_eff,nu,1)*xsym(1) & 3667 & +work1(1:cplex_eff,nu,2)*xsym(2) & 3668 & +work1(1:cplex_eff,nu,3)*xsym(3)) 3669 end do 3670 rotgr(1:cplex_eff,mushift,iafm)=rotgr(1:cplex_eff,mushift,iafm)+sum1(1:cplex_eff) 3671 end do 3672 end if 3673 ! ===== Second derivatives vs atomic positions ==== 3674 if (choice==4.or.choice==24) then 3675 work1(1:cplex_eff,1,1)=sumgr(1:cplex_eff,1+ishift4);work1(1:cplex_eff,2,2)=sumgr(1:cplex_eff,2+ishift4) 3676 work1(1:cplex_eff,3,3)=sumgr(1:cplex_eff,3+ishift4);work1(1:cplex_eff,2,3)=sumgr(1:cplex_eff,4+ishift4) 3677 work1(1:cplex_eff,1,3)=sumgr(1:cplex_eff,5+ishift4);work1(1:cplex_eff,1,2)=sumgr(1:cplex_eff,6+ishift4) 3678 work1(1:cplex_eff,3,1)=work1(1:cplex_eff,1,3);work1(1:cplex_eff,3,2)=work1(1:cplex_eff,2,3) 3679 work1(1:cplex_eff,2,1)=work1(1:cplex_eff,1,2) 3680 do mu=1,6 3681 mushift=mu+ishift4 3682 mua=alpha(mu);mub=beta(mu) 3683 sum1(:)=zero 3684 xsym(1:3)=dble(symrec(mub,1:3,irot)) 3685 do nu=1,3 3686 syma=dble(symrec(mua,nu,irot)) 3687 sum1(1:cplex_eff)=sum1(1:cplex_eff)+syma*(work1(1:cplex_eff,nu,1)*xsym(1) & 3688 & +work1(1:cplex_eff,nu,2)*xsym(2) & 3689 & +work1(1:cplex_eff,nu,3)*xsym(3)) 3690 end do 3691 rotgr(1:cplex_eff,mushift,iafm)=rotgr(1:cplex_eff,mushift,iafm)+sum1(1:cplex_eff) 3692 end do 3693 end if 3694 3695 end do ! End loop over symmetries 3696 3697 ! Store average result (over symmetries) 3698 ! -------------------------------------- 3699 if (optrhoij==1) then 3700 3701 ! Mean value for rhoij 3702 if (cplex==1) then 3703 ro(1)=rotrho(1,1)/nsym_used(1) 3704 if (abs(ro(1))>tol10) then 3705 pawrhoij(iatm)%rhoijp(klmn,ispden)=ro(1) 3706 if (use_res) pawrhoij(iatm)%rhoijres(klmn,ispden)=pawrhoij(iatm)%rhoijres(klmn,ispden)+ro(1) 3707 else 3708 pawrhoij(iatm)%rhoijp(klmn,ispden)=zero 3709 end if 3710 else 3711 ro(1)=rotrho(1,1)/nsym_used(1) 3712 if (cplex_eff==2) then 3713 ro(2)=rotrho(2,1)/nsym_used(1) 3714 else 3715 ro(2)=pawrhoij_unsym_all(iatom)%rhoij_(klmn1,ispden) 3716 end if 3717 if (any(abs(ro(1:2))>tol10)) then 3718 pawrhoij(iatm)%rhoijp(klmn1-1,ispden)=ro(1) 3719 pawrhoij(iatm)%rhoijp(klmn1 ,ispden)=ro(2) 3720 if (use_res) then 3721 pawrhoij(iatm)%rhoijres(klmn1-1,ispden)=pawrhoij(iatm)%rhoijres(klmn1-1,ispden)+ro(1) 3722 pawrhoij(iatm)%rhoijres(klmn1 ,ispden)=pawrhoij(iatm)%rhoijres(klmn1 ,ispden)+ro(2) 3723 end if 3724 else 3725 pawrhoij(iatm)%rhoijp(klmn1-1,ispden)=zero 3726 pawrhoij(iatm)%rhoijp(klmn1 ,ispden)=zero 3727 end if 3728 end if 3729 3730 ! Non-collinear case: mean value for rhoij magnetization 3731 if (noncoll) then 3732 ! Select on-zero elements 3733 if (cplex==1) then 3734 do mu=2,4 3735 ro(1)=rotmag(1,mu-1)/nsym_used(1) 3736 if (abs(ro(1))>tol10) then 3737 pawrhoij(iatm)%rhoijp(klmn,mu)=ro(1) 3738 if (use_res) pawrhoij(iatm)%rhoijres(klmn,mu)=pawrhoij(iatm)%rhoijres(klmn,mu)+ro(1) 3739 else 3740 pawrhoij(iatm)%rhoijp(klmn,mu)=zero 3741 end if 3742 end do 3743 else 3744 do mu=2,4 3745 ro(1)=rotmag(1,mu-1)/nsym_used(1) 3746 if (cplex_eff==2) then 3747 ro(2)=rotmag(2,mu-1)/nsym_used(1) 3748 else 3749 ro(2)=pawrhoij_unsym_all(iatom)%rhoij_(klmn1,mu) 3750 end if 3751 if (any(abs(ro(1:2))>tol10)) then 3752 pawrhoij(iatm)%rhoijp(klmn1-1,mu)=ro(1) 3753 pawrhoij(iatm)%rhoijp(klmn1 ,mu)=ro(2) 3754 if (use_res) then 3755 pawrhoij(iatm)%rhoijres(klmn1-1,mu)=pawrhoij(iatm)%rhoijres(klmn1-1,mu)+ro(1) 3756 pawrhoij(iatm)%rhoijres(klmn1 ,mu)=pawrhoij(iatm)%rhoijres(klmn1 ,mu)+ro(2) 3757 end if 3758 else 3759 pawrhoij(iatm)%rhoijp(klmn1-1,mu)=zero 3760 pawrhoij(iatm)%rhoijp(klmn1 ,mu)=zero 3761 end if 3762 end do 3763 end if 3764 end if 3765 3766 ! Antiferro case: mean value for down component 3767 if (antiferro.and.nsym_used(2)>0) then 3768 if (cplex==1) then 3769 ro(1)=rotrho(1,2)/nsym_used(2) 3770 if (abs(ro(1))>tol10) then 3771 pawrhoij(iatm)%rhoijp(klmn,2)=ro(1) 3772 if (use_res) pawrhoij(iatm)%rhoijres(klmn,2)=pawrhoij(iatm)%rhoijres(klmn,2)+ro(1) 3773 else 3774 pawrhoij(iatm)%rhoijp(klmn,2)=zero 3775 end if 3776 else 3777 ro(1:cplex_eff)=rotrho(1:cplex_eff,2)/nsym_used(2) 3778 if (any(abs(ro(1:2))>tol10)) then 3779 pawrhoij(iatm)%rhoijp(klmn1-1,2)=ro(1) 3780 pawrhoij(iatm)%rhoijp(klmn1 ,2)=ro(2) 3781 if (use_res) then 3782 pawrhoij(iatm)%rhoijres(klmn1-1,2)=pawrhoij(iatm)%rhoijres(klmn1-1,2)+ro(1) 3783 pawrhoij(iatm)%rhoijres(klmn1 ,2)=pawrhoij(iatm)%rhoijres(klmn1 ,2)+ro(2) 3784 end if 3785 else 3786 pawrhoij(iatm)%rhoijp(klmn1-1,2)=zero 3787 pawrhoij(iatm)%rhoijp(klmn1 ,2)=zero 3788 end if 3789 end if 3790 end if 3791 3792 ! Select non-zero elements of rhoij 3793 if (ispden==pawrhoij(iatm)%nsppol) then 3794 if (cplex==1) then 3795 if (any(abs(pawrhoij(iatm)%rhoijp(klmn,:))>tol10)) then 3796 nselect=nselect+1 3797 pawrhoij(iatm)%rhoijselect(nselect)=klmn 3798 do jj=1,pawrhoij(iatm)%nspden 3799 pawrhoij(iatm)%rhoijp(nselect,jj)=pawrhoij(iatm)%rhoijp(klmn,jj) 3800 end do 3801 end if 3802 else 3803 if (any(abs(pawrhoij(iatm)%rhoijp(klmn1-1:klmn1,:))>tol10)) then 3804 nselect=nselect+1;nselect1=2*nselect 3805 pawrhoij(iatm)%rhoijselect(nselect)=klmn 3806 do jj=1,pawrhoij(iatm)%nspden 3807 pawrhoij(iatm)%rhoijp(nselect1-1,jj)=pawrhoij(iatm)%rhoijp(klmn1-1,jj) 3808 pawrhoij(iatm)%rhoijp(nselect1 ,jj)=pawrhoij(iatm)%rhoijp(klmn1 ,jj) 3809 end do 3810 else if (pawrhoij(iatm)%use_rhoijim/=0) then ! for saving values of klmn which have non-zero rhoijim 3811 if (any(abs(pawrhoij(iatm)%rhoijim(klmn1,:))>tol10)) then 3812 nselect=nselect+1;nselect1=2*nselect 3813 pawrhoij(iatm)%rhoijselect(nselect)=klmn 3814 do jj=1,pawrhoij(iatm)%nspden 3815 pawrhoij(iatm)%rhoijp(nselect1-1,jj)=pawrhoij(iatm)%rhoijp(klmn1-1,jj) 3816 pawrhoij(iatm)%rhoijp(nselect1 ,jj)=pawrhoij(iatm)%rhoijp(klmn1 ,jj) 3817 end do 3818 end if 3819 end if 3820 end if 3821 end if 3822 3823 end if ! optrhoij==1 3824 3825 ! Store average result (over symmetries) for gradients 3826 if (choice>1) then 3827 do iplex=1,cplex_eff 3828 do mu=1,ngrhoij 3829 pawrhoij(iatm)%grhoij(mu,klmn1+iplex-cplex,ispden)=rotgr(iplex,mu,1)/nsym_used(1) 3830 end do 3831 end do 3832 if (antiferro.and.nsym_used(2)>0) then 3833 do iplex=1,cplex_eff 3834 do mu=1,ngrhoij 3835 pawrhoij(iatm)%grhoij(mu,klmn1+iplex-cplex,2)=rotgr(iplex,mu,2)/nsym_used(2) 3836 end do 3837 end do 3838 end if 3839 if (noncoll) then 3840 do nu=1,3 3841 do iplex=1,cplex_eff 3842 do mu=1,ngrhoij 3843 pawrhoij(iatm)%grhoij(mu,klmn1+iplex-cplex,1+nu)=rotmaggr(iplex,mu,nu)/nsym_used(1) 3844 end do 3845 end do 3846 end do 3847 end if 3848 end if 3849 3850 il0=il;iln0=iln ! End loops over (il,im) and (jl,jm) 3851 end do 3852 jl0=jl;jln0=jln 3853 end do 3854 3855 end do ! End loop over ispden 3856 3857 ! Store number of non-zero values of rhoij 3858 if (optrhoij==1) pawrhoij(iatm)%nrhoijsel=nselect 3859 3860 end do ! End loop over iatm 3861 3862 if (noncoll.and.optrhoij==1) then 3863 LIBPAW_DEALLOCATE(summag) 3864 LIBPAW_DEALLOCATE(rotmag) 3865 end if 3866 if (noncoll) then 3867 LIBPAW_DEALLOCATE(symrec_cart) 3868 end if 3869 if (choice>1) then 3870 if (.not.paral_atom_unsym) then 3871 do iatm=1,nrhoij 3872 LIBPAW_DEALLOCATE(tmp_grhoij(iatm)%value) 3873 end do 3874 LIBPAW_DATATYPE_DEALLOCATE(tmp_grhoij) 3875 end if 3876 LIBPAW_DEALLOCATE(sumgr) 3877 LIBPAW_DEALLOCATE(rotgr) 3878 if (choice>2) then 3879 LIBPAW_DEALLOCATE(work1) 3880 end if 3881 if (noncoll) then 3882 LIBPAW_DEALLOCATE(summaggr) 3883 LIBPAW_DEALLOCATE(rotmaggr) 3884 end if 3885 end if 3886 if(paral_atom_unsym) then 3887 call pawrhoij_free(pawrhoij_unsym_all) 3888 LIBPAW_DATATYPE_DEALLOCATE(pawrhoij_unsym_all) 3889 end if 3890 3891 3892 else ! nsym>1 3893 3894 ! ********************************************************************* 3895 ! If nsym==1, only copy rhoij_ into rhoij 3896 ! also has to fill rhoijselect array 3897 3898 if (nrhoij>0) then 3899 if(pawrhoij(1)%nspden==2.and.pawrhoij(1)%nsppol==1) then 3900 msg=' In the antiferromagnetic case, nsym cannot be 1' 3901 MSG_BUG(msg) 3902 end if 3903 end if 3904 if (optrhoij==1) then 3905 do iatm=1,nrhoij 3906 iatom=iatm;if ((paral_atom).and.(.not.paral_atom_unsym)) iatom=my_atmtab(iatm) 3907 cplex=pawrhoij(iatm)%cplex 3908 use_res=(pawrhoij(iatm)%use_rhoijres>0) 3909 if (use_res) then 3910 pawrhoij(iatm)%rhoijres(:,:)=zero 3911 if (cplex==1) then 3912 do ispden=1,pawrhoij(iatm)%nspden 3913 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3914 klmn=pawrhoij(iatm)%rhoijselect(irhoij) 3915 pawrhoij(iatm)%rhoijres(klmn,ispden)=-pawrhoij(iatm)%rhoijp(irhoij,ispden) 3916 end do 3917 end do 3918 else 3919 do ispden=1,pawrhoij(iatm)%nspden 3920 do irhoij=1,pawrhoij(iatm)%nrhoijsel 3921 klmn1=2*pawrhoij(iatm)%rhoijselect(irhoij);jrhoij=2*irhoij 3922 pawrhoij(iatm)%rhoijres(klmn1-1,ispden)=-pawrhoij(iatm)%rhoijp(jrhoij-1,ispden) 3923 pawrhoij(iatm)%rhoijres(klmn1 ,ispden)=-pawrhoij(iatm)%rhoijp(jrhoij ,ispden) 3924 end do 3925 end do 3926 end if 3927 end if 3928 nselect=0 3929 if (cplex==1) then 3930 do klmn=1,pawrhoij(iatm)%lmn2_size 3931 if (any(abs(pawrhoij_unsym(iatom)%rhoij_(klmn,:))>tol10)) then 3932 nselect=nselect+1 3933 pawrhoij(iatm)%rhoijselect(nselect)=klmn 3934 do jj=1,pawrhoij(iatm)%nspden 3935 ro(1)=pawrhoij_unsym(iatom)%rhoij_(klmn,jj) 3936 pawrhoij(iatm)%rhoijp(nselect,jj)=ro(1) 3937 if (use_res) pawrhoij(iatm)%rhoijres(klmn,jj)=pawrhoij(iatm)%rhoijres(klmn,jj)+ro(1) 3938 end do 3939 end if 3940 end do 3941 else 3942 do klmn=1,pawrhoij(iatm)%lmn2_size 3943 klmn1=2*klmn 3944 if (any(abs(pawrhoij_unsym(iatom)%rhoij_(klmn1-1:klmn1,:))>tol10)) then 3945 nselect=nselect+1;nselect1=2*nselect 3946 pawrhoij(iatm)%rhoijselect(nselect)=klmn 3947 do jj=1,pawrhoij(iatm)%nspden 3948 ro(1)=pawrhoij_unsym(iatom)%rhoij_(klmn1-1,jj) 3949 ro(2)=pawrhoij_unsym(iatom)%rhoij_(klmn1 ,jj) 3950 pawrhoij(iatm)%rhoijp(nselect1-1,jj)=ro(1) 3951 pawrhoij(iatm)%rhoijp(nselect1 ,jj)=ro(2) 3952 if (use_res) then 3953 pawrhoij(iatm)%rhoijres(klmn1-1,jj)=pawrhoij(iatm)%rhoijres(klmn1-1,jj)+ro(1) 3954 pawrhoij(iatm)%rhoijres(klmn1 ,jj)=pawrhoij(iatm)%rhoijres(klmn1 ,jj)+ro(2) 3955 end if 3956 end do 3957 end if 3958 end do 3959 end if 3960 pawrhoij(iatm)%nrhoijsel=nselect 3961 end do 3962 end if 3963 3964 end if 3965 3966 !********************************************************************* 3967 !Printing of Rhoij 3968 if (optrhoij==1.and.pawprtvol/=-10001) then 3969 wrt_mode='COLL';if (paral_atom) wrt_mode='PERS' 3970 pertstrg="RHOIJ";if (ipert>0) pertstrg="RHOIJ(1)" 3971 natinc=1;if(nrhoij>1.and.pawprtvol>=0) natinc=nrhoij-1 3972 do iatm=1,nrhoij,natinc 3973 iatom=iatm;if (paral_atom) iatom=my_atmtab(iatm) 3974 if (nrhoij==1.and.ipert>0.and.ipert<=natom) iatom=ipert 3975 idum1=2;if (pawrhoij(iatm)%cplex==2.and.pawrhoij(iatm)%nspinor==1) idum1=1 3976 if (abs(pawprtvol)>=1) then 3977 write(msg, '(6a,i3,a)') ch10," PAW TEST:",ch10,& 3978 & ' ====== Values of ',trim(pertstrg),' in symrhoij (iatom=',iatom,') ======' 3979 call wrtout(std_out,msg,wrt_mode) 3980 end if 3981 do ispden=1,pawrhoij(iatm)%nspden 3982 if (abs(pawprtvol)>=1.and.pawrhoij(iatm)%nspden/=1) then 3983 write(msg, '(3a)') ' Component ',trim(dspin(ispden+2*(pawrhoij(iatm)%nspden/4))),':' 3984 else if (pawrhoij(iatm)%nspden/=1) then 3985 if (pawrhoij(iatm)%nspden/=4) write(msg, '(4a,i3,a,i1,a)') ch10,& 3986 & ' *********** ',trim(pertstrg),' (atom ',iatom,', ispden=',ispden,') **********' 3987 if (pawrhoij(iatm)%nspden==4) write(msg, '(4a,i3,3a)') ch10,& 3988 & ' *********** ',trim(pertstrg),' (atom ',iatom,' - ',& 3989 & trim(dspin(ispden+2*(pawrhoij(iatm)%nspden/4))),') **********' 3990 else 3991 write(msg, '(4a,i3,a)') ch10,& 3992 & ' *********** ',trim(pertstrg),' (atom ',iatom,') **********' 3993 end if 3994 call wrtout(std_out,msg,wrt_mode) 3995 call pawio_print_ij(std_out,pawrhoij(iatm)%rhoijp(:,ispden),& 3996 & pawrhoij(iatm)%nrhoijsel,& 3997 & pawrhoij(iatm)%cplex,& 3998 & pawrhoij(iatm)%lmn_size,-1,idum,1,pawprtvol,& 3999 & pawrhoij(iatm)%rhoijselect(:),& 4000 & 10.d0*dble(3-2*(ispden+ipert)),1,& 4001 & opt_sym=idum1,mode_paral=wrt_mode) 4002 end do 4003 end do 4004 msg='' 4005 call wrtout(std_out,msg,wrt_mode) 4006 end if 4007 4008 !Destroy atom table used for parallelism 4009 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 4010 4011 !********************************************************************* 4012 !Small function: convert a symmetry operation 4013 !from reduced coordinates (integers) to cartesian coordinates (reals) 4014 contains 4015 function symrhoij_symcart(aprim,bprim,symred) 4016 4017 4018 !This section has been created automatically by the script Abilint (TD). 4019 !Do not modify the following lines by hand. 4020 #undef ABI_FUNC 4021 #define ABI_FUNC 'symrhoij_symcart' 4022 !End of the abilint section 4023 4024 implicit none 4025 real(dp) :: symrhoij_symcart(3,3) 4026 integer,intent(in) :: symred(3,3) 4027 real(dp),intent(in) :: aprim(3,3),bprim(3,3) 4028 integer :: ii,jj,kk 4029 real(dp) :: tmp(3,3) 4030 symrhoij_symcart=zero;tmp=zero 4031 do kk=1,3 4032 do jj=1,3 4033 do ii=1,3 4034 tmp(ii,jj)=tmp(ii,jj)+bprim(ii,kk)*dble(symred(jj,kk)) 4035 end do 4036 end do 4037 end do 4038 do kk=1,3 4039 do jj=1,3 4040 do ii=1,3 4041 symrhoij_symcart(ii,jj)=symrhoij_symcart(ii,jj)+aprim(ii,kk)*tmp(jj,kk) 4042 end do 4043 end do 4044 end do 4045 end function symrhoij_symcart 4046 4047 end subroutine symrhoij