MINICERN/packlib/kernlib/kerngen/tcgen/csetvm.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:43  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE CSETVM (NTIMEP,NINCP,JVALP,CHV,JLP,JRP,NSTEPP,IFLSQP)
  11 C
  12 C CERN PROGLIB# M432    CSETVM          .VERSION KERNFOR  4.36  930602
  13 C ORIG. 01/04/92, JZ
  14 C
  15 C-    Set NTIME decimal integers JVAL + n*NINC into CHV(JL:JR)
  16 C-    every NSTEP columns, each with one leading blank
  17 C-    and right-justified within its field;
  18 C-    squeeze multiple blanks if IFLSQ non-zero.
  19
  20       COMMON /SLATE/ NDSLAT,NESLAT,NFSLAT,NGSLAT, DUMMY(36)
  21
  22       DIMENSION    NTIMEP(9), NINCP(9), JVALP(9)
  23       DIMENSION    JLP(9), JRP(9),  NSTEPP(9), IFLSQP(9)
  24       CHARACTER    CHV*(*)
  25
  26
  27       NTIME = NTIMEP(1)
  28       NINC  = NINCP(1)
  29       JVAL  = JVALP(1)
  30       JL    = JLP(1)
  31       NSTEP = NSTEPP(1)
  32       LIMIT = JRP(1) - NSTEP + 1
  33       IFLSQ = IFLSQP(1)
  34       JWK   = JL - 1
  35
  36       DO 24  JIN=1,NTIME
  37       IF (JWK.GE.LIMIT)  THEN
  38           IF (IFLSQ.EQ.0)          GO TO 91
  39           IF (JIN.EQ.1)            GO TO 91
  40           CALL CSQMBL (CHV,JL,JWK)
  41           JWK = NESLAT - 1
  42           IF (JWK.GE.LIMIT)        GO TO 91
  43         ENDIF
  44       CALL CSETDI (JVAL,CHV,JWK+2,JWK+NSTEP)
  45       JVAL = JVAL + NINC
  46    24 JWK  = JWK + NSTEP
  47
  48       IF (IFLSQ.NE.0)  THEN
  49           CALL CSQMBL (CHV,JL,JWK)
  50           JWK = NESLAT - 1
  51         ENDIF
  52
  53       NESLAT = JWK
  54       NGSLAT = 0
  55       RETURN
  56
  57 C----              Errors
  58
  59    91 NESLAT = JWK
  60       NGSLAT = JIN
  61       RETURN
  62       END