! Small reproducer for a bug in impi.
!
! When the file name contains a '/', impi runs out of communicators:
!    Abort(614024975) on node 0 (rank 0 in comm 0): Fatal error in internal_Comm_dup: Unknown error class, error stack:
!    internal_Comm_dup(22523)............: MPI_Comm_dup(MPI_COMM_SELF, newcomm=000000A939AFF770) failed
!    MPIR_Comm_dup_impl(730).............:
!    MPII_Comm_dup(1199).................:
!    MPII_Comm_copy(1241)................:
!    MPIR_Get_contextid_sparse_group(609): Too many communicators (0/2048 free on this process; ignore_id=0)
! 
! Platform:
! Microsoft Windows 10 Professionnel
! Version	10.0.19045 Numéro 19045
! Processeur	Intel(R) Core(TM) i9-9820X CPU @ 3.30GHz, 3312 MHz, 10 cœur(s), 20 processeur(s) logique(s)
! 
! Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.10.0 Build 20230609_000000
! Intel(R) MPI Library for Windows* OS, Version 2021.14 Build 20241121
! 
! Compiled with:
!   ifort impi.lib b.for
! or equivalently with:
!   mpifort b.for
!

      INTEGER FUNCTION MP_UTIL_REQCOMM()

      IMPLICIT NONE

      INCLUDE 'mpif.h'

      INTEGER :: I_ERROR
      INTEGER, SAVE :: I_COMM = MPI_COMM_NULL
C----------------------------------------------------------------------------

      IF (I_COMM .EQ. MPI_COMM_NULL) THEN
         CALL MPI_COMM_DUP(MPI_COMM_WORLD, I_COMM, I_ERROR)
      ENDIF
      MP_UTIL_REQCOMM = I_COMM
      RETURN
      END

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      SUBROUTINE FD_PRNB_ECRSCT(FNAME)

      IMPLICIT NONE

      INCLUDE 'mpif.h'

      CHARACTER*(*), INTENT(IN) :: FNAME

      INTEGER :: I_ERROR
      INTEGER :: I_COMM, I_FILE
      INTEGER, SAVE :: I_MODE = MPI_MODE_WRONLY + MPI_MODE_CREATE

      INTEGER, EXTERNAL :: MP_UTIL_REQCOMM
C-----------------------------------------------------------------------

      I_COMM = MP_UTIL_REQCOMM()
      I_FILE = 0
      CALL MPI_FILE_OPEN(I_COMM,
     &                   FNAME,
     &                   I_MODE,
     &                   MPI_INFO_NULL,
     &                   I_FILE,
     &                   I_ERROR)
      CALL MPI_FILE_CLOSE(I_FILE, I_ERROR)

      IF (I_MODE .EQ. MPI_MODE_WRONLY + MPI_MODE_CREATE) THEN
         I_MODE = I_MODE - MPI_MODE_CREATE + MPI_MODE_APPEND
      END IF

      RETURN
      END

C====================================================================
C====================================================================
      PROGRAM IMPI_BUG_ON_SLASH_IN_FILENAME

      IMPLICIT NONE

      include 'mpif.h'

      INTEGER :: I, IERR

      EXTERNAL :: FD_PRNB_ECRSCT

      CALL MPI_INIT(IERR)

      WRITE(*,*) 'Writing to "..\__bug_impi.dta"'
      DO I=1,2200
         IF (MOD(I, 100) .EQ. 0) WRITE(*,*) I
         CALL FD_PRNB_ECRSCT('..\__bug_impi.dta')
      END DO
      WRITE(*,*) 'OK'
      WRITE(*,*)

      WRITE(*,*) 'Writing to "../__bug_impi.dta"'
      DO I=1,2200
         IF (MOD(I, 100) .EQ. 0) WRITE(*,*) I
         CALL FD_PRNB_ECRSCT('../__bug_impi.dta') 
      END DO
      WRITE(*,*) 'OK'
      WRITE(*,*)

      END