MINICERN/packlib/zebra/qutil/zitoh.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.3  1998/09/25 09:33:25  mclareni
   6 * Modifications for the Mklinux port flagged by CERNLIB_PPC
   7 *
   8 * Revision 1.2  1996/09/23 12:20:38  cernlib
   9 * add Linux
  10 *
  11 * Revision 1.1.1.1  1996/03/06 10:47:15  mclareni
  12 * Zebra
  13 *
  14 *
  15 #include "zebra/pilot.h"
  16 #if defined(CERNLIB_Z32)
  17 #include "qutyz32/zitoh.F"
  18 #elif (defined(CERNLIB_VAXVMS))||(defined(CERNLIB_QMVMI)) \
  19     ||(defined(CERNLIB_QMDOS))||(defined(CERNLIB_TMO)) \
  20     ||((defined(CERNLIB_QMLNX) && !defined(CERNLIB_PPC)))
  21 #include "qutyinv/zitoh.F"
  22 #elif (defined(CERNLIB_CONVEX))&&(defined(CERNLIB_SINGLE))
  23 #include "not_cern/qutycvx/zitoh.F"
  24 #elif defined(CERNLIB_CRAY)
  25 #include "not_cern/qutycry/zitoh.F"
  26 #elif defined(CERNLIB_CDC)
  27 #include "not_cern/qutycdc/zitoh.F"
  28 #elif defined(CERNLIB_PDP)
  29 #include "not_cern/qutypdp/zitoh.F"
  30 #else
  31       SUBROUTINE ZITOH (INTV,HOLL,NP)
  32
  33 C-    This is a rather slow stop-gap solution only  !!!
  34
  35 #include "zebra/zbcd.inc"
  36 C--------------    END CDE                             --------------
  37       COMMON /SLATE/ DUMMY(8), MM(4), DUMB(28)
  38
  39       DIMENSION    INTV(99), HOLL(99), NP(9)
  40       DIMENSION    MPAK(2)
  41       DATA  MPAK   /6,4/
  42
  43
  44       N = NP(1)
  45
  46       DO 39  JW=1,N
  47       CALL UPKBYT (INTV(JW),1,MM(1),4,MPAK(1))
  48
  49       DO 16  J=1,4
  50       JV = MM(J)
  51       IF (JV.EQ.0)  JV=45
  52    16 MM(J) = IQLETT(JV)
  53
  54       CALL UBUNCH (MM(1),HOLL(JW),4)
  55    39 CONTINUE
  56       RETURN
  57       END
  58 *      ==================================================
  59 #include "zebra/qcardl.inc"
  60 #endif