LCOV - code coverage report
Current view: top level - types - types_potden.F90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 170 181 93.9 %
Date: 2024-03-28 04:22:06 Functions: 13 15 86.7 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : MODULE m_types_potden
       7             : 
       8             :   !> Data type for the density or the potential
       9             :    TYPE t_potden
      10             :      INTEGER             :: iter
      11             :      INTEGER             :: potdenType
      12             :      COMPLEX,ALLOCATABLE :: pw(:,:),pw_w(:,:)
      13             :      !                      mt(radial_grid, sphhar, atom, spin)
      14             :      REAL,ALLOCATABLE    :: mt(:,:,:,:)
      15             :      COMPLEX,ALLOCATABLE :: vac(:,:,:,:)
      16             :      !For angles of density/potential in noco case
      17             :      REAL,ALLOCATABLE  :: theta_pw(:)
      18             :      REAL,ALLOCATABLE  :: phi_pw(:)
      19             :      REAL,ALLOCATABLE  :: theta_vac(:,:,:)
      20             :      REAL,ALLOCATABLE  :: phi_vac(:,:,:)
      21             :      REAL,ALLOCATABLE  :: theta_mt(:,:)
      22             :      REAL,ALLOCATABLE  :: phi_mt(:,:)
      23             : 
      24             :      ! Core density
      25             :      REAL, ALLOCATABLE :: qint(:,:)
      26             :      REAL, ALLOCATABLE :: tec(:,:)
      27             :      REAL, ALLOCATABLE :: mtCore(:,:,:)
      28             : 
      29             :      ! For density matrix and associated potential matrix
      30             :      COMPLEX, ALLOCATABLE :: mmpMat(:,:,:,:)
      31             :      ! additional density matrix for LDA+v
      32             :      COMPLEX, ALLOCATABLE :: nIJ_llp_mmp(:,:,:,:) ! m, m', i_pair, i_spin
      33             : 
      34             :      !this type contains two init routines that should be used to allocate
      35             :      !memory. You can either specify the datatypes or give the dimensions as integers
      36             :      !See implementation below!
      37             :    CONTAINS
      38             :      PROCEDURE :: init_potden_types
      39             :      PROCEDURE :: init_potden_simple
      40             :      PROCEDURE :: resetpotden
      41             :      PROCEDURE :: reset_dfpt
      42             :      GENERIC   :: init=>init_potden_types,init_potden_simple
      43             :      PROCEDURE :: copy_both_spin
      44             :      PROCEDURE :: sum_both_spin
      45             :      procedure :: SpinsToChargeAndMagnetisation
      46             :      procedure :: ChargeAndMagnetisationToSpins
      47             :      procedure :: addPotDen
      48             :      procedure :: subPotDen
      49             :      procedure :: copyPotDen
      50             :      procedure :: distribute
      51             :      procedure :: collect
      52             :   END TYPE t_potden
      53             : 
      54             : CONTAINS
      55         664 :   subroutine collect(this,fmpi_comm,the_other)
      56             :     use m_mpi_bc_tool
      57             : #ifdef CPP_MPI
      58             :     use mpi
      59             : #endif
      60             :     implicit none
      61             :     class(t_potden),INTENT(INOUT) :: this
      62             :     class(t_potden),OPTIONAL,INTENT(INOUT) :: the_other
      63             :     integer :: fmpi_comm
      64             : #ifdef CPP_MPI
      65             :     INTEGER:: ierr,irank
      66         664 :     real,ALLOCATABLE::rtmp(:)
      67             :     complex,ALLOCATABLE::ctmp(:)
      68         664 :     CALL MPI_COMM_RANK(fmpi_comm,irank,ierr)
      69             :     !pw
      70        3320 :     ALLOCATE(ctmp(size(this%pw)))
      71        1992 :     CALL MPI_REDUCE(this%pw,ctmp,size(this%pw),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
      72     2992818 :     if (irank==0) this%pw=reshape(ctmp,shape(this%pw))
      73         664 :     deallocate(ctmp)
      74             :     !mt
      75        4648 :     ALLOCATE(rtmp(size(this%mt)))
      76        3320 :     CALL MPI_REDUCE(this%mt,rtmp,size(this%mt),MPI_DOUBLE_PRECISION,MPI_SUM,0,fmpi_comm,ierr)
      77    45127814 :     if (irank==0) this%mt=reshape(rtmp,shape(this%mt))
      78         664 :     deallocate(rtmp)
      79         664 :     IF (PRESENT(the_other)) THEN
      80             :        !mt
      81           0 :        ALLOCATE(rtmp(size(the_other%mt)))
      82           0 :        CALL MPI_REDUCE(the_other%mt,rtmp,size(the_other%mt),MPI_DOUBLE_PRECISION,MPI_SUM,0,fmpi_comm,ierr)
      83           0 :        if (irank==0) the_other%mt=reshape(rtmp,shape(the_other%mt))
      84           0 :        deallocate(rtmp)
      85             :     END IF
      86             :     !vac
      87         664 :     if (allocated(this%vac)) THEN
      88        4648 :        ALLOCATE(ctmp(size(this%vac)))
      89        3320 :        CALL MPI_REDUCE(this%vac,ctmp,size(this%vac),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
      90    19267796 :        if (irank==0) this%vac=reshape(ctmp,shape(this%vac))
      91         664 :        deallocate(ctmp)
      92             :     endif
      93             :     !density matrix
      94         664 :     if (allocated(this%mmpMat)) then
      95        4648 :        ALLOCATE(ctmp(size(this%mmpMat)))
      96        3320 :        CALL MPI_REDUCE(this%mmpMat,ctmp,size(this%mmpMat),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
      97       76738 :        if (irank==0) this%mmpMat=reshape(ctmp,shape(this%mmpMat))
      98         664 :        deallocate(ctmp)
      99             :     endif
     100         664 :     if (allocated(this%nIJ_llp_mmp)) then
     101        4648 :        ALLOCATE(ctmp(size(this%nIJ_llp_mmp)))
     102        3320 :        CALL MPI_REDUCE(this%nIJ_llp_mmp,ctmp,size(this%nIJ_llp_mmp),MPI_DOUBLE_COMPLEX,MPI_SUM,0,fmpi_comm,ierr)
     103       66820 :        if (irank==0) this%nIJ_llp_mmp=reshape(ctmp,shape(this%nIJ_llp_mmp))
     104         664 :        deallocate(ctmp)
     105             :     endif
     106             : 
     107             : #endif
     108        1328 :   end subroutine collect
     109             : 
     110        6938 :   subroutine distribute(this,fmpi_comm)
     111             :     use m_mpi_bc_tool
     112             : #ifdef CPP_MPI
     113             :     use mpi
     114             : #endif
     115             :     implicit none
     116             :     class(t_potden),INTENT(INOUT) :: this
     117             :     integer :: fmpi_comm
     118             : #ifdef CPP_MPI
     119        6938 :     call mpi_bc(this%iter,0,fmpi_comm)
     120        6938 :     call mpi_bc(this%potdentype,0,fmpi_comm)
     121        6938 :     call mpi_bc(this%pw,0,fmpi_comm)
     122        6938 :     IF (ALLOCATED(this%pw_w)) CALL mpi_bc(this%pw_w ,0,fmpi_comm)
     123        6938 :     CALL mpi_bc(this%mt ,0,fmpi_comm)
     124        6938 :     IF (ALLOCATED(this%vac)) CALL mpi_bc(this%vac,0,fmpi_comm)
     125        6938 :     IF (ALLOCATED(this%mmpMat)) CALL mpi_bc(this%mmpMat,0,fmpi_comm)
     126        6938 :     IF (ALLOCATED(this%nIJ_llp_mmp)) CALL mpi_bc(this%nIJ_llp_mmp,0,fmpi_comm)
     127             : #endif
     128        6938 :   end subroutine distribute
     129             : 
     130        1032 :   SUBROUTINE sum_both_spin(this,that)
     131             :     IMPLICIT NONE
     132             :     CLASS(t_potden),INTENT(INOUT)   :: this
     133             :     TYPE(t_potden),INTENT(INOUT),OPTIONAL :: that
     134             : 
     135        1032 :     IF (PRESENT(that)) THEN
     136         688 :        IF (SIZE(this%pw,2)>1) THEN
     137    15480680 :           that%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
     138      898166 :           that%pw(:,1)=this%pw(:,1)+this%pw(:,2)
     139     2465010 :           that%vac(:,:,:,1)=this%vac(:,:,:,1)+this%vac(:,:,:,2)
     140         398 :           IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
     141             :        ELSE
     142     8257096 :           that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
     143      650394 :           that%pw(:,1)=this%pw(:,1)
     144    14983562 :           that%vac(:,:,:,1)=this%vac(:,:,:,1)
     145         290 :           IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
     146             :        ENDIF
     147             :     ELSE
     148         344 :        IF (SIZE(this%pw,2)>1) THEN
     149     7740340 :           this%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
     150      449083 :           this%pw(:,1)=this%pw(:,1)+this%pw(:,2)
     151     1232505 :           this%vac(:,:,:,1)=this%vac(:,:,:,1)+this%vac(:,:,:,2)
     152         199 :           IF (ALLOCATED(this%pw_w)) this%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
     153             :        ENDIF
     154             :     END IF
     155        1032 :   END SUBROUTINE sum_both_spin
     156             : 
     157         688 :   SUBROUTINE copy_both_spin(this,that)
     158             :     IMPLICIT NONE
     159             :     CLASS(t_potden),INTENT(IN)   :: this
     160             :     TYPE(t_potden),INTENT(INOUT) :: that
     161             : 
     162    23737776 :     that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
     163     1548560 :     that%pw(:,1)=this%pw(:,1)
     164    17448572 :     that%vac(:,:,:,1)=this%vac(:,:,:,1)
     165     1548560 :     IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
     166             : 
     167         688 :     IF (SIZE(that%mt,4)>1) THEN
     168    15480680 :        that%mt(:,0:,:,2)=this%mt(:,0:,:,1)
     169      898166 :        that%pw(:,2)=this%pw(:,1)
     170     2465010 :        that%vac(:,:,:,2)=this%vac(:,:,:,1)
     171      898166 :        IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,2)=this%pw_w(:,1)
     172             :     END IF
     173         688 :   END SUBROUTINE copy_both_spin
     174             : 
     175           9 :   subroutine SpinsToChargeAndMagnetisation( den )
     176             :     implicit none
     177             :     class(t_potden), intent(inout)    :: den
     178             :     !type(t_potden),  intent(inout) :: charge_magn
     179             : 
     180           9 :     type(t_potden) :: copy
     181             : 
     182           9 :     copy = den
     183             : 
     184      907362 :     den%mt(:,0:,:,  1) = copy%mt(:,0:,:,  1) + copy%mt(:,0:,:,  2)
     185      907362 :     den%mt(:,0:,:,  2) = copy%mt(:,0:,:,  1) - copy%mt(:,0:,:,  2)
     186       22272 :     den%pw(:,       1) = copy%pw(:,       1) + copy%pw(:,       2)
     187       22272 :     den%pw(:,       2) = copy%pw(:,       1) - copy%pw(:,       2)
     188          27 :     den%vac(:,:,:,1) = copy%vac(:,:,:,1) + copy%vac(:,:,:,2)
     189          27 :     den%vac(:,:,:,2) = copy%vac(:,:,:,1) - copy%vac(:,:,:,2)
     190           9 :   end subroutine
     191             : 
     192           9 :   subroutine ChargeAndMagnetisationToSpins( den )
     193             :     implicit none
     194             :     class(t_potden), intent(inout)    :: den
     195             :     !type(t_potden),  intent(inout) :: spins
     196             : 
     197           9 :     type(t_potden) :: copy
     198             : 
     199           9 :     copy = den
     200             : 
     201      907362 :     den%mt(:,0:,:,  1) = ( copy%mt(:,0:,:,  1) + copy%mt(:,0:,:,  2) ) / 2
     202      907362 :     den%mt(:,0:,:,  2) = ( copy%mt(:,0:,:,  1) - copy%mt(:,0:,:,  2) ) / 2
     203       22272 :     den%pw(:,       1) = ( copy%pw(:,       1) + copy%pw(:,       2) ) / 2
     204       22272 :     den%pw(:,       2) = ( copy%pw(:,       1) - copy%pw(:,       2) ) / 2
     205          27 :     den%vac(:,:,:,1) = ( copy%vac(:,:,:,1) + copy%vac(:,:,:,2) ) / 2
     206          27 :     den%vac(:,:,:,2) = ( copy%vac(:,:,:,1) - copy%vac(:,:,:,2) ) / 2
     207           9 :   end subroutine
     208             : 
     209           9 :   subroutine addPotDen( PotDen3, PotDen1, PotDen2 )
     210             :     implicit none
     211             :     class(t_potden), intent(in)    :: PotDen1
     212             :     class(t_potden), intent(in)    :: PotDen2
     213             :     class(t_potden), intent(inout) :: PotDen3
     214             : 
     215           9 :     PotDen3%iter       = PotDen1%iter
     216           9 :     PotDen3%potdenType = PotDen1%potdenType
     217             : 
     218             :     ! implicit allocation would break the bounds staring at 0
     219           9 :     if(.not. allocated(PotDen3%mt)) allocate(PotDen3%mt, mold=PotDen1%mt)
     220             : 
     221     1077948 :     PotDen3%mt         = PotDen1%mt + PotDen2%mt
     222       26130 :     PotDen3%pw         = PotDen1%pw + PotDen2%pw
     223          54 :     PotDen3%vac      = PotDen1%vac + PotDen2%vac
     224           9 :     if( allocated( PotDen1%pw_w ) .and. allocated( PotDen2%pw_w ) .and. allocated( PotDen3%pw_w ) ) then
     225       18444 :       PotDen3%pw_w = PotDen1%pw_w + PotDen2%pw_w
     226             :     end if
     227             : 
     228           9 :   end subroutine
     229             : 
     230         676 :   subroutine subPotDen( PotDen3, PotDen1, PotDen2 )
     231             :     implicit none
     232             :     class(t_potden), intent(in)    :: PotDen1
     233             :     class(t_potden), intent(in)    :: PotDen2
     234             :     class(t_potden), intent(inout) :: PotDen3
     235             : 
     236         676 :     PotDen3%iter       = PotDen1%iter
     237         676 :     PotDen3%potdenType = PotDen1%potdenType
     238             : 
     239             :     ! implicit allocation would break the bounds starting at 0
     240        4026 :     if(.not. allocated(PotDen3%mt)) allocate(PotDen3%mt, mold=PotDen1%mt)
     241             :     
     242             :     ! The following allocates are countermeasures to valgrind complaints
     243        4026 :     if(.not. allocated(PotDen3%vac)) allocate(PotDen3%vac, mold=PotDen1%vac)
     244             : 
     245    46743414 :     PotDen3%mt         = PotDen1%mt - PotDen2%mt
     246     3024442 :     PotDen3%pw         = PotDen1%pw - PotDen2%pw
     247    19830128 :     PotDen3%vac        = PotDen1%vac - PotDen2%vac
     248         676 :     if( allocated( PotDen1%pw_w ) .and. allocated( PotDen2%pw_w ) .and. allocated( PotDen3%pw_w ) ) then
     249           0 :       PotDen3%pw_w = PotDen1%pw_w - PotDen2%pw_w
     250             :     end if
     251             : 
     252         676 :   end subroutine
     253             : 
     254         706 :   subroutine copyPotDen( PotDenCopy, PotDen )
     255             : 
     256             :     implicit none
     257             :     class(t_potden), intent(in)    :: PotDen
     258             :     class(t_potden), intent(inout) :: PotDenCopy
     259             : 
     260         706 :     PotDenCopy%iter       = PotDen%iter
     261         706 :     PotDenCopy%potdenType = PotDen%potdenType
     262             : 
     263             :     ! implicit allocation would break the bounds starting at 0
     264        4131 :     if(.not. allocated(PotDenCopy%mt)) allocate(PotDenCopy%mt, mold=PotDen%mt)
     265             :     
     266             :     ! The following allocates are countermeasures to valgrind complaints
     267        4131 :     if(.not. allocated(PotDenCopy%vac)) allocate(PotDenCopy%vac, mold=PotDen%vac)
     268             : 
     269    58762828 :     PotDenCopy%mt         = PotDen%mt
     270     3303998 :     PotDenCopy%pw         = PotDen%pw
     271    19915762 :     PotDenCopy%vac        = PotDen%vac
     272        7244 :     PotDenCopy%qint       = PotDen%qint
     273        7244 :     PotDenCopy%tec        = PotDen%tec
     274     1682364 :     PotDenCopy%mtCore     = PotDen%mtCore
     275       87216 :     PotDenCopy%mmpMat     = PotDen%mmpMat
     276       76956 :     PotDenCopy%nIJ_llp_mmp= PotDen%nIJ_llp_mmp
     277             : 
     278         706 :   end subroutine copyPotDen
     279             : 
     280        5251 :   SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,jspins,potden_type,l_dfpt)
     281             :     USE m_judft
     282             :     USE m_types_atoms
     283             :     USE m_types_stars
     284             :     USE m_types_vacuum
     285             :     USE m_types_noco
     286             :     USE m_types_sphhar
     287             : 
     288             :     IMPLICIT NONE
     289             :     CLASS(t_potden),INTENT(OUT):: pd
     290             :     TYPE(t_atoms),INTENT(IN) :: atoms
     291             :     TYPE(t_stars),INTENT(IN) :: stars
     292             :     TYPE(t_sphhar),INTENT(IN):: sphhar
     293             :     TYPE(t_vacuum),INTENT(IN):: vacuum
     294             :     TYPE(t_noco),INTENT(IN)  :: noco
     295             :     INTEGER,INTENT(IN)       :: jspins, potden_type
     296             :     LOGICAL, OPTIONAL, INTENT(IN) :: l_dfpt
     297             : 
     298             :     LOGICAL :: do_dfpt
     299             : 
     300        5251 :     do_dfpt = .FALSE.
     301        5251 :     IF (PRESENT(l_dfpt)) do_dfpt = l_dfpt
     302             :     CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,atoms%msh,sphhar%nlhd,atoms%ntype,&
     303             :          atoms%n_denmat,atoms%n_vPairs,jspins,noco%l_noco,noco%l_mperp,potden_type,&
     304        5251 :          vacuum%nmzd,vacuum%nmzxyd,stars%ng2,do_dfpt)
     305        5251 :   END SUBROUTINE init_potden_types
     306             : 
     307        5985 :   SUBROUTINE init_potden_simple(pd,ng3,jmtd,coreMsh,nlhd,ntype,n_u,n_vPairs,jspins,nocoExtraDim,nocoExtraMTDim,potden_type,nmzd,nmzxyd,n2d,do_dfpt)
     308             :     USE m_constants
     309             :     USE m_judft
     310             :     IMPLICIT NONE
     311             :     CLASS(t_potden),INTENT(OUT) :: pd
     312             :     INTEGER,INTENT(IN)          :: ng3,jmtd,coreMsh,nlhd,ntype,n_u,n_vPairs,jspins,potden_type
     313             :     LOGICAL,INTENT(IN)          :: nocoExtraDim,nocoExtraMTDim
     314             :     INTEGER,INTENT(IN)          :: nmzd,nmzxyd,n2d
     315             :     LOGICAL,OPTIONAL,INTENT(IN) :: do_dfpt
     316             : 
     317             :     INTEGER:: err(3)
     318             :     LOGICAL :: l_dfpt
     319             : 
     320        5985 :     l_dfpt = .FALSE.
     321        5985 :     IF (PRESENT(do_dfpt)) l_dfpt = do_dfpt
     322             : 
     323        5985 :     err=0
     324        5985 :     pd%iter=0
     325        5985 :     pd%potdenType=potden_type
     326        5985 :     IF(ALLOCATED(pd%pw)) DEALLOCATE (pd%pw)
     327        5985 :     IF(ALLOCATED(pd%mt)) DEALLOCATE (pd%mt)
     328        5985 :     IF(ALLOCATED(pd%vac)) DEALLOCATE (pd%vac)
     329        5985 :     IF(ALLOCATED(pd%qint)) DEALLOCATE (pd%qint)
     330        5985 :     IF(ALLOCATED(pd%tec)) DEALLOCATE (pd%tec)
     331        5985 :     IF(ALLOCATED(pd%mtCore)) DEALLOCATE (pd%mtCore)
     332        5985 :     IF(ALLOCATED(pd%mmpMat)) DEALLOCATE (pd%mmpMat)
     333        5985 :     IF(ALLOCATED(pd%nIJ_llp_mmp)) DEALLOCATE (pd%nIJ_llp_mmp)
     334             : 
     335        5985 :     IF (l_dfpt) THEN
     336           0 :       ALLOCATE (pd%pw(ng3,MERGE(4,jspins,nocoExtraDim)),stat=err(1))
     337             :     ELSE
     338       23940 :       ALLOCATE (pd%pw(ng3,MERGE(3,jspins,nocoExtraDim)),stat=err(1))
     339             :     END IF
     340       35910 :     ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,MERGE(4,jspins,nocoExtraMTDim)),stat=err(2))
     341       35910 :     ALLOCATE (pd%vac(nmzd,n2d,2,MERGE(3,jspins,nocoExtraDim)),stat=err(3))
     342       23940 :     ALLOCATE (pd%qint(ntype,jspins))
     343       17955 :     ALLOCATE (pd%tec(ntype,jspins))
     344       29925 :     ALLOCATE (pd%mtCore(coreMsh,ntype,jspins))
     345             : 
     346       29311 :     ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),MERGE(3,jspins,nocoExtraMTDim)))
     347       23940 :     ALLOCATE (pd%nIJ_llp_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_vPairs),MERGE(3,jspins,nocoExtraMTDim)))
     348             : 
     349       23940 :     IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
     350    32737923 :     pd%pw=CMPLX(0.0,0.0)
     351   486423695 :     pd%mt=0.0
     352   139090075 :     pd%vac=CMPLX(0.0,0.0)
     353       30667 :     pd%qint = 0.0
     354       30667 :     pd%tec = 0.0
     355    13274553 :     pd%mtCore = 0.0
     356      647423 :     pd%mmpMat = CMPLX(0.0,0.0)
     357      578909 :     pd%nIJ_llp_mmp = CMPLX(0.0,0.0)
     358        5985 :   END SUBROUTINE init_potden_simple
     359             : !!$#CPP_TODO_copy !code from brysh1,brysh2...
     360             : !!$  SUBROUTINE get_combined_vector(input,stars,atoms,sphhar,noco,vacuum,sym ,&
     361             : !!$                    den,nmap,nmaph,mapmt,mapvac2,sout)
     362             : !!$    !This was brysh1 before
     363             : !!$    USE m_types
     364             : !!$    IMPLICIT NONE
     365             : !!$
     366             : !!$    TYPE(t_input),INTENT(IN)   :: input
     367             : !!$    TYPE(t_vacuum),INTENT(IN)  :: vacuum
     368             : !!$    TYPE(t_noco),INTENT(IN)    :: noco
     369             : !!$    TYPE(t_sym),INTENT(IN)     :: sym
     370             : !!$    TYPE(t_stars),INTENT(IN)   :: stars
     371             : !!$    TYPE(t_sphhar),INTENT(IN)  :: sphhar
     372             : !!$    TYPE(t_atoms),INTENT(IN)   :: atoms
     373             : !!$    TYPE(t_potden),INTENT(IN)  :: den
     374             : !!$
     375             : !!$    ! Scalar Arguments
     376             : !!$    INTEGER, INTENT (OUT) :: mapmt,mapvac2,nmap,nmaph
     377             : !!$
     378             : !!$    ! Array Arguments
     379             : !!$    REAL,ALLOCATABLE,INTENT (OUT) :: sout(:)
     380             : !!$
     381             : !!$    ! Local Scalars
     382             : !!$    INTEGER i,iv,j,js,k,l,n,na,nvaccoeff,nvaccoeff2,mapmtd
     383             : !!$
     384             : !!$    !Calculation of size
     385             : !!$    i=SIZE(den%mt)+MERGE(SIZE(den%pw),2*SIZE(den%pw),sym%invs)+SIZE(den%vacxz)+MERGE(SIZE(den%vacz)*2,SIZE(den%vacz),sym%invs)
     386             : !!$    IF (any(noco%l_unrestrictMT).AND.sym%invs) i=i+
     387             : !!$
     388             : !!$
     389             : !!$
     390             : !!$    !--->  put input into arrays sout
     391             : !!$    !      in the spin polarized case the arrays consist of
     392             : !!$    !      spin up and spin down densities
     393             : !!$
     394             : !!$    j=0
     395             : !!$    DO  js = 1,input%jspins
     396             : !!$       DO i = 1,stars%ng3
     397             : !!$          j = j + 1
     398             : !!$          sout(j) = REAL(den%pw(i,js))
     399             : !!$       END DO
     400             : !!$       IF (.NOT.sym%invs) THEN
     401             : !!$          DO i = 1,stars%ng3
     402             : !!$             j = j + 1
     403             : !!$             sout(j) = AIMAG(den%pw(i,js))
     404             : !!$          END DO
     405             : !!$       ENDIF
     406             : !!$       mapmt=0
     407             : !!$       na = 1
     408             : !!$       DO n = 1,atoms%ntype
     409             : !!$          DO l = 0,sphhar%nlh(sym%ntypsy(na))
     410             : !!$             DO i = 1,atoms%jri(n)
     411             : !!$                mapmt = mapmt +1
     412             : !!$                j = j + 1
     413             : !!$                sout(j) = den%mt(i,l,n,js)
     414             : !!$             END DO
     415             : !!$          END DO
     416             : !!$          na = na + atoms%neq(n)
     417             : !!$       END DO
     418             : !!$       IF (input%film) THEN
     419             : !!$          DO iv = 1,vacuum%nvac
     420             : !!$             DO k = 1,vacuum%nmz
     421             : !!$                j = j + 1
     422             : !!$                sout(j) = den%vacz(k,iv,js)
     423             : !!$             END DO
     424             : !!$             DO k = 1,stars%ng2-1
     425             : !!$                DO i = 1,vacuum%nmzxy
     426             : !!$                   j = j + 1
     427             : !!$                   sout(j) =  REAL(den%vacxy(i,k,iv,js))
     428             : !!$                END DO
     429             : !!$             END DO
     430             : !!$             IF (.NOT.sym%invs2) THEN
     431             : !!$                DO k = 1,stars%ng2-1
     432             : !!$                   DO i = 1,vacuum%nmzxy
     433             : !!$                      j = j + 1
     434             : !!$                      sout(j) =  AIMAG(den%vacxy(i,k,iv,js))
     435             : !!$                   END DO
     436             : !!$                END DO
     437             : !!$             END IF
     438             : !!$          END DO
     439             : !!$       END IF
     440             : !!$       IF (js .EQ. 1) nmaph = j
     441             : !!$    ENDDO
     442             : !!$
     443             : !!$    mapvac2=0
     444             : !!$    IF (noco%l_noco) THEN
     445             : !!$       !--->    off-diagonal part of the density matrix
     446             : !!$       DO i = 1,stars%ng3
     447             : !!$          j = j + 1
     448             : !!$          sout(j) = REAL(den%pw(i,3))
     449             : !!$       END DO
     450             : !!$       DO i = 1,stars%ng3
     451             : !!$          j = j + 1
     452             : !!$          sout(j) = AIMAG(den%pw(i,3))
     453             : !!$       END DO
     454             : !!$       IF (input%film) THEN
     455             : !!$          DO iv = 1,vacuum%nvac
     456             : !!$             DO k = 1,vacuum%nmz
     457             : !!$                mapvac2 = mapvac2 + 1
     458             : !!$                j = j + 1
     459             : !!$                sout(j) = den%vacz(k,iv,3)
     460             : !!$             END DO
     461             : !!$             DO k = 1,stars%ng2-1
     462             : !!$                DO i = 1,vacuum%nmzxy
     463             : !!$                   mapvac2 = mapvac2 + 1
     464             : !!$                   j = j + 1
     465             : !!$                   sout(j) =  REAL(den%vacxy(i,k,iv,3))
     466             : !!$                END DO
     467             : !!$             END DO
     468             : !!$          END DO
     469             : !!$          DO iv = 1,vacuum%nvac
     470             : !!$             DO k = 1,vacuum%nmz
     471             : !!$                mapvac2 = mapvac2 + 1
     472             : !!$                j = j + 1
     473             : !!$                sout(j) = den%vacz(k,iv,4)
     474             : !!$             END DO
     475             : !!$             DO k = 1,stars%ng2-1
     476             : !!$                DO i = 1,vacuum%nmzxy
     477             : !!$                   mapvac2 = mapvac2 + 1
     478             : !!$                   j = j + 1
     479             : !!$                   sout(j) =  AIMAG(den%vacxy(i,k,iv,3))
     480             : !!$                END DO
     481             : !!$             END DO
     482             : !!$          END DO
     483             : !!$          nvaccoeff2 = 2*vacuum%nmzxy*(stars%ng2-1)*vacuum%nvac + 2*vacuum%nmz*vacuum%nvac
     484             : !!$          IF (mapvac2 .NE. nvaccoeff2) THEN
     485             : !!$             WRITE (oUnit,*)'The number of vaccum coefficients off the'
     486             : !!$             WRITE (oUnit,*)'off-diagonal part of the density matrix is'
     487             : !!$             WRITE (oUnit,*)'inconsitent:'
     488             : !!$             WRITE (oUnit,8000) mapvac2,nvaccoeff2
     489             : !!$8000         FORMAT ('mapvac2= ',i12,'nvaccoeff2= ',i12)
     490             : !!$             CALL juDFT_error("brysh1:# of vacuum coeff. inconsistent" ,calledby ="brysh1")
     491             : !!$          ENDIF
     492             : !!$       END IF
     493             : !!$    ENDIF ! noco
     494             : !!$
     495             : !!$    IF (atoms%n_u > 0 ) THEN     ! lda+U
     496             : !!$       DO js = 1,input%jspins
     497             : !!$          DO n = 1, atoms%n_u
     498             : !!$             DO k = -3, 3
     499             : !!$                DO i = -3, 3
     500             : !!$                   j = j + 1
     501             : !!$                   sout(j) = REAL(den%mmpMat(i,k,n,js))
     502             : !!$                   j = j + 1
     503             : !!$                   sout(j) = AIMAG(den%mmpMat(i,k,n,js))
     504             : !!$                ENDDO
     505             : !!$             ENDDO
     506             : !!$          ENDDO
     507             : !!$       ENDDO
     508             : !!$    ENDIF
     509             : !!$
     510             : !!$    mapmtd = atoms%ntype*(sphhar%nlhd+1)*atoms%jmtd
     511             : !!$    IF (mapmt .GT. mapmtd) THEN
     512             : !!$       WRITE(oUnit,*)'The number of mt coefficients is larger than the'
     513             : !!$       WRITE(oUnit,*)'dimensions:'
     514             : !!$       WRITE (oUnit,8040) mapmt,mapmtd
     515             : !!$8040   FORMAT ('mapmt= ',i12,' > mapmtd= ',i12)
     516             : !!$       CALL juDFT_error("brysh1: mapmt > mapmtd (dimensions)",calledby ="brysh1")
     517             : !!$    ENDIF
     518             : !!$
     519             : !!$    nmap = j
     520             : !!$    IF (nmap.GT.SIZE(sout)) THEN
     521             : !!$       WRITE(oUnit,*)'The total number of charge density coefficients is'
     522             : !!$       WRITE(oUnit,*)'larger than the dimensions:'
     523             : !!$       WRITE (oUnit,8030) nmap,SIZE(sout)
     524             : !!$8030   FORMAT ('nmap= ',i12,' > size(sout)= ',i12)
     525             : !!$       CALL juDFT_error("brysh1: nmap > mmap (dimensions)",calledby ="brysh1")
     526             : !!$    ENDIF
     527             : !!$
     528             : !!$  END SUBROUTINE get_combined_vector
     529             : !!$#endif
     530             : 
     531             : 
     532             : 
     533        3440 :   SUBROUTINE resetPotDen(pd)
     534             : 
     535             :     IMPLICIT NONE
     536             : 
     537             :     CLASS(t_potden),INTENT(INOUT) :: pd
     538             : 
     539    15261796 :     pd%pw=CMPLX(0.0,0.0)
     540   231234178 :     pd%mt=0.0
     541    98240468 :     pd%vac=CMPLX(0.0,0.0)
     542       17542 :     pd%qint = 0.0
     543       17542 :     pd%tec = 0.0
     544     7659500 :     pd%mtCore = 0.0
     545      368332 :     pd%mmpMat = CMPLX(0.0,0.0)
     546      319540 :     pd%nIJ_llp_mmp = CMPLX(0.0,0.0)
     547        3440 :     IF (ALLOCATED(pd%pw_w)) DEALLOCATE(pd%pw_w)
     548        3440 :   END SUBROUTINE resetPotDen
     549             : 
     550           0 :   SUBROUTINE reset_dfpt(pd)
     551             : 
     552             :     IMPLICIT NONE
     553             : 
     554             :     CLASS(t_potden),INTENT(INOUT) :: pd
     555             : 
     556           0 :     IF (ALLOCATED(pd%mt)) DEALLOCATE(pd%mt)
     557           0 :     IF (ALLOCATED(pd%pw)) DEALLOCATE(pd%pw)
     558           0 :     IF (ALLOCATED(pd%pw_w)) DEALLOCATE(pd%pw_w)
     559           0 :   END SUBROUTINE reset_dfpt
     560             : 
     561       33708 : END MODULE m_types_potden

Generated by: LCOV version 1.14