Télécharger hsele1.eso

Retour à la liste

Numérotation des lignes :

hsele1
  1. C HSELE1 SOURCE KICH 22/11/21 21:15:03 11505
  2. subroutine hsele1(ith,ideb,ifin,imfopa,ihg1,ihg2
  3. + ,iwrk3,ishg,ihug,ihgsel,ihg,ipmodl,icle
  4. + ,imcord,ihgt,ixlong)
  5. C
  6. C
  7. C entree :
  8. C ith numero du thread
  9. C ideb ifin zone a traiter par la routine
  10. C mfopa contient le rang du premier elem d'une division apres le classement
  11. C ihg1 ihg2 coordonnees des barycentre si sym hg2 contient coord sym
  12. C iwrk3 adresse des vecteurs a passer a doxe
  13. C ishg nsym donne l'adresse des elements conservees dans la liste complete
  14. C ihug contient les adresse des ivecti
  15. C ihgsel contient information utile
  16. C ihg
  17. C ipmodl modele
  18. C icle 1 normal 2 translation 3 symetrie centrale 4 sym // droite 5 sym // plan
  19. C imcord contient coordonnees symetrique des noeuds (icle = 3 4 5)
  20. C ixlong pointeur vers chamelem de longueur de recherche
  21. C
  22. C sorties :
  23. C ivecti contient numero des elts connectes
  24. C nhug longueur remplie dans ivecti.lhug
  25. C inoa nombre d elements connectes par zone (nsous+1) nombre total pour un elt
  26. C
  27.  
  28.  
  29. implicit integer(i-n)
  30. implicit real*8(a-h,o-p)
  31. -INC CCREEL
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMMODEL
  35. -INC SMELEME
  36. -INC SMCOORD
  37.  
  38.  
  39. segment hgsele
  40. real*8 xmult,ymult,zmult
  41. real*8 hmaxt,xlong2,tmax,tmin,xlong2m
  42. integer nels,nbpb,ipass
  43. integer nbzt,indt,khug
  44. endsegment
  45. SEGMENT HG
  46. INTEGER IELH(nbpb,2)
  47. C IELH(i,1)=numero de l'element dans la sous zone
  48. C IELH(i,2)=numero de la sous zone
  49. C Tableau qui contient le max d(noeuds, barycentre)
  50. REAL*8 HMax(nbpb)
  51. C si ixlong different de zero contient le max de ixlong dans l'element
  52. REAL*8 XLL(nbpb)
  53. C Tableau qui contient nombre d'ele en connex par sous zone
  54. INTEGER INOA(nbpb,NSOUS+1)
  55. ENDSEGMENT
  56. C hgt contient les tableaux utile pour le tri
  57. SEGMENT HGT
  58. C integer ka(nels),kb(nels)
  59. C Tableau contenant proj ortho sur la droite apres tri
  60. REAL*8 Xp(nels)
  61. C Tableau auxiliaire pour triflot
  62. REAL*8 Xw(nels)
  63. C Tableau auxiliaire pour triflot
  64. INTEGER Ke(nels)
  65. C Tableau donne la correspondance entre le tableau trie et la numerotation de la zone 2
  66. INTEGER ICO(nels)
  67. ENDSEGMENT
  68.  
  69. SEGMENT,WRK1
  70. REAL*8 XE(3,nbno1)
  71. C coord des noeuds
  72. ENDSEGMENT
  73.  
  74. SEGMENT,WRK2
  75. REAL*8 XEJ(3,nbno1)
  76. ENDSEGMENT
  77.  
  78. SEGMENT,WRK3
  79. INTEGER IWRK1(NSOUS,nbthr), IWRK2(NSOUS,nbthr),imptv(nsous)
  80. C iwrk1 pointe vers les wrk1 et iwrk2 pointe sur les wrk2
  81. ENDSEGMENT
  82.  
  83. SEGMENT iVECTI
  84. INTEGER Lhug(JG)
  85. ENDSEGMENT
  86.  
  87. segment mlhug
  88. integer ilhug(nbthr)
  89. integer nhug(nbthr)
  90. endsegment
  91.  
  92. SEGMENT HG1
  93. REAL*8 HCOOR(3*nbpb)
  94. ENDSEGMENT
  95. pointeur hg2.hg1
  96. SEGMENT mfopa
  97. C Premier element dans un segment de la droite
  98. INTEGER ind(indt)
  99. ENDSEGMENT
  100. SEGMENT SHG
  101. INTEGER NSYM(NELS)
  102. ENDSEGMENT
  103. pointeur ipmail.MELEME
  104. pointeur mcord2.mcoord
  105.  
  106. hgt = ihgt
  107. mcord2 = imcord
  108. mmodel = ipmodl
  109. mfopa = imfopa
  110. hg1 = ihg1
  111. hg2 = ihg2
  112. wrk3 = iwrk3
  113. shg = ishg
  114. mlhug = ihug
  115.  
  116. C write(6,*) 'hsele1 ihug=',ihug
  117. hg = ihg
  118. nsous = iwrk1(/1)
  119. hgsele = ihgsel
  120. if (ipass.eq.2) then
  121. ivecti = ilhug(ith)
  122. endif
  123. khug1 = khug
  124. nhug1 = 0
  125. DO iiel1 = ideb, ifin
  126. iel1=iiel1
  127. if(icle.eq.5) iel1=nsym(iiel1)
  128. if(icle.eq.4) iel1=nsym(iiel1)
  129. if(icle.eq.3) iel1=nsym(iiel1)
  130.  
  131. tc = hg1.HCOOR((iiel1-1)*3+1) * xmult
  132. + + hg1.HCOOR((iiel1-1)*3+2) * ymult
  133. + + hg1.HCOOR((iiel1-1)*3+3) * zmult
  134. izo1 = IELH(iel1,2)
  135. inu1 = ielh(iel1,1)
  136. wrk1 = iwrk1(izo1,ith)
  137. IMODEL = KMODEL(izo1)
  138. IPMAIL = IMAMOD
  139. nbn1 = IPMAIL.num(/1)
  140. MELEME = IPMAIL
  141. CALL DOXE(XCOOR,IDIM,nbn1,NUM,inu1,XE)
  142. xkmax = hmax(iel1) + hmaxt
  143. if (ixlong.ne.0) xlong2 = xll(iel1)
  144. izg = nbzt*((tc-(xlong2+xkmax))-tmin)/(tmax-tmin)+1
  145. izg = max(izg,1)
  146. izg = min(izg,indt)
  147. indb = ind(izg)
  148. DO iiel2 = indb, nels
  149. iiel2t = ico(iiel2)
  150. iel2 = iiel2t
  151. if(icle.eq.5) iel2 = nsym(ico(iiel2))
  152. if(icle.eq.4) iel2 = nsym(ico(iiel2))
  153. if(icle.eq.3) iel2 = nsym(ico(iiel2))
  154. izo2 = IELH(iel2,2)
  155. inu2 = ielh(iel2,1)
  156. if (Xp(iiel2).gt.(tc+xlong2+xkmax)) GOTO 7
  157. wrk2 = iwrk2(izo2,ith)
  158. IMODEL = KMODEL(izo2)
  159. IPMAIL = IMAMOD
  160. nbn2 = IPMAIL.num(/1)
  161. MELEME = IMAMOD
  162. CALL DOXE(mcord2.XCOOR,IDIM,nbn2,num,inu2,XEJ)
  163. xd = sqrt(( hg1.hcoor((iiel1 -1)*3+1)
  164. + -hg2.hcoor((iiel2t -1)*3+1))**2
  165. + +( hg1.hcoor((iiel1 -1)*3+2)
  166. + -hg2.hcoor((iiel2t -1)*3+2))**2
  167. + +( hg1.hcoor((iiel1 -1)*3+3)
  168. + -hg2.hcoor((iiel2t -1)*3+3))**2)
  169. xxd=xd-xkmax
  170. IF (xxd.le.xlong2) then
  171. if (ipass.eq.1) goto 11
  172. DO ino1 = 1, nbn1
  173. DO ino2 = 1, nbn2
  174. XXLON2=0.D0
  175. DO IE3 = 1, IDIM
  176. XXLON2=XXLON2+(XE(IE3,Ino1)-
  177. + XEJ(IE3,Ino2))**2
  178. ENDDO
  179. IF(XXLON2.Lt.(XLONg2**2)) then
  180. GOTO 6
  181. endif
  182. ENDDO
  183. ENDDO
  184. GOTO 9
  185. else
  186. goto 9
  187. ENDIF
  188. 6 continue
  189. inoa(iel1,izo2)=inoa(iel1,izo2)+1
  190. INOA(IEL1,NSOUS+1)=INOA(IEL1,NSOUS+1)+1
  191. 11 continue
  192. nhug1 = nhug1 + 1
  193. if (ipass.eq.2) then
  194. lhug(nhug1)=iel2
  195. endif
  196. 9 Continue
  197. ENDDO
  198. 7 Continue
  199. ENDDO
  200. nhug(ith) = nhug1
  201. C
  202. return
  203. end
  204.  
  205.  
  206.  

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