1 : C DSIGRANK SOURCE FANDEUR 13/01/29 21:15:29 7683 2 : SUBROUTINE dsigRank(sigma,dgt,i3,i6,parahot3,idimpara3, 3 : . rkappait,lcp) 4 : 5 : c This subroutine calculates the derivative of the Rankine 6 : c plastic function with respect to sigma 7 : 8 : c gt = ft (because associated plasticity) 9 : c = S1 = largest principal stress 10 : 11 : IMPLICIT REAL*8 (A-B,D-H,O-Z) 12 : implicit integer (I-K,M,N) 13 : implicit logical (L) 14 : implicit character*10 (C) 15 : character*20 cloc1,cloc2 16 : 17 : dimension sigma(i6),dgt(i6) 18 : **** dimension rcossigmapr(i3,i3),parahot3(idimpara3) 19 : dimension rcossigmapr(3,3),parahot3(idimpara3) 20 : dimension P1(3,3),pi1(3),sigmacp(3),vloc(3),vloc1(1),dsigma(3) 21 : 22 : ***** 23 : * MESSAGES D'ERREUR ( SUPPRESSION DES AUTOMATIC OBJECTS) 24 : IF(I3.GT.3) PRINT *, ' DSIGRANK - ERREUR I2 = ', I2, ' > 2 ' 25 : ***** 26 : i1 = 1 27 : i2 = 2 28 : i4 = 4 29 : i5 = 5 30 : r1 = 1.d0 31 : r2 = 2.d0 32 : r4 = 4.d0 33 : 34 : if (lcp) then 35 : c in plane stress, calculation of the derivative of the principal stress 36 : sigmax = sigma(1) 37 : sigmay = sigma(2) 38 : sigmaxy = sigma(4) 39 : diff = sigmax-sigmay 40 : racine = diff*diff+r4*sigmaxy*sigmaxy 41 : cloc1 = 'racine' 42 : cloc2 = 'dsigrank' 42 : call check_sqrt(racine,cloc1,cloc2,lerror) 43 : c **** ********** 44 : if (Lerror) then 45 : return 46 : endif 47 : racine = dsqrt(racine) 48 : rtest = max(sigmax,sigmay) 49 : if (racine.gt.dabs(rtest)*1.e-6) then 50 : dsigma(1) = ( diff/racine+r1)/r2 51 : dsigma(2) = (-diff/racine+r1)/r2 52 : dsigma(3) = 2.0d0*sigmaxy/racine 53 : else 54 : c APEX of the Rankine surface: sigma1 = sigma2 ; sigma12 = 0 55 : dsigma(1) = dsqrt(r2)/r2 56 : dsigma(2) = dsigma(1) 57 : dsigma(3) = 0.D0 58 : endif 59 : dgt(1) = dsigma(1) 60 : dgt(2) = dsigma(2) 61 : dgt(4) = dsigma(3) 62 : dgt(3) = 0.d0 63 : dgt(5) = 0.d0 64 : dgt(6) = 0.d0 65 : else 66 : c in full 3D, calculation of the derivative of the principal stress 66 : call sigmapr3ETC(sigma,S1,S2,S3,rcossigmapr,lcp) 67 : c ============= 68 : c algorithm to find the eigen values and eigen vectors of symmetric matrix sigma 69 : c APEX test 70 : c Carefull with precision of the real*8 71 : sig1 = sigma(1)/10.d6 72 : sig2 = sigma(2)/10.d6 73 : sig3 = sigma(3)/10.d6 74 : sig4 = sigma(4)/10.d6 75 : sig5 = sigma(5)/10.d6 76 : sig6 = sigma(6)/10.d6 77 : rapex = dabs(sigma(1))+dabs(sigma(2))+dabs(sigma(3)) - 78 : . 3.*(dabs(sigma(1)*sigma(2)*sigma(3))**(1.d0/3.d0)) 79 : rapex = rapex + 9.*(dabs(sigma(4))+dabs(sigma(5))+ 80 : . dabs(sigma(6))) 81 : if (rapex.le.3.d-4) then 82 : c APEX of the Rankine surface 83 : dgt(1)=dsqrt(3.d0)/3.d0 84 : dgt(2)=dgt(1) 85 : dgt(3)=dgt(1) 86 : dgt(4)=0.d0 87 : dgt(5)=0.d0 88 : dgt(6)=0.d0 89 : else 90 : c Calculation of dgt/dsig = dgt/ds1 * ds1/dsig 91 : c dgt/dsig is the first column of the transposed matrix of axis change 92 : c between global axis and local axis of the principal stresses 93 : rkx = rcossigmapr(i1,i1) 94 : rmx = rcossigmapr(i2,i1) 95 : rnx = rcossigmapr(i3,i1) 96 : rky = rcossigmapr(i1,i2) 97 : rmy = rcossigmapr(i2,i2) 98 : rny = rcossigmapr(i3,i2) 99 : rkz = rcossigmapr(i1,i3) 100 : rmz = rcossigmapr(i2,i3) 101 : rnz = rcossigmapr(i3,i3) 102 : 103 : c Sxx, Syy, Szz, Sxy, Sxz, Syz 104 : dgt(i1) = rkx*rkx 105 : dgt(i2) = rmx*rmx 106 : dgt(i3) = rnx*rnx 107 : dgt(i4) = 2.0d0*rkx*rmx 108 : dgt(i5) = 2.0d0*rkx*rnx 109 : dgt(i6) = 2.0d0*rmx*rnx 110 : endif 111 : endif 112 : 113 : RETURN 114 : END 115 : 116 :
© Cast3M 2003 - All rights reserved.
Disclaimer