C EGA SOURCE FANDEUR 22/06/02 21:15:04 11372 SUBROUTINE EGA IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMLENTI -INC SMTEXTE EXTERNAL LONG CHARACTER*(8) ITTEMP,ITTEM2 CHARACTER*(LOCHAI) CHAR1,CHAR2 LOGICAL IRET,BOOL,BOOL1 INTEGER I1,I2 REAL*8 EPS1,X1,X2,XVAL C C TEST SUR LES TEXTES C INTEXT=1 CALL QUETYP(ITTEMP,0,IRETOU) MOTERR(1:8)=ITTEMP IF(IRETOU.EQ.0) THEN CALL ERREUR( 533) RETURN ENDIF IF(ITTEMP.EQ.'TEXTE ') GO TO 300 IF(ITTEMP.EQ.'LOGIQUE ') GO TO 310 IF(ITTEMP.EQ.'LISTENTI') GO TO 330 IF(ITTEMP.EQ.'ENTIER ') GO TO 340 IF(ITTEMP.EQ.'MOT ') GO TO 350 IF(ITTEMP.EQ.'FLOTTANT') GO TO 360 * comparaison bĂȘte des 2 objets iret=.true. ittemp=' ' ittem2=' ' call lirobj(ittemp,iv1,1,iretou) call lirobj(ittem2,iv2,1,iretou) if (ierr.ne.0) return if (ittemp.ne.ittem2) iret=.false. if (iv1.ne.iv2) iret=.false. GO TO 100 300 CONTINUE IRET=.FALSE. INTEXT=1 CALL LIROBJ(ITTEMP,ITEX1,0,IRETOU) INTEXT=1 CALL LIROBJ(ITTEMP,ITEX2,0,IRETOU) IF (IERR.NE.0) RETURN IF(IRETOU.EQ.1) THEN MTEXTE=ITEX1 MTEXT1=ITEX2 SEGACT MTEXTE,MTEXT1 NCA1=NCART NCA2=MTEXT1.NCART IF(NCA1.NE.NCA2) GO TO 221 DO I=1,NCA1 IF (MTEXT(I:I).NE.MTEXT1.MTEXT(I:I)) GO TO 221 ENDDO IRET=.TRUE. 221 SEGDES MTEXTE,MTEXT1 ELSE INTEXT=0 ITTEMP=' ' CALL LIROBJ(ITTEMP,KIKI,0,IRETOU) IF(IRETOU.EQ.0) GO TO 5000 ENDIF GO TO 100 310 CONTINUE C TEST SUR BOOLEENS IRET=.FALSE. INTEXT=0 CALL LIRLOG(BOOL ,1,IRETOU) CALL LIRLOG(BOOL1,0,IRETOU) IF (IERR.NE.0) RETURN IF(IRETOU.EQ.1) THEN IRET= BOOL.EQV.BOOL1 ELSE ITTEMP=' ' CALL LIROBJ( ITTEMP,KIKI,0,IRETOU) IF(IRETOU.EQ.0) GO TO 5000 ENDIF GO TO 100 330 CONTINUE C TEST SUR LISTENTI IRET=.FALSE. CALL LIROBJ(ITTEMP,MLENTI,1,IRETOU) CALL LIROBJ(ITTEMP,MLENT1,0,IRETOU) IF (IERR.NE.0) RETURN IF(IRETOU.EQ.1) THEN SEGACT MLENTI,MLENT1 IF(LECT(/1).NE.MLENT1.LECT(/1)) GO TO 102 DO I=1,LECT(/1) IF(LECT(I).NE.MLENT1.LECT(I)) GO TO 102 ENDDO IRET=.TRUE. 102 CONTINUE SEGDES MLENTI,MLENT1 ELSE ITTEMP=' ' CALL LIROBJ( ITTEMP,KIKI,0,IRETOU) IF(IRETOU.EQ.0) GO TO 5000 ENDIF GO TO 100 340 CONTINUE C TEST SUR ENTIERS IRET=.FALSE. CALL LIRENT(I1,1,IRETOU) CALL LIRENT(I2,0,IRETOU) IF (IERR.NE.0) RETURN IF(IRETOU.EQ.1) THEN IRET= I1.EQ.I2 ELSE ITTEMP=' ' CALL LIROBJ( ITTEMP,KIKI,0,IRETOU) IF(IRETOU.EQ.0) GO TO 5000 ENDIF GO TO 100 360 CONTINUE C TEST SUR FLOTTANTS IRET=.FALSE. CALL LIRREE(X1,1,IRETOU) CALL LIRREE(X2,0,IRETOU) IF (IERR.NE.0) RETURN IF(IRETOU.EQ.1) THEN CALL LIRREE(EPS1,0,IRETO3) IF(IRETO3.EQ.1) THEN * * MILL 9/1/91 TEST EN VALEUR ABSOLUE * XVAL = ABS (X2 - X1) IRET= XVAL.LE.EPS1 ELSE IRET= A_EGALE_B(X1,X2) ENDIF ELSE ITTEMP=' ' CALL LIROBJ( ITTEMP,KIKI,0,IRETOU) IF(IRETOU.EQ.0) GO TO 5000 ENDIF GO TO 100 350 CONTINUE C TEST SUR MOT IRET=.FALSE. CALL LIRCHA(CHAR1,1,IRET1) CALL LIRCHA(CHAR2,0,IRET2) IF (IERR.NE.0) RETURN IF(IRET2.NE.0) THEN CALL LIRENT(LL0,0,IRET3) IF (IRET3.NE.0) THEN IF (LL0.GT.LOCHAI) THEN INTERR = LL0 CALL ERREUR(36) RETURN ENDIF IRET= CHAR1(1:LL0).EQ.CHAR2(1:LL0) ELSE IF( CHAR1.EQ.CHAR2) THEN IRET=.TRUE. ELSE LL1=LONG(CHAR1) LL2=LONG(CHAR2) IRET= CHAR1(1:LL1).EQ.CHAR2(1:LL2) ENDIF ENDIF ELSE ITTEMP=' ' CALL LIROBJ( ITTEMP,KIKI,0,IRETOU) IF(IRETOU.EQ.0) GO TO 5000 ENDIF GO TO 100 100 CONTINUE CALL ECRLOG (IRET) RETURN 5000 CONTINUE CALL ERREUR(533) RETURN END