eig66_hdf.F90 12.5 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
Daniel Wortmann's avatar
Daniel Wortmann committed
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
    !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
118 119
       dims(:3)=(/neig,nkpts,jspins/)
       CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
120 121
       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
122
       !     w_iks
123 124
       dims(:3)=(/neig,nkpts,jspins/)
       CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
125 126
       CALL h5dcreate_f(d%fid, "w_iks", H5T_NATIVE_DOUBLE, spaceid, d%wikssetid, hdferr)
       CALL h5sclose_f(spaceid,hdferr)
127
       !     ev
128 129 130 131 132
       if ( l_real .and..not.l_soc ) THEN
          dims(:5)=(/one,nmat,neig,nkpts,jspins/)
       else
          dims(:5)=(/two,nmat,neig,nkpts,jspins/)
       endif
133 134 135 136 137 138 139
       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
140
       CALL h5dopen_f(d%fid, 'w_iks', d%wikssetid, hdferr)
141 142
       CALL h5dopen_f(d%fid, 'neig', d%neigsetid, hdferr)
       CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
143 144
    endif
    IF (.NOT.access_prp==H5P_DEFAULT_f) CALL H5Pclose_f(access_prp&
145 146
            &     ,hdferr)
#else
Daniel Wortmann's avatar
Daniel Wortmann committed
147
    CALL juDFT_error("Could not use HDF5 for IO, please recompile")
148
#endif
Daniel Wortmann's avatar
Daniel Wortmann committed
149
  END SUBROUTINE open_eig
150
     !----------------------------------------------------------------------
Daniel Wortmann's avatar
Daniel Wortmann committed
151
  SUBROUTINE close_eig(id,filename)
152 153 154 155 156 157 158 159 160 161 162
       !*****************************************************************
       !     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
163
#ifdef CPP_HDF
164 165 166
       CALL priv_find_data(id,d)

       CALL h5dclose_f(d%energysetid,hdferr)
Daniel Wortmann's avatar
Daniel Wortmann committed
167
       CALL h5dclose_f(d%wikssetid,hdferr)
168 169 170 171 172 173 174 175 176 177 178 179
       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)
180 181

#endif
182
     END SUBROUTINE close_eig
183
#ifdef CPP_HDF
184
     !----------------------------------------------------------------------
Daniel Wortmann's avatar
Daniel Wortmann committed
185
     SUBROUTINE priv_r_vec(d,nk,jspin,n_start,n_end,z)
186

187 188 189 190 191 192
       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(:,:)
193

Daniel Wortmann's avatar
Daniel Wortmann committed
194
       INTEGER :: nmat
195
       INTEGER i,j,neig_l
196

197
       neig_l = n_end - n_start + 1
198

Daniel Wortmann's avatar
Daniel Wortmann committed
199
       nmat=SIZE(z,1)
200 201
       !read eigenvectors
       CALL io_read_real2(d%evsetid,(/1,1,n_start,nk,jspin/),&
202 203 204
            &                           (/1,nmat,neig_l,1,1/),&
            &                           z(:nmat,:neig_l) )

205
     END SUBROUTINE priv_r_vec
206 207 208

#endif

209
     SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
210

211 212 213 214
       !*****************************************************************
       !     writes all eignevecs for the nk-th kpoint
       !*****************************************************************
       IMPLICIT NONE
215

216 217
       INTEGER, INTENT(IN)          :: id,nk,jspin
       INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
218 219
       INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
       REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
220
       TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
221

222 223 224
       INTEGER i,j,k,nv_local,n1,n2,ne
       TYPE(t_data_HDF),POINTER::d
       CALL priv_find_data(id,d)
225 226

#ifdef CPP_HDF
227 228 229 230
       !
       !write enparas
       !
       nv_local=HUGE(1)
231

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

260 261 262
       n1=1;n2=0
       IF (PRESENT(n_size)) n1=n_size
       IF (PRESENT(n_rank)) n2=n_rank
263 264
       IF (PRESENT(zmat)) THEN
          IF (zmat%l_real) THEN
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_r,1),neig,1,1/),REAL(zmat%data_r(:,:neig)),(/1,1,n1,1,1/))
268
          ELSE
269 270
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
271
                  &           (/1,SIZE(zmat%data_c,1),neig,1,1/),REAL(zmat%data_c(:,:neig)),(/1,1,n1,1,1/))
272 273
             CALL io_write_real2s(&
                  &                     d%evsetid,(/2,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
274
                  &           (/1,SIZE(zmat%data_c,1),neig,1,1/),AIMAG(zmat%data_c(:,:neig)),&
275
                  &           (/1,1,n1,1,1/))
276
          ENDIF
277
       ENDIF
278 279

#endif
280
     END SUBROUTINE write_eig
281 282 283

#ifdef CPP_HDF

284 285
     !----------------------------------------------------------------------
     SUBROUTINE priv_r_vecc(&
Daniel Wortmann's avatar
Daniel Wortmann committed
286
          &                     d,nk,jspin,n_start,n_end,z)
287

288 289 290 291 292 293
       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(:,:)
294

295 296
       REAL, ALLOCATABLE :: z1(:,:,:)
       INTEGER i,j,neig_l
Daniel Wortmann's avatar
Daniel Wortmann committed
297 298
       INTEGER :: nmat
    
299
       neig_l = n_end - n_start + 1
300

Daniel Wortmann's avatar
Daniel Wortmann committed
301
       nmat=SIZE(z,1)
302

303 304 305
       ! read eigenvectors
       ALLOCATE (z1(2,nmat,neig_l))
       CALL io_read_real3(d%evsetid,(/1,1,n_start,nk,jspin/),&
306 307
            &                      (/2,nmat,neig_l,1,1/),z1)

308 309 310 311 312
       DO i=1,neig_l
          DO j=1,nmat
             z(j,i) = CMPLX( z1(1,j,i) ,z1(2,j,i) )
          ENDDO
       ENDDO
313

314 315 316 317
       DEALLOCATE (z1)

     END SUBROUTINE priv_r_vecc
     !-----------------------------------------------------------------------
318 319 320

#endif

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

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

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

364
   END MODULE
365