Télécharger liapor.eso

Retour à la liste

Numérotation des lignes :

  1. C LIAPOR SOURCE BP208322 16/11/18 21:18:44 9177
  2. C
  3. C FABRIQUE LES ELEMENTS LIAISON POUR LES ELEMENTS JOINT POREUX (BALD).
  4. C CES ELEMENTS JOINTS SONT COMPOSES PAR TROIS SURFACES: LES SURFACES TOP
  5. C ET BOT SONT MAILLEES AVEC DES ELEMENTS QUA8 (TRI6), LA SURFACE AU
  6. C MILIEU AVEC DES QUA4 (TRI3). L'ELEMENT LIAISON CREE A 20 (15) NOEUDS.
  7. C
  8. SUBROUTINE LIAPOR(IPT1,IPT2,IPT3,MELEME,PREC)
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8 (a-h,o-z)
  11. -INC CCOPTIO
  12. -INC CCGEOME
  13. -INC CCREEL
  14.  
  15. -INC SMELEME
  16. -INC SMCOORD
  17. SEGMENT MTRAV
  18. REAL*8 TA(NBELEM)
  19. INTEGER NP1(NBELE1),NP2(NBELE1)
  20. ENDSEGMENT
  21. C* DIMENSION ITEST(0:NBCOUL-1) - NBCOUL stocke dans CCGEOME
  22. DIMENSION ITEST(0:15)
  23.  
  24. IDIMP1 = IDIM+1
  25. SEGACT MCOORD
  26. PREC3=3.*PREC
  27. TMAX=-XGRAND
  28. TMIN= XGRAND
  29. NB1=IPT1.NUM(/2)
  30. NB2=IPT2.NUM(/2)
  31. NB3=IPT3.NUM(/2)
  32. NBMAX=MIN(NB1,NB2,NB3)
  33. NBNN=IPT1.NUM(/1)
  34. NBNM=IPT3.NUM(/1)
  35. IF ((NBNN.NE.IPT2.NUM(/1)).OR.(NBNN.EQ.NBNM).OR.
  36. . (NBSOM(IPT1.ITYPEL).NE.NBSOM(IPT3.ITYPEL))) THEN
  37. CALL ERREUR(16)
  38. RETURN
  39. ENDIF
  40.  
  41. DO 40 I=0,(NBCOUL-1)
  42. ITEST(I)=0
  43. 40 CONTINUE
  44. DO 41 I=1,NB1
  45. ITEST(IPT1.ICOLOR(I))=1
  46. 41 CONTINUE
  47. DO 42 I=1,NB2
  48. ITEST(IPT2.ICOLOR(I))=1
  49. 42 CONTINUE
  50. DO 43 I=1,NB3
  51. ITEST(IPT3.ICOLOR(I))=1
  52. 43 CONTINUE
  53. ICHCOL=-1
  54. DO 44 I=0,(NBCOUL-1)
  55. IF (ITEST(I).EQ.1) THEN
  56. IF (ICHCOL.EQ.-1) THEN
  57. ICHCOL=I
  58. ELSE
  59. ICHCOL=ITABM(ICHCOL,I)
  60. ENDIF
  61. ENDIF
  62. 44 CONTINUE
  63.  
  64. NBELEM=NB2
  65. NBELE1=NBELEM+1
  66. SEGINI,MTRAV
  67. DO 11 I=1,NB2
  68. Z=0.
  69. DO 12 J=1,NBNN
  70. IREF=IPT2.NUM(J,I)*IDIMP1-IDIM
  71. Z=Z+XCOOR(IREF)+XCOOR(IREF+1)
  72. IF (IDIM.NE.2) Z=Z+XCOOR(IREF+2)
  73. 12 CONTINUE
  74. Z=Z/NBNN
  75. TA(I)=Z
  76. IF(Z.GT.TMAX) TMAX=Z
  77. IF(Z.LT.TMIN) TMIN=Z
  78. 11 CONTINUE
  79. C
  80. C CLASSEMENT APPROXIMATIF PAR ' DISTANCE '
  81. C
  82. IF ((TMAX-TMIN)/TMAX.GE.1E-6) GOTO 6
  83. TMAX=TMAX+1.
  84. TMIN=TMIN-1.
  85. 6 CONTINUE
  86. TDEC=(TMAX-TMIN)/NBELEM*1.0001
  87. N = PREC/TDEC + 1.
  88. C* Boucle 3 redondante avec SEGINI,MTRAV
  89. C* DO 3 I=1,NBELE1
  90. C* 3 NP1(I)=0
  91. DO 4 I=1,NBELEM
  92. IPLA=(TA(I)-TMIN)/TDEC+1.
  93. 4 NP1(IPLA)=NP1(IPLA)+1
  94. DO 400 I=2,NBELE1
  95. 400 NP1(I)=NP1(I-1)+NP1(I)
  96. DO 5 I=1,NBELEM
  97. IPLA=(TA(I)-TMIN)/TDEC+1.
  98. IPLB=NP1(IPLA)
  99. NP1(IPLA)=NP1(IPLA)-1
  100. NP2(IPLB)=I
  101. 5 CONTINUE
  102. C
  103. C DANS NP1 ADDRESSE DU DEBUT DE ZONE
  104. C DANS NP2 NUMERO DES ELEMENTS EN NUMEROTATION LOCALE
  105. C DANS TA DISTANCE DES ELEMENTS
  106. C
  107. C IL FAUT PREPARER LE SEGMENT TAMPON OU METTRE LES ELEMS CREES.
  108. NBREF=0
  109. NBSOUS=0
  110. NBNNOR=NBNN
  111. NBNN=2*NBNN+NBNM
  112. NBELEM=NB1+NB2
  113. SEGINI MELEME
  114. IPT4=MELEME
  115. NBELEM=NB2
  116. NUMELG=0
  117. C
  118. C BOUCLE SUR TOUS LES ELEMENTS POUR CONNAITRE LEUR FACES ET REGARDER SI
  119. C LE CENTRE DE GRAVITE EST CONFONDU A PREC PRES DE CELUI D'UN ELEMENT
  120. C COQUE
  121. C
  122. DO 20 I=1,NB1
  123. ZAA=0.
  124. DO 21 J=1,NBNNOR
  125. IREF=IPT1.NUM(J,I)*IDIMP1-IDIM
  126. ZAA=ZAA+XCOOR(IREF)+XCOOR(IREF+1)
  127. IF (IDIM.NE.2) ZAA=ZAA+XCOOR(IREF+2)
  128. 21 CONTINUE
  129. ZAA=ZAA/NBNNOR
  130. IZO=(ZAA-TMIN)/TDEC+1.
  131. IZO1=IZO-N
  132. IZO2=IZO+N
  133. IF(IZO1.LT.1) IZO1=1
  134. IF(IZO2.GT.NBELEM) IZO2=NBELEM
  135. IF (IZO.LT.0.OR.IZO.GT.NBELE1) GOTO 20
  136. DO 28 IZO=IZO1,IZO2
  137. IDEP=NP1(IZO)+1
  138. IFIN=NP1(IZO+1)
  139. IF(IFIN.LT.IDEP) GO TO 28
  140. DO 23 JFA=IDEP,IFIN
  141. IB=NP2(JFA)
  142. IF(ABS(TA(IB)-ZAA).GT.PREC3) GO TO 23
  143. IREFA=IPT1.NUM(1,I)*IDIMP1-IDIM
  144. DO 24 IK=1,NBNNOR
  145. IREFB=IPT2.NUM(IK,IB)*IDIMP1-IDIM
  146. IF (ABS(XCOOR(IREFA)-XCOOR(IREFB)).GT.PREC) GOTO 24
  147. IF (ABS(XCOOR(1+IREFA)-XCOOR(1+IREFB)).GT.PREC) GOTO 24
  148. IF (ABS(XCOOR(2+IREFA)-XCOOR(2+IREFB)).GT.PREC.AND.IDIM.NE.2)
  149. # GOTO 24
  150. ISTA=IK
  151. GO TO 26
  152. 24 CONTINUE
  153. GO TO 23
  154. 26 CONTINUE
  155. ISENS=1
  156. ISTA1=ISTA+1
  157. ISTAA=ISTA
  158. IF (ISTA1.GT.NBNNOR) ISTA1=1
  159. IREFA=IPT1.NUM(2,I)*IDIMP1-IDIM
  160. IREFB=IPT2.NUM(ISTA1,IB)*IDIMP1-IDIM
  161. Z=XCOOR(IREFA)-XCOOR(IREFB)
  162. IF(ABS(Z).GT.PREC) ISENS=-1
  163. Z=XCOOR(IREFA+1)-XCOOR(IREFB+1)
  164. IF(ABS(Z).GT.PREC) ISENS=-1
  165. IF (IDIM.NE.2) THEN
  166. Z=XCOOR(IREFA+2)-XCOOR(IREFB+2)
  167. IF (ABS(Z).GT.PREC) ISENS=-1
  168. ENDIF
  169. DO 30 IJ=2,NBNNOR
  170. IREFA=IPT1.NUM(IJ,I)*IDIMP1-IDIM
  171. ISTAA=ISTAA+ISENS
  172. IF (ISTAA.EQ.0) ISTAA=NBNNOR
  173. IF (ISTAA.GT.NBNNOR) ISTAA=1
  174. IREFB=IPT2.NUM(ISTAA,IB)*IDIMP1-IDIM
  175. DO 32 KLP=1,IDIM
  176. Z=XCOOR(IREFA+KLP-1)-XCOOR(IREFB+KLP-1)
  177. IF(ABS(Z).GT.PREC) GO TO 23
  178. 32 CONTINUE
  179. 30 CONTINUE
  180. C
  181. IZC=(ZAA-TMIN)/TDEC+1.
  182. DO 33 IC=1,NB3
  183. Z=0.
  184. DO 31 J=1,NBNM
  185. IREF=IPT3.NUM(J,IC)*IDIMP1-IDIM
  186. Z=Z+XCOOR(IREF)+XCOOR(IREF+1)
  187. IF (IDIM.NE.2) Z=Z+XCOOR(IREF+2)
  188. 31 CONTINUE
  189. Z=Z/NBNM
  190. IF(ABS(ZAA-Z).GT.PREC3) GO TO 33
  191. C ON VIENT D'IDENTIFIER UN ELEMENT DE RACCOR ON VA LE CREER
  192. IREFA=IPT1.NUM(1,I)*IDIMP1-IDIM
  193. DO 34 IK=1,NBNM
  194. IREFB=IPT3.NUM(IK,IC)*IDIMP1-IDIM
  195. IF (ABS(XCOOR(IREFA)-XCOOR(IREFB)).GT.PREC) GOTO 34
  196. IF (ABS(XCOOR(1+IREFA)-XCOOR(1+IREFB)).GT.PREC) GOTO 34
  197. IF (ABS(XCOOR(2+IREFA)-XCOOR(2+IREFB)).GT.PREC.AND.IDIM.NE.2)
  198. # GOTO 34
  199. ISTC=IK
  200. GO TO 36
  201. 34 CONTINUE
  202. GO TO 33
  203. 36 CONTINUE
  204. ISENT=1
  205. ISTC1=ISTC+1
  206. ISTCC=ISTC
  207. IF (ISTC1.GT.NBNM) ISTC1=1
  208. IREFA=IPT1.NUM(3,I)*IDIMP1-IDIM
  209. IREFB=IPT3.NUM(ISTC1,IC)*IDIMP1-IDIM
  210. Z=XCOOR(IREFA)-XCOOR(IREFB)
  211. IF(ABS(Z).GT.PREC) ISENT=-1
  212. Z=XCOOR(IREFA+1)-XCOOR(IREFB+1)
  213. IF(ABS(Z).GT.PREC) ISENT=-1
  214. IF (IDIM.NE.2) THEN
  215. Z=XCOOR(IREFA+2)-XCOOR(IREFB+2)
  216. IF (ABS(Z).GT.PREC) ISENT=-1
  217. ENDIF
  218. DO 50 IJ=3,NBNNOR,2
  219. IREFA=IPT1.NUM(IJ,I)*IDIMP1-IDIM
  220. ISTCC=ISTCC+ISENT
  221. IF (ISTCC.EQ.0) ISTCC=NBNM
  222. IF (ISTCC.GT.NBNM) ISTCC=1
  223. IREFB=IPT3.NUM(ISTCC,IC)*IDIMP1-IDIM
  224. DO 52 KLP=1,IDIM
  225. Z=XCOOR(IREFA+KLP-1)-XCOOR(IREFB+KLP-1)
  226. IF(ABS(Z).GT.PREC) GO TO 33
  227. 52 CONTINUE
  228. 50 CONTINUE
  229. C CREATION D'UN ELEM RACCORD
  230. NUMELG=NUMELG+1
  231. IF (NUMELG.GT.NBMAX) THEN
  232. CALL ERREUR(31)
  233. GOTO 101
  234. ENDIF
  235. IM=0
  236. DO 27 IK=1,NBNNOR
  237. IP1=IPT1.NUM(IK,I)
  238. IP2=IPT2.NUM(ISTA,IB)
  239. NUM(IK,NUMELG)=IP1
  240. NUM(NBNNOR+IK,NUMELG)=IP2
  241. ISTA=ISTA+ISENS
  242. IF (ISTA.EQ.0) ISTA=NBNNOR
  243. IF (ISTA.GT.NBNNOR) ISTA=1
  244. IF (IK.EQ.IBSOM(NSPOS(IPT1.ITYPEL)+IM)) THEN
  245. IM=IM+1
  246. IP3=IPT3.NUM(ISTC,IC)
  247. NUM(2*NBNNOR+IM,NUMELG)=IP3
  248. ISTC=ISTC+ISENT
  249. IF (ISTC.EQ.0) ISTC=NBNM
  250. IF (ISTC.GT.NBNM) ISTC=1
  251. IF ((IP1.NE.IP2).AND.(IP1.NE.IP3).AND.(IP2.NE.IP3)) GO TO 27
  252. INTERR(1)=NUMELG
  253. CALL ERREUR(101)
  254. ENDIF
  255. IF (IP1.NE.IP2) GO TO 27
  256. INTERR(1)=NUMELG
  257. CALL ERREUR(101)
  258. 27 CONTINUE
  259. 33 CONTINUE
  260. C
  261. 23 CONTINUE
  262. 28 CONTINUE
  263. 20 CONTINUE
  264. C WRITE(IOIMP,29) NUMELG
  265. C 29 FORMAT(//,' NOMBRE D''ELEMENTS DE LIAISON CREES : ',I5)
  266. NBELEM=NUMELG
  267. MELEME=0
  268. IF (NBELEM.EQ.0) GOTO 101
  269. SEGINI MELEME
  270. IF (NBNN.EQ.15) ITYPEL=30
  271. IF (NBNN.EQ.20) ITYPEL=31
  272. DO 100 J=1,NBELEM
  273. ICOLOR(J)=ICHCOL
  274. DO 100 I=1,NBNN
  275. NUM(I,J)=IPT4.NUM(I,J)
  276. 100 CONTINUE
  277. 101 SEGSUP IPT4
  278. SEGSUP MTRAV
  279. RETURN
  280. END
  281.  
  282.  
  283.  
  284.  
  285.  

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