banddos_io.F90 13.7 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

Daniel Wortmann's avatar
Daniel Wortmann committed
26
   PUBLIC openBandDOSFile, closeBandDOSFile, writeBandData, writedosData
27 28 29

   CONTAINS

Daniel Wortmann's avatar
Daniel Wortmann committed
30
   SUBROUTINE openBandDOSFile(fileID, input, atoms, cell, kpts, banddos,eFermiPrev)
31

Daniel Wortmann's avatar
Daniel Wortmann committed
32 33 34 35 36 37
      USE m_types_input
      USE m_types_atoms
      USE m_types_cell
      USE m_types_kpts
      USE m_types_banddos

38
      USE hdf5
Daniel Wortmann's avatar
Daniel Wortmann committed
39
      !USE m_cdn_io
40

41 42 43 44 45
      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_banddos), INTENT(IN)  :: banddos
46 47

      INTEGER(HID_T),       INTENT(OUT) :: fileID
Daniel Wortmann's avatar
Daniel Wortmann committed
48 49
      REAL,INTENT(IN)           :: eFermiPrev

50 51 52

      LOGICAL           :: l_exist
      CHARACTER(LEN=30) :: filename
53 54
      INTEGER(HID_T)    :: metaGroupID
      INTEGER(HID_T)    :: generalGroupID
55 56 57 58
      INTEGER(HID_T)    :: cellGroupID
      INTEGER(HID_T)    :: atomsGroupID
      INTEGER(HID_T)    :: kptsGroupID

59 60 61
      INTEGER(HID_T)    :: stringTypeID
      INTEGER(SIZE_T)   :: stringLength

62 63 64
      INTEGER(HID_T)    :: bravaisMatrixSpaceID, bravaisMatrixSetID
      INTEGER(HID_T)    :: reciprocalCellSpaceID, reciprocalCellSetID

65 66
      INTEGER(HID_T)    :: atomPosSpaceID, atomPosSetID
      INTEGER(HID_T)    :: atomicNumbersSpaceID, atomicNumbersSetID
67
      INTEGER(HID_T)    :: equivAtomsClassSpaceID, equivAtomsClassSetID
68

69 70
      INTEGER(HID_T)    :: kptCoordSpaceID, kptCoordSetID
      INTEGER(HID_T)    :: kptWeightSpaceID, kptWeightSetID
71
      INTEGER(HID_T)    :: kptSPLabelsSpaceID, kptSPLabelsSetID
72
      INTEGER(HID_T)    :: kptsSPIndicesSpaceID, kptsSPIndicesSetID
73

74 75
      INTEGER           :: iType, j, iAtom

76
      INTEGER           :: hdfError, dimsInt(7)
77
      INTEGER           :: version
Daniel Wortmann's avatar
Daniel Wortmann committed
78

79 80 81
      LOGICAL           :: l_error

      INTEGER           :: atomicNumbers(atoms%nat)
82
      INTEGER           :: equivAtomsGroup(atoms%nat)
83 84 85

      INTEGER(HSIZE_T)  :: dims(7)

86
      version = 1
87 88 89 90
      filename = 'banddos.hdf'

      INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
      IF(l_exist) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
91
         CALL system('rm '//TRIM(ADJUSTL(filename)))
92 93 94 95
      END IF

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

96 97 98 99
      CALL h5gcreate_f(fileID, '/meta', metaGroupID, hdfError)
      CALL io_write_attint0(metaGroupID,'version',version)
      CALL h5gclose_f(metaGroupID, hdfError)

Daniel Wortmann's avatar
Daniel Wortmann committed
100

101

102 103
      CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
      CALL io_write_attint0(generalGroupID,'spins',input%jspins)
104
      CALL io_write_attreal0(generalGroupID,'lastFermiEnergy',eFermiPrev)
105
      CALL io_write_attlog0(generalGroupID,'bandUnfolding',banddos%unfoldband)
106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
      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)

128 129 130 131 132
      iAtom = 0
      DO iType = 1, atoms%ntype
         DO j = 1, atoms%neq(iType)
            iAtom = iAtom + 1
            atomicNumbers(iAtom) = atoms%nz(iType)
133
            equivAtomsGroup(iAtom) = iType
134 135 136
         END DO
      END DO

137
      CALL h5gcreate_f(fileID, '/atoms', atomsGroupID, hdfError)
138
      CALL io_write_attint0(atomsGroupID,'nAtoms',atoms%nat)
139
      CALL io_write_attint0(atomsGroupID,'nTypes',atoms%ntype)
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156

      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)

157 158 159 160 161 162 163 164
      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)

165 166 167 168 169
      CALL h5gclose_f(atomsGroupID, hdfError)

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

      CALL io_write_attint0(kptsGroupID,'nkpt',kpts%nkpt)
170
      CALL io_write_attint0(kptsGroupID,'nSpecialPoints',kpts%numSpecialPoints)
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187

      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)

188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210
      IF (ALLOCATED(kpts%specialPointIndices)) THEN
         stringLength = LEN(kpts%specialPointNames(:))
         CALL h5tcopy_f(H5T_NATIVE_CHARACTER, stringTypeID, hdfError)
         CALL h5tset_size_f(stringTypeID, stringLength, hdfError)
         CALL h5tset_strpad_f(stringTypeID, H5T_STR_SPACEPAD_F, hdfError)
         CALL h5tset_cset_f(stringTypeID, H5T_CSET_ASCII_F, hdfError)
         dims(:1)=(/kpts%numSpecialPoints/)
         dimsInt=dims
         CALL h5screate_simple_f(1,dims(:1),kptSPLabelsSpaceID,hdfError)
         CALL h5dcreate_f(kptsGroupID, "specialPointLabels", stringTypeID, kptSPLabelsSpaceID, kptSPLabelsSetID, hdfError)
         CALL h5tclose_f(stringTypeID,hdfError)
         CALL h5sclose_f(kptSPLabelsSpaceID,hdfError)
         CALL io_write_string1(kptSPLabelsSetID,dimsInt(:1),LEN(kpts%specialPointNames(:)),kpts%specialPointNames)
         CALL h5dclose_f(kptSPLabelsSetID, hdfError)

         dims(:1)=(/kpts%numSpecialPoints/)
         dimsInt=dims
         CALL h5screate_simple_f(1,dims(:1),kptsSPIndicesSpaceID,hdfError)
         CALL h5dcreate_f(kptsGroupID, "specialPointIndices", H5T_NATIVE_INTEGER, kptsSPIndicesSpaceID, kptsSPIndicesSetID, hdfError)
         CALL h5sclose_f(kptsSPIndicesSpaceID,hdfError)
         CALL io_write_integer1(kptsSPIndicesSetID,(/1/),dimsInt(:1),kpts%specialPointIndices)
         CALL h5dclose_f(kptsSPIndicesSetID, hdfError)
      END IF
211

212 213
      CALL h5gclose_f(kptsGroupID, hdfError)

214 215
   END SUBROUTINE

216 217 218 219 220 221 222 223
   SUBROUTINE closeBandDOSFile(fileID)

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

      INTEGER hdfError

      CALL h5fclose_f(fileID, hdfError)

224 225
   END SUBROUTINE

Daniel Wortmann's avatar
Daniel Wortmann committed
226 227 228 229 230 231
   SUBROUTINE writeBandData(fileID,name_of_dos,weight_name,eig,weight_eig,kpts)
      USE m_types_kpts
      character(len=*),intent(in) :: name_of_dos
      character(len=*),intent(in) :: weight_name
      real,intent(in)             :: eig(:,:,:),weight_eig(:,:,:)
      type(t_kpts),intent(in)     :: kpts
232 233 234


      INTEGER(HID_T),  INTENT(IN) :: fileID
Daniel Wortmann's avatar
Daniel Wortmann committed
235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
      INTEGER                     :: n

      INTEGER(HID_T)    :: BSGroupID,groupID
      INTEGER           :: hdfError

      if (io_groupexists(fileID,name_of_dos)) THEN
        call io_gopen(fileID,name_of_dos,groupID)
      ELSE
        call h5gcreate_f(fileID, name_of_dos, GroupID, hdfError)
      endif
      if (io_groupexists(GroupID,"BS")) THEN
        call io_gopen(GroupID,"BS",BSgroupID)
      ELSE
        CALL h5gcreate_f(fileID, "BS", BSGroupID, hdfError)
      endif
      if (.not.io_dataexists(BSGroupID,"kpts")) call io_write_var(BSGroupID,"kpts",kpts%bk)
      if (.not.io_dataexists(BSGroupID,"eigenvalues")) call io_write_var(BSGroupID,"eigenvalues",eig)
      call io_write_var(BSGroupID,weight_name,weight_eig(:,:,:))
      CALL h5gclose_f(BSGroupID, hdfError)
      CALL h5gclose_f(GroupID, hdfError)


#if 1==2
258 259 260
      IF (banddos%unfoldband) THEN
         CALL h5gcreate_f(fileID, '/bandUnfolding', bandUnfoldingGroupID, hdfError)

261 262 263 264 265 266 267 268
         dims(:1)=(/3/)
         dimsInt = dims
         CALL h5screate_simple_f(1,dims(:1),supercellSpaceID,hdfError)
         CALL h5dcreate_f(bandUnfoldingGroupID, "supercell", H5T_NATIVE_INTEGER, supercellSpaceID, supercellSetID, hdfError)
         CALL h5sclose_f(supercellSpaceID,hdfError)
         CALL io_write_integer1(supercellSetID,(/1/),dimsInt(:1),(/banddos%s_cell_x,banddos%s_cell_y,banddos%s_cell_z/))
         CALL h5dclose_f(supercellSetID, hdfError)

269 270 271 272 273 274 275 276 277 278
         dims(:3)=(/neigd,kpts%nkpt,input%jspins/)
         dimsInt = dims
         CALL h5screate_simple_f(3,dims(:3),bUWeightsSpaceID,hdfError)
         CALL h5dcreate_f(bandUnfoldingGroupID, "weights", H5T_NATIVE_DOUBLE, bUWeightsSpaceID, buWeightsSetID, hdfError)
         CALL h5sclose_f(bUWeightsSpaceID,hdfError)
         CALL io_write_real3(bUWeightsSetID,(/1,1,1/),dimsInt(:3), REAL(results%unfolding_weights(:neigd,:,:)))
         CALL h5dclose_f(bUWeightsSetID, hdfError)

         CALL h5gclose_f(bandUnfoldingGroupID, hdfError)
      END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306
#endif
   END SUBROUTINE
SUBROUTINE writedosData(fileID,name_of_dos,e_grid,weight_name,dos)
     character(len=*),intent(in) :: name_of_dos
     character(len=*),intent(in) :: weight_name
     real,intent(in):: e_grid(:),dos(:,:)
      INTEGER(HID_T),  INTENT(IN) :: fileID

      INTEGER                     :: n

      INTEGER(HID_T)    :: DOSGroupID,groupID
      INTEGER           :: hdfError

      if (io_groupexists(fileID,name_of_dos)) THEN
        call io_gopen(fileID,name_of_dos,groupID)
      ELSE
        call h5gcreate_f(fileID, name_of_dos, GroupID, hdfError)
      endif
      if (io_groupexists(groupID,"DOS")) then
        call io_gopen(groupID,"DOS",DOSGroupID)
      ELSE
        CALL h5gcreate_f(GroupID, "DOS", DOSGroupID, hdfError)
      endif
      if (.not.io_dataexists(DOSGroupID,"energyGrid")) call io_write_var(DOSGroupID,"energyGrid",e_grid)
      print *,name_of_dos,weight_name
      call io_write_var(DOSGroupID,weight_name,dos(:,:))
      CALL h5gclose_f(DOSGroupID, hdfError)
      CALL h5gclose_f(GroupID, hdfError)
307

308 309
   END SUBROUTINE

310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355
   SUBROUTINE io_write_string1(datasetID,dims,stringLength,dataArray)

      USE hdf5
      USE m_hdf_tools4

      IMPLICIT NONE

      INTEGER(HID_T),              INTENT(IN) :: datasetID
      INTEGER,                     INTENT(IN) :: dims(1)
      INTEGER,                     INTENT(IN) :: stringLength
      CHARACTER(LEN=stringLength), INTENT(IN) :: dataArray(:)

      INTEGER          :: hdfError
      INTEGER(HID_T)   :: dataspaceID, memSpaceID
      INTEGER(HID_T)   :: stringTypeID
      INTEGER(HID_t)   :: trans
      INTEGER(HSIZE_t) :: memOffset(1), fncount(1)
      INTEGER(HSIZE_t) :: dimsHDF(1)
      INTEGER(SIZE_T)  :: stringLengthHDF

      stringLengthHDF = stringLength
      dimsHDF(:) = dims(:)
      memOffset(:) = 0
      fnCount(:) = dims(:)

      trans = gettransprop()

      CALL h5tcopy_f(H5T_NATIVE_CHARACTER, stringTypeID, hdfError)
      CALL h5tset_size_f(stringTypeID, stringLengthHDF, hdfError)
      CALL h5tset_strpad_f(stringTypeID, H5T_STR_SPACEPAD_F, hdfError)
      CALL h5tset_cset_f(stringTypeID, H5T_CSET_ASCII_F, hdfError)

      CALL h5dget_space_f(datasetID,dataspaceID,hdfError)
      CALL h5sselect_hyperslab_f(dataspaceID,H5S_SELECT_SET_F,memOffset,fncount,hdfError)
      CALL h5screate_simple_f(1,dimsHDF,memSpaceID,hdfError)
      CALL h5dwrite_f(datasetID,stringTypeID,dataArray,dimsHDF,hdfError,memSpaceID,dataspaceID,trans)
      CALL h5sclose_f(memSpaceID,hdfError)
      CALL h5sclose_f(dataspaceID,hdfError)
      CALL cleartransprop(trans)

      CALL h5tclose_f(stringTypeID,hdfError)

      CALL io_check("io_write_string1 !",hdfError)

   END SUBROUTINE io_write_string1

356 357 358
#endif

END MODULE m_banddos_io