MICROCERN/fchtak.c

   1 /* $Id$ */
   2
   3 #include "kerngen/pilot.h"
   4 /*>    ROUTINE FCHTAK
   5   CERN PROGLIB#         FCHTAK          .VERSION KERNFOR  4.31  911111
   6   ORIG. 22/02/91, JZ
   7
   8       copy a Fortran character string
   9       to allocated memory zero-terminated,
  10       return the memory pointer
  11 */
  12 #include <stdio.h>
  13 #include "kerngen/fortchar.h"
  14 char *fchtak(ftext,lgtext)
  15 #if defined(CERNLIB_QMCRY)
  16       _fcd  ftext;
  17 #endif
  18 #if !defined(CERNLIB_QMCRY)
  19       char *ftext;
  20 #endif
  21       int  lgtext;
  22 {
  23       char *malloc();
  24       char *ptalc, *ptuse;
  25       char *utext;
  26       int  nalc;
  27       int  ntx, jcol;
  28
  29       nalc  = lgtext + 8;
  30       ptalc = malloc (nalc);
  31       if (ptalc == NULL)     goto exit;
  32 #if defined(CERNLIB_QMCRY)
  33       utext = _fcdtocp(ftext);
  34 #endif
  35 #if !defined(CERNLIB_QMCRY)
  36       utext = ftext;
  37 #endif
  38
  39       ptuse = ptalc;
  40       ntx   = lgtext;
  41       for (jcol = 0; jcol < ntx; jcol++)  *ptuse++ = *utext++;
  42
  43       *ptuse = '\0';
  44 exit: return  ptalc;
  45 }
  46 /*> END <----------------------------------------------------------*/