Numérotation des lignes :

C PRLIAI    SOURCE    BP208322  16/11/18    21:20:11     9177           CC   CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTSC   LIAISON NORMAUX OU LES ELEMENTS LIAISON POREUX (BALD)C      SUBROUTINE PRLIAI      IMPLICIT INTEGER(I-N)      implicit real*8 (a-h,o-z)-INC CCOPTIO-INC SMELEME-INC CCGEOME      SEGMENT LISOBJ(0)      REAL*8 XXX      IPT3=0      XXX=DENSIT/10.      CALL LIRREE(XXX,0,IRETOU)      CRIT=ABS(REAL(XXX))  20  CONTINUE      IF (CRIT.EQ.0.) CALL ERREUR(21)      IF (IERR.NE.0) RETURN      CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)      CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)      CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU)      IF (IERR.NE.0) RETURN      SEGACT IPT1      SEGACT IPT2      IF (IPT3.NE.0) SEGACT IPT3      SEGINI LISOBJCC  ON RECHERCHE LES PARTIES DE MEME TYPEC      IPT4=IPT1      DO 1001 IOBI=1,MAX(1,IPT1.LISOUS(/1))      IF (IPT1.LISOUS(/1).NE.0) THEN       IPT4=IPT1.LISOUS(IOBI)       SEGACT IPT4      ENDIF      IF (KSURF(IPT4.ITYPEL).NE.IPT4.ITYPEL) GOTO 1002      IPT5=IPT2      DO 1006 IOBJ=1,MAX(1,IPT2.LISOUS(/1))      IF (IPT2.LISOUS(/1).NE.0) THEN       IPT5=IPT2.LISOUS(IOBJ)       SEGACT IPT5      ENDIF      IF (KSURF(IPT5.ITYPEL).NE.IPT5.ITYPEL) GOTO 1007      IF (IPT4.ITYPEL.NE.IPT5.ITYPEL) GOTO 1007       IF (IPT3.NE.0) THENCC  CAS DES ELELMENTS JOINTS POREUXC        IPT6=IPT3        DO 1008 IOBK=1,MAX(1,IPT3.LISOUS(/1))        IF (IPT3.LISOUS(/1).NE.0) THEN         IPT6=IPT3.LISOUS(IOBK)         SEGACT IPT6        ENDIF        IF (KSURF(IPT6.ITYPEL).NE.IPT6.ITYPEL) GOTO 1009        IF (IPT4.ITYPEL.EQ.IPT6.ITYPEL) GOTO 1009        IF (NBSOM(IPT4.ITYPEL).NE.NBSOM(IPT6.ITYPEL)) GOTO 1009        IPT7=0        CALL LIAPOR(IPT4,IPT5,IPT6,IPT7,CRIT)        IF (IERR.NE.0) GOTO 1003        IF (IPT7.NE.0) LISOBJ(**)=IPT7 1009   CONTINUE        IF (IPT3.LISOUS(/1).NE.0) SEGDES IPT6 1008   CONTINUE       ELSECC  CAS DES ELELMENTS JOINTS NORMAUXC        IPT7=0        CALL LIAISO(IPT4,IPT5,IPT7,CRIT)        IF (IERR.NE.0) GOTO 1003        IF (IPT7.NE.0) LISOBJ(**)=IPT7       END IF 1007 CONTINUE      IF (IPT2.LISOUS(/1).NE.0) SEGDES IPT5 1006 CONTINUE 1002 CONTINUE      IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT4 1001 CONTINUE 1003 CONTINUE      SEGDES IPT1,IPT2      IF (IPT3.NE.0) SEGDES IPT3      IF (LISOBJ(/1).NE.0.AND.IERR.EQ.0) GOTO 2000      CALL ERREUR(26)      SEGSUP LISOBJ      RETURN 2000 IF (LISOBJ(/1).GT.1) GOTO 2001      IPT4=LISOBJ(1)      SEGDES IPT4      GOTO 2002 2001 NBNN=0      NBELEM=0      NBREF=0      NBSOUS=LISOBJ(/1)      SEGINI IPT4      DO 2010 IOB=1,LISOBJ(/1)      IPT7=LISOBJ(IOB)      SEGDES IPT7      IPT4.LISOUS(IOB)=IPT7 2010 CONTINUE 2002 SEGSUP LISOBJ      CALL ECROBJ('MAILLAGE',IPT4)      RETURN      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales