MINICERN/packlib/kernlib/kerngen/ccgencf/cfput.c

   1 /*
   2  * $Id$
   3  *
   4  * $Log$
   5  * Revision 1.4  1997/10/23 16:33:19  mclareni
   6  * NT mods
   7  *
   8  * Revision 1.3  1997/02/04 17:35:12  mclareni
   9  * Merge Winnt and 97a versions
  10  *
  11  * Revision 1.2  1997/01/15 16:25:33  cernlib
  12  * fix from F.Hemmer to return rfio return code
  13  *
  14  * Revision 1.1.1.1.2.1  1997/01/21 11:30:11  mclareni
  15  * All mods for Winnt 96a on winnt branch
  16  *
  17  * Revision 1.1.1.1  1996/02/15 17:49:36  mclareni
  18  * Kernlib
  19  *
  20  */
  21 #include "kerngen/pilot.h"
  22 #include "kerngen/fortranc.h"
  23
  24 /*>    ROUTINE CFPUT
  25   CERN PROGLIB# Z310    CFPUT           .VERSION KERNFOR  4.29  910718
  26   ORIG. 12/01/91, JZ
  27       CALL CFPUT (LUNDES, MEDIUM, NWREC, MBUF, ISTAT)
  28       write to the file :
  29        LUNDES  file descriptor
  30        MEDIUM  = 0,1,2,3 : primary disk/tape, secondary disk/tape
  31        NWREC   record size, number of words to be written
  32        MBUF    vector to be written
  33       *ISTAT   status, =zero if success
  34 */
  35 #include "kerngen/cf_reaw.h"
  36 #include <errno.h>
  37 #include "kerngen/cf_xaft.h"
  38 #include "kerngen/wordsizc.h"
  39 #if defined(CERNLIB_QX_SC)
  40 void type_of_call cfput_(lundes, medium, nwrec, mbuf, stat)
  41 #endif
  42 #if defined(CERNLIB_QXNO_SC)
  43 void type_of_call cfput(lundes, medium, nwrec, mbuf, stat)
  44 #endif
  45 #if defined(CERNLIB_QXCAPT)
  46 void type_of_call CFPUT(lundes, medium, nwrec, mbuf,
  47 # ifdef CERNLIB_CFPUT_CHARACTER
  48      lmbuf,
  49 # endif
  50             stat)
  51 #  ifdef CERNLIB_CFPUT_CHARACTER
  52      int lmbuf;
  53 #  endif
  54 #endif
  55       char *mbuf;
  56       int  *lundes, *medium, *nwrec, *stat;
  57 {
  58       int  fildes;
  59       int  nbdn, nbdo;
  60
  61       *stat = 0;
  62       if (*nwrec <= 0)            return;
  63
  64 /*        write the file     */
  65
  66       fildes = *lundes;
  67       nbdo   = *nwrec * NBYTPW;
  68       nbdn   = write (fildes, mbuf, nbdo);
  69       if (nbdn < 0)               goto trouble;
  70       return;
  71
  72 #if defined(CERNLIB_PROJSHIFT)
  73 trouble:  *stat = (serrno ? serrno : (rfio_errno ? rfio_errno : errno));
  74 #else
  75 trouble:  *stat = errno;
  76 #endif
  77           perror (" error in CFPUT");
  78           return;
  79 }
  80 /*> END <----------------------------------------------------------*/
  81 #ifdef CERNLIB_TCGEN_CFPUT
  82 #undef CERNLIB_TCGEN_CFPUT
  83 #endif