MICROCERN/fchtak.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 FCHTAK
  17   CERN PROGLIB#         FCHTAK          .VERSION KERNFOR  4.31  911111
  18   ORIG. 22/02/91, JZ
  19
  20       copy a Fortran character string
  21       to allocated memory zero-terminated,
  22       return the memory pointer
  23 */
  24 #include <stdio.h>
  25 #include "kerngen/fortchar.h"
  26 char *fchtak(ftext,lgtext)
  27 #if defined(CERNLIB_QMCRY)
  28       _fcd  ftext;
  29 #endif
  30 #if !defined(CERNLIB_QMCRY)
  31       char *ftext;
  32 #endif
  33       int  lgtext;
  34 {
  35       char *malloc();
  36       char *ptalc, *ptuse;
  37       char *utext;
  38       int  nalc;
  39       int  ntx, jcol;
  40
  41       nalc  = lgtext + 8;
  42       ptalc = malloc (nalc);
  43       if (ptalc == NULL)     goto exit;
  44 #if defined(CERNLIB_QMCRY)
  45       utext = _fcdtocp(ftext);
  46 #endif
  47 #if !defined(CERNLIB_QMCRY)
  48       utext = ftext;
  49 #endif
  50
  51       ptuse = ptalc;
  52       ntx   = lgtext;
  53       for (jcol = 0; jcol < ntx; jcol++)  *ptuse++ = *utext++;
  54
  55       *ptuse = '\0';
  56 exit: return  ptalc;
  57 }
  58 /*> END <----------------------------------------------------------*/