Télécharger la plaquette Cast3M


fr en

Télécharger dans.eso

Retour à la liste

Numérotation des lignes : 

dans

  1. C DANS      SOURCE    CB215821  20/01/24    21:15:01     10506          
  2. C  teste si un listentier dans un autre
  3.       subroutine dans
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC CCREEL
  10. -INC SMLENTI
  11. -INC SMLREEL
  12. -INC SMELEME
  13.       character*4 chaopt(2)
  14.       data chaopt/'SEQU','QUEL'/
  15. c
  16. c  premiere option un listenti dans un autre
  17. c
  18.       imo=0
  19.       call lirmot(chaopt,2,imo,0)
  20.       call lirobj('LISTENTI',mlent1,0,iretou)
  21.       if( iretou.eq.0) go to 100
  22.       call lirobj('LISTENTI',mlent2,1,iretou)
  23.       if (ierr.ne.0) return
  24.       segact mlent1,mlent2
  25.       lon=mlent1.lect(/1)
  26.       do 10 i=0,mlent2.lect(/1)-1,lon
  27.        do 20 j=1,lon
  28.        if (mlent1.lect(j).ne.mlent2.lect(i+j)) goto 30
  29.   20   continue
  30. *  ok on a trouve
  31.        call ecrlog(.true.)
  32.        segdes mlent1,mlent2
  33.        return
  34.   30  continue
  35.   10  continue
  36.       call ecrlog(.false.)
  37.       segdes mlent1,mlent2
  38.       return
  39.   100 call lirobj('LISTREEL',mlree1,0,iretou)
  40.       if (iretou.eq.0) go to 300
  41.       if( ierr.ne.0) return
  42.       call lirobj('LISTREEL',mlree2,0,iretou)
  43.       if( iretou.eq.0) go to 200
  44. C
  45. C deuxieme option un listreel dans un autre listreel
  46. c
  47.       prec = 1.d30
  48.       segact mlree1,mlree2
  49.       lon = mlree2.prog(/1)
  50.       do 101 i=1,lon-1
  51.         prec = min ( prec ,abs (mlree2.prog(i)-mlree2.prog(i+1)))
  52.   101 continue
  53.       prec=prec/ 1.d5
  54.       IF(IMO.ne.2) then
  55. * option sequentiel
  56.         lon = mlree1.prog(/1)
  57.         do 110 i=0,mlree2.prog(/1)-1,lon
  58.          do 120 j=1,lon
  59.          if (abs(mlree1.prog(j)-mlree2.prog(i+j)).gt.prec) goto 130
  60.  120    continue
  61. *  ok on a trouve
  62.         call ecrlog(.true.)
  63.         segdes mlree1,mlree2
  64.         return
  65.  130    continue
  66.  110    continue
  67.         call ecrlog(.false.)
  68.         segdes mlree1,mlree2
  69.         return
  70.       else
  71. * option quel
  72.         do 140 i=1,mlree1.prog(/1)
  73.         ab = mlree1.prog(i)
  74.           do 150 j=1,mlree2.prog(/1)
  75.             if( abs(mlree2.prog(j)-ab) . le. prec) go to 140
  76.   150     continue
  77.           call ecrlog(.false.)
  78.           segdes mlree1,mlree2
  79.           return
  80.   140   continue
  81.         call ecrlog(.true.)
  82.         segdes mlree1,mlree2
  83.         return
  84.       endif
  85.  200  call lirree(xva,0,iretou)
  86.       if(iretou.eq.0) then
  87.         call erreur(21)
  88.       endif
  89. c
  90. c   test si un reel est dans un listreel
  91. c
  92.       prec = xzprec * 1000.D0
  93.       prec = MAX(prec*MAX(xpetit/prec,ABS(xva)),xpetit)
  94.       segact mlree1
  95.       lon = mlree1.prog(/1)
  96.  
  97.       do 202 i=1,lon
  98.        if( abs (xva - mlree1.prog(i)).lt. prec) goto 203
  99.   202 continue
  100.  
  101.       call ecrlog(.false.)
  102.       segdes mlree1
  103.       return
  104.   203 call ecrlog(.true.)
  105.       segdes mlree1
  106.       return
  107.  
  108.  300  continue
  109.       call lirobj('POINT',ip1,1,iretou)
  110.       if (ierr.ne.0) return
  111.       call lirobj('MAILLAGE',meleme,0,iretou)
  112.       if(iretou.eq.0) then
  113.         call erreur(21)
  114.       endif
  115.       call ecrobj('MAILLAGE',meleme)
  116.       call ecrcha('POI1')
  117.       call prchan
  118.       call lirobj('MAILLAGE',meleme,0,iretou)
  119.       if (ierr.ne.0) return
  120.       segact meleme
  121.       do kp=1,num(/2)
  122.        if (ip1.eq.num(1,kp)) then
  123.          call ecrlog(.true.)
  124.          return
  125.        endif
  126.       enddo
  127.         call ecrlog(.false.)
  128.         return
  129.       end
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales