!
! Program to demonstrate CLEARSTATUSFPQQ, a subroutine
! to clear the Intel floating point status register
! exception flags.
!
! This program uses polling to detect that a floating
! point exception has occurred.
! So build this console application with the default
! floating point exception behavior, fpe3.
!
! To build from the command line:
!
! df /debug /opt:0 clearfp.f90
!

  PROGRAM CLEARFP_DEMO

  USE DFLIB

  REAL*4 A,B,C
  INTEGER*2 STS

  A = 2.0E0
  B = 0.0E0

! Poll and display initial floating point status
  CALL GETSTATUSFPQQ(STS)
  WRITE(*,'(1X,A,Z4.4)') 'Initial fp status = ',STS

! Cause a divide-by-zero exception
! Poll and display the new floating point status
! Bit 2 of the status register (DVZ) should be set.
  C = A/B
  CALL GETSTATUSFPQQ(STS)
  WRITE(*,'(1X,A,Z4.4)') 'After div-by-zero fp status = ',STS

! If a divide by zero error occurred, clear the floating point
! status register so future exceptions can be detected.
! The flag bits and error summary bit are bits 7:0 of the register.
  IF ((STS .AND. FPSW$ZERODIVIDE) > 0) THEN
    CALL CLEARSTATUSFPQQ()
    CALL GETSTATUSFPQQ(STS)
    WRITE(*,'(1X,A,Z4.4)') 'After CLEARSTATUSFPQQ fp status = ',STS
  ENDIF

  END
