MINICERN/packlib/kernlib/kerngen/tcgen/iuweed.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:49:49  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10 #if defined(CERNLIB_QIEEE)
  11       FUNCTION IUWEED (IA,N)
  12 C
  13 C CERN PROGLIB# N103    IUWEED          .VERSION KERNFOR  4.31  911111
  14 C ORIG. 16/10/91 JZ
  15 C-    Find position of first number which is infinity or not-a-number
  16 C-    in the N word vector IA, return zero if none
  17 C-    ---  this version only for machines with IEEE representation  ---
  18       DIMENSION IA(*)
  19 #if defined(CERNLIB_B32)
  20       PARAMETER (NMANT=23, IVBAD=255)
  21 #endif
  22 #if defined(CERNLIB_B64)
  23       PARAMETER (NMANT=52, IVBAD=2047)
  24 #endif
  25 #if !defined(CERNLIB_QISASTD)
  26 #include "kerngen/q_andor.inc"
  27 #include "kerngen/q_shift.inc"
  28 #endif
  29
  30       DO  24  J=1,N
  31 #if !defined(CERNLIB_QISASTD)
  32       IVAL = IAND (ISHFTR(IA(J),NMANT), IVBAD)
  33 #endif
  34 #if defined(CERNLIB_QISASTD)
  35       IVAL = IAND (ISHFT(IA(J),-NMANT), IVBAD)
  36 #endif
  37       IF (IVAL.EQ.IVBAD)           GO TO 29
  38    24 CONTINUE
  39       J = 0
  40    29 IUWEED = J
  41       RETURN
  42       END
  43 #endif