Télécharger la plaquette Cast3M


fr en

Télécharger mucpr2.eso

Retour à la liste

Numérotation des lignes : 

mucpr2

  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