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