Télécharger la plaquette Cast3M


fr en

Télécharger effi3.eso

Retour à la liste

Numérotation des lignes : 

effi3

  1. C EFFI3     SOURCE    CHAT      05/01/12    23:28:29     5004
  2.       SUBROUTINE EFFI3(VALCAR,TYVAL,NCA1,NCAR1,XFORC,LRE,IB,IGAU,XATEF1,
  3.      &NSTEP,DREND,CELEM)
  4. ***************************************************************
  5. * calcule la matrice d efficacite directionnelle
  6. * puis transforme le vecteur force elementaire
  7. ***************************************************************
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8(A-H,O-Z)
  10.       DIMENSION VALCAR(*),XFORC(*)
  11.       CHARACTER*16 TYVAL(*)
  12.       CHARACTER*8 CELEM
  13.       dimension xatef1(3,3),xfor1(3),tq(3,3)
  14.       dimension xmat2(3,3), q(3,3),xmat3(3,3)
  15.       logical drend
  16.  
  17.       if (drend) goto 1000
  18. * matrice de rotation
  19.       w1x = valcar(ncar1+1)
  20.       w1y = valcar(ncar1+2)
  21.       w1z = valcar(ncar1+3)
  22.       w2x = valcar(ncar1+4)
  23.       w2y = valcar(ncar1+5)
  24.       w2z = valcar(ncar1+6)
  25.       tq(1,1) = w1x
  26.       tq(2,1) = w1y
  27.       tq(1,2) = w2x
  28.       tq(2,2) = w2y
  29.       if (nstep.gt.2) then
  30.         w3x = w1y*w2z - w1z*w2y
  31.         w3y = w2x*w1z - w2z*w1x
  32.         w3z = w1x*w2y - w1y*w2x
  33.         tq(3,1) = w1z
  34.         tq(3,2) = w2z
  35.         tq(1,3) = w3x
  36.         tq(2,3) = w3y
  37.         tq(3,3) = w3z
  38.       endif
  39.       do i = 1,nstep
  40.         do j = 1, nstep
  41.            q(i,j) = tq(j,i)
  42.         enddo
  43.       enddo
  44. * efficacite
  45. * produit
  46.       do i = 1,nstep
  47.         do j = 1, nstep
  48.          cc= 0.d0
  49.             do k1 = 1,nstep
  50.                 cc = cc + tq(i,k1)*xatef1(k1,j)
  51.             enddo
  52.          xmat2(i,j) = cc
  53.         enddo
  54.       enddo
  55.       do i = 1,nstep
  56.         do j = 1, nstep
  57.          cc= 0.d0
  58.             do k1 = 1,nstep
  59.                 cc = cc + xmat2(i,k1)*q(k1,j)
  60.             enddo
  61.          xatef1(i,j) = cc
  62.         enddo
  63.       enddo
  64.  
  65.  
  66.  1000 CONTINUE
  67. * affecte la force elementaire
  68. c ----------------------------------------
  69. c  elements massifs
  70. c ----------------------------------------
  71.       if (CELEM.NE.'MASSIF  ') goto 2000
  72.       kind = int(LRE/NSTEP)
  73.       DO jind1 = 1,kind
  74.  
  75. * decoupe un bloc
  76.          do in1 = 1,nstep
  77.                 xfor1(in1) = XFORC((jind1 - 1)*nstep + in1)
  78.          enddo
  79. * multiplie et range
  80.          do in1 = 1,nstep
  81.              cc = 0.D0
  82.               do k1 = 1,nstep
  83.                  cc = cc + (xatef1(in1,k1) * xfor1(k1))
  84.               enddo
  85.  
  86.              XFORC((jind1 - 1)*nstep + in1) = cc
  87.          enddo
  88.  
  89.       ENDDO
  90.       RETURN
  91.  
  92.  2000 CONTINUE
  93. c ----------------------------------------
  94. c  elements
  95. c ----------------------------------------
  96.       RETURN
  97.       END
  98.  
  99.  

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