eig66_hdf.F90 26.7 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! 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.
!--------------------------------------------------------------------------------

7 8
MODULE m_eig66_hdf
#include "juDFT_env.h"
9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
  !*****************************************************************
  ! DESC:Module for hdf-io of eig-file
  !      To be compatible with f90 interface of HDF, use kind for vars
  !
  !      !ATTENTION before calling openeig and after calling closeeig!
  !      !the hdf library has to be initialized or finalized, respectively
  !
  !      CONTAINS the following subroutines:
  !      openeig        opens file
  !      closeeig       closes file
  !      read_keb       reads kpt, enpara and basis data
  !      read_neig      read no of eigenvalues (and eigenvalues itself)
  !      read_eig       reads eigenvectors
  !      writeeig       saves all data for kpt
  !      writesingleeig saves data for one kpt and energy
  !
  !
  !                          Daniel Wortmann, Tue Nov  512:07:522002
  !*****************************************************************
  USE m_eig66_data
29
  USE m_types
30
#ifdef CPP_HDF
31 32 33
  USE hdf5
  USE m_hdf_tools
  IMPLICIT NONE
34

35 36 37 38
  PRIVATE
  INTEGER, PARAMETER :: one=1,two=2,three=3,zero=0
  !to have the correct
  !type for array constructors
39 40

#endif
41
  PUBLIC open_eig,close_eig
42
  PUBLIC read_eig,read_dos,write_dos
43
  PUBLIC write_eig!,writesingleeig,writeeigc,writebas
44 45

CONTAINS
46 47 48 49 50 51 52 53 54 55 56 57 58 59
  SUBROUTINE priv_find_data(id,d)
    INTEGER,INTENT(IN)::id
    TYPE(t_data_hdf),POINTER:: d

    CLASS(t_data),POINTER   ::dp
    CALL eig66_find_data(dp,id)
    SELECT TYPE(dp)
    TYPE is (t_data_hdf)
       d=>dp
       CLASS default
       CALL judft_error("BUG: wrong datatype in eig66_hdf")
    END SELECT
  END SUBROUTINE priv_find_data
  !----------------------------------------------------------------------
60
  SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,lmax,nlo,ntype,create,l_real,l_soc,nlotot,readonly,l_dos,l_mcd,l_orb,filename,layers,nstars,ncored,nsld,nat)
61 62 63 64 65 66 67

    !*****************************************************************
    !     opens hdf-file for eigenvectors+values
    !*****************************************************************
    IMPLICIT NONE

    INTEGER, INTENT(IN) :: id,mpi_comm
68
    INTEGER, INTENT(IN) :: nmat,neig,nkpts,jspins,nlo,ntype,lmax,nlotot
69
    LOGICAL, INTENT(IN) :: create,readonly,l_real,l_soc
70
    LOGICAL, INTENT(IN),OPTIONAL ::l_dos,l_mcd,l_orb
71 72
    CHARACTER(LEN=*),OPTIONAL :: filename
    INTEGER,INTENT(IN),OPTIONAL :: layers,nstars,ncored,nsld,nat
73 74

#ifdef CPP_HDF
75 76 77 78

    INTEGER         :: hdferr,access_mode
    INTEGER(HID_T)  :: creation_prp,access_prp,spaceid
    LOGICAL         :: l_exist
79
    INTEGER(HSIZE_T):: dims(7)
80 81
    TYPE(t_data_HDF),POINTER::d
    !Set creation and access properties
82
#ifdef CPP_MPI
83 84 85 86 87 88 89 90 91 92 93
    INCLUDE 'mpif.h'
    IF (readonly) THEN
       access_prp=H5P_DEFAULT_f
       creation_prp=H5P_DEFAULT_f
    ELSE
       CALL h5pcreate_f(H5P_FILE_ACCESS_F, access_prp, hdferr)
       !      CALL h5pset_fapl_mpiposix_f(access_prp,MPI_COMM,
       !     +.false.,hdferr)
       CALL h5pset_fapl_mpio_f(access_prp, MPI_COMM, MPI_INFO_NULL,hdferr)
       creation_prp=H5P_DEFAULT_f !no special creation property
    ENDIF
94
#else
95 96
    access_prp=H5P_DEFAULT_f
    creation_prp=H5P_DEFAULT_f
97
#endif 
98 99
    CALL priv_find_data(id,d)
    IF (PRESENT(filename)) d%fname=filename
100
    CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,lmax,nlotot,nlo,ntype,l_real,l_soc,l_dos,l_mcd,l_orb)
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
    !set access_flags according
    IF (readonly) THEN
       access_mode=H5F_ACC_RDONLY_F
    ELSE
       access_mode=H5F_ACC_RDWR_F
    ENDIF
    !     OPEN FILE and get D%FID's
    IF (create) THEN
       INQUIRE(FILE=TRIM(d%fname)//'.hdf',EXIST=l_exist)
       access_mode=H5F_ACC_TRUNC_F
       !         IF (l_exist) WRITE (*,*)'Warning: eig.hdf was overwritten'
       CALL h5fcreate_f(TRIM(d%fname)//'.hdf',access_Mode, d%fid, hdferr ,creation_prp,access_prp)
       ! create dataspaces and datasets
       !   scalars
       dims(:2)=(/nkpts,jspins/)
       CALL h5screate_simple_f(2,dims(:2),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "neig", H5T_NATIVE_INTEGER, spaceid, d%neigsetid, hdferr)
       CALL h5dcreate_f(d%fid, "wk", H5T_NATIVE_DOUBLE,spaceid, d%wksetid, hdferr)
       CALL h5dcreate_f(d%fid, "nv", H5T_NATIVE_INTEGER, spaceid, d%nvsetid, hdferr)
       CALL h5dcreate_f(d%fid, "nmat", H5T_NATIVE_INTEGER, spaceid, d%nmatsetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
       !   vectors
       dims(1:3)=(/two,nkpts,jspins/)
       CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "evac", H5T_NATIVE_DOUBLE, spaceid, d%evacsetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
       dims(:3)=(/three,nkpts,jspins/)
       CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "bk", H5T_NATIVE_DOUBLE, spaceid, d%bksetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
       dims(:3)=(/neig,nkpts,jspins/)
       CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
       !     ew
       CALL h5dcreate_f(d%fid, "energy", H5T_NATIVE_DOUBLE, spaceid, d%energysetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
136 137 138
       !     w_iks
       CALL h5dcreate_f(d%fid, "w_iks", H5T_NATIVE_DOUBLE, spaceid, d%wikssetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
139 140 141 142 143 144 145 146 147 148 149
       !     enparas
       dims(1:4)=(/lmax+1,ntype,nkpts,jspins/)
       CALL h5screate_simple_f(4,dims(1:4),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "el", H5T_NATIVE_DOUBLE, spaceid, d%esetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)

       dims(:4)=(/nlo,ntype,nkpts,jspins/)
       CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "ello", H5T_NATIVE_DOUBLE, spaceid, d%ellosetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
       !     ev
150 151 152 153 154
       if ( l_real .and..not.l_soc ) THEN
          dims(:5)=(/one,nmat,neig,nkpts,jspins/)
       else
          dims(:5)=(/two,nmat,neig,nkpts,jspins/)
       endif
155 156 157 158 159 160 161 162 163
       CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "ev", H5T_NATIVE_DOUBLE, spaceid, d%evsetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
       !      basis
       dims(:4)=(/nmat,three,nkpts,jspins/)
       CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
       CALL h5dcreate_f(d%fid, "k", H5T_NATIVE_INTEGER, spaceid, d%ksetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
       !stuff for dos etc
164
       IF (d%l_dos) THEN
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
          dims(:5)=(/4,ntype,neig,nkpts,jspins/)
          CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "qal", H5T_NATIVE_DOUBLE, spaceid, d%qalsetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
          dims(:4)=(/neig,2,nkpts,jspins/)
          CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "qvac", H5T_NATIVE_DOUBLE, spaceid, d%qvacsetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
          dims(:3)=(/neig,nkpts,jspins/)
          CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "qis", H5T_NATIVE_DOUBLE, spaceid, d%qissetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
          dims(:5)=(/neig,layers,2,nkpts,jspins/)
          CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "qvlay", H5T_NATIVE_DOUBLE, spaceid, d%qvlaysetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
          dims(:7)=(/2,nstars,neig,layers,2,nkpts,jspins/)
          CALL h5screate_simple_f(7,dims(:7),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "qstars", H5T_NATIVE_DOUBLE, spaceid, d%qstarssetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
          dims(:3)=(/neig,nkpts,jspins/)
          CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "ksym", H5T_NATIVE_DOUBLE, spaceid, d%ksymsetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
          dims(:3)=(/neig,nkpts,jspins/)
          CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
          CALL h5dcreate_f(d%fid, "jsym", H5T_NATIVE_DOUBLE, spaceid, d%jsymsetid, hdferr)
          CALL h5sclose_f(spaceid,hdferr)
193
          IF (d%l_mcd) THEN
194 195 196 197 198
             dims(:5)=(/3*ntype,ncored,neig,nkpts,jspins/)
             CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
             CALL h5dcreate_f(d%fid, "mcd", H5T_NATIVE_DOUBLE, spaceid, d%mcdsetid, hdferr)
             CALL h5sclose_f(spaceid,hdferr)
          ENDIF
199
          IF (d%l_orb) THEN
200 201 202 203 204 205 206 207
             dims(:4)=(/nsld,neig,nkpts,jspins/)
             CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
             CALL h5dcreate_f(d%fid, "qintsl", H5T_NATIVE_DOUBLE, spaceid, d%qintslsetid, hdferr)
             CALL h5sclose_f(spaceid,hdferr)
             dims(:4)=(/nsld,neig,nkpts,jspins/)
             CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
             CALL h5dcreate_f(d%fid, "qmtsl", H5T_NATIVE_DOUBLE, spaceid, d%qmtslsetid, hdferr)
             CALL h5sclose_f(spaceid,hdferr)
208
             dims(:4)=(/neig,nat,nkpts,jspins/)
209 210 211
             CALL h5screate_simple_f(4,dims(:4),spaceid,hdferr)
             CALL h5dcreate_f(d%fid, "qmtp", H5T_NATIVE_DOUBLE, spaceid, d%qmtpsetid, hdferr)
             CALL h5sclose_f(spaceid,hdferr)
212
             dims(:5)=(/neig,23,nat,nkpts,jspins/)
213 214 215 216 217 218 219 220 221 222 223 224 225 226
             CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
             CALL h5dcreate_f(d%fid, "orbcomp", H5T_NATIVE_DOUBLE, spaceid, d%orbcompsetid, hdferr)
             CALL h5sclose_f(spaceid,hdferr)
          ENDIF
       ENDIF
    ELSE
       CALL h5fopen_f (TRIM(d%fname)//'.hdf', access_Mode, d%fid, hdferr,access_prp)
       !get dataset-ids
       CALL h5dopen_f(d%fid, 'el', d%esetid, hdferr)
       CALL h5dopen_f(d%fid, 'evac', d%evacsetid, hdferr)
       CALL h5dopen_f(d%fid, 'ello', d%ellosetid, hdferr)
       CALL h5dopen_f(d%fid, 'bk', d%bksetid, hdferr)
       CALL h5dopen_f(d%fid, 'wk', d%wksetid, hdferr)
       CALL h5dopen_f(d%fid, 'energy', d%energysetid, hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
227
       CALL h5dopen_f(d%fid, 'w_iks', d%wikssetid, hdferr)
228 229 230 231 232
       CALL h5dopen_f(d%fid, 'k', d%ksetid, hdferr)
       CALL h5dopen_f(d%fid, 'neig', d%neigsetid, hdferr)
       CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr)
       CALL h5dopen_f(d%fid, 'nv', d%nvsetid, hdferr)
       CALL h5dopen_f(d%fid, 'nmat', d%nmatsetid, hdferr)
233
       IF (d%l_dos) THEN
234 235 236 237 238 239 240
          CALL h5dopen_f(d%fid, 'qal', d%qalsetid, hdferr)
          CALL h5dopen_f(d%fid, 'qvac', d%qvacsetid, hdferr)
          CALL h5dopen_f(d%fid, 'qis', d%qissetid, hdferr)
          CALL h5dopen_f(d%fid, 'qvlay', d%qvlaysetid, hdferr)
          CALL h5dopen_f(d%fid, 'qstars', d%qstarssetid, hdferr)
          CALL h5dopen_f(d%fid, 'ksym', d%ksymsetid, hdferr)
          CALL h5dopen_f(d%fid, 'jsym', d%jsymsetid, hdferr)
241
          IF (d%l_mcd) THEN
242 243
             CALL h5dopen_f(d%fid, 'mcd', d%mcdsetid, hdferr)
          ENDIF
244
          IF (d%l_orb) THEN
245 246 247 248 249 250
             CALL h5dopen_f(d%fid, 'qintsl', d%qintslsetid, hdferr)
             CALL h5dopen_f(d%fid, 'qmtsl', d%qmtslsetid, hdferr)
             CALL h5dopen_f(d%fid, 'qmtp', d%qmtpsetid, hdferr)
             CALL h5dopen_f(d%fid, 'orbcomp', d%orbcompsetid, hdferr)
          ENDIF
       ENDIF
251 252
    endif
    IF (.NOT.access_prp==H5P_DEFAULT_f) CALL H5Pclose_f(access_prp&
253 254
            &     ,hdferr)
#else
255
    CALL juDFT_error("Could not use HDF5 for IO, please recompile")
256
#endif
257
  END SUBROUTINE open_eig
258
     !----------------------------------------------------------------------
259
  SUBROUTINE close_eig(id,filename)
260 261 262 263 264 265 266 267 268 269 270
       !*****************************************************************
       !     closes hdf-file for eigenvectors+values
       !*****************************************************************
       IMPLICIT NONE
       INTEGER,INTENT(IN)                   :: id
       CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: filename

       INTEGER::hdferr
       TYPE(t_data_HDF),POINTER::d

       !close datasets
271
#ifdef CPP_HDF
272 273 274 275 276 277 278 279
       CALL priv_find_data(id,d)

       CALL h5dclose_f(d%esetid,hdferr)
       CALL h5dclose_f(d%evacsetid,hdferr)
       CALL h5dclose_f(d%ellosetid,hdferr)
       CALL h5dclose_f(d%bksetid,hdferr)
       CALL h5dclose_f(d%wksetid,hdferr)
       CALL h5dclose_f(d%energysetid,hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
280
       CALL h5dclose_f(d%wikssetid,hdferr)
281 282 283 284 285
       CALL h5dclose_f(d%ksetid,hdferr)
       CALL h5dclose_f(d%neigsetid,hdferr)
       CALL h5dclose_f(d%evsetid,hdferr)
       CALL h5dclose_f(d%nvsetid,hdferr)
       CALL h5dclose_f(d%nmatsetid,hdferr)
286
       IF (d%l_dos) THEN
287 288 289 290 291 292 293
          CALL h5dclose_f(d%qalsetid, hdferr)
          CALL h5dclose_f(d%qvacsetid, hdferr)
          CALL h5dclose_f(d%qissetid, hdferr)
          CALL h5dclose_f(d%qvlaysetid, hdferr)
          CALL h5dclose_f(d%qstarssetid, hdferr)
          CALL h5dclose_f(d%ksymsetid, hdferr)
          CALL h5dclose_f(d%jsymsetid, hdferr)
294
          IF (d%l_mcd) THEN
295 296
             CALL h5dclose_f(d%mcdsetid, hdferr)
          ENDIF
297
          IF (d%l_orb) THEN
298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313
             CALL h5dclose_f(d%qintslsetid, hdferr)
             CALL h5dclose_f(d%qmtslsetid, hdferr)
             CALL h5dclose_f(d%qmtpsetid, hdferr)
             CALL h5dclose_f(d%orbcompsetid, hdferr)
          ENDIF
       ENDIF
       !close file
       CALL h5fclose_f(d%fid,hdferr)
       !If a filename was given and the name is not the current filename
       IF (PRESENT(filename)) THEN
          IF (filename.NE.d%fname) THEN
             CALL system("mv "//TRIM(d%fname)//".hdf "//TRIM(filename)//".hdf")
          ENDIF
       ENDIF
       d%fname="eig"
       CALL eig66_remove_data(id)
314 315

#endif
316
     END SUBROUTINE close_eig
317
#ifdef CPP_HDF
318 319
     !----------------------------------------------------------------------
     SUBROUTINE priv_r_vec(d,nk,jspin,n_start,n_end,nmat,z)
320

321 322 323 324 325 326 327
       USE m_hdf_tools
       IMPLICIT NONE
       TYPE(t_data_HDF),INTENT(IN)::d
       INTEGER, INTENT(IN)  :: nk,jspin
       INTEGER, INTENT(IN)  :: n_start,n_end
       INTEGER, INTENT(OUT) :: nmat
       REAL,    INTENT(OUT) :: z(:,:)
328

329
       INTEGER i,j,neig_l
330

331
       neig_l = n_end - n_start + 1
332

333 334
       ! read matrix size
       CALL io_read_integer0(d%nmatsetid,(/nk,jspin/),(/1,1/),nmat)
335

336 337 338 339
       IF ( nmat > SIZE(z,1) .OR. neig_l > SIZE(z,2) ) THEN
          WRITE (6,*) nmat,SIZE(z,1),SIZE(z,2)
          CALL juDFT_error("eig66_hdf$read_vec",calledby ="eig66_hdf")
       ENDIF
340

341 342
       !read eigenvectors
       CALL io_read_real2(d%evsetid,(/1,1,n_start,nk,jspin/),&
343 344 345
            &                           (/1,nmat,neig_l,1,1/),&
            &                           z(:nmat,:neig_l) )

346
     END SUBROUTINE priv_r_vec
347 348

#endif
349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
     SUBROUTINE read_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
       IMPLICIT NONE
       INTEGER, INTENT(IN)          :: id,nk,jspin
       REAL,INTENT(OUT)              :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
       COMPLEX,INTENT(OUT)           :: qstars(:,:,:,:)
       INTEGER,INTENT(OUT)           :: ksym(:),jsym(:)
       REAL,INTENT(OUT),OPTIONAL     :: mcd(:,:,:)
       REAL,INTENT(OUT),OPTIONAL     :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
       TYPE(t_data_HDF),POINTER      :: d
       REAL,ALLOCATABLE              :: r_tmp5(:,:,:,:,:)
       CALL priv_find_data(id,d)
#ifdef CPP_HDF
       CALL io_read_real3(d%qalsetid,(/1,1,1,nk,jspin/),(/SIZE(qal,1),SIZE(qal,2),SIZE(qal,3),1,1/),qal)
       CALL io_read_real2(d%qvacsetid,(/1,1,nk,jspin/),(/SIZE(qvac,1),SIZE(qvac,2),1,1/),qvac)
       CALL io_read_real1(d%qissetid,(/1,nk,jspin/),(/SIZE(qis,1),1,1/),qis)
       CALL io_read_real3(d%qvlaysetid,(/1,1,1,nk,jspin/),(/SIZE(qvlay,1),SIZE(qvlay,2),SIZE(qvlay,3),1,1/),qvlay)
       ALLOCATE(r_tmp5(2,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4)))
       CALL io_read_real5(d%qstarssetid,(/1,1,1,1,1,nk,jspin/),(/2,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4),1,1/),r_tmp5(:,:,:,:,:))
       qstars=CMPLX(r_tmp5(1,:,:,:,:),r_tmp5(2,:,:,:,:))
       DEALLOCATE(r_tmp5)
       CALL io_read_integer1(d%ksymsetid,(/1,nk,jspin/),(/SIZE(ksym,1),1,1/),ksym)
       CALL io_read_integer1(d%jsymsetid,(/1,nk,jspin/),(/SIZE(jsym,1),1,1/),jsym)
       IF (d%l_mcd.AND.PRESENT(mcd)) THEN
          CALL io_read_real3(d%mcdsetid,(/1,1,1,nk,jspin/),(/SIZE(mcd,1),SIZE(mcd,2),SIZE(mcd,3),1,1/),mcd)
       ENDIF
       IF (d%l_orb.AND.PRESENT(qintsl)) THEN
          CALL io_read_real2(d%qintslsetid,(/1,1,nk,jspin/),(/SIZE(qintsl,1),SIZE(qintsl,2),1,1/),qintsl)
          CALL io_read_real2(d%qmtslsetid,(/1,1,nk,jspin/),(/SIZE(qmtsl,1),SIZE(qmtsl,2),1,1/),qmtsl)
          CALL io_read_real2(d%qmtpsetid,(/1,1,nk,jspin/),(/SIZE(qmtp,1),SIZE(qmtp,2),1,1/),qmtp)
378
          CALL io_read_real3(d%orbcompsetid,(/1,1,1,nk,jspin/),(/SIZE(orbcomp,1),23,SIZE(orbcomp,3),1,1/),orbcomp)
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398
       ENDIF
#endif
     END SUBROUTINE read_dos


     SUBROUTINE write_dos(id,nk,jspin,qal,qvac,qis,qvlay,qstars,ksym,jsym,mcd,qintsl,qmtsl,qmtp,orbcomp)
       IMPLICIT NONE
       INTEGER, INTENT(IN)          :: id,nk,jspin
       REAL,INTENT(IN)              :: qal(:,:,:),qvac(:,:),qis(:),qvlay(:,:,:)
       COMPLEX,INTENT(IN)           :: qstars(:,:,:,:)
       INTEGER,INTENT(IN)           :: ksym(:),jsym(:)
       REAL,INTENT(IN),OPTIONAL     :: mcd(:,:,:)
       REAL,INTENT(IN),OPTIONAL     :: qintsl(:,:),qmtsl(:,:),qmtp(:,:),orbcomp(:,:,:)
       TYPE(t_data_HDF),POINTER      ::d
       CALL priv_find_data(id,d)
#ifdef CPP_HDF
       CALL io_write_real3(d%qalsetid,(/1,1,1,nk,jspin/),(/SIZE(qal,1),SIZE(qal,2),SIZE(qal,3),1,1/),qal)
       CALL io_write_real2(d%qvacsetid,(/1,1,nk,jspin/),(/SIZE(qvac,1),SIZE(qvac,2),1,1/),qvac)
       CALL io_write_real1(d%qissetid,(/1,nk,jspin/),(/SIZE(qis,1),1,1/),qis)
       CALL io_write_real3(d%qvlaysetid,(/1,1,1,nk,jspin/),(/SIZE(qvlay,1),SIZE(qvlay,2),SIZE(qvlay,3),1,1/),qvlay)
399 400
       CALL io_write_real4(d%qstarssetid,(/1,1,1,1,1,nk,jspin/),(/1,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4),1,1/),REAL(qstars))
       CALL io_write_real4(d%qstarssetid,(/2,1,1,1,1,nk,jspin/),(/1,SIZE(qstars,1),SIZE(qstars,2),SIZE(qstars,3),SIZE(qstars,4),1,1/),AIMAG(qstars))
401 402 403 404 405 406 407 408 409 410

       CALL io_write_integer1(d%ksymsetid,(/1,nk,jspin/),(/SIZE(ksym,1),1,1/),ksym)
       CALL io_write_integer1(d%jsymsetid,(/1,nk,jspin/),(/SIZE(jsym,1),1,1/),jsym)
       IF (d%l_mcd.AND.PRESENT(mcd)) THEN
          CALL io_write_real3(d%mcdsetid,(/1,1,1,nk,jspin/),(/SIZE(mcd,1),SIZE(mcd,2),SIZE(mcd,3),1,1/),mcd)
       ENDIF
       IF (d%l_orb.AND.PRESENT(qintsl)) THEN
          CALL io_write_real2(d%qintslsetid,(/1,1,nk,jspin/),(/SIZE(qintsl,1),SIZE(qintsl,2),1,1/),qintsl)
          CALL io_write_real2(d%qmtslsetid,(/1,1,nk,jspin/),(/SIZE(qmtsl,1),SIZE(qmtsl,2),1,1/),qmtsl)
          CALL io_write_real2(d%qmtpsetid,(/1,1,nk,jspin/),(/SIZE(qmtp,1),SIZE(qmtp,2),1,1/),qmtp)
411
          CALL io_write_real3(d%orbcompsetid,(/1,1,1,nk,jspin/),(/SIZE(orbcomp,1),23,SIZE(orbcomp,3),1,1/),orbcomp)
412 413 414 415
       ENDIF
#endif
     END SUBROUTINE write_dos

416

417
     SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,nv,nmat,bk,wk,&
Daniel Wortmann's avatar
Daniel Wortmann committed
418
          &                  eig,w_iks,el,ello,evac,&
419
          &                  nlotot,n_size,n_rank,zmat)
420

421 422 423 424
       !*****************************************************************
       !     writes all eignevecs for the nk-th kpoint
       !*****************************************************************
       IMPLICIT NONE
425

426 427 428 429
       INTEGER, INTENT(IN)          :: id,nk,jspin
       INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
       REAL,    INTENT(IN),OPTIONAL :: wk
       INTEGER, INTENT(IN),OPTIONAL :: neig,nv,nmat,nlotot,neig_total
Daniel Wortmann's avatar
Daniel Wortmann committed
430
       REAL,    INTENT(IN),OPTIONAL :: bk(3),eig(:),el(:,:),w_iks(:)
431
       REAL,    INTENT(IN),OPTIONAL :: evac(2),ello(:,:)
432
       TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
433

434 435 436
       INTEGER i,j,k,nv_local,n1,n2,ne
       TYPE(t_data_HDF),POINTER::d
       CALL priv_find_data(id,d)
437 438

#ifdef CPP_HDF
439 440 441 442
       !
       !write enparas
       !
       nv_local=HUGE(1)
443

444
       IF (PRESENT(el))&
445 446
            &   CALL io_write_real2(&
            &                    d%esetid,(/1,1,nk,jspin/),&
447
            &                    (/SIZE(el,1),SIZE(el,2),1,1/),el)
448

449
       IF (PRESENT(ello))&
450 451
            & CALL io_write_real2(&
            &                    d%ellosetid,(/1,1,nk,jspin/),&
452
            &                    (/SIZE(ello,1),SIZE(ello,2),1,1/),ello)
453

454
       IF (PRESENT(evac)) CALL io_write_real1(&
455
            &                    d%evacsetid,(/1,nk,jspin/),(/2,1,1/),evac)
456 457 458
       !
       !write kpts
       !
459

460
       IF (PRESENT(bk)) CALL io_write_real1(&
461 462
            &                    d%bksetid,(/1,nk,jspin/),(/3,1,1/),bk)

463
       IF (PRESENT(wk)) CALL io_write_real0(&
464
            &                    d%wksetid,(/nk,jspin/),(/1,1/),wk)
465 466 467
       !
       !write basis
       !
468

469 470 471 472
       IF (PRESENT(nv)) THEN
          nv_local=nv
          CALL io_write_integer0(d%nvsetid,(/nk,jspin/),(/1,1/),nv)
       ENDIF
473

474
       IF (PRESENT(nmat)) CALL io_write_integer0(&
475 476
            &                       d%nmatsetid,(/nk,jspin/),(/1,1/),nmat)

477 478 479
       !
       !write eigenvalues
       !
Daniel Wortmann's avatar
Daniel Wortmann committed
480 481 482 483
       IF (PRESENT(w_iks)) THEN
          CALL io_write_real1s(d%wikssetid,(/1,nk,jspin/),(/size(w_iks),1,1/),w_iks,(/1,1,1/))
       ENDIF
       
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501
       IF (PRESENT(neig_total)) THEN
          CALL io_write_integer0(d%neigsetid,(/nk,jspin/),(/1,1/),neig_total)
       ENDIF

       IF (PRESENT(n_rank).AND.PRESENT(n_size).AND.&
            &        PRESENT(eig).AND.PRESENT(neig)) THEN
          CALL io_write_real1s(&
               &                     d%energysetid,(/n_rank+1,nk,jspin/),        &
               &                     (/neig,1,1/),eig(:neig),(/n_size,1,1/))
          !write eigenvectors
          !
       ELSEIF (PRESENT(eig).AND.PRESENT(neig)) THEN
          CALL io_write_real1s(&
               &                     d%energysetid,(/1,nk,jspin/),&
               &                     (/neig,1,1/),eig(:neig),(/1,1,1/))
       ELSE
          IF (PRESENT(eig)) CALL juDFT_error("BUG in calling write_eig")
       ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
502
       IF (PRESENT(zmat).AND..NOT.PRESENT(neig))&
503 504
            &    CALL juDFT_error("BUG in calling write_eig with eigenvector")

505 506 507
       n1=1;n2=0
       IF (PRESENT(n_size)) n1=n_size
       IF (PRESENT(n_rank)) n2=n_rank
508 509
       IF (PRESENT(zmat)) THEN
          IF (zmat%l_real) THEN
510 511
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
512
                  &           (/1,nmat,neig,1,1/),REAL(zmat%data_r(:nmat,:neig)),(/1,1,n1,1,1/))
513
          ELSE
514 515
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
516
                  &           (/1,nmat,neig,1,1/),REAL(zmat%data_c(:nmat,:neig)),(/1,1,n1,1,1/))
517 518
             CALL io_write_real2s(&
                  &                     d%evsetid,(/2,1,n2+1,nk,jspin/),&
519
                  &           (/1,nmat,neig,1,1/),AIMAG(zmat%data_c(:nmat,:neig)),&
520
                  &           (/1,1,n1,1,1/))
521
          ENDIF
522
       ENDIF
523 524

#endif
525
     END SUBROUTINE write_eig
526 527 528

#ifdef CPP_HDF

529 530 531 532
     !----------------------------------------------------------------------
     SUBROUTINE priv_r_vecc(&
          &                     d,nk,jspin,n_start,n_end,&
          &                     nmat,z)
533

534 535 536 537 538 539 540
       USE m_hdf_tools
       IMPLICIT NONE
       TYPE(t_data_HDF),INTENT(IN)::d
       INTEGER, INTENT(IN)  :: nk,jspin
       INTEGER, INTENT(IN)  :: n_start,n_end
       INTEGER, INTENT(OUT) :: nmat
       COMPLEX, INTENT(OUT) :: z(:,:)
541

542 543
       REAL, ALLOCATABLE :: z1(:,:,:)
       INTEGER i,j,neig_l
544

545
       neig_l = n_end - n_start + 1
546

547 548
       ! read matrix size
       CALL io_read_integer0(&
549 550 551
            &                      d%nmatsetid,(/nk,jspin/),(/1,1/),&
            &                                                nmat)

552 553 554 555
       IF ( nmat > SIZE(z,1) .OR. neig_l > SIZE(z,2) ) THEN
          WRITE (6,*) nmat,SIZE(z,1),SIZE(z,2)
          CALL juDFT_error("eig66_hdf$read_vec",calledby ="eig66_hdf")
       ENDIF
556

557 558 559
       ! read eigenvectors
       ALLOCATE (z1(2,nmat,neig_l))
       CALL io_read_real3(d%evsetid,(/1,1,n_start,nk,jspin/),&
560 561
            &                      (/2,nmat,neig_l,1,1/),z1)

562 563 564 565 566
       DO i=1,neig_l
          DO j=1,nmat
             z(j,i) = CMPLX( z1(1,j,i) ,z1(2,j,i) )
          ENDDO
       ENDDO
567

568 569 570 571
       DEALLOCATE (z1)

     END SUBROUTINE priv_r_vecc
     !-----------------------------------------------------------------------
572 573 574

#endif

575 576
     SUBROUTINE read_eig(id,nk,jspin,nv,nmat,bk,wk,neig,eig,w_iks,el,&
          &            ello,evac,n_start,n_end,zMat)
577 578 579 580
       IMPLICIT NONE
       INTEGER, INTENT(IN)            :: id,nk,jspin
       INTEGER, INTENT(OUT),OPTIONAL  :: nv,nmat
       INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
581
       REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
582 583 584
       REAL,    INTENT(OUT),OPTIONAL  :: evac(:),ello(:,:),el(:,:)
       REAL,    INTENT(OUT),OPTIONAL  :: bk(:),wk
       INTEGER, INTENT(IN),OPTIONAL   :: n_start,n_end
585
       TYPE(t_zMat),OPTIONAL  :: zmat
586 587

#ifdef CPP_HDF
588
       INTEGER:: n1,n,k
589 590 591 592 593 594 595 596 597 598 599 600 601 602 603
       TYPE(t_data_HDF),POINTER::d
       CALL priv_find_data(id,d)


       IF (PRESENT(neig))  THEN
          CALL io_read_integer0(d%neigsetid,(/nk,jspin/),(/1,1/),neig)

          IF ( PRESENT(eig) ) THEN                           ! read eigenv
             IF ( neig > SIZE(eig) ) THEN
                WRITE(*,*) neig,SIZE(eig)
                CALL juDFT_error("eig66_hdf$readeig",calledby ="eig66_hdf")
             ENDIF
             CALL io_read_real1(d%energysetid,(/1,nk,jspin/),(/neig,1,1/),&
                  &                      eig(:neig))
          ENDIF
Daniel Wortmann's avatar
Daniel Wortmann committed
604
          IF (PRESENT(w_iks)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
605
             CALL io_read_real1(d%wikssetid,(/1,nk,jspin/),(/size(w_iks),1,1/),w_iks)
Daniel Wortmann's avatar
Daniel Wortmann committed
606
          ENDIF
607 608
       ENDIF

Daniel Wortmann's avatar
Daniel Wortmann committed
609
     
610
       IF (PRESENT(nv)) CALL io_read_integer0(d%nvsetid,(/nk,jspin/),(/1,1/),nv)
611 612

       IF (PRESENT(nmat)) &
613
            & CALL io_read_integer0(d%nmatsetid,(/nk,jspin/),(/1,1/),nmat)
614 615 616 617 618
       IF (PRESENT(el)) CALL io_read_real2(d%esetid,(/1,1,nk,jspin/),&
            &                   (/SIZE(el,1),SIZE(el,2),1,1/),el(:,:))
       IF (PRESENT(ello)) CALL io_read_real2(d%ellosetid,(/1,1,nk,jspin/),&
            &                   (/SIZE(ello,1),SIZE(ello,2),1,1/),ello(:,:))
       IF (PRESENT(evac)) CALL io_read_real1(d%evacsetid,(/1,nk,jspin/),&
619 620
            &                 (/2,1,1/),evac)

621 622 623 624 625 626 627
       IF (PRESENT(bk)) CALL&
            io_read_real1(d%bksetid,(/1,nk,jspin/),(/3,1,1/),bk)
       IF (PRESENT(wk)) CALL&
            io_read_real0(d%wksetid,(/nk,jspin/),(/1,1/),wk)

       IF (PRESENT(n_start)) THEN
          IF (.NOT.PRESENT(n_end)) CALL juDFT_error("BUG3 in read_eig")
628 629 630 631 632 633
          IF (PRESENT(zMat)) THEN
             IF (zmat%l_real) THEN
                CALL priv_r_vec(d,nk,jspin,n_start,n_end,n1,zmat%z_r)
             ELSE
                CALL priv_r_vecc(d,nk,jspin,n_start,n_end,n1,zmat%z_c)
             ENDIF
634 635 636
          ENDIF
          IF (PRESENT(nmat)) nmat=n1
       ENDIF
637
#endif
638
     END SUBROUTINE read_eig
639

640
   END MODULE
641