*
* $Id: cdusp3.F,v 1.1.1.1 1996/02/28 16:24:27 mclareni Exp $
*
* $Log: cdusp3.F,v $
* Revision 1.1.1.1  1996/02/28 16:24:27  mclareni
* Hepdb, cdlib, etc
*
*
#include "hepdb/pilot.h"
#if defined(CERNLIB__P3CHILD)
      SUBROUTINE CDUSP3 (CROOT, ITIME, IRC)
*     =====================================
*
************************************************************************
*                                                                      *
*        SUBR. CDUSP3 (CROOT, ITIME, *IRC*)                            *
*                                                                      *
*   Retrieves several objects in memory in one transaction from host   *
*   to child in P3 context                                             *
*                                                                      *
*   Arguments :                                                        *
*                                                                      *
*     CROOT    Name of the calling routine                             *
*     ITIME    Event data acquisition time                             *
*     IRC      Return code (see below)                                 *
*                                                                      *
*   Called by CDGETDB,CDUSEDB,CDUSEM                                   *
*                                                                      *
*   Error Condition :                                                  *
*                                                                      *
*     IRC       =  0 : No error                                        *
*               =  5 : Error in CDCHLD in P3 communication             *
*                                                                      *
************************************************************************
*
#include "hepdb/caopts.inc"
#include "hepdb/cdcblk.inc"
#include "hepdb/ctpath.inc"
#include "hepdb/clinks.inc"
#include "hepdb/p3dbl3.inc"
#include "zebra/mzbits.inc"
*
      DIMENSION       ITIME(9)
      CHARACTER       CROOT*(*)
*
*     ------------------------------------------------------------------
*
      IQ1    = IRC
      IQ2    = IQUEST(2)
      IQ3    = IQUEST(3)
      IF (IPASP3.NE.1)          GO TO 30
*
* *** Request the host to load the data objects from the RZ file
*
      IF (NBKYP3.EQ.0) THEN
        IQ2    = 0
        IQ3    = 0
        GO TO 30
      ENDIF
*
      RNDBP3 = 'CDRZIN  '
      PAT1CT = CROOT
      CALL UCTOH  (PAT1CT, IWDBP3, 4, 8)
      CALL CDCHLD
      IF (IQDBP3.NE.0) THEN
        IQ1    = 5
#if defined(CERNLIB__DEBUG)
        IF (IDEBCD.GT.0) CALL CDPRNT (LPRTCD, '(/,'' CDUSP3 : Error '//
     +  'code'',I6,'' from CDCHLD'')', IQDBP3, 1)
#endif
        GO TO 30
      ENDIF
*
* *** Relocate the objects
*
      IPASP3 = 2
      LNK6P3 = LQ(KOFUCD+LNK3P3-1)
      LNK7P3 = LQ(KOFUCD+LNK3P3-2)
*
      DO 20 JK = 1, NKBP3
        IP3NEW = IQ(KOFUCD+LNK2P3+JK)
        I      =      IP3NEW/1000000
        IP3NEW = MOD (IP3NEW,1000000)
        IF (JK.GT.1) THEN
          IF (IP3NEW.EQ.IP3OLD) GO TO 20
          DO 10 IP3 = IP3OLD, IP3NEW-1
            LNK4P3 = LQ(KOFUCD+LNK6P3)
            LNK5P3 = LQ(KOFUCD+LNK7P3)
            CALL MZDROP (IXDBP3, LNK6P3, 'BV..')
            CALL MZDROP (IXDBP3, LNK7P3, 'BV..')
            LNK6P3 = LNK4P3
            LNK7P3 = LNK5P3
   10     CONTINUE
        ELSE
          LNK4P3 = LNK6P3
          LNK5P3 = LNK7P3
        ENDIF
        IP3OLD = IP3NEW
*
        LBKYCD = LQ(KOFUCD+LNK2P3-JK)
        LBDACD = LQ(KOFUCD+LBKYCD-KLDACD)
        NDK    = IQ(KOFUCD+LBKYCD-1)
        IF (LBDACD.NE.0) CALL MZDROP (IDIVCD, LBDACD, 'L...')
*
        NWKEY  = IQ(KOFUCD+LBKYCD-1)
        CALL UCOPY (IQ(KOFUCD+LBKYCD+1), KEYVCK, NWKEY)
        CALL CDKXIN (ITIME, IDIVCD, LAUXCL(9), LBKYCD, -KLDACD, NWKEY,
     +               KEYVCK, IPREC, IRC)
        LAUXCL(9) = 0
*
        IF (IRC.EQ.0) IQ(KOFUCD+LBKYCD+NDK+MKYPRE) = IPREC
        IF (IRC.NE.0.AND.IQ1.EQ.0) IQ1 = IRC
   20 CONTINUE
*
   30 IRC       = IQ1
      IQUEST(2) = IQ2
      IQUEST(3) = IQ3
*                                                             END CDUSP3
      END
#endif