Télécharger racpor.eso

Retour à la liste

Numérotation des lignes :

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

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