1 : C HEFLP2 SOURCE PV 07/11/23 21:17:07 5978 2 : 3 : 4 : SUBROUTINE HESSFLPOWDER2 (SIG,VAR,AMAT,NDIMA) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : integer ndima,m,i,j 8 : real*8 sig(3),var,amat(ndima,ndima),daux1,daux2 9 : . aux3,aux4 10 : real*8 vecm(3),aux1,aux2,xj2,xi1,x22(6,6),x33(6,6) 11 : real*8 nn1,nn2,eta0,aa1,aa2,bb1,bb2, 12 : . pia,pib,sigy0,pcc,rrr 13 : common /poder2_data/ nn1,nn2,eta0,aa1,aa2,bb1,bb2, 14 : . pia,pib,sigy0,pcc,rrr 14 : call DerDerInvariIJJ(sig,x22,x33,3) 14 : call Invari_I1(sig,3,xi1) 15 : if (xi1.lt.pia) then 16 : do i=1,3 17 : do j=1,3 18 : amat(i,j)=x22(i,j)+2.D0/rrr**2 19 : enddo 20 : enddo 21 : else 22 : aux1 = (pia-xi1)/(pia-pcc) 23 : daux1 = -1.D0/(pia-pcc) 24 : if (aux1.gt.1.D0) then 25 : aux1 =1.D0 26 : daux1=0.D0 27 : endif 28 : aux2 = bb1/3.D0 28 : call Invari_J2(sig,3,xj2) 28 : call desviador(sig,vecm,3) 29 : aux3 = 1.D0 / dsqrt(2.D0*xj2) 30 : aux4 = -1.D0 / dsqrt((2.D0*xj2)**3) 31 : aux5 = xj2/(aa2*sigy0**2/3.D0) 32 : daux5 = 1.D0/(aa2*sigy0**2/3.D0) 33 : if (aux5.gt.1.D0) then 34 : aux5=1.D0 35 : daux5 = 0.D0 36 : endif 37 : ****** D-P Meschke examples 38 : * aux5= 1.D0 39 : * daux5=0.D0 40 : * aux1 =1.D0 41 : * daux1=0.D0 42 : ****** D-P Meschke examples 43 : do i=1,3 44 : do j=1,3 45 : amat(i,j)=aux5*(aux3*x22(i,j)+aux4*vecm(i)*vecm(j))+ 46 : . daux5*(aux3*vecm(i)*vecm(j))+ 47 : . aux2*daux1 48 : enddo 49 : enddo 50 : endif 51 : return 52 : end 53 : 54 : 55 : 56 :
© Cast3M 2003 - All rights reserved.
Disclaimer