cdngen.F90 6.82 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
#ifdef CPP_MPI
42
   USE m_mpi_bc_potden
43
#endif
44

45
   IMPLICIT NONE
46

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

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

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

82

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

90 91
   CALL regCharges%init(input,atoms)
   CALL dos%init(input,atoms,dimension,kpts,vacuum)
92
   CALL moments%init(input,atoms)
93 94 95
   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
96 97

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

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

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

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

Matthias Redies's avatar
Matthias Redies committed
120
   IF (mpi%irank == 0) THEN
121
      IF (banddos%dos.or.banddos%vacdos.or.input%cdinf) THEN
122
#ifdef CPP_HDF
123 124 125
         CALL openBandDOSFile(banddosFile_id,input,atoms,cell,kpts)
         CALL writeBandDOSData(banddosFile_id,input,atoms,cell,kpts,results,banddos,dos,vacuum)
         CALL closeBandDOSFile(banddosFile_id)
126
#endif
127
         CALL timestart("cdngen: dos")
128
         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
129
         IF (banddos%dos.AND.(banddos%ndir == -3)) THEN
130
            CALL Ek_write_sl(eig_id,dimension,kpts,atoms,vacuum,input,jspmax,sym,cell,dos,slab,orbcomp,results)
131
         END IF
132
         CALL timestop("cdngen: dos")
133 134 135 136
      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
137
   IF (vacuum%nstm == 3) CALL juDFT_end("VACWAVE OK",mpi%irank)
138

Matthias Redies's avatar
Matthias Redies committed
139
   IF (mpi%irank == 0) THEN
140
      CALL cdntot(stars,atoms,sym,vacuum,input,cell,oneD,outDen,.TRUE.,qtot,dummy)
141 142 143
      CALL closeXMLElement('valenceDensity')
   END IF ! mpi%irank = 0

144
   IF (sliceplot%slice) THEN
Matthias Redies's avatar
Matthias Redies committed
145
      IF (mpi%irank == 0) THEN
146
         CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
147
                           0,-1.0,0.0,.FALSE.,outDen,'cdn_slice')
148
      END IF
149
      CALL juDFT_end("slice OK",mpi%irank)
150
   END IF
151

152 153
   CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
                stars,cell,sphhar,atoms,vTot,outDen,moments,results)
154

155 156
   CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)

Matthias Redies's avatar
Matthias Redies committed
157
   IF (mpi%irank == 0) THEN
158
      CALL openXMLElementNoAttributes('allElectronCharges')
159
      CALL qfix(stars,atoms,sym,vacuum,sphhar,input,cell,oneD,outDen,noco%l_noco,.TRUE.,.true.,fix)
160 161
      CALL closeXMLElement('allElectronCharges')

Matthias Redies's avatar
Matthias Redies committed
162
      IF (input%jspins == 2) THEN
163 164 165
         noco_new = noco

         !Calculate and write out spin densities at the nucleus and magnetic moments in the spheres
166
         CALL magMoms(dimension,input,atoms,noco_new,vTot,moments)
167 168 169 170

         !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
171
            CALL genNewNocoInp(input,atoms,noco,noco_new)
172 173
         END IF

174
         IF (noco%l_soc) CALL orbMagMoms(dimension,atoms,noco,moments%clmom)
175
      END IF
Matthias Redies's avatar
Matthias Redies committed
176
   END IF ! mpi%irank == 0
177

178 179 180 181 182
#ifdef CPP_MPI
   CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,outDen)
#endif

END SUBROUTINE cdngen
183

184
END MODULE m_cdngen