banddos_io.F90 9.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
!--------------------------------------------------------------------------------
! Copyright (c) 2018 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.
!--------------------------------------------------------------------------------

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This module is used to write out data that can be used to generate augmented
! DOS or bandstructure plots. For the augmentation additional data, e.g., weights
! for the orbital character of states, is stored.
!
!                                          GM' 2018
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

MODULE m_banddos_io

#ifdef CPP_HDF

21 22 23 24 25
   USE hdf5
   USE m_hdf_tools

   IMPLICIT NONE

26 27 28 29
   PUBLIC openBandDOSFile, closeBandDOSFile, writeBandDOSData

   CONTAINS

30 31 32
   SUBROUTINE openBandDOSFile(fileID, input, atoms, cell, kpts)

      USE m_types
33
      USE m_cdn_io
34 35 36 37 38 39 40 41 42 43

      TYPE(t_input), INTENT(IN)  :: input
      TYPE(t_atoms), INTENT(IN)  :: atoms
      TYPE(t_cell),  INTENT(IN)  :: cell
      TYPE(t_kpts),  INTENT(IN)  :: kpts

      INTEGER(HID_T),       INTENT(OUT) :: fileID

      LOGICAL           :: l_exist
      CHARACTER(LEN=30) :: filename
44 45
      INTEGER(HID_T)    :: metaGroupID
      INTEGER(HID_T)    :: generalGroupID
46 47 48 49 50 51 52
      INTEGER(HID_T)    :: cellGroupID
      INTEGER(HID_T)    :: atomsGroupID
      INTEGER(HID_T)    :: kptsGroupID

      INTEGER(HID_T)    :: bravaisMatrixSpaceID, bravaisMatrixSetID
      INTEGER(HID_T)    :: reciprocalCellSpaceID, reciprocalCellSetID

53 54
      INTEGER(HID_T)    :: atomPosSpaceID, atomPosSetID
      INTEGER(HID_T)    :: atomicNumbersSpaceID, atomicNumbersSetID
55
      INTEGER(HID_T)    :: equivAtomsClassSpaceID, equivAtomsClassSetID
56

57 58 59
      INTEGER(HID_T)    :: kptCoordSpaceID, kptCoordSetID
      INTEGER(HID_T)    :: kptWeightSpaceID, kptWeightSetID

60 61
      INTEGER           :: iType, j, iAtom

62
      INTEGER           :: hdfError, dimsInt(7)
63 64 65 66 67
      INTEGER           :: version
      REAL              :: eFermiPrev
      LOGICAL           :: l_error

      INTEGER           :: atomicNumbers(atoms%nat)
68
      INTEGER           :: equivAtomsGroup(atoms%nat)
69 70 71

      INTEGER(HSIZE_T)  :: dims(7)

72
      version = 1
73 74 75 76 77 78 79 80 81
      filename = 'banddos.hdf'

      INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
      IF(l_exist) THEN
         CALL system('rm '//TRIM(ADJUSTL(filename)))       
      END IF

      CALL h5fcreate_f(TRIM(ADJUSTL(filename)), H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)

82 83 84 85 86 87 88 89 90 91
      CALL h5gcreate_f(fileID, '/meta', metaGroupID, hdfError)
      CALL io_write_attint0(metaGroupID,'version',version)
      CALL h5gclose_f(metaGroupID, hdfError)

      CALL readPrevEFermi(eFermiPrev,l_error)
      IF(l_error) THEN
         ! No previous eFermi available
         eFermiPrev = 0.0
      END IF

92 93
      CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
      CALL io_write_attint0(generalGroupID,'spins',input%jspins)
94
      CALL io_write_attreal0(generalGroupID,'lastFermiEnergy',eFermiPrev)
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
      CALL h5gclose_f(generalGroupID, hdfError)

      CALL h5gcreate_f(fileID, '/cell', cellGroupID, hdfError)

      dims(:2)=(/3,3/)
      dimsInt=dims
      CALL h5screate_simple_f(2,dims(:2),bravaisMatrixSpaceID,hdfError)
      CALL h5dcreate_f(cellGroupID, "bravaisMatrix", H5T_NATIVE_DOUBLE, bravaisMatrixSpaceID, bravaisMatrixSetID, hdfError)
      CALL h5sclose_f(bravaisMatrixSpaceID,hdfError)
      CALL io_write_real2(bravaisMatrixSetID,(/1,1/),dimsInt(:2),cell%amat)
      CALL h5dclose_f(bravaisMatrixSetID, hdfError)

      dims(:2)=(/3,3/)
      dimsInt=dims
      CALL h5screate_simple_f(2,dims(:2),reciprocalCellSpaceID,hdfError)
      CALL h5dcreate_f(cellGroupID, "reciprocalCell", H5T_NATIVE_DOUBLE, reciprocalCellSpaceID, reciprocalCellSetID, hdfError)
      CALL h5sclose_f(reciprocalCellSpaceID,hdfError)
      CALL io_write_real2(reciprocalCellSetID,(/1,1/),dimsInt(:2),cell%bmat)
      CALL h5dclose_f(reciprocalCellSetID, hdfError)

      CALL h5gclose_f(cellGroupID, hdfError)

117 118 119 120 121
      iAtom = 0
      DO iType = 1, atoms%ntype
         DO j = 1, atoms%neq(iType)
            iAtom = iAtom + 1
            atomicNumbers(iAtom) = atoms%nz(iType)
122
            equivAtomsGroup(iAtom) = iType
123 124 125
         END DO
      END DO

126
      CALL h5gcreate_f(fileID, '/atoms', atomsGroupID, hdfError)
127
      CALL io_write_attint0(atomsGroupID,'nAtoms',atoms%nat)
128
      CALL io_write_attint0(atomsGroupID,'nTypes',atoms%ntype)
129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145

      dims(:2)=(/3,atoms%nat/)
      dimsInt=dims
      CALL h5screate_simple_f(2,dims(:2),atomPosSpaceID,hdfError)
      CALL h5dcreate_f(atomsGroupID, "positions", H5T_NATIVE_DOUBLE, atomPosSpaceID, atomPosSetID, hdfError)
      CALL h5sclose_f(atomPosSpaceID,hdfError)
      CALL io_write_real2(atomPosSetID,(/1,1/),dimsInt(:2),atoms%taual)
      CALL h5dclose_f(atomPosSetID, hdfError)

      dims(:1)=(/atoms%nat/)
      dimsInt=dims
      CALL h5screate_simple_f(1,dims(:1),atomicNumbersSpaceID,hdfError)
      CALL h5dcreate_f(atomsGroupID, "atomicNumbers", H5T_NATIVE_INTEGER, atomicNumbersSpaceID, atomicNumbersSetID, hdfError)
      CALL h5sclose_f(atomicNumbersSpaceID,hdfError)
      CALL io_write_integer1(atomicNumbersSetID,(/1/),dimsInt(:1),atomicNumbers)
      CALL h5dclose_f(atomicNumbersSetID, hdfError)

146 147 148 149 150 151 152 153
      dims(:1)=(/atoms%nat/)
      dimsInt=dims
      CALL h5screate_simple_f(1,dims(:1),equivAtomsClassSpaceID,hdfError)
      CALL h5dcreate_f(atomsGroupID, "equivAtomsGroup", H5T_NATIVE_INTEGER, equivAtomsClassSpaceID, equivAtomsClassSetID, hdfError)
      CALL h5sclose_f(equivAtomsClassSpaceID,hdfError)
      CALL io_write_integer1(equivAtomsClassSetID,(/1/),dimsInt(:1),equivAtomsGroup)
      CALL h5dclose_f(equivAtomsClassSetID, hdfError)

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
      CALL h5gclose_f(atomsGroupID, hdfError)

      CALL h5gcreate_f(fileID, '/kpts', kptsGroupID, hdfError)

      CALL io_write_attint0(kptsGroupID,'nkpt',kpts%nkpt)

      dims(:2)=(/3,kpts%nkpt/)
      dimsInt=dims
      CALL h5screate_simple_f(2,dims(:2),kptCoordSpaceID,hdfError)
      CALL h5dcreate_f(kptsGroupID, "coordinates", H5T_NATIVE_DOUBLE, kptCoordSpaceID, kptCoordSetID, hdfError)
      CALL h5sclose_f(kptCoordSpaceID,hdfError)
      CALL io_write_real2(kptCoordSetID,(/1,1/),dimsInt(:2),kpts%bk)
      CALL h5dclose_f(kptCoordSetID, hdfError)

      dims(:1)=(/kpts%nkpt/)
      dimsInt=dims
      CALL h5screate_simple_f(1,dims(:1),kptWeightSpaceID,hdfError)
      CALL h5dcreate_f(kptsGroupID, "weights", H5T_NATIVE_DOUBLE, kptWeightSpaceID, kptWeightSetID, hdfError)
      CALL h5sclose_f(kptWeightSpaceID,hdfError)
      CALL io_write_real1(kptWeightSetID,(/1/),dimsInt(:1),kpts%wtkpt)
      CALL h5dclose_f(kptWeightSetID, hdfError)

      CALL h5gclose_f(kptsGroupID, hdfError)

178 179
   END SUBROUTINE

180 181 182 183 184 185 186 187
   SUBROUTINE closeBandDOSFile(fileID)

      INTEGER(HID_T), INTENT(IN)  :: fileID

      INTEGER hdfError

      CALL h5fclose_f(fileID, hdfError)

188 189
   END SUBROUTINE

190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
   SUBROUTINE writeBandDOSData(fileID,input,atoms,cell,kpts,results,banddos,dos,vacuum)

      USE m_types

      TYPE(t_input),   INTENT(IN) :: input
      TYPE(t_atoms),   INTENT(IN) :: atoms
      TYPE(t_cell),    INTENT(IN) :: cell
      TYPE(t_kpts),    INTENT(IN) :: kpts
      TYPE(t_results), INTENT(IN) :: results
      TYPE(t_banddos), INTENT(IN) :: banddos
      TYPE(t_dos),     INTENT(IN) :: dos
      TYPE(t_vacuum),  INTENT(IN) :: vacuum

      INTEGER                     :: neigd

      INTEGER(HID_T),  INTENT(IN) :: fileID

      INTEGER(HID_T)    :: eigenvaluesGroupID

      INTEGER(HID_T)    :: eigenvaluesSpaceID, eigenvaluesSetID
      INTEGER(HID_T)    :: numFoundEigsSpaceID, numFoundEigsSetID
211
      INTEGER(HID_T)    :: lLikeChargeSpaceID, lLikeChargeSetID
212 213 214 215 216 217 218 219 220 221

      INTEGER           :: hdfError, dimsInt(7)

      INTEGER(HSIZE_T)  :: dims(7)

      neigd = MAXVAL(results%neig(:,:))

      CALL h5gcreate_f(fileID, '/eigenvalues', eigenvaluesGroupID, hdfError)

      CALL io_write_attint0(eigenvaluesGroupID,'neigd',neigd)
222
      CALL io_write_attint0(eigenvaluesGroupID,'maxL',3)
223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239

      dims(:2)=(/kpts%nkpt,input%jspins/)
      dimsInt=dims
      CALL h5screate_simple_f(2,dims(:2),numFoundEigsSpaceID,hdfError)
      CALL h5dcreate_f(eigenvaluesGroupID, "numFoundEigenvals", H5T_NATIVE_INTEGER, numFoundEigsSpaceID, numFoundEigsSetID, hdfError)
      CALL h5sclose_f(numFoundEigsSpaceID,hdfError)
      CALL io_write_integer2(numFoundEigsSetID,(/1,1/),dimsInt(:2),results%neig)
      CALL h5dclose_f(numFoundEigsSetID, hdfError)

      dims(:3)=(/neigd,kpts%nkpt,input%jspins/)
      dimsInt = dims
      CALL h5screate_simple_f(3,dims(:3),eigenvaluesSpaceID,hdfError)
      CALL h5dcreate_f(eigenvaluesGroupID, "eigenvalues", H5T_NATIVE_DOUBLE, eigenvaluesSpaceID, eigenvaluesSetID, hdfError)
      CALL h5sclose_f(eigenvaluesSpaceID,hdfError)
      CALL io_write_real3(eigenvaluesSetID,(/1,1,1/),dimsInt(:3),results%eig(:neigd,:,:))
      CALL h5dclose_f(eigenvaluesSetID, hdfError)

240 241 242 243 244 245 246 247
      dims(:5)=(/4,atoms%ntype,neigd,kpts%nkpt,input%jspins/)
      dimsInt = dims
      CALL h5screate_simple_f(5,dims(:5),lLikeChargeSpaceID,hdfError)
      CALL h5dcreate_f(eigenvaluesGroupID, "lLikeCharge", H5T_NATIVE_DOUBLE, lLikeChargeSpaceID, lLikeChargeSetID, hdfError)
      CALL h5sclose_f(lLikeChargeSpaceID,hdfError)
      CALL io_write_real5(lLikeChargeSetID,(/1,1,1,1,1/),dimsInt(:5),dos%qal(0:3,:,:neigd,:,:))
      CALL h5dclose_f(lLikeChargeSetID, hdfError)

248 249
      CALL h5gclose_f(eigenvaluesGroupID, hdfError)

250 251 252 253 254
   END SUBROUTINE

#endif

END MODULE m_banddos_io