FTN4
      SUBROUTINE DBCRC(NAME,JCRC,JTMLN,JENLN
     .,ISTAT),92903-16100 REV.1805  780210
C 
C 
C     NAME:   DBCRC 
C     SOURCE: &DBCRC    92903-18112 
C     BINARY: %DBCRC    ----NONE---    PART OF  %TMSLB  92903-16100 
C 
C     PRMG:   FRANCOIS GAULLIER   HPG 
C 
C 
C     **************************************************************
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.  *
C     **************************************************************
C 
C 
C  *********************************************************************
C  *                                                                   *
C  *           THIS SUBROUTINE RETURN THE DATA-BASE-CRC AND THE        *
C  *    MAXIMUM ENTRY & ITEM LENGTH.                                   *
C  *                                                                   *
C  *       CALLING PARAMETERS  :                                       *
C  *                                                                   *
C  *              NAME  : 3 WORDS LONG BUFFER * DATA BASE NAME         *
C  *              ICRC  : CRC IS RETURN HERE                           *
C  *              ITMLN : MAXIMUM ITEM LENGTH IS RETURN HERE (WORDS)   *
C  *              ENTLN : MAXIMUM ENTRY LENGTH IS RETURN HERE (WORDS)  *
C  *              ISTAT : IF 0 SUCCESFULL OPERATION                    *
C  *                      NOT 0 IMAGE ERROR IN ISTAT                   *
C  *                                                                   *
C  *    THE DATA-BASE-CRC IDENTIFY EXACTLY A SCHEMA, ATTACHED TO       *
C  *    A TRANSACTION SPECIFICATION, IT ALLOWS TO CHECK IF THE SCHEMA  *
C  *    HAS BEEN CHANGED. THE CAPACITY, THE WRITE/READ LEVEL CAN BE    *
C  *    CHANGED WHITOUT ANY PROBLEM.                                   *
C  *                                                                   *
C  *    THE MAXIMUM CARACTERISTIQUE ARE ASSUMED AS FOLLOW:             *
C  *                                                                   *
C  *    MAXIMUM NUMBER OF DATA-SET / DATA BASE :  50                   *
C  *    MAXIMUM NUMBER OF ITEM     / DATA BASE : 255                   *
C  *    MAXIMUM NUMBER OF ITEM     / ENTRY     : 127                   *
C  *                                                                   *
C  *    MAXIMUM ENTRY LENGTH (MEDIA+DATA)        256 WORDS             *
C  *    MAXIMUM ITEM LENGTH                       63 WORDS             *
C  *                                                                   *
C  *********************************************************************
C 
C 
      DIMENSION IBUF(12)
C 
C INITIALISE
C 
      ICRC=0
      MITMLN=0
      MENTLN=0
      CALL CRC16(NAME,6,ICRC) 
C 
C  COMPUTE ITEM CHECSUM 
C 
      DO 100 I=1,255
      CALL DBINF(2HI ,2,I,IBUF) 
      IF(IBUF.EQ.125) GO TO 110 
      IF(IBUF.NE.0) GO TO 3000
      IF(IBUF(7) .GT. MITMLN)  MITMLN=IBUF(7) 
      CALL MOVEW(IBUF(2),IBUF(1),8) 
      CALL MOVEW(IBUF(6),IBUF(5),3) 
      CALL CRC16(IBUF,14,ICRC)
100   CONTINUE
110   NIT=I-1 
C 
C  DATA SETS AND LINK CHECKSUM WORD 
C 
      DO 200 I=1,50 
      CALL DBINF(2HS ,2,I,IBUF) 
      IF(IBUF.EQ.100) GO TO 230 
      IF(IBUF.NE.0) GO TO 3000
      IF(IBUF(7) .GT. MENTLN)  MENTLN=IBUF(7) 
      CALL MOVEW(IBUF(2),IBUF(1),6) 
      IBUF(5)=IBUF(6) 
      IBUF(4)=IAND(IBUF(4),377B)
      CALL CRC16(IBUF,10,ICRC)
C-----IF MASTER DATA SET, SAVE ALSO THE PATH DEFINITION 
      IF(IBUF(4).EQ.104B) GO TO 200 
      CALL DBINF(2HS ,4,I,IBUF) 
      IF(IBUF.NE.0) GO TO 3000
      CALL CRC16(IBUF(3),4*IBUF(2),ICRC)
200   CONTINUE
C 
C  RETURN RESULT TO THE USER
C 
230   JCRC=ICRC 
      JTMLN=MITMLN
      JENLN=MENTLN
      ISTAT=0 
      GO TO 3010
C 
3000  ISTAT=IBUF
3010  RETURN
      END 
      END$
    