Télécharger reduri.eso

Retour à la liste

Numérotation des lignes :

  1. C REDURI SOURCE CHAT 09/10/09 21:22:29 6519
  2. subroutine reduri(mrigid,moleme,irigre)
  3. implicit real*8(a-h,o-z)
  4. implicit integer (i-n)
  5. -INC SMRIGID
  6. -INC SMELEME
  7. -INC CCOPTIO
  8. -INC SMCOORD
  9. segment icpr(xcoor(/1)/(idim+1))
  10. segment inode(ino)
  11. segment jelnum(imaxel,ino)
  12. segment izone(imaxel,ino)
  13. irigre=0
  14. ipt1=moleme
  15. segact ipt1
  16. meleme=ipt1
  17. nbso1=ipt1.lisous(/1)
  18. ino=0
  19.  
  20. *
  21. * creation, d'une numerotation locale
  22. *
  23. segini icpr
  24. do 1 i =1, max(nbso1,1)
  25. if(nbso1.ne.0) then
  26. meleme=ipt1.lisous(i)
  27. segact meleme
  28. endif
  29. do 2 j=1,num(/2)
  30. do 2 k=1,num(/1)
  31. ia= num(k,j)
  32. if(icpr(ia).eq.0) then
  33. ino=ino+1
  34. icpr(ia)=ino
  35. endif
  36. 2 continue
  37. 1 continue
  38. *
  39. * on compte combien d'elements touche un noeud
  40. *
  41. segini inode
  42. do 3 i=1,max(nbso1,1)
  43. if(nbso1.ne.0) then
  44. meleme=ipt1.lisous(i)
  45. endif
  46. do 4 j=1,num(/2)
  47. do 4 k=1,num(/1)
  48. ia=num(k,j)
  49. ib= icpr(ia)
  50. inode(ib)=inode(ib)+1
  51. 4 continue
  52. 3 continue
  53. imaxel=0
  54. do i=1,ino
  55. imaxel=max(imaxel,inode(i))
  56. inode(i)=0
  57. enddo
  58. segini jelnum,izone
  59. *
  60. * jelnum(i,k) dira le Ieme element qui touche le noeud k
  61. * izone (i,k) dira dans quel lisous le ieme element se trouve
  62. * attention le noeud K est le plus petit de l'élément
  63. do 5 i=1,max(nbso1,1)
  64. if(nbso1.ne.0) then
  65. meleme=ipt1.lisous(i)
  66. endif
  67. do 6 j=1,num(/2)
  68. ipeti=xcoor(/1)
  69. do k=1,num(/1)
  70. ipeti=min(num(k,j),ipeti)
  71. enddo
  72. ib= icpr(ipeti)
  73. inode(ib)=inode(ib)+1
  74. ic=inode(ib)
  75. jelnum(ic,ib)=j
  76. izone(ic,ib)=i
  77. 6 continue
  78. 5 continue
  79. *
  80. * travail sur les rigidites elementaires
  81. *
  82. segact mrigid
  83. nrigel=coerig(/1)
  84. nrige=irigel(/1)
  85. segini ri1
  86. irzon=0
  87. do 10 i=1,irigel(/2)
  88. ipt3=irigel(1,i)
  89. segact ipt3
  90. xmatri=irigel(4,i)
  91. ielzo=0
  92. do 11 j=1,ipt3.num(/2)
  93. ipeti=xcoor(/1)
  94. do k=1,ipt3.num(/1)
  95. ipeti=min(ipeti,ipt3.num(k,j))
  96. enddo
  97.  
  98.  
  99. * on regarde s'il existe un element de ipt1 ayant ce noeud en plus
  100. * petitre position si non on passe a l'élément suivant
  101. ib=icpr(ipeti)
  102. if(ib.eq.0) go to 11
  103. if(inode(ib).eq.0) go to 11
  104. do 13 mm=1,inode(ib)
  105. if(nbso1.ne.0)then
  106. meleme= ipt1.lisous(izone(mm,ib))
  107. endif
  108. if(ipt3.num(/1).ne.num(/1)) go to 13
  109. iel=jelnum(mm,ib)
  110. do in=1,ipt3.num(/1)
  111. if( ipt3.num(in,j).ne.num(in,iel))go to 13
  112. enddo
  113. * on a trouver un element a conserver
  114. if(ielzo.eq.0) then
  115. segini,ipt4=ipt3
  116. irzon=irzon+1
  117. do kk=1,irigel(/1)
  118. ri1.irigel(kk,irzon)=irigel(kk,i)
  119. enddo
  120. ri1.irigel(1,irzon)=ipt4
  121. ri1.coerig(irzon)=coerig(i)
  122. ri1.mtymat=mtymat
  123. xmatri=irigel(4,i)
  124. segact xmatri
  125. segini,xmatr1=xmatri
  126. ri1.irigel(4,irzon)= xmatr1
  127. endif
  128. ielzo=ielzo+1
  129. do io=1,re(/2)
  130. do iu=1,re(/1)
  131. xmatr1.re(iu,io,ielzo)=re(iu,io,j)
  132. enddo
  133. enddo
  134. * imatr1.imattt(ielzo)=imattt(j)
  135. do kk=1,ipt3.num(/1)
  136. ipt4.num(kk,ielzo)=ipt3.num(kk,j)
  137. enddo
  138. 13 continue
  139. 11 continue
  140. * on ajuste les longueur si besoin
  141. if(ielzo.ne.0) then
  142. if(ielzo.ne.ipt4.num(/2)) then
  143. nbsous=0
  144. nbelem= ielzo
  145. nbnn=ipt4.num(/1)
  146. nbref=0
  147. segadj ipt4
  148. nelrig=ielzo
  149. nligrp= xmatr1.re(/2)
  150. nligrd= xmatr1.re(/1)
  151. segadj xmatr1
  152. segdes ipt4,xmatr1
  153. else
  154. ri1.irigel(4,irzon)=xmatri
  155. ri1.irigel(1,irzon)=ipt3
  156. segsup xmatr1,ipt4
  157. endif
  158. endif
  159. segdes xmatri
  160. 10 continue
  161. if(irzon.eq.0) then
  162. segdes mrigid
  163. call erreur(21)
  164. elseif(irzon.ne.coerig(/1)) then
  165. nrigel=irzon
  166. nrige=irigel(/1)
  167. segadj ri1
  168. segdes ri1
  169. irigre=ri1
  170. else
  171. do io=1,irzon
  172. if( ri1.irigel(1,io).ne.irigel(1,io) )go to 20
  173. enddo
  174. irigre= mrigid
  175. go to 21
  176. 20 continue
  177. irigre=ri1
  178.  
  179. 21 continue
  180. endif
  181. do iou=1,irigel(/2)
  182. ipt3=irigel(1,iou)
  183. segdes ipt3
  184. enddo
  185. segdes mrigid
  186. if(irigre.eq.mrigid) then
  187. segsup ri1
  188. else
  189. segdes ri1
  190. endif
  191. segsup izone,icpr,jelnum,inode
  192. return
  193. end
  194.  
  195.  
  196.  

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