*DECK DRVGRP
      SUBROUTINE DRVGRP(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
* STANDARD GREP MODULE TO RECOVER CLE-2000 VALUES 
*                      IN A LINKED LIST OR IN AN XSM FILE.
*
* 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 : =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; =LINKED LIST ADDRESS OTHERWISE.
*           DIMENSION HENTRY(NENTRY),IENTRY(NENTRY),JENTRY(NENTRY),
*           KENTRY(NENTRY)
*
*-------------------------------------- AUTHOR: R. ROY    ; 01/01/00 ---
*
      USE GANLIB
      IMPLICIT NONE
*----
*  SUBROUTINE ARGUMENTS
*----
      INTEGER   NENTRY,IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR) KENTRY(NENTRY)
      CHARACTER HENTRY(*)*12
*----
*  LOCAL VARIABLES
*----
      CHARACTER TEXT12*12,HLIST*12,HNAME*12,TEXT72*72,TEXTIN*72,NAMT*12
      CHARACTER CLOGBG(5)*12,HSMG*131
      TYPE(C_PTR) IPDATA,JPDATA
      INTEGER   ITYLCM,IACTIO,I,J,K,N
      INTEGER   ITYP,ITYP1,NOUT,NSTP
      INTEGER   IBCHAR,NBCHAR,NRESID,IOFSET,ISET
      INTEGER   ITYPE,IOUT,ILENG,ILENG2,IPRINT
      INTEGER   NITMA, INTGMX, INTMIN, INTMAX, INDMIN, INDMAX
      PARAMETER  ( INTGMX= 2147483646 )
      DOUBLE PRECISION DFLOTT, DBLEMX, DBLMIN, DBLMAX, DBLMNV
      PARAMETER  ( DBLEMX= 1.D+100 )
      REAL      FLOTT, REALMX, RELMIN, RELMAX, RELMNV
      PARAMETER  ( REALMX= 1.E+30 )
      INTEGER   ISEEME(2),ITRANS
      REAL      ASEEME(2),ATRANS
      DOUBLE PRECISION DSEEME
      EQUIVALENCE ( DSEEME, ISEEME, ASEEME )
      EQUIVALENCE ( ITRANS, ATRANS )
      INTEGER, ALLOCATABLE, DIMENSION(:) :: IDATA,JDATA
      DATA CLOGBG
     1  / 'INTEGER' , 'REAL'    , 'STRING'   , 'DOUBLE', 'LOGICAL' /
*----
*  PARAMETER VALIDATION.
*----
      IACTIO=0
      INDMIN= 0
      INDMAX= 0
      NBCHAR= 0
      IF( NENTRY.NE.1 )THEN
         CALL XABORT('DRVGRP: MORE THAN ONE ENTRY')
      ELSEIF( IENTRY(1).NE.1.AND.IENTRY(1).NE.2 )THEN
         CALL XABORT('DRVGRP: RHS LINKED LIST '
     >             //'OR XSM FILE PARAMETER EXPECTED.')
      ELSEIF( JENTRY(1).NE.2 )THEN
         CALL XABORT('DRVGRP: RHS PARAMETER IN '
     >             //'READ-ONLY MODE EXPECTED.')
      ENDIF
*
      HLIST=HENTRY(1)
      IPDATA=KENTRY(1)
      I= 1
      IPRINT= 0
   20 CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
   25 CONTINUE
      IF( ITYP.NE.3 )CALL XABORT('DRVGRP: CHARACTER DATA EXPECTED.')
      IF( TEXT12.EQ.'EDIT' )THEN
         CALL REDGET(ITYP,IPRINT,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.1 )CALL XABORT('DRVGRP: NO INTEGER AFTER *EDIT*.')
      ELSE IF(TEXT12.EQ.'STEP') THEN
*        CHANGE THE HIERARCHICAL LEVEL ON THE LCM OBJECT.
         JPDATA=C_NULL_PTR
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         IF(ITYP.NE.3) CALL XABORT('DRVGRP: CHARACTER DATA EXPECTED.')
         IF(TEXT12.EQ.'UP') THEN
            CALL REDGET(ITYP,NITMA,FLOTT,NAMT,DFLOTT)
            IF(ITYP.NE.3) CALL XABORT('DRVGRP: DIR-NAME EXPECTED.')
            JPDATA=LCMGID(IPDATA,NAMT)
         ELSE IF(TEXT12.EQ.'AT') THEN
            CALL REDGET(ITYP,NITMA,FLOTT,NAMT,DFLOTT)
            IF(ITYP.NE.1) CALL XABORT('DRVGRP: INTEGER EXPECTED.')
            JPDATA=LCMGIL(IPDATA,NITMA)
         ELSE
            CALL XABORT('DRVGRP: *UP* OR *AT* EXPECTED.')
         ENDIF
         IPDATA=JPDATA
      ELSEIF( TEXT12.EQ.'GETVAL'.OR.TEXT12.EQ.'MAXVAL'.OR.
     >        TEXT12.EQ.'MINVAL'.OR.TEXT12.EQ.'INDMAX'.OR.
     >        TEXT12.EQ.'INDMIN'.OR.TEXT12.EQ.'MEAN'  .OR.
     >        TEXT12.EQ.'TYPE'  )THEN
         IF(     TEXT12.EQ.'GETVAL' )THEN
            IACTIO= 1
         ELSEIF( TEXT12.EQ.'MAXVAL' )THEN
            IACTIO= 2
         ELSEIF( TEXT12.EQ.'MINVAL' )THEN
            IACTIO= 3
         ELSEIF( TEXT12.EQ.'INDMAX' )THEN
            IACTIO= 4
         ELSEIF( TEXT12.EQ.'INDMIN' )THEN
            IACTIO= 5
         ELSEIF( TEXT12.EQ.'MEAN'   )THEN
            IACTIO= 6
         ELSEIF( TEXT12.EQ.'TYPE'   )THEN
            IACTIO= 7
         ENDIF
*
*        FIND BLOCK NAME
         CALL REDGET(ITYP1,ISET ,FLOTT,HNAME ,DFLOTT)
         IF(ITYP1.EQ.1) THEN
            CALL LCMLEL(IPDATA,ISET  ,ILENG2,ITYLCM)
         ELSE IF(ITYP1.EQ.3) THEN
            CALL LCMLEN(IPDATA,HNAME ,ILENG2,ITYLCM)
         ELSE
            CALL XABORT('DRVGRP: BLOCK-NAME OR LIST INDEX EXPECTED.')
         ENDIF
         IF( IACTIO.EQ.7 ) THEN
            NOUT= 1
            NSTP= 1
            ITYPE= 1
            ALLOCATE(JDATA(NOUT))
            JDATA(1)= ITYLCM
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            GO TO 310
         ENDIF
         IF( ILENG2.EQ.0 )THEN
            CALL XABORT('DRVGRP: BLOCK *'//HNAME//'* IS NOT STORED IN *'
     >                 //HLIST//'*.')
         ELSE IF( ITYLCM.EQ.10 ) THEN
            CALL XABORT('DRVGRP: '//HNAME//' IS A LIST OF ARRAYS. USE A'
     >                 //' STEP UP KEYWORD TO ACCESS THE LIST.')
         ENDIF
         ALLOCATE(IDATA(ILENG2))
         ALLOCATE(JDATA(ILENG2))
         IF( ITYLCM.EQ.4 )THEN
            ILENG= ILENG2/2
         ELSEIF( ITYLCM.EQ.3 )THEN
            ILENG= ILENG2*4
         ELSE
            ILENG= ILENG2
         ENDIF
*
*        GET BLOCK
         IF(ITYP1.EQ.1) THEN
            CALL LCMGDL(IPDATA,ISET  ,IDATA)
         ELSE IF(ITYP1.EQ.3) THEN
            CALL LCMGET(IPDATA,HNAME ,IDATA)
         ENDIF
*
         CALL REDGET(ITYP,I    ,FLOTT,TEXT12,DFLOTT)
         IF( ITYP.NE.1.OR.I.LT.1 )
     >      CALL XABORT('DRVGRP: POSITIVE INDEX EXPECTED.')
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         J= I
         K= 1
         N= 1
         IF( ITYP.EQ.1 )THEN
            J= NITMA
            IF( J.LT.I )
     >         CALL XABORT('DRVGRP: SECOND INDEX EXPECTED GREATER '
     >                   //'OR EQUAL THAN FIRST.')
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            IF( ITYP.EQ.1 )THEN
               K= NITMA
               IF( K.LT.1 )
     >            CALL XABORT('DRVGRP: POSITIVE THIRD INDEX EXPECTED.')
               IF( MOD(J-I,K).NE.0 )
     >            CALL XABORT('DRVGRP: THIRD INDEX EXPECTED TO BALANCE'
     >                      //' STEPS FROM FIRST TO SECOND INDEX.')
               CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            ENDIF
            N= (J-I)/K + 1
            IF( N.LT.1 )
     >         CALL XABORT('DRVGRP: INCONSISTENT NUMBER OF WORDS.')
         ELSEIF( (ITYP.EQ.3).AND.(TEXT12.EQ.'*') )THEN
            J= ILENG
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            IF( ITYP.EQ.1 )THEN
               K= NITMA
               IF( K.LT.1 )
     >            CALL XABORT('DRVGRP: POSITIVE THIRD INDEX EXPECTED.')
               IF( MOD(J-I,K).NE.0 )
     >            CALL XABORT('DRVGRP: THIRD INDEX EXPECTED TO BALANCE'
     >                      //' STEPS FROM FIRST TO SECOND INDEX.')
               CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            ENDIF
            N= (J-I)/K + 1
            IF( N.LT.1 )
     >         CALL XABORT('DRVGRP: INCONSISTENT NUMBER OF WORDS.')
         ENDIF
         IF( TEXT12.EQ.'NVAL' )THEN
            IF( N.NE.1.OR.K.NE.1 )THEN
               CALL XABORT('DRVGRP: NVALUE ALREADY GIVEN FROM INDEX.')
            ENDIF
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
            IF( ITYP.EQ.1)THEN
               N= NITMA
               IF( N.LT.1 )
     >         CALL XABORT('DRVGRP: POSITIVE NVALUE EXPECTED.')
               J= I + N - 1
            ELSEIF( (ITYP.EQ.3).AND.(TEXT12.EQ.'*') )THEN
               J= ILENG
               N= ILENG - I + 1
            ELSE
               CALL XABORT('DRVGRP: NVAL IS FOLLOWED BY * OR INTEGER')
            ENDIF
            CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
         ENDIF
         IF( J.GT.ILENG )THEN
            WRITE(HSMG,'(29HDRVGRP: THE VALUE OF INDEX2 (,I8,7H) IS GR,
     >      29HEATER THAN THE BLOCK LENGTH (,I8,2H).)') J,ILENG
            CALL XABORT(HSMG)
         ENDIF
         GO TO 30
      ELSEIF( TEXT12.EQ.';' )THEN
         GO TO 40
      ELSE
         CALL XABORT('DRVGRP: '//TEXT12//' IS AN INVALID KEYWORD.')
      ENDIF
      GO TO 20
*----
*  PROCESSING THE COMMAND NUMBER: IACTIO.
*----
   30 CONTINUE
      NSTP= 1
      NOUT= 0
      ITYPE= ITYLCM
      IF(     ITYLCM.EQ.1 )THEN
*
*        GREP INTEGER DATA
         INTMIN= INTGMX
         INTMAX=-INTGMX
         DO 301 IOUT=I,J,K
            NOUT= NOUT+1
            ITRANS= IDATA(IOUT)
            JDATA(NOUT)= ITRANS
            IF( ITRANS.GT.INTMAX )THEN
               INTMAX= ITRANS
               INDMAX= IOUT
            ENDIF
            IF( ITRANS.LT.INTMIN )THEN
               INTMIN= ITRANS
               INDMIN= IOUT
            ENDIF
  301    CONTINUE
         IF(     IACTIO.EQ.2 )THEN
            NOUT= 1
            JDATA(1)= INTMAX
         ELSEIF( IACTIO.EQ.3 )THEN
            NOUT= 1
            JDATA(1)= INTMIN
         ELSEIF( IACTIO.EQ.4 )THEN
            NOUT= 1
            JDATA(1)= INDMAX
            ITYPE= 1
         ELSEIF( IACTIO.EQ.5 )THEN
            NOUT= 1
            JDATA(1)= INDMIN
            ITYPE= 1
         ELSEIF( IACTIO.NE.1 )THEN
            CALL XABORT('DRVGRP: INVALID ACTION ON INTEGERS')
         ENDIF
      ELSEIF( ITYLCM.EQ.2 )THEN
*
*        GREP REAL DATA
         RELMIN= REALMX
         RELMAX=-REALMX
         RELMNV= 0.0
         DO 302 IOUT=I,J,K
            NOUT= NOUT+1
            ITRANS= IDATA(IOUT)
            JDATA(NOUT)= ITRANS
            IF( ATRANS.GT.RELMAX )THEN
               RELMAX= ATRANS
               INDMAX= IOUT
            ENDIF
            IF( ATRANS.LT.RELMIN )THEN
               RELMIN= ATRANS
               INDMIN= IOUT
            ENDIF
            RELMNV= RELMNV+ATRANS
  302    CONTINUE
         IF(     IACTIO.EQ.2 )THEN
            NOUT= 1
            ATRANS= RELMAX
            JDATA(1)= ITRANS
         ELSEIF( IACTIO.EQ.3 )THEN
            NOUT= 1
            ATRANS= RELMIN
            JDATA(1)= ITRANS
         ELSEIF( IACTIO.EQ.4 )THEN
            NOUT= 1
            JDATA(1)= INDMAX
            ITYPE= 1
         ELSEIF( IACTIO.EQ.5 )THEN
            NOUT= 1
            JDATA(1)= INDMIN
            ITYPE= 1
         ELSEIF( IACTIO.EQ.6 )THEN
            ATRANS= RELMNV/FLOAT(NOUT)
            NOUT= 1
            JDATA(1)= ITRANS
         ENDIF
      ELSEIF( ITYLCM.EQ.3 )THEN
         IF( IACTIO.NE.1 )THEN
            CALL XABORT('DRVGRP: INVALID ACTION ON STRING')
         ELSEIF( (J-I)/K.GT.71 )THEN
            CALL XABORT('DRVGRP: STRING HAS LENGTH .GT. 72')
         ENDIF
         TEXT72= ' '
         IOFSET= 0
         IF( ILENG.GE.72 )THEN
            DO 313 IBCHAR= 1, ILENG/72
               WRITE(TEXTIN,'(18A4)') (IDATA(IOFSET+IOUT),IOUT=1,18)
               DO 303 IOUT= I,J,K
                  IF( IOUT.GT.NBCHAR.AND.IOUT.LE.NBCHAR+72 )THEN
                     NOUT= NOUT+1
                     TEXT72(NOUT:NOUT)= TEXTIN(IOUT-NBCHAR:IOUT-NBCHAR)
                  ENDIF
  303          CONTINUE
               IOFSET= IOFSET+18
               NBCHAR= NBCHAR+72
  313       CONTINUE
         ENDIF
         NRESID= (ILENG-NBCHAR)/4
         IF( NRESID.GT.0 )THEN
            WRITE(TEXTIN,'(18A4)') (IDATA(IOFSET+IOUT),IOUT=1,NRESID)
            DO 323 IOUT= I,J,K
               IF( IOUT.GT.NBCHAR.AND.IOUT.LE.NBCHAR+NRESID*4 )THEN
                  NOUT= NOUT+1
                  TEXT72(NOUT:NOUT)= TEXTIN(IOUT-NBCHAR:IOUT-NBCHAR)
               ENDIF
  323       CONTINUE
         ENDIF
         NBCHAR= NOUT
         NOUT= 1
      ELSEIF( ITYLCM.EQ.4 )THEN
*
*        GREP DOUBLE PRECISION DATA
         I= I+I
         J= J+J
         K= K+K
         DBLMIN= DBLEMX
         DBLMAX=-DBLEMX
         DBLMNV= 0.0D0
         DO 304 IOUT=I,J,K
            NOUT= NOUT+1
            ISEEME(1)= IDATA(IOUT-1)
            ISEEME(2)= IDATA(IOUT)
            JDATA(2*NOUT-1)= ISEEME(1)
            JDATA(2*NOUT)= ISEEME(2)
            IF( DSEEME.GT.DBLMAX )THEN
               DBLMAX= DSEEME
               INDMAX= IOUT
            ENDIF
            IF( DSEEME.LT.DBLMIN )THEN
               DBLMIN= DSEEME
               INDMIN= IOUT
            ENDIF
            DBLMNV= DBLMNV+DSEEME
  304    CONTINUE
         IF(     IACTIO.EQ.2 )THEN
            NOUT= 1
            DSEEME= DBLMAX
            JDATA(1)= ISEEME(1)
            JDATA(2)= ISEEME(2)
         ELSEIF( IACTIO.EQ.3 )THEN
            NOUT= 1
            DSEEME= DBLMIN
            JDATA(1)= ISEEME(1)
            JDATA(2)= ISEEME(2)
         ELSEIF( IACTIO.EQ.4 )THEN
            NOUT= 1
            JDATA(1)= INDMAX
            ITYPE= 1
         ELSEIF( IACTIO.EQ.5 )THEN
            NOUT= 1
            JDATA(1)= INDMIN
            ITYPE= 1
         ELSEIF( IACTIO.EQ.6 )THEN
            DSEEME= DBLMNV/DBLE(NOUT)
            NOUT= 1
            JDATA(1)= ISEEME(1)
            JDATA(2)= ISEEME(2)
         ENDIF
         IF( ITYPE.EQ.4 )THEN
            NSTP= 2
            NOUT= 2*NOUT-1
         ENDIF
      ELSEIF( ITYLCM.EQ.5 )THEN
*
*        GREP LOGICAL DATA
         IF( IACTIO.NE.1 )THEN
            CALL XABORT('DRVGRP: INVALID ACTION ON LOGICALS')
         ENDIF
         DO 305 IOUT=I,J,K
            NOUT= NOUT+1
            JDATA(NOUT)= IDATA(IOUT)
  305    CONTINUE
      ELSE
         CALL XABORT('DRVGRP: INVALID DATA TYPE.')
      ENDIF
      DEALLOCATE(IDATA)
*----
*  PUT CLE-2000 PARMS IN CREATE OR READ/WRITE MODES.
*----
  310 DO 35 IOUT= 1, NOUT, NSTP
         IF( -ITYP.NE.ITYPE )THEN
            CALL XABORT('DRVGRP: NOT ENOUGH CLE-2000 PARAMETERS '
     >                //'TO CONTAIN ALL VALUES ASKED TO BE PICKED')
         ENDIF
         ITYP= ITYPE
         IF( ITYP.EQ.1.OR.ITYP.EQ.5 )THEN
            NITMA= JDATA(IOUT)
            IF( IPRINT.GT.0 )THEN
               IF( ITYP.EQ.1 )THEN
                  WRITE(6,*) CLOGBG(ITYP),TEXT12,'<-',NITMA
               ELSE
                  IF( NITMA.EQ.+1 )THEN
                     WRITE(6,*) CLOGBG(ITYP),TEXT12,'<- $True_L'
                  ELSEIF( NITMA.EQ.-1 )THEN
                     WRITE(6,*) CLOGBG(ITYP),TEXT12,'<- $False_L'
                  ELSE
                     WRITE(6,*) CLOGBG(ITYP),TEXT12,'<- ?_L'
                  ENDIF
               ENDIF
            ENDIF
         ELSEIF( ITYP.EQ.2 )THEN
            ITRANS= JDATA(IOUT)
            FLOTT= ATRANS
            IF( IPRINT.GT.0 )THEN
               WRITE(6,*)CLOGBG(ITYP),TEXT12,'<-',FLOTT
            ENDIF
         ELSEIF( ITYP.EQ.3 )THEN
            NITMA=72
            IF( IPRINT.GT.0 )THEN
               WRITE(6,*)CLOGBG(ITYP),TEXT12,'<-"',TEXT72(1:NBCHAR),'"'
            ENDIF
         ELSEIF( ITYP.EQ.4 )THEN
            ISEEME(1)= JDATA(IOUT)
            ISEEME(2)= JDATA(IOUT+1)
            DFLOTT= DSEEME
            IF( IPRINT.GT.0 )THEN
               WRITE(6,*)CLOGBG(ITYP),TEXT12,'<-',DFLOTT
            ENDIF
         ENDIF
         CALL REDPUT(ITYP,NITMA,FLOTT,TEXT72,DFLOTT)
         CALL REDGET(ITYP,NITMA,FLOTT,TEXT12,DFLOTT)
   35 CONTINUE
      DEALLOCATE(JDATA)
      GO TO 25
*----
*  ENDING COMMANDS: CHECK UP/DOWN BALANCE AND REMAINING PARMS.
*----
   40 CONTINUE
      RETURN
      END
