LCOV - code coverage report
Current view: top level - types - types_potden.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 155 157 98.7 %
Date: 2019-09-08 04:53:50 Functions: 13 14 92.9 %

          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             :      REAL,ALLOCATABLE    :: vacz(:,:,:)
      16             :      COMPLEX,ALLOCATABLE :: vacxy(:,:,:,:)
      17             :      !For angles of density/potential in noco case
      18             :      REAL,ALLOCATABLE  :: theta_pw(:)
      19             :      REAL,ALLOCATABLE  :: phi_pw(:)
      20             :      REAL,ALLOCATABLE  :: theta_vacz(:,:)
      21             :      REAL,ALLOCATABLE  :: phi_vacz(:,:)
      22             :      REAL,ALLOCATABLE  :: theta_vacxy(:,:,:)
      23             :      REAL,ALLOCATABLE  :: phi_vacxy(:,:,:)
      24             :      REAL,ALLOCATABLE  :: theta_mt(:,:)
      25             :      REAL,ALLOCATABLE  :: phi_mt(:,:)
      26             :      
      27             : 
      28             :      ! For density matrix and associated potential matrix
      29             :      COMPLEX, ALLOCATABLE :: mmpMat(:,:,:,:)
      30             : 
      31             :      !this type contains two init routines that should be used to allocate
      32             :      !memory. You can either specify the datatypes or give the dimensions as integers
      33             :      !See implementation below!
      34             :    CONTAINS
      35             :      PROCEDURE :: init_potden_types
      36             :      PROCEDURE :: init_potden_simple
      37             :      PROCEDURE :: resetpotden
      38             :      GENERIC   :: init=>init_potden_types,init_potden_simple
      39             :      PROCEDURE :: copy_both_spin
      40             :      PROCEDURE :: sum_both_spin
      41             :      procedure :: SpinsToChargeAndMagnetisation
      42             :      procedure :: ChargeAndMagnetisationToSpins
      43             :      procedure :: addPotDen
      44             :      procedure :: subPotDen
      45             :      procedure :: copyPotDen
      46             :      procedure :: distribute
      47             :      procedure :: collect
      48             :   END TYPE t_potden
      49             : 
      50             : CONTAINS
      51         322 :   subroutine collect(this,mpi_comm)
      52             :     use m_mpi_bc_tool
      53             :     implicit none
      54             :     class(t_potden),INTENT(INOUT) :: this
      55             :     integer :: mpi_comm
      56             : #ifdef CPP_MPI
      57             :     include 'mpif.h'
      58             :     INTEGER:: ierr,irank
      59         322 :     real,ALLOCATABLE::rtmp(:)
      60             :     complex,ALLOCATABLE::ctmp(:)
      61         322 :     CALL MPI_COMM_RANK(mpi_comm,irank,ierr)
      62             :     !pw
      63         322 :     ALLOCATE(ctmp(size(this%pw)))
      64         322 :     CALL MPI_REDUCE(this%pw,ctmp,size(this%pw),MPI_DOUBLE_COMPLEX,MPI_SUM,0,mpi_comm,ierr)
      65         322 :     if (irank==0) this%pw=reshape(ctmp,shape(this%pw))
      66         322 :     deallocate(ctmp)
      67             :     !mt
      68         322 :     ALLOCATE(rtmp(size(this%mt)))
      69         322 :     CALL MPI_REDUCE(this%mt,rtmp,size(this%mt),MPI_DOUBLE_PRECISION,MPI_SUM,0,mpi_comm,ierr)
      70         322 :     if (irank==0) this%mt=reshape(rtmp,shape(this%mt))
      71         322 :     deallocate(rtmp)
      72             :     !vac
      73         322 :     if (allocated(this%vacz)) THEN
      74         322 :        ALLOCATE(rtmp(size(this%vacz)))
      75         322 :        CALL MPI_REDUCE(this%vacz,rtmp,size(this%vacz),MPI_DOUBLE_PRECISION,MPI_SUM,0,mpi_comm,ierr)
      76         322 :        if (irank==0) this%vacz=reshape(rtmp,shape(this%vacz))
      77         322 :        deallocate(rtmp)
      78         322 :        ALLOCATE(ctmp(size(this%vacxy)))
      79         322 :        CALL MPI_REDUCE(this%vacxy,ctmp,size(this%vacxy),MPI_DOUBLE_COMPLEX,MPI_SUM,0,mpi_comm,ierr)
      80         322 :        if (irank==0) this%vacxy=reshape(ctmp,shape(this%vacxy))
      81         322 :        deallocate(ctmp)
      82             :     endif
      83             :     !density matrix
      84         322 :     if (allocated(this%mmpMat)) then
      85         322 :        ALLOCATE(ctmp(size(this%mmpMat)))
      86         322 :        CALL MPI_REDUCE(this%mmpMat,ctmp,size(this%mmpMat),MPI_DOUBLE_COMPLEX,MPI_SUM,0,mpi_comm,ierr)
      87         322 :        if (irank==0) this%mmpMat=reshape(ctmp,shape(this%mmpMat))
      88         322 :        deallocate(ctmp)
      89             :     endif
      90             : #endif
      91         322 :   end subroutine collect
      92             :   
      93        1182 :   subroutine distribute(this,mpi_comm)
      94             :     use m_mpi_bc_tool
      95             :     implicit none
      96             :     class(t_potden),INTENT(INOUT) :: this
      97             :     integer :: mpi_comm
      98             : #ifdef CPP_MPI
      99             :     include 'mpif.h'
     100        1182 :     call mpi_bc(this%iter,0,mpi_comm)
     101        1182 :     call mpi_bc(this%potdentype,0,mpi_comm)
     102        1182 :     call mpi_bc(this%pw,0,mpi_comm)
     103        1182 :     IF (ALLOCATED(this%pw_w)) CALL mpi_bc(this%pw_w ,0,mpi_comm)
     104        1182 :     CALL mpi_bc(this%mt ,0,mpi_comm)
     105        1182 :     IF (ALLOCATED(this%vacz)) call mpi_bc(this%vacz,0,mpi_comm)
     106        1182 :     IF (ALLOCATED(this%vacxy)) CALL mpi_bc(this%vacxy,0,mpi_comm)
     107        1182 :     IF (ALLOCATED(this%mmpMat)) CALL mpi_bc(this%mmpMat,0,mpi_comm)
     108             : #endif
     109        1182 :   end subroutine distribute
     110             :   
     111         510 :   SUBROUTINE sum_both_spin(this,that)
     112             :     IMPLICIT NONE
     113             :     CLASS(t_potden),INTENT(INOUT)   :: this
     114             :     TYPE(t_potden),INTENT(INOUT),OPTIONAL :: that
     115             : 
     116         510 :     IF (PRESENT(that)) THEN
     117         340 :        IF (SIZE(this%pw,2)>1) THEN
     118         268 :           that%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
     119         268 :           that%pw(:,1)=this%pw(:,1)+this%pw(:,2)
     120         268 :           that%vacz(:,:,1)=this%vacz(:,:,1)+this%vacz(:,:,2)
     121         268 :           that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)+this%vacxy(:,:,:,2)
     122         268 :           IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
     123             :        ELSE
     124          72 :           that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
     125          72 :           that%pw(:,1)=this%pw(:,1)
     126          72 :           that%vacz(:,:,1)=this%vacz(:,:,1)
     127          72 :           that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)
     128          72 :           IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
     129             :        ENDIF
     130             :     ELSE
     131         170 :        IF (SIZE(this%pw,2)>1) THEN
     132         134 :           this%mt(:,0:,:,1)=this%mt(:,0:,:,1)+this%mt(:,0:,:,2)
     133         134 :           this%pw(:,1)=this%pw(:,1)+this%pw(:,2)
     134         134 :           this%vacz(:,:,1)=this%vacz(:,:,1)+this%vacz(:,:,2)
     135         134 :           this%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)+this%vacxy(:,:,:,2)
     136         134 :           IF (ALLOCATED(this%pw_w)) this%pw_w(:,1)=this%pw_w(:,1)+this%pw_w(:,2)
     137             :        ENDIF
     138             :     END IF
     139         510 :   END SUBROUTINE sum_both_spin
     140             :     
     141         340 :   SUBROUTINE copy_both_spin(this,that)
     142             :     IMPLICIT NONE
     143             :     CLASS(t_potden),INTENT(IN)   :: this
     144             :     TYPE(t_potden),INTENT(INOUT) :: that
     145             : 
     146         340 :     that%mt(:,0:,:,1)=this%mt(:,0:,:,1)
     147         340 :     that%pw(:,1)=this%pw(:,1)
     148         340 :     that%vacz(:,:,1)=this%vacz(:,:,1)
     149         340 :     that%vacxy(:,:,:,1)=this%vacxy(:,:,:,1)
     150         340 :     IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,1)=this%pw_w(:,1)
     151             :     
     152         340 :     IF (SIZE(that%mt,4)>1) THEN
     153         268 :        that%mt(:,0:,:,2)=this%mt(:,0:,:,1)
     154         268 :        that%pw(:,2)=this%pw(:,1)
     155         268 :        that%vacz(:,:,2)=this%vacz(:,:,1)
     156         268 :        that%vacxy(:,:,:,2)=this%vacxy(:,:,:,1)
     157         268 :        IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,2)=this%pw_w(:,1)
     158             :     END IF
     159         340 :   END SUBROUTINE copy_both_spin
     160             : 
     161           3 :   subroutine SpinsToChargeAndMagnetisation( den )
     162             :     implicit none
     163             :     class(t_potden), intent(inout)    :: den
     164             :     !type(t_potden),  intent(inout) :: charge_magn
     165             : 
     166           3 :     type(t_potden) :: copy
     167             : 
     168           3 :     copy = den
     169             : 
     170           3 :     den%mt(:,0:,:,  1) = copy%mt(:,0:,:,  1) + copy%mt(:,0:,:,  2)
     171           3 :     den%mt(:,0:,:,  2) = copy%mt(:,0:,:,  1) - copy%mt(:,0:,:,  2)
     172           3 :     den%pw(:,       1) = copy%pw(:,       1) + copy%pw(:,       2)
     173           3 :     den%pw(:,       2) = copy%pw(:,       1) - copy%pw(:,       2)
     174           3 :     den%vacz(:,:,   1) = copy%vacz(:,:,   1) + copy%vacz(:,:,   2)
     175           3 :     den%vacz(:,:,   2) = copy%vacz(:,:,   1) - copy%vacz(:,:,   2)
     176           3 :     den%vacxy(:,:,:,1) = copy%vacxy(:,:,:,1) + copy%vacxy(:,:,:,2)
     177           3 :     den%vacxy(:,:,:,2) = copy%vacxy(:,:,:,1) - copy%vacxy(:,:,:,2)
     178             : 
     179           3 :   end subroutine
     180             : 
     181           3 :   subroutine ChargeAndMagnetisationToSpins( den )
     182             :     implicit none
     183             :     class(t_potden), intent(inout)    :: den
     184             :     !type(t_potden),  intent(inout) :: spins
     185             : 
     186           3 :     type(t_potden) :: copy
     187             : 
     188           3 :     copy = den
     189             : 
     190           3 :     den%mt(:,0:,:,  1) = ( copy%mt(:,0:,:,  1) + copy%mt(:,0:,:,  2) ) / 2
     191           3 :     den%mt(:,0:,:,  2) = ( copy%mt(:,0:,:,  1) - copy%mt(:,0:,:,  2) ) / 2
     192           3 :     den%pw(:,       1) = ( copy%pw(:,       1) + copy%pw(:,       2) ) / 2
     193           3 :     den%pw(:,       2) = ( copy%pw(:,       1) - copy%pw(:,       2) ) / 2
     194           3 :     den%vacz(:,:,   1) = ( copy%vacz(:,:,   1) + copy%vacz(:,:,   2) ) / 2
     195           3 :     den%vacz(:,:,   2) = ( copy%vacz(:,:,   1) - copy%vacz(:,:,   2) ) / 2
     196           3 :     den%vacxy(:,:,:,1) = ( copy%vacxy(:,:,:,1) + copy%vacxy(:,:,:,2) ) / 2
     197           3 :     den%vacxy(:,:,:,2) = ( copy%vacxy(:,:,:,1) - copy%vacxy(:,:,:,2) ) / 2
     198             : 
     199           3 :   end subroutine
     200             : 
     201           3 :   subroutine addPotDen( PotDen3, PotDen1, PotDen2 )
     202             :     implicit none
     203             :     class(t_potden), intent(in)    :: PotDen1
     204             :     class(t_potden), intent(in)    :: PotDen2
     205             :     class(t_potden), intent(inout) :: PotDen3
     206             : 
     207           3 :     PotDen3%iter       = PotDen1%iter
     208           3 :     PotDen3%potdenType = PotDen1%potdenType
     209             :     
     210             :     ! implicit allocation would break the bounds staring at 0
     211           3 :     if(.not. allocated(PotDen3%mt)) allocate(PotDen3%mt, mold=PotDen1%mt)
     212             :     
     213           3 :     PotDen3%mt         = PotDen1%mt + PotDen2%mt
     214           3 :     PotDen3%pw         = PotDen1%pw + PotDen2%pw
     215           3 :     PotDen3%vacz       = PotDen1%vacz + PotDen2%vacz
     216           3 :     PotDen3%vacxy      = PotDen1%vacxy + PotDen2%vacxy
     217           3 :     if( allocated( PotDen1%pw_w ) .and. allocated( PotDen2%pw_w ) .and. allocated( PotDen3%pw_w ) ) then
     218           0 :       PotDen3%pw_w = PotDen1%pw_w + PotDen2%pw_w
     219             :     end if
     220             :   
     221           3 :   end subroutine
     222             : 
     223         330 :   subroutine subPotDen( PotDen3, PotDen1, PotDen2 )
     224             :     implicit none
     225             :     class(t_potden), intent(in)    :: PotDen1
     226             :     class(t_potden), intent(in)    :: PotDen2
     227             :     class(t_potden), intent(inout) :: PotDen3
     228             :  
     229         330 :     PotDen3%iter       = PotDen1%iter
     230         330 :     PotDen3%potdenType = PotDen1%potdenType
     231             : 
     232             :     ! implicit allocation would break the bounds staring at 0
     233         330 :     if(.not. allocated(PotDen3%mt)) allocate(PotDen3%mt, mold=PotDen1%mt)
     234             :     
     235         330 :     PotDen3%mt         = PotDen1%mt - PotDen2%mt
     236         330 :     PotDen3%pw         = PotDen1%pw - PotDen2%pw
     237         330 :     PotDen3%vacz       = PotDen1%vacz - PotDen2%vacz
     238         330 :     PotDen3%vacxy      = PotDen1%vacxy - PotDen2%vacxy
     239         330 :     if( allocated( PotDen1%pw_w ) .and. allocated( PotDen2%pw_w ) .and. allocated( PotDen3%pw_w ) ) then
     240           0 :       PotDen3%pw_w = PotDen1%pw_w - PotDen2%pw_w
     241             :     end if
     242             :  
     243         330 :   end subroutine
     244             : 
     245         340 :   subroutine copyPotDen( PotDenCopy, PotDen )
     246             :   
     247             :     implicit none
     248             :     class(t_potden), intent(in)    :: PotDen
     249             :     class(t_potden), intent(inout) :: PotDenCopy
     250             : 
     251         340 :     PotDenCopy%iter       = PotDen%iter
     252         340 :     PotDenCopy%potdenType = PotDen%potdenType
     253             :     
     254             :     ! implicit allocation would break the bounds staring at 0
     255         340 :     if(.not. allocated(PotDenCopy%mt)) allocate(PotDenCopy%mt, mold=PotDen%mt)
     256             :     
     257         340 :     PotDenCopy%mt         = PotDen%mt
     258         340 :     PotDenCopy%pw         = PotDen%pw
     259         340 :     PotDenCopy%vacz       = PotDen%vacz
     260         340 :     PotDenCopy%vacxy      = PotDen%vacxy
     261             : 
     262         340 :   end subroutine copyPotDen
     263             : 
     264        2688 :   SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,jspins,potden_type)
     265             :     USE m_judft
     266             :     USE m_types_setup
     267             :     IMPLICIT NONE
     268             :     CLASS(t_potden),INTENT(OUT):: pd 
     269             :     TYPE(t_atoms),INTENT(IN) :: atoms
     270             :     TYPE(t_stars),INTENT(IN) :: stars
     271             :     TYPE(t_sphhar),INTENT(IN):: sphhar
     272             :     TYPE(t_vacuum),INTENT(IN):: vacuum
     273             :     TYPE(t_noco),INTENT(IN)  :: noco
     274             :     INTEGER,INTENT(IN)       :: jspins, potden_type
     275             :  
     276             :     CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,&
     277             :          atoms%n_u,jspins,noco%l_noco,noco%l_mtnocopot,potden_type,&
     278        2688 :          vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
     279        2688 :   END SUBROUTINE init_potden_types
     280             : 
     281        2688 :   SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,n_u,jspins,nocoExtraDim,nocoExtraMTDim,potden_type,nmzd,nmzxyd,n2d)
     282             :     USE m_constants
     283             :     USE m_judft
     284             :     IMPLICIT NONE
     285             :     CLASS(t_potden),INTENT(OUT) :: pd
     286             :     INTEGER,INTENT(IN)          :: ng3,jmtd,nlhd,ntype,n_u,jspins,potden_type
     287             :     LOGICAL,INTENT(IN)          :: nocoExtraDim,nocoExtraMTDim
     288             :     INTEGER,INTENT(IN)          :: nmzd,nmzxyd,n2d
     289             : 
     290             :     INTEGER:: err(4)
     291             : 
     292        2688 :     err=0
     293        2688 :     pd%iter=0
     294        2688 :     pd%potdenType=potden_type
     295        2688 :     IF(ALLOCATED(pd%pw)) DEALLOCATE (pd%pw)
     296        2688 :     IF(ALLOCATED(pd%mt)) DEALLOCATE (pd%mt)
     297        2688 :     IF(ALLOCATED(pd%vacz)) DEALLOCATE (pd%vacz)
     298        2688 :     IF(ALLOCATED(pd%vacxy)) DEALLOCATE (pd%vacxy)
     299        2688 :     IF(ALLOCATED(pd%mmpMat)) DEALLOCATE (pd%mmpMat)
     300        2688 :     ALLOCATE (pd%pw(ng3,MERGE(3,jspins,nocoExtraDim)),stat=err(1))
     301        2688 :     ALLOCATE (pd%mt(jmtd,0:nlhd,ntype,MERGE(4,jspins,nocoExtraMTDim)),stat=err(2))
     302        2688 :     ALLOCATE (pd%vacz(nmzd,2,MERGE(4,jspins,nocoExtraDim)),stat=err(3))
     303        2688 :     ALLOCATE (pd%vacxy(nmzxyd,n2d-1,2,MERGE(3,jspins,nocoExtraDim)),stat=err(4))
     304             : 
     305        2688 :     ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),jspins))
     306             : 
     307       13440 :     IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
     308        2688 :     pd%pw=CMPLX(0.0,0.0)
     309        2688 :     pd%mt=0.0
     310        2688 :     pd%vacz=0.0
     311        2688 :     pd%vacxy=CMPLX(0.0,0.0)
     312        2688 :     pd%mmpMat = CMPLX(0.0,0.0)
     313        2688 :   END SUBROUTINE init_potden_simple
     314             : !!$#CPP_TODO_copy !code from brysh1,brysh2... 
     315             : !!$  SUBROUTINE get_combined_vector(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,&
     316             : !!$                    den,nmap,nmaph,mapmt,mapvac2,sout) 
     317             : !!$    !This was brysh1 before
     318             : !!$    USE m_types
     319             : !!$    IMPLICIT NONE
     320             : !!$    TYPE(t_oneD),INTENT(IN)    :: oneD
     321             : !!$    TYPE(t_input),INTENT(IN)   :: input
     322             : !!$    TYPE(t_vacuum),INTENT(IN)  :: vacuum
     323             : !!$    TYPE(t_noco),INTENT(IN)    :: noco
     324             : !!$    TYPE(t_sym),INTENT(IN)     :: sym
     325             : !!$    TYPE(t_stars),INTENT(IN)   :: stars
     326             : !!$    TYPE(t_sphhar),INTENT(IN)  :: sphhar
     327             : !!$    TYPE(t_atoms),INTENT(IN)   :: atoms
     328             : !!$    TYPE(t_potden),INTENT(IN)  :: den
     329             : !!$
     330             : !!$    ! Scalar Arguments
     331             : !!$    INTEGER, INTENT (OUT) :: mapmt,mapvac2,nmap,nmaph
     332             : !!$
     333             : !!$    ! Array Arguments
     334             : !!$    REAL,ALLOCATABLE,INTENT (OUT) :: sout(:)
     335             : !!$
     336             : !!$    ! Local Scalars
     337             : !!$    INTEGER i,iv,j,js,k,l,n,na,nvaccoeff,nvaccoeff2,mapmtd
     338             : !!$
     339             : !!$    !Calculation of size
     340             : !!$    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)
     341             : !!$    IF (noco%l_mtnocopot.AND.sym%invs) i=i+
     342             : !!$    
     343             : !!$
     344             : !!$    
     345             : !!$    !--->  put input into arrays sout 
     346             : !!$    !      in the spin polarized case the arrays consist of 
     347             : !!$    !      spin up and spin down densities
     348             : !!$    
     349             : !!$    j=0
     350             : !!$    DO  js = 1,input%jspins
     351             : !!$       DO i = 1,stars%ng3
     352             : !!$          j = j + 1
     353             : !!$          sout(j) = REAL(den%pw(i,js))
     354             : !!$       END DO
     355             : !!$       IF (.NOT.sym%invs) THEN
     356             : !!$          DO i = 1,stars%ng3
     357             : !!$             j = j + 1
     358             : !!$             sout(j) = AIMAG(den%pw(i,js))
     359             : !!$          END DO
     360             : !!$       ENDIF
     361             : !!$       mapmt=0
     362             : !!$       na = 1
     363             : !!$       DO n = 1,atoms%ntype
     364             : !!$          DO l = 0,sphhar%nlh(atoms%ntypsy(na))
     365             : !!$             DO i = 1,atoms%jri(n)
     366             : !!$                mapmt = mapmt +1
     367             : !!$                j = j + 1
     368             : !!$                sout(j) = den%mt(i,l,n,js)
     369             : !!$             END DO
     370             : !!$          END DO
     371             : !!$          na = na + atoms%neq(n)
     372             : !!$       END DO
     373             : !!$       IF (input%film) THEN
     374             : !!$          DO iv = 1,vacuum%nvac
     375             : !!$             DO k = 1,vacuum%nmz
     376             : !!$                j = j + 1
     377             : !!$                sout(j) = den%vacz(k,iv,js)
     378             : !!$             END DO
     379             : !!$             DO k = 1,stars%ng2-1
     380             : !!$                DO i = 1,vacuum%nmzxy
     381             : !!$                   j = j + 1
     382             : !!$                   sout(j) =  REAL(den%vacxy(i,k,iv,js))
     383             : !!$                END DO
     384             : !!$             END DO
     385             : !!$             IF (.NOT.sym%invs2) THEN
     386             : !!$                DO k = 1,stars%ng2-1
     387             : !!$                   DO i = 1,vacuum%nmzxy
     388             : !!$                      j = j + 1
     389             : !!$                      sout(j) =  AIMAG(den%vacxy(i,k,iv,js))
     390             : !!$                   END DO
     391             : !!$                END DO
     392             : !!$             END IF
     393             : !!$          END DO
     394             : !!$       END IF
     395             : !!$       IF (js .EQ. 1) nmaph = j
     396             : !!$    ENDDO
     397             : !!$
     398             : !!$    mapvac2=0
     399             : !!$    IF (noco%l_noco) THEN
     400             : !!$       !--->    off-diagonal part of the density matrix
     401             : !!$       DO i = 1,stars%ng3
     402             : !!$          j = j + 1
     403             : !!$          sout(j) = REAL(den%pw(i,3))
     404             : !!$       END DO
     405             : !!$       DO i = 1,stars%ng3
     406             : !!$          j = j + 1
     407             : !!$          sout(j) = AIMAG(den%pw(i,3))
     408             : !!$       END DO
     409             : !!$       IF (input%film) THEN
     410             : !!$          DO iv = 1,vacuum%nvac
     411             : !!$             DO k = 1,vacuum%nmz
     412             : !!$                mapvac2 = mapvac2 + 1
     413             : !!$                j = j + 1
     414             : !!$                sout(j) = den%vacz(k,iv,3)
     415             : !!$             END DO
     416             : !!$             DO k = 1,stars%ng2-1
     417             : !!$                DO i = 1,vacuum%nmzxy
     418             : !!$                   mapvac2 = mapvac2 + 1
     419             : !!$                   j = j + 1
     420             : !!$                   sout(j) =  REAL(den%vacxy(i,k,iv,3))
     421             : !!$                END DO
     422             : !!$             END DO
     423             : !!$          END DO
     424             : !!$          DO iv = 1,vacuum%nvac
     425             : !!$             DO k = 1,vacuum%nmz
     426             : !!$                mapvac2 = mapvac2 + 1
     427             : !!$                j = j + 1
     428             : !!$                sout(j) = den%vacz(k,iv,4)
     429             : !!$             END DO
     430             : !!$             DO k = 1,stars%ng2-1
     431             : !!$                DO i = 1,vacuum%nmzxy
     432             : !!$                   mapvac2 = mapvac2 + 1
     433             : !!$                   j = j + 1
     434             : !!$                   sout(j) =  AIMAG(den%vacxy(i,k,iv,3))
     435             : !!$                END DO
     436             : !!$             END DO
     437             : !!$          END DO
     438             : !!$          nvaccoeff2 = 2*vacuum%nmzxy*(stars%ng2-1)*vacuum%nvac + 2*vacuum%nmz*vacuum%nvac
     439             : !!$          IF (mapvac2 .NE. nvaccoeff2) THEN
     440             : !!$             WRITE (6,*)'The number of vaccum coefficients off the'
     441             : !!$             WRITE (6,*)'off-diagonal part of the density matrix is'
     442             : !!$             WRITE (6,*)'inconsitent:'
     443             : !!$             WRITE (6,8000) mapvac2,nvaccoeff2
     444             : !!$8000         FORMAT ('mapvac2= ',i12,'nvaccoeff2= ',i12)
     445             : !!$             CALL juDFT_error("brysh1:# of vacuum coeff. inconsistent" ,calledby ="brysh1")
     446             : !!$          ENDIF
     447             : !!$       END IF
     448             : !!$    ENDIF ! noco
     449             : !!$
     450             : !!$    IF (atoms%n_u > 0 ) THEN     ! lda+U
     451             : !!$       DO js = 1,input%jspins
     452             : !!$          DO n = 1, atoms%n_u
     453             : !!$             DO k = -3, 3
     454             : !!$                DO i = -3, 3
     455             : !!$                   j = j + 1 
     456             : !!$                   sout(j) = REAL(den%mmpMat(i,k,n,js))
     457             : !!$                   j = j + 1 
     458             : !!$                   sout(j) = AIMAG(den%mmpMat(i,k,n,js))
     459             : !!$                ENDDO
     460             : !!$             ENDDO
     461             : !!$          ENDDO
     462             : !!$       ENDDO
     463             : !!$    ENDIF
     464             : !!$
     465             : !!$    mapmtd = atoms%ntype*(sphhar%nlhd+1)*atoms%jmtd
     466             : !!$    IF (mapmt .GT. mapmtd) THEN
     467             : !!$       WRITE(6,*)'The number of mt coefficients is larger than the'
     468             : !!$       WRITE(6,*)'dimensions:'
     469             : !!$       WRITE (6,8040) mapmt,mapmtd
     470             : !!$8040   FORMAT ('mapmt= ',i12,' > mapmtd= ',i12)
     471             : !!$       CALL juDFT_error("brysh1: mapmt > mapmtd (dimensions)",calledby ="brysh1")
     472             : !!$    ENDIF
     473             : !!$
     474             : !!$    nmap = j
     475             : !!$    IF (nmap.GT.SIZE(sout)) THEN 
     476             : !!$       WRITE(6,*)'The total number of charge density coefficients is'
     477             : !!$       WRITE(6,*)'larger than the dimensions:'
     478             : !!$       WRITE (6,8030) nmap,SIZE(sout)
     479             : !!$8030   FORMAT ('nmap= ',i12,' > size(sout)= ',i12)
     480             : !!$       CALL juDFT_error("brysh1: nmap > mmap (dimensions)",calledby ="brysh1")
     481             : !!$    ENDIF
     482             : !!$
     483             : !!$  END SUBROUTINE get_combined_vector
     484             : !!$#endif
     485             :     
     486             :     
     487             :   
     488        1020 :   SUBROUTINE resetPotDen(pd)
     489             : 
     490             :     IMPLICIT NONE
     491             : 
     492             :     CLASS(t_potden),INTENT(INOUT) :: pd
     493             : 
     494        1020 :     pd%pw=CMPLX(0.0,0.0)
     495        1020 :     pd%mt=0.0
     496        1020 :     pd%vacz=0.0
     497        1020 :     pd%vacxy=CMPLX(0.0,0.0)
     498        1020 :     pd%mmpMat = CMPLX(0.0,0.0)
     499        1020 :     IF (ALLOCATED(pd%pw_w)) DEALLOCATE(pd%pw_w)
     500        1020 :   END SUBROUTINE resetPotDen
     501             : 
     502        5376 : END MODULE m_types_potden

Generated by: LCOV version 1.13