*DECK DRVUTL
      SUBROUTINE DRVUTL(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* STANDARD UTILITY MODULE FOR LINKED LIST OR XSM 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.
*  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; =LINKED LIST ADDRESS OTHERWISE.
*           DIMENSION HENTRY(NENTRY),IENTRY(NENTRY),JENTRY(NENTRY),
*           KENTRY(NENTRY)
*
* LIST OF UTILITY ACTIONS:
*   IMPR : PRINT A BLOCK.
*   COPY : COPY A BLOCK OR A DIRECTORY.
*   CREA : CREATE A BLOCK.
*   DEL  : DELETE A BLOCK.
*   STAT : COMPARE TWO BLOCKS.
*   ADD  : ADD TWO FLOATING POINT BLOCKS OR DIRECTORIES COMPONENT BY
*          COMPONENT.
*   MULT : MULTIPLY THE FLOATING POINT COMPONENTS OF A BLOCK OR
*          DIRECTORY BY A CONSTANT.
*   STEP : CHANGE OF DIRECTORY LEVEL.
*   DIR  : PRINT THE ACTIVE DIRECTORY CONTENT.
*   DUMP : DUMP THE ACTIVE AND SON DIRECTORIES ON THE PRINTER.
*
*-------------------------------------- AUTHOR: A. HEBERT ; 03/02/88 ---
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER :: NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR) :: KENTRY(NENTRY)
      CHARACTER :: HENTRY(NENTRY)*12
*----
*  LOCAL VARIABLES
*----
      INTEGER, PARAMETER :: MAXLEV=50
      TYPE(C_PTR) :: IPLIST,IPLIS1,IPKEEP(MAXLEV)
      CHARACTER :: TEXT4*4,NAMT*12,NAMT2*12,NAMMY*12,NAMLCM*72,
     1             CTYP(3)*11,CENT(3)*9,HSMG*131,TEXT12*12
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IARA
      REAL, ALLOCATABLE, DIMENSION(:) :: ARA,ARA2
      DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: DARA
      COMPLEX, ALLOCATABLE, DIMENSION(:) :: CARA
      LOGICAL, ALLOCATABLE, DIMENSION(:) :: LARA
      DOUBLE PRECISION :: DFLOTT
      LOGICAL :: EMPTY,LCM
      DATA (CTYP(ITY),ITY=1,3)/'CLE_2000','LINKED_LIST','XSM_FILE'/
      DATA (CENT(ITY),ITY=1,3)/'CREATE','IN_OUT','READ-ONLY'/
      SAVE CTYP,CENT
*----
*  PARAMETER VALIDATION.
*----
      IF(NENTRY.EQ.0) CALL XABORT('DRVUTL: PARAMETER EXPECTED.')
      TEXT12=HENTRY(1)
      IF(JENTRY(1).EQ.0) THEN
         IF(IENTRY(1).GT.2) CALL XABORT('DRVUTL: THE UTILITY MODULE WO'
     1   //'RKS ONLY WITH LINKED LISTS AND XSM FILES ('//TEXT12//').')
      ELSE IF(JENTRY(1).EQ.1) THEN
         IF(IENTRY(1).GT.2) CALL XABORT('DRVUTL: THE UTILITY MODULE WO'
     1   //'RKS ONLY WITH LINKED LISTS AND XSM FILES ('//TEXT12//').')
      ELSE IF(JENTRY(1).EQ.2) THEN
         IF(IENTRY(1).GT.2) CALL XABORT('DRVUTL: THE UTILITY MODULE WO'
     1   //'RKS ONLY WITH LINKED LISTS AND XSM FILES ('//TEXT12//').')
      ENDIF
      IND=JENTRY(1)
      ITYPE=IENTRY(1)
      IPLIST=KENTRY(1)
      IPKEEP(1)=IPLIST
      ILEV=1
      CALL LCMINF(IPLIST,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
      WRITE(6,180) CTYP(ITYPE+1),CENT(IND+1),NAMMY,NAMLCM
      FLUSH(6)
*----
*  PERFORM SOME UTILITY ACTIONS.
*----
   10 CALL REDGET(INDIC,NITMA,DPREC,TEXT4,DFLOTT)
      IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
      IF(TEXT4.EQ.'IMPR') THEN
*        PRINT A LCM OR XSM BLOCK.
         CALL REDGET(INDPRT,ISET,FLOTT,NAMT,DFLOTT)
         IF(INDPRT.EQ.1) THEN
            CALL LCMLEL(IPLIST,ISET,ILONG,ITYBLK)
            IF(ILONG.EQ.0) THEN
               WRITE (6,245) ISET
               CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
               GO TO 10
            ENDIF
         ELSE IF(INDPRT.EQ.3) THEN
            CALL LCMLEN(IPLIST,NAMT,ILONG,ITYBLK)
            IF(ILONG.EQ.0) THEN
               WRITE (6,250) NAMT
               CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
               GO TO 10
            ENDIF
         ELSE
            CALL XABORT('DRVUTL: BLOCK-NAME OR LIST INDEX EXPECTED.')
         ENDIF
         IF(ITYBLK.EQ.10) CALL XABORT('DRVUTL: '//NAMT//' IS A LIST OF'
     1   //' ARRAYS. USE A STEP UP KEYWORD TO ACCESS THE LIST.')
         IF((ITYBLK.EQ.1).OR.(ITYBLK.EQ.3).OR.(ITYBLK.EQ.5)) THEN
            ALLOCATE(IARA(ILONG))
            IF(INDPRT.EQ.1) THEN
               CALL LCMGDL(IPLIST,ISET,IARA)
            ELSE IF(INDPRT.EQ.3) THEN
               CALL LCMGET(IPLIST,NAMT,IARA)
            ENDIF
         ELSE IF(ITYBLK.EQ.2) THEN
            ALLOCATE(ARA(ILONG))
            IF(INDPRT.EQ.1) THEN
               CALL LCMGDL(IPLIST,ISET,ARA)
            ELSE IF(INDPRT.EQ.3) THEN
               CALL LCMGET(IPLIST,NAMT,ARA)
            ENDIF
         ELSE IF(ITYBLK.EQ.4) THEN
            ALLOCATE(DARA(ILONG/2))
            IF(INDPRT.EQ.1) THEN
               CALL LCMGDL(IPLIST,ISET,DARA)
            ELSE IF(INDPRT.EQ.3) THEN
               CALL LCMGET(IPLIST,NAMT,DARA)
            ENDIF
         ELSE IF(ITYBLK.EQ.6) THEN
            ALLOCATE(CARA(ILONG/2))
            IF(INDPRT.EQ.1) THEN
               CALL LCMGDL(IPLIST,ISET,CARA)
            ELSE IF(INDPRT.EQ.3) THEN
               CALL LCMGET(IPLIST,NAMT,CARA)
            ENDIF
         ELSE
            CALL XABORT('DRVUTL: IMPR TYPE NOT SUPPORTED.')
         ENDIF
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         LL=99999999
         IF(INDIC.EQ.1) THEN
            LL=NITMA
         ELSE IF(INDIC.NE.3) THEN
           CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         ELSE IF(TEXT4.NE.'*') THEN
           CALL XABORT('DRVUTL: CHARACTER * EXPECTED.')
         ENDIF
         ICONT=0
         IMAX=MIN0(LL,ILONG)
         IF(ITYBLK.EQ.1) THEN
           DO I=1,ILONG
             IF(IARA(I).NE.0) ICONT=ICONT+1
           ENDDO
         ELSE IF(ITYBLK.EQ.2) THEN
           DO I=1,ILONG
             IF(ARA(I).NE.0.0) ICONT=ICONT+1
           ENDDO
         ELSE IF(ITYBLK.EQ.4) THEN
           DO I=1,ILONG/2
             IF(DARA(I).NE.0.0D0) ICONT=ICONT+1
           ENDDO
           IMAX=MIN0(LL,ILONG/2)
         ELSE IF(ITYBLK.EQ.6) THEN
           DO I=1,ILONG/2
             IF(CARA(I).NE.0.0) ICONT=ICONT+1
           ENDDO
           IMAX=MIN0(LL,ILONG/2)
         ENDIF
         IF(INDPRT.EQ.1) THEN
            WRITE (6,225) ISET,ILONG,ICONT
         ELSE IF(INDPRT.EQ.3) THEN
            WRITE (6,230) NAMT,ILONG,ICONT
         ENDIF
         IF((IMAX.GT.0).AND.(ITYBLK.EQ.1)) THEN
            WRITE (6,'(1X,13I10)') (IARA(I),I=1,IMAX)
         ELSE IF((IMAX.GT.0).AND.(ITYBLK.EQ.2)) THEN
            WRITE (6,'(1X,1P,10E13.4)') (ARA(I),I=1,IMAX)
         ELSE IF((IMAX.GT.0).AND.(ITYBLK.EQ.3)) THEN
            WRITE (6,'(1X,32A4)') (IARA(I),I=1,IMAX)
         ELSE IF((IMAX.GT.0).AND.(ITYBLK.EQ.4)) THEN
            WRITE(6,'(1X,1P,6D21.12)') (DARA(I),I=1,IMAX)
         ELSE IF((IMAX.GT.0).AND.(ITYBLK.EQ.5)) THEN
            WRITE(6,'(1X,65L2)') (IARA(I),I=1,IMAX)
         ELSE IF((IMAX.GT.0).AND.(ITYBLK.EQ.6)) THEN
            WRITE(6,'(1X,1P,4(2H (,E13.4,1H,,E13.4,1H)))')
     1      (REAL(CARA(I)),AIMAG(CARA(I)),I=1,IMAX)
         ELSE IF((IMAX.GT.0).AND.(ITYBLK.EQ.0)) THEN
            WRITE (6,240) NAMT
         ENDIF
         WRITE (6,'(/)')
         IF((ITYBLK.EQ.1).OR.(ITYBLK.EQ.3).OR.(ITYBLK.EQ.5)) THEN
            DEALLOCATE(IARA)
         ELSE IF(ITYBLK.EQ.2) THEN
            DEALLOCATE(ARA)
         ELSE IF(ITYBLK.EQ.4) THEN
            DEALLOCATE(DARA)
         ELSE IF(ITYBLK.EQ.6) THEN
            DEALLOCATE(CARA)
         ENDIF
      ELSE IF(TEXT4.EQ.'COPY') THEN
*        COPY AND NAME A BLOCK OR DIRECTORY ON LCM OR XSM.
         IF(IND.EQ.2) CALL XABORT('DRVUTL: COPY IS A FORBIDDEN OPERATIO'
     1   //'N IN READ-ONLY MODE.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT2,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL LCMLEN(IPLIST,NAMT,ILONG,ITYBLK)
         IF(ILONG.EQ.-1) THEN
*           COPY A COMPLETE DIRECTORY.
            CALL LCMSIX(IPLIST,NAMT,1)
            NUNIT=KDROPN('DUMMYSQ',0,2,0)
            IF(NUNIT.LE.0) CALL XABORT('DRVUTL: KDROPN FAILURE.')
            CALL LCMEXP(IPLIST,0,NUNIT,1,1)
            REWIND(NUNIT)
            CALL LCMSIX(IPLIST,' ',2)
            CALL LCMSIX(IPLIST,NAMT2,1)
            CALL LCMEXP(IPLIST,0,NUNIT,1,2)
            IRC=KDRCLS(NUNIT,2)
            IF(IRC.LT.0) CALL XABORT('DRVUTL: KDRCLS FAILURE.')
            CALL LCMSIX(IPLIST,' ',2)
         ELSE IF(ILONG.GT.0) THEN
*           COPY A SINGLE RECORD.
            ALLOCATE(IARA(ILONG))
               CALL LCMGET(IPLIST,NAMT,IARA)
               CALL LCMPUT(IPLIST,NAMT2,ILONG,ITYBLK,IARA)
            DEALLOCATE(IARA)
         ELSE IF(ILONG.EQ.0) THEN
            CALL XABORT('DRVUTL: '''//NAMT//''' IS NOT STORED ON LCM O'
     1      //'R XSM.')
         ENDIF
      ELSE IF(TEXT4.EQ.'CREA') THEN
         IF(IND.EQ.2) CALL XABORT('DRVUTL: CREA IS A FORBIDDEN OPERATIO'
     1   //'N IN READ-ONLY MODE.')
         CALL REDGET(NTYPE,ISET,FLOTT,NAMT,DFLOTT)
         INDICO=0
         IF(NTYPE.EQ.1) THEN
            CALL LCMLEL(IPLIST,ISET,ILONG0,INDICO)
         ELSE IF(NTYPE.EQ.3) THEN
            CALL LCMLEN(IPLIST,NAMT,ILONG0,INDICO)
         ELSE
            CALL XABORT('DRVUTL: INTEGER OR CHARACTER DATA EXPECTED.')
         ENDIF
         CALL REDGET(INDIC,ILONG2,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.1) CALL XABORT('DRVUTL: INTEGER DATA EXPECTED.')
         ILONG1=1
   30    CALL REDGET(INDIC,ILONG,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.EQ.1) THEN
            IF(ILONG0.EQ.0) CALL XABORT('DRVUTL: LOWER INDEX NOT EXPEC'
     1      //'TED.')
            ILONG1=ILONG2
            ILONG2=ILONG
            GO TO 30
         ELSE IF((INDIC.NE.3).OR.(TEXT4.NE.'=')) THEN
            CALL XABORT('DRVUTL: = SIGN EXPECTED.')
         ENDIF
         CALL REDGET(INDIC,NITMA,FLOAT,TEXT4,DFLOTT)
         IF(INDICO.EQ.99) THEN
            INDICO=INDIC
         ELSE IF(INDIC.NE.INDICO) THEN
            CALL XABORT('DRVUTL: INCONSISTENT DATA TYPE(1).')
         ENDIF
         IF(INDIC.EQ.1) THEN
            ALLOCATE(IARA(MAX(ILONG2,ILONG0)))
            IF((ILONG0.NE.0).AND.(NTYPE.EQ.1)) THEN
               CALL LCMGDL(IPLIST,ISET,IARA)
            ELSE IF((ILONG0.NE.0).AND.(NTYPE.EQ.3)) THEN
               CALL LCMGET(IPLIST,NAMT,IARA)
            ENDIF
            IARA(ILONG1)=NITMA
         ELSE IF(INDIC.EQ.2) THEN
            ALLOCATE(ARA(MAX(ILONG2,ILONG0)))
            IF((ILONG0.NE.0).AND.(NTYPE.EQ.1)) THEN
               CALL LCMGDL(IPLIST,ISET,ARA)
            ELSE IF((ILONG0.NE.0).AND.(NTYPE.EQ.3)) THEN
               CALL LCMGET(IPLIST,NAMT,ARA)
            ENDIF
            ARA(ILONG1)=FLOAT
         ELSE IF(INDIC.EQ.3) THEN
            ALLOCATE(IARA(MAX(ILONG2,ILONG0)))
            IF((ILONG0.NE.0).AND.(NTYPE.EQ.1)) THEN
               CALL LCMGDL(IPLIST,ISET,IARA)
            ELSE IF((ILONG0.NE.0).AND.(NTYPE.EQ.3)) THEN
               CALL LCMGET(IPLIST,NAMT,IARA)
            ENDIF
            READ(TEXT4,'(A4)') IARA(ILONG1)
         ELSE IF(INDIC.EQ.4) THEN
            ALLOCATE(DARA(MAX(ILONG2,ILONG0/2)))
            IF((ILONG0.NE.0).AND.(NTYPE.EQ.1)) THEN
               CALL LCMGDL(IPLIST,ISET,DARA)
            ELSE IF((ILONG0.NE.0).AND.(NTYPE.EQ.3)) THEN
               CALL LCMGET(IPLIST,NAMT,DARA)
            ENDIF
            DARA(ILONG1)=DFLOTT
         ELSE IF(INDIC.EQ.5) THEN
            ALLOCATE(LARA(MAX(ILONG2,ILONG0)))
            IF((ILONG0.NE.0).AND.(NTYPE.EQ.1)) THEN
               CALL LCMGDL(IPLIST,ISET,LARA)
            ELSE IF((ILONG0.NE.0).AND.(NTYPE.EQ.3)) THEN
               CALL LCMGET(IPLIST,NAMT,LARA)
            ENDIF
            IF (NITMA.EQ.1) THEN 
              LARA(ILONG1)=.TRUE.
            ELSE
              LARA(ILONG1)=.FALSE.
            ENDIF
         ENDIF
         DO I=ILONG1+1,ILONG2
            CALL REDGET(INDIC,NITMA,FLOAT,TEXT4,DFLOTT)
            IF(INDIC.NE.INDICO) THEN
               CALL XABORT('DRVUTL: INCONSISTENT DATA TYPE(2).')
            ELSE IF(INDIC.EQ.1) THEN
               IARA(I)=NITMA
            ELSE IF(INDIC.EQ.2) THEN
               ARA(I)=FLOAT
            ELSE IF(INDIC.EQ.3) THEN
               READ(TEXT4,'(A4)') IARA(I)
            ELSE IF(INDIC.EQ.4) THEN
               DARA(I)=DFLOTT
            ELSE IF(INDIC.EQ.5) THEN
               IF (NITMA.EQ.1) THEN 
                 LARA(I)=.TRUE.
               ELSE
                 LARA(I)=.FALSE.
               ENDIF
            ENDIF
         ENDDO
         IF(NTYPE.EQ.1) THEN
            IF(INDICO.EQ.1) THEN
               CALL LCMPDL(IPLIST,ISET,MAX(ILONG2,ILONG0),INDICO,IARA)
               DEALLOCATE(IARA)
            ELSE IF(INDICO.EQ.2) THEN
               CALL LCMPDL(IPLIST,ISET,MAX(ILONG2,ILONG0),INDICO,ARA)
               DEALLOCATE(ARA)
            ELSE IF(INDICO.EQ.3) THEN
               CALL LCMPDL(IPLIST,ISET,MAX(ILONG2,ILONG0),INDICO,IARA)
               DEALLOCATE(IARA)
            ELSE IF(INDICO.EQ.4) THEN
               CALL LCMPDL(IPLIST,ISET,MAX(2*ILONG2,ILONG0),INDICO,DARA)
               DEALLOCATE(DARA)
            ELSE IF(INDICO.EQ.5) THEN
               CALL LCMPDL(IPLIST,ISET,MAX(ILONG2,ILONG0),INDICO,LARA)
               DEALLOCATE(LARA)
            ENDIF
         ELSE IF(NTYPE.EQ.3) THEN
            IF(INDICO.EQ.1) THEN
               CALL LCMPUT(IPLIST,NAMT,MAX(ILONG2,ILONG0),INDICO,IARA)
               DEALLOCATE(IARA)
            ELSE IF(INDICO.EQ.2) THEN
               CALL LCMPUT(IPLIST,NAMT,MAX(ILONG2,ILONG0),INDICO,ARA)
               DEALLOCATE(ARA)
            ELSE IF(INDICO.EQ.3) THEN
               CALL LCMPUT(IPLIST,NAMT,MAX(ILONG2,ILONG0),INDICO,IARA)
               DEALLOCATE(IARA)
            ELSE IF(INDICO.EQ.4) THEN
               CALL LCMPUT(IPLIST,NAMT,MAX(2*ILONG2,ILONG0),INDICO,DARA)
               DEALLOCATE(DARA)
            ELSE IF(INDICO.EQ.5) THEN
               CALL LCMPUT(IPLIST,NAMT,MAX(ILONG2,ILONG0),INDICO,LARA)
               DEALLOCATE(LARA)
            ENDIF
         ENDIF
      ELSE IF(TEXT4.EQ.'DEL') THEN
*        DELETE A BLOCK.
         IF(IND.EQ.2) CALL XABORT('DRVUTL: DEL IS A FORBIDDEN OPERATION'
     1   //' IN READ-ONLY MODE.')
         IF(ITYPE.GT.1) CALL XABORT('DRVUTL: DEL CAN ONLY BE USED WITH '
     1   //'LINKED-LISTS.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL LCMDEL(IPLIST,NAMT)
      ELSE IF(TEXT4.EQ.'STAT') THEN
*        COMPARE TWO BLOCKS STORED ON LCM OR XSM.
*        READ RELATIVE OR ABSOLUTE ERROR.
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
*        RECOVERY OF THE FIRST BLOCK.
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL LCMLEN(IPLIST,NAMT,ILONG1,IT1BLK)
         IF(IT1BLK.NE.2) CALL XABORT('DRVUTL: '''//NAMT//''' IS NOT OF'
     1   //' REAL TYPE.')
         ALLOCATE(ARA(ILONG1))
         CALL LCMGET(IPLIST,NAMT,ARA)
*        RECOVERY OF THE SECOND BLOCK.
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL LCMLEN(IPLIST,NAMT,ILONG2,IT2BLK)
         IF(ILONG2.NE.ILONG1) THEN
           CALL XABORT('DRVUTL: THE 2 BLOCKS ARE OF DIFFERENT LENGTH.')
         ELSE IF(IT1BLK.NE.IT2BLK) THEN
           CALL XABORT('DRVUTL: THE 2 BLOCKS ARE OF DIFFERENT TYPES.')
         ENDIF
         ALLOCATE(ARA(ILONG2))
         CALL LCMGET(IPLIST,NAMT,ARA2)
*        COMPARE THE TWO BLOCKS.
         EPSMAX=0.0
         EPSAVG=0.0
         IF(TEXT4(1:3).EQ.'REL') THEN
             WRITE (6,200) 'RELATIVE'
             DO I=1,ILONG1
                IF(ARA2(I).NE.0.0) THEN
                   ABSEP=ABS((ARA(I)-ARA2(I))/ARA2(I))
                ELSE
                   ABSEP=0.0
                ENDIF
                IF(EPSMAX.LT.ABSEP) THEN
                   EPSMAX=ABSEP
                   INGRO=I
                ENDIF
                EPSAVG=EPSAVG+ABSEP
             ENDDO
             EPSMAX=100.0*EPSMAX
             EPSAVG=100.0*EPSAVG/REAL(ILONG1)
             WRITE (6,210) ILONG1,EPSMAX,INGRO,EPSAVG
          ELSE IF(TEXT4(1:3).EQ.'ABS') THEN
             WRITE (6,200) 'ABSOLUTE'
             DO I=1,ILONG1
                ABSEP=ABS(ARA(I)-ARA2(I))
                IF(EPSMAX.LT.ABSEP) THEN
                   EPSMAX=ABSEP
                   INGRO=I
                ENDIF
                EPSAVG=EPSAVG+ABSEP
             ENDDO
             EPSAVG=EPSAVG/REAL(ILONG1)
             WRITE (6,220) ILONG1,EPSMAX,INGRO,EPSAVG
         ELSE
            CALL XABORT('DRVUTL: CHOOSE RELATIVE OR ABSOLUTE')
         ENDIF
         DEALLOCATE(ARA2)
         DEALLOCATE(ARA)
      ELSE IF(TEXT4.EQ.'ADD') THEN
*        ADD TWO BLOCKS OR DIRECTORIES STORED ON LCM OR XSM.
*        RECOVERY OF THE FIRST BLOCK.
         IF(IND.EQ.2) CALL XABORT('DRVUTL: ADD IS A FORBIDDEN OPERATIO'
     1   //'N IN READ-ONLY MODE.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT2,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         CALL LCMLEN(IPLIST,NAMT,ILONG1,IT1BLK)
         IF(ILONG1.EQ.-1) THEN
*           ADD TWO DIRECTORIES.
            NUNIT=KDROPN('DUMMYSQ',0,2,0)
            IF(NUNIT.LE.0) CALL XABORT('DRVUTL: KDROPN FAILURE.')
            CALL LCMEXP(IPLIST,0,NUNIT,1,1)
            REWIND(NUNIT)
            CALL LCMOP(IPLIS1,'DUMMYDA',0,1,0)
            CALL LCMEXP(IPLIS1,0,NUNIT,1,2)
            IRC=KDRCLS(NUNIT,2)
            IF(IRC.LT.0) CALL XABORT('DRVUTL: KDRCLS FAILURE.')
            CALL LCMSIX(IPLIS1,NAMT,1)
            CALL LCMSIX(IPLIST,NAMT2,1)
            CALL LCMADD(IPLIS1,IPLIST)
            CALL LCMSIX(IPLIS1,' ',2)
            CALL LCMSIX(IPLIST,' ',2)
            CALL LCMCL(IPLIS1,2)
         ELSE IF(ILONG1.GT.0) THEN
*           ADD TWO RECORDS.
            IF(IT1BLK.NE.2) CALL XABORT('DRVUTL: '''//NAMT//''' IS NOT'
     1      //' OF REAL TYPE.')
            CALL LCMLEN(IPLIST,NAMT2,ILONG2,IT2BLK)
            IF(ILONG2.NE.ILONG1) THEN
               CALL XABORT('DRVUTL: THE 2 BLOCKS ARE OF DIFFERENT LENGT'
     1         //'H.')
            ELSE IF(IT1BLK.NE.IT2BLK) THEN
               CALL XABORT('DRVUTL: THE 2 BLOCKS ARE OF DIFFERENT TYPE'
     1         //'S.')
            ENDIF
            ALLOCATE(ARA(ILONG1))
            CALL LCMGET(IPLIST,NAMT,ARA)
            ALLOCATE(ARA(ILONG2))
            CALL LCMGET(IPLIST,NAMT,ARA2)
            ARA2(:ILONG2)=ARA(:ILONG2)+ARA2(:ILONG2)
            CALL LCMPUT(IPLIST,NAMT2,ILONG2,IT1BLK,ARA2)
            DEALLOCATE(ARA2)
            DEALLOCATE(ARA)
         ELSE IF(ILONG1.EQ.0) THEN
            CALL XABORT('DRVUTL: '''//NAMT//''' IS NOT STORED.')
         ENDIF
      ELSE IF(TEXT4.EQ.'MULT') THEN
*        MULTIPLY AN LCM OR XSM BLOCK OR DIRECTORY BY A CONSTANT.
*        RECOVERY OF A BLOCK OR DIRECTORY.
         IF(IND.EQ.2) CALL XABORT('DRVUTL: MULT IS A FORBIDDEN OPERATIO'
     1   //'N IN READ-ONLY MODE.')
         CALL REDGET(NTYPE,ISET,FLOTT,NAMT,DFLOTT)
         IF(NTYPE.EQ.1) THEN
            CALL LCMLEL(IPLIST,ISET,ILONG1,ITYBLK)
         ELSE IF(NTYPE.EQ.3) THEN
            CALL LCMLEN(IPLIST,NAMT,ILONG1,ITYBLK)
         ELSE
            CALL XABORT('DRVUTL: INTEGER OR CHARACTER DATA EXPECTED.')
         ENDIF
*        READ A NUMBER.
         CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
         IF(INDIC.EQ.3) CALL XABORT('DRVUTL: INTEGER OR REAL NUMBER EX'
     1   //'PECTED.')
         IF(INDIC.EQ.1) FLOTT=REAL(NITMA)
         CALL LCMLEN(IPLIST,NAMT,ILONG1,ITYBLK)
         IF(ILONG1.EQ.-1) THEN
*           MULTIPLY A DIRECTORY FLOATTING CONTENT BY A REAL NUMBER.
            IF(NTYPE.EQ.1) THEN
               IPLIS1=LCMDIL(IPLIST,ISET)
            ELSE IF(NTYPE.EQ.3) THEN
               IPLIS1=LCMDID(IPLIST,NAMT)
            ENDIF
            CALL LCMULT(IPLIS1,FLOTT)
         ELSE IF(ILONG1.GT.0) THEN
*           MULTIPLY A REAL RECORD BY A REAL NUMBER.
            IF(ITYBLK.NE.2) CALL XABORT('DRVUTL: '''//NAMT//''' IS NOT'
     1      //' OF REAL TYPE.')
            ALLOCATE(ARA(ILONG1))
            IF(NTYPE.EQ.1) THEN
               CALL LCMGDL(IPLIST,ISET,ARA)
            ELSE IF(NTYPE.EQ.3) THEN
               CALL LCMGET(IPLIST,NAMT,ARA)
            ENDIF
            ARA(:ILONG1)=ARA(:ILONG1)*FLOTT
            IF(NTYPE.EQ.1) THEN
               CALL LCMPDL(IPLIST,ISET,ILONG1,ITYBLK,ARA)
            ELSE IF(NTYPE.EQ.3) THEN
               CALL LCMPUT(IPLIST,NAMT,ILONG1,ITYBLK,ARA)
            ENDIF
            DEALLOCATE(ARA)
         ELSE IF(ILONG1.EQ.0) THEN
            CALL XABORT('DRVUTL: '''//NAMT//''' IS NOT STORED.')
         ENDIF
      ELSE IF(TEXT4.EQ.'STEP') THEN
*        CHANGE THE HIERARCHICAL LEVEL ON THE LCM OR XSM FILE.
         CALL REDGET(INDIC,NITMA,FLOTT,TEXT4,DFLOTT)
         IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECTED.')
         IF(TEXT4.EQ.'UP') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
            IF(INDIC.NE.3) CALL XABORT('DRVUTL: CHARACTER DATA EXPECT'
     1      //'ED.')
            WRITE (6,190) NAMT
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) CALL XABORT('DRVUTL: MAXLEV OVERFLOW.')
            IPLIST=LCMGID(IPLIST,NAMT)
            IPKEEP(ILEV)=IPLIST
         ELSE IF(TEXT4.EQ.'AT') THEN
            CALL REDGET(INDIC,NITMA,FLOTT,NAMT,DFLOTT)
            IF(INDIC.NE.1) CALL XABORT('DRVUTL: INTEGER DATA EXPECTED.')
            WRITE (6,195) NITMA
            ILEV=ILEV+1
            IF(ILEV.GT.MAXLEV) CALL XABORT('DRVUTL: MAXLEV OVERFLOW.')
            IPLIST=LCMGIL(IPLIST,NITMA)
            IPKEEP(ILEV)=IPLIST
         ELSE IF(TEXT4.EQ.'DOWN') THEN
            WRITE (6,'(/35H DRVUTL: STEP DOWN TO PARENT LEVEL.)')
            ILEV=ILEV-1
            IF(ILEV.LT.1) CALL XABORT('DRVUTL: TOO MANY STEPS DOWN.')
            IPLIST=IPKEEP(ILEV)
         ELSE IF(TEXT4.EQ.'ROOT') THEN
            WRITE (6,'(/33H DRVUTL: STEP DOWN TO ROOT LEVEL.)')
            ILEV=1
            IPLIST=IPKEEP(1)
         ENDIF
      ELSE IF(TEXT4.EQ.'DIR') THEN
*        PRINT THE DIRECTORY OF THE ACTIVE LEVEL.
         CALL LCMLIB(IPLIST)
      ELSE IF(TEXT4.EQ.'DUMP') THEN
*        DUMP THE ACTIVE AND SON DIRECTORIES ON THE PRINTER.
         CALL LCMEXP(IPLIST,0,6,2,1)
      ELSE IF(TEXT4.EQ.';') THEN
         CALL LCMINF(IPLIST,NAMLCM,NAMMY,EMPTY,ILONG,LCM)
         WRITE(6,260) NAMMY
         RETURN
      ELSE
         WRITE(HSMG,'(8HDRVUTL: ,A4,30H IS AN INVALID UTILITY ACTION.)
     1   ') TEXT4
         CALL XABORT(HSMG)
      ENDIF
      GO TO 10
*
  180 FORMAT (/36H DRVUTL: PERFORM UTILITY ACTIONS ON ,A11,9H OPEN IN ,
     1 A9,29H MODE WITH ACTIVE DIRECTORY ',A12,2H'./9X,9HLCM NAME=,A)
  190 FORMAT (/27H DRVUTL: STEP UP TO LEVEL ',A12,2H'.)
  195 FORMAT (/27H DRVUTL: STEP AT COMPONENT ,I5,1H.)
  200 FORMAT (/17H DRVUTL: COMPARE ,A8,26H ERRORS OF THE TWO BLOCKS:/)
  210 FORMAT (/5H LEN=,I6,5X,7HEPSMAX=,F8.2,15H % IN COMPONENT,I6/16X,
     1 7HEPSAVG=,F8.2,2H %)
  220 FORMAT (/5H LEN=,I6,5X,7HEPSMAX=,E10.5,13H IN COMPONENT,I6/16X,
     1 7HEPSAVG=,E10.5)
  225 FORMAT (/29H DRVUTL: CONTENT OF COMPONENT,I6,5X,8HLENGTH =,I10,
     1 5X,26HNUMBER OF NON ZERO TERMS =,I10/)
  230 FORMAT (/27H DRVUTL: CONTENT OF BLOCK ',A12,1H',5X,8HLENGTH =,
     1 I10,5X,26HNUMBER OF NON ZERO TERMS =,I10/)
  240 FORMAT (/16H DRVUTL: BLOCK ',A12,21H' IS OF UNKNOWN TYPE./)
  245 FORMAT (/18H DRVUTL: COMPONENT,I6,27H IS NOT STORED ON THE CURRE,
     1 20HNT LCM OR XSM LEVEL./)
  250 FORMAT (/16H DRVUTL: BLOCK ',A12,28H' IS NOT STORED ON THE CURRE,
     1 20HNT LCM OR XSM LEVEL./)
  260 FORMAT (/40H DRVUTL: LEAVING WITH ACTIVE DIRECTORY ',A12,2H'.)
      END
