Télécharger mucpr2.eso

Retour à la liste

Numérotation des lignes :

  1. C MUCPR2 SOURCE PV 20/03/29 21:15:07 10565
  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. xbp=xbuffp(inp)
  63. xb1=xb1+re(ind+1,inp)*xbp
  64. xb2=xb2+re(ind+2,inp)*xbp
  65. enddo
  66. xbuffd(ind+1)=xb1
  67. xbuffd(ind+2)=xb2
  68. enddo
  69. indi=ind
  70.  
  71. do ind=indi,indl-1,1
  72. xb1=0.d0
  73. do inp=1,inpl
  74. xb1=xb1+re(ind+1,inp)*xbuffp(inp)
  75. enddo
  76. xbuffd(ind+1)=xb1
  77. enddo
  78. else
  79. * cas symetrique on utilise la transposee
  80. do ind=indi,indl-2,2
  81. xb1=0.d0
  82. xb2=0.d0
  83. do inp=1,inpl
  84. xbp=xbuffp(inp)
  85. xb1=xb1+re(inp,ind+1)*xbp
  86. xb2=xb2+re(inp,ind+2)*xbp
  87. enddo
  88. xbuffd(ind+1)=xb1
  89. xbuffd(ind+2)=xb2
  90. enddo
  91. indi=ind
  92.  
  93. do ind=indi,indl-1,1
  94. xb1=0.d0
  95. do inp=1,inpl
  96. xb1=xb1+re(inp,ind+1)*xbuffp(inp)
  97. enddo
  98. xbuffd(ind+1)=xb1
  99. enddo
  100. endif
  101. end
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  

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