eig66_hdf.F90 12.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
  !*****************************************************************
  ! 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
    !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)
143 144
    endif
    IF (.NOT.access_prp==H5P_DEFAULT_f) CALL H5Pclose_f(access_prp&
145 146
            &     ,hdferr)
#else
147
    CALL juDFT_error("Could not use HDF5 for IO, please recompile")
148
#endif
149
  END SUBROUTINE open_eig
150
     !----------------------------------------------------------------------
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,list,z)
186

187 188 189 190
       USE m_hdf_tools
       IMPLICIT NONE
       TYPE(t_data_HDF),INTENT(IN)::d
       INTEGER, INTENT(IN)  :: nk,jspin
Daniel Wortmann's avatar
Daniel Wortmann committed
191
       INTEGER, OPTIONAL,INTENT(IN)  :: list(:)
192
       REAL,    INTENT(OUT) :: z(:,:)
193

Daniel Wortmann's avatar
Daniel Wortmann committed
194
       INTEGER :: nmat
195
       INTEGER i
196 197


Daniel Wortmann's avatar
Daniel Wortmann committed
198
       nmat=SIZE(z,1)
199
       !read eigenvectors
200 201 202 203 204 205
       IF (.NOT.PRESENT(list)) THEN
          ! read all eigenvectors
          CALL io_read_real2(d%evsetid,(/1,1,1,nk,jspin/),&
               (/1,nmat,SIZE(z,2),1,1/),z(:nmat,:) )
       ELSE
          DO i=1,SIZE(list)
Daniel Wortmann's avatar
Daniel Wortmann committed
206
             CALL io_read_real1(d%evsetid,(/1,1,list(i),nk,jspin/),&
207 208 209
                  &                      (/1,nmat,1,1,1/),z(:nmat,i))
          ENDDO
       END IF
210

211
     END SUBROUTINE priv_r_vec
212 213 214

#endif

215
     SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
216

217 218 219 220
       !*****************************************************************
       !     writes all eignevecs for the nk-th kpoint
       !*****************************************************************
       IMPLICIT NONE
221

222 223
       INTEGER, INTENT(IN)          :: id,nk,jspin
       INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
224 225
       INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
       REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
226
       TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
227

228 229 230
       INTEGER i,j,k,nv_local,n1,n2,ne
       TYPE(t_data_HDF),POINTER::d
       CALL priv_find_data(id,d)
231 232

#ifdef CPP_HDF
233 234 235 236
       !
       !write enparas
       !
       nv_local=HUGE(1)
237

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

266 267 268
       n1=1;n2=0
       IF (PRESENT(n_size)) n1=n_size
       IF (PRESENT(n_rank)) n2=n_rank
269 270
       IF (PRESENT(zmat)) THEN
          IF (zmat%l_real) THEN
271 272
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
273
                  &           (/1,SIZE(zmat%data_r,1),neig,1,1/),REAL(zmat%data_r(:,:neig)),(/1,1,n1,1,1/))
274
          ELSE
275 276
             CALL io_write_real2s(&
                  &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
277
                  &           (/1,SIZE(zmat%data_c,1),neig,1,1/),REAL(zmat%data_c(:,:neig)),(/1,1,n1,1,1/))
278 279
             CALL io_write_real2s(&
                  &                     d%evsetid,(/2,1,n2+1,nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
280
                  &           (/1,SIZE(zmat%data_c,1),neig,1,1/),AIMAG(zmat%data_c(:,:neig)),&
281
                  &           (/1,1,n1,1,1/))
282
          ENDIF
283
       ENDIF
284 285

#endif
286
     END SUBROUTINE write_eig
287 288 289

#ifdef CPP_HDF

290 291
     !----------------------------------------------------------------------
     SUBROUTINE priv_r_vecc(&
292
          &                     d,nk,jspin,list,z)
293

294 295 296 297
       USE m_hdf_tools
       IMPLICIT NONE
       TYPE(t_data_HDF),INTENT(IN)::d
       INTEGER, INTENT(IN)  :: nk,jspin
298
       INTEGER,OPTIONAL, INTENT(IN)  :: list(:)
299
       COMPLEX, INTENT(OUT) :: z(:,:)
300

301
       REAL, ALLOCATABLE :: z1(:,:,:)
302
       INTEGER i,j
Daniel Wortmann's avatar
Daniel Wortmann committed
303 304
       INTEGER :: nmat
    
305

Daniel Wortmann's avatar
Daniel Wortmann committed
306
       nmat=SIZE(z,1)
307

308 309 310 311 312 313 314
       IF (.NOT.PRESENT(list)) THEN
          ! read all eigenvectors
          ALLOCATE (z1(2,nmat,SIZE(z,2)))
          CALL io_read_real3(d%evsetid,(/1,1,1,nk,jspin/),&
               &                      (/2,nmat,SIZE(z,2),1,1/),z1)
          DO i=1,SIZE(z,2)
             z(:,i) = CMPLX( z1(1,:,i) ,z1(2,:,i) )
315
          ENDDO
316 317 318 319
       ELSE
          ALLOCATE (z1(2,nmat,1))
          DO i=1,SIZE(list)
              CALL io_read_real3(d%evsetid,(/1,1,list(i),nk,jspin/),&
Daniel Wortmann's avatar
Daniel Wortmann committed
320
               &                      (/2,nmat,1,1,1/),z1)
321 322 323
              z(:,i) = CMPLX( z1(1,:,i) ,z1(2,:,i) )
           ENDDO
        END IF
324 325
     END SUBROUTINE priv_r_vecc
     !-----------------------------------------------------------------------
326 327 328

#endif

329
     SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,list,zMat)
330 331 332
       IMPLICIT NONE
       INTEGER, INTENT(IN)            :: id,nk,jspin
       INTEGER, INTENT(OUT),OPTIONAL  :: neig
Daniel Wortmann's avatar
Daniel Wortmann committed
333
       REAL,    INTENT(OUT),OPTIONAL  :: eig(:),w_iks(:)
334
       INTEGER, INTENT(IN),OPTIONAL   :: list(:)
335
       TYPE(t_mat),OPTIONAL  :: zmat
336 337

#ifdef CPP_HDF
338
       INTEGER:: n1,n,k
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
       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
354
          IF (PRESENT(w_iks)) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
355
             CALL io_read_real1(d%wikssetid,(/1,nk,jspin/),(/size(w_iks),1,1/),w_iks)
Daniel Wortmann's avatar
Daniel Wortmann committed
356
          ENDIF
357 358
       ENDIF

359 360 361 362 363
       IF (PRESENT(zMat)) THEN
          IF (zmat%l_real) THEN
             CALL priv_r_vec(d,nk,jspin,list,zmat%data_r)
          ELSE
             CALL priv_r_vecc(d,nk,jspin,list,zmat%data_c)
364 365
          ENDIF
       ENDIF
366
#endif
367
     END SUBROUTINE read_eig
368

369
   END MODULE
370