Numérotation des lignes :

1. C PRLIAI SOURCE BP208322 16/11/18 21:20:11 9177
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.
16. CALL LIRREE(XXX,0,IRETOU)
17. CRIT=ABS(REAL(XXX))
18. 20 CONTINUE
19. IF (CRIT.EQ.0.) CALL ERREUR(21)
20. IF (IERR.NE.0) RETURN
21. CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
22. CALL LIROBJ('MAILLAGE',IPT2,1,IRETOU)
23. CALL LIROBJ('MAILLAGE',IPT3,0,IRETOU)
24. IF (IERR.NE.0) RETURN
25. SEGACT IPT1
26. SEGACT IPT2
27. IF (IPT3.NE.0) SEGACT IPT3
28. SEGINI LISOBJ
29. C
30. C ON RECHERCHE LES PARTIES DE MEME TYPE
31. C
32. IPT4=IPT1
33. DO 1001 IOBI=1,MAX(1,IPT1.LISOUS(/1))
34. IF (IPT1.LISOUS(/1).NE.0) THEN
35. IPT4=IPT1.LISOUS(IOBI)
36. SEGACT IPT4
37. ENDIF
38. IF (KSURF(IPT4.ITYPEL).NE.IPT4.ITYPEL) GOTO 1002
39. IPT5=IPT2
40. DO 1006 IOBJ=1,MAX(1,IPT2.LISOUS(/1))
41. IF (IPT2.LISOUS(/1).NE.0) THEN
42. IPT5=IPT2.LISOUS(IOBJ)
43. SEGACT IPT5
44. ENDIF
45. IF (KSURF(IPT5.ITYPEL).NE.IPT5.ITYPEL) GOTO 1007
46. IF (IPT4.ITYPEL.NE.IPT5.ITYPEL) GOTO 1007
47. IF (IPT3.NE.0) THEN
48. C
49. C CAS DES ELELMENTS JOINTS POREUX
50. C
51. IPT6=IPT3
52. DO 1008 IOBK=1,MAX(1,IPT3.LISOUS(/1))
53. IF (IPT3.LISOUS(/1).NE.0) THEN
54. IPT6=IPT3.LISOUS(IOBK)
55. SEGACT IPT6
56. ENDIF
57. IF (KSURF(IPT6.ITYPEL).NE.IPT6.ITYPEL) GOTO 1009
58. IF (IPT4.ITYPEL.EQ.IPT6.ITYPEL) GOTO 1009
59. IF (NBSOM(IPT4.ITYPEL).NE.NBSOM(IPT6.ITYPEL)) GOTO 1009
60. IPT7=0
61. CALL LIAPOR(IPT4,IPT5,IPT6,IPT7,CRIT)
62. IF (IERR.NE.0) GOTO 1003
63. IF (IPT7.NE.0) LISOBJ(**)=IPT7
64. 1009 CONTINUE
65. IF (IPT3.LISOUS(/1).NE.0) SEGDES IPT6
66. 1008 CONTINUE
67. ELSE
68. C
69. C CAS DES ELELMENTS JOINTS NORMAUX
70. C
71. IPT7=0
72. CALL LIAISO(IPT4,IPT5,IPT7,CRIT)
73. IF (IERR.NE.0) GOTO 1003
74. IF (IPT7.NE.0) LISOBJ(**)=IPT7
75. END IF
76. 1007 CONTINUE
77. IF (IPT2.LISOUS(/1).NE.0) SEGDES IPT5
78. 1006 CONTINUE
79. 1002 CONTINUE
80. IF (IPT1.LISOUS(/1).NE.0) SEGDES IPT4
81. 1001 CONTINUE
82. 1003 CONTINUE
83. SEGDES IPT1,IPT2
84. IF (IPT3.NE.0) SEGDES IPT3
85. IF (LISOBJ(/1).NE.0.AND.IERR.EQ.0) GOTO 2000
86. CALL ERREUR(26)
87. SEGSUP LISOBJ
88. RETURN
89. 2000 IF (LISOBJ(/1).GT.1) GOTO 2001
90. IPT4=LISOBJ(1)
91. SEGDES IPT4
92. GOTO 2002
93. 2001 NBNN=0
94. NBELEM=0
95. NBREF=0
96. NBSOUS=LISOBJ(/1)
97. SEGINI IPT4
98. DO 2010 IOB=1,LISOBJ(/1)
99. IPT7=LISOBJ(IOB)
100. SEGDES IPT7
101. IPT4.LISOUS(IOB)=IPT7
102. 2010 CONTINUE
103. 2002 SEGSUP LISOBJ
104. CALL ECROBJ('MAILLAGE',IPT4)
105. RETURN
106. END
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.

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