Line data    Source code

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