[cig-commits] r21072 - seismo/3D/FAULT_SOURCE/branches/new_fault_db/src
ampuero at geodynamics.org
ampuero at geodynamics.org
Mon Nov 26 15:55:49 PST 2012
Author: ampuero
Date: 2012-11-26 15:55:49 -0800 (Mon, 26 Nov 2012)
New Revision: 21072
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_generate_databases.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_dynamic.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/prepare_timerun.f90
Log:
fault modules now export error messages to IMAIN file
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90 2012-11-26 14:18:14 UTC (rev 21071)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/create_regions_mesh.f90 2012-11-26 23:55:49 UTC (rev 21072)
@@ -172,7 +172,7 @@
nspec2D_bottom,nspec2D_top,ANISOTROPY)
! if faults exist this reads nodes_coords_open
- call fault_read_input(prname,NDIM)
+ call fault_read_input(prname,myrank)
call sync_all()
if (myrank == 0) write(IMAIN,*) ' ...setting up jacobian '
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_generate_databases.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_generate_databases.f90 2012-11-26 14:18:14 UTC (rev 21071)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_generate_databases.f90 2012-11-26 23:55:49 UTC (rev 21072)
@@ -9,7 +9,7 @@
module fault_generate_databases
- use create_regions_mesh_ext_par, only: NGLLX,NGLLY,NGLLZ,NGLLSQUARE,NGNOD2D,NDIM,CUSTOM_REAL
+ use create_regions_mesh_ext_par, only: NGLLX,NGLLY,NGLLZ,NGLLSQUARE,NGNOD2D,NDIM,CUSTOM_REAL,IMAIN
implicit none
private
@@ -34,9 +34,9 @@
logical, save :: ANY_FAULT_IN_THIS_PROC = .false.
logical, save :: ANY_FAULT = .false.
+ logical, parameter :: PARALLEL_FAULT = .true.
! NOTE: PARALLEL_FAULT has to be the same
! in fault_solver_common.f90, fault_generate_databases.f90 and fault_scotch.f90
- logical, parameter :: PARALLEL_FAULT = .true.
! corners indices of reference cube faces
integer,dimension(3,4),parameter :: iface1_corner_ijk = &
@@ -62,23 +62,23 @@
contains
!=================================================================================================================
-subroutine fault_read_input(prname,NDIM)
+subroutine fault_read_input(prname,myrank)
character(len=256), intent(in) :: prname
- integer, intent(in) :: NDIM
+ integer, intent(in) :: myrank
integer :: nb,i,iflt,ier,nspec,dummy_node
- integer, parameter :: IIN = 100
+ integer, parameter :: IIN_PAR = 100
! read fault input file
nb = 0
- open(unit=IIN,file='DATA/Par_file_faults',status='old',action='read',iostat=ier)
+ open(unit=IIN_PAR,file='DATA/Par_file_faults',status='old',action='read',iostat=ier)
if (ier==0) then
- read(IIN,*) nb
+ read(IIN_PAR,*) nb
+ if (myrank==0) write(IMAIN,*) ' ... reading ', nb,' faults from file DATA/Par_file_faults'
else
- write(6,*) 'No faults in the domain'
- write(6,*) 'Par_file_faults does not exist '
- close(IIN)
+ if (myrank==0) write(IMAIN,*) 'File DATA/Par_file_faults not found: assume no faults'
+ close(IIN_PAR)
end if
ANY_FAULT = (nb>0)
@@ -86,22 +86,22 @@
allocate(fault_db(nb))
do i=1,nb
- read(IIN,*) fault_db(i)%eta
+ read(IIN_PAR,*) fault_db(i)%eta
enddo
- close(IIN)
+ close(IIN_PAR)
! read fault database file
- open(unit=IIN,file=prname(1:len_trim(prname))//'Database_fault', &
+ open(unit=IIN_PAR,file=prname(1:len_trim(prname))//'Database_fault', &
status='old',action='read',form='formatted',iostat=ier)
if( ier /= 0 ) then
- write(IIN,*) 'error opening file: ',prname(1:len_trim(prname))//'Database_fault'
- write(IIN,*) 'make sure file exists'
+ write(IIN_PAR,*) 'error opening file: ',prname(1:len_trim(prname))//'Database_fault'
+ write(IIN_PAR,*) 'make sure file exists'
stop
endif
do iflt=1,size(fault_db)
- read(IIN,*) nspec
+ read(IIN_PAR,*) nspec
fault_db(iflt)%nspec = nspec
if (nspec == 0) cycle
@@ -114,30 +114,30 @@
allocate(fault_db(iflt)%inodes2(4,nspec))
do i=1,nspec
- read(IIN,*) fault_db(iflt)%ispec1(i), fault_db(iflt)%inodes1(:,i)
+ read(IIN_PAR,*) fault_db(iflt)%ispec1(i), fault_db(iflt)%inodes1(:,i)
enddo
do i=1,nspec
- read(IIN,*) fault_db(iflt)%ispec2(i), fault_db(iflt)%inodes2(:,i)
+ read(IIN_PAR,*) fault_db(iflt)%ispec2(i), fault_db(iflt)%inodes2(:,i)
enddo
! loading ispec1 ispec2 iface1 iface2 of fault elements.
! allocate(fault_db(iflt)%iface1(nspec))
! allocate(fault_db(iflt)%iface2(nspec))
! do i=1,fault_db(iflt)%nspec
-! read(IIN,*) fault_db(iflt)%ispec1(i), fault_db(iflt)%ispec2(i), &
+! read(IIN_PAR,*) fault_db(iflt)%ispec1(i), fault_db(iflt)%ispec2(i), &
! fault_db(iflt)%iface1(i), fault_db(iflt)%iface2(i)
! enddo
enddo
! read nodes coordinates of the original version of the mesh, in which faults are open
- read(IIN,*) nnodes_coords_open
+ read(IIN_PAR,*) nnodes_coords_open
allocate(nodes_coords_open(NDIM,nnodes_coords_open))
do i = 1, nnodes_coords_open
- read(IIN,*) dummy_node, nodes_coords_open(:,i)
+ read(IIN_PAR,*) dummy_node, nodes_coords_open(:,i)
enddo
- close(IIN)
+ close(IIN_PAR)
end subroutine fault_read_input
@@ -587,13 +587,13 @@
integer :: size_Kelvin_Voigt
if (.not.ANY_FAULT) return
-! opening Kelvin_voig_eta.bin (Necessary for all processors , if number of fault elements = 0
-! then the file will be empty with
+
+! opening Kelvin_voig_eta.bin for each processor
+! if number of fault elements = 0 then the file is empty
filename = prname(1:len_trim(prname))//'Kelvin_voigt_eta.bin'
open(unit=IOUT,file=trim(filename),status='unknown',action='write',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(IOUT) 'error opening file ',trim(filename)
- ! JPA instead of IOUT this error message should go to an error log file
+ write(IMAIN,*) 'error opening file ',trim(filename)
stop
endif
@@ -605,14 +605,13 @@
endif
write(IOUT) size_Kelvin_Voigt
if (size_Kelvin_Voigt /= 0) Write(IOUT) Kelvin_Voigt_eta
- Close(IOUT)
+ close(IOUT)
! saves mesh file proc***_fault_db.bin
filename = prname(1:len_trim(prname))//'fault_db.bin'
open(unit=IOUT,file=trim(filename),status='unknown',action='write',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(IOUT,*) 'error opening file ',trim(filename)
- ! JPA instead of IOUT this error message should go to an error log file
+ write(IMAIN,*) 'error opening file ',trim(filename)
stop
endif
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90 2012-11-26 14:18:14 UTC (rev 21071)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90 2012-11-26 23:55:49 UTC (rev 21072)
@@ -5,10 +5,10 @@
module fault_solver_common
+ use constants
+
implicit none
- include 'constants.h'
-
private
type fault_type
@@ -298,7 +298,10 @@
! count the number of output points on the current fault (#iflt)
open(IIN,file='DATA/FAULT_STATIONS',status='old',action='read',iostat=ier)
- if( ier /= 0 ) stop 'error opening FAULT_STATIONS file'
+ if (ier /= 0) then
+ if (myrank==0) write(IMAIN,*) 'Fatal error opening FAULT_STATIONS file. Abort.'
+ stop
+ endif
read(IIN,*) np
dataT%npoin =0
do i=1,np
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_dynamic.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_dynamic.f90 2012-11-26 14:18:14 UTC (rev 21071)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_dynamic.f90 2012-11-26 23:55:49 UTC (rev 21072)
@@ -14,8 +14,6 @@
implicit none
- include 'constants.h'
-
private
! outputs(dyn) /inputs (kind) at selected times for all fault nodes:
@@ -92,12 +90,12 @@
! Minv inverse mass matrix
! dt global time step
!
-subroutine BC_DYNFLT_init(prname,Minv,DTglobal,nt,vel)
+subroutine BC_DYNFLT_init(prname,Minv,DTglobal,nt,vel,myrank)
character(len=256), intent(in) :: prname ! 'proc***'
real(kind=CUSTOM_REAL), intent(in) :: Minv(:)
double precision, intent(in) :: DTglobal
- integer, intent(in) :: nt
+ integer, intent(in) :: nt,myrank
real(kind=CUSTOM_REAL), intent(inout) :: vel(:,:)
real(kind=CUSTOM_REAL) :: dt
@@ -115,18 +113,25 @@
open(unit=IIN_PAR,file='DATA/Par_file_faults',status='old',iostat=ier)
if( ier /= 0 ) then
- write(6,*) 'File Par_file_faults not found: assume no faults'
+ if (myrank==0) write(IMAIN,*) 'File DATA/Par_file_faults not found: assume no faults'
close(IIN_PAR)
return
endif
read(IIN_PAR,*) nbfaults
- if (nbfaults==0) return
+ if (nbfaults==0) then
+ if (myrank==0) write(IMAIN,*) 'No faults found in file DATA/Par_file_faults'
+ return
+ elseif (nbfaults==1) then
+ if (myrank==0) write(IMAIN,*) 'There is 1 fault in file DATA/Par_file_faults'
+ else
+ if (myrank==0) write(IMAIN,*) 'There are ', nbfaults, ' faults in file DATA/Par_file_faults'
+ endif
filename = prname(1:len_trim(prname))//'fault_db.bin'
open(unit=IIN_BIN,file=trim(filename),status='old',action='read',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(6,*) 'File ',trim(filename),' not found. Abort'
+ write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
stop
endif
! WARNING TO DO: should be an MPI abort
@@ -160,7 +165,7 @@
filename = prname(1:len_trim(prname))//'Kelvin_voigt_eta.bin'
open(unit=IIN_BIN,file=trim(filename),status='old',action='read',form='unformatted',iostat=ier)
if( ier /= 0 ) then
- write(6,*) 'File ',trim(filename),' not found. Abort'
+ write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
stop
endif
read(IIN_BIN) size_Kelvin_Voigt
@@ -169,8 +174,11 @@
read(IIN_BIN) Kelvin_Voigt_eta
endif
close(IIN_BIN)
+
return
-100 stop 'Did not find BEGIN_FAULT block #'
+
+100 if (myrank==0) write(IMAIN,*) 'Fatal error: did not find BEGIN_FAULT input block in file DATA/Par_file_faults. Abort.'
+ stop
! WARNING TO DO: should be an MPI abort
end subroutine BC_DYNFLT_init
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90 2012-11-26 14:18:14 UTC (rev 21071)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90 2012-11-26 23:55:49 UTC (rev 21072)
@@ -9,8 +9,6 @@
implicit none
- include 'constants.h'
-
private
! outputs(dyn) /inputs (kind) at selected times for all fault nodes:
@@ -54,12 +52,12 @@
! Minv inverse mass matrix
! dt global time step
!
-subroutine BC_KINFLT_init(prname,Minv,DTglobal,nt)
+subroutine BC_KINFLT_init(prname,Minv,DTglobal,nt,myrank)
character(len=256), intent(in) :: prname ! 'proc***'
real(kind=CUSTOM_REAL), intent(in) :: Minv(:)
double precision, intent(in) :: DTglobal
- integer, intent(in) :: nt
+ integer, intent(in) :: nt,myrank
real(kind=CUSTOM_REAL) :: dt
integer :: iflt,ier,dummy_idfault
@@ -76,16 +74,27 @@
open(unit=IIN_PAR,file='DATA/Par_file_faults',status='old',iostat=ier)
if( ier /= 0 ) then
- write(6,*) 'Have not found Par_file_faults: assume no faults'
+ if (myrank==0) write(IMAIN,*) 'File DATA/Par_file_faults not found: assume no faults'
+ close(IIN_PAR)
return
endif
read(IIN_PAR,*) nbfaults
- if (nbfaults==0) return
+ if (nbfaults==0) then
+ if (myrank==0) write(IMAIN,*) 'No faults found in file DATA/Par_file_faults'
+ return
+ elseif (nbfaults==1) then
+ if (myrank==0) write(IMAIN,*) 'There is 1 fault in file DATA/Par_file_faults'
+ else
+ if (myrank==0) write(IMAIN,*) 'There are ', nbfaults, ' faults in file DATA/Par_file_faults'
+ endif
filename = prname(1:len_trim(prname))//'fault_db.bin'
open(unit=IIN_BIN,file=trim(filename),status='old',action='read',form='unformatted',iostat=ier)
- if( ier /= 0 ) stop 'Have not found proc*_fault_db.bin'
+ if( ier /= 0 ) then
+ write(IMAIN,*) 'Fatal error: file ',trim(filename),' not found. Abort'
+ stop
+ endif
! WARNING TO DO: should be an MPI abort
read(IIN_PAR,*) ! eta
@@ -108,7 +117,9 @@
close(IIN_PAR)
return
-100 stop 'Did not find BEGIN_FAULT block #'
+
+100 if (myrank==0) write(IMAIN,*) 'Fatal error: did not find BEGIN_FAULT input block in file DATA/Par_file_faults. Abort.'
+ stop
! WARNING TO DO: should be an MPI abort
end subroutine BC_KINFLT_init
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/prepare_timerun.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/prepare_timerun.f90 2012-11-26 14:18:14 UTC (rev 21071)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/prepare_timerun.f90 2012-11-26 23:55:49 UTC (rev 21072)
@@ -116,9 +116,9 @@
veloc(:,:) = 0._CUSTOM_REAL
! Loading kinematic and dynamic fault solvers.
- call BC_DYNFLT_init(prname,rmass,DT,NSTEP,veloc)
+ call BC_DYNFLT_init(prname,rmass,DT,NSTEP,veloc,myrank)
- call BC_KINFLT_init(prname,rmass,DT,NSTEP)
+ call BC_KINFLT_init(prname,rmass,DT,NSTEP,myrank)
! initialize acoustic arrays to zero
if( ACOUSTIC_SIMULATION ) then
More information about the CIG-COMMITS
mailing list