LCOV - code coverage report
Current view: top level - io - eig66_hdf.F90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 122 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 7 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_eig66_hdf
       8             : #include "juDFT_env.h"
       9             :   !*****************************************************************
      10             :   ! DESC:Module for hdf-io of eig-file
      11             :   !      To be compatible with f90 interface of HDF, use kind for vars
      12             :   !
      13             :   !      !ATTENTION before calling openeig and after calling closeeig!
      14             :   !      !the hdf library has to be initialized or finalized, respectively
      15             :   !
      16             :   !      CONTAINS the following subroutines:
      17             :   !      openeig        opens file
      18             :   !      closeeig       closes file
      19             :   !      read_keb       reads kpt, enpara and basis data
      20             :   !      read_neig      read no of eigenvalues (and eigenvalues itself)
      21             :   !      read_eig       reads eigenvectors
      22             :   !      writeeig       saves all data for kpt
      23             :   !      writesingleeig saves data for one kpt and energy
      24             :   !
      25             :   !
      26             :   !                          Daniel Wortmann
      27             :   !*****************************************************************
      28             :   USE m_eig66_data
      29             :   USE m_types
      30             : #ifdef CPP_HDF
      31             :   USE hdf5
      32             :   USE m_hdf_tools
      33             :   IMPLICIT NONE
      34             : 
      35             :   PRIVATE
      36             :   INTEGER, PARAMETER :: one=1,two=2,three=3,zero=0
      37             :   !to have the correct
      38             :   !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           0 :   SUBROUTINE priv_find_data(id,d)
      47             :     INTEGER,INTENT(IN)::id
      48             :     TYPE(t_data_hdf),POINTER:: d
      49             : 
      50             :     CLASS(t_data),POINTER   ::dp
      51           0 :     CALL eig66_find_data(dp,id)
      52             :     SELECT TYPE(dp)
      53             :     TYPE is (t_data_hdf)
      54           0 :        d=>dp
      55             :        CLASS default
      56           0 :        CALL judft_error("BUG: wrong datatype in eig66_hdf")
      57             :     END SELECT
      58           0 :   END SUBROUTINE priv_find_data
      59             :   !----------------------------------------------------------------------
      60           0 :   SUBROUTINE open_eig(id,mpi_comm,nmat,neig,nkpts,jspins,create,l_real,l_soc,readonly,filename)
      61             : 
      62             :     !*****************************************************************
      63             :     !     opens hdf-file for eigenvectors+values
      64             :     !*****************************************************************
      65             :     IMPLICIT NONE
      66             : 
      67             :     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             :     INTEGER         :: hdferr,access_mode
      75             :     INTEGER(HID_T)  :: creation_prp,access_prp,spaceid
      76             :     LOGICAL         :: l_exist
      77             :     INTEGER(HSIZE_T):: dims(7)
      78             :     TYPE(t_data_HDF),POINTER::d
      79             :     !Set creation and access properties
      80             : #ifdef CPP_HDFMPI
      81             :     INCLUDE 'mpif.h'
      82           0 :     IF (readonly) THEN
      83           0 :        access_prp=H5P_DEFAULT_f
      84           0 :        creation_prp=H5P_DEFAULT_f
      85             :     ELSE
      86           0 :        CALL h5pcreate_f(H5P_FILE_ACCESS_F, access_prp, hdferr)
      87             :        !      CALL h5pset_fapl_mpiposix_f(access_prp,MPI_COMM,
      88             :        !     +.false.,hdferr)
      89           0 :        CALL h5pset_fapl_mpio_f(access_prp, MPI_COMM, MPI_INFO_NULL,hdferr)
      90           0 :        creation_prp=H5P_DEFAULT_f !no special creation property
      91             :     ENDIF
      92             : #else
      93             :     access_prp=H5P_DEFAULT_f
      94             :     creation_prp=H5P_DEFAULT_f
      95             : #endif 
      96           0 :     CALL priv_find_data(id,d)
      97           0 :     IF (PRESENT(filename)) d%fname=filename
      98           0 :     CALL eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
      99             :     !set access_flags according
     100           0 :     IF (readonly) THEN
     101           0 :        access_mode=H5F_ACC_RDONLY_F
     102             :     ELSE
     103           0 :        access_mode=H5F_ACC_RDWR_F
     104             :     ENDIF
     105             :     !     OPEN FILE and get D%FID's
     106           0 :     IF (create) THEN
     107           0 :        INQUIRE(FILE=TRIM(d%fname)//'.hdf',EXIST=l_exist)
     108           0 :        access_mode=H5F_ACC_TRUNC_F
     109             :        !         IF (l_exist) WRITE (*,*)'Warning: eig.hdf was overwritten'
     110           0 :        CALL h5fcreate_f(TRIM(d%fname)//'.hdf',access_Mode, d%fid, hdferr ,creation_prp,access_prp)
     111             :        ! create dataspaces and datasets
     112             :        !   scalars
     113           0 :        dims(:2)=(/nkpts,jspins/)
     114           0 :        CALL h5screate_simple_f(2,dims(:2),spaceid,hdferr)
     115           0 :        CALL h5dcreate_f(d%fid, "neig", H5T_NATIVE_INTEGER, spaceid, d%neigsetid, hdferr)
     116           0 :        CALL h5sclose_f(spaceid,hdferr)
     117             :        !     ew
     118           0 :        dims(:3)=(/neig,nkpts,jspins/)
     119           0 :        CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
     120           0 :        CALL h5dcreate_f(d%fid, "energy", H5T_NATIVE_DOUBLE, spaceid, d%energysetid, hdferr)
     121           0 :        CALL h5sclose_f(spaceid,hdferr)
     122             :        !     w_iks
     123           0 :        dims(:3)=(/neig,nkpts,jspins/)
     124           0 :        CALL h5screate_simple_f(3,dims(:3),spaceid,hdferr)
     125           0 :        CALL h5dcreate_f(d%fid, "w_iks", H5T_NATIVE_DOUBLE, spaceid, d%wikssetid, hdferr)
     126           0 :        CALL h5sclose_f(spaceid,hdferr)
     127             :        !     ev
     128           0 :        if ( l_real .and..not.l_soc ) THEN
     129           0 :           dims(:5)=(/one,nmat,neig,nkpts,jspins/)
     130             :        else
     131           0 :           dims(:5)=(/two,nmat,neig,nkpts,jspins/)
     132             :        endif
     133           0 :        CALL h5screate_simple_f(5,dims(:5),spaceid,hdferr)
     134           0 :        CALL h5dcreate_f(d%fid, "ev", H5T_NATIVE_DOUBLE, spaceid, d%evsetid, hdferr)
     135           0 :        CALL h5sclose_f(spaceid,hdferr)
     136             :     ELSE
     137           0 :        CALL h5fopen_f (TRIM(d%fname)//'.hdf', access_Mode, d%fid, hdferr,access_prp)
     138             :        !get dataset-ids
     139           0 :        CALL h5dopen_f(d%fid, 'energy', d%energysetid, hdferr)
     140           0 :        CALL h5dopen_f(d%fid, 'w_iks', d%wikssetid, hdferr)
     141           0 :        CALL h5dopen_f(d%fid, 'neig', d%neigsetid, hdferr)
     142           0 :        CALL h5dopen_f(d%fid, 'ev', d%evsetid, hdferr)
     143             :     endif
     144           0 :     IF (.NOT.access_prp==H5P_DEFAULT_f) CALL H5Pclose_f(access_prp&
     145           0 :             &     ,hdferr)
     146             : #else
     147             :     CALL juDFT_error("Could not use HDF5 for IO, please recompile")
     148             : #endif
     149           0 :   END SUBROUTINE open_eig
     150             :      !----------------------------------------------------------------------
     151           0 :   SUBROUTINE close_eig(id,filename)
     152             :        !*****************************************************************
     153             :        !     closes hdf-file for eigenvectors+values
     154             :        !*****************************************************************
     155             :        IMPLICIT NONE
     156             :        INTEGER,INTENT(IN)                   :: id
     157             :        CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: filename
     158             : 
     159             :        INTEGER::hdferr
     160             :        TYPE(t_data_HDF),POINTER::d
     161             : 
     162             :        !close datasets
     163             : #ifdef CPP_HDF
     164           0 :        CALL priv_find_data(id,d)
     165             : 
     166           0 :        CALL h5dclose_f(d%energysetid,hdferr)
     167           0 :        CALL h5dclose_f(d%wikssetid,hdferr)
     168           0 :        CALL h5dclose_f(d%neigsetid,hdferr)
     169           0 :        CALL h5dclose_f(d%evsetid,hdferr)
     170             :        !close file
     171           0 :        CALL h5fclose_f(d%fid,hdferr)
     172             :        !If a filename was given and the name is not the current filename
     173           0 :        IF (PRESENT(filename)) THEN
     174           0 :           IF (filename.NE.d%fname) THEN
     175           0 :              CALL system("mv "//TRIM(d%fname)//".hdf "//TRIM(filename)//".hdf")
     176             :           ENDIF
     177             :        ENDIF
     178           0 :        d%fname="eig"
     179           0 :        CALL eig66_remove_data(id)
     180             : 
     181             : #endif
     182           0 :      END SUBROUTINE close_eig
     183             : #ifdef CPP_HDF
     184             :      !----------------------------------------------------------------------
     185           0 :      SUBROUTINE priv_r_vec(d,nk,jspin,list,z)
     186             : 
     187             :        USE m_hdf_tools
     188             :        IMPLICIT NONE
     189             :        TYPE(t_data_HDF),INTENT(IN)::d
     190             :        INTEGER, INTENT(IN)  :: nk,jspin
     191             :        INTEGER, OPTIONAL,INTENT(IN)  :: list(:)
     192             :        REAL,    INTENT(OUT) :: z(:,:)
     193             : 
     194             :        INTEGER :: nmat
     195             :        INTEGER i
     196             : 
     197             : 
     198           0 :        nmat=SIZE(z,1)
     199             :        !read eigenvectors
     200           0 :        IF (.NOT.PRESENT(list)) THEN
     201             :           ! read all eigenvectors
     202             :           CALL io_read_real2(d%evsetid,(/1,1,1,nk,jspin/),&
     203           0 :                (/1,nmat,SIZE(z,2),1,1/),z(:nmat,:) )
     204             :        ELSE
     205           0 :           DO i=1,SIZE(list)
     206             :              CALL io_read_real1(d%evsetid,(/1,1,list(i),nk,jspin/),&
     207           0 :                   &                      (/1,nmat,1,1,1/),z(:nmat,i))
     208             :           ENDDO
     209             :        END IF
     210             : 
     211           0 :      END SUBROUTINE priv_r_vec
     212             : 
     213             : #endif
     214             : 
     215           0 :      SUBROUTINE write_eig(id,nk,jspin,neig,neig_total,eig,w_iks,n_size,n_rank,zmat)
     216             : 
     217             :        !*****************************************************************
     218             :        !     writes all eignevecs for the nk-th kpoint
     219             :        !*****************************************************************
     220             :        IMPLICIT NONE
     221             : 
     222             :        INTEGER, INTENT(IN)          :: id,nk,jspin
     223             :        INTEGER, INTENT(IN),OPTIONAL :: n_size,n_rank
     224             :        INTEGER, INTENT(IN),OPTIONAL :: neig,neig_total
     225             :        REAL,    INTENT(IN),OPTIONAL :: eig(:),w_iks(:)
     226             :        TYPE(t_mat),INTENT(IN),OPTIONAL :: zmat
     227             : 
     228             :        INTEGER i,j,k,nv_local,n1,n2,ne
     229             :        TYPE(t_data_HDF),POINTER::d
     230           0 :        CALL priv_find_data(id,d)
     231             : 
     232             : #ifdef CPP_HDF
     233             :        !
     234             :        !write enparas
     235             :        !
     236           0 :        nv_local=HUGE(1)
     237             : 
     238             :        !
     239             :        !write eigenvalues
     240             :        !
     241           0 :        IF (PRESENT(w_iks)) THEN
     242           0 :           CALL io_write_real1s(d%wikssetid,(/1,nk,jspin/),(/size(w_iks),1,1/),w_iks,(/1,1,1/))
     243             :        ENDIF
     244             :        
     245           0 :        IF (PRESENT(neig_total)) THEN
     246           0 :           CALL io_write_integer0(d%neigsetid,(/nk,jspin/),(/1,1/),neig_total)
     247             :        ENDIF
     248             : 
     249             :        IF (PRESENT(n_rank).AND.PRESENT(n_size).AND.&
     250           0 :             &        PRESENT(eig).AND.PRESENT(neig)) THEN
     251             :           CALL io_write_real1s(&
     252             :                &                     d%energysetid,(/n_rank+1,nk,jspin/),        &
     253           0 :                &                     (/neig,1,1/),eig(:neig),(/n_size,1,1/))
     254             :           !write eigenvectors
     255             :           !
     256           0 :        ELSEIF (PRESENT(eig).AND.PRESENT(neig)) THEN
     257             :           CALL io_write_real1s(&
     258             :                &                     d%energysetid,(/1,nk,jspin/),&
     259           0 :                &                     (/neig,1,1/),eig(:neig),(/1,1,1/))
     260             :        ELSE
     261           0 :           IF (PRESENT(eig)) CALL juDFT_error("BUG in calling write_eig")
     262             :        ENDIF
     263           0 :        IF (PRESENT(zmat).AND..NOT.PRESENT(neig))&
     264           0 :             &    CALL juDFT_error("BUG in calling write_eig with eigenvector")
     265             : 
     266           0 :        n1=1;n2=0
     267           0 :        IF (PRESENT(n_size)) n1=n_size
     268           0 :        IF (PRESENT(n_rank)) n2=n_rank
     269           0 :        IF (PRESENT(zmat)) THEN
     270           0 :           IF (zmat%l_real) THEN
     271             :              CALL io_write_real2s(&
     272             :                   &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
     273           0 :                   &           (/1,SIZE(zmat%data_r,1),neig,1,1/),REAL(zmat%data_r(:,:neig)),(/1,1,n1,1,1/))
     274             :           ELSE
     275             :              CALL io_write_real2s(&
     276             :                   &                     d%evsetid,(/1,1,n2+1,nk,jspin/),&
     277           0 :                   &           (/1,SIZE(zmat%data_c,1),neig,1,1/),REAL(zmat%data_c(:,:neig)),(/1,1,n1,1,1/))
     278             :              CALL io_write_real2s(&
     279             :                   &                     d%evsetid,(/2,1,n2+1,nk,jspin/),&
     280             :                   &           (/1,SIZE(zmat%data_c,1),neig,1,1/),AIMAG(zmat%data_c(:,:neig)),&
     281           0 :                   &           (/1,1,n1,1,1/))
     282             :           ENDIF
     283             :        ENDIF
     284             : 
     285             : #endif
     286           0 :      END SUBROUTINE write_eig
     287             : 
     288             : #ifdef CPP_HDF
     289             : 
     290             :      !----------------------------------------------------------------------
     291           0 :      SUBROUTINE priv_r_vecc(&
     292           0 :           &                     d,nk,jspin,list,z)
     293             : 
     294             :        USE m_hdf_tools
     295             :        IMPLICIT NONE
     296             :        TYPE(t_data_HDF),INTENT(IN)::d
     297             :        INTEGER, INTENT(IN)  :: nk,jspin
     298             :        INTEGER,OPTIONAL, INTENT(IN)  :: list(:)
     299             :        COMPLEX, INTENT(OUT) :: z(:,:)
     300             : 
     301           0 :        REAL, ALLOCATABLE :: z1(:,:,:)
     302             :        INTEGER i,j
     303             :        INTEGER :: nmat
     304             :     
     305             : 
     306           0 :        nmat=SIZE(z,1)
     307             : 
     308           0 :        IF (.NOT.PRESENT(list)) THEN
     309             :           ! read all eigenvectors
     310           0 :           ALLOCATE (z1(2,nmat,SIZE(z,2)))
     311             :           CALL io_read_real3(d%evsetid,(/1,1,1,nk,jspin/),&
     312           0 :                &                      (/2,nmat,SIZE(z,2),1,1/),z1)
     313           0 :           DO i=1,SIZE(z,2)
     314           0 :              z(:,i) = CMPLX( z1(1,:,i) ,z1(2,:,i) )
     315             :           ENDDO
     316             :        ELSE
     317           0 :           ALLOCATE (z1(2,nmat,1))
     318           0 :           DO i=1,SIZE(list)
     319             :               CALL io_read_real3(d%evsetid,(/1,1,list(i),nk,jspin/),&
     320           0 :                &                      (/2,nmat,1,1,1/),z1)
     321           0 :               z(:,i) = CMPLX( z1(1,:,i) ,z1(2,:,i) )
     322             :            ENDDO
     323             :         END IF
     324           0 :      END SUBROUTINE priv_r_vecc
     325             :      !-----------------------------------------------------------------------
     326             : 
     327             : #endif
     328             : 
     329           0 :      SUBROUTINE read_eig(id,nk,jspin,neig,eig,w_iks,list,zMat)
     330             :        IMPLICIT NONE
     331             :        INTEGER, INTENT(IN)            :: id,nk,jspin
     332             :        INTEGER, INTENT(OUT),OPTIONAL  :: neig
     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             :        TYPE(t_data_HDF),POINTER::d
     340           0 :        CALL priv_find_data(id,d)
     341             : 
     342             : 
     343           0 :        IF (PRESENT(neig))  THEN
     344           0 :           CALL io_read_integer0(d%neigsetid,(/nk,jspin/),(/1,1/),neig)
     345             : 
     346           0 :           IF ( PRESENT(eig) ) THEN                           ! read eigenv
     347           0 :              IF ( neig > SIZE(eig) ) THEN
     348           0 :                 WRITE(*,*) neig,SIZE(eig)
     349           0 :                 CALL juDFT_error("eig66_hdf$readeig",calledby ="eig66_hdf")
     350             :              ENDIF
     351             :              CALL io_read_real1(d%energysetid,(/1,nk,jspin/),(/neig,1,1/),&
     352           0 :                   &                      eig(:neig))
     353             :           ENDIF
     354           0 :           IF (PRESENT(w_iks)) THEN
     355           0 :              CALL io_read_real1(d%wikssetid,(/1,nk,jspin/),(/size(w_iks),1,1/),w_iks)
     356             :           ENDIF
     357             :        ENDIF
     358             : 
     359           0 :        IF (PRESENT(zMat)) THEN
     360           0 :           IF (zmat%l_real) THEN
     361           0 :              CALL priv_r_vec(d,nk,jspin,list,zmat%data_r)
     362             :           ELSE
     363           0 :              CALL priv_r_vecc(d,nk,jspin,list,zmat%data_c)
     364             :           ENDIF
     365             :        ENDIF
     366             : #endif
     367           0 :      END SUBROUTINE read_eig
     368             : 
     369           0 :    END MODULE
     370             : 

Generated by: LCOV version 1.13