FTN,L 
C 
C 
C 
CC************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
CC************************************************************
C 
C 
C 
C      NAME:   HARD ERROR 
C      SOURCE: 92840 - 18059
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE  HERR(IND,IGCB,ICODE), 92840-16001 REV. 2013 790904    SY2013
C 
C     THIS PROCEDURE TAKES THE INTEGER VALUE IN ICODE AND INDEXES 
C  INTO THE ERROR MASK BUFFER TO GET THE MASK WORD AND BIT OF 
C  INTEREST. SOFT ERRORS ARE UPDATED TO FIRM ERRORS FOR REPORTING       EM1901
C  PURPOSES.                                                            EM1901
C 
      DIMENSION IEBUF(4),IESOFT(4)                                      EM1901
C 
      DATA MAXER/64/                                                    EM1901
      DATA IERR/27/ 
      DATA IREAD/1/                                                     EM1901
      DATA IWRIT/2/                                                     EM1901
C 
C INITIALIZE THE SOFT ERROR MASK. WORD 1 HAS ERRORS 16-1, WORD 2, 32-17 EM1901
C WORD 3, 48-33, AND WORD 4, 64-49, AS IN THE GCB ERROR MASK.           EM1901
C BIT IS TURNED ON IF CORRESPONDING ERROR IS SOFT BUG, OFF IF ERROR IS  EM1901
C HARD, FIRM, OR NON-EXISTENT.                                          EM1901
C 
C SY2013 CHANGED IESOFT(1) FROM 42200B TO 52200B. (ERROR 13 IS SOFT)
C 
      DATA IESOFT/52200B,4771B,1B,0/                                    EM1901
C 
C 
CCCC
C     THIS CALL ESTABLISHES AN ADDRESS LINK BETWEEN THE GRAPGHICS 
C  PACKAGE AND THE CURRENT GCB AND ALSO CHECKS FOR A SUSPENDED GCB. 
C 
      ISUSP= 0
      CALL GCBIM(99,1,IGCB,ISUSP) 
      IF(ISUSP.NE.0)RETURN
C 
C RETURN ERROR 32 IF REQUEST IS FOR REPORTING OF OBVIOUSLY NON-SOFT     EM1901
C ERRORS. NEGATIVE NUMBERS ARE RESERVED FOR FMP ERRORS AND WE ONLY HAVE EM1901
C 4 WORDS WITH 64 BITS IN GCB'S ERROR MASK. 
      IF(ICODE.LE.0.OR.ICODE.GT.MAXER)GO TO 800 
C 
C COMPUTE MASK BIT AND WORD INDEX INTO A 4 WORD ERROR MASK              EM1901
      IMPY = MOD(ICODE,16)
      INDX = ICODE/16 + 1 
      IF(IMPY)60,50,60
50    INDX = INDX -1
      IMSK = 100000B
      GO TO 65
60    IMSK = 2**(IMPY -1) 
C 
C SEE IF ERROR IN QUESTION IS A LEGAL SOFT ERROR BY APPLYING THE MASK   EM1901
C TO THE SOFT ERROR STRING.  IF IT ISN'T, THEN REPORT AN ERROR 32.      EM1901
 65   ITST = IAND(IESOFT(INDX),IMSK)
      IF (ITST.EQ.0) GO TO 800
C 
C RETRIEVE THE ERROR MASK FROM THE GCB                                  EM1901
      CALL GCBIM(IERR,1,IEBUF,0,IREAD)                                  EM1901
C 
C MAKE FIRM BY TURNING ON BIT IN GCB'S ERROR MASK.  NOTE, IT IS NOT AN  EM1901
C ERROR TO REQUEST HDERR OF THE SAME SOFT ERROR TWICE, SO DON'T CHECK   EM1901
C BITS STATE TO SAVE OVERHEAD, AS DOUBLE SETTING WON'T HAPPEN OFTEN.    EM1901
      IEBUF(INDX) = IOR(IEBUF(INDX),IMSK)                               EM1901
      CALL GCBIM(IERR,1,IEBUF,0,IWRIT)                                  EM1901
      RETURN
800   CALL PLTER(32)
      RETURN
      END 
      END$
C 
                                                                                                                                                                    