Télécharger dbblx.eso

Retour à la liste

Numérotation des lignes :

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

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