1 : C JAUCAU SOURCE CHAT 11/03/16 21:25:52 6902 2 : subroutine jaucau(NBNN,nbsh,tab1,Ncoele,NBPTEL,SHPTOT,XE1 3 : 1 ,XE2, BGENE, SHPWRK,tab,KCAS,KERRE,mwrk5,ipmint,mele) 4 : implicit real*8(a-h,o-z) 5 : implicit integer (i-n) 6 : -INC SMINTE 7 : -INC CCOPTIO 8 : SEGMENT MWRK5 9 : REAL*8 BGR(NGRA,LRE),BB(2,NGRA),gradi(ngra),R(ngra),u(ngra) 10 : REAL*8 TENS(9),tentra(9),xddls2(lre) 11 : ENDSEGMENT 12 : dimension xe1(3,nbnn),xe2(3,nbnn) 13 : dimension tab(nbptel,*),shpwrk(6,NBNN),shptot(6,NBNN,*) 14 : dimension tab1(nbptel,*),bgene(*) 15 : 16 : C 17 : KERRE=0 18 : C 19 : C MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS 20 : C 21 : DO 50 IA=1,NBPTEL 22 : DO 50 IB=1,NCOELE 23 : TAB(IA,IB)=0.D0 24 : 50 CONTINUE 25 : xxr=1.d0 26 : if(kcas.eq.2) xxr=2.d0 27 : xxzero=0.d0 28 : iipdpg=0 29 : ngra=gradi(/1) 30 : lre=xddls2(/1) 31 : minte=ipmint 32 : NHRM=NIFOUR 33 : do 51 igau=1,nbptel 33 : CALL BGRMAS(iGau,mele,nbnn,LRE,IFOUR,NGRA,NIFOUR,XE1, 34 : . xXZero,SHPTOT,SHPWRK,BB,BGR,DJAC,IIPDPG) 35 : ia=0 36 : do iou=1,NBNN 37 : do iyu=1,idim 38 : ia=ia+1 39 : xddls2(ia)= XE2(iyu,iou)-xe1(iyu,iou) 40 : enddo 41 : enddo 41 : CALL BGRDEP(BGR,NGRA,XDDLs2,LRE,GRADI) 42 : if(idim.eQ.2) then 43 : gradi(1)=gradi(1)+1.D0 44 : gradi(4)=gradi(4)+1.D0 45 : ELSE IF(IDIM.EQ.3) THEN 46 : gradi(1)=gradi(1)+1.D0 47 : gradi(5)=gradi(5)+1.D0 48 : gradi(9)=gradi(9)+1.D0 49 : ENDIF 49 : CALL POLA2(gradi,R,U,IDIM) 50 : * fait le rtens R.A.Rt on utilise u pour mettre Rt 51 : * et on met le tenseur dans le tableau tens 52 : * attention, vu le stockage R est en fait Rt 53 : if(idim.eq.2) then 54 : U(1)=r(1) 55 : u(2)=r(3) 56 : U(3)=R(2) 57 : u(4)=R(4) 58 : tens(1)=tab1(igau,1) 59 : tens(2)=tab1(igau,4)/xxr 60 : tens(3)=tab1(igau,4)/xxr 61 : tens(4)=tab1(igau,2) 62 : elseif(idim.eq.3) then 63 : U(1)=r(1) 64 : u(2)=r(4) 65 : U(3)=R(7) 66 : u(4)=R(2) 67 : u(5)=r(5) 68 : u(6)=r(8) 69 : u(7)=r(3) 70 : u(8)=r(6) 71 : u(9)=r(9) 72 : tens(1)=tab1(igau,1) 73 : tens(2)=tab1(igau,4)/xxr 74 : tens(3)=tab1(igau,5)/xxr 75 : tens(4)=tens(2) 76 : tens(5)=tab1(igau,2) 77 : tens(6)=tab1(igau,6)/xxr 78 : tens(7)=tens(3) 79 : tens(8)=tens(6) 80 : tens(9)=tab1(igau,3) 81 : else 82 : write(6,*)' idim est ni 2 ni 3 stop' 83 : stop 84 : endif 84 : CALL MULMAT(tentra,tens,R,IDIM,IDIM,IDIM) 84 : CALL MULMAT(tens,U,Tentra,IDIM,IDIM,IDIM) 85 : if(idim.eq.2) then 86 : tab(igau,1)=tens(1) 87 : tab(igau,2)=tens(4) 88 : tab(igau,4)=tens(2)*xxr 89 : else 90 : tab(igau,1)=tens(1) 91 : tab(igau,2)=tens(5) 92 : tab(igau,3)=tens(9) 93 : tab(igau,4)=tens(2)*xxr 94 : tab(igau,5)=tens(3)*xxr 95 : tab(igau,6)=tens(6)*xxr 96 : endif 97 : 51 CONTINUE 98 : return 99 : end 100 : 101 : 102 : 103 : 104 :
© Cast3M 2003 - All rights reserved.
Disclaimer