Télécharger mucpr2.eso

Retour à la liste

Numérotation des lignes :

  1. C MUCPR2 SOURCE PV 17/12/19 21:15:07 9673
  2. subroutine mucpr2(inpl,indl,re,xbuffp,xbuffd,isyme)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. * appele par mucpr1
  6. REAL*8 re(indl,inpl),xbuffp(inpl),xbuffd(indl)
  7. * blocage par 6 puis par 3 puis par 2 pour reutiliser xbuffp
  8. * le blocage a 2 est suffisant en fait
  9. * les triangles ont 3 noeuds et 3 ou 6 inconnues par noeud
  10. ** write (6,*) 'isyme inpl indl',isyme,inpl,indl
  11. ** write (6,*) ((re(ind,inp),inp=1,inpl),ind=1,indl)
  12.  
  13.  
  14.  
  15. indi=0
  16. ** goto 2
  17. ** do ind=0,indl-6,6
  18. ** xb1=0.d0
  19. ** xb2=0.d0
  20. ** xb3=0.d0
  21. ** xb4=0.d0
  22. ** xb5=0.d0
  23. ** xb6=0.d0
  24. ** do inp=1,inpl
  25. ** xb1=xb1+xbuffp(inp)*re(ind+1,inp)
  26. ** xb2=xb2+xbuffp(inp)*re(ind+2,inp)
  27. ** xb3=xb3+xbuffp(inp)*re(ind+3,inp)
  28. ** xb4=xb4+xbuffp(inp)*re(ind+4,inp)
  29. ** xb5=xb5+xbuffp(inp)*re(ind+5,inp)
  30. ** xb6=xb6+xbuffp(inp)*re(ind+6,inp)
  31. ** enddo
  32. ** xbuffd(ind+1)=xb1
  33. ** xbuffd(ind+2)=xb2
  34. ** xbuffd(ind+3)=xb3
  35. ** xbuffd(ind+4)=xb4
  36. ** xbuffd(ind+5)=xb5
  37. ** xbuffd(ind+6)=xb6
  38. ** enddo
  39. ** indi=ind
  40. ** 3 continue
  41. ** do ind=indi,indl-3,3
  42. ** xb1=0.d0
  43. ** xb2=0.d0
  44. ** xb3=0.d0
  45. ** do inp=1,inpl
  46. ** xb1=xb1+xbuffp(inp)*re(ind+1,inp)
  47. ** xb2=xb2+xbuffp(inp)*re(ind+2,inp)
  48. ** xb3=xb3+xbuffp(inp)*re(ind+3,inp)
  49. ** enddo
  50. ** xbuffd(ind+1)=xb1
  51. ** xbuffd(ind+2)=xb2
  52. ** xbuffd(ind+3)=xb3
  53. ** enddo
  54. ** indi=ind
  55. ** 2 continue
  56. if (isyme.ne.0) then
  57. * cas non symetrique
  58. do ind=indi,indl-2,2
  59. xb1=0.d0
  60. xb2=0.d0
  61. do inp=1,inpl
  62. xb1=xb1+re(ind+1,inp)*xbuffp(inp)
  63. xb2=xb2+re(ind+2,inp)*xbuffp(inp)
  64. enddo
  65. xbuffd(ind+1)=xb1
  66. xbuffd(ind+2)=xb2
  67. enddo
  68. indi=ind
  69.  
  70. do ind=indi,indl-1,1
  71. xb1=0.d0
  72. do inp=1,inpl
  73. xb1=xb1+re(ind+1,inp)*xbuffp(inp)
  74. enddo
  75. xbuffd(ind+1)=xb1
  76. enddo
  77. else
  78. * cas symetrique on utilise la transposee
  79. do ind=indi,indl-2,2
  80. xb1=0.d0
  81. xb2=0.d0
  82. do inp=1,inpl
  83. xbp=xbuffp(inp)
  84. xb1=xb1+re(inp,ind+1)*xbuffp(inp)+0.D0
  85. xb2=xb2+re(inp,ind+2)*xbuffp(inp)+0.D0
  86. enddo
  87. xbuffd(ind+1)=xb1
  88. xbuffd(ind+2)=xb2
  89. enddo
  90. indi=ind
  91.  
  92. do ind=indi,indl-1,1
  93. xb1=0.d0
  94. do inp=1,inpl
  95. xb1=xb1+re(inp,ind+1)*xbuffp(inp)
  96. enddo
  97. xbuffd(ind+1)=xb1
  98. enddo
  99. endif
  100. end
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  

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