cdngen.F90 5.53 KB
Newer Older
1 2 3 4 5
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
6
MODULE m_cdngen
7

8 9 10 11 12 13 14
USE m_juDFT

CONTAINS

SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
                  dimension,kpts,atoms,sphhar,stars,sym,obsolete,&
                  enpara,cell,noco,jij,vTot,results,oneD,coreSpecInput,&
15
                  archiveType,outDen)
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

   !*****************************************************
   !    Charge density generator
   !    calls cdnval to generate the valence charge and the
   !    core routines for the core contribution
   !*****************************************************

   USE m_constants
   USE m_prpqfftmap
   USE m_cdnval
   USE m_cdn_io
   USE m_wrtdop
   USE m_cdntot
   USE m_cdnovlp
   USE m_qfix
31
   USE m_genNewNocoInp
32 33
   USE m_types
   USE m_xmlOutput
34
   USE m_magMoms
35
   USE m_orbMagMoms
36
   USE m_cdncore
Daniel Wortmann's avatar
Daniel Wortmann committed
37
#ifdef CPP_MPI
38
   USE m_mpi_bc_potden
Daniel Wortmann's avatar
Daniel Wortmann committed
39
#endif
40

41
   IMPLICIT NONE
42

43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
   ! Type instance arguments
   TYPE(t_results),INTENT(INOUT)    :: results
   TYPE(t_mpi),INTENT(IN)           :: mpi
   TYPE(t_dimension),INTENT(IN)     :: dimension
   TYPE(t_oneD),INTENT(IN)          :: oneD
   TYPE(t_enpara),INTENT(INOUT)     :: enpara
   TYPE(t_obsolete),INTENT(IN)      :: obsolete
   TYPE(t_banddos),INTENT(IN)       :: banddos
   TYPE(t_sliceplot),INTENT(IN)     :: sliceplot
   TYPE(t_input),INTENT(IN)         :: input
   TYPE(t_vacuum),INTENT(IN)        :: vacuum
   TYPE(t_noco),INTENT(IN)          :: noco
   TYPE(t_jij),INTENT(IN)           :: jij
   TYPE(t_sym),INTENT(IN)           :: sym
   TYPE(t_stars),INTENT(IN)         :: stars
   TYPE(t_cell),INTENT(IN)          :: cell
   TYPE(t_kpts),INTENT(IN)          :: kpts
   TYPE(t_sphhar),INTENT(IN)        :: sphhar
   TYPE(t_atoms),INTENT(IN)         :: atoms
   TYPE(t_coreSpecInput),INTENT(IN) :: coreSpecInput
   TYPE(t_potden),INTENT(IN)        :: vTot
64
   TYPE(t_potden),INTENT(INOUT)     :: outDen
65 66

   !Scalar Arguments
67
   INTEGER, INTENT (IN)             :: eig_id, archiveType
68 69 70 71 72

   ! Local type instances
   TYPE(t_noco) :: noco_new

   !Local Scalars
73
   REAL fix,qtot,dummy
74
   INTEGER jspin,jspmax
75
   LOGICAL l_enpara
76 77

   !Local Arrays
78
   REAL stdn(atoms%ntype,dimension%jspd),svdn(atoms%ntype,dimension%jspd)
79 80
   REAL chmom(atoms%ntype,dimension%jspd),clmom(3,atoms%ntype,dimension%jspd)
   REAL   ,ALLOCATABLE :: qvac(:,:,:,:),qvlay(:,:,:,:,:)
81
   COMPLEX,ALLOCATABLE :: qa21(:)
82 83 84 85 86 87 88 89 90 91 92 93 94 95

   IF (mpi%irank.EQ.0) THEN
      INQUIRE(file='enpara',exist=l_enpara)
      IF (l_enpara) OPEN (40,file ='enpara',form = 'formatted',status ='unknown')
   ENDIF
   ALLOCATE (qa21(atoms%ntype))
   ALLOCATE (qvac(dimension%neigd,2,kpts%nkpt,dimension%jspd))
   ALLOCATE (qvlay(dimension%neigd,vacuum%layerd,2,kpts%nkpt,dimension%jspd))

   !initialize density arrays with zero
   qa21(:) = cmplx(0.0,0.0)
   qvac(:,:,:,:) = 0.0 
   qvlay(:,:,:,:,:) = 0.0

96
   IF (mpi%irank.EQ.0) CALL openXMLElementNoAttributes('valenceDensity')
97

98
   !In a non-collinear calcuation where the off-diagonal part of the
99 100
   !density matrix in the muffin-tins is calculated, the a- and
   !b-coef. for both spins are needed at once. Thus, cdnval is only
101
   !called once and both spin directions are calculated in a single run.
102 103 104 105 106
   jspmax = input%jspins
   IF (noco%l_mperp) jspmax = 1
   DO jspin = 1,jspmax
      CALL timestart("cdngen: cdnval")
      CALL cdnval(eig_id,&
107
                  mpi,kpts,jspin,sliceplot,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
108
                  sphhar,sym,obsolete,vTot,oneD,coreSpecInput,&
109
                  outDen,results,qvac,qvlay,qa21,chmom,clmom)
110 111 112 113 114
      CALL timestop("cdngen: cdnval")
   END DO

   IF (mpi%irank.EQ.0) THEN
      IF (l_enpara) CLOSE (40)
115
      CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
116 117 118
      CALL closeXMLElement('valenceDensity')
   END IF ! mpi%irank = 0

119 120
   CALL cdncore(results,mpi,dimension,oneD,sliceplot,input,vacuum,noco,sym,&
                stars,cell,sphhar,atoms,vTot,outDen,stdn,svdn)
121

122 123
   IF (sliceplot%slice) THEN
      IF (mpi%irank.EQ.0) THEN
124 125 126
         CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
                           1,-1.0,0.0,.FALSE.,outDen,'cdn_slice')
      END IF
127
      CALL juDFT_end("slice OK",mpi%irank)
128
   END IF
129

130 131
   IF (mpi%irank.EQ.0) THEN
      CALL openXMLElementNoAttributes('allElectronCharges')
132
      CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
      CALL closeXMLElement('allElectronCharges')

      IF (input%jspins.EQ.2) THEN
         noco_new = noco

         !Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
         CALL magMoms(dimension,input,atoms,noco_new,vTot,stdn,svdn,chmom,qa21)

         !Generate and save the new nocoinp file if the directions of the local
         !moments are relaxed or a constraint B-field is calculated.
         IF (ANY(noco%l_relax(:atoms%ntype)).OR.noco%l_constr) THEN
            CALL genNewNocoInp(input,atoms,jij,noco,noco_new)
         END IF

         IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,clmom)
      END IF
   END IF ! mpi%irank.EQ.0

151 152 153 154 155 156 157
#ifdef CPP_MPI
   CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif

   DEALLOCATE (qvac,qvlay,qa21)

END SUBROUTINE cdngen
158

159
END MODULE m_cdngen