eig66_hdf.F90 12.3 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
  !*****************************************************************
  ! 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's avatar
Daniel Wortmann committed
26
  !                          Daniel Wortmann
27 28
  !*****************************************************************
  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
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,create,l_real,l_soc,readonly,filename)
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
69
    LOGICAL, INTENT(IN) :: create,readonly,l_real,l_soc
70
    CHARACTER(LEN=*),OPTIONAL :: filename
71 72

#ifdef CPP_HDF
73 74 75 76

    INTEGER         :: hdferr,access_mode
    INTEGER(HID_T)  :: creation_prp,access_prp,spaceid
    LOGICAL         :: l_exist
77
    INTEGER(HSIZE_T):: dims(7)
78 79
    TYPE(t_data_HDF),POINTER::d
    !Set creation and access properties
80
#ifdef CPP_HDFMPI
81 82 83 84 85 86 87 88 89 90 91
    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
92
#else
93 94
    access_prp=H5P_DEFAULT_f
    creation_prp=H5P_DEFAULT_f
95
#endif 
96 97
    CALL priv_find_data(id,d)
    IF (PRESENT(filename)) d%fname=filename
98
    CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
    !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 h5sclose_f(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
120 121 122
       !     w_iks
       CALL h5dcreate_f(d%fid, "w_iks", H5T_NATIVE_DOUBLE, spaceid, d%wikssetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
123
       !     ev
124 125 126 127 128
       if ( l_real .and..not.l_soc ) THEN
          dims(:5)=(/one,nmat,neig,nkpts,jspins/)
       else
          dims(:5)=(/two,nmat,neig,nkpts,jspins/)
       endif
129 130 131 132 133 134 135
       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)
    ELSE
       CALL h5fopen_f (TRIM(d%fname)//'.hdf', access_Mode, d%fid, hdferr,access_prp)
       !get dataset-ids
       CALL h5dopen_f(d%fid, 'energy', d%energysetid, hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
136
       CALL h5dopen_f(d%fid, 'w_iks', d%wikssetid, hdferr)
137 138
       CALL h5dopen_f(d%fid, 'neig', d%neigsetid, hdferr)
       CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr)
139 140
    endif
    IF (.NOT.access_prp==H5P_DEFAULT_f) CALL H5Pclose_f(access_prp&
141 142
            &     ,hdferr)
#else
143
    CALL juDFT_error("Could not use HDF5 for IO, please recompile")
144
#endif
145
  END SUBROUTINE open_eig
146
     !----------------------------------------------------------------------
147
  SUBROUTINE close_eig(id,filename)
148 149 150 151 152 153 154 155 156 157 158
       !*****************************************************************
       !     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
159
#ifdef CPP_HDF
160 161 162
       CALL priv_find_data(id,d)

       CALL h5dclose_f(d%energysetid,hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
163
       CALL h5dclose_f(d%wikssetid,hdferr)
164 165 166 167 168 169 170 171 172 173 174 175
       CALL h5dclose_f(d%neigsetid,hdferr)
       CALL h5dclose_f(d%evsetid,hdferr)
       !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)
176 177

#endif
178
     END SUBROUTINE close_eig
179
#ifdef CPP_HDF
180
     !----------------------------------------------------------------------
Daniel Wortmann's avatar
Daniel Wortmann committed
181
     SUBROUTINE priv_r_vec(d,nk,jspin,n_start,n_end,z)
182

183 184 185 186 187 188
       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
       REAL,    INTENT(OUT) :: z(:,:)
189

Daniel Wortmann's avatar
Daniel Wortmann committed
190
       INTEGER :: nmat
191
       INTEGER i,j,neig_l
192

193
       neig_l = n_end - n_start + 1
194

Daniel Wortmann's avatar
Daniel Wortmann committed
195
       nmat=SIZE(z,1)
196 197
       !read eigenvectors
       CALL io_read_real2(d%evsetid,(/1,1,n_start,nk,jspin/),&
198 199 200
            &                           (/1,nmat,neig_l,1,1/),&
            &                           z(:nmat,:neig_l) )

201
     END SUBROUTINE priv_r_vec
202 203 204

#endif

205
     SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
206

207 208 209 210
       !*****************************************************************
       !     writes all eignevecs for the nk-th kpoint
       !*****************************************************************
       IMPLICIT NONE
211

212 213
       INTEGER, INTENT(IN)          :: id,nk,jspin
       INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
214 215
       INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
       REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
216
       TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
217

218 219 220
       INTEGER i,j,k,nv_local,n1,n2,ne
       TYPE(t_data_HDF),POINTER::d
       CALL priv_find_data(id,d)
221 222

#ifdef CPP_HDF
223 224 225 226
       !
       !write enparas
       !
       nv_local=HUGE(1)
227

228 229 230
       !
       !write eigenvalues
       !
Daniel Wortmann's avatar
Daniel Wortmann committed
231 232 233 234
       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
       
235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
       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
253
       IF (PRESENT(zmat).AND..NOT.PRESENT(neig))&
254 255
            &    CALL juDFT_error("BUG in calling write_eig with eigenvector")

256 257 258
       n1=1;n2=0
       IF (PRESENT(n_size)) n1=n_size
       IF (PRESENT(n_rank)) n2=n_rank
259 260
       IF (PRESENT(zmat)) THEN
          IF (zmat%l_real) THEN
261 262
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
263
                  &           (/1,SIZE(zmat%data_r,1),neig,1,1/),REAL(zmat%data_r(:,:neig)),(/1,1,n1,1,1/))
264
          ELSE
265 266
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
267
                  &           (/1,SIZE(zmat%data_c,1),neig,1,1/),REAL(zmat%data_c(:,:neig)),(/1,1,n1,1,1/))
268 269
             CALL io_write_real2s(&
                  &                     d%evsetid,(/2,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
270
                  &           (/1,SIZE(zmat%data_c,1),neig,1,1/),AIMAG(zmat%data_c(:,:neig)),&
271
                  &           (/1,1,n1,1,1/))
272
          ENDIF
273
       ENDIF
274 275

#endif
276
     END SUBROUTINE write_eig
277 278 279

#ifdef CPP_HDF

280 281
     !----------------------------------------------------------------------
     SUBROUTINE priv_r_vecc(&
Daniel Wortmann's avatar
Daniel Wortmann committed
282
          &                     d,nk,jspin,n_start,n_end,z)
283

284 285 286 287 288 289
       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
       COMPLEX, INTENT(OUT) :: z(:,:)
290

291 292
       REAL, ALLOCATABLE :: z1(:,:,:)
       INTEGER i,j,neig_l
Daniel Wortmann's avatar
Daniel Wortmann committed
293 294
       INTEGER :: nmat
    
295
       neig_l = n_end - n_start + 1
296

Daniel Wortmann's avatar
Daniel Wortmann committed
297
       nmat=SIZE(z,1)
298

299 300 301
       ! read eigenvectors
       ALLOCATE (z1(2,nmat,neig_l))
       CALL io_read_real3(d%evsetid,(/1,1,n_start,nk,jspin/),&
302 303
            &                      (/2,nmat,neig_l,1,1/),z1)

304 305 306 307 308
       DO i=1,neig_l
          DO j=1,nmat
             z(j,i) = CMPLX( z1(1,j,i) ,z1(2,j,i) )
          ENDDO
       ENDDO
309

310 311 312 313
       DEALLOCATE (z1)

     END SUBROUTINE priv_r_vecc
     !-----------------------------------------------------------------------
314 315 316

#endif

317
     SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,n_start,n_end,zMat)
318 319 320
       IMPLICIT NONE
       INTEGER, INTENT(IN)            :: id,nk,jspin
       INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
321
       REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
322
       INTEGER, INTENT(IN),OPTIONAL   :: n_start,n_end
323
       TYPE(t_mat),OPTIONAL  :: zmat
324 325

#ifdef CPP_HDF
326
       INTEGER:: n1,n,k
327 328 329 330 331 332 333 334 335 336 337 338 339 340 341
       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
342
          IF (PRESENT(w_iks)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
343
             CALL io_read_real1(d%wikssetid,(/1,nk,jspin/),(/size(w_iks),1,1/),w_iks)
Daniel Wortmann's avatar
Daniel Wortmann committed
344
          ENDIF
345 346 347 348
       ENDIF

       IF (PRESENT(n_start)) THEN
          IF (.NOT.PRESENT(n_end)) CALL juDFT_error("BUG3 in read_eig")
349 350
          IF (PRESENT(zMat)) THEN
             IF (zmat%l_real) THEN
351
                CALL priv_r_vec(d,nk,jspin,n_start,n_end,zmat%data_r)
352
             ELSE
353
                CALL priv_r_vecc(d,nk,jspin,n_start,n_end,zmat%data_c)
354
             ENDIF
355 356
          ENDIF
       ENDIF
357
#endif
358
     END SUBROUTINE read_eig
359

360
   END MODULE
361