[cig-commits] r5319 -
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d
willic3 at geodynamics.org
willic3 at geodynamics.org
Fri Nov 17 14:36:34 PST 2006
Author: willic3
Date: 2006-11-17 14:36:34 -0800 (Fri, 17 Nov 2006)
New Revision: 5319
Modified:
short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/mat_7.f
Log:
Fixed some bugs, mostly related to intializing viscous strain variables.
Test based on bm1 seems to work OK.
Need to do a shear test to make sure I haven't mixed up engineering/tensor strain.
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/mat_7.f
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/mat_7.f 2006-11-17 22:18:26 UTC (rev 5318)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/libpylith3d/mat_7.f 2006-11-17 22:36:34 UTC (rev 5319)
@@ -227,10 +227,17 @@
double precision dmat(nddmat),tmax
character errstrng*(*)
c
+c... local constants
+c
+ double precision diag(6),eng(6)
+ data diag/one,one,one,zero,zero,zero/
+ data eng/one,one,one,half,half,half/
+c
c... local variables
c
integer i
- double precision sfrac,e,pr,vise,rmu,rmue,tmaxe
+ double precision sfrac,e,pr,vise,rmu,rmue,tmaxe,emean
+ double precision edev(6)
c
cdebug write(6,*) "Hello from elas_strs_7_f!"
c
@@ -250,6 +257,16 @@
call dspmv("u",nstr,one,dmat,state(7),ione,one,state,ione)
call dcopy(nstr,state,ione,scur,ione)
c
+c... compute strain quantities to initialize viscous strain
+c
+ emean=third*(ee(1)+ee(2)+ee(3))
+ do i=1,nstr
+ edev(i)=ee(i)*eng(i)-emean*diag(i)
+ end do
+ do i=1,3
+ call dcopy(nstr,edev,ione,state(nstr*(i-1)+13),ione)
+ end do
+c
c... compute Maxwell time for current stress state
c
e=prop(2)
@@ -357,6 +374,7 @@
c
integer i
double precision sfrac,frac0,e,pr,rmu,rmue,vise,bulkm,sfac,shfac
+ double precision rmut
c
c... included variable definitions
c
@@ -389,10 +407,11 @@
tmax=big
do i=1,3
rmue=prop(2*(i-1)+4)
+ rmut=rmu*rmue
vise=prop(2*(i-1)+5)
if(rmue.ne.zero) then
- tmax=min(tmax,vise/rmue)
- shfac=shfac+rmue*compdq(deltp,vise,rmue)
+ tmax=min(tmax,vise/rmut)
+ shfac=shfac+rmue*compdq(deltp,vise,rmut)
end if
end do
c
@@ -458,7 +477,7 @@
c... local variables
c
integer i,j,ind
- double precision sfrac,e,pr,rmu,bulkm,rmue,vise,frac0
+ double precision sfrac,e,pr,rmu,bulkm,rmue,rmut,vise,frac0
double precision etracetdt,emeantdt,smeantdt,sdevtdt,dq(3)
double precision edevtdt,edevt,emeant,deltae,rtime(3)
c
@@ -495,12 +514,13 @@
tmax=big
do i=1,3
rmue=prop(2*(i-1)+4)
+ rmut=rmu*rmue
vise=prop(2*(i-1)+5)
rtime(i)=zero
if(rmue.ne.zero) then
- rtime(i)=vise/rmue
+ rtime(i)=vise/rmut
tmax=min(tmax,rtime(i))
- dq(i)=compdq(deltp,vise,rmue)
+ dq(i)=compdq(deltp,vise,rmut)
end if
end do
c
@@ -521,7 +541,7 @@
end if
end do
sdevtdt=two*rmu*sdevtdt
- dstate(i)=smeantdt+sdevtdt+state0(i)
+ dstate(i)=diag(i)*smeantdt+sdevtdt+state0(i)
dstate(i+6)=ee(i)
scur(i)=dstate(i)
end do
More information about the cig-commits
mailing list