*DECK DRVBAC
      SUBROUTINE DRVBAC(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* BACKUP ONE OR MANY LINKED LISTS OR FILES.
*
* INPUT/OUTPUT PARAMETERS:
*  NENTRY : NUMBER OF LINKED LISTS AND FILES USED BY THE MODULE.
*  HENTRY : CHARACTER*12 NAME OF EACH LINKED LIST OR FILE.
*  IENTRY : =0 CLE-2000 VARIABLE; =1 LINKED LIST; =2 XSM FILE;
*           =3 SEQUENTIAL BINARY FILE; =4 SEQUENTIAL ASCII FILE;
*           =5 DIRECT ACCESS FILE.
*  JENTRY : =0 THE LINKED LIST OR FILE IS CREATED.
*           =1 THE LINKED LIST OR FILE IS OPEN FOR MODIFICATIONS;
*           =2 THE LINKED LIST OR FILE IS OPEN IN READ-ONLY MODE.
*  KENTRY : FILE UNIT NUMBER OR LINKED LIST ADDRESS.
*           DIMENSION HENTRY(NENTRY),IENTRY(NENTRY),JENTRY(NENTRY),
*           KENTRY(NENTRY)
*
*-------------------------------------- AUTHOR: A. HEBERT ; 25/03/94 ---
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      CHARACTER HENTRY(NENTRY)*12
      TYPE(C_PTR) KENTRY(NENTRY)
*----
*  LOCAL VARIABLES
*----
      TYPE(C_PTR) IPLIST,JPLIST
      INTEGER KCHAR(3)
      CHARACTER TEXT12*12,TEXT4*4,HMEDIA*12,NAMT*12
      DOUBLE PRECISION DFLOTT
*
      IF(NENTRY.LE.1) THEN
         CALL XABORT('DRVBAC: TWO PARAMETERS EXPECTED.')
      ELSE IF((IENTRY(1).NE.1).AND.(IENTRY(1).NE.2)) THEN
         CALL XABORT('DRVBAC: LHS LINKED LIST OR XSM FILE EXPECTED.')
      ELSE IF(JENTRY(1).EQ.2) THEN
         CALL XABORT('DRVBAC: LHS PARAMETER IN CREATE OR MODIFICATION '
     1   //'MODE EXPECTED.')
      ENDIF
      ITYPE=IENTRY(1)
      IPLIST=KENTRY(1)
*
      IMPX=1
      JPLIST=C_NULL_PTR
   10 CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
      IF(INDIC.EQ.10) GO TO 30
      IF(INDIC.NE.3) CALL XABORT('DRVBAC: CHARACTER DATA EXPECTED.')
      IF(TEXT4.EQ.'EDIT') THEN
         CALL REDGET(INDIC,IMPX,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('DRVBAC: INTEGER DATA EXPECTED.')
      ELSE IF(TEXT4.EQ.'STEP') THEN
*        CHANGE THE HIERARCHICAL LEVEL ON THE LCM OBJECT.
         IF(ITYPE.GT.2) CALL XABORT('DRVBAC: UNABLE TO STEP INTO A SE'
     1   //'QUENTIAL FILE.')
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVBAC: CHARACTER DATA EXPECTED.')
         IF(TEXT4.EQ.'UP') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('DRVBAC: CHARACTER DATA EXPECT'
     1      //'ED.')
            IF(IMPX.GT.0) WRITE (6,100) NAMT
            CALL LCMLEN(IPLIST,NAMT,ILONG,ITYLCM)
            IF(ILONG.GT.0) THEN
               JPLIST=LCMGID(IPLIST,NAMT)
            ELSE
               JPLIST=LCMDID(IPLIST,NAMT)
            ENDIF
         ELSE IF(TEXT4.EQ.'AT') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('DRVBAC: INTEGER EXPECTED.')
            IF(IMPX.GT.0) WRITE (6,110) NITMA
            CALL LCMLEL(IPLIST,NITMA,ILONG,ITYLCM)
            IF(ILONG.GT.0) THEN
               JPLIST=LCMGIL(IPLIST,NITMA)
            ELSE
               JPLIST=LCMDIL(IPLIST,NITMA)
            ENDIF
         ELSE
            CALL XABORT('DRVBAC: UP OR AT EXPECTED.')
         ENDIF
         IPLIST=JPLIST
      ELSE IF(TEXT4.EQ.';') THEN
         GO TO 30
      ELSE
         CALL XABORT('DRVBAC: '//TEXT4//' IS AN INVALID KEY WORD.')
      ENDIF
      GO TO 10
*
   30 CALL LCMLEN(IPLIST,'SIGNATURE',ILONG,ITYLCM)
      IF(ILONG.NE.0) THEN
         CALL LCMGET(IPLIST,'SIGNATURE',KCHAR)
         WRITE(TEXT12,'(3A4)') (KCHAR(I1),I1=1,3)
         IF(TEXT12.NE.'L_ARCHIVES') THEN
            HMEDIA=HENTRY(1)
            CALL XABORT('DRVBAC: SIGNATURE OF '//HMEDIA//' IS '//TEXT12
     1      //'. L_ARCHIVES EXPECTED.')
         ENDIF
      ELSE
         TEXT12='L_ARCHIVES'
         READ(TEXT12,'(3A4)') (KCHAR(I1),I1=1,3)
         CALL LCMPUT(IPLIST,'SIGNATURE',3,3,KCHAR)
      ENDIF
      DO 40 I=2,NENTRY
      IF((JENTRY(I).EQ.0).OR.(JENTRY(I).EQ.1)) THEN
         TEXT12=HENTRY(I)
         CALL XABORT('DRVBAC: ENTRY '//TEXT12//' IS NOT EXPECTED.')
      ELSE IF(IENTRY(I).GT.2) THEN
         CALL XABORT('DRVBAC: RHS LINKED LIST OR XSM FILE EXPECTED.')
      ELSE
         IF(IMPX.GT.0) WRITE (6,'(/17H DRVBAC: BACKUP '',A12,
     1   8H'' INTO '',A12,2H''.)') HENTRY(I),HENTRY(1)
         CALL LCMSIX(IPLIST,HENTRY(I),1)
         CALL LCMEQU(KENTRY(I),IPLIST)
         CALL LCMSIX(IPLIST,' ',2)
      ENDIF
   40 CONTINUE
      RETURN
  100 FORMAT (/27H DRVBAC: STEP UP TO LEVEL ',A12,2H'.)
  110 FORMAT (/26H DRVBAC: STEP AT COMPONENT,I6,1H.)
      END
