TABLE OF CONTENTS
- ABINIT/m_paw_an
- m_paw_an/paw_an_copy
- m_paw_an/paw_an_free
- m_paw_an/paw_an_gather
- m_paw_an/paw_an_init
- m_paw_an/paw_an_isendreceive_fillbuffer
- m_paw_an/paw_an_isendreceive_getbuffer
- m_paw_an/paw_an_nullify
- m_paw_an/paw_an_print
- m_paw_an/paw_an_redistribute
- m_paw_an/paw_an_reset_flags
- m_paw_an/paw_an_type
ABINIT/m_paw_an [ Modules ]
NAME
m_paw_an
FUNCTION
This module contains the definition of the paw_an_type structured datatype, as well as related functions and methods. paw_an_type variables contain various arrays given on ANgular mesh or ANgular moments for a given atom.
COPYRIGHT
Copyright (C) 2013-2024 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_paw_an 26 27 USE_DEFS 28 USE_MSG_HANDLING 29 USE_MPI_WRAPPERS 30 USE_MEMORY_PROFILING 31 32 use m_paral_atom, only : get_my_atmtab, free_my_atmtab, get_my_natom 33 use m_pawang, only : pawang_type 34 use m_pawtab, only : pawtab_type 35 36 implicit none 37 38 private 39 40 !public procedures. 41 public :: paw_an_init 42 public :: paw_an_free 43 public :: paw_an_nullify 44 public :: paw_an_copy 45 public :: paw_an_print 46 public :: paw_an_gather 47 public :: paw_an_redistribute 48 public :: paw_an_reset_flags 49 50 !private procedures. 51 private :: paw_an_isendreceive_getbuffer 52 private :: paw_an_isendreceive_fillbuffer
m_paw_an/paw_an_copy [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_copy
FUNCTION
Copy one paw_an datastructure into another Can take into accound changes of dimensions Can copy a shared paw_an into distributed ones (when parallelism is activated)
INPUTS
mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc comm_atom=--optional-- MPI communicator over atoms paw_an_in(:)<type(paw_an_type)>= input paw_an datastructure
SIDE EFFECTS
paw_an_cpy(:)<type(paw_an_type)>= output paw_an datastructure
NOTES
paw_an_cpy must have been allocated in the calling function.
SOURCE
545 subroutine paw_an_copy(paw_an_in,paw_an_cpy,& 546 & mpi_atmtab,comm_atom) ! optional arguments (parallelism) 547 548 !Arguments ------------------------------------ 549 !scalars 550 integer,optional,intent(in) :: comm_atom 551 !arrays 552 integer,optional,target,intent(in) :: mpi_atmtab(:) 553 type(Paw_an_type),intent(in),target :: paw_an_in(:) 554 type(Paw_an_type),intent(inout),target :: paw_an_cpy(:) 555 556 !Local variables------------------------------- 557 !scalars 558 integer :: cplx_mesh_size,ij,ij1,lm_size,my_comm_atom,my_natom,nkxc1,nk3xc1,npaw_an_in 559 integer :: npaw_an_max,npaw_an_out,nspden,paral_case,v_size,sz1 560 logical :: my_atmtab_allocated,paral_atom 561 character(len=500) :: msg 562 type(Paw_an_type),pointer :: paw_an_in1, paw_an_out1 563 !arrays 564 integer,pointer :: my_atmtab(:) 565 type(Paw_an_type), pointer :: paw_an_out(:) 566 567 ! ************************************************************************* 568 569 !@Paw_an_type 570 571 !Retrieve sizes 572 npaw_an_in=size(paw_an_in);npaw_an_out=size(paw_an_cpy) 573 574 !Set up parallelism over atoms 575 paral_atom=(present(comm_atom));if (paral_atom) paral_atom=(xmpi_comm_size(comm_atom)>1) 576 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 577 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 578 my_atmtab_allocated=.false. 579 580 !Determine in which case we are (parallelism, ...) 581 !No parallelism: a single copy operation 582 paral_case=0;npaw_an_max=npaw_an_in 583 paw_an_out => paw_an_cpy 584 if (paral_atom) then 585 if (npaw_an_out<npaw_an_in) then ! Parallelism: the copy operation is a scatter 586 call get_my_natom(my_comm_atom,my_natom,npaw_an_in) 587 if (my_natom==npaw_an_out) then 588 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,npaw_an_in) 589 paral_case=1;npaw_an_max=npaw_an_out 590 paw_an_out => paw_an_cpy 591 else 592 msg=' npaw_an_out should be equal to my_natom !' 593 LIBPAW_BUG(msg) 594 end if 595 else ! Parallelism: the copy operation is a gather 596 call get_my_natom(my_comm_atom,my_natom,npaw_an_out) 597 if (my_natom==npaw_an_in) then 598 paral_case=2;npaw_an_max=npaw_an_in 599 else 600 msg=' npaw_ij_in should be equal to my_natom !' 601 LIBPAW_BUG(msg) 602 end if 603 end if 604 end if 605 606 !First case: a simple copy or a scatter 607 if (npaw_an_max>0.and.((paral_case==0).or.(paral_case==1))) then 608 call paw_an_free(paw_an_cpy) 609 call paw_an_nullify(paw_an_cpy) 610 611 ! Loop on paw_ij components 612 do ij1=1,npaw_an_max 613 ij=ij1; if (paral_case==1) ij=my_atmtab(ij1) 614 615 paw_an_in1=>paw_an_in(ij) 616 paw_an_out1=>paw_an_out(ij1) 617 paw_an_out1%angl_size =paw_an_in1%angl_size 618 paw_an_out1%cplex =paw_an_in1%cplex 619 paw_an_out1%has_kxc =paw_an_in1%has_kxc 620 paw_an_out1%has_k3xc =paw_an_in1%has_k3xc 621 paw_an_out1%has_vhartree =paw_an_in1%has_vhartree 622 paw_an_out1%has_vxc =paw_an_in1%has_vxc 623 paw_an_out1%has_vxctau =paw_an_in1%has_vxctau 624 paw_an_out1%has_vxcval =paw_an_in1%has_vxcval 625 paw_an_out1%has_vxc_ex =paw_an_in1%has_vxc_ex 626 paw_an_out1%itypat =paw_an_in1%itypat 627 paw_an_out1%lm_size =paw_an_in1%lm_size 628 paw_an_out1%mesh_size =paw_an_in1%mesh_size 629 paw_an_out1%nkxc1 =paw_an_in1%nkxc1 630 paw_an_out1%nk3xc1 =paw_an_in1%nk3xc1 631 paw_an_out1%nspden =paw_an_in1%nspden 632 if (allocated(paw_an_in1%lmselect)) then 633 sz1=size(paw_an_in1%lmselect) 634 LIBPAW_ALLOCATE(paw_an_out1%lmselect,(sz1)) 635 paw_an_out1%lmselect(:)=paw_an_in1%lmselect(:) 636 end if 637 v_size=0 638 if (paw_an_in1%has_vxc>0) then 639 v_size=size(paw_an_in1%vxc1,2) 640 else if (paw_an_in1%has_vxctau>0) then 641 v_size=size(paw_an_in1%vxctau1,2) 642 else if (paw_an_in1%has_kxc>0) then 643 v_size=size(paw_an_in1%kxc1,2) 644 else if (paw_an_in1%has_k3xc>0) then 645 v_size=size(paw_an_in1%k3xc1,2) 646 else if (paw_an_in1%has_vxcval>0) then 647 v_size=size(paw_an_in1%vxc1_val,2) 648 else if (paw_an_in1%has_vxc_ex>0) then 649 v_size=size(paw_an_in1%vxc_ex,2) 650 else if (paw_an_in1%has_vhartree>0) then 651 v_size=size(paw_an_in1%vh1,2) 652 end if 653 nspden=paw_an_in1%nspden 654 lm_size=paw_an_in1%lm_size 655 cplx_mesh_size=paw_an_in1%cplex*paw_an_in1%mesh_size 656 nkxc1=paw_an_in1%nkxc1 657 if (paw_an_in1%has_kxc>0) then 658 LIBPAW_ALLOCATE(paw_an_out1%kxc1,(cplx_mesh_size,v_size,nkxc1)) 659 LIBPAW_ALLOCATE(paw_an_out1%kxct1,(cplx_mesh_size,v_size,nkxc1)) 660 if (paw_an_in1%has_kxc==2.and.nkxc1>0) then 661 paw_an_out1%kxc1(:,:,:)=paw_an_in1%kxc1(:,:,:) 662 paw_an_out1%kxct1(:,:,:)=paw_an_in1%kxct1(:,:,:) 663 end if 664 end if 665 nk3xc1=paw_an_in1%nk3xc1 666 if (paw_an_in1%has_k3xc>0) then 667 LIBPAW_ALLOCATE(paw_an_out1%k3xc1,(cplx_mesh_size,v_size,nk3xc1)) 668 LIBPAW_ALLOCATE(paw_an_out1%k3xct1,(cplx_mesh_size,v_size,nk3xc1)) 669 if (paw_an_in1%has_k3xc==2.and.nk3xc1>0) then 670 paw_an_out1%k3xc1(:,:,:)=paw_an_in1%k3xc1(:,:,:) 671 paw_an_out1%k3xct1(:,:,:)=paw_an_in1%k3xct1(:,:,:) 672 end if 673 end if 674 if (paw_an_in1%has_vhartree>0) then 675 LIBPAW_ALLOCATE(paw_an_out1%vh1,(cplx_mesh_size,lm_size,nspden)) 676 LIBPAW_ALLOCATE(paw_an_out1%vht1,(cplx_mesh_size,lm_size,nspden)) 677 if (paw_an_in1%has_vhartree==2) then 678 paw_an_out1%vh1(:,:,:)=paw_an_in1%vh1(:,:,:) 679 paw_an_out1%vht1(:,:,:)=paw_an_in1%vht1(:,:,:) 680 end if 681 end if 682 if (paw_an_in1%has_vxc>0) then 683 LIBPAW_ALLOCATE(paw_an_out1%vxc1,(cplx_mesh_size,v_size,nspden)) 684 LIBPAW_ALLOCATE(paw_an_out1%vxct1,(cplx_mesh_size,v_size,nspden)) 685 if (paw_an_in1%has_vxc==2) then 686 paw_an_out1%vxc1(:,:,:)=paw_an_in1%vxc1(:,:,:) 687 paw_an_out1%vxct1(:,:,:)=paw_an_in1%vxct1(:,:,:) 688 end if 689 end if 690 if (paw_an_in1%has_vxctau>0) then 691 LIBPAW_ALLOCATE(paw_an_out1%vxctau1,(cplx_mesh_size,v_size,nspden)) 692 LIBPAW_ALLOCATE(paw_an_out1%vxcttau1,(cplx_mesh_size,v_size,nspden)) 693 if (paw_an_in1%has_vxc==2) then 694 paw_an_out1%vxctau1(:,:,:)=paw_an_in1%vxctau1(:,:,:) 695 paw_an_out1%vxcttau1(:,:,:)=paw_an_in1%vxcttau1(:,:,:) 696 end if 697 end if 698 if (paw_an_in1%has_vxcval>0) then 699 LIBPAW_ALLOCATE(paw_an_out1%vxc1_val,(cplx_mesh_size,v_size,nspden)) 700 LIBPAW_ALLOCATE(paw_an_out1%vxct1_val,(cplx_mesh_size,v_size,nspden)) 701 if (paw_an_in1%has_vxcval==2) then 702 paw_an_out1%vxc1_val(:,:,:)=paw_an_in1%vxc1_val(:,:,:) 703 paw_an_out1%vxct1_val(:,:,:)=paw_an_in1%vxct1_val(:,:,:) 704 end if 705 end if 706 if (paw_an_in1%has_vxc_ex>0) then 707 LIBPAW_ALLOCATE(paw_an_out1%vxc_ex,(cplx_mesh_size,v_size,nspden)) 708 if (paw_an_in1%has_vxc_ex==2) then 709 paw_an_out1%vxc_ex(:,:,:)=paw_an_in1%vxc_ex(:,:,:) 710 end if 711 end if 712 end do 713 end if 714 715 !Second case: a gather 716 if (paral_case==2) then 717 call paw_an_gather(paw_an_in,paw_an_cpy,-1,my_comm_atom,my_atmtab) 718 end if 719 720 !Destroy atom table used for parallelism 721 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 722 723 end subroutine paw_an_copy
m_paw_an/paw_an_free [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_free
FUNCTION
Deallocate pointers and nullify flags in a paw_an structure
SIDE EFFECTS
Paw_an(:)<type(Paw_an_type)>=various arrays given on ANgular mesh or ANgular moments All associated pointers in Paw_an(:) are deallocated
SOURCE
401 subroutine paw_an_free(Paw_an) 402 403 !Arguments ------------------------------------ 404 !arrays 405 type(Paw_an_type),intent(inout) :: Paw_an(:) 406 407 !Local variables------------------------------- 408 integer :: iat,natom 409 410 ! ************************************************************************* 411 412 !@Paw_an_type 413 414 natom=SIZE(Paw_an);if (natom==0) return 415 416 do iat=1,natom 417 if (allocated(Paw_an(iat)%lmselect )) then 418 LIBPAW_DEALLOCATE(Paw_an(iat)%lmselect) 419 end if 420 if (allocated(Paw_an(iat)%vh1 )) then 421 LIBPAW_DEALLOCATE(Paw_an(iat)%vh1) 422 end if 423 if (allocated(Paw_an(iat)%vht1 )) then 424 LIBPAW_DEALLOCATE(Paw_an(iat)%vht1) 425 end if 426 if (allocated(Paw_an(iat)%vxc1 )) then 427 LIBPAW_DEALLOCATE(Paw_an(iat)%vxc1) 428 end if 429 if (allocated(Paw_an(iat)%vxctau1 )) then 430 LIBPAW_DEALLOCATE(Paw_an(iat)%vxctau1) 431 end if 432 if (allocated(Paw_an(iat)%vxc1_val )) then 433 LIBPAW_DEALLOCATE(Paw_an(iat)%vxc1_val) 434 end if 435 if (allocated(Paw_an(iat)%vxct1 )) then 436 LIBPAW_DEALLOCATE(Paw_an(iat)%vxct1) 437 end if 438 if (allocated(Paw_an(iat)%vxcttau1 )) then 439 LIBPAW_DEALLOCATE(Paw_an(iat)%vxcttau1) 440 end if 441 if (allocated(Paw_an(iat)%vxct1_val)) then 442 LIBPAW_DEALLOCATE(Paw_an(iat)%vxct1_val) 443 end if 444 if (allocated(Paw_an(iat)%kxc1 )) then 445 LIBPAW_DEALLOCATE(Paw_an(iat)%kxc1) 446 end if 447 if (allocated(Paw_an(iat)%kxct1 )) then 448 LIBPAW_DEALLOCATE(Paw_an(iat)%kxct1) 449 end if 450 if (allocated(Paw_an(iat)%k3xc1 )) then 451 LIBPAW_DEALLOCATE(Paw_an(iat)%k3xc1) 452 end if 453 if (allocated(Paw_an(iat)%k3xct1 )) then 454 LIBPAW_DEALLOCATE(Paw_an(iat)%k3xct1) 455 end if 456 if (allocated(Paw_an(iat)%vxc_ex )) then 457 LIBPAW_DEALLOCATE(Paw_an(iat)%vxc_ex) 458 end if 459 460 ! === Reset all has_* flags === 461 Paw_an(iat)%has_kxc =0 462 Paw_an(iat)%has_k3xc =0 463 Paw_an(iat)%has_vhartree=0 464 Paw_an(iat)%has_vxc =0 465 Paw_an(iat)%has_vxctau =0 466 Paw_an(iat)%has_vxcval =0 467 Paw_an(iat)%has_vxc_ex =0 468 end do !iat 469 470 end subroutine paw_an_free
m_paw_an/paw_an_gather [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_gather
FUNCTION
(All)Gather paw_an datastructures
INPUTS
master=master communicator receiving data ; if -1 do a ALLGATHER comm_atom= communicator over atom mpi_atmtab(:)=--optional-- indexes of the atoms treated by current calling proc paw_an_in(:)<type(paw_an_type)>= input paw_an datastructures on every process
OUTPUT
paw_an_gathered(:)<type(paw_an_type)>= output paw_an datastructure
SOURCE
848 subroutine paw_an_gather(Paw_an_in,paw_an_gathered,master,comm_atom,mpi_atmtab) 849 850 !Arguments ------------------------------------ 851 integer,intent(in) :: master,comm_atom 852 !arrays 853 integer,optional,target,intent(in) :: mpi_atmtab(:) 854 type(Paw_an_type),target,intent(in) :: Paw_an_in(:) 855 type(Paw_an_type),target,intent(inout) :: Paw_an_gathered(:) 856 857 !Local variables------------------------------- 858 !scalars 859 integer :: buf_dp_size,buf_dp_size_all,buf_int_size,buf_int_size_all,cplx_mesh_size 860 integer :: iat,iatot,ierr,has_lm_select,i1,i2,ij,indx_int,indx_dp 861 integer :: lm_size,me_atom 862 integer :: my_natom,natom,nkxc1,nk3xc1,npaw_an_in_sum,nproc_atom,nspden,v_size,sz1,sz2,sz3 863 logical :: my_atmtab_allocated,paral_atom 864 character(len=500) :: msg 865 type(Paw_an_type),pointer :: paw_an_in1,paw_an_gathered1 866 !arrays 867 integer :: bufsz(2) 868 integer,allocatable :: buf_int(:),buf_int_all(:) 869 integer,allocatable :: count_dp(:),count_int(:),count_tot(:),displ_dp(:),displ_int(:) 870 integer,pointer :: my_atmtab(:) 871 real(dp),allocatable :: buf_dp(:),buf_dp_all(:) 872 873 ! ************************************************************************* 874 875 !@Paw_an_type 876 877 if (master/=-1) then 878 msg='simple gather (master/=-1) not yet implemented !' 879 LIBPAW_BUG(msg) 880 end if 881 882 my_natom=size(paw_an_in);natom=size(paw_an_gathered) 883 884 !Set up parallelism over atoms 885 paral_atom=(my_natom/=natom) 886 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 887 call get_my_atmtab(comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom) 888 nproc_atom=xmpi_comm_size(comm_atom) 889 me_atom=xmpi_comm_rank(comm_atom) 890 891 !Special case: one process (simple copy) 892 if (nproc_atom==1) then 893 if (master==-1.or.me_atom==master) then 894 call paw_an_free(paw_an_gathered) 895 call paw_an_nullify(paw_an_gathered) 896 do iat=1,my_natom 897 paw_an_in1=>paw_an_in(iat) 898 paw_an_gathered1%itypat =paw_an_in1%itypat 899 paw_an_gathered1%nspden =paw_an_in1%nspden 900 paw_an_gathered1%cplex =paw_an_in1%cplex 901 paw_an_gathered1%mesh_size =paw_an_in1%mesh_size 902 paw_an_gathered1%angl_size =paw_an_in1%angl_size 903 paw_an_gathered1%lm_size =paw_an_in1%lm_size 904 paw_an_gathered1%nkxc1 =paw_an_in1%nkxc1 905 paw_an_gathered1%nk3xc1 =paw_an_in1%nk3xc1 906 paw_an_gathered1%has_vxc =paw_an_in1%has_vxc 907 paw_an_gathered1%has_vxctau =paw_an_in1%has_vxctau 908 paw_an_gathered1%has_kxc =paw_an_in1%has_kxc 909 paw_an_gathered1%has_k3xc =paw_an_in1%has_k3xc 910 paw_an_gathered1%has_vxcval =paw_an_in1%has_vxcval 911 paw_an_gathered1%has_vxc_ex =paw_an_in1%has_vxc_ex 912 paw_an_gathered1%has_vhartree =paw_an_in1%has_vhartree 913 if (allocated(paw_an_in1%lmselect)) then 914 sz1=size(paw_an_in1%lmselect) 915 LIBPAW_ALLOCATE(paw_an_gathered1%lmselect,(sz1)) 916 paw_an_gathered1%lmselect(:)=paw_an_in1%lmselect(:) 917 end if 918 if (allocated(paw_an_in1%vxc1)) then 919 sz1=size(paw_an_in1%vxc1,1);sz2=size(paw_an_in1%vxc1,2) 920 sz3=size(paw_an_in1%vxc1,3) 921 LIBPAW_ALLOCATE(paw_an_gathered1%vxc1,(sz1,sz2,sz3)) 922 paw_an_gathered1%vxc1(:,:,:)=paw_an_in1%vxc1(:,:,:) 923 end if 924 if (allocated(paw_an_in1%vxctau1)) then 925 sz1=size(paw_an_in1%vxctau1,1);sz2=size(paw_an_in1%vxctau1,2) 926 sz3=size(paw_an_in1%vxctau1,3) 927 LIBPAW_ALLOCATE(paw_an_gathered1%vxctau1,(sz1,sz2,sz3)) 928 paw_an_gathered1%vxctau1(:,:,:)=paw_an_in1%vxctau1(:,:,:) 929 end if 930 if (allocated(paw_an_in1%vxcttau1)) then 931 sz1=size(paw_an_in1%vxcttau1,1);sz2=size(paw_an_in1%vxcttau1,2) 932 sz3=size(paw_an_in1%vxcttau1,3) 933 LIBPAW_ALLOCATE(paw_an_gathered1%vxcttau1,(sz1,sz2,sz3)) 934 paw_an_gathered1%vxcttau1(:,:,:)=paw_an_in1%vxcttau1(:,:,:) 935 end if 936 if (allocated(paw_an_in1%kxc1)) then 937 sz1=size(paw_an_in1%kxc1,1);sz2=size(paw_an_in1%kxc1,2) 938 sz3=size(paw_an_in1%kxc1,3) 939 LIBPAW_ALLOCATE(paw_an_gathered1%kxc1,(sz1,sz2,sz3)) 940 if (sz3>0) paw_an_gathered1%kxc1(:,:,:)=paw_an_in1%kxc1(:,:,:) 941 end if 942 if (allocated(paw_an_in1%k3xc1)) then 943 sz1=size(paw_an_in1%k3xc1,1);sz2=size(paw_an_in1%k3xc1,2) 944 sz3=size(paw_an_in1%k3xc1,3) 945 LIBPAW_ALLOCATE(paw_an_gathered1%k3xc1,(sz1,sz2,sz3)) 946 if (sz3>0) paw_an_gathered1%k3xc1(:,:,:)=paw_an_in1%k3xc1(:,:,:) 947 end if 948 if (allocated(paw_an_in1%kxct1)) then 949 sz1=size(paw_an_in1%kxct1,1);sz2=size(paw_an_in1%kxct1,2) 950 sz3=size(paw_an_in1%kxct1,3) 951 LIBPAW_ALLOCATE(paw_an_gathered1%kxct1,(sz1,sz2,sz3)) 952 if (sz3>0) paw_an_gathered1%kxct1(:,:,:)=paw_an_in1%kxct1(:,:,:) 953 end if 954 if (allocated(paw_an_in1%k3xct1)) then 955 sz1=size(paw_an_in1%k3xct1,1);sz2=size(paw_an_in1%k3xct1,2) 956 sz3=size(paw_an_in1%k3xct1,3) 957 LIBPAW_ALLOCATE(paw_an_gathered1%k3xct1,(sz1,sz2,sz3)) 958 if (sz3>0) paw_an_gathered1%k3xct1(:,:,:)=paw_an_in1%k3xct1(:,:,:) 959 end if 960 if (allocated(paw_an_in1%vxc1_val)) then 961 sz1=size(paw_an_in1%vxc1_val,1);sz2=size(paw_an_in1%vxc1_val,2) 962 sz3=size(paw_an_in1%vxc1_val,3) 963 LIBPAW_ALLOCATE(paw_an_gathered1%vxc1_val,(sz1,sz2,sz3)) 964 paw_an_gathered1%vxc1_val(:,:,:)=paw_an_in1%vxc1_val(:,:,:) 965 end if 966 if (allocated(paw_an_in1%vxct1_val)) then 967 sz1=size(paw_an_in1%vxct1_val,1);sz2=size(paw_an_in1%vxct1_val,2) 968 sz3=size(paw_an_in1%vxct1_val,3) 969 LIBPAW_ALLOCATE(paw_an_gathered1%vxct1_val,(sz1,sz2,sz3)) 970 paw_an_gathered1%vxct1_val(:,:,:)=paw_an_in1%vxct1_val(:,:,:) 971 end if 972 if (allocated(paw_an_in1%vxc_ex)) then 973 sz1=size(paw_an_in1%vxc_ex,1);sz2=size(paw_an_in1%vxc_ex,2) 974 sz3=size(paw_an_in1%vxc_ex,3) 975 LIBPAW_ALLOCATE(paw_an_gathered1%vxc_ex,(sz1,sz2,sz3)) 976 paw_an_gathered1%vxc_ex(:,:,:)=paw_an_in1%vxc_ex(:,:,:) 977 end if 978 if (allocated(paw_an_in1%vh1)) then 979 sz1=size(paw_an_in1%vh1,1);sz2=size(paw_an_in1%vh1,2) 980 sz3=size(paw_an_in1%vh1,3) 981 LIBPAW_ALLOCATE(paw_an_gathered1%vh1,(sz1,sz2,sz3)) 982 paw_an_gathered1%vh1(:,:,:)=paw_an_in1%vh1(:,:,:) 983 end if 984 if (allocated(paw_an_in1%vht1)) then 985 sz1=size(paw_an_in1%vht1,1);sz2=size(paw_an_in1%vht1,2) 986 sz3=size(paw_an_in1%vht1,3) 987 LIBPAW_ALLOCATE(paw_an_gathered1%vht1,(sz1,sz2,sz3)) 988 paw_an_gathered1%vht1(:,:,:)=paw_an_in1%vht1(:,:,:) 989 end if 990 end do 991 end if 992 return 993 end if 994 995 !Test on sizes 996 npaw_an_in_sum=my_natom 997 call xmpi_sum(npaw_an_in_sum,comm_atom,ierr) 998 if (master==-1) then 999 if (natom/=npaw_an_in_sum) then 1000 msg='Wrong sizes sum[npaw_an_in]/=natom !' 1001 LIBPAW_BUG(msg) 1002 end if 1003 else 1004 if (me_atom==master.and.natom/=npaw_an_in_sum) then 1005 msg='(2) paw_an_gathered wrongly allocated !' 1006 LIBPAW_BUG(msg) 1007 end if 1008 end if 1009 1010 !Compute sizes of buffers 1011 buf_int_size=0;buf_dp_size=0 1012 do ij=1,my_natom 1013 buf_int_size=buf_int_size+18+size(paw_an_in(ij)%lmselect) 1014 end do 1015 do ij=1,my_natom 1016 paw_an_in1=>paw_an_in(ij) 1017 if (paw_an_in1%has_vxc==2) then 1018 buf_dp_size=buf_dp_size+size(paw_an_in1%vxc1) 1019 buf_dp_size=buf_dp_size+size(paw_an_in1%vxct1) 1020 end if 1021 if (paw_an_in1%has_vxctau==2) then 1022 buf_dp_size=buf_dp_size+size(paw_an_in1%vxctau1) 1023 buf_dp_size=buf_dp_size+size(paw_an_in1%vxcttau1) 1024 end if 1025 if (paw_an_in1%has_kxc==2) then 1026 buf_dp_size=buf_dp_size+size(paw_an_in1%kxc1) 1027 buf_dp_size=buf_dp_size+size(paw_an_in1%kxct1) 1028 end if 1029 if (paw_an_in1%has_k3xc==2) then 1030 buf_dp_size=buf_dp_size+size(paw_an_in1%k3xc1) 1031 buf_dp_size=buf_dp_size+size(paw_an_in1%k3xct1) 1032 end if 1033 if (paw_an_in1%has_vxcval==2) then 1034 buf_dp_size=buf_dp_size+size(paw_an_in1%vxc1_val) 1035 buf_dp_size=buf_dp_size+size(paw_an_in1%vxct1_val) 1036 end if 1037 if (paw_an_in1%has_vxc_ex==2) then 1038 buf_dp_size=buf_dp_size+size(paw_an_in1%vxc_ex) 1039 end if 1040 if (paw_an_in1%has_vhartree==2) then 1041 buf_dp_size=buf_dp_size+size(paw_an_in1%vh1) 1042 buf_dp_size=buf_dp_size+size(paw_an_in1%vht1) 1043 end if 1044 end do 1045 1046 !Fill in input buffers 1047 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 1048 LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size)) 1049 indx_int=1;indx_dp=1 1050 do ij=1, my_natom 1051 paw_an_in1=>paw_an_in(ij) 1052 buf_int(indx_int)=my_atmtab(ij); indx_int=indx_int+1 1053 buf_int(indx_int)=paw_an_in1%itypat; indx_int=indx_int+1 1054 buf_int(indx_int)=paw_an_in1%nspden; indx_int=indx_int+1 1055 buf_int(indx_int)=paw_an_in1%cplex; indx_int=indx_int+1 1056 buf_int(indx_int)=paw_an_in1%mesh_size; indx_int=indx_int+1 1057 buf_int(indx_int)=paw_an_in1%angl_size; indx_int=indx_int+1 1058 buf_int(indx_int)=paw_an_in1%lm_size; indx_int=indx_int+1 1059 buf_int(indx_int)=paw_an_in1%nkxc1; indx_int=indx_int+1 1060 buf_int(indx_int)=paw_an_in1%nk3xc1; indx_int=indx_int+1 1061 buf_int(indx_int)=paw_an_in1%has_vxc; indx_int=indx_int+1 1062 buf_int(indx_int)=paw_an_in1%has_vxctau; indx_int=indx_int+1 1063 buf_int(indx_int)=paw_an_in1%has_kxc; indx_int=indx_int+1 1064 buf_int(indx_int)=paw_an_in1%has_k3xc; indx_int=indx_int+1 1065 buf_int(indx_int)=paw_an_in1%has_vxcval; indx_int=indx_int+1 1066 buf_int(indx_int)=paw_an_in1%has_vxc_ex; indx_int=indx_int+1 1067 buf_int(indx_int)=paw_an_in1%has_vhartree; indx_int=indx_int+1 1068 v_size=0 1069 if (paw_an_in1%has_vxc>0) then 1070 v_size=size(paw_an_in1%vxc1,2) 1071 else if (paw_an_in1%has_vxctau>0) then 1072 v_size=size(paw_an_in1%vxctau1,2) 1073 else if (paw_an_in1%has_kxc>0) then 1074 v_size=size(paw_an_in1%kxc1,2) 1075 else if (paw_an_in1%has_k3xc>0) then 1076 v_size=size(paw_an_in1%k3xc1,2) 1077 else if (paw_an_in1%has_vxcval>0) then 1078 v_size=size(paw_an_in1%vxc1_val,2) 1079 else if (paw_an_in1%has_vxc_ex>0) then 1080 v_size=size(paw_an_in1%vxc_ex,2) 1081 else if (paw_an_in1%has_vhartree>0) then 1082 v_size=size(paw_an_in1%vh1,2) 1083 end if 1084 buf_int(indx_int)=v_size;indx_int=indx_int+1 1085 if (allocated(paw_an_in1%lmselect)) then 1086 buf_int(indx_int)=1;indx_int=indx_int+1 1087 else 1088 buf_int(indx_int)=0;indx_int=indx_int+1 1089 end if 1090 nspden=paw_an_in1%nspden 1091 lm_size=paw_an_in1%lm_size 1092 cplx_mesh_size=paw_an_in1%cplex*paw_an_in1%mesh_size 1093 if (lm_size>0) then 1094 if (allocated(paw_an_in1%lmselect)) then 1095 do i1=1,lm_size 1096 if (paw_an_in1%lmselect(i1)) then 1097 buf_int(indx_int)=1 1098 else 1099 buf_int(indx_int)=0 1100 end if 1101 indx_int=indx_int+1 1102 end do 1103 end if 1104 end if 1105 if (paw_an_in1%has_vxc==2) then 1106 do i1=1,nspden 1107 do i2=1,v_size 1108 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxc1(:,i2,i1) 1109 indx_dp=indx_dp+cplx_mesh_size 1110 end do 1111 end do 1112 do i1=1,nspden 1113 do i2=1,v_size 1114 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxct1(:,i2,i1) 1115 indx_dp=indx_dp+cplx_mesh_size 1116 end do 1117 end do 1118 end if 1119 if (paw_an_in1%has_vxctau==2) then 1120 do i1=1,nspden 1121 do i2=1,v_size 1122 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxctau1(:,i2,i1) 1123 indx_dp=indx_dp+cplx_mesh_size 1124 end do 1125 end do 1126 do i1=1,nspden 1127 do i2=1,v_size 1128 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxcttau1(:,i2,i1) 1129 indx_dp=indx_dp+cplx_mesh_size 1130 end do 1131 end do 1132 end if 1133 if (paw_an_in1%has_kxc==2.and.paw_an_in1%nkxc1>0) then 1134 do i1=1,paw_an_in1%nkxc1 1135 do i2=1,v_size 1136 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%kxc1(:,i2,i1) 1137 indx_dp=indx_dp+cplx_mesh_size 1138 end do 1139 end do 1140 do i1=1,paw_an_in1%nkxc1 1141 do i2=1,v_size 1142 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%kxct1(:,i2,i1) 1143 indx_dp=indx_dp+cplx_mesh_size 1144 end do 1145 end do 1146 end if 1147 if (paw_an_in1%has_k3xc==2.and.paw_an_in1%nk3xc1>0) then 1148 do i1=1,paw_an_in1%nk3xc1 1149 do i2=1,v_size 1150 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%k3xc1(:,i2,i1) 1151 indx_dp=indx_dp+cplx_mesh_size 1152 end do 1153 end do 1154 do i1=1,paw_an_in1%nk3xc1 1155 do i2=1,v_size 1156 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%k3xct1(:,i2,i1) 1157 indx_dp=indx_dp+cplx_mesh_size 1158 end do 1159 end do 1160 end if 1161 if (paw_an_in1%has_vxcval==2) then 1162 do i1=1,nspden 1163 do i2=1,v_size 1164 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxc1_val(:,i2,i1) 1165 indx_dp=indx_dp+cplx_mesh_size 1166 end do 1167 end do 1168 do i1=1,nspden 1169 do i2=1,v_size 1170 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxct1_val(:,i2,i1) 1171 indx_dp=indx_dp+cplx_mesh_size 1172 end do 1173 end do 1174 end if 1175 if (paw_an_in1%has_vxc_ex==2) then 1176 do i1=1,nspden 1177 do i2=1,v_size 1178 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxc_ex(:,i2,i1) 1179 indx_dp=indx_dp+cplx_mesh_size 1180 end do 1181 end do 1182 end if 1183 if (paw_an_in1%has_vhartree==2) then 1184 do i1=1,nspden 1185 do i2=1,lm_size 1186 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vh1(:,i2,i1) 1187 indx_dp=indx_dp+cplx_mesh_size 1188 end do 1189 end do 1190 do i1=1,nspden 1191 do i2=1,lm_size 1192 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vht1(:,i2,i1) 1193 indx_dp=indx_dp+cplx_mesh_size 1194 end do 1195 end do 1196 end if 1197 end do 1198 if (indx_int/=1+buf_int_size) then 1199 msg='Error (1) in paw_an_gather: wrong buffer sizes !' 1200 LIBPAW_BUG(msg) 1201 end if 1202 if (indx_dp/=1+buf_dp_size) then 1203 msg='Error (2) in paw_an_gather: wrong buffer sizes !' 1204 LIBPAW_BUG(msg) 1205 end if 1206 1207 !Communicate (1 gather for integers, 1 gather for reals) 1208 LIBPAW_ALLOCATE(count_int,(nproc_atom)) 1209 LIBPAW_ALLOCATE(displ_int,(nproc_atom)) 1210 LIBPAW_ALLOCATE(count_dp ,(nproc_atom)) 1211 LIBPAW_ALLOCATE(displ_dp ,(nproc_atom)) 1212 LIBPAW_ALLOCATE(count_tot,(2*nproc_atom)) 1213 bufsz(1)=buf_int_size; bufsz(2)=buf_dp_size 1214 call xmpi_allgather(bufsz,2,count_tot,comm_atom,ierr) 1215 do ij=1,nproc_atom 1216 count_int(ij)=count_tot(2*ij-1) 1217 count_dp (ij)=count_tot(2*ij) 1218 end do 1219 displ_int(1)=0;displ_dp(1)=0 1220 do ij=2,nproc_atom 1221 displ_int(ij)=displ_int(ij-1)+count_int(ij-1) 1222 displ_dp (ij)=displ_dp (ij-1)+count_dp (ij-1) 1223 end do 1224 buf_int_size_all=sum(count_int) 1225 buf_dp_size_all =sum(count_dp) 1226 LIBPAW_DEALLOCATE(count_tot) 1227 LIBPAW_ALLOCATE(buf_int_all,(buf_int_size_all)) 1228 LIBPAW_ALLOCATE(buf_dp_all ,(buf_dp_size_all)) 1229 call xmpi_allgatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,comm_atom,ierr) 1230 call xmpi_allgatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,comm_atom,ierr) 1231 LIBPAW_DEALLOCATE(count_int) 1232 LIBPAW_DEALLOCATE(displ_int) 1233 LIBPAW_DEALLOCATE(count_dp) 1234 LIBPAW_DEALLOCATE(displ_dp) 1235 1236 !Fill in output datastructure 1237 indx_int=1; indx_dp=1 1238 call paw_an_free(paw_an_gathered) 1239 call paw_an_nullify(paw_an_gathered) 1240 do iat=1,natom 1241 iatot=buf_int_all(indx_int); indx_int=indx_int+1 1242 paw_an_gathered1=>paw_an_gathered(iatot) 1243 paw_an_gathered1%itypat=buf_int_all(indx_int); indx_int=indx_int+1 1244 paw_an_gathered1%nspden=buf_int_all(indx_int); indx_int=indx_int+1 1245 paw_an_gathered1%cplex=buf_int_all(indx_int); indx_int=indx_int+1 1246 paw_an_gathered1%mesh_size=buf_int_all(indx_int); indx_int=indx_int+1 1247 paw_an_gathered1%angl_size=buf_int_all(indx_int); indx_int=indx_int+1 1248 paw_an_gathered1%lm_size=buf_int_all(indx_int); indx_int=indx_int+1 1249 paw_an_gathered1%nkxc1=buf_int_all(indx_int); indx_int=indx_int+1 1250 paw_an_gathered1%nk3xc1=buf_int_all(indx_int); indx_int=indx_int+1 1251 paw_an_gathered1%has_vxc=buf_int_all(indx_int); indx_int=indx_int+1 1252 paw_an_gathered1%has_vxctau=buf_int_all(indx_int); indx_int=indx_int+1 1253 paw_an_gathered1%has_kxc=buf_int_all(indx_int); indx_int=indx_int+1 1254 paw_an_gathered1%has_k3xc=buf_int_all(indx_int); indx_int=indx_int+1 1255 paw_an_gathered1%has_vxcval=buf_int_all(indx_int); indx_int=indx_int+1 1256 paw_an_gathered1%has_vxc_ex=buf_int_all(indx_int); indx_int=indx_int+1 1257 paw_an_gathered1%has_vhartree=buf_int_all(indx_int); indx_int=indx_int+1 1258 v_size=buf_int_all(indx_int); indx_int=indx_int+1 1259 has_lm_select=buf_int_all(indx_int); indx_int=indx_int+1 1260 nspden=paw_an_gathered1%nspden 1261 lm_size=paw_an_gathered1%lm_size 1262 nkxc1=paw_an_gathered1%nkxc1 1263 nk3xc1=paw_an_gathered1%nk3xc1 1264 cplx_mesh_size=paw_an_gathered1%cplex*paw_an_gathered1%mesh_size 1265 if (has_lm_select==1) then 1266 LIBPAW_ALLOCATE(paw_an_gathered1%lmselect,(lm_size)) 1267 if (lm_size>0) then 1268 do i1=1,lm_size 1269 if (buf_int_all(indx_int)==1) then 1270 paw_an_gathered1%lmselect(i1)=.TRUE.;indx_int=indx_int+1 1271 else 1272 paw_an_gathered1%lmselect(i1)=.FALSE.;indx_int=indx_int+1 1273 end if 1274 end do 1275 end if 1276 end if 1277 if (paw_an_gathered1%has_vxc>0) then 1278 LIBPAW_ALLOCATE(paw_an_gathered1%vxc1,(cplx_mesh_size,v_size,nspden)) 1279 LIBPAW_ALLOCATE(paw_an_gathered1%vxct1,(cplx_mesh_size,v_size,nspden)) 1280 if (paw_an_gathered1%has_vxc==2) then 1281 do i1=1,nspden 1282 do i2=1,v_size 1283 paw_an_gathered1%vxc1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1284 indx_dp=indx_dp+cplx_mesh_size 1285 end do 1286 end do 1287 do i1=1,nspden 1288 do i2=1,v_size 1289 paw_an_gathered1%vxct1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1290 indx_dp=indx_dp+cplx_mesh_size 1291 end do 1292 end do 1293 end if 1294 end if 1295 if (paw_an_gathered1%has_vxctau>0) then 1296 LIBPAW_ALLOCATE(paw_an_gathered1%vxctau1,(cplx_mesh_size,v_size,nspden)) 1297 LIBPAW_ALLOCATE(paw_an_gathered1%vxcttau1,(cplx_mesh_size,v_size,nspden)) 1298 if (paw_an_gathered1%has_vxctau==2) then 1299 do i1=1,nspden 1300 do i2=1,v_size 1301 paw_an_gathered1%vxctau1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1302 indx_dp=indx_dp+cplx_mesh_size 1303 end do 1304 end do 1305 do i1=1,nspden 1306 do i2=1,v_size 1307 paw_an_gathered1%vxcttau1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1308 indx_dp=indx_dp+cplx_mesh_size 1309 end do 1310 end do 1311 end if 1312 end if 1313 if (paw_an_gathered1%has_kxc>0) then 1314 LIBPAW_ALLOCATE(paw_an_gathered1%kxc1,(cplx_mesh_size,v_size,nkxc1)) 1315 LIBPAW_ALLOCATE(paw_an_gathered1%kxct1,(cplx_mesh_size,v_size,nkxc1)) 1316 if (paw_an_gathered1%has_kxc==2.and.nkxc1>0) then 1317 do i1=1,nkxc1 1318 do i2=1,v_size 1319 paw_an_gathered1%kxc1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1320 indx_dp=indx_dp+cplx_mesh_size 1321 end do 1322 end do 1323 do i1=1,nkxc1 1324 do i2=1,v_size 1325 paw_an_gathered1%kxct1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1326 indx_dp=indx_dp+cplx_mesh_size 1327 end do 1328 end do 1329 end if 1330 end if 1331 if (paw_an_gathered1%has_k3xc>0) then 1332 LIBPAW_ALLOCATE(paw_an_gathered1%k3xc1,(cplx_mesh_size,v_size,nk3xc1)) 1333 LIBPAW_ALLOCATE(paw_an_gathered1%k3xct1,(cplx_mesh_size,v_size,nk3xc1)) 1334 if (paw_an_gathered1%has_k3xc==2.and.nk3xc1>0) then 1335 do i1=1,nk3xc1 1336 do i2=1,v_size 1337 paw_an_gathered1%k3xc1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1338 indx_dp=indx_dp+cplx_mesh_size 1339 end do 1340 end do 1341 do i1=1,nk3xc1 1342 do i2=1,v_size 1343 paw_an_gathered1%k3xct1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1344 indx_dp=indx_dp+cplx_mesh_size 1345 end do 1346 end do 1347 end if 1348 end if 1349 if (paw_an_gathered1%has_vxcval>0) then 1350 LIBPAW_ALLOCATE(paw_an_gathered1%vxc1_val,(cplx_mesh_size,v_size,nspden)) 1351 LIBPAW_ALLOCATE(paw_an_gathered1%vxct1_val,(cplx_mesh_size,v_size,nspden)) 1352 if (paw_an_gathered1%has_vxcval==2) then 1353 do i1=1,nspden 1354 do i2=1,v_size 1355 paw_an_gathered1%vxc1_val(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1356 indx_dp=indx_dp+cplx_mesh_size 1357 end do 1358 end do 1359 do i1=1,nspden 1360 do i2=1,v_size 1361 paw_an_gathered1%vxct1_val(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1362 indx_dp=indx_dp+cplx_mesh_size 1363 end do 1364 end do 1365 end if 1366 end if 1367 if (paw_an_gathered1%has_vxc_ex>0) then 1368 LIBPAW_ALLOCATE(paw_an_gathered1%vxc_ex,(cplx_mesh_size,v_size,nspden)) 1369 if (paw_an_gathered1%has_vxc_ex==2) then 1370 do i1=1,nspden 1371 do i2=1,v_size 1372 paw_an_gathered1%vxc_ex(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1373 indx_dp=indx_dp+cplx_mesh_size 1374 end do 1375 end do 1376 end if 1377 end if 1378 if (paw_an_gathered1%has_vhartree>0) then 1379 LIBPAW_ALLOCATE(paw_an_gathered1%vh1,(cplx_mesh_size,lm_size,nspden)) 1380 LIBPAW_ALLOCATE(paw_an_gathered1%vht1,(cplx_mesh_size,lm_size,nspden)) 1381 if (paw_an_gathered1%has_vhartree==2) then 1382 do i1=1,nspden 1383 do i2=1,lm_size 1384 paw_an_gathered1%vh1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1385 indx_dp=indx_dp+cplx_mesh_size 1386 end do 1387 end do 1388 do i1=1,nspden 1389 do i2=1,lm_size 1390 paw_an_gathered1%vht1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1) 1391 indx_dp=indx_dp+cplx_mesh_size 1392 end do 1393 end do 1394 end if 1395 end if 1396 end do ! iat 1397 1398 !Free buffers 1399 LIBPAW_DEALLOCATE(buf_int) 1400 LIBPAW_DEALLOCATE(buf_int_all) 1401 LIBPAW_DEALLOCATE(buf_dp) 1402 LIBPAW_DEALLOCATE(buf_dp_all) 1403 1404 !Destroy atom table 1405 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 1406 1407 end subroutine paw_an_gather
m_paw_an/paw_an_init [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_init
FUNCTION
Initialize a paw_an data type.
INPUTS
mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc comm_atom=--optional-- MPI communicator over atoms
SIDE EFFECTS
Paw_an(:)<type(paw_an_type)>=PAW arrays given on ANgular mesh or ANgular moments. Initialized in output
SOURCE
238 subroutine paw_an_init(Paw_an,natom,ntypat,nkxc1,nk3xc1,nspden,cplex,pawxcdev,typat,Pawang,Pawtab,& 239 & has_vhartree,has_vxc,has_vxctau,has_vxcval,has_kxc,has_k3xc,has_vxc_ex, & ! optional arguments 240 & mpi_atmtab,comm_atom) ! optional arguments (parallelism) 241 242 !Arguments ------------------------------------ 243 !scalars 244 integer,intent(in) :: natom,nkxc1,nk3xc1,ntypat,cplex,nspden,pawxcdev 245 integer,optional,intent(in) :: has_vhartree,has_vxc,has_vxctau,has_vxcval,has_kxc,has_k3xc,has_vxc_ex 246 integer,optional,intent(in) :: comm_atom 247 !arrays 248 integer,intent(in) :: typat(natom) 249 integer,optional,target,intent(in) :: mpi_atmtab(:) 250 type(Pawang_type),intent(in) :: Pawang 251 type(Pawtab_type),intent(in) :: Pawtab(ntypat) 252 type(Paw_an_type),intent(inout) :: Paw_an(:) 253 254 !Local variables------------------------------- 255 !scalars 256 integer :: iat,iat1,itypat,lm_size,my_comm_atom,my_natom,v_size 257 logical :: my_atmtab_allocated,paral_atom 258 !arrays 259 integer,pointer :: my_atmtab(:) 260 261 ! ************************************************************************* 262 263 !@Paw_an_type 264 265 !Set up parallelism over atoms 266 my_natom=size(Paw_an);if (my_natom==0) return 267 paral_atom=(present(comm_atom).and.(my_natom/=natom)) 268 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 269 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 270 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom) 271 272 do iat=1,my_natom 273 iat1=iat;if (paral_atom) iat1=my_atmtab(iat) 274 itypat=typat(iat1) 275 276 lm_size =Pawtab(itypat)%lcut_size**2 277 Paw_an(iat)%angl_size =Pawang%angl_size 278 Paw_an(iat)%cplex =cplex 279 Paw_an(iat)%itypat =itypat 280 Paw_an(iat)%lm_size =lm_size 281 Paw_an(iat)%mesh_size =Pawtab(itypat)%mesh_size 282 Paw_an(iat)%nkxc1 =nkxc1 283 Paw_an(iat)%nk3xc1 =nk3xc1 284 Paw_an(iat)%nspden =nspden 285 286 ! === Non-zero LM-moments of "one-center" densities/potentials === 287 ! * Filled in pawdenpot. 288 LIBPAW_ALLOCATE(Paw_an(iat)%lmselect,(lm_size)) 289 290 v_size=Paw_an(iat)%lm_size ; if (pawxcdev==0) v_size=Paw_an(iat)%angl_size 291 292 ! === XC potential inside the sphere === 293 ! * LM-moments of potential if pawxcdev/=0 294 ! * (theta,phi) values of potential if pawxcdev=0 295 Paw_an(iat)%has_vxc=0 296 if (PRESENT(has_vxc)) then 297 if (has_vxc>0) then 298 Paw_an(iat)%has_vxc=1 299 LIBPAW_ALLOCATE(Paw_an(iat)%vxc1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 300 LIBPAW_ALLOCATE(Paw_an(iat)%vxct1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 301 Paw_an(iat)%vxc1=zero;Paw_an(iat)%vxct1=zero 302 end if 303 end if 304 305 Paw_an(iat)%has_vxctau=0 306 if (PRESENT(has_vxctau)) then 307 if (has_vxctau>0) then 308 Paw_an(iat)%has_vxctau=1 309 LIBPAW_ALLOCATE(Paw_an(iat)%vxctau1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 310 LIBPAW_ALLOCATE(Paw_an(iat)%vxcttau1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 311 Paw_an(iat)%vxctau1=zero;Paw_an(iat)%vxcttau1=zero 312 end if 313 end if 314 315 ! ========================== 316 ! === Optional arguments === 317 ! ========================== 318 319 ! * XC potential inside PAW spheres generated by valence electrons 320 Paw_an(iat)%has_vxcval=0 321 if (PRESENT(has_vxcval)) then 322 if (has_vxcval>0) then 323 Paw_an(iat)%has_vxcval=1 324 LIBPAW_ALLOCATE(Paw_an(iat)%vxc1_val ,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 325 LIBPAW_ALLOCATE(Paw_an(iat)%vxct1_val,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 326 Paw_an(iat)%vxc1_val=zero;Paw_an(iat)%vxct1_val=zero 327 end if 328 end if 329 330 ! * Hartree potential LM-moments inside the sphere 331 Paw_an(iat)%has_vhartree=0 332 if (PRESENT(has_vhartree)) then 333 if (has_vhartree>0) then 334 Paw_an(iat)%has_vhartree=1 335 LIBPAW_ALLOCATE(Paw_an(iat)%vh1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 336 LIBPAW_ALLOCATE(Paw_an(iat)%vht1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 337 Paw_an(iat)%vh1=zero;Paw_an(iat)%vht1=zero 338 end if 339 end if 340 341 ! xc kernels inside the sphere 342 Paw_an(iat)%has_kxc=0 343 if (PRESENT(has_kxc)) then 344 if (has_kxc>0) then 345 Paw_an(iat)%has_kxc=1 346 LIBPAW_ALLOCATE(Paw_an(iat)%kxc1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nkxc1)) 347 LIBPAW_ALLOCATE(Paw_an(iat)%kxct1,(cplex*Paw_an(iat)%mesh_size,v_size,nkxc1)) 348 if (nkxc1>0) then 349 Paw_an(iat)%kxc1=zero;Paw_an(iat)%kxct1=zero 350 end if 351 end if 352 end if 353 354 ! xc kernel derivatives inside the sphere 355 Paw_an(iat)%has_k3xc=0 356 if (PRESENT(has_k3xc)) then 357 if (has_k3xc>0) then 358 Paw_an(iat)%has_k3xc=1 359 LIBPAW_ALLOCATE(Paw_an(iat)%k3xc1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nk3xc1)) 360 LIBPAW_ALLOCATE(Paw_an(iat)%k3xct1,(cplex*Paw_an(iat)%mesh_size,v_size,nk3xc1)) 361 if (nk3xc1>0) then 362 Paw_an(iat)%k3xc1=zero;Paw_an(iat)%k3xct1=zero 363 end if 364 end if 365 end if 366 367 ! local exact-exchange potential inside the sphere 368 Paw_an(iat)%has_vxc_ex=0 369 if (PRESENT(has_vxc_ex)) then 370 if (has_vxc_ex>0.and.Pawtab(itypat)%useexexch/=0) then 371 Paw_an(iat)%has_vxc_ex=1 372 LIBPAW_ALLOCATE(Paw_an(iat)%vxc_ex,(cplex*Paw_an(iat)%mesh_size,v_size,nspden)) 373 Paw_an(iat)%vxc_ex=zero 374 end if 375 end if 376 377 end do !iat 378 379 !Destroy atom table used for parallelism 380 call free_my_atmtab(my_atmtab,my_atmtab_allocated) 381 382 end subroutine paw_an_init
m_paw_an/paw_an_isendreceive_fillbuffer [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_isendreceive_fillbuffer
FUNCTION
Extract from paw_an 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 paw_ij_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
npaw_an_send= number of sent atoms
paw_an= data structure from which are extract buffer int and buffer dp
OUTPUT
buf_int : buffer of integers to be send in a send operation buf_int_size : size of buffer of integers to be send in a send operation buf_dp : buffer of double precision numbers to be send in a send operation buf_dp_size : size of buffer of double precision numbers to be send in a send operation
SOURCE
2042 subroutine paw_an_isendreceive_fillbuffer(paw_an, atmtab_send,atm_indx_send,npaw_an_send,& 2043 & buf_int,buf_int_size,buf_dp,buf_dp_size) 2044 2045 !Arguments ------------------------------------ 2046 !scalars 2047 integer,intent(out) :: buf_int_size,buf_dp_size 2048 integer,intent(in) :: npaw_an_send 2049 !arrays 2050 integer,intent(in) :: atmtab_send(:),atm_indx_send(:) 2051 integer,allocatable,intent(out) :: buf_int(:) 2052 real(dp),allocatable,intent(out):: buf_dp(:) 2053 type(paw_an_type),target,intent(in) :: paw_an(:) 2054 2055 !Local variables------------------------------- 2056 !scalars 2057 integer :: cplx_mesh_size,i1,i2,iatom_tot,ij,indx_int,indx_dp 2058 integer :: ipaw_an_send,lm_size,nspden,v_size 2059 character(len=500) :: msg 2060 type(Paw_an_type),pointer :: paw_an1 2061 !arrays 2062 2063 ! ********************************************************************* 2064 2065 !Compute sizes of buffers 2066 buf_int_size=0 ; buf_dp_size=0 2067 do ipaw_an_send=1,npaw_an_send 2068 iatom_tot=atmtab_send(ipaw_an_send) 2069 ij = atm_indx_send(iatom_tot) 2070 paw_an1=>paw_an(ij) 2071 buf_int_size=buf_int_size+18+size(paw_an1%lmselect) 2072 if (paw_an1%has_vxc==2) then 2073 buf_dp_size=buf_dp_size+size(paw_an1%vxc1) 2074 buf_dp_size=buf_dp_size+size(paw_an1%vxct1) 2075 end if 2076 if (paw_an1%has_vxctau==2) then 2077 buf_dp_size=buf_dp_size+size(paw_an1%vxctau1) 2078 buf_dp_size=buf_dp_size+size(paw_an1%vxcttau1) 2079 end if 2080 if (paw_an1%has_kxc==2) then 2081 buf_dp_size=buf_dp_size+size(paw_an1%kxc1) 2082 buf_dp_size=buf_dp_size+size(paw_an1%kxct1) 2083 end if 2084 if (paw_an1%has_k3xc==2) then 2085 buf_dp_size=buf_dp_size+size(paw_an1%k3xc1) 2086 buf_dp_size=buf_dp_size+size(paw_an1%k3xct1) 2087 end if 2088 if (paw_an1%has_vxcval==2) then 2089 buf_dp_size=buf_dp_size+size(paw_an1%vxc1_val) 2090 buf_dp_size=buf_dp_size+size(paw_an1%vxct1_val) 2091 end if 2092 if (paw_an1%has_vxc_ex==2) then 2093 buf_dp_size=buf_dp_size+size(paw_an1%vxc_ex) 2094 end if 2095 if (paw_an1%has_vhartree==2) then 2096 buf_dp_size=buf_dp_size+size(paw_an1%vh1) 2097 buf_dp_size=buf_dp_size+size(paw_an1%vht1) 2098 end if 2099 end do 2100 2101 !Fill in input buffers 2102 LIBPAW_ALLOCATE(buf_int,(buf_int_size)) 2103 LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size)) 2104 indx_int=1;indx_dp=1 2105 do ipaw_an_send=1,npaw_an_send 2106 iatom_tot=atmtab_send(ipaw_an_send) 2107 ij = atm_indx_send(iatom_tot) 2108 paw_an1=>paw_an(ij) 2109 buf_int(indx_int)=iatom_tot; indx_int=indx_int+1 2110 buf_int(indx_int)=paw_an1%itypat; indx_int=indx_int+1 2111 buf_int(indx_int)=paw_an1%nspden; indx_int=indx_int+1 2112 buf_int(indx_int)=paw_an1%cplex; indx_int=indx_int+1 2113 buf_int(indx_int)=paw_an1%mesh_size; indx_int=indx_int+1 2114 buf_int(indx_int)=paw_an1%angl_size; indx_int=indx_int+1 2115 buf_int(indx_int)=paw_an1%lm_size; indx_int=indx_int+1 2116 buf_int(indx_int)=paw_an1%nkxc1; indx_int=indx_int+1 2117 buf_int(indx_int)=paw_an1%nk3xc1; indx_int=indx_int+1 2118 buf_int(indx_int)=paw_an1%has_vxc; indx_int=indx_int+1 2119 buf_int(indx_int)=paw_an1%has_vxctau; indx_int=indx_int+1 2120 buf_int(indx_int)=paw_an1%has_kxc; indx_int=indx_int+1 2121 buf_int(indx_int)=paw_an1%has_k3xc; indx_int=indx_int+1 2122 buf_int(indx_int)=paw_an1%has_vxcval; indx_int=indx_int+1 2123 buf_int(indx_int)=paw_an1%has_vxc_ex; indx_int=indx_int+1 2124 buf_int(indx_int)=paw_an1%has_vhartree; indx_int=indx_int+1 2125 v_size=0 2126 if (paw_an1%has_vxc>0) then 2127 v_size=size(paw_an1%vxc1,2) 2128 else if (paw_an1%has_vxctau>0) then 2129 v_size=size(paw_an1%vxctau1,2) 2130 else if (paw_an1%has_kxc>0) then 2131 v_size=size(paw_an1%kxc1,2) 2132 else if (paw_an1%has_k3xc>0) then 2133 v_size=size(paw_an1%k3xc1,2) 2134 else if (paw_an1%has_vxcval>0) then 2135 v_size=size(paw_an1%vxc1_val,2) 2136 else if (paw_an1%has_vxc_ex>0) then 2137 v_size=size(paw_an1%vxc_ex,2) 2138 else if (paw_an1%has_vhartree>0) then 2139 v_size=size(paw_an1%vh1,2) 2140 end if 2141 buf_int(indx_int)=v_size;indx_int=indx_int+1 2142 if (allocated(paw_an1%lmselect)) then 2143 buf_int(indx_int)=1;indx_int=indx_int+1 2144 else 2145 buf_int(indx_int)=0;indx_int=indx_int+1 2146 end if 2147 nspden=paw_an1%nspden 2148 lm_size=paw_an1%lm_size 2149 cplx_mesh_size=paw_an1%cplex*paw_an1%mesh_size 2150 if (lm_size>0) then 2151 if (allocated(paw_an1%lmselect)) then 2152 do i1=1,lm_size 2153 if (paw_an1%lmselect(i1)) then 2154 buf_int(indx_int)=1 2155 else 2156 buf_int(indx_int)=0 2157 end if 2158 indx_int=indx_int+1 2159 end do 2160 end if 2161 end if 2162 if (paw_an1%has_vxc==2) then 2163 do i1=1,nspden 2164 do i2=1,v_size 2165 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxc1(:,i2,i1) 2166 indx_dp=indx_dp+cplx_mesh_size 2167 end do 2168 end do 2169 do i1=1,nspden 2170 do i2=1,v_size 2171 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxct1(:,i2,i1) 2172 indx_dp=indx_dp+cplx_mesh_size 2173 end do 2174 end do 2175 end if 2176 if (paw_an1%has_vxctau==2) then 2177 do i1=1,nspden 2178 do i2=1,v_size 2179 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxctau1(:,i2,i1) 2180 indx_dp=indx_dp+cplx_mesh_size 2181 end do 2182 end do 2183 do i1=1,nspden 2184 do i2=1,v_size 2185 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxcttau1(:,i2,i1) 2186 indx_dp=indx_dp+cplx_mesh_size 2187 end do 2188 end do 2189 end if 2190 if (paw_an1%has_kxc==2.and.paw_an1%nkxc1>0) then 2191 do i1=1,paw_an1%nkxc1 2192 do i2=1,v_size 2193 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%kxc1(:,i2,i1) 2194 indx_dp=indx_dp+cplx_mesh_size 2195 end do 2196 end do 2197 do i1=1,paw_an1%nkxc1 2198 do i2=1,v_size 2199 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%kxct1(:,i2,i1) 2200 indx_dp=indx_dp+cplx_mesh_size 2201 end do 2202 end do 2203 end if 2204 if (paw_an1%has_k3xc==2.and.paw_an1%nk3xc1>0) then 2205 do i1=1,paw_an1%nk3xc1 2206 do i2=1,v_size 2207 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%k3xc1(:,i2,i1) 2208 indx_dp=indx_dp+cplx_mesh_size 2209 end do 2210 end do 2211 do i1=1,paw_an1%nk3xc1 2212 do i2=1,v_size 2213 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%k3xct1(:,i2,i1) 2214 indx_dp=indx_dp+cplx_mesh_size 2215 end do 2216 end do 2217 end if 2218 if (paw_an1%has_vxcval==2) then 2219 do i1=1,nspden 2220 do i2=1,v_size 2221 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxc1_val(:,i2,i1) 2222 indx_dp=indx_dp+cplx_mesh_size 2223 end do 2224 end do 2225 do i1=1,nspden 2226 do i2=1,v_size 2227 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxct1_val(:,i2,i1) 2228 indx_dp=indx_dp+cplx_mesh_size 2229 end do 2230 end do 2231 end if 2232 if (paw_an1%has_vxc_ex==2) then 2233 do i1=1,nspden 2234 do i2=1,v_size 2235 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxc_ex(:,i2,i1) 2236 indx_dp=indx_dp+cplx_mesh_size 2237 end do 2238 end do 2239 end if 2240 if (paw_an1%has_vhartree==2) then 2241 do i1=1,nspden 2242 do i2=1,lm_size 2243 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vh1(:,i2,i1) 2244 indx_dp=indx_dp+cplx_mesh_size 2245 end do 2246 end do 2247 do i1=1,nspden 2248 do i2=1,lm_size 2249 buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vht1(:,i2,i1) 2250 indx_dp=indx_dp+cplx_mesh_size 2251 end do 2252 end do 2253 end if 2254 end do 2255 if ((indx_int-1/=buf_int_size).or.(indx_dp-1/=buf_dp_size)) then 2256 write(msg,'(4(a,i10))') 'Wrong buffer sizes: buf_int =',buf_int_size,'/',indx_int-1,& 2257 & ' buf_dp =',buf_dp_size ,'/',indx_dp-1 2258 LIBPAW_BUG(msg) 2259 end if 2260 2261 end subroutine paw_an_isendreceive_fillbuffer
m_paw_an/paw_an_isendreceive_getbuffer [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_isendreceive_getbuffer
FUNCTION
Fill a paw_an structure with the buffers received in a receive operation This buffer should have been first extracted by a call to paw_an_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
npaw_an_send= number of sent atoms
OUTPUT
paw_an= output datastructure filled with buffers receive in a receive operation
SOURCE
1825 subroutine paw_an_isendreceive_getbuffer(paw_an,npaw_an_send,atm_indx_recv,buf_int,buf_dp) 1826 1827 !Arguments ------------------------------------ 1828 !scalars 1829 integer,intent(in) :: npaw_an_send 1830 !arrays 1831 integer,intent(in) ::atm_indx_recv(:),buf_int(:) 1832 real(dp),intent(in):: buf_dp(:) 1833 type(paw_an_type),target,intent(inout) :: paw_an(:) 1834 1835 !Local variables------------------------------- 1836 !scalars 1837 integer :: buf_int_size,buf_dp_size,cplx_mesh_size,has_lm_select,i1,i2 1838 integer :: iat,iatot,ij,indx_int,indx_dp,lm_size,nkxc1,nk3xc1,nspden,v_size 1839 character(len=500) :: msg 1840 type(paw_an_type),pointer :: paw_an1 1841 !arrays 1842 1843 ! ********************************************************************* 1844 1845 buf_int_size=size(buf_int) 1846 buf_dp_size=size(buf_dp) 1847 indx_int=1; indx_dp=1 1848 1849 do ij=1,npaw_an_send 1850 iatot=buf_int(indx_int); indx_int=indx_int+1 1851 iat= atm_indx_recv(iatot) 1852 paw_an1=>paw_an(iat) 1853 paw_an1%itypat=buf_int(indx_int); indx_int=indx_int+1 1854 paw_an1%nspden=buf_int(indx_int); indx_int=indx_int+1 1855 paw_an1%cplex=buf_int(indx_int); indx_int=indx_int+1 1856 paw_an1%mesh_size=buf_int(indx_int); indx_int=indx_int+1 1857 paw_an1%angl_size=buf_int(indx_int); indx_int=indx_int+1 1858 paw_an1%lm_size=buf_int(indx_int); indx_int=indx_int+1 1859 paw_an1%nkxc1=buf_int(indx_int); indx_int=indx_int+1 1860 paw_an1%nk3xc1=buf_int(indx_int); indx_int=indx_int+1 1861 paw_an1%has_vxc=buf_int(indx_int); indx_int=indx_int+1 1862 paw_an1%has_vxctau=buf_int(indx_int); indx_int=indx_int+1 1863 paw_an1%has_kxc=buf_int(indx_int); indx_int=indx_int+1 1864 paw_an1%has_k3xc=buf_int(indx_int); indx_int=indx_int+1 1865 paw_an1%has_vxcval=buf_int(indx_int); indx_int=indx_int+1 1866 paw_an1%has_vxc_ex=buf_int(indx_int); indx_int=indx_int+1 1867 paw_an1%has_vhartree=buf_int(indx_int); indx_int=indx_int+1 1868 v_size=buf_int(indx_int); indx_int=indx_int+1 1869 has_lm_select=buf_int(indx_int); indx_int=indx_int+1 1870 nspden=paw_an1%nspden 1871 lm_size=paw_an1%lm_size 1872 nkxc1=paw_an1%nkxc1 1873 nk3xc1=paw_an1%nk3xc1 1874 cplx_mesh_size=paw_an1%cplex*paw_an1%mesh_size 1875 if (has_lm_select==1) then 1876 LIBPAW_ALLOCATE(paw_an1%lmselect,(lm_size)) 1877 if (lm_size>0) then 1878 do i1=1,lm_size 1879 if (buf_int(indx_int)==1) then 1880 paw_an1%lmselect(i1)=.TRUE.;indx_int=indx_int+1 1881 else 1882 paw_an1%lmselect(i1)=.FALSE.;indx_int=indx_int+1 1883 end if 1884 end do 1885 end if 1886 end if 1887 if (paw_an1%has_vxc>0) then 1888 LIBPAW_ALLOCATE(paw_an1%vxc1,(cplx_mesh_size,v_size,nspden)) 1889 LIBPAW_ALLOCATE(paw_an1%vxct1,(cplx_mesh_size,v_size,nspden)) 1890 if (paw_an1%has_vxc==2) then 1891 do i1=1,nspden 1892 do i2=1,v_size 1893 paw_an1%vxc1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1894 indx_dp=indx_dp+cplx_mesh_size 1895 end do 1896 end do 1897 do i1=1,nspden 1898 do i2=1,v_size 1899 paw_an1%vxct1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1900 indx_dp=indx_dp+cplx_mesh_size 1901 end do 1902 end do 1903 end if 1904 end if 1905 if (paw_an1%has_vxctau>0) then 1906 LIBPAW_ALLOCATE(paw_an1%vxctau1,(cplx_mesh_size,v_size,nspden)) 1907 LIBPAW_ALLOCATE(paw_an1%vxcttau1,(cplx_mesh_size,v_size,nspden)) 1908 if (paw_an1%has_vxctau==2) then 1909 do i1=1,nspden 1910 do i2=1,v_size 1911 paw_an1%vxctau1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1912 indx_dp=indx_dp+cplx_mesh_size 1913 end do 1914 end do 1915 do i1=1,nspden 1916 do i2=1,v_size 1917 paw_an1%vxcttau1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1918 indx_dp=indx_dp+cplx_mesh_size 1919 end do 1920 end do 1921 end if 1922 end if 1923 if (paw_an1%has_kxc>0) then 1924 LIBPAW_ALLOCATE(paw_an1%kxc1,(cplx_mesh_size,v_size,nkxc1)) 1925 LIBPAW_ALLOCATE(paw_an1%kxct1,(cplx_mesh_size,v_size,nkxc1)) 1926 if (paw_an1%has_kxc==2.and.nkxc1>0) then 1927 do i1=1,nkxc1 1928 do i2=1,v_size 1929 paw_an1%kxc1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1930 indx_dp=indx_dp+cplx_mesh_size 1931 end do 1932 end do 1933 do i1=1,nkxc1 1934 do i2=1,v_size 1935 paw_an1%kxct1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1936 indx_dp=indx_dp+cplx_mesh_size 1937 end do 1938 end do 1939 end if 1940 end if 1941 if (paw_an1%has_k3xc>0) then 1942 LIBPAW_ALLOCATE(paw_an1%k3xc1,(cplx_mesh_size,v_size,nk3xc1)) 1943 LIBPAW_ALLOCATE(paw_an1%k3xct1,(cplx_mesh_size,v_size,nk3xc1)) 1944 if (paw_an1%has_k3xc==2.and.nk3xc1>0) then 1945 do i1=1,nk3xc1 1946 do i2=1,v_size 1947 paw_an1%k3xc1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1948 indx_dp=indx_dp+cplx_mesh_size 1949 end do 1950 end do 1951 do i1=1,nk3xc1 1952 do i2=1,v_size 1953 paw_an1%k3xct1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1954 indx_dp=indx_dp+cplx_mesh_size 1955 end do 1956 end do 1957 end if 1958 end if 1959 if (paw_an1%has_vxcval>0) then 1960 LIBPAW_ALLOCATE(paw_an1%vxc1_val,(cplx_mesh_size,v_size,nspden)) 1961 LIBPAW_ALLOCATE(paw_an1%vxct1_val,(cplx_mesh_size,v_size,nspden)) 1962 if (paw_an1%has_vxcval==2) then 1963 do i1=1,nspden 1964 do i2=1,v_size 1965 paw_an1%vxc1_val(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1966 indx_dp=indx_dp+cplx_mesh_size 1967 end do 1968 end do 1969 do i1=1,nspden 1970 do i2=1,v_size 1971 paw_an1%vxct1_val(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1972 indx_dp=indx_dp+cplx_mesh_size 1973 end do 1974 end do 1975 end if 1976 end if 1977 if (paw_an1%has_vxc_ex>0) then 1978 LIBPAW_ALLOCATE(paw_an1%vxc_ex,(cplx_mesh_size,v_size,nspden)) 1979 if (paw_an1%has_vxc_ex==2) then 1980 do i1=1,nspden 1981 do i2=1,v_size 1982 paw_an1%vxc_ex(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1983 indx_dp=indx_dp+cplx_mesh_size 1984 end do 1985 end do 1986 end if 1987 end if 1988 if (paw_an1%has_vhartree>0) then 1989 LIBPAW_ALLOCATE(paw_an1%vh1,(cplx_mesh_size,lm_size,nspden)) 1990 LIBPAW_ALLOCATE(paw_an1%vht1,(cplx_mesh_size,lm_size,nspden)) 1991 if (paw_an1%has_vhartree==2) then 1992 do i1=1,nspden 1993 do i2=1,lm_size 1994 paw_an1%vh1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 1995 indx_dp=indx_dp+cplx_mesh_size 1996 end do 1997 end do 1998 do i1=1,nspden 1999 do i2=1,lm_size 2000 paw_an1%vht1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1) 2001 indx_dp=indx_dp+cplx_mesh_size 2002 end do 2003 end do 2004 end if 2005 end if 2006 end do ! iat 2007 if ((indx_int/=1+buf_int_size).or.(indx_dp/=1+buf_dp_size)) then 2008 write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size 2009 LIBPAW_BUG(msg) 2010 end if 2011 2012 end subroutine paw_an_isendreceive_getbuffer
m_paw_an/paw_an_nullify [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_nullify
FUNCTION
Nullify pointers and flags in a paw_an structure
INPUTS
SIDE EFFECTS
Paw_an(:)<type(paw_an_type)>=PAW arrays given on ANgular mesh or ANgular moments. Nullified in output
SOURCE
490 subroutine paw_an_nullify(Paw_an) 491 492 !Arguments ------------------------------------ 493 type(Paw_an_type),intent(inout) :: Paw_an(:) 494 495 !Local variables------------------------------- 496 integer :: iat,natom 497 498 ! ************************************************************************* 499 500 !@Paw_an_type 501 ! MGPAW: This one could be removed/renamed, 502 ! variables can be initialized in the datatype declaration 503 ! Do we need to expose this in the public API? 504 505 natom=SIZE(Paw_an(:));if (natom==0) return 506 507 do iat=1,natom 508 ! Set all has_* flags to zero. 509 Paw_an(iat)%has_kxc =0 510 Paw_an(iat)%has_k3xc =0 511 Paw_an(iat)%has_vhartree =0 512 Paw_an(iat)%has_vxc =0 513 Paw_an(iat)%has_vxctau =0 514 Paw_an(iat)%has_vxcval =0 515 Paw_an(iat)%has_vxc_ex =0 516 end do 517 518 end subroutine paw_an_nullify
m_paw_an/paw_an_print [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_print
FUNCTION
Reports basic info on a paw_an datastructure
INPUTS
[unit]=the unit number for output
[mode_paral]=either "COLL" or "PERS"
[mpi_atmtab(:)]=indexes of the atoms treated by current proc (can be computed here)
[comm_atom]=MPI communicator over atoms (needed if parallelism over atoms is activated)
[natom]=total number of atom (needed if parallelism over atoms is activated)
if Paw_an is distributed, natom is different from size(Paw_an).
OUTPUT
(only writing)
SOURCE
748 subroutine paw_an_print(Paw_an,unit,mode_paral, & 749 & mpi_atmtab,comm_atom,natom) 750 751 !Arguments ------------------------------------ 752 !scalars 753 integer,optional,intent(in) :: comm_atom,natom,unit 754 character(len=4),optional,intent(in) :: mode_paral 755 !arrays 756 integer,optional,target,intent(in) :: mpi_atmtab(:) 757 type(Paw_an_type),intent(in) :: Paw_an(:) 758 759 !Local variables------------------------------- 760 !scalars 761 integer :: iatom,iatom_tot,my_comm_atom,my_natom,my_unt,size_paw_an 762 logical :: my_atmtab_allocated,paral_atom 763 character(len=4) :: my_mode 764 character(len=500) :: msg 765 !arrays 766 integer,pointer :: my_atmtab(:) 767 768 ! ************************************************************************* 769 770 !@Paw_an_type 771 772 size_paw_an=SIZE(Paw_an) 773 my_unt =std_out; if (PRESENT(unit )) my_unt =unit 774 my_mode ='PERS' ; if (PRESENT(mode_paral)) my_mode =mode_paral 775 my_natom=size_paw_an; if (PRESENT(natom)) my_natom=natom 776 777 !Set up parallelism over atoms 778 paral_atom=(present(comm_atom).and.my_natom/=size_paw_an) 779 nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab 780 my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom 781 call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,my_natom,my_natom_ref=size_paw_an) 782 783 write(msg,'(3a)')ch10,' === Content of the pawfgrtab datatype === ',ch10 784 call wrtout(my_unt,msg,my_mode) 785 786 do iatom=1,my_natom 787 iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom) 788 write(msg,'(a)')' ' 789 call wrtout(my_unt,msg,my_mode) 790 write(msg,'(a,i4)')' ****************************** iatom= ' , iatom_tot 791 call wrtout(my_unt,msg,my_mode) 792 write(msg,'(a,i4)')' Dimension of paw angular mesh= ',paw_an(iatom)%angl_size 793 call wrtout(my_unt,msg,my_mode) 794 write(msg,'(a,i4)')' cplex (1 if potentials/densities are real, 2 if they are complex)= ',& 795 & paw_an(iatom)%cplex 796 call wrtout(my_unt,msg,my_mode) 797 write(msg,'(a,i4)')' has_kxc = ',paw_an(iatom)%has_kxc 798 call wrtout(my_unt,msg,my_mode) 799 write(msg,'(a,i4)')' has_k3xc = ',paw_an(iatom)%has_k3xc 800 call wrtout(my_unt,msg,my_mode) 801 write(msg,'(a,i4)')' has_vhartree= ',paw_an(iatom)%has_vhartree 802 call wrtout(my_unt,msg,my_mode) 803 write(msg,'(a,i4)')' has_vxc = ',paw_an(iatom)%has_vxc 804 call wrtout(my_unt,msg,my_mode) 805 write(msg,'(a,i4)')' has_vxctau = ',paw_an(iatom)%has_vxctau 806 call wrtout(my_unt,msg,my_mode) 807 write(msg,'(a,i4)')' has_vxcval = ',paw_an(iatom)%has_vxcval 808 call wrtout(my_unt,msg,my_mode) 809 write(msg,'(a,i4)')' has_vxc_ex = ',paw_an(iatom)%has_vxc_ex 810 call wrtout(my_unt,msg,my_mode) 811 write(msg,'(a,i4)')' Atome type = ',paw_an(iatom)%itypat 812 call wrtout(my_unt,msg,my_mode) 813 write(msg,'(a,i4)')' lm_size = ',paw_an(iatom)%lm_size 814 call wrtout(my_unt,msg,my_mode) 815 write(msg,'(a,i4)')' mesh_size = ',paw_an(iatom)%mesh_size 816 call wrtout(my_unt,msg,my_mode) 817 write(msg,'(a,i4)')' nkxc1 = ',paw_an(iatom)%nkxc1 818 call wrtout(my_unt,msg,my_mode) 819 write(msg,'(a,i4)')' nk3xc1 = ',paw_an(iatom)%nk3xc1 820 call wrtout(my_unt,msg,my_mode) 821 write(msg,'(a,i4)')' nspden = ',paw_an(iatom)%nspden 822 call wrtout(my_unt,msg,my_mode) 823 end do 824 825 end subroutine paw_an_print
m_paw_an/paw_an_redistribute [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_redistribute
FUNCTION
Redistribute an array of paw_an datastructures Input paw_an is given on a MPI communicator Output paw_an 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 paw_an treated by current proc
if not present, will be calculated in the present routine
mpi_atmtab_out= --optional-- indexes of the output paw_an 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
[paw_an_out(:)]<type(paw_an_type)>= --optional-- if present, the redistributed datastructure does not replace the input one but is delivered in paw_an_out if not present, input and output datastructure are the same.
SIDE EFFECTS
paw_an(:)<type(paw_an_type)>= input (and eventually output) paw_an datastructures
SOURCE
1448 subroutine paw_an_redistribute(paw_an,mpi_comm_in,mpi_comm_out,& 1449 & natom,mpi_atmtab_in,mpi_atmtab_out,paw_an_out,& 1450 & SendAtomProc,SendAtomList,RecvAtomProc,RecvAtomList) 1451 1452 !Arguments ------------------------------------ 1453 !scalars 1454 integer,intent(in) :: mpi_comm_in,mpi_comm_out 1455 integer,optional,intent(in) :: natom 1456 !arrays 1457 integer,intent(in),optional,target :: mpi_atmtab_in(:),mpi_atmtab_out(:) 1458 type(paw_an_type),allocatable,intent(inout) :: paw_an(:) 1459 type(paw_an_type),pointer,optional :: paw_an_out(:) !vz_i 1460 integer,intent(in),optional :: SendAtomProc(:),SendAtomList(:),RecvAtomProc(:),RecvAtomList(:) 1461 1462 !Local variables------------------------------- 1463 !scalars 1464 1465 integer :: algo_option,i1,iat_in,iat_out,iatom,ierr,iircv,iisend,imsg,imsg_current,imsg1 1466 integer :: iproc_rcv,iproc_send,ireq,me_exch,mpi_comm_exch,my_natom_in,my_natom_out,my_tag,natom_tot,nb_msg 1467 integer :: nb_dp,nb_int,nbmsg_incoming,nbrecvmsg,nbsend,nbsendreq,nbsent,nbrecv,next,npaw_an_sent 1468 integer :: nproc_in,nproc_out 1469 logical :: flag,in_place,message_yet_prepared,my_atmtab_in_allocated,my_atmtab_out_allocated,paral_atom 1470 !arrays 1471 integer :: buf_size(3),request1(3) 1472 integer,pointer :: my_atmtab_in(:),my_atmtab_out(:) 1473 integer,allocatable :: atmtab_send(:),atm_indx_in(:),atm_indx_out(:),buf_int1(:),From(:),request(:) 1474 integer,allocatable,target:: buf_int(:) 1475 integer,pointer :: buf_ints(:) 1476 logical, allocatable :: msg_pick(:) 1477 real(dp),allocatable :: buf_dp1(:) 1478 real(dp),allocatable,target :: buf_dp(:) 1479 real(dp),pointer :: buf_dps(:) 1480 type(coeffi1_type),target,allocatable :: tab_buf_int(:),tab_buf_atom(:) 1481 type(coeff1_type),target,allocatable :: tab_buf_dp(:) 1482 type(paw_an_type),allocatable :: paw_an_all(:) 1483 type(paw_an_type),pointer :: paw_an_out1(:) 1484 1485 ! ************************************************************************* 1486 1487 !@paw_an_type 1488 1489 in_place=(.not.present(paw_an_out)) 1490 my_natom_in=size(paw_an) 1491 1492 !If not "in_place", destroy the output datastructure 1493 if (.not.in_place) then 1494 if (associated(paw_an_out)) then 1495 call paw_an_free(paw_an_out) 1496 LIBPAW_DATATYPE_DEALLOCATE(paw_an_out) 1497 end if 1498 end if 1499 1500 !Special sequential case 1501 if (mpi_comm_in==xmpi_comm_self.and.mpi_comm_out==xmpi_comm_self) then 1502 if ((.not.in_place).and.(my_natom_in>0)) then 1503 LIBPAW_DATATYPE_ALLOCATE(paw_an_out,(my_natom_in)) 1504 call paw_an_nullify(paw_an_out) 1505 call paw_an_copy(paw_an,paw_an_out) 1506 end if 1507 return 1508 end if 1509 1510 !Get total natom 1511 if (present(natom)) then 1512 natom_tot=natom 1513 else 1514 natom_tot=my_natom_in 1515 call xmpi_sum(natom_tot,mpi_comm_in,ierr) 1516 end if 1517 1518 !Select input distribution 1519 if (present(mpi_atmtab_in)) then 1520 my_atmtab_in => mpi_atmtab_in 1521 my_atmtab_in_allocated=.false. 1522 else 1523 call get_my_atmtab(mpi_comm_in,my_atmtab_in,my_atmtab_in_allocated,& 1524 & paral_atom,natom_tot,my_natom_in) 1525 end if 1526 1527 !Select output distribution 1528 if (present(mpi_atmtab_out)) then 1529 my_natom_out=size(mpi_atmtab_out) 1530 my_atmtab_out => mpi_atmtab_out 1531 my_atmtab_out_allocated=.false. 1532 else 1533 call get_my_natom(mpi_comm_out,my_natom_out,natom_tot) 1534 call get_my_atmtab(mpi_comm_out,my_atmtab_out,my_atmtab_out_allocated,& 1535 & paral_atom,natom_tot) 1536 end if 1537 1538 !Select algo according to optional input arguments 1539 algo_option=1 1540 if (present(SendAtomProc).and.present(SendAtomList).and.& 1541 & present(RecvAtomProc).and.present(RecvAtomList)) algo_option=2 1542 1543 1544 !Brute force algorithm (allgather + scatter) 1545 !--------------------------------------------------------- 1546 if (algo_option==1) then 1547 1548 LIBPAW_DATATYPE_ALLOCATE(paw_an_all,(natom_tot)) 1549 call paw_an_nullify(paw_an_all) 1550 call paw_an_copy(paw_an,paw_an_all,comm_atom=mpi_comm_in,mpi_atmtab=my_atmtab_in) 1551 if (in_place) then 1552 call paw_an_free(paw_an) 1553 LIBPAW_DATATYPE_DEALLOCATE(paw_an) 1554 LIBPAW_DATATYPE_ALLOCATE(paw_an,(my_natom_out)) 1555 call paw_an_nullify(paw_an) 1556 call paw_an_copy(paw_an_all,paw_an,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out) 1557 else 1558 LIBPAW_DATATYPE_ALLOCATE(paw_an_out,(my_natom_out)) 1559 call paw_an_nullify(paw_an_out) 1560 call paw_an_copy(paw_an_all,paw_an_out,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out) 1561 end if 1562 call paw_an_free(paw_an_all) 1563 LIBPAW_DATATYPE_DEALLOCATE(paw_an_all) 1564 1565 1566 !Asynchronous algorithm (asynchronous communications) 1567 !--------------------------------------------------------- 1568 else if (algo_option==2) then 1569 1570 nbsend=size(SendAtomProc) ; nbrecv=size(RecvAtomProc) 1571 1572 if (in_place) then 1573 if (my_natom_out > 0) then 1574 LIBPAW_DATATYPE_ALLOCATE(paw_an_out1,(my_natom_out)) 1575 call paw_an_nullify(paw_an_out1) 1576 else 1577 LIBPAW_DATATYPE_ALLOCATE(paw_an_out1,(0)) 1578 end if 1579 else 1580 LIBPAW_DATATYPE_ALLOCATE(paw_an_out,(my_natom_out)) 1581 call paw_an_nullify(paw_an_out) 1582 paw_an_out1=>paw_an_out 1583 end if 1584 1585 nproc_in=xmpi_comm_size(mpi_comm_in) 1586 nproc_out=xmpi_comm_size(mpi_comm_out) 1587 if (nproc_in<=nproc_out) mpi_comm_exch=mpi_comm_out 1588 if (nproc_in>nproc_out) mpi_comm_exch=mpi_comm_in 1589 me_exch=xmpi_comm_rank(mpi_comm_exch) 1590 1591 ! Dimension put to the maximum to send 1592 LIBPAW_ALLOCATE(atmtab_send,(nbsend)) 1593 LIBPAW_ALLOCATE(atm_indx_in,(natom_tot)) 1594 atm_indx_in=-1 1595 do iatom=1,my_natom_in 1596 atm_indx_in(my_atmtab_in(iatom))=iatom 1597 end do 1598 LIBPAW_ALLOCATE(atm_indx_out,(natom_tot)) 1599 atm_indx_out=-1 1600 do iatom=1,my_natom_out 1601 atm_indx_out(my_atmtab_out(iatom))=iatom 1602 end do 1603 1604 LIBPAW_DATATYPE_ALLOCATE(tab_buf_int,(nbsend)) 1605 LIBPAW_DATATYPE_ALLOCATE(tab_buf_dp,(nbsend)) 1606 LIBPAW_DATATYPE_ALLOCATE(tab_buf_atom,(nbsend)) 1607 LIBPAW_ALLOCATE(request,(3*nbsend)) 1608 1609 ! A send buffer in an asynchrone communication couldn't be deallocate before it has been receive 1610 nbsent=0 ; ireq=0 ; iisend=0 ; nbsendreq=0 ; nb_msg=0 1611 do iisend=1,nbsend 1612 iproc_rcv=SendAtomProc(iisend) 1613 next=-1 1614 if (iisend < nbsend) next=SendAtomProc(iisend+1) 1615 if (iproc_rcv /= me_exch) then 1616 nbsent=nbsent+1 1617 atmtab_send(nbsent)=SendAtomList(iisend) ! we groups the atoms sends to the same process 1618 if (iproc_rcv /= next) then 1619 if (nbsent > 0) then 1620 ! Check if message has been yet prepared 1621 message_yet_prepared=.false. 1622 do imsg=1,nb_msg 1623 if (size(tab_buf_atom(imsg)%value) /= nbsent) then 1624 cycle 1625 else 1626 do imsg1=1,nbsent 1627 if (tab_buf_atom(imsg)%value(imsg1)/=atmtab_send(imsg1)) exit 1628 message_yet_prepared=.true. 1629 imsg_current=imsg 1630 end do 1631 end if 1632 end do 1633 ! Create the message 1634 if (.not.message_yet_prepared) then 1635 nb_msg=nb_msg+1 1636 call paw_an_isendreceive_fillbuffer( & 1637 & paw_an,atmtab_send,atm_indx_in,nbsent,buf_int,nb_int,buf_dp,nb_dp) 1638 LIBPAW_ALLOCATE(tab_buf_int(nb_msg)%value,(nb_int)) 1639 LIBPAW_ALLOCATE(tab_buf_dp(nb_msg)%value,(nb_dp)) 1640 tab_buf_int(nb_msg)%value(1:nb_int)=buf_int(1:nb_int) 1641 tab_buf_dp(nb_msg)%value(1:nb_dp)=buf_dp(1:nb_dp) 1642 LIBPAW_DEALLOCATE(buf_int) 1643 LIBPAW_DEALLOCATE(buf_dp) 1644 LIBPAW_ALLOCATE(tab_buf_atom(nb_msg)%value, (nbsent)) 1645 tab_buf_atom(nb_msg)%value(1:nbsent)=atmtab_send(1:nbsent) 1646 imsg_current=nb_msg 1647 end if 1648 ! Communicate 1649 buf_size(1)=size(tab_buf_int(imsg_current)%value) 1650 buf_size(2)=size(tab_buf_dp(imsg_current)%value) 1651 buf_size(3)=nbsent 1652 buf_ints=>tab_buf_int(imsg_current)%value 1653 buf_dps=>tab_buf_dp(imsg_current)%value 1654 my_tag=300 1655 ireq=ireq+1 1656 call xmpi_isend(buf_size,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr) 1657 my_tag=301 1658 ireq=ireq+1 1659 call xmpi_isend(buf_ints,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr) 1660 my_tag=302 1661 ireq=ireq+1 1662 call xmpi_isend(buf_dps,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr) 1663 nbsendreq=ireq 1664 nbsent=0 1665 end if 1666 end if 1667 else ! Just a renumbering, not a sending 1668 iat_in=atm_indx_in(SendAtomList(iisend)) 1669 iat_out=atm_indx_out(my_atmtab_in(iat_in)) 1670 call paw_an_copy(paw_an(iat_in:iat_in),paw_an_out1(iat_out:iat_out)) 1671 nbsent=0 1672 end if 1673 end do 1674 1675 LIBPAW_ALLOCATE(From,(nbrecv)) 1676 From(:)=-1 ; nbrecvmsg=0 1677 do iircv=1,nbrecv 1678 iproc_send=RecvAtomProc(iircv) !receive from ( RcvAtomProc is sorted by growing process ) 1679 next=-1 1680 if (iircv < nbrecv) next=RecvAtomProc(iircv+1) 1681 if (iproc_send /= me_exch .and. iproc_send/=next) then 1682 nbrecvmsg=nbrecvmsg+1 1683 From(nbrecvmsg)=iproc_send 1684 end if 1685 end do 1686 1687 LIBPAW_ALLOCATE(msg_pick,(nbrecvmsg)) 1688 msg_pick=.false. 1689 nbmsg_incoming=nbrecvmsg 1690 do while (nbmsg_incoming > 0) 1691 do i1=1,nbrecvmsg 1692 if (.not.msg_pick(i1)) then 1693 iproc_send=From(i1) 1694 flag=.false. 1695 my_tag=300 1696 call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr) 1697 if (flag) then 1698 msg_pick(i1)=.true. 1699 call xmpi_irecv(buf_size,iproc_send,my_tag,mpi_comm_exch,request1(1),ierr) 1700 call xmpi_wait(request1(1),ierr) 1701 nb_int=buf_size(1) 1702 nb_dp=buf_size(2) 1703 npaw_an_sent=buf_size(3) 1704 LIBPAW_ALLOCATE(buf_int1,(nb_int)) 1705 LIBPAW_ALLOCATE(buf_dp1 ,(nb_dp)) 1706 my_tag=301 1707 call xmpi_irecv(buf_int1,iproc_send,my_tag,mpi_comm_exch,request1(2),ierr) 1708 my_tag=302 1709 call xmpi_irecv(buf_dp1,iproc_send,my_tag,mpi_comm_exch,request1(3),ierr) 1710 call xmpi_waitall(request1(2:3),ierr) 1711 call paw_an_isendreceive_getbuffer(paw_an_out1,npaw_an_sent,atm_indx_out,buf_int1,buf_dp1) 1712 nbmsg_incoming=nbmsg_incoming-1 1713 LIBPAW_DEALLOCATE(buf_int1) 1714 LIBPAW_DEALLOCATE(buf_dp1) 1715 end if 1716 end if 1717 end do 1718 end do 1719 LIBPAW_DEALLOCATE(msg_pick) 1720 1721 if (in_place) then 1722 call paw_an_free(paw_an) 1723 LIBPAW_DATATYPE_DEALLOCATE(paw_an) 1724 LIBPAW_DATATYPE_ALLOCATE(paw_an,(my_natom_out)) 1725 call paw_an_nullify(paw_an) 1726 call paw_an_copy(paw_an_out1,paw_an) 1727 call paw_an_free(paw_an_out1) 1728 LIBPAW_DATATYPE_DEALLOCATE(paw_an_out1) 1729 end if 1730 1731 ! Wait for deallocating arrays that all sending operations has been realized 1732 if (nbsendreq > 0) then 1733 call xmpi_waitall(request(1:nbsendreq),ierr) 1734 end if 1735 1736 ! Deallocate buffers 1737 do i1=1,nb_msg 1738 LIBPAW_DEALLOCATE(tab_buf_int(i1)%value) 1739 LIBPAW_DEALLOCATE(tab_buf_dp(i1)%value) 1740 LIBPAW_DEALLOCATE(tab_buf_atom(i1)%value) 1741 end do 1742 LIBPAW_DATATYPE_DEALLOCATE(tab_buf_int) 1743 LIBPAW_DATATYPE_DEALLOCATE(tab_buf_dp) 1744 LIBPAW_DATATYPE_DEALLOCATE(tab_buf_atom) 1745 LIBPAW_DEALLOCATE(From) 1746 LIBPAW_DEALLOCATE(request) 1747 LIBPAW_DEALLOCATE(atmtab_send) 1748 LIBPAW_DEALLOCATE(atm_indx_in) 1749 LIBPAW_DEALLOCATE(atm_indx_out) 1750 1751 end if !algo_option 1752 1753 !Eventually release temporary pointers 1754 call free_my_atmtab(my_atmtab_in,my_atmtab_in_allocated) 1755 call free_my_atmtab(my_atmtab_out,my_atmtab_out_allocated) 1756 1757 end subroutine paw_an_redistribute
m_paw_an/paw_an_reset_flags [ Functions ]
[ Top ] [ m_paw_an ] [ Functions ]
NAME
paw_an_reset_flags
FUNCTION
Set all paw_an flags to 1 (force the recomputation of all arrays)
SIDE EFFECTS
Paw_an<type(Paw_an_type)>=paw_an datastructure
SOURCE
1774 subroutine paw_an_reset_flags(Paw_an) 1775 1776 !Arguments ------------------------------------ 1777 !arrays 1778 type(Paw_an_type),intent(inout) :: Paw_an(:) 1779 1780 !Local variables------------------------------- 1781 integer :: iat,natom 1782 1783 ! ************************************************************************* 1784 1785 !@Paw_an_type 1786 1787 natom=SIZE(Paw_an);if (natom==0) return 1788 do iat=1,natom 1789 if (Paw_an(iat)%has_kxc >0) Paw_an(iat)%has_kxc =1 1790 if (Paw_an(iat)%has_k3xc >0) Paw_an(iat)%has_k3xc =1 1791 if (Paw_an(iat)%has_vhartree>0) Paw_an(iat)%has_vhartree=1 1792 if (Paw_an(iat)%has_vxc >0) Paw_an(iat)%has_vxc =1 1793 if (Paw_an(iat)%has_vxctau >0) Paw_an(iat)%has_vxctau =1 1794 if (Paw_an(iat)%has_vxcval >0) Paw_an(iat)%has_vxcval =1 1795 if (Paw_an(iat)%has_vxc_ex >0) Paw_an(iat)%has_vxc_ex =1 1796 end do 1797 1798 end subroutine paw_an_reset_flags
m_paw_an/paw_an_type [ Types ]
[ Top ] [ m_paw_an ] [ Types ]
NAME
paw_an_type
FUNCTION
For PAW, various arrays given on ANgular mesh or ANgular moments
SOURCE
66 type,public :: paw_an_type 67 68 ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines, 69 ! declared in another part of ABINIT, that might need to take into account your modification. 70 71 !Integer scalars 72 73 integer :: angl_size 74 ! Dimension of paw angular mesh (angl_size=ntheta*nphi) 75 76 integer :: cplex 77 ! cplex=1 if potentials/densities are real, 2 if they are complex 78 79 integer :: has_kxc 80 ! set to 1 if xc kernels kxc1 and kxct1 are allocated and used 81 ! 2 if they are already computed 82 83 integer :: has_k3xc 84 ! set to 1 if xc kernel derivatives k3xc1 and k3xct1 are allocated and used 85 ! 2 if it is already computed 86 87 integer :: has_vhartree 88 ! set to 1 if vh1 and vht1 are allocated and used 89 ! 2 if they are already computed 90 91 integer :: has_vxc 92 ! set to 1 if vxc1 and vxct1 are allocated and used 93 ! 2 if they are already computed 94 95 integer :: has_vxctau 96 ! set to 1 if vxctau1 and vxcttau1 are allocated and used 97 ! 2 if they are already computed 98 99 integer :: has_vxcval 100 ! set to 1 if vxc1_val and vxct1_val are allocated and used 101 ! 2 if they are already computed 102 103 integer :: has_vxc_ex 104 ! set to 1 if vxc_ex and is allocated and used 105 ! 2 if it is already computed 106 107 integer :: itypat 108 ! itypat=type of the atom 109 110 integer :: lm_size 111 ! lm_size=(l_size)**2 112 ! l is Maximum value of l+1 leading to non zero Gaunt coeffs (l_size=2*l_max+1) 113 114 integer :: mesh_size 115 ! Dimension of radial mesh for arrays contained in this paw_an datastructure 116 ! May be different from pawrad%mesh_size 117 118 integer :: nkxc1 119 ! number of independent components of Kxc1 and Kxct1 120 ! (usually 3 for LDA, 23 for GGA) 121 122 integer :: nk3xc1 123 ! number of independent components of K3xc1 and K3xct1 124 ! (usually 4 for LDA, not available for GGA) 125 126 integer :: nspden 127 ! Number of spin-density components 128 129 !Logical arrays 130 131 logical, allocatable :: lmselect(:) 132 ! lmselect(lm_size) 133 ! lmselect(ilm)=select the non-zero LM-moments of "one-center" densities/potentials 134 135 !Real (real(dp)) arrays 136 137 real(dp), allocatable :: kxc1 (:,:,:) 138 ! kxc1(cplex*mesh_size,lm_size or angl_size,nkxc1) 139 ! Gives xc kernel inside the sphere 140 ! (theta,phi) values of kernel if pawxcdev=0 141 ! LM-moments of kernel if pawxcdev/=0 142 143 real(dp), allocatable :: kxct1 (:,:,:) 144 ! kxct1(cplex*mesh_size,lm_size or angl_size,nkxc1) 145 ! Gives xc pseudo kernel inside the sphere 146 ! (theta,phi) values of kernel if pawxcdev=0 147 ! LM-moments of kernel if pawxcdev/=0 148 149 real(dp), allocatable :: k3xc1 (:,:,:) 150 ! k3xc1(cplex*mesh_size,lm_size or angl_size,nk3xc1) 151 ! Gives xc kernel derivative inside the sphere 152 ! (theta,phi) values of kernel derivative if pawxcdev=0 153 ! LM-moments of kernel derivative if pawxcdev/=0 => NOT AVAILABLE YET 154 155 real(dp), allocatable :: k3xct1 (:,:,:) 156 ! k3xct1(cplex*mesh_size,lm_size or angl_size,nk3xc1) 157 ! Gives xc pseudo kernel derivative inside the sphere 158 ! (theta,phi) values of kernel derivative if pawxcdev=0 159 ! LM-moments of kernel derivative if pawxcdev/=0 => NOT AVAILABLE YET 160 161 real(dp), allocatable :: vh1 (:,:,:) 162 ! vh1(cplex*mesh_size,lm_size,nspden) 163 ! Gives Hartree potential LM-moments inside the sphere 164 165 real(dp), allocatable :: vht1 (:,:,:) 166 ! vht1(cplex*mesh_size,lm_size,nspden) 167 ! Gives Hartree tilde potential LM-moments inside the sphere 168 169 real(dp), allocatable :: vxc1 (:,:,:) 170 ! vxc1(cplex*mesh_size,lm_size or angl_size,nspden) 171 ! Gives xc potential inside the sphere 172 ! (theta,phi) values of potential if pawxcdev=0 173 ! LM-moments of potential if pawxcdev/=0 174 175 real(dp), allocatable :: vxctau1 (:,:,:) 176 ! vxctau1(cplex*mesh_size,lm_size or angl_size,nspden) 177 ! Gives xc potential inside the sphere 178 ! (theta,phi) values of potential if pawxcdev=0 179 ! LM-moments of potential if pawxcdev/=0 180 181 real(dp), allocatable :: vxc1_val (:,:,:) 182 ! vxc1_val(cplex*mesh_size,lm_size or angl_size,nspden) (Usually real, Mainly used for GW) 183 ! Gives xc potential inside the sphere arising from valence only electrons 184 ! (theta,phi) values of potential if pawxcdev=0 185 ! LM-moments of potential if pawxcdev/=0 186 187 real(dp), allocatable :: vxct1 (:,:,:) 188 ! vxct1(cplex*mesh_size,angl_size,nspden) 189 ! Gives xc pseudo potential inside the sphere 190 ! (theta,phi) values of potential if pawxcdev=0 191 ! LM-moments of potential if pawxcdev/=0 192 193 real(dp), allocatable :: vxcttau1 (:,:,:) 194 ! vxcttau1(cplex*mesh_size,angl_size,nspden) 195 ! Gives xc pseudo potential inside the sphere 196 ! (theta,phi) values of potential if pawxcdev=0 197 ! LM-moments of potential if pawxcdev/=0 198 199 real(dp), allocatable :: vxct1_val (:,:,:) 200 ! vxct1_val(cplex*mesh_size,angl_size,nspden) (Usually real, Mainly used for GW) 201 ! Gives xc pseudo potential inside the sphere 202 ! (theta,phi) values of potential if pawxcdev=0 203 ! LM-moments of potential if pawxcdev/=0 204 205 real(dp), allocatable :: vxc_ex (:,:,:) 206 ! vxc_ex(cplex*mesh_size,angl_size,nspden) 207 ! Gives xc potential for local exact exchange inside the sphere 208 ! (theta,phi) values of potential if pawxcdev=0 209 ! LM-moments of potential if pawxcdev/=0 210 211 end type paw_an_type