Télécharger raccor.eso

Retour à la liste

Numérotation des lignes :

  1. C RACCOR SOURCE BP208322 16/11/18 21:20:39 9177
  2. C FABRIQUE LES ELEMENTS RACCORD ENTRE DEUX LIGNES
  3. C EXTRAIT DE COCO
  4. C
  5. SUBROUTINE RACCOR(IPT1,IPT2,MELEME,PREC)
  6.  
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. -INC CCOPTIO
  10. -INC CCGEOME
  11. -INC CCREEL
  12. *-
  13. -INC SMELEME
  14. -INC SMCOORD
  15. SEGMENT MTRAV
  16. REAL*8 TA(NBELEM)
  17. INTEGER NP1(NBELE1),NP2(NBELE1)
  18. ENDSEGMENT
  19. C* DIMENSION ITEST(0:NBCOUL-1) - NBCOUL stocke dans CCGEOME
  20. DIMENSION ITEST(0:30)
  21.  
  22. SEGACT,MCOORD
  23. IDIMP1 = IDIM+1
  24.  
  25. PREC3=3.*PREC
  26. TMAX=-XGRAND
  27. TMIN= XGRAND
  28.  
  29. NB1=IPT1.NUM(/2)
  30. NB2=IPT2.NUM(/2)
  31. NBMAX=MIN(NB1,NB2)
  32. NBNN=IPT1.NUM(/1)
  33. IF (NBNN.NE.IPT2.NUM(/1)) THEN
  34. CALL ERREUR(16)
  35. RETURN
  36. ENDIF
  37. DO 40 I=0,NBCOUL-1
  38. 40 ITEST(I)=0
  39. DO 41 I=1,NB1
  40. ITEST(IPT1.ICOLOR(I))=1
  41. 41 CONTINUE
  42. DO 42 I=1,NB2
  43. ITEST(IPT2.ICOLOR(I))=1
  44. 42 CONTINUE
  45. ICHCOL=-1
  46. DO 43 I=0,NBCOUL-1
  47. IF (ITEST(I).EQ.1) THEN
  48. IF (ICHCOL.EQ.-1) THEN
  49. ICHCOL=I
  50. ELSE
  51. ICHCOL=ITABM(ICHCOL,I)
  52. ENDIF
  53. ENDIF
  54. 43 CONTINUE
  55. NBELEM=NB2
  56. NBELE1=NBELEM+1
  57. SEGINI MTRAV
  58. DO 11 I=1,NB2
  59. Z=0.
  60. DO 12 J=1,NBNN
  61. IREF=IPT2.NUM(J,I)*IDIMP1-IDIM
  62. Z=Z+ABS(XCOOR(IREF))+ABS(XCOOR(IREF+1))
  63. IF (IDIM.NE.2) Z=Z+ABS(XCOOR(IREF+2))
  64. 12 CONTINUE
  65. Z=Z/NBNN
  66. TA(I)=Z
  67. IF(Z.GT.TMAX) TMAX=Z
  68. IF(Z.LT.TMIN) TMIN=Z
  69. 11 CONTINUE
  70. C
  71. C CLASSEMENT APPROXIMATIF PAR ' DISTANCE '
  72. C
  73. IF ((ABS(TMAX).GE.XPETIT).AND.(TMAX-TMIN)/TMAX.GE.1E-6) GOTO 6
  74. TMAX=TMAX+1.
  75. TMIN=TMIN-1.
  76. 6 CONTINUE
  77. TDEC=(TMAX-TMIN)/NBELEM*1.0001
  78. N =int( PREC/TDEC) + 1
  79. C* Boucle 3 redeondante avec SEGINI MTRAV
  80. C* DO 3 I=1,NBELE1
  81. C* 3 NP1(I)=0
  82. DO 4 I=1,NBELEM
  83. IPLA=int((TA(I)-TMIN)/TDEC)+1
  84. 4 NP1(IPLA)=NP1(IPLA)+1
  85. DO 400 I=2,NBELE1
  86. 400 NP1(I)=NP1(I-1)+NP1(I)
  87. DO 5 I=1,NBELEM
  88. IPLA=int((TA(I)-TMIN)/TDEC)+1
  89. IPLB=NP1(IPLA)
  90. NP1(IPLA)=NP1(IPLA)-1
  91. NP2(IPLB)=I
  92. 5 CONTINUE
  93. C
  94. C DANS NP1 ADDRESSE DU DEBUT DE ZONE
  95. C DANS NP2 NUMERO DES ELEMENTS EN NUMEROTATION LOCALE
  96. C DANS TA DISTANCE DES ELEMENTS
  97. C
  98. C IL FAUT PREPARER LE SEGMENT TAMPON OU METTRE LES ELEMS CREES.
  99. NBREF=0
  100. NBSOUS=0
  101. NBNNOR=NBNN
  102. NBNN=2*NBNN
  103. NBELEM=NB1+NB2
  104. SEGINI MELEME
  105. IPT4=MELEME
  106. NBT=NBELEM
  107. NBELEM=NB2
  108. NUMELG=0
  109. C
  110. C BOUCLE SUR TOUS LES ELEMENTS POUR CONNAITRE LEUR FACES ET REGARDER SI
  111. C LE CENTRE DE GRAVITE EST CONFONDU A PREC PRES DE CELUI D'UN ELEMENT
  112. C COQUE
  113. DO 20 I=1,NB1
  114. ZAA=0.
  115. DO 21 J=1,NBNNOR
  116. IREF=IPT1.NUM(J,I)*IDIMP1-IDIM
  117. ZAA=ZAA+ABS(XCOOR(IREF))+ABS(XCOOR(IREF+1))
  118. IF (IDIM.NE.2) ZAA=ZAA+ABS(XCOOR(IREF+2))
  119. 21 CONTINUE
  120. ZAA=ZAA/NBNNOR
  121. IZO=int((ZAA-TMIN)/TDEC)+1
  122. IZO1=IZO-N
  123. IZO2=IZO+N
  124. IF(IZO1.LT.1) IZO1=1
  125. IF(IZO2.GT.NBELEM) IZO2=NBELEM
  126. IF (IZO.LT.0.OR.IZO.GT.NBELE1) GOTO 20
  127. DO 28 IZO=IZO1,IZO2
  128. IDEP=NP1(IZO)+1
  129. IFIN=NP1(IZO+1)
  130. IF(IFIN.LT.IDEP) GO TO 28
  131. DO 23 JFA=IDEP,IFIN
  132. IB=NP2(JFA)
  133. IF(ABS(TA(IB)-ZAA).GT.PREC3) GO TO 23
  134. C ON VIENT D'IDENTIFIER UN ELEMENT DE RACCOR ON VA LE CREER
  135. IREFA=IPT1.NUM(1,I)*IDIMP1-IDIM
  136. DO 24 IK=1,NBNNOR
  137. IREFB=IPT2.NUM(IK,IB)*IDIMP1-IDIM
  138. IF (ABS(XCOOR(IREFA)-XCOOR(IREFB)).GT.PREC) GOTO 24
  139. IF (ABS(XCOOR(1+IREFA)-XCOOR(1+IREFB)).GT.PREC) GOTO 24
  140. IF (ABS(XCOOR(2+IREFA)-XCOOR(2+IREFB)).GT.PREC.AND.IDIM.NE.2) GOTO
  141. # 24
  142. ISTA=IK
  143. GO TO 26
  144. 24 CONTINUE
  145. GO TO 23
  146. 26 CONTINUE
  147. ISENS=1
  148. ISTA1=ISTA+1
  149. ISTAA=ISTA
  150. IF (ISTA1.GT.NBNNOR) ISTA1=1
  151. IREFA=IPT1.NUM(2,I)*IDIMP1-IDIM
  152. IREFB=IPT2.NUM(ISTA1,IB)*IDIMP1-IDIM
  153. Z=XCOOR(IREFA)-XCOOR(IREFB)
  154. IF(ABS(Z).GT.PREC) ISENS=-1
  155. Z=XCOOR(IREFA+1)-XCOOR(IREFB+1)
  156. IF(ABS(Z).GT.PREC) ISENS=-1
  157. IF (IDIM.NE.2) THEN
  158. Z=XCOOR(IREFA+2)-XCOOR(IREFB+2)
  159. IF (ABS(Z).GT.PREC) ISENS=-1
  160. ENDIF
  161. DO 30 IJ=2,NBNNOR
  162. IREFA=IPT1.NUM(IJ,I)*IDIMP1-IDIM
  163. ISTAA=ISTAA+ISENS
  164. IF (ISTAA.EQ.0) ISTAA=NBNNOR
  165. IF (ISTAA.GT.NBNNOR) ISTAA=1
  166. IREFB=IPT2.NUM(ISTAA,IB)*IDIMP1-IDIM
  167. DO 32 KLP=1,IDIM
  168. Z=XCOOR(IREFA+KLP-1)-XCOOR(IREFB+KLP-1)
  169. IF(ABS(Z).GT.PREC) GO TO 23
  170. 32 CONTINUE
  171. 30 CONTINUE
  172. C CREATION D'UN ELEM RACCORD
  173. NUMELG=NUMELG+1
  174. IF (NUMELG.GT.NBMAX) CALL ERREUR(31)
  175. IF (IERR.NE.0) GOTO 101
  176. DO 27 IK=1,NBNNOR
  177. IP1=IPT1.NUM(IK,I)
  178. IP2=IPT2.NUM(ISTA,IB)
  179. NUM(IK,NUMELG)=IP1
  180. NUM(NBNN-IK+1,NUMELG)=IP2
  181. ISTA=ISTA+ISENS
  182. IF (ISTA.EQ.0) ISTA=NBNNOR
  183. IF (ISTA.GT.NBNNOR) ISTA=1
  184. IF (IP1.NE.IP2) GOTO 27
  185. INTERR(1)=NUMELG
  186. CALL ERREUR(101)
  187. 27 CONTINUE
  188. 23 CONTINUE
  189. 28 CONTINUE
  190. 20 CONTINUE
  191. WRITE(IOIMP,29) NUMELG
  192. 29 FORMAT(//,' NOMBRE D''ELEMENTS DE RACCORD CREES : ',I5)
  193. NBELEM=NUMELG
  194. MELEME = 0
  195. IF (NBELEM.EQ.0) THEN
  196. CALL ERREUR(26)
  197. GOTO 101
  198. ENDIF
  199. SEGINI MELEME
  200. IF (NBNN.EQ.4) ITYPEL=12
  201. IF (NBNN.EQ.6) ITYPEL=13
  202. DO 100 J=1,NBELEM
  203. ICOLOR(J)=ICHCOL
  204. DO 100 I=1,NBNN
  205. NUM(I,J)=IPT4.NUM(I,J)
  206. 100 CONTINUE
  207. 101 SEGSUP IPT4
  208. SEGSUP MTRAV
  209.  
  210. RETURN
  211. END
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  

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