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    PV090527  25/02/19    21:15:03     12164          
  2.       subroutine mucpr2(inpl,indl,re,xbuffp,xbuffd,isyme,irela)
  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.        if (isyme.ne.0) then
  17. *  cas non symetrique
  18.          do ind=indi,indl-2,2
  19.           xb1=0.d0
  20.           xb2=0.d0
  21.           do inp=1,inpl
  22.            xbp=xbuffp(inp)
  23.            xb1=xb1+re(ind+1,inp)*xbp
  24.            xb2=xb2+re(ind+2,inp)*xbp
  25.           enddo
  26.           xbuffd(ind+1)=xb1
  27.           xbuffd(ind+2)=xb2
  28.          enddo
  29.          indi=ind
  30.  
  31.          do ind=indi,indl-1,1
  32.           xb1=0.d0
  33.           do inp=1,inpl
  34.            xb1=xb1+re(ind+1,inp)*xbuffp(inp)
  35.           enddo
  36.           xbuffd(ind+1)=xb1
  37.          enddo
  38.        else
  39. *  cas symetrique on utilise la transposee
  40. *  pour les relations, on ne considere que la premiere ligne et colonne
  41.        if (irela.eq.0) then
  42.        do ind=indi,indl-2,2
  43.         xb1=0.d0
  44.         xb2=0.d0
  45.         do inp=1,inpl
  46.          xbp=xbuffp(inp)
  47.          xb1=xb1+re(inp,ind+1)*xbp
  48.          xb2=xb2+re(inp,ind+2)*xbp
  49.         enddo
  50.         xbuffd(ind+1)=xb1
  51.         xbuffd(ind+2)=xb2
  52.        enddo
  53.        indi=ind
  54.        endif
  55.        if(irela.eq.1) then
  56. *       write(6,*) 'mucpr2 irela 1 inpl ',inpl
  57.         xb1=0.d0
  58.         do inp=1,inpl
  59.          xb1=xb1+re(inp,1)*xbuffp(inp)
  60.         enddo
  61.         xbuffd(1)=xb1
  62.         do ind=1,indl-1,1
  63.          xb1=re(1,ind+1)*xbuffp(1)
  64.          xbuffd(ind+1)=xb1
  65.         enddo
  66.        else 
  67.         do ind=indi,indl-1,1
  68.          xb1=0.d0
  69.          do inp=1,inpl
  70.           xb1=xb1+re(inp,ind+1)*xbuffp(inp)
  71.          enddo
  72.          xbuffd(ind+1)=xb1
  73.         enddo
  74.        endif
  75.        endif
  76.        end
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  

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