TABLE OF CONTENTS
- ABINIT/m_results_out
- m_results_out/copy_results_out
- m_results_out/destroy_results_out
- m_results_out/gather_results_out
- m_results_out/init_results_out
- m_results_out/results_out_type
ABINIT/m_results_out [ Modules ]
NAME
m_results_out
FUNCTION
This module provides the definition of the results_out_type used to store results from GS calculations.
COPYRIGHT
Copyright (C) 2008-2024 ABINIT group (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 .
TODO
One should replace the 'pointer' by 'allocatable'. This was tried, in October 2014, but Petrus_nag complained (test v67mbpt t31...t34), and also max2 (paral#08 np=10).
SOURCE
21 #if defined HAVE_CONFIG_H 22 #include "config.h" 23 #endif 24 25 #include "abi_common.h" 26 27 MODULE m_results_out 28 29 use defs_basis 30 use m_dtset 31 use m_errors 32 use m_abicore 33 use m_xmpi 34 35 use defs_abitypes, only : MPI_type 36 37 implicit none 38 39 private 40 41 ! public procedures. 42 public :: init_results_out 43 public :: destroy_results_out 44 public :: copy_results_out 45 public :: gather_results_out
m_results_out/copy_results_out [ Functions ]
[ Top ] [ m_results_out ] [ Functions ]
NAME
copy_results_out
FUNCTION
Copy a results_out datastructure into another
INPUTS
results_out_in=<type(results_out_type)>=input results_out datastructure
OUTPUT
results_out_out=<type(results_out_type)>=output results_out datastructure
SOURCE
432 subroutine copy_results_out(results_out_in,results_out_out) 433 434 !Arguments ------------------------------------ 435 !arrays 436 type(results_out_type),intent(in) :: results_out_in 437 type(results_out_type),intent(out) :: results_out_out 438 !Local variables------------------------------- 439 !scalars 440 integer :: natom_,natom_out,nimage_,nimage_out,nkpt_,nkpt_out,npsp_,npsp_out,nocc_,nocc_out,ntypat_,ntypat_out 441 442 !************************************************************************ 443 444 !@results_out_type 445 446 nimage_=size(results_out_in%etotal) 447 natom_ =size(results_out_in%fcart,2) 448 nkpt_ =size(results_out_in%npwtot,1) 449 nocc_ =size(results_out_in%occ,1) 450 npsp_ =size(results_out_in%mixalch,1) 451 ntypat_=size(results_out_in%mixalch,2) 452 nimage_out=0;if (associated(results_out_out%etotal))nimage_out=size(results_out_out%etotal) 453 natom_out =0;if (associated(results_out_out%fcart)) natom_out =size(results_out_out%fcart,2) 454 nkpt_out =0;if (associated(results_out_out%npwtot))nkpt_out =size(results_out_out%npwtot,1) 455 nocc_out =0;if (associated(results_out_out%occ)) nocc_out =size(results_out_out%occ,1) 456 npsp_out =0;if (associated(results_out_out%mixalch))npsp_out =size(results_out_out%mixalch,1) 457 ntypat_out=0;if (associated(results_out_out%mixalch))ntypat_out=size(results_out_out%mixalch,2) 458 459 if (nimage_>nimage_out) then 460 if (associated(results_out_out%acell)) then 461 ABI_FREE(results_out_out%acell) 462 end if 463 if (associated(results_out_out%etotal)) then 464 ABI_FREE(results_out_out%etotal) 465 end if 466 if (associated(results_out_out%rprim)) then 467 ABI_FREE(results_out_out%rprim) 468 end if 469 if (associated(results_out_out%strten)) then 470 ABI_FREE(results_out_out%strten) 471 end if 472 if (associated(results_out_out%vel_cell)) then 473 ABI_FREE(results_out_out%vel_cell) 474 end if 475 ABI_MALLOC(results_out_out%acell,(3,nimage_)) 476 ABI_MALLOC(results_out_out%etotal,(nimage_)) 477 ABI_MALLOC(results_out_out%rprim,(3,3,nimage_)) 478 ABI_MALLOC(results_out_out%strten,(6,nimage_)) 479 ABI_MALLOC(results_out_out%vel_cell,(3,3,nimage_)) 480 end if 481 if (nimage_>nimage_out.or.natom_>natom_out) then 482 if (associated(results_out_out%fcart)) then 483 ABI_FREE(results_out_out%fcart) 484 end if 485 if (associated(results_out_out%gred)) then 486 ABI_FREE(results_out_out%gred) 487 end if 488 if (associated(results_out_out%intgres)) then 489 ABI_FREE(results_out_out%intgres) 490 end if 491 if (associated(results_out_out%vel)) then 492 ABI_FREE(results_out_out%vel) 493 end if 494 if (associated(results_out_out%xred)) then 495 ABI_FREE(results_out_out%xred) 496 end if 497 ABI_MALLOC(results_out_out%fcart,(3,natom_,nimage_)) 498 ABI_MALLOC(results_out_out%gred,(3,natom_,nimage_)) 499 ABI_MALLOC(results_out_out%intgres,(4,natom_,nimage_)) 500 ABI_MALLOC(results_out_out%vel,(3,natom_,nimage_)) 501 ABI_MALLOC(results_out_out%xred,(3,natom_,nimage_)) 502 end if 503 if (nimage_>nimage_out.or.nkpt_>nkpt_out) then 504 if (associated(results_out_out%npwtot)) then 505 ABI_FREE(results_out_out%npwtot) 506 end if 507 ABI_MALLOC(results_out_out%npwtot,(nkpt_,nimage_)) 508 end if 509 if (nimage_>nimage_out.or.nocc_>nocc_out) then 510 if (associated(results_out_out%occ)) then 511 ABI_FREE(results_out_out%occ) 512 end if 513 ABI_MALLOC(results_out_out%occ,(nocc_,nimage_)) 514 end if 515 if (ntypat_>ntypat_out) then 516 if (associated(results_out_out%amu)) then 517 ABI_FREE(results_out_out%amu) 518 end if 519 ABI_MALLOC(results_out_out%amu,(ntypat_,nimage_)) 520 end if 521 522 if (npsp_>npsp_out.or.ntypat_>ntypat_out) then 523 if (associated(results_out_out%mixalch)) then 524 ABI_FREE(results_out_out%mixalch) 525 end if 526 ABI_MALLOC(results_out_out%mixalch,(npsp_,ntypat_,nimage_)) 527 end if 528 529 results_out_out%nimage=results_out_in%nimage 530 results_out_out%natom =results_out_in%natom 531 results_out_out%nkpt =results_out_in%nkpt 532 results_out_out%nocc =results_out_in%nocc 533 results_out_out%acell(1:3,1:nimage_) =results_out_in%acell(1:3,1:nimage_) 534 results_out_out%amu(1:ntypat_,1:nimage_) =results_out_in%amu(1:ntypat_,1:nimage_) 535 results_out_out%etotal(1:nimage_) =results_out_in%etotal(1:nimage_) 536 results_out_out%fcart(1:3,1:natom_,1:nimage_)=results_out_in%fcart(1:3,1:natom_,1:nimage_) 537 results_out_out%gred(1:3,1:natom_,1:nimage_) =results_out_in%gred(1:3,1:natom_,1:nimage_) 538 results_out_out%intgres(1:4,1:natom_,1:nimage_) =results_out_in%intgres(1:4,1:natom_,1:nimage_) 539 results_out_out%mixalch(1:npsp_,1:ntypat_,1:nimage_)=results_out_in%mixalch(1:npsp_,1:ntypat_,1:nimage_) 540 results_out_out%npwtot(1:nkpt_,1:nimage_) =results_out_in%npwtot(1:nkpt_,1:nimage_) 541 results_out_out%occ(1:nocc_,1:nimage_) =results_out_in%occ(1:nocc_,1:nimage_) 542 results_out_out%rprim(1:3,1:3,1:nimage_) =results_out_in%rprim(1:3,1:3,1:nimage_) 543 results_out_out%strten(1:6,1:nimage_) =results_out_in%strten(1:6,1:nimage_) 544 results_out_out%xred(1:3,1:natom_,1:nimage_) =results_out_in%xred(1:3,1:natom_,1:nimage_) 545 results_out_out%vel(1:3,1:natom_,1:nimage_) =results_out_in%vel(1:3,1:natom_,1:nimage_) 546 results_out_out%vel_cell(1:3,1:3,1:nimage_) =results_out_in%vel_cell(1:3,1:3,1:nimage_) 547 548 end subroutine copy_results_out
m_results_out/destroy_results_out [ Functions ]
[ Top ] [ m_results_out ] [ Functions ]
NAME
destroy_results_out
FUNCTION
Clean and destroy an array of results_out datastructures
SIDE EFFECTS
results_out(:)=<type(results_out_type)>=results_out datastructure array
SOURCE
344 subroutine destroy_results_out(results_out) 345 346 !Arguments ------------------------------------ 347 !arrays 348 type(results_out_type),intent(inout) :: results_out(:) 349 !Local variables------------------------------- 350 !scalars 351 integer :: idt1,idt2,ii,results_out_size 352 353 !************************************************************************ 354 355 !@results_out_type 356 357 results_out_size=size(results_out) 358 if (results_out_size>0) then 359 360 idt1=lbound(results_out,1);idt2=ubound(results_out,1) 361 do ii=idt1,idt2 362 results_out(ii)%nimage=0 363 results_out(ii)%natom=0 364 results_out(ii)%nkpt=0 365 results_out(ii)%nocc=0 366 if (associated(results_out(ii)%acell)) then 367 ABI_FREE(results_out(ii)%acell) 368 end if 369 if (associated(results_out(ii)%amu)) then 370 ABI_FREE(results_out(ii)%amu) 371 end if 372 if (associated(results_out(ii)%etotal)) then 373 ABI_FREE(results_out(ii)%etotal) 374 end if 375 if (associated(results_out(ii)%fcart)) then 376 ABI_FREE(results_out(ii)%fcart) 377 end if 378 if (associated(results_out(ii)%gred)) then 379 ABI_FREE(results_out(ii)%gred) 380 end if 381 if (associated(results_out(ii)%intgres)) then 382 ABI_FREE(results_out(ii)%intgres) 383 end if 384 if (associated(results_out(ii)%mixalch)) then 385 ABI_FREE(results_out(ii)%mixalch) 386 end if 387 if (associated(results_out(ii)%npwtot)) then 388 ABI_FREE(results_out(ii)%npwtot) 389 end if 390 if (associated(results_out(ii)%occ)) then 391 ABI_FREE(results_out(ii)%occ) 392 end if 393 if (associated(results_out(ii)%rprim)) then 394 ABI_FREE(results_out(ii)%rprim) 395 end if 396 if (associated(results_out(ii)%strten)) then 397 ABI_FREE(results_out(ii)%strten) 398 end if 399 if (associated(results_out(ii)%vel)) then 400 ABI_FREE(results_out(ii)%vel) 401 end if 402 if (associated(results_out(ii)%vel_cell)) then 403 ABI_FREE(results_out(ii)%vel_cell) 404 end if 405 if (associated(results_out(ii)%xred)) then 406 ABI_FREE(results_out(ii)%xred) 407 end if 408 end do 409 410 end if 411 412 end subroutine destroy_results_out
m_results_out/gather_results_out [ Functions ]
[ Top ] [ m_results_out ] [ Functions ]
NAME
gather_results_out
FUNCTION
Gather results_out datastructure array using communicator over images (replicas) of the cell. Each contribution of single processor is gathered into a big array on master processor
INPUTS
allgather= --optional, default=false-- if TRUE do ALL_GATHER instead of GATHER dtsets(:)= <type datafiles_type> contains all input variables, master= --optional, default=0-- index of master proc receiving gathered data (if allgather=false) mpi_enregs=information about MPI parallelization only_one_per_img= --optional, default=true-- if TRUE, the gather operation is only done by one proc per image (master of the comm_cell) results_out(:)=<type(results_out_type)>=results_out datastructure array on each proc use_results_all=true if results_out_all datastructure is allocated for current proc
SIDE EFFECTS
=== f use_results_all=true === results_out_all(:)=<type(results_out_type)>=global (gathered) results_out datastructure array
SOURCE
577 subroutine gather_results_out(dtsets,mpi_enregs,results_out,results_out_all,use_results_all,& 578 & master,allgather,only_one_per_img) ! optional arguments 579 580 !Arguments ------------------------------------ 581 !scalars 582 integer,optional,intent(in) :: master 583 logical,optional,intent(in) :: allgather,only_one_per_img 584 logical,intent(in) :: use_results_all 585 !arrays 586 type(dataset_type),intent(in) :: dtsets(:) 587 type(results_out_type),intent(in) :: results_out(:) 588 type(results_out_type),intent(inout) :: results_out_all(:) 589 type(MPI_type), intent(inout) :: mpi_enregs(:) 590 !Local variables------------------------------- 591 !scalars 592 integer :: dtsets_size 593 integer :: ibufi,ibufr 594 integer :: idt1,idt2,ierr,ii,iproc,jj 595 integer :: isize,isize_img 596 integer :: master_all,master_img,master_one_img 597 integer :: mpi_enregs_size,mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat 598 integer :: natom_,nkpt_,nocc_,npsp_,ntypat_,nimage,nimagetot 599 integer :: results_out_size,results_out_all_size 600 integer :: rsize,rsize_img 601 logical :: do_allgather,one_per_img 602 character(len=500) :: msg 603 ! type(MPI_type):: mpi_img 604 !arrays 605 integer,allocatable :: ibuffer(:),ibuffer_all(:),ibufshft(:) 606 integer,allocatable :: iimg(:),isize_img_all(:),nimage_all(:) 607 integer,allocatable :: rbufshft(:),rsize_img_all(:) 608 real(dp),allocatable :: rbuffer(:),rbuffer_all(:) 609 610 !************************************************************************ 611 612 !@results_out_type 613 614 one_per_img=.true.;if (present(only_one_per_img)) one_per_img=only_one_per_img 615 do_allgather=.false.;if (present(allgather)) do_allgather=allgather 616 master_all=0;if (present(master)) master_all=master 617 618 ! call init_mpi_enreg(mpi_img,init_mpi=.false.) 619 master_img=0;master_one_img=0 620 ! i_am_master=(mpi_img%me==master_all) 621 ! use_results_all= & 622 !& ((( do_allgather).and.( one_per_img).and.(mpi_img%me_cell==master_one_img)) .or. & 623 !& (( do_allgather).and.(.not.one_per_img)) .or. & 624 !& ((.not.do_allgather).and.( one_per_img).and.(mpi_img%me==master_all)) .or. & 625 !& ((.not.do_allgather).and.(.not.one_per_img).and.(mpi_img%me_img==master_img))) 626 627 dtsets_size=size(dtsets);results_out_size=size(results_out) 628 mpi_enregs_size=size(mpi_enregs) 629 if (dtsets_size/=results_out_size) then 630 msg=' Wrong sizes for dtsets and results_out datastructures !' 631 ABI_BUG(msg) 632 end if 633 if (mpi_enregs_size/=results_out_size) then 634 msg=' Wrong sizes for dtsets and results_out datastructures !' 635 ABI_BUG(msg) 636 end if 637 638 if (use_results_all) then 639 results_out_all_size=size(results_out_all) 640 if (results_out_size/=results_out_all_size) then 641 msg=' Wrong size for results_out_all datastructure !' 642 ABI_BUG(msg) 643 end if 644 end if 645 646 if (results_out_size>0) then 647 648 idt1=lbound(results_out,1);idt2=ubound(results_out,1) 649 650 ! Create global results_out_all datastructure 651 if (use_results_all) then 652 mxnatom=1;mxnband=1;mxnkpt=1;mxnpsp=1;mxntypat=1 653 do ii=idt1,idt2 654 isize=size(results_out(ii)%fcart,2) ;if (isize>mxnatom) mxnatom=isize 655 isize=size(results_out(ii)%occ,1) ;if (isize>mxnband) mxnband=isize 656 isize=size(results_out(ii)%mixalch,1);if(isize>mxnpsp) mxnpsp=isize 657 isize=size(results_out(ii)%npwtot,1);if (isize>mxnkpt) mxnkpt=isize 658 isize=size(results_out(ii)%mixalch,2);if(isize>mxntypat) mxntypat=isize 659 end do 660 mxnband=mxnband/mxnkpt;mxnsppol=1 661 call init_results_out(dtsets,2,0,mpi_enregs,mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat,results_out_all) 662 end if 663 664 ! Loop over results_out components (datasets) 665 do ii=idt1,idt2 666 667 ! Simple copy in case of 1 image 668 if (dtsets(ii)%npimage<=1) then 669 if (use_results_all) then 670 call copy_results_out(results_out(ii),results_out_all(ii)) 671 end if 672 else 673 674 ! Retrieve MPI information for this dataset 675 676 if ((.not.one_per_img).or.(mpi_enregs(ii)%me_cell==master_one_img)) then 677 678 ! Gather number of images treated by each proc 679 ABI_MALLOC(nimage_all,(mpi_enregs(ii)%nproc_img)) 680 nimage_all=0 681 nimage=results_out(ii)%nimage 682 call xmpi_allgather(nimage,nimage_all,mpi_enregs(ii)%comm_img,ierr) 683 nimagetot=sum(nimage_all) 684 685 ! Copy scalars from distributed results_out to gathered one 686 if (use_results_all) then 687 results_out_all(ii)%nimage=nimagetot 688 results_out_all(ii)%natom =results_out(ii)%natom 689 results_out_all(ii)%nkpt =results_out(ii)%nkpt 690 results_out_all(ii)%nocc =results_out(ii)%nocc 691 results_out_all(ii)%npsp =results_out(ii)%npsp 692 results_out_all(ii)%ntypat=results_out(ii)%ntypat 693 end if 694 695 ! Compute number of integers/reals needed by current 696 ! results_out structure for current proc 697 isize=results_out(ii)%nkpt 698 rsize=28+16*results_out(ii)%natom+results_out(ii)%nocc+results_out(ii)%npsp*results_out(ii)%ntypat+results_out(ii)%ntypat 699 isize_img=results_out(ii)%nimage*isize 700 rsize_img=results_out(ii)%nimage*rsize 701 ABI_MALLOC(isize_img_all,(mpi_enregs(ii)%nproc_img)) 702 ABI_MALLOC(rsize_img_all,(mpi_enregs(ii)%nproc_img)) 703 isize_img_all(:)=isize*nimage_all(:) 704 rsize_img_all(:)=rsize*nimage_all(:) 705 ABI_FREE(nimage_all) 706 707 ! Compute shifts in buffer arrays for each proc 708 ABI_MALLOC(ibufshft,(mpi_enregs(ii)%nproc_img)) 709 ibufshft(1)=0 710 ABI_MALLOC(rbufshft,(mpi_enregs(ii)%nproc_img)) 711 rbufshft(1)=0 712 do jj=2,mpi_enregs(ii)%nproc_img 713 ibufshft(jj)=ibufshft(jj-1)+isize_img_all(jj-1) 714 rbufshft(jj)=rbufshft(jj-1)+rsize_img_all(jj-1) 715 end do 716 717 ! Load buffers 718 ABI_MALLOC(ibuffer,(isize_img)) 719 ABI_MALLOC(rbuffer,(rsize_img)) 720 ibufi=0;ibufr=0 721 natom_=results_out(ii)%natom 722 nkpt_ =results_out(ii)%nkpt 723 nocc_ =results_out(ii)%nocc 724 npsp_ =results_out(ii)%npsp 725 ntypat_ =results_out(ii)%ntypat 726 do jj=1,results_out(ii)%nimage 727 ibuffer(ibufi+1:ibufi+nkpt_)=results_out(ii)%npwtot(1:nkpt_,jj) 728 ibufi=ibufi+nkpt_ 729 rbuffer(ibufr+1:ibufr+3)=results_out(ii)%acell(1:3,jj) 730 ibufr=ibufr+3 731 rbuffer(ibufr+1:ibufr+ntypat_)=results_out(ii)%amu(1:ntypat_,jj) 732 ibufr=ibufr+ntypat_ 733 rbuffer(ibufr+1)=results_out(ii)%etotal(jj) 734 ibufr=ibufr+1 735 rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%fcart(1:3,1:natom_,jj),(/3*natom_/)) 736 ibufr=ibufr+3*natom_ 737 rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%gred(1:3,1:natom_,jj),(/3*natom_/)) 738 ibufr=ibufr+3*natom_ 739 rbuffer(ibufr+1:ibufr+4*natom_)=reshape(results_out(ii)%intgres(1:4,1:natom_,jj),(/4*natom_/)) 740 ibufr=ibufr+4*natom_ 741 rbuffer(ibufr+1:ibufr+npsp_*ntypat_)=& 742 & reshape(results_out(ii)%mixalch(1:npsp_,1:ntypat_,jj),(/npsp_*ntypat_/) ) 743 ibufr=ibufr+npsp_*ntypat_ 744 rbuffer(ibufr+1:ibufr+nocc_)=results_out(ii)%occ(1:nocc_,jj) 745 ibufr=ibufr+nocc_ 746 rbuffer(ibufr+1:ibufr+9)=reshape(results_out(ii)%rprim(1:3,1:3,jj),(/9/)) 747 ibufr=ibufr+9 748 rbuffer(ibufr+1:ibufr+9)=reshape(results_out(ii)%vel_cell(1:3,1:3,jj),(/9/)) 749 ibufr=ibufr+9 750 rbuffer(ibufr+1:ibufr+6)=results_out(ii)%strten(1:6,jj) 751 ibufr=ibufr+6 752 rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%vel(1:3,1:natom_,jj),(/3*natom_/)) 753 ibufr=ibufr+3*natom_ 754 rbuffer(ibufr+1:ibufr+3*natom_)=reshape(results_out(ii)%xred(1:3,1:natom_,jj),(/3*natom_/)) 755 ibufr=ibufr+3*natom_ 756 end do 757 if (ibufi/=isize_img.or.ibufr/=rsize_img) then 758 msg=' wrong buffer sizes !' 759 ABI_BUG(msg) 760 end if 761 762 ! Gather all data 763 if (use_results_all) then 764 ABI_MALLOC(ibuffer_all,(isize*nimagetot)) 765 ABI_MALLOC(rbuffer_all,(rsize*nimagetot)) 766 end if 767 if (.not.use_results_all) then 768 ABI_MALLOC(ibuffer_all,(0)) 769 ABI_MALLOC(rbuffer_all,(0)) 770 end if 771 if (do_allgather) then 772 call xmpi_allgatherv(ibuffer,isize_img,ibuffer_all,isize_img_all,ibufshft,& 773 & mpi_enregs(ii)%comm_img,ierr) 774 call xmpi_allgatherv(rbuffer,rsize_img,rbuffer_all,rsize_img_all,rbufshft,& 775 & mpi_enregs(ii)%comm_img,ierr) 776 else 777 call xmpi_gatherv(ibuffer,isize_img,ibuffer_all,isize_img_all,ibufshft,& 778 & master_img,mpi_enregs(ii)%comm_img,ierr) 779 call xmpi_gatherv(rbuffer,rsize_img,rbuffer_all,rsize_img_all,rbufshft,& 780 & master_img,mpi_enregs(ii)%comm_img,ierr) 781 end if 782 ABI_FREE(isize_img_all) 783 ABI_FREE(rsize_img_all) 784 ABI_FREE(ibuffer) 785 ABI_FREE(rbuffer) 786 787 ! Transfer buffers into gathered results_out_all (master proc only) 788 if (use_results_all) then 789 ABI_MALLOC(iimg,(mpi_enregs(ii)%nproc_img)) 790 iimg=0 791 natom_=results_out_all(ii)%natom 792 nkpt_=results_out_all(ii)%nkpt 793 nocc_=results_out_all(ii)%nocc 794 npsp_ =results_out_all(ii)%npsp 795 ntypat_ =results_out_all(ii)%ntypat 796 do jj=1,nimagetot 797 ! The following line supposes that images are sorted by increasing index 798 iproc=mpi_enregs(ii)%distrb_img(jj)+1;iimg(iproc)=iimg(iproc)+1 799 ibufi=ibufshft(iproc)+(iimg(iproc)-1)*isize 800 ibufr=rbufshft(iproc)+(iimg(iproc)-1)*rsize 801 results_out_all(ii)%npwtot(1:nkpt_,jj)=ibuffer_all(ibufi+1:ibufi+nkpt_) 802 ibufi=ibufi+nkpt_ 803 results_out_all(ii)%acell(1:3,jj)=rbuffer_all(ibufr+1:ibufr+3) 804 ibufr=ibufr+3 805 results_out_all(ii)%amu(1:ntypat_,jj)=rbuffer_all(ibufr+1:ibufr+ntypat_) 806 ibufr=ibufr+ntypat_ 807 results_out_all(ii)%etotal(jj)=rbuffer_all(ibufr+1) 808 ibufr=ibufr+1 809 results_out_all(ii)%fcart(1:3,1:natom_,jj)= & 810 & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/)) 811 ibufr=ibufr+3*natom_ 812 results_out_all(ii)%gred(1:3,1:natom_,jj)= & 813 & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/)) 814 ibufr=ibufr+3*natom_ 815 results_out_all(ii)%intgres(1:4,1:natom_,jj)= & 816 & reshape(rbuffer_all(ibufr+1:ibufr+4*natom_),(/4,natom_/)) 817 ibufr=ibufr+4*natom_ 818 results_out_all(ii)%mixalch(1:npsp_,1:ntypat_,jj)= & 819 & reshape(rbuffer_all(ibufr+1:ibufr+npsp_*ntypat_),(/npsp_,ntypat_/)) 820 ibufr=ibufr+npsp_*ntypat_ 821 results_out_all(ii)%occ(1:nocc_,jj)=rbuffer_all(ibufr+1:ibufr+nocc_) 822 ibufr=ibufr+nocc_ 823 results_out_all(ii)%rprim(1:3,1:3,jj)=reshape(rbuffer_all(ibufr+1:ibufr+9),(/3,3/)) 824 ibufr=ibufr+9 825 results_out_all(ii)%vel_cell(1:3,1:3,jj)=reshape(rbuffer_all(ibufr+1:ibufr+9),(/3,3/)) 826 ibufr=ibufr+9 827 results_out_all(ii)%strten(1:6,jj)=rbuffer_all(ibufr+1:ibufr+6) 828 ibufr=ibufr+6 829 results_out_all(ii)%vel(1:3,1:natom_,jj)= & 830 & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/)) 831 ibufr=ibufr+3*natom_ 832 results_out_all(ii)%xred(1:3,1:natom_,jj)= & 833 & reshape(rbuffer_all(ibufr+1:ibufr+3*natom_),(/3,natom_/)) 834 ibufr=ibufr+3*natom_ 835 end do 836 ABI_FREE(iimg) 837 end if 838 839 ! Free memory 840 ABI_FREE(ibufshft) 841 ABI_FREE(rbufshft) 842 ABI_FREE(ibuffer_all) 843 ABI_FREE(rbuffer_all) 844 845 end if 846 end if 847 end do 848 end if 849 850 end subroutine gather_results_out
m_results_out/init_results_out [ Functions ]
[ Top ] [ m_results_out ] [ Functions ]
NAME
init_results_out
FUNCTION
Init all scalars and pointers in an array of results_out datastructures
INPUTS
dtsets(:)= <type datafiles_type> contains all input variables, option_alloc=0: only allocate datastructure 1: allocate and initialize the whole datastructure 2: allocate datastructure and initialize only first member option_size=0: allocate results_out with a global number images (use mxnimage=max(dtset%nimage)) 1: allocate results_out with a number of images per processor (use mxnimage=max(mpi_enreg%my_nimage)) mpi_enregs=information about MPI parallelization mxnimage=-optional- maximal value of nimage over datasets if this argument is present, it is used for allocations if it is not present, allocations are automatic natom= number of atoms nband= number of bands nkpt= number of k-points nsppol= number of independant spin components
SIDE EFFECTS
results_out(:)=<type(results_out_type)>=results_out datastructure array
SOURCE
182 subroutine init_results_out(dtsets,option_alloc,option_size,mpi_enregs,& 183 & mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat,results_out) 184 185 !Arguments ------------------------------------ 186 !scalars 187 integer,intent(in) :: option_alloc,option_size 188 integer,intent(in) :: mxnatom,mxnband,mxnkpt,mxnpsp,mxnsppol,mxntypat 189 !arrays 190 type(dataset_type),intent(in) :: dtsets(:) 191 type(results_out_type),intent(inout) :: results_out(:) 192 type(MPI_type), intent(in) :: mpi_enregs(:) 193 !Local variables------------------------------- 194 !scalars 195 integer :: dtsets_size,idt1,idt2,idt3,ii,jj,kk 196 integer :: mpi_enregs_size,mxnimage_,natom_,nkpt_,nocc_ 197 integer :: results_out_size 198 ! type(MPI_type) :: mpi_img 199 !arrays 200 integer,allocatable :: img(:,:),nimage(:) 201 real(dp),allocatable :: tmp(:,:) 202 203 !************************************************************************ 204 205 !@results_out_type 206 207 dtsets_size=size(dtsets) 208 results_out_size=size(results_out) 209 mpi_enregs_size=size(mpi_enregs) 210 if (dtsets_size/=mpi_enregs_size .or. dtsets_size/=results_out_size) then 211 ABI_ERROR("init_results_out: wrong sizes (2)!") 212 endif 213 214 if (results_out_size>0) then 215 216 idt1=lbound(results_out,1);idt2=ubound(results_out,1) 217 idt3=idt2;if (option_alloc==2) idt3=idt1 218 ABI_MALLOC(nimage,(idt1:idt2)) 219 nimage=0 220 mxnimage_=1 221 if (option_size==0) then 222 do ii=idt1,idt2 223 nimage(ii)=dtsets(ii)%nimage 224 if (nimage(ii)>mxnimage_) mxnimage_=nimage(ii) 225 end do 226 if (option_alloc>0) then 227 ABI_MALLOC(img,(mxnimage_,idt1:idt3)) 228 img=0 229 do ii=idt1,idt3 230 do jj=1,nimage(ii) 231 img(jj,ii)=jj 232 end do 233 end do 234 end if 235 else 236 do ii=idt1,idt2 237 nimage(ii)=mpi_enregs(ii)%my_nimage 238 if (nimage(ii)>mxnimage_) mxnimage_=nimage(ii) 239 end do 240 if (option_alloc>0) then 241 ABI_MALLOC(img,(mxnimage_,idt1:idt3)) 242 img=0 243 do ii=idt1,idt3 244 do jj=1,nimage(ii) 245 img(jj,ii)=mpi_enregs(ii)%my_imgtab(jj) 246 end do 247 end do 248 end if 249 end if 250 251 do ii=idt1,idt2 252 253 ABI_MALLOC(results_out(ii)%acell,(3,mxnimage_)) 254 ABI_MALLOC(results_out(ii)%amu,(mxntypat,mxnimage_)) 255 ABI_MALLOC(results_out(ii)%etotal,(mxnimage_)) 256 ABI_MALLOC(results_out(ii)%fcart,(3,mxnatom,mxnimage_)) 257 ABI_MALLOC(results_out(ii)%gred,(3,mxnatom,mxnimage_)) 258 ABI_MALLOC(results_out(ii)%intgres,(4,mxnatom,mxnimage_)) 259 ABI_MALLOC(results_out(ii)%mixalch,(mxnpsp,mxntypat,mxnimage_)) 260 ABI_MALLOC(results_out(ii)%npwtot,(mxnkpt,mxnimage_)) 261 ABI_MALLOC(results_out(ii)%occ,(mxnband*mxnkpt*mxnsppol,mxnimage_)) 262 ABI_MALLOC(results_out(ii)%rprim,(3,3,mxnimage_)) 263 ABI_MALLOC(results_out(ii)%strten,(6,mxnimage_)) 264 ABI_MALLOC(results_out(ii)%vel,(3,mxnatom,mxnimage_)) 265 ABI_MALLOC(results_out(ii)%vel_cell,(3,3,mxnimage_)) 266 ABI_MALLOC(results_out(ii)%xred,(3,mxnatom,mxnimage_)) 267 268 if ((option_alloc==1).or.(option_alloc==2.and.ii==idt3)) then 269 results_out(ii)%nimage=nimage(ii) 270 results_out(ii)%natom =mxnatom 271 results_out(ii)%nkpt =mxnkpt 272 results_out(ii)%npsp =mxnpsp 273 results_out(ii)%ntypat =mxntypat 274 results_out(ii)%nocc =mxnband*mxnkpt*mxnsppol 275 natom_=dtsets(ii)%natom 276 nkpt_=dtsets(ii)%nkpt;if(ii==0) nkpt_=mxnkpt 277 nocc_=mxnband*dtsets(ii)%nkpt*dtsets(ii)%nsppol 278 results_out(ii)%nimage=nimage(ii) 279 results_out(ii)%natom=natom_ 280 results_out(ii)%nkpt=nkpt_ 281 results_out(ii)%nocc=nocc_ 282 results_out(ii)%acell=zero 283 results_out(ii)%amu=zero 284 results_out(ii)%etotal(:)=zero 285 results_out(ii)%fcart(:,:,:)=zero 286 results_out(ii)%gred(:,:,:)=zero 287 results_out(ii)%intgres(:,:,:)=zero 288 results_out(ii)%mixalch(:,:,:)=zero 289 results_out(ii)%occ=zero 290 results_out(ii)%rprim=zero 291 results_out(ii)%strten(:,:)=zero 292 results_out(ii)%vel=zero 293 results_out(ii)%vel_cell=zero 294 results_out(ii)%xred=zero 295 results_out(ii)%npwtot(:,:)=0 296 if (nimage(ii)>0) then 297 do jj=1,nimage(ii) 298 kk=img(jj,ii) 299 results_out(ii)%acell(:,jj) =dtsets(ii)%acell_orig(:,kk) 300 results_out(ii)%amu(:,jj) =dtsets(ii)%amu_orig(:,kk) 301 results_out(ii)%rprim(:,:,jj) =dtsets(ii)%rprim_orig(:,:,kk) 302 results_out(ii)%vel_cell(:,:,jj)=dtsets(ii)%vel_cell_orig(:,:,kk) 303 results_out(ii)%mixalch(:,:,jj) =dtsets(ii)%mixalch_orig(:,:,kk) 304 if (natom_>0) then 305 ABI_MALLOC(tmp,(3,natom_)) 306 tmp(1:3,1:natom_)=dtsets(ii)%vel_orig(1:3,1:natom_,kk) 307 results_out(ii)%vel(1:3,1:natom_,jj)=tmp(1:3,1:natom_) 308 tmp(1:3,1:natom_)=dtsets(ii)%xred_orig(1:3,1:natom_,kk) 309 results_out(ii)%xred(1:3,1:natom_,jj)=tmp(1:3,1:natom_) 310 ABI_FREE(tmp) 311 end if 312 if (nocc_>0) then 313 results_out(ii)%occ(1:nocc_,jj)=dtsets(ii)%occ_orig(1:nocc_,kk) 314 end if 315 end do 316 end if 317 end if 318 319 end do 320 ABI_FREE(nimage) 321 !if (option_size/=0.and.option_alloc==1) then 322 if (allocated(img)) then 323 ABI_FREE(img) 324 end if 325 end if 326 327 end subroutine init_results_out
m_results_out/results_out_type [ Types ]
[ Top ] [ m_results_out ] [ Types ]
NAME
results_out_type
FUNCTION
This structured datatype contains a subset of the results of a GS calculation, needed to perform the so-called "internal tests", and to perform the timing analysis
SOURCE
59 type, public :: results_out_type 60 61 ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines, 62 ! declared in another part of ABINIT, that might need to take into account your modification. 63 64 ! Integer scalar 65 66 integer :: natom 67 ! The number of atoms for this dataset 68 integer :: nimage 69 ! The number of images of the cell for this dataset (treated by current proc) 70 integer :: nkpt 71 ! The number of k-pints for this dataset 72 integer :: nocc 73 ! The number of occupations for this dataset 74 integer :: npsp 75 ! The number of pseudopotentials 76 integer :: ntypat 77 ! The number of types of atoms 78 79 ! Integer arrays 80 81 integer, pointer :: npwtot(:,:) 82 ! npw(mxnkpt,nimage) Full number of plane waves for each 83 ! k point, computed with the "true" rprimd 84 ! Not taking into account the decrease due to istwfk 85 ! Not taking into account the spread of pws on different procs 86 87 ! Real (real(dp)) arrays 88 89 real(dp), pointer :: acell(:,:) 90 ! acell(3,nimage) 91 ! Length of primitive vectors 92 93 real(dp), pointer :: amu(:,:) 94 ! amu(ntypat,nimage) 95 ! Mass of the atomic type 96 97 real(dp), pointer :: etotal(:) 98 ! etotal(nimage) 99 ! Total energy (Hartree) 100 101 real(dp), pointer :: fcart(:,:,:) 102 ! fcart(3,natom,nimage) Cartesian forces (Hartree/Bohr) 103 ! Forces in cartesian coordinates (Hartree) 104 105 real(dp), pointer :: gred(:,:,:) 106 ! gred(3,natom,nimage) 107 ! Forces in reduced coordinates (Hartree) 108 ! Actually, gradient of the total energy with respect 109 ! to change of reduced coordinates 110 111 real(dp), pointer :: intgres(:,:,:) 112 ! intgres(4,natom,nimage) ! 4 is for nspden 113 ! Gradient of the total energy wrt constraints (Hartree) 114 115 real(dp), pointer :: mixalch(:,:,:) 116 ! mixalch(npsp,ntypat,nimage) [note that in psps datastructure, the dimensioning is npspalch,ntypalch] 117 ! Mixing coefficients going from the input pseudopotentials (those for alchemical mixing) to the alchemical atoms 118 119 real(dp), pointer :: occ(:,:) 120 ! occ(mxmband_upper*mxnkpt*mxnsppol,nimage) 121 ! Electronic occupations 122 123 real(dp), pointer :: rprim(:,:,:) 124 ! rprim(3,3,nimage) 125 ! Dimensionless real space primitive translations 126 127 real(dp), pointer :: strten(:,:) 128 ! strten(6,nimage) 129 ! Stress tensor 130 131 real(dp), pointer :: vel(:,:,:) 132 ! vel(3,natom,nimage) 133 ! Atomic velocities 134 135 real(dp), pointer :: vel_cell(:,:,:) 136 ! vel_cell(3,3,nimage) 137 ! Cell velocities 138 ! Time derivatives of dimensional primitive translations 139 140 real(dp), pointer :: xred(:,:,:) 141 ! xred(3,natom,nimage) 142 ! Atomic positions in reduced coordinates 143 144 end type results_out_type