Sources Esope | Cast3M

bsigco
C BSIGCO    SOURCE    CHAT      05/01/12    21:42:54     5004
      SUBROUTINE BSIGCO(XXE,DAR,FFE,RPL,FT,TWL,RJ,XR,RC,
     * FU,P,FF,XE,YE,ZE)
C
C  ***** ELEMENT COQ3 ******
C  CE SUB A COMMME BUT DE CALCULER LES FORCES ( EXPRIMEES DANS LE
C REOERE GLOBALE) QUI EQUILIBRENT UN CHAMP DE CONTRAINTES POUR
C
C  EN ENTREE - EP   : EPAISSEUR DE LA COQUE
C              XXE(I,J) : IEME COORDONNEE DU JEME NOEUD DE L'ELEMENT
C              DAR(6)   : CONTRAINTES - MEMBRANE PUIS FLEXION
C
C  EN SORTIE - FFE(I,J) : IEME COMPOSANTE DU CHAMP DE FORCE A
C                         APPLIQUER AU JEME NOEUD DE L'ELEMENT
C
C CE SUB VIENT  DE TRICO VIA BILBO.
C
C LA LONGUEUR DU SEGMENT DE TRAVAIL NECESSAIRE EST  151
C ATTENTION RPL ET FT SONT EN EQUIVALLENCE  AINSI QUE FF(1),XE(1)
C  FF(4),YE(1)   FF(7),ZE(1)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION FFE(6,2),XXE(3,3),DAR(6)
       DIMENSION TWL(6)
        DIMENSION RL(9,9),RP(9,9),RPL(9,9),JLIM(2,9),XL(6,3),RJ(2,2),
     1 XR(3,9),FF(9),RC(3,3)
      DIMENSION  P(3,3),XE(3),YE(3),ZE(3)
      DIMENSION FT(18)
      DIMENSION FU(6)
      DATA JLIM/1,1,2,3,2,3,4,4,5,       6,5,6,7,7,8,9,8,9/
      DATA RL/ 0., 0., 0.,    0. ,0. ,0. ,   1. ,0. ,0. ,
     1         1., 0., 0.,    0. ,0. ,0. ,  -1. ,0. ,0. ,
     2         0., 0., 0.,    1. ,0. ,0. ,  -1. ,0. ,0. ,
     3    0., -0.5,0.5,0.,0.5,-0.5, 0., 0., 0.,
     4  0., 0., 0.,     0., 0.,   -0.5,   0.,   0.,   0.5,
     6 0.,-0.5,  0.,    0., 0., 0.,     0., 0.5, 0.,
     7 -1., 0.5, -0.5,      1.,  0.5,  -0.5,   0., 0., 0.,
     8 0., 0., 0.,    -1.,  0., 0.5,    1., 0., 0.5,
     9  1., -0.5,  0.,   0.,  0.,  0.,   -1.,   -0.5,  0./
      DATA RP/ 1., 0., 0.,   0., 0., 0.,    0., 0., 0.,
     2         0., 0., 0.,   0., 0., 0.,    0., 0., 0.,
     3         0., 0., 0.,   0., 0., 0.,    0., 0., 0.,
     4         0., 0., 0.,   1., 0., 0.,    0., 0., 0.,
     5         0., 0., 0.,   0., 0., 0.,    0., 0., 0.,
     6         0., 0., 0.,   0., 0., 0.,    0., 0., 0.,
     7         0., 0., 0.,   0., 0., 0.,    1., 0., 0.,
     8         0., 0., 0.,   0., 0., 0.,    0., 0., 0.,
     9         0., 0., 0.,   0., 0., 0.,    0., 0., 0./
      DATA XL/0.,0.,-1., -0.33333333,0.33333333,0.,
     2 0., -1., 0.,  0.33333333,0.,-0.33333333,
     3 0.5,-0.5,-0.5,0.,0.33333333,-0.33333333/
      DO 185 IP=1,3
      XE(IP)=XXE(1,IP)
      YE(IP)=XXE(2,IP)
  185 ZE(IP)=XXE(3,IP)
      CALL PASSA(XE,YE,ZE,P,X13,X23,Y13,Y23)
  184 CONTINUE
       IELE=3
      DO 16 IP=1,3
   16 TWL(IP)=DAR(IP+3)
      DO 160 IP=1,3
  160 TWL(3+IP)=DAR(IP)
       SO= 0.5D0
      FU(1)=SO*(TWL(4)*Y23-TWL(6)*X23)
      FU(2)=SO*(-TWL(5)*X23+TWL(6)*Y23)
      FU(3)=SO*(-TWL(4)*Y13+TWL(6)*X13)
      FU(4)=SO*(TWL(5)*X13-TWL(6)*Y13)
      FU(5)=SO*TWL(6)*(X23-X13)
      FU(6)=SO*(X23-X13)*TWL(5)
       RJ(1,1)=X13
      RJ(2,1)=X23
       RJ(1,2)=Y13
      RJ(2,2)=Y23
      DT=X13*Y23-Y13*X23
         SURF2=  ABS(DT)
      DT=-1./ABS(DT)
       DO 1 K=1,3
      IK=3*K-2
       DO 1 I=1,2
      II=IK+I
      DO 1 J=1,2
       IJ=IK+J
    1 RP(IJ,II)=RJ(J,I)
      DO 2 J=1,9
      K1=JLIM(1,J)
      K2=JLIM(2,J)
      DO 2  I=4,9
      S=0.D0
       DO 3 K=K1,K2
   3  S=S+RL(K,I)*RP(K,J)
      RPL(I,J)=S
   2  CONTINUE
      DO 4 J=1,3
      DO 4 I=1,9
       S=0.D0
       DO 5 K=4,9
      L=K-3
   5  S=S+XL(L,J)*RPL(K,I)
   4  XR(J,I)=S
      DO 8 I=1,9
   8  FF(I)=0.D0
      RC(1,1)=Y23*Y23
       RC(2,1)=Y13*Y13
       RC(3,1)=-2.*Y13*Y23
      RC(1,2)=X23*X23
      RC(2,2)=X13*X13
       RC(3,2)=-2.*X13*X23
      RC(1,3)=-2.*X23*Y23
      RC(2,3)=-2.*X13*Y13
      RC(3,3)=2.*(X13*Y23+X23*Y13)
      DO 9 I=1,3
      DO 9 J=1,9
      S=0.D0
       DO 10 K=1,3
   10 S=S+RC(K,I)*XR(K,J)
    9 FF(J)=FF(J)+S*TWL(I)
       K=0
       DO 11 I=1,IELE
       IP=6*(I-1)
      FT(IP+1)=FU(2*I-1)
      FT(IP+2)=FU(2*I)
      FT(IP+3)=DT*FF(3*I-2)
      FT(IP+4)=DT*FF(3*I)
       FT(IP+5)=-DT*FF(3*I-1)
       FT(IP+6)=0.
   11 CONTINUE
       DO 12 I=1,IELE
       KP=6*(I-1)
      MP=KP+3
           DO 13 J=1,3
           DO 14   JP=1,3
      FFE(J,I)=FFE(J,I)+P(JP,J)*FT(JP+KP)
      FFE(J+3,I)=FFE(J+3,I)+P(JP,J)*FT(JP+MP)
   14 CONTINUE
   13 CONTINUE
   12 CONTINUE
      RETURN
      END