*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:49  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
      SUBROUTINE CDJOIN (PATHN, IDATM, NI, NOBI, CHTI, IOTI, ICONI,
     +                      KEYI, NO, NOBO, CHTO, IOTO, ICONO, IRC)
*     =============================================================
*
************************************************************************
*                                                                      *
*        SUBR.CDJOIN (PATHN, IDATM, NI, NOBI, CHTI, IOTI, ICONI,       *
*                     KEYI, NO*, NOBO*, CHTO*, IOTO*, ICONO, IRC*)     *
*                                                                      *
*   Routine to Join a Table of Name PATHN                              *
*   The values of the Keys to be presented can be found at             *
*                 IQ(LJOICX+1,..,NO,NO+1,...,NO*NOBO)                  *
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     PATHN    Pathname of the Table                                   *
*     IDATM    Packed Date and Time (or Run #) at which the table is   *
*              valid                                                   *
*     NI       Number of Coloumns to join                              *
*     NOBI     Number of Rows (Data) to join                           *
*     CHTI     Name of Keys to which to join                           *
*     IOTI     Type of Keys to which to join                           *
*     ICONI    Number of concatenated keys to join                     *
*     KEYI     Value of Keys to which to join                          *
*     NO       Number of Keys to be Presented                          *
*     NOBO     Number of Objects to be presented                       *
*     CHTO     Name of Keys used for Presentation                      *
*     IOTO     Type of Keys used for Presentation                      *
*     ICONO    Number of concatenated keys to present                  *
*     IRC      Return code (see below)                                 *
*                                                                      *
*   Called by CDVIEW                                                   *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IRC       =  0 : No error                                        *
*                                                                      *
************************************************************************
*
#include "hepdb/cdcblk.inc"
#include "hepdb/clinks.inc"
#include "hepdb/ckkeys.inc"
#include "hepdb/cviews.inc"
#include "hepdb/cxlink.inc"
      DIMENSION       IOTI(NI), IOTO(9), KEYI(NI, NOBI)
      DIMENSION       ICONI(9), ICONO(9), IFLAG(100), IDATM(9)
      CHARACTER       PATHN*(*), CHTI(NI)*8, CHTO(*)*8, CHTG(100)*8
      CHARACTER       KYNAM*8, KYVAL*20, BLANK*20
      CHARACTER       KY10*10, CHPRO*50
      DATA            BLANK /' '/
*
*     ------------------------------------------------------------------
*
* *** Set the current directory
*
      CALL CDLDUP (PATHN, 0, IRC)
      IF (IRC.NE.0)         GO TO 999
      CALL CDKYTG
*
*  ** Fill concatenation flag (if non-zero: number of concatenated keys
*
      CALL CDCONC (IOTYCK(1), NWKYCK, ICONCK(1), NSKPCK)
*
*  ** Get the Coloumn Names in the Table to Join
*
      CALL VZERO (IFKYCV, NWKYCK)
      CALL VZERO (IFLAG, NWKYCK)
      CALL VZERO (MASKCX, NWKYCK)
      I  = 1
    1 I  = I + 1
      IF (I.GT.NI)          GO TO 7
    2 I1 = I-1
      CHPRO = 'Give name for '//CHTI(I)
      CALL KUPROC (CHPRO(1:23), CHTG(I1), LCHT)
      IOTYCV(I1) = IOTI(I)
      DO 3 J = NSYSCK+1, NWKYCK
        IF (CHTG(I1).EQ.CTAGCK(J)) THEN
          JST        = J
          IFKYCV(I1) = J
          MASKCX(J)  = 1
          GO TO 5
        ENDIF
    3 CONTINUE
      GO TO 2
    5 CONTINUE
      IF (ICONI(I).EQ.0)    GO TO 1
      NREP = ICONI(I)
      DO 6 J = 1, NREP
        I          = I + 1
        K          = JST + J
        I1         = I - 1
        IFKYCV(I1) = K
        IFLAG(K)   = 1
        MASKCX(K)  = 1
        IOTYCV(I1) = IOTYCK(K)
        CHTG(I1)   = CTAGCK(K)
    6 CONTINUE
      GO TO 1
    7 CONTINUE
*
*  ** Get additional Key-Names and Key-Values to Search
*
      CALL VZERO (KEYSCV, NWKYCK)
      IK = NI-1
   10 CONTINUE
      CALL KUPROC ('Key-Name to Search (if no more - |) ?', KYNAM, LKEY)
      IF (KYNAM.EQ.'|')     GO TO 20
      I = NSYSCK+1
   11 IF (I.GT.NWKYCK)      GO TO 13
      IF (KYNAM.EQ.CTAGCK(I).AND.IFLAG(I).EQ.0) THEN
        IFLAG(I)   = 1
        IKEY       = I
        IK         = IK + 1
        IFKYCV(IK) = I
        MASKCX(I)  = 1
        CHTG(IK)   = CTAGCK(I)
        IOTYCV(IK) = IOTYCK(I)
        ICONI(IK)  = ICONCK(I)
        NREP       = 0
        IF (ICONI(IK).GT.0) THEN
          NREP = ICONI(IK)
          DO 12 J = 1, NREP
            I = I + 1
            IFKYCV(IK+J) = I
            MASKCX(I)    = 1
            CHTG(IK+J)   = CTAGCK(I)
            IOTYCV(IK+J) = IOTYCK(I)
            ICONI(IK+J)  = ICONCK(I)
            IFLAG(I)     = 1
   12     CONTINUE
        ENDIF
        GO TO 15
      ENDIF
      I = I + 1
      GO TO 11
   13 CONTINUE
      GO TO 10
   15 CONTINUE
      CALL KUPROC ('Key-Value ?', KYVAL, LKEY)
      IF (IOTYCK(IKEY).EQ.5) THEN
*  *        Hollerith
        LCDAT = (NREP+1)*4
        CALL UCTOH (KYVAL(1:LCDAT), KEYSCV(IKEY), 4, LCDAT)
        IK = IK + NREP
      ELSE IF (IOTYCK(IKEY).EQ.2) THEN
*  *        Integer
        LEN  = MIN (10,LKEY)
        KY10 = BLANK(1:10-LEN)//KYVAL(1:LEN)
        READ (KY10(1:10), 1002) KEYSCV(IKEY)
      ELSE IF (IOTYCK(IKEY).EQ.1) THEN
*  *        Bit-string
        LEN  = MIN (8,LKEY)
        KY10 = BLANK(1:8-LEN)//KYVAL(1:LEN)
        READ (KY10(1:8), 1003) KEYSCV(IKEY)
      ENDIF
      GO TO 10
   20 CONTINUE
*
*  ** Loop on Input Objects
*
      LKJNCX(1) = 0
      LKJNCX(2) = 0
      DO 23 I = 1, NOBI
*    *      Key-Vector for CDUSEDB
        DO 22 J = 2, NI
          INDX = IFKYCV(J-1)
*    *  The following equality can be later replaced by other relation:
          KEYSCV(INDX) = KEYI(J,I)
   22   CONTINUE
*
        IF (I.EQ.1) THEN
          CALL CDUSEDB (PATHN, LKJNCX(1),IDATM, MASKCX,KEYSCV,'VS', IRC)
        ELSE
          CALL CDUSEDB (PATHN, LKJNCX(2),IDATM, MASKCX,KEYSCV,'VS', IRC)
          IF (LKJNCX(1).EQ.0) LKJNCX(1) = LKJNCX(2)
        ENDIF
   23 CONTINUE
*
*  ** Get the Key-Names to Present
*
      CALL VZERO (JFKYCV, NWKYCK)
      CALL VZERO (IFLAG, NWKYCK)
      IP        = 1
      ICONO(I)  = 0
      CHTO(1)   = CTAGCK(IDHKSN)
      IOTO(1)   = IOTYCK(IDHKSN)
      JFKYCV(1) = IDHKSN
   25 CALL KUPROC ('Key-Name to Present (if no more: |) ?', KYNAM, LKEY)
      IF (KYNAM.EQ.'|')     GO TO 30
      I = NSYSCK+1
   26 IF (I.GT.NWKYCK)      GO TO 28
      IF (KYNAM.EQ.CTAGCK(I).AND.IFLAG(I).EQ.0) THEN
        IFLAG(I)   = 1
        IP         = IP + 1
        CHTO(IP)   = CTAGCK(I)
        IOTO(IP)   = IOTYCK(I)
        ICONO(IP)  = ICONCK(I)
        JFKYCV(IP) = I
        IF (ICONO(IP).LE.0) THEN
          GO TO 25
        ELSE
          NREP = ICONO(IP)
          DO 27 J = 1,NREP
            IP         = IP + 1
            I          = I + 1
            IFLAG(I)   = 1
            CHTO(IP)   = CTAGCK(I)
            IOTO(IP)   = IOTYCK(I)
            ICONO(IP)  = ICONCK(I)
            JFKYCV(IP) = I
   27     CONTINUE
        ENDIF
        GO TO 25
      ENDIF
      I = I + 1
      GO TO 26
   28 CONTINUE
      GO TO 25
   30 CONTINUE
*
*  ** Lift Bank for Output
*
      NO = IP
      IF (NO.LE.0)          GO TO 999
      NOBO =  NZBANK (IDIVCD, LKJNCX(1))
      IF (NOBO.LE.0)        GO TO 999
      NDAT = NO *  NOBO
      CALL CDBANK (IDIVCD, LJOICX, LJOICX, 2, 'JOIN', 0, 0, NDAT, 2, 0,
     +             IRC)
      IF (IRC.NE.0)   GO TO 999
*
*  ** Fill-Up 'JOIN' Bank and free LKJNCX
*
      IPOIN = LJOICX
      NKOBJ = NZBANK (IDIVCD, LKJNCX(1))
      IF (NKOBJ.GT.0) THEN
        LFRSCX = LKJNCX(1)
        DO 40 K = 1, NKOBJ
          IF (LFRSCX.GT.0) THEN
            DO 35 J = 1, NO
              IPOIN = IPOIN + 1
              IQ(KOFUCD+IPOIN) = IQ(KOFUCD+LFRSCX+JFKYCV(J))
   35       CONTINUE
          ENDIF
          LFRSCX = LQ(KOFUCD+LFRSCX)
   40   CONTINUE
      ENDIF
      CALL MZDROP (IDIVCD, LKJNCX(1), 'L')
*
 1001 FORMAT (I2)
 1002 FORMAT (I10)
 1003 FORMAT (Z8)
*                                                             END CDJOIN
  999 END
