Télécharger dbblx.eso

Retour à la liste

Numérotation des lignes :

  1. C DBBLX SOURCE CB215821 17/11/29 21:15:00 9636
  2. * dedouble les multiplicateurs de Lagrange
  3. *
  4. subroutine dbblx(mrigid,lagdua)
  5.  
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8.  
  9. -INC CCOPTIO
  10. -INC SMCOORD
  11. -INC SMRIGID
  12. -INC SMELEME
  13.  
  14. idimp1 = idim + 1
  15.  
  16. segact mcoord*mod
  17. nbpts = xcoor(/1) / idimp1
  18. nbini = nbpts
  19.  
  20. nbsous = 0
  21. nbref = 0
  22. nbnn = 2
  23. nbelem = 0
  24. segini,ipt8
  25. ipt8.itypel = 2
  26. nbele8 = nbelem
  27.  
  28. segact mrigid*mod
  29. nrigel = irigel(/2)
  30.  
  31. C Boucle d'activation et AJUSTEMENT MCOORD en 1 coup
  32. do 9 ir = 1, nrigel
  33. ipt1 = irigel(1,ir)
  34. segact ipt1
  35. i_z = ipt1.itypel
  36. if (i_z .ne. 22) goto 9
  37. nbpts = nbpts + ipt1.num(/2)
  38. 9 continue
  39. segadj,mcoord
  40.  
  41. nbpts=nbini
  42. do 10 ir = 1, nrigel
  43. ipt1 = irigel(1,ir)
  44. segact ipt1
  45. i_z = ipt1.itypel
  46. segdes,ipt1
  47. if (i_z .ne. 22) goto 10
  48. segini,meleme=ipt1
  49. nbsous = 0
  50. nbref = 0
  51. nbnn = meleme.num(/1)+1
  52. nbelem = meleme.num(/2)
  53. segadj meleme
  54. nbsup = nbelem
  55.  
  56. nbpts0 = nbpts
  57. nbpts = nbpts0 + nbsup
  58.  
  59. do 100 j = 1, nbsup
  60. do 120 i = nbnn,3,-1
  61. meleme.num(i,j) = meleme.num(i-1,j)
  62. 120 continue
  63. meleme.num(2,j) = nbpts0 + j
  64. ip2 = (meleme.num(2,j)-1) * idimp1
  65. ip1 = (meleme.num(1,j)-1) * idimp1
  66. do k = 1, idimp1
  67. xcoor(ip2+k) = xcoor(ip1+k)
  68. enddo
  69. 100 continue
  70. irigel(1,ir) = meleme
  71. ** on garde la liste des noeuds rajoutés
  72. * nbsous = 0
  73. * nbref = 0
  74. nbnn = 2
  75. nbelem = nbele8 + nbsup
  76. segadj ipt8
  77. do 130 j = 1, nbsup
  78. j8 = nbele8 + j
  79. ipt8.num(1,j8) = meleme.num(1,j)
  80. ipt8.num(2,j8) = meleme.num(2,j)
  81. 130 continue
  82. nbele8 = nbelem
  83. segdes,meleme
  84. *
  85. des1 = irigel(3,ir)
  86. segini,descr=des1
  87. segdes,des1
  88. nligrp = lisinc(/2)+1
  89. nligrd = lisdua(/2)+1
  90. segadj descr
  91. do 200 i = nligrp, 3, -1
  92. lisinc(i) = lisinc(i-1)
  93. noelep(i) = noelep(i-1)+1
  94. 200 continue
  95. lisinc(2) = 'LX'
  96. noelep(2) = 2
  97. do 210 i = nligrd, 3, -1
  98. lisdua(i) = lisdua(i-1)
  99. noeled(i) = noeled(i-1)+1
  100. 210 continue
  101. lisdua(2)='FLX'
  102. noeled(2)=2
  103. segdes,descr
  104. irigel(3,ir) = descr
  105.  
  106. xmatr1 = irigel(4,ir)
  107. segini,xmatri=xmatr1
  108. segdes,xmatr1
  109. nelrig = re(/3)
  110. segadj,xmatri
  111. do 300 im = 1, nelrig
  112. do 310 i = nligrp, 1, -1
  113. do 310 j = nligrd, 2, -1
  114. re(i,j,im) = re(i,j-1,im)
  115. 310 continue
  116. do 320 j = nligrd, 1, -1
  117. do 320 i = nligrp, 2, -1
  118. re(i,j,im) = re(i-1,j,im)
  119. 320 continue
  120. re(1,1,im) = -1.D0+re(1,1,im)
  121. re(1,2,im) = +1.D0
  122. re(2,1,im) = +1.D0
  123. re(2,2,im) = re(1,1,im)
  124. 300 continue
  125. segdes,xmatri
  126. irigel(4,ir) = xmatri
  127.  
  128. 10 continue
  129. *
  130. segdes mrigid
  131. *
  132. if (nbele8.eq.0) then
  133. segsup,ipt8
  134. ipt8 = 0
  135. endif
  136.  
  137. lagdua = ipt8
  138.  
  139. return
  140. end
  141.  
  142.  
  143.  

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