hdf_accessprp.F90 5.21 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_hdf_accessprp
    USE hdf5
Daniel Wortmann's avatar
Bugfix  
Daniel Wortmann committed
9
    USE m_judft_stop
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
    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
      INCLUDE 'mpif.h'
40 41
      LOGICAL :: l_mpi
      CALL MPI_INITALIZED(l_mpi,ierr)
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
#endif

      IF (.not.present(setupfile)) THEN
         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")
         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
        IF (l_mpi) THEN
           driver="mpiio"
        ELSE
           driver='default'
        ENDIF
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 98 99 100 101
#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
102
#ifdef CPP_HDFMPI
103
        IF (l_mpi) THEN
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
        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
130
     ENDIF
131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
#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
      !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
      END function

end module m_hdf_accessprp