*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/08 15:32:53  mclareni
* Initial revision
*
*
#include "kuip/pilot.h"
*CMZ :  2.07/03 02/05/95  16.01.25  by  Gunter Folger
*-- Author :
      SUBROUTINE KUVEC(VECN,X,NELEMS,CHOPT)
*
********************************************************************************
*
* Routine for vector handling.
*
* Note: in the following description ILOW stands for ILOW(IDIM),
*       IHIGH for IHIGH(IDIM) and LENTOT for LENGTH(IDIM), where IDIM is
*       the dimension (1, 2 or 3) affected.
*
* Only one dimension can be handled by this routine, ex. VECN can be
* VEC(3), VEC(2,3:5), etc. if VEC is two-dim, but cannot be VEC(2:3,3:5)
*
* CHOPT='R' read in the array X the content of vector VECN (eg. VECN ---> X)
*           starting by the ILOW-th vector element (ILOW=1 is the first one).
*           NELEMS elements are read, eg. VECN(ILOW:ILOW+NELEMS-1), or all
*           if NELEMS<=0 or NELEMS>=LENTOT.
*           If the vector is not existing then IQUEST(1)=1.
*
* CHOPT=' ' same as CHOPT='R'.
*
* CHOPT='W' write the array X into the vector VECN (eg. X ---> VECN)
*           starting by the ILOW-th vector element (ILOW=1 is the first one).
*           NELEMS elements are written, eg. X(1:NELEMS).
*           If the vector is not large enough, it is automatically extended.
*           If the vector is not existing it is created.
*
* CHOPT='-' (used together with option 'W') same as CHOPT='W' and in addition
*           the vector is shrinked to the actual size.
*
* CHOPT='C' just create the vector if not existing.
*
* CHOPT='I' (used together with option 'W' or 'C') vector is of type Integer
*           (default case is Real)
*
* CHOPT='X' (used together with option 'W' or 'C') vector is of type compleX
*           (default case is Real)
*
* It returns also in IQUEST :
*
* IQUEST(10) : NCHNAM (number of chars of VECN)
* IQUEST(11) : LENTOT (total number of elements of vector)
* IQUEST(12) : LLOW   (low address)
* IQUEST(13) : LHIGH  (high address)
* IQUEST(14) : ITYPE  (type: 1=real, 2=integer, 3=hollerith)
*
* IQUEST(20) : ICOPY  (if <> 0 a copy on temporary vectory was done,
*                      with LENFR and LENTO addresses defined as follow)
* IQUEST(21) : LENFR(1)
* IQUEST(22) : LENFR(2)
* IQUEST(23) : LENFR(3)
* IQUEST(31) : LENTO(1)
* IQUEST(32) : LENTO(2)
* IQUEST(33) : LENTO(3)
*
* The vector elements can be addressed individually, if the common block /PAWC/
* is present, by Q(LLOW+I) or IQ(LLOW+I), with I ranging from 0 to LENTOT-1.
*
* The array X should be defined in the calling routine of the right type,
* INTEGER or REAL, corresponding to the vector type.
*
*     Input :
*
      CHARACTER*(*) VECN
*
*     Input/Output :
*
      INTEGER X(*)
*
*     Input :
*
      INTEGER NELEMS
      CHARACTER*(*) CHOPT
*
********************************************************************************
*
#include "kuip/kcgen.inc"
#include "kuip/kcques.inc"
#include "kuip/kcvect.inc"
      CHARACTER*1  VECTYP
      DIMENSION LENFR(3),LENTO(3),ILOW(3),LENGTH(3),IHIGH(3),ISTEPS(3)
      DIMENSION NDIM(3)
      CHARACTER*64 VNAME,VECNAM
      DIMENSION IOPT(7)
      EQUIVALENCE (IOPT(1),IOPTR),(IOPT(2),IOPTBL),(IOPT(3),IOPTW)
      EQUIVALENCE (IOPT(4),IOPTMI),(IOPT(5),IOPTC),(IOPT(6),IOPTI)
      EQUIVALENCE (IOPT(7),IOPTX)

*
      IQUEST(1)=0
      NELEM=NELEMS

      VECNAM=VECN
      CALL CLTOU(VECNAM)

      CALL UOPTC(CHOPT,'R W-CIX',IOPT)

      IF (IOPTR.GT.0.AND.CHOPT.NE.'R') THEN
         CALL KUALFA
         PRINT *,'*** KUVEC: Option R cannot coexist with other '
     +   //'options'
         IQUEST(1)=1
         GO TO 999
      ENDIF

      TVECFL=.FALSE.
      CALL KUVECT(VECNAM,LLOW,LHIGH)
      TVECFL=.TRUE.

      NCHNAM=IQUEST(10)
      IF (LLOW.GT.0) THEN
         ICOPY=IQUEST(20)
         LENFR(1)=IQUEST(21)
         LENFR(2)=IQUEST(22)
         LENFR(3)=IQUEST(23)
         LENTO(1)=IQUEST(31)
         LENTO(2)=IQUEST(32)
         LENTO(3)=IQUEST(33)
      ELSE
         ICOPY=0
         I1=INDEX(VECNAM,'(')
         I2=INDEX(VECNAM,')')
         NCHSUB=(I2-1)-(I1+1)+1
         DO 5 I=1,3
            LENFR(I)=1
            LENTO(I)=1
    5    CONTINUE
         IF (NCHSUB.GT.0) THEN
            CALL KIVIND(VECNAM(I1+1:I2-1),NCHSUB,LENFR,LENTO)
            IF (IQUEST(1).NE.0) GO TO 999
         ENDIF
         DO 6 I=1,3
            IF (LENFR(I).GT.LENTO(I)) LENTO(I)=LENFR(I)
    6    CONTINUE
      ENDIF

      DO 8 I=1,3
         ILOW(I)=LENFR(I)
         LENGTH(I)=LENTO(I)-LENFR(I)+1
    8 CONTINUE
*
* Multi-dim vectors accepted only if large enough
* (i.e. only one-dim vectors can be expanded)
* and with non-mixed dimensions
*
      IDIM=1
      III=0
      DO 9 I=1,3
         IF (LENGTH(I).GT.1) THEN
            III=III+1
            IDIM=I
         ENDIF
    9 CONTINUE
      IF (III.GT.1) THEN
         PRINT *,'*** KUVEC: Cannot handle mixed dimensions for vector '
     +   , VECNAM(:NCHNAM)
         IQUEST(1)=1
         GO TO 999
      ENDIF
      IF (NELEM.GT.LENGTH(IDIM)) THEN
         IF ( LLOW.GT.0) THEN
*               upper limit given is smaller/= than real length of vector
            IF ( LENTO(IDIM).LT.IQ(LVECN+10+IDIM) ) THEN
               NELEM=LENGTH(IDIM)
            ELSE
*                need to expand vector, check if 1-d
               IF ( IQ(LVECN+14).NE.1 ) THEN
                  PRINT *,'*** KUVEC: Multi-dim vector ',
     +                    VECNAM(:NCHNAM),' is not large enough'
                  IQUEST(1)=1
                  GO TO 999
               ENDIF
            ENDIF

         ENDIF
      ENDIF
*
      IF (IOPTC.GT.0.AND.IDIM.EQ.1) LENGTH(1)=NELEM
*
      IF (LLOW.EQ.0) THEN
*
* Vector not existing
*
         IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
            IQUEST(1)=1
            GO TO 999
         ELSE
*
* Create the vector
*
            VNAME=' '
            WRITE (VNAME,1000) VECNAM(1:NCHNAM),(LENGTH(I),I=1,3)
 1000     FORMAT (A,'(',I6,',',I6,',',I6,')')
            IF (IOPTI.GT.0) THEN
               VECTYP='I'
               IQUEST(14)=2
            ELSE IF (IOPTX.GT.0) THEN
               VECTYP='C'
               IQUEST(14)=3
            ELSE
               VECTYP='R'
               IQUEST(14)=1
            ENDIF
            CALL KXCRV1(VNAME,VECTYP)
            IF (IQUEST(1).NE.0) GO TO 999
*
         ENDIF
*
      ENDIF

      IF (ILOW(IDIM).LT.1) THEN
         IQUEST(1)=1
         GO TO 999
      ENDIF
*
      IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
         IF (NELEM.LT.1.OR.NELEM.GT.LENGTH(IDIM)) NELEM=LENGTH(IDIM)
      ENDIF
*
      IHIGH(IDIM)=ILOW(IDIM)+NELEM-1
      IF (IHIGH(IDIM).LT.1.OR.IHIGH(IDIM).LT.ILOW(IDIM)) THEN
         IQUEST(1)=1
         GO TO 999
      ENDIF
*             cannot read beyond limits of vector
      IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
         IF (IHIGH(IDIM).GT.IQ(LVECN+10+IDIM)) THEN
            IQUEST(1)=1
            GO TO 999
         ENDIF
      ENDIF
*
      JJJ=ILOW(1)+IQ(LVECN+11)*(ILOW(2)-1)+
     +    IQ(LVECN+11)*IQ(LVECN+12)*(ILOW(3)-1)
      LLOW=LVECN+14+JJJ
      LHIGH=LVECN+14+JJJ+NELEM-1
*
* CHOPT='R' - Copy from the vector to the array
*
      IF (IOPTBL.GT.0.OR.IOPTR.GT.0) THEN
         DO 40 I=1,NELEM
            X(I)=IQ(LLOW+I-1)
   40    CONTINUE
         GO TO 999
      ENDIF
*
* CHOPT='C' - Just create the vector
*
      IF (IOPTC.GT.0) THEN
         IQUEST(10+IDIM)=LENGTH(IDIM)
         IQUEST(12)=LLOW
         IQUEST(13)=LHIGH
         GO TO 999
      ENDIF
*
      IF (IOPTW.EQ.0) THEN
         CALL KUALFA
         PRINT *,'*** KUVEC: Unknown option ',CHOPT
         IQUEST(1)=1
         GO TO 999
      ENDIF
*
* CHOPT='W'
*
      IF (IOPTW.GT.0) THEN
*           only shrink/expand 1-d vectors
         IF (IDIM.EQ.1 .AND. IQ(LVECN+14).EQ.1 ) THEN
*
            ND=ILOW(IDIM)+ NELEM-1 -IQ(LVECN+10+IDIM)
*
* If there is a subscript in the vector name,
* then do not shrink even if options '-' is present
*
            IF (ND.LT.0 .AND.  ILOW(IDIM).GT.1
     +         .OR.LENTO(IDIM).LT.IQ(LVECN+10+IDIM) )  ND=0
*
* The one-dim vector must be enlarged or shrinked ?
*
            IF ((ND.GT.0).OR.(ND.LT.0.AND.IOPTMI.GT.0)) THEN
               NL=0
               CALL MZPUSH(IXKUIP,LVECN,NL,ND,' ')
               IQUEST(1)=0
               LENGTH(IDIM)=LENGTH(IDIM) + ND
               IQ(LVECN+10)=IQ(LVECN+10) + ND
               IQ(LVECN+10+IDIM)=IQ(LVECN+10+IDIM) + ND
               LLOW=LVECN+14+ILOW(IDIM)
               LHIGH=LVECN+14+IHIGH(IDIM)
            ENDIF
*
* Copy from the array to the one-dim vector
*
            DO 50 I=1,NELEM
               IQ(LLOW+I-1)=X(I)
   50       CONTINUE
*
            IQUEST(10+IDIM)=LENGTH(IDIM)
            IQUEST(12)=LLOW
            IQUEST(13)=LHIGH
*
         ELSE
*
* Copy from the array to the multi-dim vector
*
            IF (ICOPY.EQ.0) THEN
*
               DO 70 I=1,NELEM
                  IQ(LLOW+I-1)=X(I)
   70          CONTINUE
*
            ELSE
*
               DO 80 I=1,3
                  NDIM(I)=IQ(LVECN+10+I)
                  IF (LENFR(I).LE.LENTO(I)) THEN
                     ISTEPS(I)=1
                  ELSE
                     ISTEPS(I)=-1
                  ENDIF
   80          CONTINUE
               III=1
               DO 90 K=LENFR(3),LENTO(3),ISTEPS(3)
                  DO 90 J=LENFR(2),LENTO(2),ISTEPS(2)
                     DO 90 I=LENFR(1),LENTO(1),ISTEPS(1)
                        JJJ=I+NDIM(1)*(J-1)+NDIM(1)*NDIM(2)*(K-1)
                        LLL=LVECN+14+JJJ
                        IQ(LLL)=X(III)
                        III=III+1
   90          CONTINUE
*
            ENDIF
*
         ENDIF
      ENDIF
*
  999 END
