cdngen.F90 7.07 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

CONTAINS

SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
12
                  dimension,kpts,atoms,sphhar,stars,sym,&
13
                  enpara,cell,noco,vTot,results,oneD,coreSpecInput,&
Matthias Redies's avatar
Matthias Redies committed
14
                  archiveType, xcpot,outDen,EnergyDen)
15 16 17 18 19 20 21

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

22
   USE m_types
23
   USE m_constants
24
   USE m_juDFT
25 26 27 28 29 30 31
   USE m_prpqfftmap
   USE m_cdnval
   USE m_cdn_io
   USE m_wrtdop
   USE m_cdntot
   USE m_cdnovlp
   USE m_qfix
32
   USE m_genNewNocoInp
33
   USE m_xmlOutput
34
   USE m_magMoms
35
   USE m_orbMagMoms
36
   USE m_cdncore
37 38
   USE m_doswrite
   USE m_Ekwritesl
39
   USE m_banddos_io
Matthias Redies's avatar
Matthias Redies committed
40
   USE m_metagga
41
   USE m_unfold_band_kpts
Daniel Wortmann's avatar
Daniel Wortmann committed
42
#ifdef CPP_MPI
43
   USE m_mpi_bc_potden
Daniel Wortmann's avatar
Daniel Wortmann committed
44
#endif
45

46
   IMPLICIT NONE
47

48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
   ! 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_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_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
Matthias Redies's avatar
Matthias Redies committed
67 68
   CLASS(t_xcpot),INTENT(INOUT)     :: xcpot
   TYPE(t_potden),INTENT(INOUT)     :: outDen, EnergyDen
69 70

   !Scalar Arguments
71
   INTEGER, INTENT (IN)             :: eig_id, archiveType
72 73

   ! Local type instances
74 75
   TYPE(t_noco)          :: noco_new
   TYPE(t_regionCharges) :: regCharges
76
   TYPE(t_dos)           :: dos
77
   TYPE(t_moments)       :: moments
78 79
   TYPE(t_mcd)           :: mcd
   TYPE(t_slab)          :: slab
80
   TYPE(t_orbcomp)       :: orbcomp
81
   TYPE(t_cdnvalJob)     :: cdnvalJob
82

83

84
   !Local Scalars
85
   REAL                  :: fix, qtot, dummy,eFermiPrev
86
   INTEGER               :: jspin, jspmax
87 88 89
#ifdef CPP_HDF
   INTEGER(HID_T)        :: banddosFile_id
#endif
90
   LOGICAL               :: l_error
91

92 93
   CALL regCharges%init(input,atoms)
   CALL dos%init(input,atoms,dimension,kpts,vacuum)
94
   CALL moments%init(input,atoms)
95 96 97
   CALL mcd%init1(banddos,dimension,input,atoms,kpts)
   CALL slab%init(banddos,dimension,atoms,cell,input,kpts)
   CALL orbcomp%init(input,banddos,dimension,atoms,kpts)
Matthias Redies's avatar
Matthias Redies committed
98 99

   CALL outDen%init(stars,    atoms, sphhar, vacuum, input%jspins, noco%l_noco, POTDEN_TYPE_DEN)
Matthias Redies's avatar
Matthias Redies committed
100
   CALL EnergyDen%init(stars, atoms, sphhar, vacuum, input%jspins, noco%l_noco, POTDEN_TYPE_EnergyDen)
101

Matthias Redies's avatar
Matthias Redies committed
102
   IF (mpi%irank == 0) CALL openXMLElementNoAttributes('valenceDensity')
103

104
   !In a non-collinear calcuation where the off-diagonal part of the
105 106
   !density matrix in the muffin-tins is calculated, the a- and
   !b-coef. for both spins are needed at once. Thus, cdnval is only
107
   !called once and both spin directions are calculated in a single run.
108 109 110
   jspmax = input%jspins
   IF (noco%l_mperp) jspmax = 1
   DO jspin = 1,jspmax
111
      CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin,sliceplot,banddos)
112
      CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
113
                  sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,coreSpecInput,mcd,slab,orbcomp)
114 115
   END DO

Matthias Redies's avatar
Matthias Redies committed
116 117
   ! calculate kinetic energy density for MetaGGAs
   if(xcpot%exc_is_metagga()) then
Matthias Redies's avatar
Matthias Redies committed
118
      CALL calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars,&
Matthias Redies's avatar
Matthias Redies committed
119
                             vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
Matthias Redies's avatar
Matthias Redies committed
120 121
   endif

Matthias Redies's avatar
Matthias Redies committed
122
   IF (mpi%irank == 0) THEN
123
      IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
124 125 126 127 128
         IF (banddos%unfoldband) THEN
            eFermiPrev = 0.0
            CALL readPrevEFermi(eFermiPrev,l_error)
            CALL write_band_sc(kpts,results,eFermiPrev)
         END IF
129
#ifdef CPP_HDF
130 131 132
         CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts)
         CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
         CALL closeBandDOSFile(banddosFile_id)
133
#endif
134
         CALL timestart("cdngen: dos")
135
         CALL doswrite(eig_id,dimension,kpts,atoms,vacuum,input,banddos,sliceplot,noco,sym,cell,dos,mcd,results,slab,orbcomp,oneD)
Matthias Redies's avatar
Matthias Redies committed
136
         IF (banddos%dos.AND.(banddos%ndir == -3)) THEN
137
            CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results)
138
         END IF
139
         CALL timestop("cdngen: dos")
140 141 142 143
      END IF
   END IF

   IF ((banddos%dos.OR.banddos%vacdos).AND.(banddos%ndir/=-2)) CALL juDFT_end("DOS OK",mpi%irank)
Matthias Redies's avatar
Matthias Redies committed
144
   IF (vacuum%nstm == 3) CALL juDFT_end("VACWAVE OK",mpi%irank)
145

Matthias Redies's avatar
Matthias Redies committed
146
   IF (mpi%irank == 0) THEN
147
      CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
148 149 150
      CALL closeXMLElement('valenceDensity')
   END IF ! mpi%irank = 0

151
   IF (sliceplot%slice) THEN
Matthias Redies's avatar
Matthias Redies committed
152
      IF (mpi%irank == 0) THEN
153
         CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
154
                           0,-1.0,0.0,.FALSE.,outDen,'cdn_slice')
155
      END IF
156
      CALL juDFT_end("slice OK",mpi%irank)
157
   END IF
158

159 160
   CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
                stars,cell,sphhar,atoms,vTot,outDen,moments,results)
161

162 163
   CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)

Matthias Redies's avatar
Matthias Redies committed
164
   IF (mpi%irank == 0) THEN
165
      CALL openXMLElementNoAttributes('allElectronCharges')
166
      CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
167 168
      CALL closeXMLElement('allElectronCharges')

Matthias Redies's avatar
Matthias Redies committed
169
      IF (input%jspins == 2) THEN
170 171 172
         noco_new = noco

         !Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
173
         CALL magMoms(dimension,input,atoms,noco_new,vTot,moments)
174 175 176 177

         !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
178
            CALL genNewNocoInp(input,atoms,noco,noco_new)
179 180
         END IF

181
         IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,moments%clmom)
182
      END IF
Matthias Redies's avatar
Matthias Redies committed
183
   END IF ! mpi%irank == 0
184

185 186 187 188 189
#ifdef CPP_MPI
   CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif

END SUBROUTINE cdngen
190

191
END MODULE m_cdngen