[cig-commits] r20932 - in seismo/3D/FAULT_SOURCE/branches/new_fault_db: decompose_mesh_SCOTCH src
surendra at geodynamics.org
surendra at geodynamics.org
Thu Oct 25 17:32:13 PDT 2012
Author: surendra
Date: 2012-10-25 17:32:13 -0700 (Thu, 25 Oct 2012)
New Revision: 20932
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90
Log:
Fixed lot of compiler errors from recent cleanup
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90 2012-10-26 00:16:57 UTC (rev 20931)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90 2012-10-26 00:32:13 UTC (rev 20932)
@@ -260,7 +260,8 @@
! ---------------------------------------------------------------------------------------------------
subroutine lex_order(xyz_c,loc,nnodes,nspec)
- integer, intent(in) :: nnodes,nspec,loc(nspec)
+ integer, intent(in) :: nnodes,nspec
+ integer :: loc(nspec)
double precision, intent(in) :: xyz_c(3,nspec)
double precision, dimension(nspec) :: work,xp,yp,zp
@@ -351,7 +352,7 @@
call fault_repartition_parallel (nelmnts,part,nodes_coords,nnodes)
else
! move all fault elements to the same partition (proc=0)
- call fault_repartition_not_parallel (nelmnts, nnodes, elmnts, nsize, nparts, part, esize)
+ call fault_repartition_not_parallel (nelmnts, nnodes, elmnts, nsize, nproc, part, esize)
endif
end subroutine fault_repartition
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90 2012-10-26 00:16:57 UTC (rev 20931)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90 2012-10-26 00:32:13 UTC (rev 20932)
@@ -86,7 +86,8 @@
type, extends (fault_type) :: bc_dynflt_type
private
- real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null(), MU=>null(), Fload=>null()
+ real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null()
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(), Fload=>null()
type(dataT_type) :: dataT
type(dataXZ_type) :: dataXZ,dataXZ_all
type(swf_type), pointer :: swf => null()
@@ -262,9 +263,9 @@
allocate(bc%MU(bc%nglob))
if (RATE_AND_STATE) then
allocate(bc%rsf)
- call rsf_init(bc%rsf,bc%Fload,bc%coord,IIN_PAR)
+ call rsf_init(bc%rsf,bc%T0,bc%Fload,bc%coord,IIN_PAR)
! WARNING: the line below is only valid for pure strike-slip faulting
- bc%V(1,:) = f%V_init
+ bc%V(1,:) = bc%rsf%V_init
else
allocate(bc%swf)
call swf_init(bc%swf,bc%MU,bc%coord,IIN_PAR)
@@ -288,6 +289,7 @@
integer, dimension(bc%nglob) :: inp_nx,inp_nz
real(kind=CUSTOM_REAL) :: minX, siz_str,siz_dip, hypo_loc_str,hypo_loc_dip,rad_T_str,rad_T_dip
integer :: relz_num,sub_relz_num, num_cell_str,num_cell_dip, hypo_cell_str,hypo_cell_dip
+ integer :: i
open(unit=IIN_NUC,file='DATA/FAULT/input_file.txt',status='old',iostat=ier)
read(IIN_NUC,*) relz_num,sub_relz_num
@@ -701,11 +703,12 @@
!=====================================================================
-subroutine rsf_init(f,nucFload,coord,IIN_PAR)
+subroutine rsf_init(f,T0,nucFload,coord,IIN_PAR)
type(rsf_type), intent(out) :: f
+ real(kind=CUSTOM_REAL), intent(in) :: T0(:,:)
real(kind=CUSTOM_REAL), intent(in) :: coord(:,:)
- real(kind=CUSTOM_REAL), pointer :: nucFload(:,:)
+ real(kind=CUSTOM_REAL), pointer :: nucFload(:)
integer, intent(in) :: IIN_PAR
real(kind=CUSTOM_REAL) :: V0,f0,a,b,L,theta,theta_init,V_init,fw,Vw, C,T
@@ -718,22 +721,25 @@
real(kind=CUSTOM_REAL) :: Fload
integer :: nFload
! real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: init_vel
+ integer :: nglob
NAMELIST / RSF / V0,f0,a,b,L,V_init,theta_init,nV0,nf0,na,nb,nL,nV_init,ntheta_init,C,T,nC,nForcedRup,Vw,fw,nVw,nfw
NAMELIST / ASP / Fload,nFload
- allocate( f%V0(bc%nglob) )
- allocate( f%f0(bc%nglob) )
- allocate( f%a(bc%nglob) )
- allocate( f%b(bc%nglob) )
- allocate( f%L(bc%nglob) )
- allocate( f%V_init(bc%nglob) )
- allocate( f%theta(bc%nglob) )
- allocate( f%C(bc%nglob) )
- allocate( f%T(bc%nglob) )
- allocate( f%fw(bc%nglob) )
- allocate( f%Vw(bc%nglob) )
+ nglob = size(coord,2)
+ allocate( f%V0(nglob) )
+ allocate( f%f0(nglob) )
+ allocate( f%a(nglob) )
+ allocate( f%b(nglob) )
+ allocate( f%L(nglob) )
+ allocate( f%V_init(nglob) )
+ allocate( f%theta(nglob) )
+ allocate( f%C(nglob) )
+ allocate( f%T(nglob) )
+ allocate( f%fw(nglob) )
+ allocate( f%Vw(nglob) )
+
V0 =1.e-6_CUSTOM_REAL
f0 =0.6_CUSTOM_REAL
a =0.0080_CUSTOM_REAL !0.0080_CUSTOM_REAL
@@ -801,7 +807,7 @@
W2=7500._CUSTOM_REAL
w=3000._CUSTOM_REAL
hypo_z = -7500._CUSTOM_REAL
- do i=1,bc%nglob
+ do i=1,nglob
x=coord(1,i)
z=coord(3,i)
c1=abs(x)<W1+w
@@ -847,15 +853,15 @@
! We should implement it as an option for the user
if(f%stateLaw == 1) then
f%theta = f%L/f%V0 &
- * exp( ( f%a * log(TWO*sinh(-sqrt(bc%T0(1,:)**2+bc%T0(2,:)**2)/bc%T0(3,:)/f%a)) &
+ * exp( ( f%a * log(TWO*sinh(-sqrt(T0(1,:)**2+T0(2,:)**2)/T0(3,:)/f%a)) &
- f%f0 - f%a*log(f%V_init/f%V0) ) &
/ f%b )
else
- f%theta = f%a * log(TWO*V0/V_init * sinh(-sqrt(bc%T0(1,:)**2+bc%T0(2,:)**2)/bc%T0(3,:)/f%a))
+ f%theta = f%a * log(TWO*V0/V_init * sinh(-sqrt(T0(1,:)**2+T0(2,:)**2)/T0(3,:)/f%a))
endif
! WARNING : ad hoc for SCEC benchmark TPV10x
- allocate( nucFload(bc%nglob) )
+ allocate( nucFload(nglob) )
Fload = 0.e0_CUSTOM_REAL
nFload = 0
read(IIN_PAR, nml=ASP)
More information about the CIG-COMMITS
mailing list