C PRRACC SOURCE BP208322 16/11/18 21:20:21 9177 C C CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTS C RACCORD NORMAUX OU LES ELEMENTS RACCORD POREUX (BALD) C SUBROUTINE PRRACC IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMELEME XXX=DENSIT/10. CALL LIRREE(XXX,0,IRETOU) IF (IERR.NE.0) RETURN CRIT=ABS(XXX) IF (CRIT.EQ.0.) THEN CALL ERREUR(21) RETURN ENDIF IPT3=0 CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) IF (IERR.NE.0) RETURN CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU) IF (IERR.NE.0) RETURN CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU) IF (IERR.NE.0) RETURN C SEGACT IPT1 IF (IPT1.LISOUS(/1).NE.0) GOTO 102 IF (KSURF(IPT1.ITYPEL).EQ.0) GOTO 101 102 CONTINUE CALL ECROBJ('MAILLAGE',IPT1) CALL PRCONT CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) IF (IERR.NE.0) RETURN SEGACT IPT1 101 CONTINUE C SEGACT IPT2 IF (IPT2.LISOUS(/1).NE.0) GOTO 202 IF (KSURF(IPT2.ITYPEL).EQ.0) GOTO 201 202 CONTINUE CALL ECROBJ('MAILLAGE',IPT2) CALL PRCONT CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU) IF (IERR.NE.0) RETURN SEGACT IPT2 201 CONTINUE C IF(IPT3.NE.0)THEN C C CAS DES ELELMENTS JOINTS POREUX C SEGACT IPT3 IF (IPT3.LISOUS(/1).NE.0) GOTO 302 IF (KSURF(IPT3.ITYPEL).EQ.0) GOTO 301 302 CONTINUE SEGDES IPT1,IPT2,IPT3 CALL ERREUR(26) RETURN 301 CONTINUE CALL RACPOR(IPT1,IPT2,IPT3,IPT4,CRIT) SEGDES IPT1,IPT2,IPT3 C ELSE C C CAS DES ELELMENTS JOINTS NORMAUX C CALL RACCOR(IPT1,IPT2,IPT4,CRIT) SEGDES IPT1,IPT2 C END IF C IF (IERR.NE.0) RETURN SEGDES IPT4 CALL ECROBJ('MAILLAGE',IPT4) RETURN END