cdngen.F90 7.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
Matthias Redies's avatar
Matthias Redies committed
7
   USE m_types
8

Matthias Redies's avatar
Matthias Redies committed
9
   TYPE(t_potden)   :: comparison_kinED_pw
10 11 12 13

CONTAINS

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

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

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

48
   IMPLICIT NONE
49

50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
   ! 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
69 70
   CLASS(t_xcpot),INTENT(INOUT)     :: xcpot
   TYPE(t_potden),INTENT(INOUT)     :: outDen, EnergyDen
71 72

   !Scalar Arguments
73
   INTEGER, INTENT (IN)             :: eig_id, archiveType
74 75

   ! Local type instances
76
   TYPE(t_noco)          :: noco_new
Matthias Redies's avatar
Matthias Redies committed
77 78 79 80
   TYPE(t_regionCharges) :: regCharges, fake_regCharges
   TYPE(t_dos)           :: dos, fake_dos
   TYPE(t_moments)       :: moments, fake_moments
   TYPE(t_results)       :: fake_results
81 82
   TYPE(t_mcd)           :: mcd
   TYPE(t_slab)          :: slab
83
   TYPE(t_orbcomp)       :: orbcomp
84
   TYPE(t_cdnvalJob)     :: cdnvalJob
85

86

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

95 96
   CALL regCharges%init(input,atoms)
   CALL dos%init(input,atoms,dimension,kpts,vacuum)
97
   CALL moments%init(input,atoms)
98 99 100
   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
101

102 103
   CALL outDen%init(stars,    atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
   CALL EnergyDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_EnergyDen)
104

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

107
   !In a non-collinear calcuation where the off-diagonal part of the
108 109
   !density matrix in the muffin-tins is calculated, the a- and
   !b-coef. for both spins are needed at once. Thus, cdnval is only
110
   !called once and both spin directions are calculated in a single run.
111 112 113
   jspmax = input%jspins
   IF (noco%l_mperp) jspmax = 1
   DO jspin = 1,jspmax
114
      CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin,sliceplot,banddos)
115
      CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
116
                  sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,coreSpecInput,mcd,slab,orbcomp)
Matthias Redies's avatar
Matthias Redies committed
117 118 119 120 121 122
      fake_regCharges = regCharges
      fake_dos        = dos
      fake_results    = results
      fake_moments    = moments
      CALL calc_kinED_pw(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
         sphhar,sym,vTot,oneD,cdnvalJob,comparison_kinED_pw,fake_regCharges,fake_dos,fake_results,fake_moments)
123 124
   END DO

Matthias Redies's avatar
Matthias Redies committed
125 126
   ! calculate kinetic energy density for MetaGGAs
   if(xcpot%exc_is_metagga()) then
Matthias Redies's avatar
Matthias Redies committed
127
      CALL calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars,&
Matthias Redies's avatar
Matthias Redies committed
128
                             vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
Matthias Redies's avatar
Matthias Redies committed
129 130
   endif

Matthias Redies's avatar
Matthias Redies committed
131
   IF (mpi%irank == 0) THEN
132
      IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
133 134 135 136 137
         IF (banddos%unfoldband) THEN
            eFermiPrev = 0.0
            CALL readPrevEFermi(eFermiPrev,l_error)
            CALL write_band_sc(kpts,results,eFermiPrev)
         END IF
138
#ifdef CPP_HDF
139
         CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts,banddos)
140 141
         CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
         CALL closeBandDOSFile(banddosFile_id)
142
#endif
143
         CALL timestart("cdngen: dos")
144
         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
145
         IF (banddos%dos.AND.(banddos%ndir == -3)) THEN
146
            CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results)
147
         END IF
148
         CALL timestop("cdngen: dos")
149 150 151 152
      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
153
   IF (vacuum%nstm == 3) CALL juDFT_end("VACWAVE OK",mpi%irank)
154

Matthias Redies's avatar
Matthias Redies committed
155
   IF (mpi%irank == 0) THEN
156
      CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
157 158 159
      CALL closeXMLElement('valenceDensity')
   END IF ! mpi%irank = 0

160
   IF (sliceplot%slice) THEN
Matthias Redies's avatar
Matthias Redies committed
161
      IF (mpi%irank == 0) THEN
162
         CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
163
                           0,-1.0,0.0,.FALSE.,outDen,'cdn_slice')
164
      END IF
165
      CALL juDFT_end("slice OK",mpi%irank)
166
   END IF
167

168 169
   CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
                stars,cell,sphhar,atoms,vTot,outDen,moments,results)
170

171 172
   CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)

Matthias Redies's avatar
Matthias Redies committed
173
   IF (mpi%irank == 0) THEN
174
      CALL openXMLElementNoAttributes('allElectronCharges')
175
      CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
176 177
      CALL closeXMLElement('allElectronCharges')

Matthias Redies's avatar
Matthias Redies committed
178
      IF (input%jspins == 2) THEN
179 180 181
         noco_new = noco

         !Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
182
         CALL magMoms(dimension,input,atoms,noco_new,vTot,moments)
183 184 185 186

         !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
187
            CALL genNewNocoInp(input,atoms,noco,noco_new)
188 189
         END IF

190
         IF (noco%l_soc) CALL orbMagMoms(input,atoms,noco,moments%clmom)
191
      END IF
Matthias Redies's avatar
Matthias Redies committed
192
   END IF ! mpi%irank == 0
193

194 195 196 197 198
#ifdef CPP_MPI
   CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif

END SUBROUTINE cdngen
199

200
END MODULE m_cdngen