C DANS      SOURCE    CB215821  20/01/24    21:15:01     10506          
C  teste si un listentier dans un autre
      subroutine dans
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMLENTI
-INC SMLREEL
-INC SMELEME
      character*4 chaopt(2)
      data chaopt/'SEQU','QUEL'/
c
c  premiere option un listenti dans un autre
c
      imo=0
      call lirmot(chaopt,2,imo,0)
      call lirobj('LISTENTI',mlent1,0,iretou)
      if( iretou.eq.0) go to 100
      call lirobj('LISTENTI',mlent2,1,iretou)
      if (ierr.ne.0) return
      segact mlent1,mlent2
      lon=mlent1.lect(/1)
      do 10 i=0,mlent2.lect(/1)-1,lon
       do 20 j=1,lon
       if (mlent1.lect(j).ne.mlent2.lect(i+j)) goto 30
  20   continue
*  ok on a trouve
       call ecrlog(.true.)
       segdes mlent1,mlent2
       return
  30  continue
  10  continue
      call ecrlog(.false.)
      segdes mlent1,mlent2
      return
  100 call lirobj('LISTREEL',mlree1,0,iretou)
      if (iretou.eq.0) go to 300
      if( ierr.ne.0) return
      call lirobj('LISTREEL',mlree2,0,iretou)
      if( iretou.eq.0) go to 200
C
C deuxieme option un listreel dans un autre listreel
c
      prec = 1.d30
      segact mlree1,mlree2
      lon = mlree2.prog(/1)
      do 101 i=1,lon-1
        prec = min ( prec ,abs (mlree2.prog(i)-mlree2.prog(i+1)))
  101 continue
      prec=prec/ 1.d5
      IF(IMO.ne.2) then
* option sequentiel
        lon = mlree1.prog(/1)
        do 110 i=0,mlree2.prog(/1)-1,lon
         do 120 j=1,lon
         if (abs(mlree1.prog(j)-mlree2.prog(i+j)).gt.prec) goto 130
 120    continue
*  ok on a trouve
        call ecrlog(.true.)
        segdes mlree1,mlree2
        return
 130    continue
 110    continue
        call ecrlog(.false.)
        segdes mlree1,mlree2
        return
      else
* option quel
        do 140 i=1,mlree1.prog(/1)
        ab = mlree1.prog(i)
          do 150 j=1,mlree2.prog(/1)
            if( abs(mlree2.prog(j)-ab) . le. prec) go to 140
  150     continue
          call ecrlog(.false.)
          segdes mlree1,mlree2
          return
  140   continue
        call ecrlog(.true.)
        segdes mlree1,mlree2
        return
      endif
 200  call lirree(xva,0,iretou)
      if(iretou.eq.0) then
        call erreur(21)
      endif
c
c   test si un reel est dans un listreel
c
      prec = xzprec * 1000.D0
      prec = MAX(prec*MAX(xpetit/prec,ABS(xva)),xpetit)
      segact mlree1
      lon = mlree1.prog(/1)

      do 202 i=1,lon
       if( abs (xva - mlree1.prog(i)).lt. prec) goto 203
  202 continue

      call ecrlog(.false.)
      segdes mlree1
      return
  203 call ecrlog(.true.)
      segdes mlree1
      return

 300  continue
      call lirobj('POINT',ip1,1,iretou)
      if (ierr.ne.0) return
      call lirobj('MAILLAGE',meleme,0,iretou)
      if(iretou.eq.0) then
        call erreur(21)
      endif
      call ecrobj('MAILLAGE',meleme)
      call ecrcha('POI1')
      call prchan
      call lirobj('MAILLAGE',meleme,0,iretou)
      if (ierr.ne.0) return
      segact meleme
      do kp=1,num(/2)
       if (ip1.eq.num(1,kp)) then
         call ecrlog(.true.)
         return
       endif
      enddo
        call ecrlog(.false.)
        return
      end







 
 
