1 : C SAUF SOURCE CHAT 05/01/13 03:11:20 5004 2 : SUBROUTINE SAUF 3 : C 4 : C 5 : C CET OPERATEUR ENLEVE AU SEGMENT LECT1(RESP. MLREE1) LES ELEMENTS 6 : C DU SEGMENT LECT2(RESP. MLREE2) ET LES MET DANS MLENTI(RESP.MLREEL) 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : -INC CCOPTIO 10 : -INC SMLENTI 11 : -INC SMLREEL 12 : C 13 : C **** OPERATION SUR MLENTI 14 : C 14 : CALL LIROBJ('LISTENTI',LECT1,0,IRETOU) 15 : IF(IRETOU.EQ.0)GO TO 10 15 : CALL LIROBJ('LISTENTI',LECT2,1,IRETOU) 16 : IF(IERR.NE.0) RETURN 17 : MLENT1=LECT1 18 : MLENT2=LECT2 19 : SEGACT MLENT1,MLENT2 20 : N1=MLENT1.LECT(/1) 21 : IF(N1.EQ.0) GO TO 5000 22 : N2=MLENT2.LECT(/1) 23 : JG=N1+N2 24 : SEGINI MLENTI 25 : JG=0 26 : DO 1 I=1,N1 27 : IF(N2.EQ.0) GO TO 3 28 : DO 2 J=1,N2 29 : IF(MLENT1.LECT(I).EQ.MLENT2.LECT(J)) GO TO 1 30 : 2 CONTINUE 31 : 3 CONTINUE 32 : JG=JG+1 33 : LECT(JG)=MLENT1.LECT(I) 34 : 1 CONTINUE 35 : SEGADJ MLENTI 36 : SEGDES MLENT1,MLENT2 36 : CALL ECROBJ('LISTENTI',MLENTI) 37 : SEGDES MLENTI 38 : GO TO 5000 39 : C 40 : C **** OPERATION SUR DES MLREEL 41 : C 42 : 10 CONTINUE 42 : CALL LIROBJ('LISTREEL',MLREE1,0,IRETOU) 43 : IF(IRETOU.EQ.0) GO TO 20 44 : SEGACT MLREE1 45 : N1=MLREE1.PROG(/1) 46 : IF(N1.EQ.0) GO TO 5000 46 : CALL LIROBJ('LISTREEL',MLREE2,1,IRETOU) 47 : IF(IERR.NE.0)RETURN 48 : SEGACT MLREE2 49 : N2=MLREE2.PROG(/1) 50 : JG=0 51 : SEGINI MLREEL 52 : DO 11 I=1,N1 53 : IF(N2.EQ.0) GO TO 13 54 : DO 12 J=1,N2 55 : IF(MLREE1.PROG(I).EQ.MLREE2.PROG(J)) GO TO 11 56 : 12 CONTINUE 57 : 13 CONTINUE 58 : JG=JG+1 59 : SEGADJ MLREEL 60 : PROG(JG)=MLREE1.PROG(I) 61 : 11 CONTINUE 62 : SEGDES MLREE1,MLREE2 62 : CALL ECROBJ('LISTREEL',MLREEL) 63 : SEGDES MLREEL 64 : 5000 CONTINUE 65 : RETURN 66 : C 67 : C PAS D OPERANDE CORRECTE TROUVE 68 : C 68 : 20 CALL QUETYP(MOTERR(1:8),0,IRETOU) 69 : IF(IRETOU.NE.0) THEN 69 : CALL ERREUR (39) 70 : ELSE 70 : CALL ERREUR(533) 71 : ENDIF 72 : RETURN 73 : END 74 :
© Cast3M 2003 - All rights reserved.
Disclaimer