Télécharger crbar1.eso

Retour à la liste

Numérotation des lignes :

crbar1
  1. C CRBAR1 SOURCE KICH 22/10/03 21:15:02 11473
  2. subroutine crbar1(iwrk3,ipmodl,ideb,ifin,xmultl,icle
  3. + ,d,pt1,pt2,jconl,ihg1,ihg2,xmn,ymn,zmn
  4. + ,xmx,ymx,zmx,hmxt,ihg,ith,ixlong,xlong2,xlg2m)
  5. C
  6. C
  7. C entree :
  8. C iwrk3 donne les adresses des vecteurs a passer a doxe
  9. C ipmodl le modele associe
  10. C ideb ifin zone a traiter par le thread ith
  11. C xmultl 1.5
  12. C icle = 1 normal 2 translation 3 sym // un point 4 // droite 5 // un plan
  13. C d distance au plan de l origine (icle=5)
  14. C pt1 icle = 5 vect normal au plan
  15. C icle = 2 vect de la translation
  16. c icle = 3 coordonnees du centre de symetrie
  17. c icle = 4 point de la droite pt2 vect directeur normee
  18. c ixlong numero chamelem de longueur s'il y a lieu
  19. c xlong2 longueur de recherche
  20. c
  21. c sorties :
  22. c jconl segment 1 elements gardes 0 elements exclus (cas symetries)
  23. C ihg1 ihg2 coordonnees des barycentres des elements
  24. c xmn ymn zmn min des coordonnees pour le tri
  25. C xmx ymx zmx max des coordonnes pour le tri
  26. C hmxt max de dist bary noeuds
  27. c ihg voir description du segment dans conne1
  28. c
  29. c routine appelee par conne1
  30.  
  31. implicit integer(i-n)
  32. implicit real*8(a-h,o-z)
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMMODEL
  36. -INC CCREEL
  37. -INC SMELEME
  38. -INC SMCOORD
  39. -INC SMCHAML
  40. C
  41. SEGMENT,WRK3
  42. INTEGER IWRK1(NSOUS,nbthr), IWRK2(NSOUS,nbthr),imptv(nsous)
  43. C iwrk1 pointe vers les wrk1 et iwrk2 pointe sur les wrk2
  44. ENDSEGMENT
  45. segment wrk1
  46. real*8 xe(3,nbno1)
  47. endsegment
  48. segment hg
  49. integer ielh(nbpb,2)
  50. real*8 hmax(nbpb)
  51. real*8 xll(nbpb)
  52. integer inoa(nbpb,nsous+1)
  53. endsegment
  54. segment conl
  55. integer iconl(nbpb)
  56. endsegment
  57. segment hg1
  58. real*8 hcoor(3*nbpb)
  59. endsegment
  60. pointeur hg2.hg1
  61. real*8 xmn(*),ymn(*),zmn(*)
  62. real*8 xmx(*),ymx(*),zmx(*),hmxt(*),xlg2m(*)
  63. real*8 pt1(*),pt2(*)
  64. c
  65. i1 = 0
  66. ik1 = 0
  67. mmodel = ipmodl
  68. wrk3 = iwrk3
  69. hg1 = ihg1
  70. hg2 = ihg2
  71. hg = ihg
  72. c
  73. xmin=xgrand
  74. ymin=xgrand
  75. zmin=xgrand
  76. xmax=-xgrand
  77. ymax=-xgrand
  78. zmax=-xgrand
  79. conl = jconl
  80. hmaxt = 0d0
  81. xlong2m = 0d0
  82. do ib = ideb, ifin
  83. iel = ielh(ib,1)
  84. izo = ielh(ib,2)
  85. imodel = kmodel(izo)
  86. wrk1 = iwrk1(izo,ith)
  87. meleme = imamod
  88. nbel = num(/2)
  89. nbno = num(/1)
  90. usnbno = 1d0 / nbno
  91. call doxe(xcoor,idim,nbno,num,iel,xe)
  92. xm = xe(1,1)
  93. ym = xe(2,1)
  94. zm = xe(3,1)
  95. do ino = 2, nbno
  96. xm = xm + xe(1,ino)
  97. ym = ym + xe(2,ino)
  98. zm = zm + xe(3,ino)
  99. enddo
  100. xm = xm * usnbno
  101. ym = ym * usnbno
  102. zm = zm * usnbno
  103. xm1 = xm
  104. ym1 = ym
  105. zm1 = zm
  106. xma = 0d0
  107. do ino = 1, nbno
  108. xma = max(xma,sqrt((xe(1,ino)-xm)**2
  109. + +(xe(2,ino)-ym)**2+(xe(3,ino)-zm)**2))
  110. enddo
  111. hmax(ib) = xma
  112. hmaxt = max (hmaxt,xma)
  113. if (ixlong.ne.0) then
  114. melval = imptv(izo)
  115. xlongm = 0d0
  116. nbglar = velche(/1)
  117. do igau = 1, nbglar
  118. xlongm = max(xlongm,velche(igau,min(ib,velche(/2))))
  119. enddo
  120. xlong2 = xlongm * xmultl
  121. xll(ib) = xlong2
  122. xlong2m = max(xlong2m,xlong2)
  123. endif
  124. C
  125. if (icle.eq.5) then
  126. C on garde les eles a moins de xlong de l ele de sym
  127. B1 = D + xm*PT1(1)+ym*pt1(2)+zm*pt1(3)
  128. IF ((abs(B1)-xma).LE.XLONG2) THEN
  129. b1 = 2. * b1
  130. xm1 = xm - b1*pt1(1)
  131. ym1 = ym - b1*pt1(2)
  132. zm1 = zm - b1*pt1(3)
  133. hg2.HCOOR((Ib -1)*3+1) = xm1
  134. hg2.HCOOR((Ib -1)*3+2) = ym1
  135. hg2.HCOOR((Ib -1)*3+3) = zm1
  136. HCOOR((Ib -1)*3+1) = xm
  137. HCOOR((Ib -1)*3+2) = ym
  138. HCOOR((Ib -1)*3+3) = zm
  139. else
  140. iconl(ib)=0
  141. ENDIF
  142. elseif (icle.eq.4) then
  143. C
  144. C on garde les eles a moins de xlong de l ele de sym
  145. C
  146. B1 = (xm-PT1(1))*pt2(1)
  147. + + (ym-pt1(2))*pt2(2)
  148. + + (zm-pt1(3))*PT2(3)
  149. C1 = (PT1(1)-xm+(b1*pt2(1)))**2
  150. + + (pt1(2)-ym+(b1*pt2(2)))**2
  151. + + (pt1(3)-zm+(b1*PT2(3)))**2
  152. C1 = sqrt(C1)
  153. IF ((C1-xma).LE.XLONG2) THEN
  154. xm1 = xm + 2. *(pt1(1)-xm+b1*pt2(1))
  155. ym1 = ym + 2. *(pt1(2)-ym+b1*pt2(2))
  156. zm1 = zm + 2. *(pt1(3)-zm+b1*pt2(3))
  157. hg2.HCOOR((Ib -1)*3+1) = xm1
  158. hg2.HCOOR((Ib -1)*3+2) = ym1
  159. hg2.HCOOR((Ib -1)*3+3) = zm1
  160. HCOOR((Ib -1)*3+1) = xm
  161. HCOOR((Ib -1)*3+2) = ym
  162. HCOOR((Ib -1)*3+3) = zm
  163. else
  164. iconl(ib)=0
  165. ENDIF
  166. elseif (icle.eq.3) then
  167. C
  168. C on garde les eles a moins de xlong de l ele de sym
  169. C
  170. B1 = (xm-PT1(1))**2 + (ym-pt1(2))**2
  171. + + (zm-pt1(3))**2
  172. B1 = sqrt(B1)
  173. IF ((B1-xma).LE.XLONG2) THEN
  174. xm1 = xm + 2. *(PT1(1)-xm)
  175. ym1 = ym + 2. *(PT1(2)-ym)
  176. zm1 = zm + 2. *(PT1(3)-zm)
  177. hg2.HCOOR((Ib -1)*3+1) = xm1
  178. hg2.HCOOR((Ib -1)*3+2) = ym1
  179. hg2.HCOOR((Ib -1)*3+3) = zm1
  180. HCOOR((Ib -1)*3+1) = xm
  181. HCOOR((Ib -1)*3+2) = ym
  182. HCOOR((Ib -1)*3+3) = zm
  183. else
  184. iconl(ib)=0
  185. endif
  186. elseif (icle.eq.2) then
  187. xm1 = xm + PT1(1)
  188. ym1 = ym + PT1(2)
  189. zm1 = zm + PT1(3)
  190. hg2.HCOOR((Ib-1)*3+1) = xm1
  191. hg2.HCOOR((Ib-1)*3+2) = ym1
  192. hg2.HCOOR((Ib-1)*3+3) = zm1
  193. HCOOR((Ib-1)*3+1) = xm
  194. HCOOR((Ib-1)*3+2) = ym
  195. HCOOR((Ib-1)*3+3) = zm
  196. else
  197. HCOOR((IB-1)*3+1) = xm
  198. HCOOR((IB-1)*3+2) = ym
  199. HCOOR((IB-1)*3+3) = zm
  200. endif
  201. xmax = max(xmax,xm1)
  202. ymax = max(ymax,ym1)
  203. zmax = max(zmax,zm1)
  204. xmin = min(xmin,xm1)
  205. ymin = min(ymin,ym1)
  206. zmin = min(zmin,zm1)
  207. enddo
  208. xmx(ith) = xmax
  209. ymx(ith) = ymax
  210. zmx(ith) = zmax
  211. xmn(ith) = xmin
  212. ymn(ith) = ymin
  213. zmn(ith) = zmin
  214. hmxt(ith)= hmaxt
  215. xlg2m(ith) = xlong2m
  216. return
  217. end
  218.  
  219.  
  220.  

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