[cig-commits] r5483 -
short/3D/PyLith/branches/pylith-0.8/pylith3d/utils
willic3 at geodynamics.org
willic3 at geodynamics.org
Wed Dec 6 12:59:23 PST 2006
Author: willic3
Date: 2006-12-06 12:59:22 -0800 (Wed, 06 Dec 2006)
New Revision: 5483
Modified:
short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.f
short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.par
Log:
Updated code to allow coordinate ranges to be specified. Nodes outside
those ranges get no slip.
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.f
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.f 2006-12-06 20:33:12 UTC (rev 5482)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.f 2006-12-06 20:59:22 UTC (rev 5483)
@@ -30,7 +30,7 @@
c... info read or deduced from parameter file
c
integer nfaults,numdefs,faultdef(3,maxdefs),blocknum(maxblocks)
- double precision cscale,dipcut,pole(3,maxblocks)
+ double precision cscale,dipcut,pole(3,maxblocks),xlims(3,2)
logical dflag
c
c... intrinsic functions
@@ -50,7 +50,7 @@
integer elems(maxattached),colors(maxattached)
double precision pi,d2r
double precision x(nsd),xtmp(nsd),fnorm(nsd)
- logical pairused
+ logical pairused,inrange
character ffile*500
c
pi=acos(-1.0d0)
@@ -75,6 +75,11 @@
c
if(dflag) dipcut=abs(sin(d2r*dipcut))
c
+c... coordinate ranges to be considered
+c
+ call pskip(kp)
+ read(kp,*) ((xlims(i,j),j=1,2),i=1,3)
+c
c... block rotation poles
c
do i=1,nblocks
@@ -105,60 +110,64 @@
read(kf,*,end=20) nattached
read(kf,*,end=20) (elems(j),j=1,nattached)
read(kf,*,end=20) (colors(j),j=1,nattached)
+ inrange=.true.
do j=1,3
x(j)=cscale*xtmp(j)
+ if(x(j).lt.xlims(j,1).or.x(j).gt.xlims(j,2)) inrange=.false.
end do
c
c... see if pair has been used previously. If not, create a new entry
c if the fault has been defined.
c
- do j=1,nattached
- pairused=.false.
- do k=1,nentries
- if(elems(j).eq.nfault(1,k).and.node.eq.nfault(2,k)) then
- pairused=.true.
- go to 30
- end if
- end do
- 30 continue
- if(.not.pairused) then
+ if(inrange) then
+ do j=1,nattached
+ pairused=.false.
+ do k=1,nentries
+ if(elems(j).eq.nfault(1,k).and.node.eq.nfault(2,k)) then
+ pairused=.true.
+ go to 30
+ end if
+ end do
+ 30 continue
+ if(.not.pairused) then
c
c... for now, choose first fault in definition list
c
- blk1=0
- blk2=0
- faultnum=0
- do k=1,numdefs
- if(colors(j).eq.faultdef(1,k)) then
- blk1=colors(j)
- blk2=faultdef(2,k)
- faultnum=k
- go to 40
- else if(colors(j).eq.faultdef(2,k)) then
- blk1=colors(j)
- blk2=faultdef(1,k)
- faultnum=k
- go to 40
- end if
- end do
- 40 continue
- if(blk1.eq.0) then
- write(kto,810) elems(j),node,colors(j)
- else
- nentries=nentries+1
- nfault(1,nentries)=elems(j)
- nfault(2,nentries)=node
- call getvals(x,fnorm,dipcut,dflag,
- & pole(1,blocknum(blk1)),pole(1,blocknum(blk2)),split)
+ blk1=0
+ blk2=0
+ faultnum=0
+ do k=1,numdefs
+ if(colors(j).eq.faultdef(1,k)) then
+ blk1=colors(j)
+ blk2=faultdef(2,k)
+ faultnum=k
+ go to 40
+ else if(colors(j).eq.faultdef(2,k)) then
+ blk1=colors(j)
+ blk2=faultdef(1,k)
+ faultnum=k
+ go to 40
+ end if
+ end do
+ 40 continue
+ if(blk1.eq.0) then
+ write(kto,810) elems(j),node,colors(j)
+ else
+ nentries=nentries+1
+ nfault(1,nentries)=elems(j)
+ nfault(2,nentries)=node
+ call getvals(x,fnorm,dipcut,dflag,
+ & pole(1,blocknum(blk1)),pole(1,blocknum(blk2)),split)
c
c... output split node values
c
- write(kso,"(3i8,3(2x,1pe15.8))")
- & (nfault(k,nentries),k=1,2),faultdef(3,faultnum),
- & (split(k),k=1,3)
+ write(kso,"(3i8,3(2x,1pe15.8))")
+ & (nfault(k,nentries),k=1,2),faultdef(3,faultnum),
+ & (split(k),k=1,3)
+ end if
end if
- end if
- end do
+ end do
+ end if
go to 10
20 continue
close(kf)
Modified: short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.par
===================================================================
--- short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.par 2006-12-06 20:33:12 UTC (rev 5482)
+++ short/3D/PyLith/branches/pylith-0.8/pylith3d/utils/blockrot3.par 2006-12-06 20:59:22 UTC (rev 5483)
@@ -17,6 +17,16 @@
4 3 1.0d0 75.0d0
#-----------------------------------------------------------------------
#
+# Coordinate ranges:
+#
+# Enter coordinate ranges to be considered. Any points lying
+# outside of these ranges will be rejected.
+#
+# xmin xmax ymin ymax zmin zmax
+#-----------------------------------------------------------------------
+ -1.5d5 1.5d5 -1.5d5 1.5d5 4.0d3 1.9d4
+#-----------------------------------------------------------------------
+#
# Rotation pole info:
#
# For each block, enter the following info:
@@ -32,13 +42,10 @@
#
# blocknum(i) polex(i) poley(i) poler(i), i=1,nblocks
#-----------------------------------------------------------------------
- 1 1.0d5 1.0d5 -5.0d-6
- 2 -1.0d5 -1.0d5 -5.0d-6
- 3 0.0d0 0.0d0 0.0d0
- 4 0.0d0 0.0d0 0.0d0
-# poles above should yield approximately equal amounts of strike-slip
-# and dip-slip movement on the fault between blocks 1 and 2. Blocks 3
-# and 4 are chosen as the reference frame and so have no movement.
+ 1 -3.373d5 -9.571d5 -2.291d-7
+ 2 -5.002d5 -8.817d5 -4.584d-7
+ 5 0.0d0 0.0d0 0.0d0
+ 6 -1.500d5 -2.910d5 -3.163d-6
#-----------------------------------------------------------------------
#
# Fault definition info:
@@ -65,15 +72,27 @@
#
#-----------------------------------------------------------------------
1
- 1 2 1
-"fault_03_01_02.flt_pylith"
-# Highest priority is dipping boundary between blocks 1 and 2.
+ 6 5 0
+"fault_02_06_05_subset.flt_pylith"
+# Highest priority is San Andreas boundary.
1
- 1 4 2
-"fault_08_01_04.flt_pylith"
-# Next highest priority is vertical boundary between blocks 1 and 4.
+ 6 2 0
+"fault_06_06_02.flt_pylith"
+# Next highest priority is SAF boundary of block 2.
1
- 2 3 3
-"fault_11_02_03.flt_pylith"
-# Lowest priority is vertical boundary between blocks 2 and 3.
+ 6 1 0
+"fault_03_06_01.flt_pylith"
+# Next highest priority is SAF boundary of block 1.
+ 1
+ 5 2 0
+"fault_07_05_02.flt_pylith"
+# Next highest priority is boundary between block 2 and reference block.
+ 1
+ 5 1 0
+"fault_05_05_01.flt_pylith"
+# Next highest priority is boundary between block 1 and reference block.
+ 1
+ 2 1 0
+"fault_16_02_01.flt_pylith"
+# Lowest priority is boundary between blocks 1 and 2.
#-----------------------------------------------------------------------
More information about the cig-commits
mailing list