1 : C PRLIAI SOURCE PV 07/11/23 21:18:43 5978 2 : C 3 : C CE SOUS PROGRAMME PREPARE LES DONNEES POUR LES ELEMENTS 4 : C LIAISON NORMAUX OU LES ELEMENTS LIAISON POREUX (BALD) 5 : C 6 : SUBROUTINE PRLIAI 7 : IMPLICIT INTEGER(I-N) 8 : implicit real*8 (a-h,o-z) 9 : -INC CCOPTIO 10 : -INC SMELEME 11 : -INC CCGEOME 12 : SEGMENT LISOBJ(0) 13 : REAL*8 XXX 14 : IPT3=0 15 : XXX=DENSIT/10. 15 : CALL LIRREE(XXX,0,IRETOU) 16 : CRIT=ABS(REAL(XXX)) 17 : 20 CONTINUE 17 : IF (CRIT.EQ.0.) CALL ERREUR(21) 18 : IF (IERR.NE.0) RETURN 18 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 18 : CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU) 18 : CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU) 19 : IF (IERR.NE.0) RETURN 20 : SEGACT IPT1 21 : SEGACT IPT2 22 : IF (IPT3.NE.0) SEGACT IPT3 23 : SEGINI LISOBJ 24 : C 25 : C ON RECHERCHE LES PARTIES DE MEME TYPE 26 : C 27 : IPT4=IPT1 28 : DO 1001 IOBI=1,MAX(1,IPT1.LISOUS(/1)) 29 : IF (IPT1.LISOUS(/1).NE.0) THEN 30 : IPT4=IPT1.LISOUS(IOBI) 31 : SEGACT IPT4 32 : ENDIF 33 : IF (KSURF(IPT4.ITYPEL).NE.IPT4.ITYPEL) GOTO 1002 34 : IPT5=IPT2 35 : DO 1006 IOBJ=1,MAX(1,IPT2.LISOUS(/1)) 36 : IF (IPT2.LISOUS(/1).NE.0) THEN 37 : IPT5=IPT2.LISOUS(IOBJ) 38 : SEGACT IPT5 39 : ENDIF 40 : IF (KSURF(IPT5.ITYPEL).NE.IPT5.ITYPEL) GOTO 1007 41 : IF (IPT4.ITYPEL.NE.IPT5.ITYPEL) GOTO 1007 42 : IF (IPT3.NE.0) THEN 43 : C 44 : C CAS DES ELELMENTS JOINTS POREUX 45 : C 46 : IPT6=IPT3 47 : DO 1008 IOBK=1,MAX(1,IPT3.LISOUS(/1)) 48 : IF (IPT3.LISOUS(/1).NE.0) THEN 49 : IPT6=IPT3.LISOUS(IOBK) 50 : SEGACT IPT6 51 : ENDIF 52 : IF (KSURF(IPT6.ITYPEL).NE.IPT6.ITYPEL) GOTO 1009 53 : IF (IPT4.ITYPEL.EQ.IPT6.ITYPEL) GOTO 1009 54 : IF (NBSOM(IPT4.ITYPEL).NE.NBSOM(IPT6.ITYPEL)) GOTO 1009 55 : IPT7=0 55 : CALL LIAPOR(IPT4,IPT5,IPT6,IPT7,CRIT) 56 : IF (IERR.NE.0) GOTO 1003 57 : IF (IPT7.NE.0) LISOBJ(**)=IPT7 58 : 1009 CONTINUE 59 : IF (IPT3.LISOUS(/1).NE.0) SEGDES IPT6 60 : 1008 CONTINUE 61 : ELSE 62 : C 63 : C CAS DES ELELMENTS JOINTS NORMAUX 64 : C 65 : IPT7=0 65 : CALL LIAISO(IPT4,IPT5,IPT7,CRIT) 66 : IF (IERR.NE.0) GOTO 1003 67 : IF (IPT7.NE.0) LISOBJ(**)=IPT7 68 : END IF 69 : 1007 CONTINUE 70 : IF (IPT2.LISOUS(/1).NE.0) SEGDES IPT5 71 : 1006 CONTINUE 72 : 1002 CONTINUE 73 : IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT4 74 : 1001 CONTINUE 75 : 1003 CONTINUE 76 : SEGDES IPT1,IPT2 77 : IF (IPT3.NE.0) SEGDES IPT3 78 : IF (LISOBJ(/1).NE.0.AND.IERR.EQ.0) GOTO 2000 78 : CALL ERREUR(26) 79 : SEGSUP LISOBJ 80 : RETURN 81 : 2000 IF (LISOBJ(/1).GT.1) GOTO 2001 82 : IPT4=LISOBJ(1) 83 : SEGDES IPT4 84 : GOTO 2002 85 : 2001 NBNN=0 86 : NBELEM=0 87 : NBREF=0 88 : NBSOUS=LISOBJ(/1) 89 : SEGINI IPT4 90 : DO 2010 IOB=1,LISOBJ(/1) 91 : IPT7=LISOBJ(IOB) 92 : SEGDES IPT7 93 : IPT4.LISOUS(IOB)=IPT7 94 : 2010 CONTINUE 95 : 2002 SEGSUP LISOBJ 95 : CALL ECROBJ('MAILLAGE',IPT4) 96 : RETURN 97 : END 98 : 99 : 100 : 101 : 102 : 103 : 104 : 105 : 106 :
© Cast3M 2003 - All rights reserved.
Disclaimer