Line data    Source code

       1             : MODULE m_cfOutput_hdf
       2             : #ifdef CPP_HDF
       3             : 
       4             :    USE hdf5
       5             :    USE m_hdf_tools
       6             : 
       7             :    IMPLICIT NONE
       8             : 
       9             :    PUBLIC opencfFile, closecfFile, writeCFpot, writeCFcdn
      10             : 
      11             :    CONTAINS
      12             : 
      13           1 :    SUBROUTINE opencfFile(fileID, atoms, cell, inFilename, l_create)
      14             : 
      15             :       USE m_types_atoms
      16             :       USE m_types_cell
      17             :       USE m_juDFT
      18             : 
      19             :       TYPE(t_atoms),                INTENT(IN)  :: atoms
      20             :       TYPE(t_cell),                 INTENT(IN)  :: cell
      21             :       INTEGER(HID_T),               INTENT(OUT) :: fileID
      22             :       CHARACTER(len=:), OPTIONAL, ALLOCATABLE,   INTENT(IN)  :: inFilename
      23             :       LOGICAL, OPTIONAL,            INTENT(IN)  :: l_create
      24             : 
      25             :       INTEGER          :: version,numCDN, numPOT
      26           1 :       CHARACTER(len=:),ALLOCATABLE :: filename
      27             :       LOGICAL          :: l_exist
      28             :       LOGICAL          :: l_error,l_createIn
      29             :       INTEGER          :: hdfError
      30             :       INTEGER(HSIZE_T) :: dims(2)
      31             :       INTEGER          :: dimsInt(2)
      32             : 
      33             :       INTEGER(HID_T)   :: metaGroupID
      34             :       INTEGER(HID_T)   :: generalGroupID
      35             :       INTEGER(HID_T)   :: bravaisMatrixSpaceID,bravaisMatrixSetID
      36             : 
      37           1 :       l_createIn = .TRUE.
      38           1 :       IF(PRESENT(l_create)) l_createIn = l_create
      39             : 
      40           1 :       version = 1
      41           1 :       IF(PRESENT(inFilename)) THEN
      42           0 :          filename = inFilename
      43             :       ELSE
      44           1 :          filename = "CFdata.hdf"
      45             :       ENDIF
      46             : 
      47           1 :       INQUIRE(FILE=TRIM(ADJUSTL(filename)),EXIST=l_exist)
      48             : 
      49           1 :       IF(l_createIn) THEN
      50           1 :          IF(l_exist) THEN
      51           0 :             CALL system('rm '//TRIM(ADJUSTL(filename)))
      52             :          ENDIF
      53             : 
      54           1 :          CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, fileID, hdfError, H5P_DEFAULT_F, H5P_DEFAULT_F)
      55             : 
      56           1 :          CALL h5gcreate_f(fileID, '/meta', metaGroupID, hdfError)
      57           1 :          CALL io_write_attint0(metaGroupID,'version',version)
      58             : 
      59           1 :          CALL h5gclose_f(metaGroupID, hdfError)
      60             : 
      61             :          !How many potentials and charge densities are written out
      62           1 :          CALL h5gcreate_f(fileID, '/general', generalGroupID, hdfError)
      63           6 :          CALL io_write_attint0(generalGroupID,'numPOT',COUNT(atoms%l_outputCFpot(:)))
      64           6 :          CALL io_write_attint0(generalGroupID,'numCDN',COUNT(atoms%l_outputCFcdn(:)))
      65             : 
      66             :          !Write out the Bravais Matrix (important to keep track of phase differences for coefficients with m != 0)
      67           1 :          dims(:2)=(/3,3/)
      68           3 :          dimsInt=dims
      69           1 :          CALL h5screate_simple_f(2,dims(:2),bravaisMatrixSpaceID,hdfError)
      70           1 :          CALL h5dcreate_f(generalGroupID, "bravaisMatrix", H5T_NATIVE_DOUBLE, bravaisMatrixSpaceID, bravaisMatrixSetID, hdfError)
      71           1 :          CALL h5sclose_f(bravaisMatrixSpaceID,hdfError)
      72           1 :          CALL io_write_real2(bravaisMatrixSetID,(/1,1/),dimsInt(:2),"amat",cell%amat)
      73           1 :          CALL h5dclose_f(bravaisMatrixSetID, hdfError)
      74             : 
      75           4 :          CALL h5gclose_f(generalGroupID, hdfError)
      76           0 :       ELSE IF(l_exist) THEN
      77             :          !Only open file
      78           0 :          CALL h5fopen_f(filename, H5F_ACC_RDWR_F, fileID, hdfError, H5P_DEFAULT_F)
      79             :       ELSE
      80           0 :          CALL juDFT_error("File not found", calledby="opencfFile")
      81             :       ENDIF
      82             : 
      83           1 :    END SUBROUTINE opencfFile
      84             : 
      85           1 :    SUBROUTINE closecfFile(fileID)
      86             : 
      87             :       INTEGER(HID_T), INTENT(IN)  :: fileID
      88             : 
      89             :       INTEGER hdfError
      90             : 
      91           1 :       CALL h5fclose_f(fileID, hdfError)
      92             : 
      93           1 :    END SUBROUTINE closecfFile
      94             : 
      95           1 :    SUBROUTINE writeCFpot(fileID, atoms,input,iType,vlm)
      96             : 
      97             :       USE m_types_atoms
      98             :       USE m_types_input
      99             :       USE m_juDFT
     100             : 
     101             :       INTEGER(HID_T),   INTENT(IN)  :: fileID
     102             :       TYPE(t_atoms),    INTENT(IN)  :: atoms
     103             :       TYPE(t_input),    INTENT(IN)  :: input
     104             :       INTEGER,          INTENT(IN)  :: iType
     105             :       COMPLEX,          INTENT(IN)  :: vlm(:,:,:)
     106             : 
     107             :       INTEGER(HID_T) :: potGroupID, vlmGroupID
     108             :       INTEGER(HID_T) :: rmeshDataSpaceID,rmeshDataSetID
     109             :       INTEGER(HID_T) :: vlmDataSpaceID,vlmDataSetID
     110             : 
     111             :       INTEGER(HSIZE_T)  :: dims(7)
     112             :       INTEGER           :: dimsInt(7)
     113             :       INTEGER           :: hdfError
     114             :       INTEGER           :: l,m,lm
     115             :       LOGICAL           :: l_exist
     116           1 :       CHARACTER(len=:), ALLOCATABLE  :: groupName
     117             : 
     118           1 :       groupName = '/pot-'//int2str(iType)
     119             : 
     120           1 :       l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
     121             : 
     122           1 :       IF(l_exist) THEN
     123           0 :          CALL juDFT_error('Group already exists: '//groupName, calledby="writeCFpot")
     124             :       ENDIF
     125             : 
     126           1 :       CALL h5gcreate_f(fileID, groupName, potGroupID, hdfError)
     127             : 
     128             :       !Radial Mesh
     129           1 :       CALL io_write_attint0(potGroupID,'atomType',iType)
     130           1 :       CALL io_write_attreal0(potGroupID,'RMT',atoms%rmt(iType))
     131           2 :       dims(:1)=[atoms%jri(iType)]
     132           8 :       dimsInt=dims
     133           1 :       CALL h5screate_simple_f(1,dims(:1),rmeshDataSpaceID,hdfError)
     134           1 :       CALL h5dcreate_f(potGroupID, "rmesh", H5T_NATIVE_DOUBLE, rmeshDataSpaceID, rmeshDataSetID, hdfError)
     135           1 :       CALL h5sclose_f(rmeshDataSpaceID,hdfError)
     136           1 :       CALL io_write_real1(rmeshDataSetID,[1],dimsInt(:1),"rmsh",atoms%rmsh(:atoms%jri(iType),iType))
     137           1 :       CALL h5dclose_f(rmeshDataSetID, hdfError)
     138             : 
     139           4 :       DO l = 2, 6, 2
     140          31 :          DO m = -l,l
     141          27 :             lm = l * (l+1) + m + 1
     142          27 :             CALL h5gcreate_f(potGroupID, 'VKS.'//int2str(l)//'.'//int2str(m), vlmGroupID, hdfError)
     143          27 :             CALL io_write_attint0(vlmGroupID,'l',l)
     144          27 :             CALL io_write_attint0(vlmGroupID,'m',m)
     145             : 
     146         108 :             dims(:3)=[2,atoms%jri(iType),input%jspins]
     147         216 :             dimsInt=dims
     148          27 :             CALL h5screate_simple_f(3,dims(:3),vlmDataSpaceID,hdfError)
     149          27 :             CALL h5dcreate_f(vlmGroupID, "vlm", H5T_NATIVE_DOUBLE, vlmDataSpaceID, vlmDataSetID, hdfError)
     150          27 :             CALL h5sclose_f(vlmDataSpaceID,hdfError)
     151          27 :             CALL io_write_complex2(vlmDataSetID,[-1,1,1],dimsInt(:3),"vlm",vlm(:atoms%jri(iType),lm,:))
     152          27 :             CALL h5dclose_f(vlmDataSetID, hdfError)
     153             : 
     154          57 :             CALL h5gclose_f(vlmGroupID, hdfError)
     155             :          ENDDO
     156             :       ENDDO
     157           1 :       CALL h5gclose_f(potGroupID, hdfError)
     158             : 
     159           1 :    END SUBROUTINE writeCFpot
     160             : 
     161           1 :    SUBROUTINE writeCFcdn(fileID, atoms,iType, n4f)
     162             : 
     163             :       USE m_types_atoms
     164             :       USE m_types_input
     165             :       USE m_juDFT
     166             : 
     167             :       INTEGER(HID_T),   INTENT(IN)  :: fileID
     168             :       TYPE(t_atoms),    INTENT(IN)  :: atoms
     169             :       INTEGER,          INTENT(IN)  :: iType
     170             :       REAL,             INTENT(IN)  :: n4f(:)
     171             : 
     172             :       INTEGER(HID_T) :: cdnGroupID
     173             :       INTEGER(HID_T) :: rmeshDataSpaceID,rmeshDataSetID
     174             :       INTEGER(HID_T) :: cdnDataSpaceID,cdnDataSetID
     175             : 
     176             :       INTEGER(HSIZE_T)  :: dims(7)
     177             :       INTEGER           :: dimsInt(7)
     178             :       INTEGER           :: hdfError
     179             :       LOGICAL           :: l_exist
     180           1 :       CHARACTER(len=:),ALLOCATABLE  :: groupName
     181             : 
     182           1 :       groupName = '/cdn-'//int2str(iType)
     183             : 
     184           1 :       l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
     185             : 
     186           1 :       IF(l_exist) THEN
     187           0 :          CALL juDFT_error('Group already exists: '//groupName, calledby="writeCFcdn")
     188             :       ENDIF
     189             : 
     190           1 :       CALL h5gcreate_f(fileID, groupName, cdnGroupID, hdfError)
     191             : 
     192             :       !Radial Mesh
     193           1 :       CALL io_write_attint0(cdnGroupID,'atomType',iType)
     194           1 :       CALL io_write_attreal0(cdnGroupID,'RMT',atoms%rmt(iType))
     195           2 :       dims(:1)=[atoms%jri(iType)]
     196           8 :       dimsInt=dims
     197           1 :       CALL h5screate_simple_f(1,dims(:1),rmeshDataSpaceID,hdfError)
     198           1 :       CALL h5dcreate_f(cdnGroupID, "rmesh", H5T_NATIVE_DOUBLE, rmeshDataSpaceID, rmeshDataSetID, hdfError)
     199           1 :       CALL h5sclose_f(rmeshDataSpaceID,hdfError)
     200           1 :       CALL io_write_real1(rmeshDataSetID,[1],dimsInt(:1),"rmsh",atoms%rmsh(:atoms%jri(iType),iType))
     201           1 :       CALL h5dclose_f(rmeshDataSetID, hdfError)
     202             : 
     203           2 :       dims(:1)=[atoms%jri(iType)]
     204           8 :       dimsInt=dims
     205           1 :       CALL h5screate_simple_f(1,dims(:1),cdnDataSpaceID,hdfError)
     206           1 :       CALL h5dcreate_f(cdnGroupID, "cdn", H5T_NATIVE_DOUBLE, cdnDataSpaceID, cdnDataSetID, hdfError)
     207           1 :       CALL h5sclose_f(cdnDataSpaceID,hdfError)
     208           1 :       CALL io_write_real1(cdnDataSetID,[1],dimsInt(:1),"n4f",n4f(:atoms%jri(iType)))
     209           1 :       CALL h5dclose_f(cdnDataSetID, hdfError)
     210             : 
     211           1 :       CALL h5gclose_f(cdnGroupID, hdfError)
     212             : 
     213           1 :    END SUBROUTINE writeCFcdn
     214             : 
     215             : #endif
     216             : END MODULE m_cfOutput_hdf