MODULE FlushStdOut

!     ------------------------------------------------------------------
!     Implementation des Modula-2 Moduls FlusthStrOut - fuer Details
!     bitte in FlushStrOut.def.m2cc nachsehen.
!
!     Implementation part of Modula-2 module - for details please see
!     FlushStrOut.def.m2cc
!     ------------------------------------------------------------------
!     Implementation by M.Riedl, GNU public licence
!     ------------------------------------------------------------------
!     $(Id)$
!     ------------------------------------------------------------------

      USE,intrinsic :: ISO_C_BINDING,only : CINT => C_INT, CPTR => C_PTR

      IMPLICIT NONE

      PRIVATE

      INTERFACE
        FUNCTION fflush(stdout) RESULT(ierr) bind(C,name="fflush")
          IMPORT CPTR,CINT
          IMPLICIT NONE
!         --------------------------------------------------------------
!         define "C" fflush function
!         --------------------------------------------------------------
          TYPE(CPTR),value :: stdout
          INTEGER(CINT)    :: ierr
        END FUNCTION fflush
      END INTERFACE

!     Mache "C" stdout in Fortran bekannt

      TYPE(CPTR), bind(C,name="stdout") :: StdOutC

!     StdOutC muss "public" sein

      PUBLIC FlushStdOutFTN,FlushStdOutC,StdOutC

CONTAINS

      SUBROUTINE FlushStdOutFTN() bind(C,name="FlushStdOutFTN")
        USE, intrinsic :: ISO_FORTRAN_ENV, only : StdOut => OUTPUT_UNIT
        IMPLICIT NONE
!       ----------------------------------------------------------------
!       Empty the buffer of Fortran OUTPUT_UNIT (write all out)
!       ----------------------------------------------------------------
        FLUSH(StdOut)
      END SUBROUTINE FlushStdOutFTN

      SUBROUTINE FlushStdOutC() bind(C,name="FlushStdOutC")
        USE, intrinsic :: ISO_FORTRAN_ENV, only : StdErr => ERROR_UNIT
        IMPLICIT NONE
!       ----------------------------------------------------------------
!       Empty the buffer of "C" stdout (write all out)
!       ----------------------------------------------------------------
        INTEGER(CINT) :: ierr
!       ----------------------------------------------------------------
        ierr = fflush(StdOutC)
        IF (ierr .NE. 0) THEN
          Write(StdErr,'(//,1X,A,//)') "*** call to fflush failed ***"
        ENDIF
      END SUBROUTINE FlushStdOutC 

END MODULE FlushStdOut