Esope source files

   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 :