CTITLEUSDBCK -- CHECK RETURN STATUS OF M204 HOST LANGUAGE ROUTINE
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CA    AUTHOR       J. M. PONTON
CA    DESIGNER     J. M. PONTON
CA    LANGUAGE     VSFORTRAN
CA    SYSTEM       IBM S/370
CA    WRITTEN      02-07-85
C     REVISED      MO-DA-YR BY PROGRAMMER FOR REASON
C     REVISED      08-20-85 BY JMP - ADD TABLE OF SUBROUTINE NAMES AND
C                                    ERROR CODES TO ALLOW NON-ZERO
C                                    RETURN CODES.
C     REVISED      08-19-85 RSK. CHANGED IFAM CALL TO USE 'M204EX' TO   00070000
C                           ALLOW FOR CALLER IN ANY AMODE.              00080000
CA
CA    CALL USDBCK(SUBNAM, IRC, *LAB)
CA
CA    IN/OUT  ARGUMENT  TYPE  DESCRIPTION
CA    ------  --------  ----  -----------
CA    IN      SUBNAM    CHAR  NAME OF THE HOST LANGUAGE SUBROUTINE THAT
CA                            WAS CALLED LAST.
CA
CA    IN      IRC       I4    ROUTINE CODE FROM HOST LANGUAGE ROUTINE.
CA
CA    IN      *LAB            STATEMENT LABEL TO RETURN TO IF RETURN
CA                            CODE IS NONZERO.
CA
CA    THIS SUBROUTINE CHECKS THE RETURN CODE OF A HOST LANGUAGE INTER-
CA    FACE ROUTINE. IF IRC = 0, USDBCK MERELY RETURNS TO THE CALLING
CA    PROGRAM. IF IT IS NONZERO, IT PRINTS AN ERROR MESSAGE AND RETURNS
CA    TO THE STATEMENT LABEL IN THE THIRD ARGUMENT.
CA
CA    IF IRC ^=0, A TABLE OF SUBROUTINE NAMES AND RETURN CODES IS
CA    CHECKED. IF 'SUBNAM' AND IRC IS IN THIS TABLE, THE ERROR MESSAGE
CA    IS NOT PRINTED.
CA
C     EJECT
C
      SUBROUTINE USDBCK(SUBNAM, IRC, *)
C
      IMPLICIT INTEGER (A-Z)
C
      CHARACTER*6   SUBNAM
      CHARACTER*80  MSG
      CHARACTER*6   SUBTAB(1)
      DIMENSION     RCTAB(1)
C
      DATA M2GERR /7/                                                   00350000
      DATA LTAB/1/
      DATA SUBTAB/'IFOPEN'/
      DATA RCTAB/16/
C
      IF (IRC .EQ. 0) RETURN
C
C         CHECK FOR SUBNAM IN SUBTAB FOR NON-ZERO RETURN CODES.
C
      DO 10 I = 1, LTAB
      IF (SUBNAM .EQ. SUBTAB(I) .AND. RCTAB(I) .EQ. IRC) RETURN
   10 CONTINUE
C
   20 CONTINUE
C
      WRITE (6,30) SUBNAM, IRC
   30 FORMAT(' *** ERROR *** ',A6,': RETURN CODE = ',I6)
      CALL M204EX(M2GERR, IRC, MSG)
      WRITE (6,40) MSG
   40 FORMAT(' *** MESSAGE FROM IFGERR ***',/,1X,A80)
C
      RETURN 1
      END