MICROCERN/fchput.c

   1 /*
   2  * $Id$
   3  *
   4  * $Log$
   5  * Revision 1.1.2.1  2002/07/11 17:15:24  alibrary
   6  * Adding MICROCERN
   7  *
   8  * Revision 1.1.1.1  1999/05/18 15:55:29  fca
   9  * AliRoot sources
  10  *
  11  * Revision 1.1.1.1  1996/02/15 17:49:40  mclareni
  12  * Kernlib
  13  *
  14  */
  15 #include "kerngen/pilot.h"
  16 /*>    ROUTINE FCHPUT
  17   CERN PROGLIB#         FCHPUT          .VERSION KERNFOR  4.31  911111
  18   ORIG. 22/02/91, JZ
  19
  20       Copy a zero-terminated C character string
  21       to a Fortran character string of length NTEXT,
  22       return length and blank-fill
  23 */
  24 #include <stdio.h>
  25 #include "kerngen/fortchar.h"
  26 int fchput(pttext,ftext,lgtext)
  27       char *pttext;
  28 #if defined(CERNLIB_QMCRY)
  29       _fcd ftext;
  30 #endif
  31 #if !defined(CERNLIB_QMCRY)
  32       char *ftext;
  33 #endif
  34       int  lgtext;
  35 {
  36       char *utext;
  37       int  limit, jcol;
  38       int  nhave;
  39
  40       limit = lgtext;
  41       jcol  = 0;
  42 #if defined(CERNLIB_QMCRY)
  43       utext = _fcdtocp(ftext);
  44 #endif
  45 #if !defined(CERNLIB_QMCRY)
  46       utext = ftext;
  47 #endif
  48       if (pttext == NULL)          goto out;
  49
  50 /*--      copy the text to the caller   */
  51       for (jcol = 0; jcol < limit; jcol++)
  52       {   if (*pttext == '\0')  break;
  53           *utext++ = *pttext++;
  54         }
  55
  56 out:  nhave = jcol;
  57       for (; jcol < limit; jcol++)   *utext++ = ' ';
  58       return nhave;
  59 }
  60 /*> END <----------------------------------------------------------*/