cdngen.F90 8.36 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 7 8 9
MODULE m_cdngen
CONTAINS

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

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

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

43
   IMPLICIT NONE
44

45 46 47 48
#ifdef CPP_MPI
   INCLUDE 'mpif.h'
#endif

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

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

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

85

86
   !Local Scalars
87
   REAL                  :: fix, qtot, dummy,eFermiPrev
88
   INTEGER               :: jspin, jspmax, ierr
Matthias Redies's avatar
Matthias Redies committed
89
   INTEGER               :: dim_idx
90

91 92 93
#ifdef CPP_HDF
   INTEGER(HID_T)        :: banddosFile_id
#endif
94
   LOGICAL               :: l_error
95

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

103 104
   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)
105

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

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

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

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

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

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

Uliana Alekseeva's avatar
Uliana Alekseeva committed
165
   CALL timestart("cdngen: cdncore")
166 167 168 169 170 171 172
   if(xcpot%exc_is_MetaGGA()) then
      CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
                   stars,cell,sphhar,atoms,vTot,outDen,moments,results, EnergyDen)
   else
      CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
                   stars,cell,sphhar,atoms,vTot,outDen,moments,results)
   endif
Matthias Redies's avatar
Matthias Redies committed
173
   call xcpot%core_den%subPotDen(outDen, xcpot%val_den)
Uliana Alekseeva's avatar
Uliana Alekseeva committed
174
   CALL timestop("cdngen: cdncore")
175

176 177
   CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)

Matthias Redies's avatar
Matthias Redies committed
178
   IF (mpi%irank == 0) THEN
179
      CALL openXMLElementNoAttributes('allElectronCharges')
180
      CALL qfix(mpi,stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
181 182
      CALL closeXMLElement('allElectronCharges')

Matthias Redies's avatar
Matthias Redies committed
183
      IF (input%jspins == 2) THEN
184 185 186
         noco_new = noco

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

189 190
         noco = noco_new

191 192 193
         !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
194
            CALL genNewNocoInp(input,atoms,noco,noco_new)
195 196
         END IF

197
         IF (noco%l_soc) CALL orbMagMoms(input,atoms,noco,moments%clmom)
198
         
199
      END IF
Matthias Redies's avatar
Matthias Redies committed
200
   END IF ! mpi%irank == 0
201

202
#ifdef CPP_MPI
203 204 205 206 207 208 209 210 211 212 213 214
   CALL MPI_BCAST(noco%l_ss,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%l_mperp,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%l_constr,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%mix_b,1,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)

   CALL MPI_BCAST(noco%alphInit,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%alph,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%beta,atoms%ntype,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%b_con,atoms%ntype*2,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%l_relax,atoms%ntype,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
   CALL MPI_BCAST(noco%qss,3,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)

215 216 217 218
   CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif

END SUBROUTINE cdngen
219

220
END MODULE m_cdngen