Télécharger dbblx.eso

Retour à la liste

Numérotation des lignes :

  1. C DBBLX SOURCE CB215821 19/08/20 21:16:33 10287
  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. if (i_z .ne. 22) goto 10
  47. segini,meleme=ipt1
  48. nbsous = 0
  49. nbref = 0
  50. nbnn = meleme.num(/1)+1
  51. nbelem = meleme.num(/2)
  52. segadj meleme
  53. nbsup = nbelem
  54.  
  55. nbpts0 = nbpts
  56. nbpts = nbpts0 + nbsup
  57.  
  58. do 100 j = 1, nbsup
  59. do 120 i = nbnn,3,-1
  60. meleme.num(i,j) = meleme.num(i-1,j)
  61. 120 continue
  62. meleme.num(2,j) = nbpts0 + j
  63. ip2 = (meleme.num(2,j)-1) * idimp1
  64. ip1 = (meleme.num(1,j)-1) * idimp1
  65. do k = 1, idimp1
  66. xcoor(ip2+k) = xcoor(ip1+k)
  67. enddo
  68. 100 continue
  69. irigel(1,ir) = meleme
  70. ** on garde la liste des noeuds rajoutés
  71. * nbsous = 0
  72. * nbref = 0
  73. nbnn = 2
  74. nbelem = nbele8 + nbsup
  75. segadj ipt8
  76. do 130 j = 1, nbsup
  77. j8 = nbele8 + j
  78. ipt8.num(1,j8) = meleme.num(1,j)
  79. ipt8.num(2,j8) = meleme.num(2,j)
  80. 130 continue
  81. nbele8 = nbelem
  82. *
  83. des1 = irigel(3,ir)
  84. segini,descr=des1
  85. segdes,des1
  86. nligrp = lisinc(/2)+1
  87. nligrd = lisdua(/2)+1
  88. segadj descr
  89. do 200 i = nligrp, 3, -1
  90. lisinc(i) = lisinc(i-1)
  91. noelep(i) = noelep(i-1)+1
  92. 200 continue
  93. lisinc(2) = 'LX'
  94. noelep(2) = 2
  95. do 210 i = nligrd, 3, -1
  96. lisdua(i) = lisdua(i-1)
  97. noeled(i) = noeled(i-1)+1
  98. 210 continue
  99. lisdua(2)='FLX'
  100. noeled(2)=2
  101. segdes,descr
  102. irigel(3,ir) = descr
  103.  
  104. xmatr1 = irigel(4,ir)
  105. segini,xmatri=xmatr1
  106. segdes,xmatr1
  107. nelrig = re(/3)
  108. segadj,xmatri
  109. do 300 im = 1, nelrig
  110. do 310 i = nligrp, 1, -1
  111. do 310 j = nligrd, 2, -1
  112. re(i,j,im) = re(i,j-1,im)
  113. 310 continue
  114. do 320 j = nligrd, 1, -1
  115. do 320 i = nligrp, 2, -1
  116. re(i,j,im) = re(i-1,j,im)
  117. 320 continue
  118. re(1,1,im) = -1.D0+re(1,1,im)
  119. re(1,2,im) = +1.D0
  120. re(2,1,im) = +1.D0
  121. re(2,2,im) = re(1,1,im)
  122. 300 continue
  123. segdes,xmatri
  124. irigel(4,ir) = xmatri
  125.  
  126. 10 continue
  127. *
  128. segdes mrigid
  129. *
  130. if (nbele8.eq.0) then
  131. segsup,ipt8
  132. ipt8 = 0
  133. endif
  134.  
  135. lagdua = ipt8
  136.  
  137. end
  138.  
  139.  
  140.  

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