C REFE SOURCE PV 20/03/30 21:23:48 10567 SUBROUTINE REFE C*********************************************************************** C C Opérateur REFE C ______________ C C C OBJET : Lister les objets maillages inclus au sens des noeuds dans C ----- un autre ou indiquer si un objet maillage est inclus dans C un autre. C C SYNTAXE 1 : LOBI = REFE OBJ2 ; C ------- C LOBI : objet LISTMOTS contenant la liste C C C SYNTAXE 2 : LOGI = OBJ1 REFE OBJ2 ; C ------- C LOGI : objet de type LOGIQUE prenant les valeurs VRAI C ou FAUX suivant que OBJ1 est inclus ou non dans C OBJ2 C C*********************************************************************** IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC PPARAM -INC CCOPTIO -INC CCNOYAU -INC SMELEME -INC SMLMOTS -INC SMCOORD -INC SMLENTI C SEGMENT IZTGN CHARACTER*(LONOM) NOML(0) ENDSEGMENT SEGMENT/IZTGP/(IPTL(0)) SEGMENT TABOG CHARACTER*(LONOM) NOMOG(0) ENDSEGMENT SEGMENT TIBOG INTEGER NIMOG(0) ENDSEGMENT C C- Décodage des arguments et détermination de la syntaxe utilisée : C- CAS 1 : On fait la liste de tous les objets inclus dans obj1 C- CAS 2 : On regarde si obj1 est inclus dans obj2 C CALL LIROBJ('MAILLAGE',MELEM1,1,IRETOU) IF (IRETOU.NE.1) RETURN CALL LIROBJ('MAILLAGE',MELEM2,0,IRETOU) IF (IRETOU.EQ.0) THEN IKAS = 1 MELEME = MELEM1 ELSE IKAS = 2 MELEME = MELEM2 ENDIF MELEM0 = MELEME C C- Initialisation du LISTENTI de travail indiquant si le point C- numéro I est dans le maillage; C- LECT(I)<>0 : Le point numéro I est dans le MELEME C SEGACT MCOORD NBNOUV = nbpts JG = NBNOUV SEGINI MLENTI SEGACT MELEME NBSOUS = LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 NPTD = 0 DO 20 KS=1,NBSOUS IF (NBSOUS.EQ.1) THEN IPT1 = MELEME ELSE IPT1 = LISOUS(KS) ENDIF SEGACT IPT1 NP = IPT1.NUM(/1) NEL = IPT1.NUM(/2) DO 10 K=1,NEL DO 10 N=1,NP IF (LECT(IPT1.NUM(N,K)).EQ.0) THEN NPTD = NPTD + 1 LECT(IPT1.NUM(N,K)) = NPTD ENDIF 10 CONTINUE 20 CONTINUE C C- Liste des objets maillage à comparer à MELEM0 C IF (IKAS.EQ.1) THEN IZTGN = 0 IZTGP = 0 CALL LFILE(' ','MAILLAGE',IZTGN,IZTGP) IF (IERR.NE.0) THEN SEGSUP MLENTI RETURN ENDIF SEGACT IZTGN,IZTGP ELSE SEGINI IZTGN,IZTGP NOML(**) = 'INDEFINI' IPTL(**) = MELEM1 ENDIF C C- Inclusion au sens des points des maillages de pointeur IPTL(L) C- et de nom NOML(L) dans le maillage de pointeur MELEM0. C SEGINI TABOG,TIBOG NL = IPTL(/1) DO 60 L=1,NL MELEME = IPTL(L) IPT1 = MELEME IF (MELEME.EQ.MELEM0) THEN NOMOG(**) = NOML(L) NIMOG(**) = IPTL(L) ELSE SEGACT MELEME NBSOUS = LISOUS(/1) IF (NBSOUS.EQ.0) NBSOUS=1 DO 40 KS=1,NBSOUS IF (NBSOUS.EQ.1) THEN IPT1 = MELEME ELSE IPT1 = LISOUS(KS) ENDIF SEGACT IPT1 NP = IPT1.NUM(/1) NEL = IPT1.NUM(/2) DO 30 K=1,NEL DO 30 I=1,NP NU = LECT(IPT1.NUM(I,K)) IF (NU.EQ.0) GOTO 50 30 CONTINUE 40 CONTINUE NOMOG(**) = NOML(L) NIMOG(**) = IPTL(L) 50 CONTINUE ENDIF 60 CONTINUE C C- Ecriture du résultat et ménage C NBO = NIMOG(/1) IF (IKAS.EQ.1) THEN JGM = NOMOG(/2) JGN = 8 SEGINI MLMOTS IF (JGM.EQ.0) THEN CALL ERREUR(-313) ELSE DO 70 I=1,JGM MOTS(I) = NOMOG(I) 70 CONTINUE ENDIF SEGACT,MLMOTS CALL ECROBJ('LISTMOTS',MLMOTS) ELSE IF (NBO.EQ.0) THEN CALL ECRLOG(.FALSE.) ELSE CALL ECRLOG(.TRUE.) ENDIF ENDIF SEGSUP IZTGN,IZTGP,TABOG,TIBOG,MLENTI END