Télécharger reduri.eso

Retour à la liste

Numérotation des lignes :

  1. C REDURI SOURCE JC220346 19/12/16 21:15:00 10433
  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. return
  165. elseif(irzon.ne.coerig(/1)) then
  166. nrigel=irzon
  167. nrige=irigel(/1)
  168. segadj ri1
  169. segdes ri1
  170. irigre=ri1
  171. else
  172. do io=1,irzon
  173. if( ri1.irigel(1,io).ne.irigel(1,io) )go to 20
  174. enddo
  175. irigre= mrigid
  176. go to 21
  177. 20 continue
  178. irigre=ri1
  179.  
  180. 21 continue
  181. endif
  182. do iou=1,irigel(/2)
  183. ipt3=irigel(1,iou)
  184. segdes ipt3
  185. enddo
  186. segdes mrigid
  187. if(irigre.eq.mrigid) then
  188. segsup ri1
  189. else
  190. segdes ri1
  191. endif
  192. segsup izone,icpr,jelnum,inode
  193. return
  194. end
  195.  
  196.  
  197.  
  198.  

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