TABLE OF CONTENTS
- ABINIT/bandfft_kpt_mpi_recv
- ABINIT/bandfft_kpt_mpi_send
- ABINIT/m_bandfft_kpt
- ABINIT/prep_bandfft_tabs
- m_bandfft_kpt/bandfft_kpt_copy
- m_bandfft_kpt/bandfft_kpt_destroy
- m_bandfft_kpt/bandfft_kpt_destroy_array
- m_bandfft_kpt/bandfft_kpt_get_ikpt
- m_bandfft_kpt/bandfft_kpt_init1
- m_bandfft_kpt/bandfft_kpt_init2
- m_bandfft_kpt/bandfft_kpt_reset
- m_bandfft_kpt/bandfft_kpt_restoretabs
- m_bandfft_kpt/bandfft_kpt_savetabs
- m_bandfft_kpt/bandfft_kpt_set_ikpt
- m_bandfft_kpt/bandfft_kpt_type
ABINIT/bandfft_kpt_mpi_recv [ Functions ]
NAME
bandfft_kpt_mpi_recv
FUNCTION
Receive a bandfft_kpt_type inside a MPI communicator.
INPUTS
sender=ID of the sender in spaceComm tag=message tag spaceComm=MPI Communicator
OUTPUT
ierr=Error status output=# of on proc. sender
PARENTS
posdoppler
CHILDREN
SOURCE
1524 subroutine bandfft_kpt_mpi_recv(output,sender,tag,spaceComm,ierr) 1525 1526 1527 !This section has been created automatically by the script Abilint (TD). 1528 !Do not modify the following lines by hand. 1529 #undef ABI_FUNC 1530 #define ABI_FUNC 'bandfft_kpt_mpi_recv' 1531 !End of the abilint section 1532 1533 implicit none 1534 1535 !Arguments ------------------------------------ 1536 !scalars 1537 integer,intent(in) :: sender,spaceComm,tag 1538 integer,intent(out) :: ierr 1539 !arrays 1540 type(bandfft_kpt_type),intent(out) :: output 1541 1542 !Local variables------------------------------- 1543 !scalars 1544 integer :: ipck,nsize,size_dp,size_int 1545 integer :: size1_kg_k_gather=0,size2_kg_k_gather=0,size_recvcounts=0 1546 integer :: size_sendcounts=0,size_rdispls=0,size_sdispls=0,size1_gbound=0,size2_gbound 1547 integer :: size1_kg_k_gather_sym=0,size2_kg_k_gather_sym=0,size_rdispls_sym=0 1548 integer :: size_sdispls_sym=0,size_recvcounts_sym=0,size_recvcounts_sym_tot=0 1549 integer :: size_sendcounts_sym=0,size_sendcounts_sym_all=0,size_tab_proc=0 1550 integer :: size_indices_pw_fft=0,size_sendcount_fft=0,size_senddisp_fft=0 1551 integer :: size_recvcount_fft=0,size_recvdisp_fft=0,size1_kg_k_fft=0,size2_kg_k_fft=0 1552 integer :: size1_ffnl_gather=0,size2_ffnl_gather=0,size3_ffnl_gather=0,size4_ffnl_gather=0 1553 integer :: size_kinpw_gather=0,size1_ph3d_gather=0,size2_ph3d_gather=0,size3_ph3d_gather=0 1554 integer :: size1_kpg_k_gather=0,size2_kpg_k_gather=0,sz1,sz2,sz3,sz4 1555 !arrays 1556 integer,allocatable :: buffer_int(:) 1557 real(dp),allocatable :: buffer_dp(:) 1558 1559 ! ************************************************************************* 1560 1561 if (xmpi_comm_size(spaceComm)<=1) return 1562 1563 !=== Receive flags and array sizes ==== 1564 nsize=45 1565 ABI_ALLOCATE(buffer_int,(nsize)) 1566 call xmpi_recv(buffer_int,sender,3*tag-2,spaceComm,ierr) 1567 output%flag1_is_allocated=buffer_int(1) 1568 output%flag2_is_allocated=buffer_int(2) 1569 output%flag3_is_allocated=buffer_int(3) 1570 output%have_to_reequilibrate=(buffer_int(4)/=0) 1571 output%istwf_k=buffer_int(5) 1572 output%npw_tot=buffer_int(6) 1573 output%npw_fft=buffer_int(7) 1574 output%ndatarecv=buffer_int(8) 1575 output%idatarecv0=buffer_int(9) 1576 output%ndatarecv_tot=buffer_int(10) 1577 output%ndatasend_sym=buffer_int(11) 1578 size_recvcounts=buffer_int(12) 1579 size_sendcounts=buffer_int(13) 1580 size_rdispls=buffer_int(14) 1581 size_sdispls=buffer_int(15) 1582 size1_gbound=buffer_int(16) 1583 size2_gbound=buffer_int(17) 1584 size1_ffnl_gather=buffer_int(18) 1585 size2_ffnl_gather=buffer_int(19) 1586 size3_ffnl_gather=buffer_int(20) 1587 size4_ffnl_gather=buffer_int(21) 1588 size_kinpw_gather=buffer_int(22) 1589 size1_ph3d_gather=buffer_int(23) 1590 size2_ph3d_gather=buffer_int(24) 1591 size3_ph3d_gather=buffer_int(25) 1592 size1_kpg_k_gather=buffer_int(26) 1593 size2_kpg_k_gather=buffer_int(27) 1594 size_indices_pw_fft=buffer_int(28) 1595 size_sendcount_fft=buffer_int(29) 1596 size_senddisp_fft=buffer_int(30) 1597 size_recvcount_fft=buffer_int(31) 1598 size_recvdisp_fft=buffer_int(32) 1599 size1_kg_k_fft=buffer_int(33) 1600 size2_kg_k_fft=buffer_int(34) 1601 size1_kg_k_gather=buffer_int(35) 1602 size2_kg_k_gather=buffer_int(36) 1603 size1_kg_k_gather_sym=buffer_int(37) 1604 size2_kg_k_gather_sym=buffer_int(38) 1605 size_rdispls_sym=buffer_int(39) 1606 size_sdispls_sym=buffer_int(40) 1607 size_recvcounts_sym=buffer_int(41) 1608 size_recvcounts_sym_tot=buffer_int(42) 1609 size_sendcounts_sym=buffer_int(43) 1610 size_sendcounts_sym_all=buffer_int(44) 1611 size_tab_proc=buffer_int(45) 1612 ABI_DEALLOCATE(buffer_int) 1613 1614 !=== Compute amount of transmitted data ==== 1615 size_int=size1_kg_k_gather*size2_kg_k_gather & 1616 & +size_recvcounts+size_sendcounts+size_rdispls+size_sdispls & 1617 & +size1_gbound*size2_gbound & 1618 & +size1_kg_k_gather_sym*size2_kg_k_gather_sym & 1619 & +size_rdispls_sym+size_sdispls_sym & 1620 & +size_recvcounts_sym+size_recvcounts_sym_tot & 1621 & +size_sendcounts_sym+size_sendcounts_sym_all+size_tab_proc & 1622 & +size_indices_pw_fft+size_sendcount_fft+size_senddisp_fft & 1623 & +size_recvcount_fft+size_recvdisp_fft & 1624 & +size1_kg_k_fft*size2_kg_k_fft 1625 size_dp=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather & 1626 & +size_kinpw_gather & 1627 & +size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather & 1628 & +size1_kpg_k_gather*size2_kpg_k_gather 1629 1630 !=== Receive and unpack integer data ==== 1631 if (size_int>0) then 1632 ipck=0 1633 ABI_ALLOCATE(buffer_int,(size_int)) 1634 call xmpi_recv(buffer_int,sender,3*tag-1,spaceComm,ierr) 1635 if (allocated(output%kg_k_gather)) then 1636 ABI_DEALLOCATE(output%kg_k_gather) 1637 end if 1638 if (size1_kg_k_gather*size2_kg_k_gather>0) then 1639 nsize=size1_kg_k_gather*size2_kg_k_gather 1640 sz1=size1_kg_k_gather;sz2=size2_kg_k_gather 1641 ABI_ALLOCATE(output%kg_k_gather,(sz1,sz2)) 1642 output%kg_k_gather(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/)) 1643 ipck=ipck+nsize 1644 end if 1645 if (allocated(output%recvcounts)) then 1646 ABI_DEALLOCATE(output%recvcounts) 1647 end if 1648 if (size_recvcounts>0) then 1649 ABI_ALLOCATE(output%recvcounts,(size_recvcounts)) 1650 output%recvcounts(:)=buffer_int(ipck+1:ipck+size_recvcounts) 1651 ipck=ipck+size_recvcounts 1652 end if 1653 if (allocated(output%sendcounts)) then 1654 ABI_DEALLOCATE(output%sendcounts) 1655 end if 1656 if (size_sendcounts>0) then 1657 ABI_ALLOCATE(output%sendcounts,(size_sendcounts)) 1658 output%sendcounts(:)=buffer_int(ipck+1:ipck+size_sendcounts) 1659 ipck=ipck+size_sendcounts 1660 end if 1661 if (allocated(output%rdispls)) then 1662 ABI_DEALLOCATE(output%rdispls) 1663 end if 1664 if (size_rdispls>0) then 1665 ABI_ALLOCATE(output%rdispls,(size_rdispls)) 1666 output%rdispls(:)=buffer_int(ipck+1:ipck+size_rdispls) 1667 ipck=ipck+size_rdispls 1668 end if 1669 if (allocated(output%sdispls)) then 1670 ABI_DEALLOCATE(output%sdispls) 1671 end if 1672 if (size_sdispls>0) then 1673 ABI_ALLOCATE(output%sdispls,(size_sdispls)) 1674 output%sdispls(:)=buffer_int(ipck+1:ipck+size_sdispls) 1675 ipck=ipck+size_sdispls 1676 end if 1677 if (allocated(output%gbound)) then 1678 ABI_DEALLOCATE(output%gbound) 1679 end if 1680 if (size1_gbound*size2_gbound>0) then 1681 nsize=size1_gbound*size2_gbound 1682 sz1=size1_gbound;sz2=size2_gbound 1683 ABI_ALLOCATE(output%gbound,(sz1,sz2)) 1684 output%gbound(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/)) 1685 ipck=ipck+nsize 1686 end if 1687 if (allocated(output%kg_k_gather_sym)) then 1688 ABI_DEALLOCATE(output%kg_k_gather_sym) 1689 end if 1690 if (size1_kg_k_gather_sym*size2_kg_k_gather_sym>0) then 1691 nsize=size1_kg_k_gather_sym*size2_kg_k_gather_sym 1692 sz1=size1_kg_k_gather_sym;sz2=size2_kg_k_gather_sym 1693 ABI_ALLOCATE(output%kg_k_gather_sym,(sz1,sz2)) 1694 output%kg_k_gather_sym(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/)) 1695 ipck=ipck+nsize 1696 end if 1697 if (allocated(output%rdispls_sym)) then 1698 ABI_DEALLOCATE(output%rdispls_sym) 1699 end if 1700 if (size_rdispls_sym>0) then 1701 ABI_ALLOCATE(output%rdispls_sym,(size_rdispls_sym)) 1702 output%rdispls_sym(:)=buffer_int(ipck+1:ipck+size_rdispls_sym) 1703 ipck=ipck+size_rdispls_sym 1704 end if 1705 if (allocated(output%sdispls_sym)) then 1706 ABI_DEALLOCATE(output%sdispls_sym) 1707 end if 1708 if (size_sdispls_sym>0) then 1709 ABI_ALLOCATE(output%sdispls_sym,(size_sdispls_sym)) 1710 output%sdispls_sym(:)=buffer_int(ipck+1:ipck+size_sdispls_sym) 1711 ipck=ipck+size_sdispls_sym 1712 end if 1713 if (allocated(output%recvcounts_sym)) then 1714 ABI_DEALLOCATE(output%recvcounts_sym) 1715 end if 1716 if (size_recvcounts_sym>0) then 1717 ABI_ALLOCATE(output%recvcounts_sym,(size_recvcounts_sym)) 1718 output%recvcounts_sym(:)=buffer_int(ipck+1:ipck+size_recvcounts_sym) 1719 ipck=ipck+size_recvcounts_sym 1720 end if 1721 if (allocated(output%recvcounts_sym_tot)) then 1722 ABI_DEALLOCATE(output%recvcounts_sym_tot) 1723 end if 1724 if (size_recvcounts_sym_tot>0) then 1725 ABI_ALLOCATE(output%recvcounts_sym_tot,(size_recvcounts_sym_tot)) 1726 output%recvcounts_sym_tot(:)=buffer_int(ipck+1:ipck+size_recvcounts_sym_tot) 1727 ipck=ipck+size_recvcounts_sym_tot 1728 end if 1729 if (allocated(output%sendcounts_sym)) then 1730 ABI_DEALLOCATE(output%sendcounts_sym) 1731 end if 1732 if (size_sendcounts_sym>0) then 1733 ABI_ALLOCATE(output%sendcounts_sym,(size_sendcounts_sym)) 1734 output%sendcounts_sym(:)=buffer_int(ipck+1:ipck+size_sendcounts_sym) 1735 ipck=ipck+size_sendcounts_sym 1736 end if 1737 if (allocated(output%sendcounts_sym_all)) then 1738 ABI_DEALLOCATE(output%sendcounts_sym_all) 1739 end if 1740 if (size_sendcounts_sym_all>0) then 1741 ABI_ALLOCATE(output%sendcounts_sym_all,(size_sendcounts_sym_all)) 1742 output%sendcounts_sym_all(:)=buffer_int(ipck+1:ipck+size_sendcounts_sym_all) 1743 ipck=ipck+size_sendcounts_sym_all 1744 end if 1745 if (allocated(output%tab_proc)) then 1746 ABI_DEALLOCATE(output%tab_proc) 1747 end if 1748 if (size_tab_proc>0) then 1749 ABI_ALLOCATE(output%tab_proc,(size_tab_proc)) 1750 output%tab_proc(:)=buffer_int(ipck+1:ipck+size_tab_proc) 1751 ipck=ipck+size_tab_proc 1752 end if 1753 if (allocated(output%indices_pw_fft)) then 1754 ABI_DEALLOCATE(output%indices_pw_fft) 1755 end if 1756 if (size_indices_pw_fft>0) then 1757 ABI_ALLOCATE(output%indices_pw_fft,(size_indices_pw_fft)) 1758 output%indices_pw_fft(:)=buffer_int(ipck+1:ipck+size_indices_pw_fft) 1759 ipck=ipck+size_indices_pw_fft 1760 end if 1761 if (allocated(output%sendcount_fft)) then 1762 ABI_DEALLOCATE(output%sendcount_fft) 1763 end if 1764 if (size_sendcount_fft>0) then 1765 ABI_ALLOCATE(output%sendcount_fft,(size_sendcount_fft)) 1766 output%sendcount_fft(:)=buffer_int(ipck+1:ipck+size_sendcount_fft) 1767 ipck=ipck+size_sendcount_fft 1768 end if 1769 if (allocated(output%senddisp_fft)) then 1770 ABI_DEALLOCATE(output%senddisp_fft) 1771 end if 1772 if (size_senddisp_fft>0) then 1773 ABI_ALLOCATE(output%senddisp_fft,(size_senddisp_fft)) 1774 output%senddisp_fft(:)=buffer_int(ipck+1:ipck+size_senddisp_fft) 1775 ipck=ipck+size_senddisp_fft 1776 end if 1777 if (allocated(output%recvcount_fft)) then 1778 ABI_DEALLOCATE(output%recvcount_fft) 1779 end if 1780 if (size_recvcount_fft>0) then 1781 ABI_ALLOCATE(output%recvcount_fft,(size_recvcount_fft)) 1782 output%recvcount_fft(:)=buffer_int(ipck+1:ipck+size_recvcount_fft) 1783 ipck=ipck+size_recvcount_fft 1784 end if 1785 if (allocated(output%recvdisp_fft)) then 1786 ABI_DEALLOCATE(output%recvdisp_fft) 1787 end if 1788 if (size_recvdisp_fft>0) then 1789 ABI_ALLOCATE(output%recvdisp_fft,(size_recvdisp_fft)) 1790 output%recvdisp_fft(:)=buffer_int(ipck+1:ipck+size_recvdisp_fft) 1791 ipck=ipck+size_recvdisp_fft 1792 end if 1793 if (allocated(output%kg_k_fft)) then 1794 ABI_DEALLOCATE(output%kg_k_fft) 1795 end if 1796 if (size1_kg_k_fft*size2_kg_k_fft>0) then 1797 nsize=size1_kg_k_fft*size2_kg_k_fft 1798 sz1=size1_kg_k_fft;sz2=size2_kg_k_fft 1799 ABI_ALLOCATE(output%kg_k_fft,(sz1,sz2)) 1800 output%kg_k_fft(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/)) 1801 ipck=ipck+nsize 1802 end if 1803 ABI_DEALLOCATE(buffer_int) 1804 end if 1805 1806 !=== Receive and unpack real data ==== 1807 if (size_dp>0) then 1808 ipck=0 1809 ABI_ALLOCATE(buffer_dp,(size_dp)) 1810 call xmpi_recv(buffer_dp,sender,3*tag,spaceComm,ierr) 1811 if (allocated(output%ffnl_gather)) then 1812 ABI_DEALLOCATE(output%ffnl_gather) 1813 end if 1814 if (size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather>0) then 1815 nsize=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather 1816 sz1=size1_ffnl_gather;sz2=size2_ffnl_gather;sz3=size3_ffnl_gather;sz4=size4_ffnl_gather 1817 ABI_ALLOCATE(output%ffnl_gather,(sz1,sz2,sz3,sz4)) 1818 output%ffnl_gather(:,:,:,:)=reshape(buffer_dp(ipck+1:ipck+nsize),(/sz1,sz2,sz3,sz4/)) 1819 ipck=ipck+nsize 1820 end if 1821 if (allocated(output%kinpw_gather)) then 1822 ABI_DEALLOCATE(output%kinpw_gather) 1823 end if 1824 if (size_kinpw_gather>0) then 1825 ABI_ALLOCATE(output%kinpw_gather,(size_kinpw_gather)) 1826 output%kinpw_gather(:)=buffer_dp(ipck+1:ipck+size_kinpw_gather) 1827 ipck=ipck+size_kinpw_gather 1828 end if 1829 if (allocated(output%ph3d_gather)) then 1830 ABI_DEALLOCATE(output%ph3d_gather) 1831 end if 1832 if (size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather>0) then 1833 nsize=size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather 1834 sz1=size1_ph3d_gather;sz2=size2_ph3d_gather;sz3=size3_ph3d_gather 1835 ABI_ALLOCATE(output%ph3d_gather,(sz1,sz2,sz3)) 1836 output%ph3d_gather(:,:,:)=reshape(buffer_dp(ipck+1:ipck+nsize),(/sz1,sz2,sz3/)) 1837 ipck=ipck+nsize 1838 end if 1839 if (allocated(output%kpg_k_gather)) then 1840 ABI_DEALLOCATE(output%kpg_k_gather) 1841 end if 1842 if (size1_kpg_k_gather*size2_kpg_k_gather>0) then 1843 nsize=size1_kpg_k_gather*size2_kpg_k_gather 1844 sz1=size1_kpg_k_gather;sz2=size2_kpg_k_gather 1845 ABI_ALLOCATE(output%kpg_k_gather,(sz1,sz2)) 1846 output%kpg_k_gather(:,:)=reshape(buffer_dp(ipck+1:ipck+nsize),(/sz1,sz2/)) 1847 ipck=ipck+nsize 1848 end if 1849 ABI_DEALLOCATE(buffer_dp) 1850 end if 1851 1852 end subroutine bandfft_kpt_mpi_recv
ABINIT/bandfft_kpt_mpi_send [ Functions ]
NAME
bandfft_kpt_mpi_send
FUNCTION
Send a bandfft_kpt_type inside a MPI communicator
INPUTS
input=The datatype to be transmitted
receiver=ID of the receiver in spaceComm
tag=message tag
spaceComm=MPI Communicator
[profile]=(character, optional, default=full)
Define the part of the datastructure to be sent; possible values:
'full'= the entire datastructure
'fourwf'= only arrays needed by the fourwf routine
OUTPUT
ierr=Error status
PARENTS
posdoppler
CHILDREN
SOURCE
1220 subroutine bandfft_kpt_mpi_send(input,receiver,tag,spaceComm,ierr,profile) 1221 1222 1223 !This section has been created automatically by the script Abilint (TD). 1224 !Do not modify the following lines by hand. 1225 #undef ABI_FUNC 1226 #define ABI_FUNC 'bandfft_kpt_mpi_send' 1227 !End of the abilint section 1228 1229 implicit none 1230 1231 !Arguments ------------------------------------ 1232 !scalars 1233 integer,intent(in) :: receiver,spaceComm,tag 1234 integer,intent(out) :: ierr 1235 character(len=*),optional,intent(in) :: profile 1236 !arrays 1237 type(bandfft_kpt_type),intent(in) :: input 1238 1239 !Local variables------------------------------- 1240 !scalars 1241 integer :: ipck,nsize,size_dp,size_int 1242 integer :: size1_kg_k_gather=0,size2_kg_k_gather=0,size_recvcounts=0 1243 integer :: size_sendcounts=0,size_rdispls=0,size_sdispls=0,size1_gbound=0,size2_gbound 1244 integer :: size1_kg_k_gather_sym=0,size2_kg_k_gather_sym=0,size_rdispls_sym=0 1245 integer :: size_sdispls_sym=0,size_recvcounts_sym=0,size_recvcounts_sym_tot=0 1246 integer :: size_sendcounts_sym=0,size_sendcounts_sym_all=0,size_tab_proc=0 1247 integer :: size_indices_pw_fft=0,size_sendcount_fft=0,size_senddisp_fft=0 1248 integer :: size_recvcount_fft=0,size_recvdisp_fft=0,size1_kg_k_fft=0,size2_kg_k_fft=0 1249 integer :: size1_ffnl_gather=0,size2_ffnl_gather=0,size3_ffnl_gather=0,size4_ffnl_gather=0 1250 integer :: size_kinpw_gather=0,size1_ph3d_gather=0,size2_ph3d_gather=0,size3_ph3d_gather=0 1251 integer :: size1_kpg_k_gather=0,size2_kpg_k_gather=0 1252 logical :: fourwf,full 1253 !arrays 1254 integer,allocatable :: buffer_int(:) 1255 real(dp),allocatable :: buffer_dp(:) 1256 1257 ! ************************************************************************* 1258 1259 if (xmpi_comm_size(spaceComm)<=1) return 1260 1261 fourwf=.false.;if (present(profile)) fourwf=(trim(profile)=='fourwf') 1262 full=(.not.fourwf) 1263 1264 !=== Store sizes ==== 1265 if (fourwf.or.full) then 1266 if (allocated(input%kg_k_gather)) size1_kg_k_gather=size(input%kg_k_gather,1) 1267 if (allocated(input%kg_k_gather)) size2_kg_k_gather=size(input%kg_k_gather,2) 1268 if (input%flag1_is_allocated==1) then 1269 if (allocated(input%recvcounts)) size_recvcounts=size(input%recvcounts) 1270 if (allocated(input%sendcounts)) size_sendcounts=size(input%sendcounts) 1271 if (allocated(input%rdispls)) size_rdispls=size(input%rdispls) 1272 if (allocated(input%sdispls)) size_sdispls=size(input%sdispls) 1273 if (allocated(input%gbound)) size1_gbound=size(input%gbound,1) 1274 if (allocated(input%gbound)) size2_gbound=size(input%gbound,2) 1275 end if 1276 if (input%flag3_is_allocated==1.and.input%istwf_k>1) then 1277 if (allocated(input%kg_k_gather_sym)) size1_kg_k_gather_sym=size(input%kg_k_gather_sym,1) 1278 if (allocated(input%kg_k_gather_sym)) size2_kg_k_gather_sym=size(input%kg_k_gather_sym,2) 1279 if (allocated(input%rdispls_sym)) size_rdispls_sym=size(input%rdispls_sym) 1280 if (allocated(input%sdispls_sym)) size_sdispls_sym=size(input%sdispls_sym) 1281 if (allocated(input%recvcounts_sym)) size_recvcounts_sym=size(input%recvcounts_sym) 1282 if (allocated(input%recvcounts_sym_tot)) size_recvcounts_sym_tot=size(input%recvcounts_sym_tot) 1283 if (allocated(input%sendcounts_sym)) size_sendcounts_sym=size(input%sendcounts_sym) 1284 if (allocated(input%sendcounts_sym_all)) size_sendcounts_sym_all=size(input%sendcounts_sym_all) 1285 if (allocated(input%tab_proc)) size_tab_proc=size(input%tab_proc) 1286 end if 1287 if (input%have_to_reequilibrate) then 1288 if (allocated(input%indices_pw_fft)) size_indices_pw_fft=size(input%indices_pw_fft) 1289 if (allocated(input%sendcount_fft)) size_sendcount_fft=size(input%sendcount_fft) 1290 if (allocated(input%senddisp_fft)) size_senddisp_fft=size(input%senddisp_fft) 1291 if (allocated(input%recvcount_fft)) size_recvcount_fft=size(input%recvcount_fft) 1292 if (allocated(input%recvdisp_fft)) size_recvdisp_fft=size(input%recvdisp_fft) 1293 if (allocated(input%kg_k_fft)) size1_kg_k_fft=size(input%kg_k_fft,1) 1294 if (allocated(input%kg_k_fft)) size2_kg_k_fft=size(input%kg_k_fft,2) 1295 end if 1296 end if 1297 if (input%flag2_is_allocated==1.and.full) then 1298 if (allocated(input%ffnl_gather)) size1_ffnl_gather=size(input%ffnl_gather,1) 1299 if (allocated(input%ffnl_gather)) size2_ffnl_gather=size(input%ffnl_gather,2) 1300 if (allocated(input%ffnl_gather)) size3_ffnl_gather=size(input%ffnl_gather,3) 1301 if (allocated(input%ffnl_gather)) size4_ffnl_gather=size(input%ffnl_gather,4) 1302 if (allocated(input%kinpw_gather)) size_kinpw_gather=size(input%kinpw_gather) 1303 if (allocated(input%ph3d_gather)) size1_ph3d_gather=size(input%ph3d_gather,1) 1304 if (allocated(input%ph3d_gather)) size2_ph3d_gather=size(input%ph3d_gather,2) 1305 if (allocated(input%ph3d_gather)) size3_ph3d_gather=size(input%ph3d_gather,3) 1306 if (allocated(input%kpg_k_gather)) size1_kpg_k_gather=size(input%kpg_k_gather,1) 1307 if (allocated(input%kpg_k_gather)) size2_kpg_k_gather=size(input%kpg_k_gather,2) 1308 end if 1309 1310 !=== Compute amount of data to transmit ==== 1311 size_int=size1_kg_k_gather*size2_kg_k_gather & 1312 & +size_recvcounts+size_sendcounts+size_rdispls+size_sdispls & 1313 & +size1_gbound*size2_gbound & 1314 & +size1_kg_k_gather_sym*size2_kg_k_gather_sym & 1315 & +size_rdispls_sym+size_sdispls_sym & 1316 & +size_recvcounts_sym+size_recvcounts_sym_tot & 1317 & +size_sendcounts_sym+size_sendcounts_sym_all+size_tab_proc & 1318 & +size_indices_pw_fft+size_sendcount_fft+size_senddisp_fft & 1319 & +size_recvcount_fft+size_recvdisp_fft & 1320 & +size1_kg_k_fft*size2_kg_k_fft 1321 size_dp=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather & 1322 & +size_kinpw_gather & 1323 & +size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather & 1324 & +size1_kpg_k_gather*size2_kpg_k_gather 1325 1326 !=== Send flags and array sizes ==== 1327 nsize=45 1328 ABI_ALLOCATE(buffer_int,(nsize)) 1329 buffer_int(1)=input%flag1_is_allocated 1330 buffer_int(2)=input%flag2_is_allocated 1331 buffer_int(3)=input%flag3_is_allocated 1332 buffer_int(4)=0;if (input%have_to_reequilibrate) buffer_int(4)=1 1333 buffer_int(5)=input%istwf_k 1334 buffer_int(6)=input%npw_tot 1335 buffer_int(7)=input%npw_fft 1336 buffer_int(8)=input%ndatarecv 1337 buffer_int(9)=input%idatarecv0 1338 buffer_int(10)=input%ndatarecv_tot 1339 buffer_int(11)=input%ndatasend_sym 1340 buffer_int(12)=size_recvcounts 1341 buffer_int(13)=size_sendcounts 1342 buffer_int(14)=size_rdispls 1343 buffer_int(15)=size_sdispls 1344 buffer_int(16)=size1_gbound 1345 buffer_int(17)=size2_gbound 1346 buffer_int(18)=size1_ffnl_gather 1347 buffer_int(19)=size2_ffnl_gather 1348 buffer_int(20)=size3_ffnl_gather 1349 buffer_int(21)=size4_ffnl_gather 1350 buffer_int(22)=size_kinpw_gather 1351 buffer_int(23)=size1_ph3d_gather 1352 buffer_int(24)=size2_ph3d_gather 1353 buffer_int(25)=size3_ph3d_gather 1354 buffer_int(26)=size1_kpg_k_gather 1355 buffer_int(27)=size2_kpg_k_gather 1356 buffer_int(28)=size_indices_pw_fft 1357 buffer_int(29)=size_sendcount_fft 1358 buffer_int(30)=size_senddisp_fft 1359 buffer_int(31)=size_recvcount_fft 1360 buffer_int(32)=size_recvdisp_fft 1361 buffer_int(33)=size1_kg_k_fft 1362 buffer_int(34)=size2_kg_k_fft 1363 buffer_int(35)=size1_kg_k_gather 1364 buffer_int(36)=size2_kg_k_gather 1365 buffer_int(37)=size1_kg_k_gather_sym 1366 buffer_int(38)=size2_kg_k_gather_sym 1367 buffer_int(39)=size_rdispls_sym 1368 buffer_int(40)=size_sdispls_sym 1369 buffer_int(41)=size_recvcounts_sym 1370 buffer_int(42)=size_recvcounts_sym_tot 1371 buffer_int(43)=size_sendcounts_sym 1372 buffer_int(44)=size_sendcounts_sym_all 1373 buffer_int(45)=size_tab_proc 1374 call xmpi_send(buffer_int,receiver,3*tag-2,spaceComm,ierr) 1375 ABI_DEALLOCATE(buffer_int) 1376 1377 !=== Pack and send integer data ==== 1378 if (size_int>0) then 1379 ipck=0 1380 ABI_ALLOCATE(buffer_int,(size_int)) 1381 if (size1_kg_k_gather*size2_kg_k_gather>0) then 1382 nsize=size1_kg_k_gather*size2_kg_k_gather 1383 buffer_int(ipck+1:ipck+nsize)=reshape(input%kg_k_gather(:,:),(/nsize/)) 1384 ipck=ipck+nsize 1385 end if 1386 if (size_recvcounts>0) then 1387 buffer_int(ipck+1:ipck+size_recvcounts)=input%recvcounts(:) 1388 ipck=ipck+size_recvcounts 1389 end if 1390 if (size_sendcounts>0) then 1391 buffer_int(ipck+1:ipck+size_sendcounts)=input%sendcounts(:) 1392 ipck=ipck+size_sendcounts 1393 end if 1394 if (size_rdispls>0) then 1395 buffer_int(ipck+1:ipck+size_rdispls)=input%rdispls(:) 1396 ipck=ipck+size_rdispls 1397 end if 1398 if (size_sdispls>0) then 1399 buffer_int(ipck+1:ipck+size_sdispls)=input%sdispls(:) 1400 ipck=ipck+size_sdispls 1401 end if 1402 if (size1_gbound*size2_gbound>0) then 1403 nsize=size1_gbound*size2_gbound 1404 buffer_int(ipck+1:ipck+nsize)=reshape(input%gbound(:,:),(/nsize/)) 1405 ipck=ipck+nsize 1406 end if 1407 if (size1_kg_k_gather_sym*size2_kg_k_gather_sym>0) then 1408 nsize=size1_kg_k_gather_sym*size2_kg_k_gather_sym 1409 buffer_int(ipck+1:ipck+nsize)=reshape(input%kg_k_gather_sym(:,:),(/nsize/)) 1410 ipck=ipck+nsize 1411 end if 1412 if (size_rdispls_sym>0) then 1413 buffer_int(ipck+1:ipck+size_rdispls_sym)=input%rdispls_sym(:) 1414 ipck=ipck+size_rdispls_sym 1415 end if 1416 if (size_sdispls_sym>0) then 1417 buffer_int(ipck+1:ipck+size_sdispls_sym)=input%sdispls_sym(:) 1418 ipck=ipck+size_sdispls_sym 1419 end if 1420 if (size_recvcounts_sym>0) then 1421 buffer_int(ipck+1:ipck+size_recvcounts_sym)=input%recvcounts_sym(:) 1422 ipck=ipck+size_recvcounts_sym 1423 end if 1424 if (size_recvcounts_sym_tot>0) then 1425 buffer_int(ipck+1:ipck+size_recvcounts_sym_tot)=input%recvcounts_sym_tot(:) 1426 ipck=ipck+size_recvcounts_sym_tot 1427 end if 1428 if (size_sendcounts_sym>0) then 1429 buffer_int(ipck+1:ipck+size_sendcounts_sym)=input%sendcounts_sym(:) 1430 ipck=ipck+size_sendcounts_sym 1431 end if 1432 if (size_sendcounts_sym_all>0) then 1433 buffer_int(ipck+1:ipck+size_sendcounts_sym_all)=input%sendcounts_sym_all(:) 1434 ipck=ipck+size_sendcounts_sym_all 1435 end if 1436 if (size_tab_proc>0) then 1437 buffer_int(ipck+1:ipck+size_tab_proc)=input%tab_proc(:) 1438 ipck=ipck+size_tab_proc 1439 end if 1440 if (size_indices_pw_fft>0) then 1441 buffer_int(ipck+1:ipck+size_indices_pw_fft)=input%indices_pw_fft(:) 1442 ipck=ipck+size_indices_pw_fft 1443 end if 1444 if (size_sendcount_fft>0) then 1445 buffer_int(ipck+1:ipck+size_sendcount_fft)=input%sendcount_fft(:) 1446 ipck=ipck+size_sendcount_fft 1447 end if 1448 if (size_senddisp_fft>0) then 1449 buffer_int(ipck+1:ipck+size_senddisp_fft)=input%senddisp_fft(:) 1450 ipck=ipck+size_senddisp_fft 1451 end if 1452 if (size_recvcount_fft>0) then 1453 buffer_int(ipck+1:ipck+size_recvcount_fft)=input%recvcount_fft(:) 1454 ipck=ipck+size_recvcount_fft 1455 end if 1456 if (size_recvdisp_fft>0) then 1457 buffer_int(ipck+1:ipck+size_recvdisp_fft)=input%recvdisp_fft(:) 1458 ipck=ipck+size_recvdisp_fft 1459 end if 1460 if (size1_kg_k_fft*size2_kg_k_fft>0) then 1461 nsize=size1_kg_k_fft*size2_kg_k_fft 1462 buffer_int(ipck+1:ipck+nsize)=reshape(input%kg_k_fft(:,:),(/nsize/)) 1463 ipck=ipck+nsize 1464 end if 1465 call xmpi_send(buffer_int,receiver,3*tag-1,spaceComm,ierr) 1466 ABI_DEALLOCATE(buffer_int) 1467 end if 1468 1469 !=== Pack and send real data ==== 1470 if (size_dp>0) then 1471 ipck=0 1472 ABI_ALLOCATE(buffer_dp,(size_dp)) 1473 if (size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather>0) then 1474 nsize=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather 1475 buffer_dp(ipck+1:ipck+nsize)=reshape(input%ffnl_gather(:,:,:,:),(/nsize/)) 1476 ipck=ipck+nsize 1477 end if 1478 if (size_kinpw_gather>0) then 1479 buffer_dp(ipck+1:ipck+size_kinpw_gather)=input%kinpw_gather(:) 1480 ipck=ipck+size_kinpw_gather 1481 end if 1482 if (size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather>0) then 1483 nsize=size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather 1484 buffer_dp(ipck+1:ipck+nsize)=reshape(input%ph3d_gather(:,:,:),(/nsize/)) 1485 ipck=ipck+nsize 1486 end if 1487 if (size1_kpg_k_gather*size2_kpg_k_gather>0) then 1488 nsize=size1_kpg_k_gather*size2_kpg_k_gather 1489 buffer_dp(ipck+1:ipck+nsize)=reshape(input%kpg_k_gather(:,:),(/nsize/)) 1490 ipck=ipck+nsize 1491 end if 1492 call xmpi_send(buffer_dp,receiver,3*tag,spaceComm,ierr) 1493 ABI_DEALLOCATE(buffer_dp) 1494 end if 1495 1496 end subroutine bandfft_kpt_mpi_send
ABINIT/m_bandfft_kpt [ Modules ]
NAME
m_bandfft_kpt
FUNCTION
This module provides the definition of the bandfft_kpt_type used for kgb parallelization.
COPYRIGHT
Copyright (C) 2011-2018 ABINIT group (FJ, FB, MT) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
PARENTS
CHILDREN
SOURCE
22 #if defined HAVE_CONFIG_H 23 #include "config.h" 24 #endif 25 26 #include "abi_common.h" 27 28 MODULE m_bandfft_kpt 29 30 use defs_basis 31 use defs_abitypes 32 use m_abicore 33 use m_errors 34 use m_xmpi 35 36 use m_time, only : timab 37 use m_kg, only : mkkpg 38 use m_fftcore, only : sphereboundary 39 use m_mpinfo, only : proc_distrb_cycle 40 use m_hamiltonian, only : gs_hamiltonian_type 41 42 implicit none 43 44 private 45 public :: bandfft_kpt_init1 46 public :: bandfft_kpt_init2 47 public :: bandfft_kpt_reset 48 public :: bandfft_kpt_destroy 49 public :: bandfft_kpt_destroy_array 50 public :: bandfft_kpt_copy 51 public :: bandfft_kpt_mpi_send 52 public :: bandfft_kpt_mpi_recv 53 public :: bandfft_kpt_savetabs 54 public :: bandfft_kpt_restoretabs 55 public :: bandfft_kpt_set_ikpt 56 public :: bandfft_kpt_get_ikpt 57 public :: prep_bandfft_tabs
ABINIT/prep_bandfft_tabs [ Functions ]
NAME
prep_bandfft_tabs
FUNCTION
This routine transpose various tabs needed in bandfft parallelization
INPUTS
ikpt=index of the k-point gs_hamk <type(gs_hamiltonian_type)>=all data for the Hamiltonian at k mkmem=number of k points which can fit in memory; set to 0 if use disk
SIDE EFFECTS
bandfft_kpt tabs (defined in m_bandfft_kpt module)
PARENTS
energy,fock2ACE,forstrnps,vtorho
CHILDREN
bandfft_kpt_init2,bandfft_kpt_set_ikpt,mkkpg,timab,xmpi_allgatherv
SOURCE
2173 subroutine prep_bandfft_tabs(gs_hamk,ikpt,mkmem,mpi_enreg) 2174 2175 2176 !This section has been created automatically by the script Abilint (TD). 2177 !Do not modify the following lines by hand. 2178 #undef ABI_FUNC 2179 #define ABI_FUNC 'prep_bandfft_tabs' 2180 !End of the abilint section 2181 2182 implicit none 2183 2184 !Arguments ------------------------------- 2185 integer,intent(in) :: ikpt,mkmem 2186 type(gs_hamiltonian_type),intent(inout) :: gs_hamk 2187 type(MPI_type),intent(inout) :: mpi_enreg 2188 2189 !Local variables------------------------------- 2190 integer :: dimffnl,ierr,ikpt_this_proc,ipw,lmnmax,matblk,ndatarecv,nkpg,npw_k,ntypat,spaceComm 2191 logical :: tabs_allocated 2192 real(dp) :: tsec(2) 2193 character(len=500) :: message 2194 integer, allocatable :: recvcounts(:),rdispls(:) 2195 integer, allocatable :: recvcountsloc(:),rdisplsloc(:) 2196 real(dp),allocatable :: ffnl_gather(:,:,:,:),ffnl_little(:,:,:,:),ffnl_little_gather(:,:,:,:) 2197 real(dp),allocatable :: kinpw_gather(:),kpg_k_gather(:,:) 2198 real(dp),allocatable :: ph3d_gather(:,:,:),ph3d_little(:,:,:),ph3d_little_gather(:,:,:) 2199 2200 ! ********************************************************************* 2201 2202 call timab(575,1,tsec) 2203 2204 ikpt_this_proc=mpi_enreg%my_kpttab(ikpt) 2205 tabs_allocated=((bandfft_kpt(ikpt_this_proc)%flag1_is_allocated==1).and.& 2206 & (ikpt_this_proc <= mkmem).and.(ikpt_this_proc/=0)) 2207 2208 if (.not.tabs_allocated) then 2209 message = ' the bandfft tabs are not allocated !' 2210 MSG_BUG(message) 2211 end if 2212 2213 ntypat=gs_hamk%ntypat 2214 lmnmax=gs_hamk%lmnmax 2215 matblk=gs_hamk%matblk 2216 npw_k=gs_hamk%npw_k 2217 dimffnl=size(gs_hamk%ffnl_k,2) 2218 nkpg=size(gs_hamk%kpg_k,2) 2219 2220 ABI_ALLOCATE(rdispls,(mpi_enreg%nproc_band)) 2221 ABI_ALLOCATE(recvcounts,(mpi_enreg%nproc_band)) 2222 ABI_ALLOCATE(rdisplsloc,(mpi_enreg%nproc_band)) 2223 ABI_ALLOCATE(recvcountsloc,(mpi_enreg%nproc_band)) 2224 2225 spaceComm =mpi_enreg%comm_band 2226 ndatarecv =bandfft_kpt(ikpt_this_proc)%ndatarecv 2227 rdispls(:) =bandfft_kpt(ikpt_this_proc)%rdispls(:) 2228 recvcounts(:)=bandfft_kpt(ikpt_this_proc)%recvcounts(:) 2229 2230 !---- Process FFNL 2231 if (associated(gs_hamk%ffnl_k)) then 2232 ABI_ALLOCATE(ffnl_gather,(ndatarecv,dimffnl,lmnmax,ntypat)) 2233 ABI_ALLOCATE(ffnl_little,(dimffnl,lmnmax,ntypat,npw_k)) 2234 ABI_ALLOCATE(ffnl_little_gather,(dimffnl,lmnmax,ntypat,ndatarecv)) 2235 do ipw=1,npw_k 2236 ffnl_little(:,:,:,ipw)=gs_hamk%ffnl_k(ipw,:,:,:) 2237 end do 2238 recvcountsloc(:)=recvcounts(:)*dimffnl*lmnmax*ntypat 2239 rdisplsloc(:)=rdispls(:)*dimffnl*lmnmax*ntypat 2240 call xmpi_allgatherv(ffnl_little,npw_k*dimffnl*lmnmax*ntypat,ffnl_little_gather,& 2241 & recvcountsloc(:),rdisplsloc,spaceComm,ierr) 2242 do ipw=1,ndatarecv 2243 ffnl_gather(ipw,:,:,:)=ffnl_little_gather(:,:,:,ipw) 2244 end do 2245 ABI_DEALLOCATE(ffnl_little) 2246 ABI_DEALLOCATE(ffnl_little_gather) 2247 else 2248 ABI_ALLOCATE(ffnl_gather,(0,0,0,0)) 2249 end if 2250 2251 !---- Process PH3D 2252 if (associated(gs_hamk%ph3d_k)) then 2253 ABI_ALLOCATE(ph3d_gather,(2,ndatarecv,matblk)) 2254 ABI_ALLOCATE(ph3d_little,(2,matblk,npw_k)) 2255 ABI_ALLOCATE(ph3d_little_gather,(2,matblk,ndatarecv)) 2256 recvcountsloc(:)=recvcounts(:)*2*matblk 2257 rdisplsloc(:)=rdispls(:)*2*matblk 2258 do ipw=1,npw_k 2259 ph3d_little(:,:,ipw)=gs_hamk%ph3d_k(:,ipw,:) 2260 end do 2261 call xmpi_allgatherv(ph3d_little,npw_k*2*matblk,ph3d_little_gather,& 2262 & recvcountsloc(:),rdisplsloc,spaceComm,ierr) 2263 do ipw=1,ndatarecv 2264 ph3d_gather(:,ipw,:)=ph3d_little_gather(:,:,ipw) 2265 end do 2266 ABI_DEALLOCATE(ph3d_little_gather) 2267 ABI_DEALLOCATE(ph3d_little) 2268 else 2269 ABI_ALLOCATE(ph3d_gather,(0,0,0)) 2270 end if 2271 2272 !---- Process KPG_K 2273 if (associated(gs_hamk%kpg_k)) then 2274 ABI_ALLOCATE(kpg_k_gather,(ndatarecv,nkpg)) 2275 if (nkpg>0) then 2276 call mkkpg(bandfft_kpt(ikpt_this_proc)%kg_k_gather,kpg_k_gather,gs_hamk%kpt_k,nkpg,ndatarecv) 2277 end if 2278 else 2279 ABI_ALLOCATE(kpg_k_gather,(0,0)) 2280 end if 2281 2282 !---- Process KINPW 2283 if (associated(gs_hamk%kinpw_k)) then 2284 ABI_ALLOCATE(kinpw_gather,(ndatarecv)) 2285 recvcountsloc(:)=recvcounts(:) 2286 rdisplsloc(:)=rdispls(:) 2287 call xmpi_allgatherv(gs_hamk%kinpw_k,npw_k,kinpw_gather,recvcountsloc(:),rdisplsloc,spaceComm,ierr) 2288 else 2289 ABI_ALLOCATE(kinpw_gather,(0)) 2290 end if 2291 2292 ABI_DEALLOCATE(recvcounts) 2293 ABI_DEALLOCATE(rdispls) 2294 ABI_DEALLOCATE(recvcountsloc) 2295 ABI_DEALLOCATE(rdisplsloc) 2296 2297 call bandfft_kpt_init2(bandfft_kpt,dimffnl,ffnl_gather,ikpt_this_proc,kinpw_gather,kpg_k_gather,& 2298 & lmnmax,matblk,mkmem,ndatarecv,nkpg,ntypat,ph3d_gather) 2299 2300 ABI_DEALLOCATE(ffnl_gather) 2301 ABI_DEALLOCATE(ph3d_gather) 2302 ABI_DEALLOCATE(kinpw_gather) 2303 ABI_DEALLOCATE(kpg_k_gather) 2304 2305 !---- Store current kpt index 2306 call bandfft_kpt_set_ikpt(ikpt,mpi_enreg) 2307 2308 call timab(575,2,tsec) 2309 2310 end subroutine prep_bandfft_tabs
m_bandfft_kpt/bandfft_kpt_copy [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_copy
FUNCTION
Copy a bandfft_kpt datastructure into another
INPUTS
bandfft_kpt_in=<type(bandfft_kpt_type)>=input bandfft_kpt datastructure
OUTPUT
bandfft_kpt_out=<type(bandfft_kpt_type)>=output bandfft_kpt datastructure
PARENTS
CHILDREN
SOURCE
1000 subroutine bandfft_kpt_copy(bandfft_kpt_in,bandfft_kpt_out,mpi_enreg1,opt_bandfft) 1001 1002 1003 !This section has been created automatically by the script Abilint (TD). 1004 !Do not modify the following lines by hand. 1005 #undef ABI_FUNC 1006 #define ABI_FUNC 'bandfft_kpt_copy' 1007 !End of the abilint section 1008 1009 implicit none 1010 1011 !Arguments ------------------------------------ 1012 !scalars 1013 integer,intent(in) :: opt_bandfft 1014 type(bandfft_kpt_type),pointer :: bandfft_kpt_in(:) 1015 type(bandfft_kpt_type),pointer :: bandfft_kpt_out(:) 1016 type(MPI_type),intent(inout) :: mpi_enreg1 1017 1018 !Local variables------------------------------- 1019 !scalars 1020 integer :: ikpt,isppol,jkpt,sz1,sz2,sz3,sz4 1021 1022 ! ********************************************************************* 1023 1024 !Optional pointers 1025 if (opt_bandfft==0) then 1026 nullify(bandfft_kpt_out) 1027 else if (opt_bandfft==1) then 1028 if (associated(bandfft_kpt_in)) then 1029 ABI_DATATYPE_ALLOCATE(bandfft_kpt_out,(size(bandfft_kpt_in))) 1030 do isppol=1,size(mpi_enreg1%proc_distrb,3) 1031 do ikpt=1,size(mpi_enreg1%proc_distrb,1) 1032 sz1=size(mpi_enreg1%proc_distrb,2) 1033 if(proc_distrb_cycle(mpi_enreg1%proc_distrb,ikpt,1,sz1,isppol,mpi_enreg1%me_kpt)) then 1034 cycle 1035 end if 1036 jkpt=mpi_enreg1%my_kpttab(ikpt) 1037 ! if (allocated(bandfft_kpt_in(jkpt)%ind_kg_mpi_to_seq)) then 1038 ! sz1=size(bandfft_kpt_in(jkpt)%ind_kg_mpi_to_seq) 1039 ! ABI_ALLOCATE(bandfft_kpt_out(jkpt)%ind_kg_mpi_to_seq,(sz1)) 1040 ! bandfft_kpt_out(jkpt)%ind_kg_mpi_to_seq= & 1041 ! & bandfft_kpt_in(jkpt)%ind_kg_mpi_to_seq 1042 ! end if 1043 if (allocated(bandfft_kpt_in(jkpt)%kg_k_gather)) then 1044 sz1=size(bandfft_kpt_in(jkpt)%kg_k_gather,1) 1045 sz2=size(bandfft_kpt_in(jkpt)%kg_k_gather,2) 1046 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%kg_k_gather,(sz1,sz2)) 1047 bandfft_kpt_out(jkpt)%kg_k_gather= & 1048 & bandfft_kpt_in(jkpt)%kg_k_gather 1049 end if 1050 bandfft_kpt_out(jkpt)%flag1_is_allocated=bandfft_kpt_in(jkpt)%flag1_is_allocated 1051 if (allocated(bandfft_kpt_in(jkpt)%gbound)) then 1052 sz1=size(bandfft_kpt_in(jkpt)%gbound,1) 1053 sz2=size(bandfft_kpt_in(jkpt)%gbound,2) 1054 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%gbound,(sz1,sz2)) 1055 bandfft_kpt_out(jkpt)%gbound= & 1056 & bandfft_kpt_in(jkpt)%gbound 1057 end if 1058 if (allocated(bandfft_kpt_in(jkpt)%recvcounts)) then 1059 sz1=size(bandfft_kpt_in(jkpt)%recvcounts) 1060 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%recvcounts,(sz1)) 1061 bandfft_kpt_out(jkpt)%recvcounts= & 1062 & bandfft_kpt_in(jkpt)%recvcounts 1063 end if 1064 if (allocated(bandfft_kpt_in(jkpt)%sendcounts)) then 1065 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%sendcounts,(size(bandfft_kpt_in(jkpt)%sendcounts))) 1066 bandfft_kpt_out(jkpt)%sendcounts= & 1067 & bandfft_kpt_in(jkpt)%sendcounts 1068 end if 1069 if (allocated(bandfft_kpt_in(jkpt)%rdispls)) then 1070 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%rdispls,(size(bandfft_kpt_in(jkpt)%rdispls))) 1071 bandfft_kpt_out(jkpt)%rdispls= & 1072 & bandfft_kpt_in(jkpt)%rdispls 1073 end if 1074 if (allocated(bandfft_kpt_in(jkpt)%sdispls)) then 1075 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%sdispls,(size(bandfft_kpt_in(jkpt)%sdispls))) 1076 bandfft_kpt_out(jkpt)%sdispls= & 1077 & bandfft_kpt_in(jkpt)%sdispls 1078 end if 1079 bandfft_kpt_out(jkpt)%flag2_is_allocated=bandfft_kpt_in(jkpt)%flag2_is_allocated 1080 if (allocated(bandfft_kpt_in(jkpt)%ffnl_gather)) then 1081 sz1=size(bandfft_kpt_in(jkpt)%ffnl_gather,1) 1082 sz2=size(bandfft_kpt_in(jkpt)%ffnl_gather,2) 1083 sz3=size(bandfft_kpt_in(jkpt)%ffnl_gather,3) 1084 sz4=size(bandfft_kpt_in(jkpt)%ffnl_gather,4) 1085 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%ffnl_gather,(sz1,sz2,sz3,sz4)) 1086 bandfft_kpt_out(jkpt)%ffnl_gather= & 1087 & bandfft_kpt_in(jkpt)%ffnl_gather 1088 end if 1089 if (allocated(bandfft_kpt_in(jkpt)%kinpw_gather)) then 1090 sz1=size(bandfft_kpt_in(jkpt)%kinpw_gather) 1091 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%kinpw_gather,(sz1)) 1092 bandfft_kpt_out(jkpt)%kinpw_gather= & 1093 & bandfft_kpt_in(jkpt)%kinpw_gather 1094 end if 1095 if (allocated(bandfft_kpt_in(jkpt)%ph3d_gather)) then 1096 sz1=size(bandfft_kpt_in(jkpt)%ph3d_gather,1) 1097 sz2=size(bandfft_kpt_in(jkpt)%ph3d_gather,2) 1098 sz3=size(bandfft_kpt_in(jkpt)%ph3d_gather,3) 1099 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%ph3d_gather,(sz1,sz2,sz3)) 1100 bandfft_kpt_out(jkpt)%ph3d_gather= & 1101 & bandfft_kpt_in(jkpt)%ph3d_gather 1102 end if 1103 if (allocated(bandfft_kpt_in(jkpt)%kpg_k_gather)) then 1104 sz1=size(bandfft_kpt_in(jkpt)%kpg_k_gather,1) 1105 sz2=size(bandfft_kpt_in(jkpt)%kpg_k_gather,2) 1106 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%kpg_k_gather,(sz1,sz2)) 1107 bandfft_kpt_out(jkpt)%kpg_k_gather= & 1108 & bandfft_kpt_in(jkpt)%kpg_k_gather 1109 end if 1110 bandfft_kpt_out(jkpt)%flag3_is_allocated=bandfft_kpt_in(jkpt)%flag3_is_allocated 1111 if (allocated(bandfft_kpt_in(jkpt)%kg_k_gather_sym)) then 1112 sz1=size(bandfft_kpt_in(jkpt)%kg_k_gather_sym,1) 1113 sz2=size(bandfft_kpt_in(jkpt)%kg_k_gather_sym,2) 1114 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%kg_k_gather_sym,(sz1,sz2)) 1115 bandfft_kpt_out(jkpt)%kg_k_gather_sym= & 1116 & bandfft_kpt_in(jkpt)%kg_k_gather_sym 1117 end if 1118 if (allocated(bandfft_kpt_in(jkpt)%rdispls_sym)) then 1119 sz1=size(bandfft_kpt_in(jkpt)%rdispls_sym) 1120 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%rdispls_sym,(sz1)) 1121 bandfft_kpt_out(jkpt)%rdispls_sym= & 1122 & bandfft_kpt_in(jkpt)%rdispls_sym 1123 end if 1124 if (allocated(bandfft_kpt_in(jkpt)%recvcounts_sym)) then 1125 sz1=size(bandfft_kpt_in(jkpt)%recvcounts_sym) 1126 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%recvcounts_sym,(sz1)) 1127 bandfft_kpt_out(jkpt)%recvcounts_sym= & 1128 & bandfft_kpt_in(jkpt)%recvcounts_sym 1129 end if 1130 if (allocated(bandfft_kpt_in(jkpt)%recvcounts_sym_tot)) then 1131 sz1=size(bandfft_kpt_in(jkpt)%recvcounts_sym_tot) 1132 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%recvcounts_sym_tot,(sz1)) 1133 bandfft_kpt_out(jkpt)%recvcounts_sym_tot= & 1134 & bandfft_kpt_in(jkpt)%recvcounts_sym_tot 1135 end if 1136 if (allocated(bandfft_kpt_in(jkpt)%sdispls_sym)) then 1137 sz1=size(bandfft_kpt_in(jkpt)%sdispls_sym) 1138 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%sdispls_sym,(sz1)) 1139 bandfft_kpt_out(jkpt)%sdispls_sym= & 1140 & bandfft_kpt_in(jkpt)%sdispls_sym 1141 end if 1142 if (allocated(bandfft_kpt_in(jkpt)%sendcounts_sym)) then 1143 sz1=size(bandfft_kpt_in(jkpt)%sendcounts_sym) 1144 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%sendcounts_sym,(sz1)) 1145 bandfft_kpt_out(jkpt)%sendcounts_sym= & 1146 & bandfft_kpt_in(jkpt)%sendcounts_sym 1147 end if 1148 if (allocated(bandfft_kpt_in(jkpt)%sendcounts_sym_all)) then 1149 sz1=size(bandfft_kpt_in(jkpt)%sendcounts_sym_all) 1150 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%sendcounts_sym_all,(sz1)) 1151 bandfft_kpt_out(jkpt)%sendcounts_sym_all= & 1152 & bandfft_kpt_in(jkpt)%sendcounts_sym_all 1153 end if 1154 if (allocated(bandfft_kpt_in(jkpt)%tab_proc)) then 1155 sz1=size(bandfft_kpt_in(jkpt)%tab_proc) 1156 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%tab_proc,(sz1)) 1157 bandfft_kpt_out(jkpt)%tab_proc= & 1158 bandfft_kpt_in(jkpt)%tab_proc 1159 end if 1160 if (bandfft_kpt_in(jkpt)%have_to_reequilibrate) then 1161 bandfft_kpt_out(jkpt)%have_to_reequilibrate = .true. 1162 bandfft_kpt_out(jkpt)%npw_fft = bandfft_kpt_in(jkpt)%npw_fft 1163 sz1=size(bandfft_kpt_in(jkpt)%indices_pw_fft) 1164 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%indices_pw_fft,(sz1)) 1165 bandfft_kpt_out(jkpt)%indices_pw_fft=bandfft_kpt_in(jkpt)%indices_pw_fft 1166 sz1=size(bandfft_kpt_in(jkpt)%sendcount_fft) 1167 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%sendcount_fft,(sz1)) 1168 bandfft_kpt_out(jkpt)%sendcount_fft=bandfft_kpt_in(jkpt)%sendcount_fft 1169 sz1=size(bandfft_kpt_in(jkpt)%senddisp_fft) 1170 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%senddisp_fft,(sz1)) 1171 bandfft_kpt_out(jkpt)%senddisp_fft=bandfft_kpt_in(jkpt)%senddisp_fft 1172 sz1=size(bandfft_kpt_in(jkpt)%recvcount_fft) 1173 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%recvcount_fft,(sz1)) 1174 bandfft_kpt_out(jkpt)%recvcount_fft=bandfft_kpt_in(jkpt)%recvcount_fft 1175 sz1=size(bandfft_kpt_in(jkpt)%recvdisp_fft) 1176 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%recvdisp_fft,(sz1)) 1177 bandfft_kpt_out(jkpt)%recvdisp_fft=bandfft_kpt_in(jkpt)%recvdisp_fft 1178 sz1=size(bandfft_kpt_in(jkpt)%kg_k_fft,1) 1179 sz2=size(bandfft_kpt_in(jkpt)%kg_k_fft,2) 1180 ABI_ALLOCATE(bandfft_kpt_out(jkpt)%kg_k_fft,(sz1,sz2)) 1181 bandfft_kpt_out(jkpt)%kg_k_fft=bandfft_kpt_in(jkpt)%kg_k_fft 1182 end if 1183 end do 1184 end do 1185 end if 1186 end if 1187 1188 end subroutine bandfft_kpt_copy
m_bandfft_kpt/bandfft_kpt_destroy [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_destroy
FUNCTION
Destroy a bandfft_kpt datastructure
INPUTS
OUTPUT
SIDE EFFECTS
bandfft_kpt_in=the datastructure to destroy
PARENTS
m_bandfft_kpt,posdoppler
CHILDREN
SOURCE
802 subroutine bandfft_kpt_destroy(bandfft_kpt_in) 803 804 805 !This section has been created automatically by the script Abilint (TD). 806 !Do not modify the following lines by hand. 807 #undef ABI_FUNC 808 #define ABI_FUNC 'bandfft_kpt_destroy' 809 !End of the abilint section 810 811 implicit none 812 813 !Arguments ------------------------------------ 814 type(bandfft_kpt_type) :: bandfft_kpt_in 815 !Local variables------------------------------- 816 817 ! *********************************************************************** 818 819 bandfft_kpt_in%flag1_is_allocated=0 820 bandfft_kpt_in%flag2_is_allocated=0 821 bandfft_kpt_in%flag3_is_allocated=0 822 bandfft_kpt_in%have_to_reequilibrate=.false. 823 824 if (allocated(bandfft_kpt_in%kg_k_gather)) then 825 ABI_DEALLOCATE(bandfft_kpt_in%kg_k_gather) 826 end if 827 if (allocated(bandfft_kpt_in%gbound)) then 828 ABI_DEALLOCATE(bandfft_kpt_in%gbound) 829 end if 830 if (allocated(bandfft_kpt_in%recvcounts)) then 831 ABI_DEALLOCATE(bandfft_kpt_in%recvcounts) 832 end if 833 if (allocated(bandfft_kpt_in%sendcounts)) then 834 ABI_DEALLOCATE(bandfft_kpt_in%sendcounts) 835 end if 836 if (allocated(bandfft_kpt_in%rdispls)) then 837 ABI_DEALLOCATE(bandfft_kpt_in%rdispls) 838 end if 839 if (allocated(bandfft_kpt_in%sdispls)) then 840 ABI_DEALLOCATE(bandfft_kpt_in%sdispls) 841 end if 842 if (allocated(bandfft_kpt_in%ffnl_gather)) then 843 ABI_DEALLOCATE(bandfft_kpt_in%ffnl_gather) 844 end if 845 if (allocated(bandfft_kpt_in%kinpw_gather)) then 846 ABI_DEALLOCATE(bandfft_kpt_in%kinpw_gather) 847 end if 848 if (allocated(bandfft_kpt_in%kpg_k_gather)) then 849 ABI_DEALLOCATE(bandfft_kpt_in%kpg_k_gather) 850 end if 851 if (allocated(bandfft_kpt_in%ph3d_gather)) then 852 ABI_DEALLOCATE(bandfft_kpt_in%ph3d_gather) 853 end if 854 if (allocated(bandfft_kpt_in%kg_k_gather_sym)) then 855 ABI_DEALLOCATE(bandfft_kpt_in%kg_k_gather_sym) 856 end if 857 if (allocated(bandfft_kpt_in%rdispls_sym)) then 858 ABI_DEALLOCATE(bandfft_kpt_in%rdispls_sym) 859 end if 860 if (allocated(bandfft_kpt_in%recvcounts_sym)) then 861 ABI_DEALLOCATE(bandfft_kpt_in%recvcounts_sym) 862 end if 863 if (allocated(bandfft_kpt_in%recvcounts_sym_tot)) then 864 ABI_DEALLOCATE(bandfft_kpt_in%recvcounts_sym_tot) 865 end if 866 if (allocated(bandfft_kpt_in%sdispls_sym)) then 867 ABI_DEALLOCATE(bandfft_kpt_in%sdispls_sym) 868 end if 869 if (allocated(bandfft_kpt_in%sendcounts_sym)) then 870 ABI_DEALLOCATE(bandfft_kpt_in%sendcounts_sym) 871 end if 872 if (allocated(bandfft_kpt_in%sendcounts_sym_all)) then 873 ABI_DEALLOCATE(bandfft_kpt_in%sendcounts_sym_all) 874 end if 875 if (allocated(bandfft_kpt_in%tab_proc)) then 876 ABI_DEALLOCATE(bandfft_kpt_in%tab_proc) 877 end if 878 if (allocated(bandfft_kpt_in%indices_pw_fft)) then 879 ABI_DEALLOCATE(bandfft_kpt_in%indices_pw_fft) 880 end if 881 if (allocated(bandfft_kpt_in%sendcount_fft)) then 882 ABI_DEALLOCATE(bandfft_kpt_in%sendcount_fft) 883 end if 884 if (allocated(bandfft_kpt_in%senddisp_fft)) then 885 ABI_DEALLOCATE(bandfft_kpt_in%senddisp_fft) 886 end if 887 if (allocated(bandfft_kpt_in%recvcount_fft)) then 888 ABI_DEALLOCATE(bandfft_kpt_in%recvcount_fft) 889 end if 890 if (allocated(bandfft_kpt_in%recvdisp_fft)) then 891 ABI_DEALLOCATE(bandfft_kpt_in%recvdisp_fft) 892 end if 893 if (allocated(bandfft_kpt_in%kg_k_fft)) then 894 ABI_DEALLOCATE(bandfft_kpt_in%kg_k_fft) 895 end if 896 897 end subroutine bandfft_kpt_destroy
m_bandfft_kpt/bandfft_kpt_destroy_array [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_destroy_array
FUNCTION
Clean and destroy an array of bandfft_kpt datastructures
INPUTS
OUTPUT
SIDE EFFECTS
bandfft_kpt_in(:)=the array of datastructure to destroy
PARENTS
gstate,gwls_hamiltonian
CHILDREN
SOURCE
924 subroutine bandfft_kpt_destroy_array(bandfft_kpt_in,mpi_enreg) 925 926 927 !This section has been created automatically by the script Abilint (TD). 928 !Do not modify the following lines by hand. 929 #undef ABI_FUNC 930 #define ABI_FUNC 'bandfft_kpt_destroy_array' 931 !End of the abilint section 932 933 implicit none 934 935 !Arguments ------------------------------------ 936 type(bandfft_kpt_type),pointer :: bandfft_kpt_in(:) 937 type(MPI_type), intent(inout) :: mpi_enreg 938 939 !Local variables------------------------------- 940 integer :: ikpt_this_proc,isppol,ikpt,mkmem,nband,nkpt,nsppol 941 character(len=500) :: msg 942 943 ! *********************************************************************** 944 945 if (xmpi_paral==0) return 946 947 if (associated(bandfft_kpt_in)) then 948 mkmem =size(bandfft_kpt_in) 949 nkpt=size(mpi_enreg%proc_distrb,1) 950 nband=size(mpi_enreg%proc_distrb,2) 951 nsppol=size(mpi_enreg%proc_distrb,3) 952 if (nsppol==0.or.nkpt==0) then 953 msg=' mpi_enreg%proc_distrb should be allocated !' 954 MSG_BUG(msg) 955 end if 956 nkpt=size(mpi_enreg%my_kpttab) 957 if (nkpt==0) then 958 msg=' mpi_enreg%my_kpttab should be allocated !' 959 MSG_BUG(msg) 960 end if 961 do isppol=1,nsppol 962 do ikpt=1,nkpt 963 if(proc_distrb_cycle(mpi_enreg%proc_distrb,ikpt,1,nband,isppol,mpi_enreg%me_kpt)) cycle 964 ikpt_this_proc=mpi_enreg%my_kpttab(ikpt) 965 if ((ikpt_this_proc>mkmem) .or.(ikpt_this_proc<=0)) then 966 msg=' The bandfft tab cannot be deallocated !' 967 MSG_BUG(msg) 968 end if 969 call bandfft_kpt_destroy(bandfft_kpt_in(ikpt_this_proc)) 970 end do 971 end do 972 ABI_DATATYPE_DEALLOCATE(bandfft_kpt_in) 973 nullify(bandfft_kpt_in) 974 end if 975 976 end subroutine bandfft_kpt_destroy_array
m_bandfft_kpt/bandfft_kpt_get_ikpt [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_get_ikpt
FUNCTION
Get the value of bandfft_kpt_current_ikpt variable,
i.e. current index of bandfft_kpt loaded in memory
INPUT
OUTPUT
bandfft_kpt_get_ikpt= current index of bandfft_kpt
PARENTS
apply_invovl,chebfi,getghc,make_invovl,prep_fourwf prep_getghc,prep_nonlop
CHILDREN
SOURCE
2127 function bandfft_kpt_get_ikpt() 2128 2129 2130 !This section has been created automatically by the script Abilint (TD). 2131 !Do not modify the following lines by hand. 2132 #undef ABI_FUNC 2133 #define ABI_FUNC 'bandfft_kpt_get_ikpt' 2134 !End of the abilint section 2135 2136 implicit none 2137 2138 !Arguments ------------------------------- 2139 integer :: bandfft_kpt_get_ikpt 2140 !Local variables------------------------------- 2141 2142 ! ********************************************************************* 2143 2144 bandfft_kpt_get_ikpt=bandfft_kpt_current_ikpt 2145 2146 end function bandfft_kpt_get_ikpt
m_bandfft_kpt/bandfft_kpt_init1 [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_init1
FUNCTION
Init all (or part of) scalars and pointers in a bandfft_kpt datastructure
INPUTS
istwfk(nkpt) = input option parameter that describes the storage of wfs kg(3,mpw*mkmem) = dimensionless coords of G vecs in basis sphere at k point mgfft = maximum single fft dimension (IN) mkmem = number of k points which can fit in memory; set to 0 if use disk mpi_enreg = information about MPI parallelization mpw = maximum number of planewaves as dimensioned in calling routine nband(nkpt*nsppol) = number of bands at each k point nkpt = number of k points npwarr(nkpt) = array holding npw for each k point, taking into account the effect of istwfk, and the spreading over processors nsppol = 1 for unpolarized, 2 for polarized
OUTPUT
within the bandfft_kpt data_type : Initialize and compute gbound = sphere boundary info idatarecv0 = position of the planewave coordinates (0,0,0) istwf_k = input option parameter that describes the storage of wfs kg_k_gather = planewave coordinates (of the processor + sended by other processors band) kg_k_gather_sym = planewave coordinates (kg_k_gather + opposited planewave coordinates sended by the processors fft) ndatarecv = total number of values received by the processor and sended by the other processors band ndatasend_sym = number of sended values to the processors fft to create opposited planewave coordinates ndatarecv_tot = total number of received values by the processor (ndatarecv + number of received opposited planewave coordinates) recvcounts = number of values received by the processor from each processor band recvcounts_sym = number of values received by the processor from each processor fft recvcounts_sym_tot = number of values received by each processor from the other processors fft rdispls = positions of values received by the processor from each processor band rdispls_sym = positions of values received by the processor from each processor fft sendcounts = number of values sended by the processor to each processor band sendcounts_sym = number of values sended by the processor to each processor fft sendcounts_sym_all = number of values sended by each processor to the other processors fft sdispls = postions of values sended by the processor to each processor band sdispls_sym = postions of values sended by the processor to each processor fft tab_proc = positions of opposited planewave coordinates in the list of the processors fft
SIDE EFFECTS
bandfft_kpt_in=<type(bandfft_kpt)>=bandfft_kpt datastructure
PARENTS
gstate
CHILDREN
SOURCE
204 subroutine bandfft_kpt_init1(bandfft_kpt_in,istwfk,kg,mgfft,mkmem,mpi_enreg,mpw,nband,nkpt,npwarr,nsppol) 205 206 207 !This section has been created automatically by the script Abilint (TD). 208 !Do not modify the following lines by hand. 209 #undef ABI_FUNC 210 #define ABI_FUNC 'bandfft_kpt_init1' 211 !End of the abilint section 212 213 implicit none 214 215 !Arguments ------------------------------------ 216 !scalars 217 integer,intent(in) :: mgfft,mkmem,mpw,nkpt,nsppol 218 type(bandfft_kpt_type),pointer :: bandfft_kpt_in(:) 219 type(MPI_type),intent(inout) :: mpi_enreg 220 !arrays 221 integer,intent(in) :: istwfk(nkpt),nband(nkpt*nsppol) 222 integer,intent(in) :: kg(3,mpw*mkmem),npwarr(nkpt) 223 224 !Local variables------------------------------- 225 !scalars 226 integer :: comm_band,comm_fft,idatarecv,idatarecv0,ierr,ikg,ikpt,ikpt_this_proc,iproc,isppol,istwf_k,itest,jsendloc 227 integer :: me_fft,me_kpt,n2,nband_k,ndatarecv,ndatarecv_tot,ndatasend_sym,nproc_band,nproc_fft,npw_fft,npw_k,npw_tot 228 logical :: reequilibrate_allocated 229 character(len=500) :: message 230 !arrays 231 integer,allocatable :: buff_kg(:,:),gbound(:,:),indices_pw_fft(:),kg_k(:,:),kg_k_fft(:,:),kg_k_gather(:,:) 232 integer,allocatable :: kg_k_gather_all(:,:),kg_k_gather_send(:,:),kg_k_gather_sym(:,:) 233 integer,allocatable :: npw_per_proc(:) 234 integer,allocatable :: rdispls(:),rdispls_all(:),rdispls_sym(:),rdispls_sym_loc(:) 235 integer,allocatable :: recvcounts(:),recvcounts_sym(:),recvcounts_fft(:),recvcounts_sym_loc(:),recvcounts_sym_tot(:) 236 integer,allocatable :: recvdisp_fft(:),sdispls(:),sdispls_sym_loc(:),sdispls_sym(:) 237 integer,allocatable :: sendcounts(:),sendcounts_fft(:),sendcounts_sym(:),sendcounts_sym_all(:),sendcounts_sym_loc(:) 238 integer,allocatable :: senddisp_fft(:),sum_kg(:),tab_proc(:) 239 240 ! ********************************************************************* 241 242 If(mpi_enreg%paral_kgb/=1) then 243 nullify(bandfft_kpt_in) 244 return 245 end if 246 247 !--------------------------------------------- 248 !Initialisation 249 !--------------------------------------------- 250 nproc_fft = mpi_enreg%nproc_fft 251 nproc_band = mpi_enreg%nproc_band 252 253 me_fft = mpi_enreg%me_fft 254 me_kpt = mpi_enreg%me_kpt 255 256 comm_band = mpi_enreg%comm_band 257 comm_fft = mpi_enreg%comm_fft 258 259 !============================================================================= 260 !Compute and store various tabs in bandfft_kpt(ikpt) data_struc 261 !These ones will be used in following subroutines: 262 !vtorho, mkrho, prep_nonlop, prep_fourwf, prep_getghc... 263 !============================================================================= 264 265 ABI_DATATYPE_ALLOCATE(bandfft_kpt_in,(mkmem)) 266 267 ABI_ALLOCATE(sdispls ,(nproc_band)) 268 ABI_ALLOCATE(sendcounts ,(nproc_band)) 269 ABI_ALLOCATE(rdispls ,(nproc_band)) 270 ABI_ALLOCATE(recvcounts ,(nproc_band)) 271 ABI_ALLOCATE(sendcounts_fft,(nproc_fft)) 272 ABI_ALLOCATE(senddisp_fft ,(nproc_fft)) 273 ABI_ALLOCATE(recvcounts_fft,(nproc_fft)) 274 ABI_ALLOCATE(recvdisp_fft ,(nproc_fft)) 275 276 bandfft_kpt_in(:)%flag1_is_allocated=0 277 bandfft_kpt_in(:)%flag2_is_allocated=0 278 bandfft_kpt_in(:)%flag3_is_allocated=0 279 280 do isppol=1,nsppol 281 ikg=0 282 do ikpt=1,nkpt 283 npw_k=npwarr(ikpt) 284 istwf_k=istwfk(ikpt) 285 nband_k=nband(ikpt+(isppol-1)*nkpt) 286 if(proc_distrb_cycle(mpi_enreg%proc_distrb,ikpt,1,nband_k,isppol,me_kpt))cycle 287 ikpt_this_proc=mpi_enreg%my_kpttab(ikpt) 288 if ((ikpt_this_proc > mkmem).or.(ikpt_this_proc==0)) then 289 message = ' this bandfft tab is not allocated !' 290 MSG_ERROR(message) 291 end if 292 if (bandfft_kpt_in(ikpt_this_proc)%flag1_is_allocated==0) then 293 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%gbound ,(2*mgfft+8,2)) 294 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%recvcounts,(nproc_band)) 295 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%sendcounts,(nproc_band)) 296 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%rdispls ,(nproc_band)) 297 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%sdispls ,(nproc_band)) 298 bandfft_kpt_in(ikpt_this_proc)%flag1_is_allocated=1 299 end if 300 301 ! Initialize various quantities for the reequilibration step 302 reequilibrate_allocated=(isppol==2.and.bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate) 303 bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate = .false. 304 bandfft_kpt_in(ikpt_this_proc)%npw_fft = 0 305 306 call xmpi_allgather(npw_k,recvcounts,comm_band,ierr) 307 rdispls(1)=0 308 do iproc=2,nproc_band 309 rdispls(iproc)=rdispls(iproc-1)+recvcounts(iproc-1) 310 end do 311 ndatarecv=rdispls(nproc_band)+recvcounts(nproc_band) 312 313 ABI_ALLOCATE(kg_k_gather,(3,ndatarecv)) 314 ABI_ALLOCATE(kg_k,(3,npw_k)) 315 kg_k(:,1:npw_k)=kg(:,1+ikg:npw_k+ikg) 316 call xmpi_allgatherv(kg_k,3*npw_k,kg_k_gather,3*recvcounts(:),3*rdispls(:),comm_band,ierr) 317 318 sendcounts(:)=npw_k*mpi_enreg%bandpp 319 do iproc=1,nproc_band 320 sdispls(iproc)=(iproc-1)*npw_k*mpi_enreg%bandpp 321 end do 322 323 ! ============================================================================ 324 ! Here we compute gbound, as well for istwf_k=1 as for istwf_k=2 and store it 325 ! ============================================================================ 326 !MG: Why don't we compute gbound locally by just computing the full G-sphere from ecut 327 ABI_ALLOCATE(npw_per_proc,(nproc_fft)) 328 ABI_ALLOCATE(rdispls_all,(nproc_fft)) 329 ABI_ALLOCATE(gbound,(2*mgfft+8,2)) 330 if (mgfft>0) gbound(:,:)=0 331 if (istwf_k==1) then 332 call xmpi_allgather(ndatarecv,npw_per_proc,mpi_enreg%comm_fft,ierr) 333 rdispls_all(1)=0 334 do iproc=2,nproc_fft 335 rdispls_all(iproc)=rdispls_all(iproc-1)+npw_per_proc(iproc-1) 336 end do 337 npw_tot=rdispls_all(nproc_fft)+npw_per_proc(nproc_fft) 338 ABI_ALLOCATE(kg_k_gather_all,(3,npw_tot)) 339 call xmpi_allgatherv(kg_k_gather,& 340 & 3*ndatarecv,kg_k_gather_all,3*npw_per_proc(:),3*rdispls_all,mpi_enreg%comm_fft,ierr) 341 if (mgfft>0) then 342 call sphereboundary(gbound,istwf_k,kg_k_gather_all,mgfft,npw_tot) 343 end if 344 345 else if (istwf_k==2) then 346 347 ! ============================================================================ 348 ! In this case, we have to add the opposite values in the kg_k_gather tab 349 ! before computing gbound 350 ! ============================================================================ 351 352 ! Allocation 353 ABI_ALLOCATE(tab_proc ,(ndatarecv)) 354 ABI_ALLOCATE(sendcounts_sym ,(nproc_fft)) 355 ABI_ALLOCATE(sendcounts_sym_all,(nproc_fft*nproc_fft)) 356 ABI_ALLOCATE(sdispls_sym ,(nproc_fft)) 357 ABI_ALLOCATE(recvcounts_sym ,(nproc_fft)) 358 ABI_ALLOCATE(recvcounts_sym_tot,(nproc_fft)) 359 ABI_ALLOCATE(rdispls_sym ,(nproc_fft)) 360 ABI_ALLOCATE(sendcounts_sym_loc,(nproc_fft)) 361 ABI_ALLOCATE(sdispls_sym_loc ,(nproc_fft)) 362 ABI_ALLOCATE(recvcounts_sym_loc,(nproc_fft)) 363 ABI_ALLOCATE(rdispls_sym_loc ,(nproc_fft)) 364 365 ! Initialisation 366 tab_proc(:) = 0 367 sendcounts_sym(:) = 0 368 sendcounts_sym_all(:) = 0 369 sdispls_sym(:) = 0 370 recvcounts_sym(:) = 0 371 recvcounts_sym_tot(:) = 0 372 373 ! Localisation of kg_k==[0 0 0] 374 ABI_ALLOCATE(sum_kg,(ndatarecv)) 375 idatarecv0 = -1 376 ndatasend_sym = ndatarecv 377 sum_kg=sum(abs(kg_k_gather),1) 378 if (count(sum_kg==0)/=0) then 379 do idatarecv=1,ndatarecv 380 if (sum_kg(idatarecv)==0) idatarecv0=idatarecv 381 end do 382 ndatasend_sym = ndatarecv-1 383 end if 384 385 ! Localisation of the processor where the vector -k2 is 386 n2 = mpi_enreg%distribfft%n2_coarse 387 do idatarecv=1,ndatarecv 388 if (idatarecv/=idatarecv0) then 389 tab_proc(idatarecv) = mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(-kg_k_gather(2,idatarecv),n2) + 1) 390 else 391 tab_proc(idatarecv) = -1 392 end if 393 end do 394 395 ! Number of values send by the processor to the others 396 do iproc=1,nproc_fft 397 sendcounts_sym(iproc) = count(tab_proc(:)==(iproc-1)) 398 end do 399 400 ! Save sendcounts_sym for each processor in sendcounts_sym_all 401 ! knowed by all processors of comm_fft 402 rdispls_sym(1)=0 403 do iproc=2,nproc_fft 404 rdispls_sym(iproc)= nproc_fft*(iproc-1) 405 end do 406 recvcounts_sym(:)=nproc_fft 407 call xmpi_allgatherv(sendcounts_sym(:),nproc_fft,& 408 & sendcounts_sym_all(:),recvcounts_sym,rdispls_sym,comm_fft,ierr) 409 410 ! Calculation of the dimension of kg_k_gather_sym for each processor 411 ! recvcounts_sym_tot is knowed by all processors of comm_fft 412 call xmpi_sum(sendcounts_sym,recvcounts_sym_tot,nproc_fft,comm_fft,ierr) 413 414 ! Dimension of kg_k_gather_sym 415 ndatarecv_tot = ndatarecv+recvcounts_sym_tot(me_fft+1) 416 417 ! Intialize kg_k_gather_sym 418 ABI_ALLOCATE(kg_k_gather_sym,(3,ndatarecv_tot)) 419 kg_k_gather_sym(:,:)=0 420 kg_k_gather_sym(:,1:ndatarecv) = kg_k_gather(:,:) 421 422 ! Allocation and initialisation 423 ABI_ALLOCATE(kg_k_gather_send,(3,ndatasend_sym)) 424 kg_k_gather_send(:,:)=0 425 426 ! The values are sorted in blocks 427 jsendloc=0 428 do iproc=1,nproc_fft 429 430 ! Position of the beginning of the block 431 sdispls_sym(iproc)=jsendloc 432 433 ! Creation of the blocks 434 do idatarecv=1,ndatarecv 435 if (tab_proc(idatarecv)==(iproc-1)) then 436 jsendloc=jsendloc+1 437 kg_k_gather_send(:,jsendloc) = -kg_k_gather(:,idatarecv) 438 end if 439 end do 440 end do 441 442 ! Position of received data 443 rdispls_sym(1)= ndatarecv 444 recvcounts_sym(1)= sendcounts_sym_all((me_fft+1)) 445 do iproc=2,nproc_fft 446 rdispls_sym(iproc) = rdispls_sym(iproc-1) + & 447 sendcounts_sym_all((me_fft+1)+(iproc-2)*nproc_fft) 448 recvcounts_sym(iproc) = sendcounts_sym_all((me_fft+1)+(iproc-1)*nproc_fft) 449 end do 450 451 ! Exchange of kg_k 452 sendcounts_sym_loc = sendcounts_sym*3 453 sdispls_sym_loc = sdispls_sym *3 454 recvcounts_sym_loc = recvcounts_sym*3 455 rdispls_sym_loc = rdispls_sym *3 456 call xmpi_alltoallv(kg_k_gather_send(:,:),sendcounts_sym_loc,sdispls_sym_loc,& 457 & kg_k_gather_sym(:,:) ,recvcounts_sym_loc,rdispls_sym_loc,comm_fft,ierr) 458 459 ! Store the following data in the bandfft_kpt_in data_struc 460 ikpt_this_proc=mpi_enreg%my_kpttab(ikpt) 461 if (bandfft_kpt_in(ikpt_this_proc)%flag3_is_allocated==0) then 462 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather_sym,(3,ndatarecv_tot)) 463 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%rdispls_sym,(nproc_fft)) 464 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym,(nproc_fft)) 465 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym_tot,(nproc_fft)) 466 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%sdispls_sym,(nproc_fft)) 467 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym,(nproc_fft)) 468 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym_all,(nproc_fft*nproc_fft)) 469 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%tab_proc,(ndatarecv)) 470 bandfft_kpt_in(ikpt_this_proc)%flag3_is_allocated=1 471 end if 472 473 bandfft_kpt_in(ikpt_this_proc)%idatarecv0 =idatarecv0 474 bandfft_kpt_in(ikpt_this_proc)%ndatarecv_tot =ndatarecv_tot 475 bandfft_kpt_in(ikpt_this_proc)%ndatasend_sym =ndatasend_sym 476 bandfft_kpt_in(ikpt_this_proc)%kg_k_gather_sym(:,:) =kg_k_gather_sym(:,:) 477 bandfft_kpt_in(ikpt_this_proc)%rdispls_sym(:) =rdispls_sym(:) 478 bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym(:) =recvcounts_sym(:) 479 bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym_tot(:)=recvcounts_sym_tot(:) 480 bandfft_kpt_in(ikpt_this_proc)%sdispls_sym(:) =sdispls_sym(:) 481 bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym(:) =sendcounts_sym(:) 482 bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym_all(:)=sendcounts_sym_all(:) 483 bandfft_kpt_in(ikpt_this_proc)%tab_proc(:) =tab_proc(:) 484 485 ABI_DEALLOCATE(tab_proc) 486 ABI_DEALLOCATE(sendcounts_sym) 487 ABI_DEALLOCATE(sendcounts_sym_all) 488 ABI_DEALLOCATE(sdispls_sym) 489 ABI_DEALLOCATE(recvcounts_sym) 490 ABI_DEALLOCATE(recvcounts_sym_tot) 491 ABI_DEALLOCATE(rdispls_sym) 492 ABI_DEALLOCATE(kg_k_gather_sym) 493 ABI_DEALLOCATE(sendcounts_sym_loc) 494 ABI_DEALLOCATE(recvcounts_sym_loc) 495 ABI_DEALLOCATE(sdispls_sym_loc) 496 ABI_DEALLOCATE(rdispls_sym_loc) 497 ABI_DEALLOCATE(kg_k_gather_send) 498 ABI_DEALLOCATE(sum_kg) 499 500 ! Then compute gbound 501 call xmpi_allgather(ndatarecv_tot,npw_per_proc,mpi_enreg%comm_fft,ierr) 502 rdispls_all(1)=0 503 do iproc=2,nproc_fft 504 rdispls_all(iproc)=rdispls_all(iproc-1)+npw_per_proc(iproc-1) 505 end do 506 npw_tot=rdispls_all(nproc_fft)+npw_per_proc(nproc_fft) 507 ABI_ALLOCATE(kg_k_gather_all,(3,npw_tot)) 508 call xmpi_allgatherv(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather_sym,& 509 & 3*ndatarecv_tot,kg_k_gather_all,3*npw_per_proc(:),3*rdispls_all,mpi_enreg%comm_fft,ierr) 510 if (mgfft>0) then 511 call sphereboundary(gbound,istwf_k,kg_k_gather_all,mgfft,npw_tot) 512 end if 513 514 ! Only calculations with istwfk=1 or 2 515 else 516 write(message, '(a,i0,a)' )' the value istwfk=',istwf_k,' is not allowed in case of bandfft parallelization!' 517 MSG_BUG(message) 518 end if 519 ABI_DEALLOCATE(kg_k_gather_all) 520 ABI_DEALLOCATE(npw_per_proc) 521 ABI_DEALLOCATE(rdispls_all) 522 ! ============================================================================ 523 ! End of gbound 524 ! ============================================================================ 525 526 ! Check if there is k_G vectors have been redistributed (after unbalancing dectecion) 527 ! Note that FFT load balancing is directly related to unbalancing detection 528 ! made in kpgsph routine. 529 itest=0 ; n2 = mpi_enreg%distribfft%n2_coarse 530 do idatarecv=1,ndatarecv 531 iproc=mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(kg_k_gather(2,idatarecv),n2)+1) 532 if (iproc/=me_fft) itest=itest+1 533 end do 534 call xmpi_sum(itest,mpi_enreg%comm_fft,ierr) 535 if (itest>0) then 536 write(message, '(a,i4,3a)' ) & 537 & 'There is a load unbalancing for the FFT parallelization (kpt',ikpt,').',ch10,& 538 & 'Plane-wave components will be redistributed before each FFT!' 539 MSG_COMMENT(message) 540 end if 541 bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate=(itest>0) 542 543 ! If yes, store relevant data 544 if(bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate) then 545 n2 = mpi_enreg%distribfft%n2_coarse 546 sendcounts_fft(:) = 0 547 recvcounts_fft(:) = 0 548 senddisp_fft(:) = 0 549 recvdisp_fft(:) = 0 550 do idatarecv = 1 ,ndatarecv 551 iproc = mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(kg_k_gather(2,idatarecv),n2) + 1) 552 sendcounts_fft(iproc + 1) = sendcounts_fft(iproc + 1) + 1 553 end do 554 call xmpi_alltoall(sendcounts_fft,1,recvcounts_fft,1,mpi_enreg%comm_fft,ierr) 555 do iproc =2, nproc_fft 556 senddisp_fft(iproc) = senddisp_fft(iproc - 1) + sendcounts_fft(iproc-1) 557 recvdisp_fft(iproc) = recvdisp_fft(iproc - 1) + recvcounts_fft(iproc-1) 558 end do 559 npw_fft = recvdisp_fft(nproc_fft) + recvcounts_fft(nproc_fft) ! nb plane wave for fourwf call 560 ABI_ALLOCATE(buff_kg,(3,ndatarecv)) ! for sorting kg_k 561 ABI_ALLOCATE(kg_k_fft,(3,npw_fft)) 562 ABI_ALLOCATE(indices_pw_fft,(ndatarecv)) 563 !filling of sorted send buffers 564 sendcounts_fft(:) = 0 565 do idatarecv = 1 ,ndatarecv 566 iproc = mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(kg_k_gather(2,idatarecv),n2) + 1) 567 sendcounts_fft(iproc + 1) = sendcounts_fft(iproc + 1) + 1 568 indices_pw_fft(idatarecv) = senddisp_fft(iproc+1) + sendcounts_fft(iproc+1) 569 buff_kg(1:3,indices_pw_fft(idatarecv)) = kg_k_gather(1:3,idatarecv) 570 end do 571 572 call xmpi_alltoallv(buff_kg, 3*sendcounts_fft, 3*senddisp_fft, & 573 & kg_k_fft,3*recvcounts_fft, 3*recvdisp_fft, mpi_enreg%comm_fft,ierr) 574 575 if (.not.reequilibrate_allocated) then 576 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kg_k_fft, (3,npw_fft) ) 577 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%indices_pw_fft, (ndatarecv)) 578 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%sendcount_fft, (nproc_fft)) 579 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%senddisp_fft, (nproc_fft)) 580 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%recvcount_fft, (nproc_fft)) 581 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%recvdisp_fft, (nproc_fft)) 582 end if 583 bandfft_kpt_in(ikpt_this_proc)%npw_fft = npw_fft 584 bandfft_kpt_in(ikpt_this_proc)%indices_pw_fft(:) = indices_pw_fft(:) 585 bandfft_kpt_in(ikpt_this_proc)%sendcount_fft (:) = sendcounts_fft (:) 586 bandfft_kpt_in(ikpt_this_proc)%senddisp_fft(:) = senddisp_fft(:) 587 bandfft_kpt_in(ikpt_this_proc)%recvcount_fft(:) = recvcounts_fft(:) 588 bandfft_kpt_in(ikpt_this_proc)%recvdisp_fft(:) = recvdisp_fft(:) 589 bandfft_kpt_in(ikpt_this_proc)%kg_k_fft(:,:) = kg_k_fft(:,:) 590 ABI_DEALLOCATE(buff_kg ) 591 ABI_DEALLOCATE(kg_k_fft) 592 ABI_DEALLOCATE(indices_pw_fft) 593 end if 594 595 ! Tabs which are common to istwf_k=1 and 2 596 if (.not. allocated(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather)) then 597 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather,(3,ndatarecv)) 598 end if 599 bandfft_kpt_in(ikpt_this_proc)%recvcounts(:) =recvcounts(:) 600 bandfft_kpt_in(ikpt_this_proc)%sendcounts(:) =sendcounts(:) 601 bandfft_kpt_in(ikpt_this_proc)%rdispls(:) =rdispls(:) 602 bandfft_kpt_in(ikpt_this_proc)%sdispls(:) =sdispls(:) 603 bandfft_kpt_in(ikpt_this_proc)%gbound(:,:) =gbound(:,:) 604 bandfft_kpt_in(ikpt_this_proc)%kg_k_gather(:,:)=kg_k_gather(:,:) 605 bandfft_kpt_in(ikpt_this_proc)%ndatarecv =ndatarecv 606 bandfft_kpt_in(ikpt_this_proc)%istwf_k =istwf_k 607 bandfft_kpt_in(ikpt_this_proc)%npw_tot =npw_tot 608 ABI_DEALLOCATE(kg_k_gather) 609 ABI_DEALLOCATE(kg_k) 610 ABI_DEALLOCATE(gbound) 611 612 ikg=ikg+npw_k 613 end do 614 end do 615 ABI_DEALLOCATE(recvcounts) 616 ABI_DEALLOCATE(sendcounts) 617 ABI_DEALLOCATE(rdispls) 618 ABI_DEALLOCATE(sdispls) 619 ABI_DEALLOCATE(sendcounts_fft) 620 ABI_DEALLOCATE(senddisp_fft) 621 ABI_DEALLOCATE(recvcounts_fft) 622 ABI_DEALLOCATE(recvdisp_fft) 623 624 !============================================================================= 625 !End of computation and storage of the bandfft_kpt(ikpt) data_struc 626 !============================================================================= 627 628 end subroutine bandfft_kpt_init1
m_bandfft_kpt/bandfft_kpt_init2 [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_init2
FUNCTION
Init part of scalars and pointers in a bandfft_kpt datastructure
INPUTS
dimffnl=second dimension of ffnl (1+number of derivatives) ffnl_gather(ndatarecv,dimffnl,lmnmax,ntypat)=nonlocal form factors on basis sphere. kinpw_gather(:)=(modified) kinetic energy for each plane wave (Hartree) kpg_k_gather(ndatarecv,nkpg)=k+G vector for a given k point lmnmax=if useylm=1, max number of (l,m,n) comp. over all type of psps =if useylm=0, max number of (l,n) comp. over all type of psps matblk=dimension of the array ph3d mkmem =number of k points which can fit in memory; set to 0 if use disk ndatarecv= dimension of the arrays nkpg=second dimension of kpg_k (0 if useylm=0) ntypat=number of types of atoms in unit cell. ph3d_gather(2,ndatarecv,matblk)=3-dim structure factors, for each atom and plane wave.
OUTPUT
SIDE EFFECTS
PARENTS
prep_bandfft_tabs
CHILDREN
SOURCE
665 subroutine bandfft_kpt_init2(bandfft_kpt_in,dimffnl,ffnl_gather,ikpt_this_proc,kinpw_gather,& 666 & kpg_k_gather,lmnmax,matblk,mkmem,ndatarecv,nkpg,ntypat,ph3d_gather) 667 668 669 !This section has been created automatically by the script Abilint (TD). 670 !Do not modify the following lines by hand. 671 #undef ABI_FUNC 672 #define ABI_FUNC 'bandfft_kpt_init2' 673 !End of the abilint section 674 675 implicit none 676 677 !Arguments ------------------------------- 678 integer, intent(in) :: dimffnl,ikpt_this_proc,lmnmax,matblk,mkmem,ndatarecv,nkpg,ntypat 679 !Local variables------------------------------- 680 real(dp),intent(in) :: ffnl_gather(:,:,:,:),kinpw_gather(:) 681 real(dp),intent(in) :: kpg_k_gather(:,:),ph3d_gather(:,:,:) 682 type(bandfft_kpt_type), intent(inout) :: bandfft_kpt_in (mkmem) 683 684 ! ********************************************************************* 685 686 if (allocated(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather)) then 687 ABI_DEALLOCATE(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather) 688 end if 689 if (size(ffnl_gather)>0) then 690 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather,(ndatarecv,dimffnl,lmnmax,ntypat)) 691 bandfft_kpt_in(ikpt_this_proc)%ffnl_gather(:,:,:,:)=ffnl_gather(:,:,:,:) 692 else 693 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather,(0,0,0,0)) 694 end if 695 696 if (allocated(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather)) then 697 ABI_DEALLOCATE(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather) 698 end if 699 if (size(ph3d_gather)>0) then 700 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather,(2,ndatarecv,matblk)) 701 bandfft_kpt_in(ikpt_this_proc)%ph3d_gather(:,:,:) =ph3d_gather(:,:,:) 702 else 703 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather,(0,0,0)) 704 end if 705 706 if (allocated(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather)) then 707 ABI_DEALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather) 708 end if 709 if (size(kpg_k_gather)>0) then 710 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather,(ndatarecv,nkpg)) 711 bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather(:,:) =kpg_k_gather(:,:) 712 else 713 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather,(0,0)) 714 end if 715 716 if (allocated(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather)) then 717 ABI_DEALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather) 718 end if 719 if (size(kinpw_gather)>0) then 720 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(ndatarecv)) 721 bandfft_kpt_in(ikpt_this_proc)%kinpw_gather(:) =kinpw_gather(:) 722 else 723 ABI_ALLOCATE(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(0)) 724 end if 725 726 bandfft_kpt_in(ikpt_this_proc)%flag2_is_allocated=1 727 728 end subroutine bandfft_kpt_init2
m_bandfft_kpt/bandfft_kpt_reset [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_reset
FUNCTION
Reset flags a bandfft_kpt datastructure
INPUTS
OUTPUT
SIDE EFFECTS
bandfft_kpt_in=the datastructure to nullify
PARENTS
posdoppler
CHILDREN
SOURCE
754 subroutine bandfft_kpt_reset(bandfft_kpt_in) 755 756 757 !This section has been created automatically by the script Abilint (TD). 758 !Do not modify the following lines by hand. 759 #undef ABI_FUNC 760 #define ABI_FUNC 'bandfft_kpt_reset' 761 !End of the abilint section 762 763 implicit none 764 765 !Arguments ------------------------------------ 766 type(bandfft_kpt_type) :: bandfft_kpt_in 767 !Local variables------------------------------- 768 769 ! *********************************************************************** 770 771 bandfft_kpt_in%flag1_is_allocated=0 772 bandfft_kpt_in%flag2_is_allocated=0 773 bandfft_kpt_in%flag3_is_allocated=0 774 bandfft_kpt_in%have_to_reequilibrate=.false. 775 776 end subroutine bandfft_kpt_reset
m_bandfft_kpt/bandfft_kpt_restoretabs [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_restoretabs
FUNCTION
Restore some (kpt-dependent) tabs into a bandfft_kpt datastructure INPUT
OUTPUT
=== Arrays to be eventually restored ===== ffnl(:,:,:,:)=nonlocal form factors on basis sphere ph3d(:,:,:)=3-dim structure factors, for each atom and plane wave kpg(:,:)=k+G vector for a given k point kinpw(:)=kinetic energy for each plane wave (Hartree)
SIDE EFFECTS
bandfft_kpt_out=<type(bandfft_kpt)>=bandfft_kpt datastructure
PARENTS
energy,fock2ACE,forstrnps
CHILDREN
SOURCE
1977 subroutine bandfft_kpt_restoretabs(bandfft_kpt_out,ffnl,ph3d,kpg,kinpw) 1978 1979 1980 !This section has been created automatically by the script Abilint (TD). 1981 !Do not modify the following lines by hand. 1982 #undef ABI_FUNC 1983 #define ABI_FUNC 'bandfft_kpt_restoretabs' 1984 !End of the abilint section 1985 1986 implicit none 1987 1988 !Arguments ------------------------------- 1989 type(bandfft_kpt_type),intent(inout) :: bandfft_kpt_out 1990 real(dp),intent(inout),allocatable,optional :: ffnl(:,:,:,:),ph3d(:,:,:),kpg(:,:),kinpw(:) 1991 !Local variables------------------------------- 1992 integer :: is1,is2,is3,is4 1993 1994 ! ********************************************************************* 1995 1996 if (present(ffnl)) then 1997 if (allocated(bandfft_kpt_out%ffnl_gather)) then 1998 ABI_DEALLOCATE(bandfft_kpt_out%ffnl_gather) 1999 end if 2000 if (allocated(ffnl)) then 2001 is1=size(ffnl,1) 2002 is2=size(ffnl,2) 2003 is3=size(ffnl,3) 2004 is4=size(ffnl,4) 2005 ABI_ALLOCATE(bandfft_kpt_out%ffnl_gather,(is1,is2,is3,is4)) 2006 bandfft_kpt_out%ffnl_gather(:,:,:,:)=ffnl(:,:,:,:) 2007 ABI_DEALLOCATE(ffnl) 2008 bandfft_kpt_out%flag2_is_allocated=1 2009 end if 2010 end if 2011 if (present(ph3d)) then 2012 if (allocated(bandfft_kpt_out%ph3d_gather)) then 2013 ABI_DEALLOCATE(bandfft_kpt_out%ph3d_gather) 2014 end if 2015 if (allocated(ph3d)) then 2016 is1=size(ph3d,1) 2017 is2=size(ph3d,2) 2018 is3=size(ph3d,3) 2019 ABI_ALLOCATE(bandfft_kpt_out%ph3d_gather,(is1,is2,is3)) 2020 bandfft_kpt_out%ph3d_gather(:,:,:)=ph3d(:,:,:) 2021 ABI_DEALLOCATE(ph3d) 2022 bandfft_kpt_out%flag2_is_allocated=1 2023 end if 2024 end if 2025 if (present(kpg)) then 2026 if (allocated(bandfft_kpt_out%kpg_k_gather)) then 2027 ABI_DEALLOCATE(bandfft_kpt_out%kpg_k_gather) 2028 end if 2029 if (allocated(kpg)) then 2030 is1=size(kpg,1) 2031 is2=size(kpg,2) 2032 ABI_ALLOCATE(bandfft_kpt_out%kpg_k_gather,(is1,is2)) 2033 bandfft_kpt_out%kpg_k_gather(:,:)=kpg(:,:) 2034 ABI_DEALLOCATE(kpg) 2035 bandfft_kpt_out%flag2_is_allocated=1 2036 end if 2037 end if 2038 if (present(kinpw)) then 2039 if (allocated(bandfft_kpt_out%kinpw_gather)) then 2040 ABI_DEALLOCATE(bandfft_kpt_out%kinpw_gather) 2041 end if 2042 if (allocated(kinpw)) then 2043 is1=size(kinpw,1) 2044 ABI_ALLOCATE(bandfft_kpt_out%kinpw_gather,(is1)) 2045 bandfft_kpt_out%kinpw_gather(:)=kinpw(:) 2046 ABI_DEALLOCATE(kinpw) 2047 end if 2048 end if 2049 2050 end subroutine bandfft_kpt_restoretabs
m_bandfft_kpt/bandfft_kpt_savetabs [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_savetabs
FUNCTION
Save some (kpt-dependent) tabs from a bandfft_kpt datastructure
INPUTS
bandfft_kpt_in=<type(bandfft_kpt)>=bandfft_kpt datastructure
OUTPUT
ffnl(:,:,:,:)=nonlocal form factors on basis sphere ph3d(:,:,:)=3-dim structure factors, for each atom and plane wave kpg(:,:)=k+G vector for a given k point kinpw(:)=kinetic energy for each plane wave (Hartree)
PARENTS
energy,fock2ACE,forstrnps
CHILDREN
SOURCE
1880 subroutine bandfft_kpt_savetabs(bandfft_kpt_in,ffnl,ph3d,kpg,kinpw) 1881 1882 1883 !This section has been created automatically by the script Abilint (TD). 1884 !Do not modify the following lines by hand. 1885 #undef ABI_FUNC 1886 #define ABI_FUNC 'bandfft_kpt_savetabs' 1887 !End of the abilint section 1888 1889 implicit none 1890 1891 !Arguments ------------------------------- 1892 type(bandfft_kpt_type),intent(inout) :: bandfft_kpt_in 1893 real(dp),intent(inout),allocatable,optional :: ffnl(:,:,:,:),ph3d(:,:,:),kpg(:,:),kinpw(:) 1894 !Local variables------------------------------- 1895 integer :: is1,is2,is3,is4 1896 1897 ! ********************************************************************* 1898 1899 if (present(ffnl)) then 1900 if (allocated(ffnl)) then 1901 ABI_DEALLOCATE(ffnl) 1902 end if 1903 if (allocated(bandfft_kpt_in%ffnl_gather)) then 1904 is1=size(bandfft_kpt_in%ffnl_gather,1) 1905 is2=size(bandfft_kpt_in%ffnl_gather,2) 1906 is3=size(bandfft_kpt_in%ffnl_gather,3) 1907 is4=size(bandfft_kpt_in%ffnl_gather,4) 1908 ABI_ALLOCATE(ffnl,(is1,is2,is3,is4)) 1909 ffnl(:,:,:,:)=bandfft_kpt_in%ffnl_gather(:,:,:,:) 1910 end if 1911 end if 1912 if (present(ph3d)) then 1913 if (allocated(ph3d)) then 1914 ABI_DEALLOCATE(ph3d) 1915 end if 1916 if (allocated(bandfft_kpt_in%ph3d_gather)) then 1917 is1=size(bandfft_kpt_in%ph3d_gather,1) 1918 is2=size(bandfft_kpt_in%ph3d_gather,2) 1919 is3=size(bandfft_kpt_in%ph3d_gather,3) 1920 ABI_ALLOCATE(ph3d,(is1,is2,is3)) 1921 ph3d(:,:,:)=bandfft_kpt_in%ph3d_gather(:,:,:) 1922 end if 1923 end if 1924 if (present(kpg)) then 1925 if (allocated(kpg)) then 1926 ABI_DEALLOCATE(kpg) 1927 end if 1928 if (allocated(bandfft_kpt_in%kpg_k_gather)) then 1929 is1=size(bandfft_kpt_in%kpg_k_gather,1) 1930 is2=size(bandfft_kpt_in%kpg_k_gather,2) 1931 ABI_ALLOCATE(kpg,(is1,is2)) 1932 kpg(:,:)=bandfft_kpt_in%kpg_k_gather(:,:) 1933 end if 1934 end if 1935 if (present(kinpw)) then 1936 if (allocated(kinpw)) then 1937 ABI_DEALLOCATE(kinpw) 1938 end if 1939 if (allocated(bandfft_kpt_in%kinpw_gather)) then 1940 is1=size(bandfft_kpt_in%kinpw_gather,1) 1941 ABI_ALLOCATE(kinpw,(is1)) 1942 kinpw(:)=bandfft_kpt_in%kinpw_gather(:) 1943 end if 1944 end if 1945 1946 end subroutine bandfft_kpt_savetabs
m_bandfft_kpt/bandfft_kpt_set_ikpt [ Functions ]
[ Top ] [ m_bandfft_kpt ] [ Functions ]
NAME
bandfft_kpt_set_ikpt
FUNCTION
Set the value of bandfft_kpt_current_ikpt variable,
i.e. current index of bandfft_kpt loaded in memory
INPUT
ikpt=index of k-point (in the global array dtset%kpt)
mpi_enreg= information about MPI parallelization
OUTPUT
bandfft_kpt_current_ikpt value changed
PARENTS
mkrho,prep_bandfft_tabs,vtorho
CHILDREN
SOURCE
2077 subroutine bandfft_kpt_set_ikpt(ikpt,mpi_enreg) 2078 2079 2080 !This section has been created automatically by the script Abilint (TD). 2081 !Do not modify the following lines by hand. 2082 #undef ABI_FUNC 2083 #define ABI_FUNC 'bandfft_kpt_set_ikpt' 2084 !End of the abilint section 2085 2086 implicit none 2087 2088 !Arguments ------------------------------- 2089 integer,intent(in) :: ikpt 2090 type(MPI_type),intent(inout) :: mpi_enreg 2091 !Local variables------------------------------- 2092 2093 ! ********************************************************************* 2094 2095 if (ikpt>0) then 2096 bandfft_kpt_current_ikpt=mpi_enreg%my_kpttab(ikpt) 2097 else 2098 bandfft_kpt_current_ikpt=-1 2099 end if 2100 2101 end subroutine bandfft_kpt_set_ikpt
m_bandfft_kpt/bandfft_kpt_type [ Types ]
[ Top ] [ m_bandfft_kpt ] [ Types ]
NAME
bandfft_kpt_type
FUNCTION
The bandfft_kpt_type structured datatype gather different information about the triple band-fft-kpt parallelisation : tabs which are distributed over all the three dimensions and stored during the calculation, dimensions of messages exchange during the calculations... i.e.: all the information which were spread over the entire code before and recomputed at each iline, istep or itime STEP with a large probability to make a mistake.
SOURCE
75 type, public :: bandfft_kpt_type 76 77 ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines, 78 ! declared in another part of ABINIT, that might need to take into account your modification. 79 80 integer :: flag1_is_allocated ! determine if the following data are allocated or not 81 integer :: npw_tot ! array holding the total number of plane waves for each k point 82 integer :: ndatarecv ! total number of values received by the processor and sent 83 ! by the other processors band 84 integer, allocatable :: kg_k_gather(:,:) ! planewave coordinates 85 ! (of the processor + sent by other processors band) 86 integer, allocatable :: recvcounts(:) ! number of values received by the processor from each processor band 87 integer, allocatable :: sendcounts(:) ! number of values sent by the processor to each processor band 88 integer, allocatable :: rdispls (:) ! positions of values received by the processor from each processor band 89 integer, allocatable :: sdispls (:) ! postions of values sent by the processor to each processor band 90 integer, allocatable :: gbound(:,:) ! sphere boundary info: gbound(2*mgfft+8,2) 91 92 integer :: flag2_is_allocated ! determine if the following data are allocated or not 93 real(dp), allocatable :: ffnl_gather(:,:,:,:) ! ffnl tab (of the processor + sent by other processors band) 94 real(dp), allocatable :: kinpw_gather(:) ! kinpw tab (of the processor + sent by other processors band) 95 real(dp), allocatable :: ph3d_gather(:,:,:) ! ph3d tab (of the processor + sent by other processors band) 96 real(dp), allocatable :: kpg_k_gather(:,:) ! kpg_k tab (of the processor + sent by other processors band) 97 98 99 integer :: flag3_is_allocated ! determine if the following data are allocated or not 100 integer :: istwf_k ! input option parameter that describes the storage of wfs 101 integer :: idatarecv0 ! position of the planewave coordinates (0,0,0) 102 integer :: ndatarecv_tot ! total number of received values by the processor 103 ! (ndatarecv + number of received opposited planewave coordinates) 104 integer :: ndatasend_sym ! number of sent values to the processors fft to create opposited 105 ! planewave coordinates 106 integer, allocatable :: kg_k_gather_sym(:,:) ! planewave coordinates 107 ! (kg_k_gather + opposited planewave coordinates sent by the processors fft) 108 integer, allocatable :: rdispls_sym(:) ! positions of values received by the processor from each processor fft 109 integer, allocatable :: recvcounts_sym(:) ! number of values received by the processor from each processor fft 110 integer, allocatable :: recvcounts_sym_tot(:) ! number of values received by each processor from the other processors fft 111 integer, allocatable :: sdispls_sym(:) ! postions of values sent by the processor to each processor fft 112 integer, allocatable :: sendcounts_sym(:) ! number of values sent by the processor to each processor fft 113 integer, allocatable :: sendcounts_sym_all(:) ! number of values sent by each processor to the other processors fft 114 integer, allocatable :: tab_proc(:) ! positions of opposited planewave coordinates in the list of the processors fft 115 116 logical :: have_to_reequilibrate ! indicates weather we will have to reequilibrate and allocate all these stuff 117 integer :: npw_fft ! Number of plane waves during fft step 118 integer, allocatable :: indices_pw_fft(:) ! Indices for sorting pw like pw 119 integer, allocatable :: sendcount_fft (:) ! Number of pw to send to others proc fft 120 integer, allocatable :: senddisp_fft(:) ! Positions for sending 121 integer, allocatable :: recvcount_fft(:) ! Number of pw to receive from others proc fft 122 integer, allocatable :: recvdisp_fft(:) ! Positions for receiving 123 integer, allocatable :: kg_k_fft(:,:) ! planewaves coordinates 124 125 end type bandfft_kpt_type