hdf_accessprp.F90 5.26 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 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
module m_hdf_accessprp
    USE hdf5
#include "juDFT_env.h"
    implicit none
    private
    !the hdf-access-properties
    integer          :: n_access_prp=0
    integer(hid_t)   :: access_prp(100)
    character(len=10) :: access_filename(100)
    public hdf_access_prp
    CONTAINS

    recursive SUBROUTINE  priv_generate_access_prp(setupfile)
      !Subroutine reads the two files ~/.gf_hdf and .gf_hdf
      !to generate access properties
      !typical file:
      !&hdf filename="embpot11",driver="mpiposix",alignment=103333
      !&hdf filename="default",driver="mpiio",hint(1)="romio_ds_read",value(1)="disable"
      IMPLICIT NONE
      character(len=*),optional::setupfile
      !generate the access_prp for later use
      character(len=10) :: filename
      character(len=9)  :: driver
      character(len=20) :: hint(10),value(10)
      logical           :: keep,gpfs,l_exist
      integer(hsize_t)  :: mem_increment
      integer(hsize_t)  :: alignment
      NAMELIST /hdf/filename,driver,hint,value,keep,gpfs,mem_increment,alignment

      integer :: n,i,hdferr,ierr,info
      character(len=128)::path
38
#ifdef CPP_HDFMPI
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
      INCLUDE 'mpif.h'
#endif

      IF (.not.present(setupfile)) THEN
         CPP_juDFT_timestart_debug("generating access prp")
         n_access_prp=1
         call priv_generate_access_prp("default")
         call getenv("HOME",path)
         call priv_generate_access_prp(trim(path)//"/.gf_hdf")
         call priv_generate_access_prp("gf_hdf")
         CPP_juDFT_timestop_debug("generating access prp")
         return
      ENDIF

      if (.not.(setupfile=="default")) THEN
           INQUIRE(file=setupfile,exist=l_exist)
           IF (.not.l_exist) return
           OPEN(999,file=setupfile)
      ENDIF
      write(6,*) "Access properties from:",setupfile

      n=0
      readloop:DO
        filename="default"
63
#ifdef CPP_HDFMPI
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
        driver="mpiio"
#else
        driver="default"
#endif
        hint=""
        value=""
        keep=.false.
        mem_increment=1024*1024
        alignment=-1
        gpfs=.false.

        if (.not.(setupfile=="default")) read(999,hdf,end=100)
        if (n>0.and.(setupfile=="default")) return
        !Now create the access property
        if (filename=="default") THEN
             n=1
        else
             n_access_prp=n_access_prp+1
             n=n_access_prp
             access_filename(n)=filename
        endif

        write(6,"(a,i5,8(1x,a))") "Access_prp:",n,"for:",filename,"with:",driver

        !different drivers
        if (index(driver,"default")==1) THEN
            access_prp(n)=H5P_DEFAULT_f
            cycle readloop
        endif
        call  h5pcreate_f(H5P_FILE_ACCESS_F, access_prp(n), hdferr)
        IF (index(driver,"core")==1) THEN
            CALL h5pset_fapl_core_f(access_prp(n), mem_increment, keep,hdferr)
            cycle readloop
        ENDIF
98
#ifdef CPP_HDFMPI
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
        CALL MPI_BARRIER(MPI_COMM_WORLD,hdferr)
        IF (index(driver,"mpiio")==1) THEN
            !create info object
            CALL MPI_Info_create(info,ierr);
            i=1
            DO WHILE(i<=size(hint))
              if (len(trim(hint(i)))>1) THEN
                  write(6,*) "Hint:",hint(i),"=",value(i)
                  call MPI_Info_set(info,hint(i),value(i),hdferr)
                  i=i+1
              else
                  i=size(hint)+1
              endif
            ENDDO
            CALL h5pset_fapl_mpio_f(access_prp(n), MPI_COMM_WORLD,INFO,hdferr)
            CALL MPI_BARRIER(MPI_COMM_WORLD,hdferr)
            call mpi_info_free(info,ierr)
            if (alignment>0) CALL h5pset_alignment_f(access_prp(n), INT(0,hsize_t),alignment, hdferr)
            cycle readloop
        ENDIF
        IF (index(driver,"mpiposix")==1) THEN
            call judft_error("MPIPOSIX driver not implemented")
             !CALL h5pset_fapl_mpiposix_f(access_prp(n), MPI_COMM_WORLD,gpfs,hdferr)
            if (alignment>0) CALL h5pset_alignment_f(access_prp(n), INT(0,hsize_t),alignment, hdferr)
            cycle readloop
        ENDIF
#endif
        write(0,*) "Driver name unkown:",driver
        call judft_error("Unkown driver",calledby="gf_io2dmat")
      ENDDO readloop
100   close(999)

      END SUBROUTINE

      FUNCTION hdf_access_prp(filename)
      !return the access_prp from the list
      character(len=*),intent(in) :: filename
      INTEGER(hid_t)          :: hdf_access_prp
      INTEGER                 :: n
      CPP_juDFT_timestart_debug("getting access prp")
      !if this is the first attempt to get an access_prp, generate them
      if (n_access_prp==0) CALL priv_generate_access_prp()
      hdf_access_prp=access_prp(1)
      DO n=2,n_access_prp
          if (trim(filename)==trim(access_filename(n))) THEN
                  hdf_access_prp=access_prp(n)
                  write(6,*) "Assigned:",n," to ", filename
          ENDIF
      ENDDO
      CPP_juDFT_timestop_debug("getting access prp")
      END function

end module m_hdf_accessprp