Télécharger mrem1.eso

Retour à la liste

Numérotation des lignes :

  1. C MREM1 SOURCE PV 15/12/11 21:15:08 8731
  2. SUBROUTINE MREM1(mchpoi,ri1,ri2,ri3,ri4,ichp6,mchpo1,iret)
  3. * remontee des LX sur les points supports des multiplicateurs
  4. * dans le cas des resolution avexc matrices de dependances
  5. * ri2 rigidite complete avant condensation
  6. * ri1 rigidite de dependance brute
  7. IMPLICIT INTEGER(I-N)
  8. IMPLICIT REAL*8(A-H,O-Z)
  9. -INC SMRIGID
  10. -INC CCOPTIO
  11. -INC SMCHPOI
  12. -INC SMCOORD
  13. -INC SMELEME
  14. segment LXOK(XCOOR(/1)/(idim+1))
  15. * fabrication du bon ri2 : ri2 + les conditions de ri4 dont les LX
  16. * sont dans ri3
  17. segini lxok
  18. mrigid=ri3
  19. segact mrigid
  20. do 10 irig=1,irigel(/2)
  21. meleme=irigel(1,irig)
  22. segact meleme
  23. if (itypel.ne.22) call erreur(5)
  24. descr=irigel(3,irig)
  25. segact descr
  26. do 20 j=1,num(/2)
  27. lxok(num(1,j))=1
  28. 20 continue
  29. segdes meleme
  30. 10 continue
  31. segini,ri5=ri4
  32. mrigid=ri5
  33. do 100 irig=1,irigel(/2)
  34. ipt1=irigel(1,irig)
  35. xmatr1=irigel(4,irig)
  36. segini,meleme=ipt1
  37. segini,xmatri=xmatr1
  38. if (itypel.ne.22) call erreur(5)
  39. jj=0
  40. do 110 j=1,num(/2)
  41. if (lxok(num(1,j)).eq.0) num(1,j)=0
  42. if (num(1,j).ne.0) then
  43. jj=jj+1
  44. do 120 in=1,num(/1)
  45. num(in,jj)=num(in,j)
  46. 120 continue
  47. do io=1,re(/2)
  48. do iu=1,re(/1)
  49. re(iu,io,jj)=re(iu,io,j)
  50. enddo
  51. enddo
  52. * imattt(jj)=imattt(j)
  53. endif
  54. 110 continue
  55. nbnn=num(/1)
  56. nbelem=jj
  57. nbsous=0
  58. nbref=0
  59. segadj meleme
  60. irigel(1,irig)=meleme
  61. nelrig=jj
  62. nligrp=re(/2)
  63. nligrd=re(/1)
  64. segadj xmatri
  65. irigel(4,irig)=xmatri
  66. 100 continue
  67. segsup lxok
  68. call fusrig(ri2,mrigid,iret)
  69. ri2=iret
  70. C remontee sur les ddl condenses
  71. call depen3(ri1,ri6)
  72. call mucpri(mchpoi,ri6,ichp3)
  73. * write (6,*) 'mchpoi dans mrem1 '
  74. * call ecchpo(mchpoi)
  75. *
  76. * on peut tuer ri6
  77. *
  78. segact ri6
  79. do 55 i=1,ri6.irigel(/2)
  80. ipt4=ri6.irigel(1,i)
  81. segsup ipt4
  82. des1=ri6.irigel(3,i)
  83. segsup des1
  84. xmatr6=ri6.irigel(4,i)
  85. * segact imatr6
  86. * do 56 j=1,imatr6.imattt(/1)
  87. * xmatr6=imatr6.imattt(j)
  88. * segsup xmatr6
  89. * 56 continue
  90. segsup xmatr6
  91. 55 continue
  92. call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  93. call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  94. mchpo1=iret
  95. call mucpri(mchpo1,ri2 ,ichp5)
  96. call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
  97. call remplx(ri1,iret,ichp7)
  98. mchpoi=mchpo1
  99. * les champs de points qui sortent sont de nature diffuse
  100. SEGACT MCHPOI
  101. NAT = MAX(1,JATTRI(/1))
  102. NSOUPO=IPCHP(/1)
  103. SEGADJ MCHPOI
  104. JATTRI(1)=1
  105. SEGDES MCHPOI
  106. * write (6,*) 'mchpo1 dans mrem1 '
  107. * call ecchpo(mchpo1)
  108. * write (6,*) 'ichp7 dans mrem1 '
  109. * call ecchpo(ichp7)
  110. call fuchpo(mchpo1,ichp7,iret)
  111. mchpoi=iret
  112. * les champs de points qui sortent sont de nature diffuse
  113. SEGACT MCHPOI
  114. NAT = MAX(1,JATTRI(/1))
  115. NSOUPO=IPCHP(/1)
  116. SEGADJ MCHPOI
  117. JATTRI(1)=1
  118. SEGDES MCHPOI
  119. return
  120. end
  121.  
  122.  
  123.  
  124.  
  125.  

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