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