1 : C EFFI2 SOURCE CHAT 05/01/12 23:28:26 5004 2 : SUBROUTINE EFFI2(VALCAR,TYVAL,NCA1,NCAR1,REL,LRE,IB,IGAU,XATEF1, 3 : &NSTEP,DREND,CELEM) 4 : *************************************************************** 5 : * calcule la matrice d efficacite directionnelle 6 : * puis transforme la matrice elementaire par blocs 7 : *************************************************************** 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : DIMENSION VALCAR(*),REL(LRE,LRE) 11 : CHARACTER*16 TYVAL(*) 12 : CHARACTER*8 CELEM 13 : dimension xatef1(3,3),xmat1(3,3),tq(3,3),xres(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 : 45 : * efficacite 46 : * produit 47 : do i = 1,nstep 48 : do j = 1, nstep 49 : cc= 0.d0 50 : do k1 = 1,nstep 51 : cc = cc + tq(i,k1)*xatef1(k1,j) 52 : enddo 53 : xmat2(i,j) = cc 54 : enddo 55 : enddo 56 : do i = 1,nstep 57 : do j = 1, nstep 58 : cc= 0.d0 59 : do k1 = 1,nstep 60 : cc = cc + xmat2(i,k1)*q(k1,j) 61 : enddo 62 : xatef1(i,j) = cc 63 : enddo 64 : enddo 65 : 66 : 67 : 68 : 1000 CONTINUE 69 : * affecte la rigidite elementaire 70 : c ---------------------------------------- 71 : c elements massifs 72 : c ---------------------------------------- 73 : if (CELEM.NE.'MASSIF ') goto 2000 74 : kind = int(LRE/NSTEP) 75 : DO jind1 = 1,kind 76 : DO jind2 =1,kind 77 : 78 : * decoupe un bloc 79 : do in1 = 1,nstep 80 : do in2 = 1, nstep 81 : xmat1(in1,in2) = 82 : & REL((jind1 - 1)*nstep + in1,(jind2 - 1)*nstep + in2) 83 : * if (ib.eq.1.and.igau.eq.1.and.jind1.eq.1.and.jind2.eq.2) 84 : * & write(6,*) in1,in2,xmat1(in1,in2) , 85 : * & ((jind1 - 1)*nstep + in1), ((jind2 - 1)*nstep + in2) 86 : enddo 87 : enddo 88 : * multiplie et range 89 : do in1 = 1,nstep 90 : do in2 = 1, nstep 91 : cc = 0.D0 92 : do k1 = 1,nstep 93 : cc = cc + (xatef1(in1,k1) * xmat1(k1,in2)) 94 : * if (igau.eq.5.and.jind1.eq.6.and.jind2.eq.7) 95 : * &write(6,*) in1,in2,xatef1(in1,k1) , xmat1(k1,in2) 96 : enddo 97 : 98 : REL((jind1 - 1)*nstep + in1,(jind2 - 1)*nstep + in2) = cc 99 : * if (ib.eq.1.and.igau.eq.5.and.jind1.eq.6.and.jind2.eq.7) 100 : * & write(6,*) ((jind1 - 1)*nstep + in1),((jind2 - 1)*nstep + in2), 101 : * & in1,in2, cc 102 : * if (ib.eq.1.and.igau.eq.5.and.jind1.eq.5) 103 : * & write(6,*) ((jind1 - 1)*nstep + in1),((jind2 - 1)*nstep + in2), 104 : * & in1,in2, xmat1(in1,in2),cc 105 : enddo 106 : enddo 107 : 108 : 109 : ENDDO 110 : ENDDO 111 : RETURN 112 : 113 : 2000 CONTINUE 114 : c ---------------------------------------- 115 : c elements 116 : c ---------------------------------------- 117 : RETURN 118 : END 119 :
© Cast3M 2003 - All rights reserved.
Disclaimer