1 : C FLACOQ SOURCE CHAT 05/01/13 00:02:57 5004 2 : SUBROUTINE FLACOQ(RE,XA,EP,CONT,XE,YE,ZE,P,XX,YY,BB, 3 : 1 CC,RQP,RJ,SIG) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : DIMENSION CONT(*) 7 : DIMENSION RE(18,18),XA(3,3),SIG(3),JLIM(2,9),RJ(2,2),RP(9,9) 8 : 1 ,RL(9,9) 9 : DIMENSION P(3,3),XX(3,3),YY(3,3),BB(3),CC(3), 10 : 1 XE(3),YE(3),ZE(3) 11 : DIMENSION RQP(18,18) 12 : DATA JLIM/1,1,2,3,2,3,4,4,5, 6,5,6,7,7,8,9,8,9/ 13 : DATA RL/ 0., 0., 0., 0. ,0. ,0. , 1. ,0. ,0. , 14 : 1 1., 0., 0., 0. ,0. ,0. , -1. ,0. ,0. , 15 : 2 0., 0., 0., 1. ,0. ,0. , -1. ,0. ,0. , 16 : 3 0., -0.5,0.5,0.,0.5,-0.5, 0., 0., 0., 17 : 4 0., 0., 0., 0., 0., -0.5, 0., 0., 0.5, 18 : 6 0.,-0.5, 0., 0., 0., 0., 0., 0.5, 0., 19 : 7 -1., 0.5, -0.5, 1., 0.5, -0.5, 0., 0., 0., 20 : 8 0., 0., 0., -1., 0., 0.5, 1., 0., 0.5, 21 : 9 1., -0.5, 0., 0., 0., 0., -1., -0.5, 0./ 22 : DATA RP/ 1., 0., 0., 0., 0., 0., 0., 0., 0., 23 : 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 24 : 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 25 : 4 0., 0., 0., 1., 0., 0., 0., 0., 0., 26 : 5 0., 0., 0., 0., 0., 0., 0., 0., 0., 27 : 6 0., 0., 0., 0., 0., 0., 0., 0., 0., 28 : 7 0., 0., 0., 0., 0., 0., 1., 0., 0., 29 : 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 30 : 9 0., 0., 0., 0., 0., 0., 0., 0., 0./ 31 : C JUSQU A NOUVEL ORDRE LA PRESSION SERA NULLE PRENO=0. 32 : PRENO=0. 33 : DO 151 I=1,3 34 : XE(I)=XA(1,I) 35 : YE(I)=XA(2,I) 36 : 151 ZE(I)=XA(3,I) 36 : CALL PASSA(XE,YE,ZE, P,X13,X23,Y13,Y23) 37 : RJ(1,1)=Y13 38 : RJ(2,1)=Y23 39 : RJ(1,2)= -X13 40 : RJ(2,2)=-X23 41 : DO 1 K=1,3 42 : IK=3*K-2 43 : DO 1 I=1,2 44 : II=IK+I 45 : DO 1 J=1,2 46 : IJ=IK+J 47 : 1 RP(IJ,II)=RJ(J,I) 48 : DT=X13*Y23-Y13*X23 49 : SURF=DT 50 : SIG(1)=+CONT(1) 51 : SIG(2)=+CONT(2) 52 : SIG(3)=+CONT(3) 53 : DT=1./ABS(DT) 54 : C ****** K SIG ET K P CALCULES AVEC W LINEAIRES ******** 55 : C ***************** 56 : C ****** BUNG 7 2 79 ************** 57 : SURF=0. 58 : DO 12 I=1,18 59 : DO 12 J=1,18 60 : 12 RQP(J,I)=0. 61 : BB(1)=Y23 62 : BB(2)=-Y13 63 : BB(3)=0. 64 : CC(1)=-X23 65 : CC(2)=X13 66 : CC(3)=X23-X13 67 : SIG(1)= SIG(1)*EP*0.50*DT 68 : SIG(2)= SIG(2)*EP*0.50*DT 69 : SIG(3)= SIG(3)*EP*0.50*DT 70 : DO 16 J=1,3 71 : JJ=(J-1)*6+1 72 : DO 17 I=1,3 73 : II=(I-1)*6+1 74 : S= SIG(1)*BB(I)*BB(J)+SIG(2)*CC(I)*CC(J) + 75 : 1 SIG(3)*(BB(I)*CC(J)+BB(J)*CC(I)) 76 : RQP(II,JJ)= RQP(II,JJ)+S 77 : RQP(II+1,JJ+1)=RQP(II+1,JJ+1)+S 78 : RQP(II+2,JJ+2)=RQP(II+2,JJ+2)+S 79 : 17 CONTINUE 80 : 16 CONTINUE 81 : 82 : C CALCUL DE KP A PARTIR DES DEPLACEMENTS 83 : AUX=PRENO / 12. 84 : A1=AUX*(Y13+Y23) 85 : A2= AUX*(X13+X23) 86 : A3= AUX*(X13-2.*X23) 87 : A4 =AUX* (2.*X13-X23) 88 : A5=AUX*Y23 89 : A6= AUX*Y13 90 : RQP(1,9)= A1 91 : RQP(9,1)=RQP(1,9) 92 : RQP(1,15)= A5 93 : RQP(15,1)=RQP(1,15) 94 : RQP(2,9)= -A2 95 : RQP(9,2)=RQP(2,9) 96 : RQP(2,15)= A3 97 : RQP(15,2)=RQP(2,15) 98 : RQP(7,3)= -A1 99 : RQP(3,7)=RQP(7,3) 100 : RQP(7,15)= -A6 101 : RQP(15,7)=RQP(7,15) 102 : RQP(8,3)= A2 103 : RQP(3,8)=RQP(8,3) 104 : RQP(8,15)= A4 105 : RQP(15,8)= RQP(8,15) 106 : RQP(13,3) = -A5 107 : RQP(3,13) =RQP(13,3) 108 : RQP(13,9)= A6 109 : RQP(9,13) = RQP(13,9 ) 110 : RQP(14,3)= -A3 111 : RQP(3,14)= RQP(14,3) 112 : RQP(14,9) = -A4 113 : RQP(9,14) = RQP(14,9) 114 : DO 6 K=1,6 115 : K1=3*(K-1) 116 : DO 6 L=K,6 117 : L1= 3*(L-1) 118 : DO 7 I=1,3 119 : IM=I+K1 120 : DO 7 J=1,3 121 : JM=J+L1 122 : 7 XX(I,J)= RQP(IM,JM) 122 : CALL PRODT(YY,XX,P,3,3) 123 : DO 8 I=1,3 124 : IM=I+K1 125 : DO 8 J=1,3 126 : JM=J+L1 127 : 8 RE(IM,JM)=YY(I,J) 128 : 6 CONTINUE 129 : DO 290 I=1,18 130 : DO 290 J=I,18 131 : 290 RE(J,I)= RE( I,J) 132 : RETURN 133 : END 134 :
© Cast3M 2003 - All rights reserved.
Disclaimer