C----------------------------------------------------------------------
C  IOPERH - CONDITION HANDLER FOR VMS FILE OPENS; MAKE SOME ERRORS
C    NONFATAL, BUT GIVE FULL SYSTEM MESSAGE.
C
C    NO MESSAGE FOR FILE-NOT-FOUND -- THIS IS TO BE HANDLED BY CALLER.
C
C  THIS IS VMS SPECIFIC CODE; USE OF THIS CONDITION HANDLER IS
C  RESTRICTED TO VMS SYSTEMS ...
C
C  invisible to UNIX
C
#ifdef __VMS
      INTEGER*4 FUNCTION IOPERH(SIGARGS,MECHARGS)
C
      INTEGER*4 SIGARGS(*)
      INTEGER*4 MECHARGS(*)
C
      INCLUDE '($FORDEF)' ! DECLARE FOR$_ symbols   VMS-ONLY
      INCLUDE '($SSDEF)'  ! DECLARE SS$_ symbols
      INCLUDE '($STSDEF)' ! DECLARE STS$_ symbols
C
C
      save ierct,iermax
C
      data ierct/0/
      data iermax/10/
C
C--------------
C
C
      INDEX=LIB$MATCH_COND(SIGARGS(2),SS$_UNWIND,FOR$_FILNOTFOU,
     >    FOR$_OPEFAI,FOR$_NO_SUCDEV,FOR$_FILNAMSPE)
C
      IF(INDEX.EQ.0) THEN
C
C  UNRECOGNIZED ERROR CONDITION CODE -- APPLY ERROR COUNT
C
        IERCT=IERCT+1
        IF(IERCT.LT.IERMAX) THEN
          IOPERH=SS$_CONTINUE
          SIGARGS(1)=SIGARGS(1)-2
          CALL SYS$PUTMSG(SIGARGS,,,)
          SIGARGS(1)=SIGARGS(1)+2
        ELSE
C
C  ERROR COUNT EXCEEDED ==> NOT HANDLED HERE ...
C
          WRITE(6,'('' %IOPERH:  MAX ERROR COUNT EXCEEDED: '',I3)')
     >        IERMAX
          IOPERH=SS$_RESIGNAL
          RETURN                 !  RETURN TO GET DEFAULT HANDLER ...
        ENDIF
C
      ELSE IF(INDEX.EQ.1) THEN
C
C  CONTINUE UNWIND ...
C
        IOPERH=SS$_CONTINUE
        RETURN
C
      ELSE IF(INDEX.EQ.2) THEN
C
C  FNOF:  NO MESSAGE ...
C
        IOPERH=SS$_CONTINUE
C
      ELSE IF(INDEX.GT.2) THEN
C
C  OTHER FILE OPEN ERROR:  ECHO MESSAGE ...
C
        IOPERH=SS$_CONTINUE
        SIGARGS(1)=SIGARGS(1)-2
        CALL SYS$PUTMSG(SIGARGS,,,)
        SIGARGS(1)=SIGARGS(1)+2
C
      ENDIF
C
C  UNWIND - EXECUTION TO CONTINUE UNCONDITIONALLY
C  ERROR MADE KNOWN TO OPEN SUBROUTINE VIA STATUS CODE.
C
      CALL LIB$SIG_TO_RET(SIGARGS,MECHARGS)
C
      RETURN               ! END VMS ONLY CODE
#endif
C---------------------------------------------------------------
C  DUMMY UNIX VERSION
C
#ifdef __UNIX
      INTEGER FUNCTION IOPERH(IDUMMY)
      WRITE(6,9991)
 9991 FORMAT(' ?IOPERH:  NOT CALLABLE ON UNIX SYSTEM'/
     >   '  PROGRAMMING ERROR IN CALLER'/)
      CALL bad_exit
      IOPERH=-99999
      RETURN
#endif
C
      end
