! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
!   Copyright by The HDF Group.                                               *
!   All rights reserved.                                                      *
!                                                                             *
!   This file is part of HDF5.  The full HDF5 copyright notice, including     *
!   terms governing use, modification, and redistribution, is contained in    *
!   the COPYING file, which can be found at the root of the source code       *
!   distribution tree, or in https://www.hdfgroup.org/licenses.               *
!   If you do not have access to either file, you may request a copy from     *
!   help@hdfgroup.org.                                                        *
! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

!
! main program for subfiling HDF5 Fortran tests
!

#include <H5config_f.inc>

PROGRAM subfiling_test
  USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT64_T
  USE HDF5
  USE MPI
  USE TH5_MISC

  IMPLICIT NONE

  INTEGER :: total_error = 0        ! sum of the number of errors
  INTEGER(KIND=MPI_INTEGER_KIND) :: mpierror               ! MPI hdferror flag
  INTEGER(KIND=MPI_INTEGER_KIND) :: mpi_rank               ! rank of the calling process in the communicator

#ifdef H5_HAVE_SUBFILING_VFD

  CHARACTER(LEN=7), PARAMETER :: filename = "subf.h5"

  INTEGER :: hdferror                                      ! HDF hdferror flag
  INTEGER(KIND=MPI_INTEGER_KIND) :: mpi_size, mpi_size_ret ! number of processes in the group of communicator
  INTEGER(KIND=MPI_INTEGER_KIND) :: required, provided
  LOGICAL :: file_exists

  INTEGER(HID_T) :: fapl_id
  INTEGER(HID_T) :: file_id
  INTEGER(KIND=MPI_INTEGER_KIND) :: comm, comm_ret
  INTEGER(KIND=MPI_INTEGER_KIND) :: info, info_ret
  CHARACTER(LEN=3) :: info_val
  CHARACTER(LEN=180) :: subfname
  INTEGER :: i, sum
  INTEGER(C_INT64_T) inode
  TYPE(H5FD_subfiling_config_t) :: vfd_config
  TYPE(H5FD_ioc_config_t)       :: vfd_config_ioc
#ifdef H5_MPI_LOGICAL_KIND
  LOGICAL(KIND=H5_MPI_LOGICAL_KIND) :: flag
#else
  LOGICAL(KIND=MPI_INTEGER_KIND) :: flag
#endif

  INTEGER :: nerrors = 0

  INTEGER(HID_T) :: driver_id

  CHARACTER(len=8) :: hex1, hex2
  CHARACTER(len=1) :: arg

  INTEGER(KIND=MPI_INTEGER_KIND) :: mpi_int_type
  !
  ! initialize MPI
  !
  required = MPI_THREAD_MULTIPLE
  CALL mpi_init_thread(required, provided, mpierror)
  IF (mpierror .NE. MPI_SUCCESS) THEN
     WRITE(*,*) "MPI_INIT_THREAD  *FAILED*"
     nerrors = nerrors + 1
  ENDIF
  IF (provided .NE. required) THEN
     WRITE(*,*) "MPI doesn't support MPI_Init_thread with MPI_THREAD_MULTIPLE *FAILED*"
     nerrors = nerrors + 1
  ENDIF
  CALL mpi_comm_rank( MPI_COMM_WORLD, mpi_rank, mpierror )
  IF (mpierror .NE. MPI_SUCCESS) THEN
     WRITE(*,*) "MPI_COMM_RANK  *FAILED* Process = ", mpi_rank
     nerrors = nerrors + 1
  ENDIF
  CALL mpi_comm_size( MPI_COMM_WORLD, mpi_size, mpierror )
  IF (mpierror .NE. MPI_SUCCESS) THEN
     WRITE(*,*) "MPI_COMM_SIZE  *FAILED* Process = ", mpi_rank
     nerrors = nerrors + 1
  ENDIF

  IF(nerrors.NE.0)THEN
     IF(mpi_rank==0) CALL write_test_status(sum, &
          'Testing Initializing mpi_init_thread', total_error)
     CALL MPI_Barrier(MPI_COMM_WORLD, mpierror)
     CALL mpi_abort(MPI_COMM_WORLD, 1_MPI_INTEGER_KIND, mpierror)
  ENDIF

  !
  ! initialize the HDF5 fortran interface
  !
  CALL h5open_f(hdferror)

  IF(mpi_rank==0) CALL write_test_header("SUBFILING FORTRAN TESTING")

  ! ***********************************
  ! Test H5Pset/get_mpi_params_f APIs
  ! ***********************************
  nerrors = 0
  IF(mpi_size.GT.2)THEN

     IF (mpi_rank.LE.1)THEN
        CALL MPI_Comm_split(MPI_COMM_WORLD, 1_MPI_INTEGER_KIND, mpi_rank, comm, mpierror)
     ELSE
        CALL MPI_Comm_split(MPI_COMM_WORLD, 0_MPI_INTEGER_KIND, mpi_rank, comm, mpierror)
     ENDIF

     CALL MPI_Info_create(info, mpierror)
     CALL MPI_Info_set( info, "foo", "bar", mpierror)

     IF (mpi_rank.LE.1)THEN

        CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror)
        CALL check("h5pcreate_f", hdferror, nerrors)

        CALL H5Pset_mpi_params_f(fapl_id, comm, info, hdferror)
        CALL check("H5Pset_mpi_params_f", hdferror, nerrors)

        CALL H5Pget_mpi_params_f(fapl_id, comm_ret, info_ret, hdferror)
        CALL check("H5Pget_mpi_params_f", hdferror, nerrors)

        CALL mpi_comm_size(comm_ret, mpi_size_ret, mpierror)

        IF(mpi_size_ret.NE.2)THEN
           IF(mpi_rank.EQ.0) &
                WRITE(*,*) "Failed H5Pset_mpi_params_f and H5Pget_mpi_params_f sequence"
           nerrors = nerrors + 1
        ENDIF

        CALL mpi_info_get(info_ret,"foo", 3_MPI_INTEGER_KIND, info_val, flag, mpierror)
        IF(LOGICAL(flag) .EQV. LOGICAL(.TRUE.))THEN
           IF(info_val.NE."bar")THEN
              IF(mpi_rank.EQ.0) &
                   WRITE(*,*) "Failed H5Pset_mpi_params_f and H5Pget_mpi_params_f sequence"
              nerrors = nerrors + 1
           ENDIF
        ELSE
           IF(mpi_rank.EQ.0) &
                WRITE(*,*) "Failed to find info value with mpi_info_get"
           nerrors = nerrors + 1
        ENDIF
        CALL h5pclose_f(fapl_id, hdferror)
     ENDIF

     CALL MPI_Comm_free(comm, mpierror)
     CALL MPI_Info_free(info, mpierror)

  ENDIF

  IF(h5_sizeof(total_error).EQ.8_size_t)THEN
     mpi_int_type=MPI_INTEGER8
  ELSE
     mpi_int_type=MPI_INTEGER4
  ENDIF

  CALL MPI_REDUCE(nerrors, sum, 1_MPI_INTEGER_KIND, mpi_int_type, MPI_SUM, 0_MPI_INTEGER_KIND, MPI_COMM_WORLD, mpierror)
  IF(mpi_rank==0) CALL write_test_status(sum, &
       'Testing H5Pset/get_mpi_params_f', total_error)

  ! *********************************************************
  ! Setup file access property list with subfiling I/O access
  ! *********************************************************

  nerrors = 0
  CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl_id, hdferror)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL H5Pset_mpi_params_f(fapl_id, MPI_COMM_WORLD, MPI_INFO_NULL, hdferror)
  CALL check("H5Pset_mpi_params_f", hdferror, nerrors)

  CALL H5Pget_mpi_params_f(fapl_id, comm, info, hdferror)
  CALL check("H5Pset_mpi_params_f", hdferror, nerrors)

  CALL mpi_comm_size(comm, mpi_size_ret, mpierror)
  IF(mpi_size_ret.NE.mpi_size)THEN
     IF(mpi_rank.EQ.0) &
          WRITE(*,*) "Failed H5Pset_mpi_params_f and H5Pget_mpi_params_f sequence"
     nerrors = nerrors + 1
  ENDIF

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Pset/get_mpi_params_f with defaults ', total_error)

  ! Verify no new enum parameters have been added in C and not updated in Fortran
  IF( IOC_SELECTION_OPTIONS_F .NE. 4)THEN
     IF(mpi_rank.EQ.0) &
          WRITE(*,*) "Mismatch between Fortran and C H5FD_subfiling_ioc_select_t definitions"
     nerrors = nerrors + 1
  ENDIF

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing Subfiling FD is registered', total_error)

  ! *********************************************************
  ! Check the default subfiling parameters
  ! *********************************************************
  nerrors = 0
  CALL h5pset_fapl_subfiling_f(fapl_id, hdferror)
  CALL check("h5pset_fapl_subfiling_f", hdferror, nerrors)

  CALL h5pget_driver_f(fapl_id, driver_id, hdferror)
  CALL check("h5pget_driver_f", hdferror, nerrors)

  IF( driver_id .NE. H5FD_SUBFILING_F) THEN
     WRITE(*,*) "Wrong file driver type returned"
     nerrors = nerrors + 1
  ENDIF

  ! *********************************************************
  ! Check the default parameters for subfiling and ioc
  ! *********************************************************

  CALL h5pget_fapl_subfiling_f(fapl_id, vfd_config, hdferror)
  CALL check("h5pget_fapl_subfiling_f", hdferror, nerrors)

  CALL h5pset_fapl_ioc_f(vfd_config%ioc_fapl_id, hdferror)
  CALL check("h5pset_fapl_ioc_f", hdferror, nerrors)

  CALL h5pget_fapl_ioc_f(vfd_config%ioc_fapl_id, vfd_config_ioc, hdferror)
  CALL check("h5pget_fapl_ioc_f", hdferror, nerrors)

  WRITE(hex1,'(z8)') H5FD_SUBFILING_FAPL_MAGIC_F
  WRITE(hex2,'(z8)') vfd_config%magic

  IF(hex1 .NE. hex2 .OR. &
     vfd_config%version .NE. H5FD_SUBFILING_CURR_FAPL_VERSION_F .OR. &
     .NOT.vfd_config%require_ioc .OR. &
     vfd_config%shared_cfg%ioc_selection .NE. SELECT_IOC_ONE_PER_NODE_F .OR. &
     vfd_config%shared_cfg%stripe_size .NE. H5FD_SUBFILING_DEFAULT_STRIPE_SIZE_F .OR. &
     vfd_config%shared_cfg%stripe_count .NE. H5FD_SUBFILING_DEFAULT_STRIPE_COUNT_F &
     )THEN
     IF(mpi_rank.EQ.0) &
          WRITE(*,*) "Failed h5pget_fapl_subfiling_f"
     nerrors = nerrors + 1
  ENDIF

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Pset/get_fapl_subfiling_f with defaults', total_error)

  WRITE(hex1,'(z8)') H5FD_IOC_FAPL_MAGIC_F
  WRITE(hex2,'(z8)') vfd_config_ioc%magic

  nerrors = 0
  IF(hex1 .NE. hex2 .OR. &
     vfd_config_ioc%version .NE. H5FD_IOC_CURR_FAPL_VERSION_F .OR. &
     vfd_config_ioc%thread_pool_size .NE. H5FD_IOC_DEFAULT_THREAD_POOL_SIZE_F &
     )THEN
     IF(mpi_rank.EQ.0) &
          WRITE(*,*) "Failed h5pget_fapl_ioc_f"
     nerrors = nerrors + 1
  ENDIF

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Pset/get_fapl_ioc_f with defaults', total_error)

  ! *********************************************************
  ! Testing creating a file with subfiling, default settings
  ! *********************************************************

  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id)
  CALL check("h5fcreate_f", hdferror, nerrors)

  CALL h5fclose_f(file_id, hdferror)
  CALL check("h5fclose_f", hdferror, nerrors)

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Fcreate with subfiling with default settings', total_error)

  ! *********************************************************
  ! Testing creating a file with subfiling, modified settings
  ! *********************************************************

  ! Testing modifying defaults for subfiling FD

  vfd_config%magic = INT(H5FD_SUBFILING_FAPL_MAGIC_F,C_INT32_T)
  vfd_config%version = INT(H5FD_SUBFILING_CURR_FAPL_VERSION_F,C_INT32_T)
  vfd_config%require_ioc = .TRUE.
  vfd_config%shared_cfg%ioc_selection = INT(SELECT_IOC_ONE_PER_NODE_F,C_INT)
  vfd_config%shared_cfg%stripe_size = 16*1024*1024
  vfd_config%shared_cfg%stripe_count = 3

  nerrors = 0
  CALL h5pset_fapl_subfiling_f(fapl_id, hdferror, vfd_config)
  CALL check("h5pset_fapl_ioc_f", hdferror, nerrors)

  CALL h5pget_fapl_subfiling_f(fapl_id, vfd_config, hdferror)
  CALL check("h5pget_fapl_ioc_f", hdferror, nerrors)

  WRITE(hex1,'(z8)') H5FD_SUBFILING_FAPL_MAGIC_F
  WRITE(hex2,'(z8)') vfd_config%magic

  IF(hex1 .NE. hex2 .OR. &
     vfd_config%version .NE. H5FD_SUBFILING_CURR_FAPL_VERSION_F .OR. &
     .NOT.vfd_config%require_ioc .OR. &
     vfd_config%shared_cfg%ioc_selection .NE. SELECT_IOC_ONE_PER_NODE_F .OR. &
     vfd_config%shared_cfg%stripe_size .NE. 16*1024*1024 .OR. &
     vfd_config%shared_cfg%stripe_count .NE. 3 &
     )THEN
     IF(mpi_rank.EQ.0) &
          WRITE(*,*) "Failed h5pget_fapl_subfiling_f"
     nerrors = nerrors + 1
  ENDIF

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Pset/get_fapl_subfiling_f with custom settings', total_error)

  vfd_config_ioc%magic   = INT(H5FD_IOC_FAPL_MAGIC_F,C_INT32_T)
  vfd_config_ioc%version = INT(H5FD_IOC_CURR_FAPL_VERSION_F,C_INT32_T)
  vfd_config_ioc%thread_pool_size = 2

  nerrors = 0
  CALL h5pset_fapl_ioc_f(vfd_config%ioc_fapl_id, hdferror, vfd_config_ioc)
  CALL check("h5pset_fapl_ioc_f", hdferror, nerrors)

  CALL h5pget_fapl_ioc_f(vfd_config%ioc_fapl_id, vfd_config_ioc, hdferror)
  CALL check("h5pget_fapl_ioc_f", hdferror, nerrors)

  IF(& !vfd_config_ioc%magic .NE. H5FD_IOC_FAPL_MAGIC_F .OR. &
     vfd_config_ioc%version .NE. H5FD_IOC_CURR_FAPL_VERSION_F .OR. &
     vfd_config_ioc%thread_pool_size .NE. 2 &
     )THEN
     IF(mpi_rank.EQ.0) &
          WRITE(*,*) "Failed h5pget_fapl_ioc_f"
     nerrors = nerrors + 1
  ENDIF
  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Pset/get_fapl_ioc_f with custom settings', total_error)

  ! *********************************************************
  ! Testing creating a file with subfiling, custom settings
  ! *********************************************************

  CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferror, access_prp = fapl_id)
  CALL check("h5pcreate_f", hdferror, nerrors)

  CALL h5fclose_f(file_id, hdferror)
  CALL check("h5fclose_f", hdferror, nerrors)

  IF(mpi_rank.EQ.0)THEN
     INQUIRE(FILE=filename, EXIST=file_exists)
     IF(.NOT.file_exists)THEN
        WRITE(*,"(A,A)") "Failed to find the stub subfile ",TRIM(filename)
        nerrors = nerrors + 1
     ENDIF
#ifdef H5_HAVE_DARWIN
     arg(1:1)="f"
#else
     arg(1:1)="c"
#endif
     CALL EXECUTE_COMMAND_LINE("stat -"//arg(1:1)//" %i "//filename//" >> tmp_inode", EXITSTAT=i)
     IF(i.ne.0)THEN
        WRITE(*,"(A,A)") "Failed to stat the stub subfile ",TRIM(filename)
        nerrors = nerrors + 1
     ENDIF

     OPEN(11,FILE="tmp_inode")
     READ(11,*) inode
     CLOSE(11,STATUS="delete")

     DO i = 1, vfd_config%shared_cfg%stripe_count
        WRITE(subfname,'(A,".subfile_",I0,"_",I0,"_of_",I0)') filename,inode,i,vfd_config%shared_cfg%stripe_count
        INQUIRE(FILE=subfname, EXIST=file_exists)
        IF(.NOT.file_exists)THEN
           WRITE(*,"(A,A)") "Failed to create the subfile ",TRIM(subfname)
           nerrors = nerrors + 1
        ENDIF
     ENDDO

  ENDIF

  CALL h5pclose_f(fapl_id, hdferror)
  CALL check("h5pclose_f", hdferror, nerrors)

  IF(mpi_rank==0) CALL write_test_status(nerrors, &
       'Testing H5Fcreate with subfiling with custom settings', total_error)

  !
  ! close HDF5 interface
  !
  CALL h5close_f(hdferror)

  IF(h5_sizeof(total_error).EQ.8_size_t)THEN
     mpi_int_type=MPI_INTEGER8
  ELSE
     mpi_int_type=MPI_INTEGER4
  ENDIF

  CALL MPI_ALLREDUCE(total_error, sum, 1_MPI_INTEGER_KIND, mpi_int_type, MPI_SUM, MPI_COMM_WORLD, mpierror)

  !
  ! close MPI
  !
  IF (sum == 0) THEN
     CALL mpi_finalize(mpierror)
     IF (mpierror .NE. MPI_SUCCESS) THEN
        WRITE(*,*) "MPI_FINALIZE  *FAILED* Process = ", mpi_rank
     ENDIF
  ELSE
     WRITE(*,*) 'Errors detected in process ', mpi_rank
     CALL mpi_abort(MPI_COMM_WORLD, 1_MPI_INTEGER_KIND, mpierror)
     IF (mpierror .NE. MPI_SUCCESS) THEN
        WRITE(*,*) "MPI_ABORT  *FAILED* Process = ", mpi_rank
     ENDIF
  ENDIF

  IF(mpi_rank==0) CALL write_test_footer()

  !
  ! end main program
  !

#else

  CALL mpi_init(mpierror)
  CALL mpi_comm_rank(MPI_COMM_WORLD, mpi_rank, mpierror)

  IF(mpi_rank==0) THEN
     CALL write_test_header("SUBFILING FORTRAN TESTING")
     CALL write_test_status( -1, 'Subfiling not enabled', total_error)
     CALL write_test_footer()
  ENDIF

  CALL mpi_finalize(mpierror)

#endif

END PROGRAM subfiling_test
