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

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:42  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       SUBROUTINE CLEFT (CHV,JLP,JRP)
  11 C
  12 C CERN PROGLIB# M432    CLEFT           .VERSION KERNFOR  4.21  890323
  13 C ORIG. 04/10/88, JZ
  14 C
  15 C-    Left-justify CHV(JL:JR)
  16
  17       DIMENSION    JLP(9), JRP(9)
  18
  19       COMMON /SLATE/ NDSLAT,NESLAT, DUMMY(38)
  20       CHARACTER    CHV*(*)
  21
  22 C--       Find the first blank
  23
  24       JL = JLP(1)
  25       JR = JRP(1)
  26
  27       JP = JR + 1
  28       JJ = JL
  29    12 IF (JJ.GE.JP)          GO TO 99
  30       IF (CHV(JJ:JJ).NE.' ')   THEN
  31           JJ = JJ + 1
  32           GO TO 12
  33         ENDIF
  34
  35 C--       Copy shifted
  36
  37       JP = JJ
  38       JJ = JJ + 1
  39    21 IF (JJ.GT.JR)          GO TO 91
  40       IF (CHV(JJ:JJ).NE.' ')   THEN
  41           CHV(JP:JP) = CHV(JJ:JJ)
  42           JP = JP+1
  43         ENDIF
  44       JJ = JJ+1
  45       GO TO 21
  46
  47    91 CHV(JP:JR) = ' '
  48    99 NESLAT = JP
  49       NDSLAT = JP - JL
  50       RETURN
  51       END