[cig-commits] r21263 - in seismo/3D/SPECFEM3D/trunk: . src/shared src/specfem3D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Wed Jan 16 19:36:22 PST 2013
Author: dkomati1
Date: 2013-01-16 19:36:21 -0800 (Wed, 16 Jan 2013)
New Revision: 21263
Modified:
seismo/3D/SPECFEM3D/trunk/Makefile.in
seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/create_color_image.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_common.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
Log:
replaced the "class()" keyword used by Surendra with "type()".
suppressed GIF creation based on a non-portable system call (not compatible with the Fortran2003 standard), kept the PNM files only;
one day we should switch to calling the JPEG library directly anyway, as in the 2D code.
added "make realclean" for SCOTCH.
Modified: seismo/3D/SPECFEM3D/trunk/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/Makefile.in 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/Makefile.in 2013-01-17 03:36:21 UTC (rev 21263)
@@ -166,7 +166,7 @@
clean: required
- (rm -rf bin lib obj src/meshfem3D/*.mod src/decompose_mesh/*.mod src/generate_databases/*.mod src/specfem3D/*.mod)
+ (rm -rf bin lib obj src/meshfem3D/*.mod src/decompose_mesh/*.mod src/generate_databases/*.mod src/specfem3D/*.mod ; cd src/decompose_mesh/scotch/src ; make realclean)
help:
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/constants.h.in 2013-01-17 03:36:21 UTC (rev 21263)
@@ -227,10 +227,12 @@
real(kind=CUSTOM_REAL),parameter :: CROSS_SECTION_Y = 65500.0
real(kind=CUSTOM_REAL),parameter :: CROSS_SECTION_Z = -30000.0
-! plots GIF cross-section image
+! plots PNM cross-section image
! (EXPERIMENTAL feature)
! (cross-section plane parameters can be specified in create_color_image.f90)
- logical, parameter :: PNM_GIF_IMAGE = .false.
+!! DK DK Jan 2013: here for performance and to reduce the size of the files, one day
+!! DK DK Jan 2013: we should switch to using the JPEG library directly, as already implemented in SPECFEM2D
+ logical, parameter :: PNM_IMAGE = .false.
! geometry tolerance parameter to calculate number of independent grid points
! sensitive to actual size of model, assumes reference sphere of radius 1
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/detect_surface.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -654,7 +654,7 @@
!-------------------------------------------------------------------------------------------------
!
- subroutine detect_surface_PNM_GIF_image(NPROC,nglob,nspec,ibool,&
+ subroutine detect_surface_PNM_image(NPROC,nglob,nspec,ibool,&
ispec_is_image_surface, &
iglob_is_image_surface, &
num_iglob_image_surface, &
@@ -765,5 +765,5 @@
enddo ! nspec
num_iglob_image_surface = count
- end subroutine detect_surface_PNM_GIF_image
+ end subroutine detect_surface_PNM_image
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/create_color_image.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/create_color_image.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/create_color_image.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -24,7 +24,7 @@
!
!=====================================================================
- module image_PNM_GIF_par
+ module image_PNM_par
use constants,only: CUSTOM_REAL,IMAIN
use specfem_par,only: myrank,NPROC,it
@@ -73,8 +73,6 @@
! or ASCII PNM P3 format (easier to edit)
logical, parameter :: BINARY_FILE = .true.
- ! only keeps GIF file
- logical, parameter :: REMOVE_PNM_FILE = .false.
! ----------------------------------------------
! image data
@@ -93,13 +91,13 @@
integer :: NX_IMAGE_color,NZ_IMAGE_color
integer :: nb_pixel_loc
- end module image_PNM_GIF_par
+ end module image_PNM_par
!=============================================================
- subroutine write_PNM_GIF_initialize()
+ subroutine write_PNM_initialize()
- use image_PNM_GIF_par
+ use image_PNM_par
use specfem_par,only: NGLOB_AB,NSPEC_AB,ibool,xstore,ystore,zstore,&
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,my_neighbours_ext_mesh, &
@@ -135,7 +133,7 @@
! checks image type
if(IMAGE_TYPE > 4 .or. IMAGE_TYPE < 1) then
- call exit_mpi(myrank,'That type is not implemented for GIF images yet')
+ call exit_mpi(myrank,'That type is not implemented for PNM images yet')
endif
! user output
@@ -143,20 +141,20 @@
write(IMAIN,*)
write(IMAIN,*) '********'
! type = 1 : velocity V_x component
- if( IMAGE_TYPE == 1 ) write(IMAIN,*) 'GIF image: velocity V_x component'
+ if( IMAGE_TYPE == 1 ) write(IMAIN,*) 'PNM image: velocity V_x component'
! type = 2 : velocity V_y component
- if( IMAGE_TYPE == 2 ) write(IMAIN,*) 'GIF image: velocity V_y component'
+ if( IMAGE_TYPE == 2 ) write(IMAIN,*) 'PNM image: velocity V_y component'
! type = 3 : velocity V_z component
- if( IMAGE_TYPE == 3 ) write(IMAIN,*) 'GIF image: velocity V_z component'
+ if( IMAGE_TYPE == 3 ) write(IMAIN,*) 'PNM image: velocity V_z component'
! type = 4 : velocity V norm
- if( IMAGE_TYPE == 4 ) write(IMAIN,*) 'GIF image: velocity norm'
+ if( IMAGE_TYPE == 4 ) write(IMAIN,*) 'PNM image: velocity norm'
endif
! finds global points on image surface
allocate(ispec_is_image_surface(NSPEC_AB),iglob_is_image_surface(NGLOB_AB),stat=ier)
if( ier /= 0 ) call exit_mpi(myrank,'error allocating image ispec and iglob')
- call detect_surface_PNM_GIF_image(NPROC,NGLOB_AB,NSPEC_AB,ibool,&
+ call detect_surface_PNM_image(NPROC,NGLOB_AB,NSPEC_AB,ibool,&
ispec_is_image_surface, &
iglob_is_image_surface, &
num_iglob_image_surface, &
@@ -204,11 +202,6 @@
if( count /= num_iglob_image_surface) call exit_mpi(myrank,'error image point number')
- !daniel: outputs global points into vtk file
- !vtkfilename = prname(1:len_trim(prname))//'GIF_image_points'
- !call write_VTK_data_points(NGLOB_AB,xstore,ystore,zstore, &
- ! iglob_coord,count,vtkfilename)
-
! horizontal size of the image
xmin_color_image_loc = minval( xcoord(:) )
xmax_color_image_loc = maxval( xcoord(:) )
@@ -451,7 +444,7 @@
endif
! handles vp background data
- call write_PNM_GIF_vp_background()
+ call write_PNM_vp_background()
! user output
if( myrank == 0 ) then
@@ -460,15 +453,15 @@
endif
- end subroutine write_PNM_GIF_initialize
+ end subroutine write_PNM_initialize
!=============================================================
- subroutine write_PNM_GIF_vp_background
+ subroutine write_PNM_vp_background
- use image_PNM_GIF_par
+ use image_PNM_par
use specfem_par,only:myrank
implicit none
! local parameters
@@ -513,16 +506,19 @@
endif
endif
- end subroutine write_PNM_GIF_vp_background
+ end subroutine write_PNM_vp_background
!================================================================
- subroutine write_PNM_GIF_create_image
+ subroutine write_PNM_create_image
-! creates color PNM/GIF image
+! creates color PNM image
- use image_PNM_GIF_par
+!! DK DK Jan 2013: here for performance and to reduce the size of the files, one day
+!! DK DK Jan 2013: we should switch to using the JPEG library directly, as already implemented in SPECFEM2D
+
+ use image_PNM_par
use constants,only: NDIM
implicit none
@@ -585,26 +581,26 @@
! master process writes out file
if (myrank == 0) then
! writes output file
- call write_PNM_GIF_data(image_color_data,iglob_image_color,&
+ call write_PNM_data(image_color_data,iglob_image_color,&
NX_IMAGE_color,NZ_IMAGE_color,it,image_cutsnaps,image_color_vp_display)
endif
- end subroutine write_PNM_GIF_create_image
+ end subroutine write_PNM_create_image
!================================================================
- subroutine write_PNM_GIF_data(color_image_2D_data,iglob_image_color_2D,&
+ subroutine write_PNM_data(color_image_2D_data,iglob_image_color_2D,&
NX,NY,it,cutsnaps,image_color_vp_display)
! display a given field as a red and blue color image
! to display the snapshots : display image*.gif
! when compiling with Intel ifort, use " -assume byterecl " option to create binary PNM images
use constants,only: HUGEVAL,TINYVAL,CUSTOM_REAL,OUTPUT_FILES_PATH
- use image_PNM_GIF_par,only: BINARY_FILE,VP_BACKGROUND,&
- POWER_DISPLAY_COLOR,REMOVE_PNM_FILE
+ use image_PNM_par,only: BINARY_FILE,VP_BACKGROUND,&
+ POWER_DISPLAY_COLOR
implicit none
integer :: NX,NY,it
@@ -792,25 +788,8 @@
! close the file
close(27)
- ! open image file and create system command to convert image to more convenient format
- ! use the "convert" command from ImageMagick http://www.imagemagick.org
- write(system_command,"('cd ',a,' ; convert image',i7.7,'.pnm image',i7.7,'.gif')") &
- OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)),it,it
+ end subroutine write_PNM_data
- ! call the system to convert image to GIF
- ! this line can be safely commented out if your compiler does not implement "system()" for system calls;
- ! in such a case you will simply get images in PNM format in directory OUTPUT_FILES instead of GIF format
- call system(system_command)
-
- ! removes PNM file
- if( REMOVE_PNM_FILE ) then
- write(system_command,"('cd ',a,' ; rm -f image',i7.7,'.pnm')") &
- OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)), it
- call system(system_command)
- endif
-
- end subroutine write_PNM_GIF_data
-
!=============================================================
subroutine get_iglob_vp(iglob,ispec,vp)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/detect_mesh_surfaces.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -115,8 +115,8 @@
endif
! initializes cross-section gif image
- if( PNM_GIF_IMAGE ) then
- call write_PNM_GIF_initialize()
+ if( PNM_IMAGE ) then
+ call write_PNM_initialize()
endif
end subroutine detect_mesh_surfaces
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_common.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_common.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_common.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -9,7 +9,7 @@
implicit none
- private
+!!!!! DK DK private
type fault_type
integer :: nspec=0, nglob=0
@@ -20,6 +20,35 @@
integer, dimension(:), pointer :: ibulk1=>null(), ibulk2=>null()
end type fault_type
+ ! outputs(dyn) /inputs (kind) at selected times for all fault nodes:
+ ! strength, state, slip, slip velocity, fault stresses, rupture time, process zone time
+ ! rupture time = first time when slip velocity = threshold V_RUPT (defined below)
+ ! process zone time = first time when slip = Dc
+ type dataXZ_type
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: stg=>null(), sta=>null(), d1=>null(), d2=>null(), v1=>null(), v2=>null(), &
+ t1=>null(), t2=>null(), t3=>null(), tRUP=>null(), tPZ=>null()
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: xcoord=>null(), ycoord=>null(), zcoord=>null()
+ integer :: npoin=0
+ end type dataXZ_type
+
+ type swf_type
+!! DK DK private
+ integer :: kind
+ logical :: healing = .false.
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: Dc=>null(), mus=>null(), mud=>null(), &
+ theta=>null(), T=>null(), C=>null()
+ end type swf_type
+
+ type rsf_type
+!! DK DK private
+ integer :: StateLaw = 1 ! 1=ageing law, 2=slip law
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: V0=>null(), f0=>null(), L=>null(), &
+ V_init=>null(), &
+ a=>null(), b=>null(), theta=>null(), &
+ T=>null(), C=>null(), &
+ fw=>null(), Vw=>null()
+ end type rsf_type
+
! outputs on selected fault nodes at every time step:
type dataT_type
integer :: npoin=0, ndat=0, nt=0
@@ -30,6 +59,24 @@
character(len=100) :: shortFieldNames
end type dataT_type
+ type, extends (fault_type) :: bc_dynandkinflt_type
+!!!!!!!! DK DK private
+ real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null()
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(), Fload=>null()
+ integer, dimension(:), pointer :: npoin_perproc=>null(), poin_offset=>null()
+ type(dataT_type) :: dataT
+ type(dataXZ_type) :: dataXZ,dataXZ_all
+ type(swf_type), pointer :: swf => null()
+ type(rsf_type), pointer :: rsf => null()
+ logical :: allow_opening = .false. ! default : do not allow opening
+
+!! DK DK added this in order to be able to use the type for both dynamic and kinematic faults
+ real(kind=CUSTOM_REAL) :: kin_dt
+ integer :: kin_it
+ real(kind=CUSTOM_REAL), dimension(:,:), pointer :: v_kin_t1,v_kin_t2
+
+ end type bc_dynandkinflt_type
+
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
@@ -47,7 +94,8 @@
use specfem_par
use specfem_par_elastic, only : rmassx,rmassy,rmassz
- class(fault_type), intent(inout) :: bc
+!! DK DK use type(bc_dynandkinflt_type) instead of class(fault_type) for compatibility with some current compilers
+ type(bc_dynandkinflt_type), intent(inout) :: bc
integer, intent(in) :: IIN_BIN
real(kind=CUSTOM_REAL) :: tmp_vec(3,NGLOB_AB)
@@ -195,7 +243,8 @@
!===============================================================
function get_jump (bc,v) result(dv)
- class(fault_type), intent(in) :: bc
+!! DK DK use type(bc_dynandkinflt_type) instead of class(fault_type) for compatibility with some current compilers
+ type(bc_dynandkinflt_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(in) :: v(:,:)
real(kind=CUSTOM_REAL) :: dv(3,bc%nglob)
@@ -209,7 +258,8 @@
!---------------------------------------------------------------------
function get_weighted_jump (bc,f) result(da)
- class(fault_type), intent(in) :: bc
+!! DK DK use type(bc_dynandkinflt_type) instead of class(fault_type) for compatibility with some current compilers
+ type(bc_dynandkinflt_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(in) :: f(:,:)
real(kind=CUSTOM_REAL) :: da(3,bc%nglob)
@@ -227,7 +277,8 @@
!----------------------------------------------------------------------
function rotate(bc,v,fb) result(vr)
- class(fault_type), intent(in) :: bc
+!! DK DK use type(bc_dynandkinflt_type) instead of class(fault_type) for compatibility with some current compilers
+ type(bc_dynandkinflt_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(in) :: v(3,bc%nglob)
integer, intent(in) :: fb
real(kind=CUSTOM_REAL) :: vr(3,bc%nglob)
@@ -254,7 +305,8 @@
subroutine add_BT(bc,MxA,T)
- class(fault_type), intent(in) :: bc
+!! DK DK use type(bc_dynandkinflt_type) instead of class(fault_type) for compatibility with some current compilers
+ type(bc_dynandkinflt_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(inout) :: MxA(:,:)
real(kind=CUSTOM_REAL), dimension(3,bc%nglob), intent(in) :: T
@@ -419,7 +471,8 @@
subroutine store_dataT(dataT,d,v,t,itime)
use specfem_par, only : myrank
- class(dataT_type), intent(inout) :: dataT
+!! DK DK use type() instead of class() for compatibility with some current compilers
+ type(dataT_type), intent(inout) :: dataT
real(kind=CUSTOM_REAL), dimension(:,:), intent(in) :: d,v,t
integer, intent(in) :: itime
@@ -441,7 +494,8 @@
!------------------------------------------------------------------------
subroutine SCEC_write_dataT(dataT)
- class(dataT_type), intent(in) :: dataT
+!! DK DK use type() instead of class() for compatibility with some current compilers
+ type(dataT_type), intent(in) :: dataT
integer :: i,k,IOUT
character(len=10) :: my_fmt
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_dynamic.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -17,49 +17,51 @@
private
- ! outputs(dyn) /inputs (kind) at selected times for all fault nodes:
- ! strength, state, slip, slip velocity, fault stresses, rupture time, process zone time
- ! rupture time = first time when slip velocity = threshold V_RUPT (defined below)
- ! process zone time = first time when slip = Dc
- type dataXZ_type
- real(kind=CUSTOM_REAL), dimension(:), pointer :: stg=>null(), sta=>null(), d1=>null(), d2=>null(), v1=>null(), v2=>null(), &
- t1=>null(), t2=>null(), t3=>null(), tRUP=>null(), tPZ=>null()
- real(kind=CUSTOM_REAL), dimension(:), pointer :: xcoord=>null(), ycoord=>null(), zcoord=>null()
- integer :: npoin=0
- end type dataXZ_type
+!! DK DK moved this to fault_common in order to use it there
- type swf_type
- private
- integer :: kind
- logical :: healing = .false.
- real(kind=CUSTOM_REAL), dimension(:), pointer :: Dc=>null(), mus=>null(), mud=>null(), &
- theta=>null(), T=>null(), C=>null()
- end type swf_type
+! ! outputs(dyn) /inputs (kind) at selected times for all fault nodes:
+! ! strength, state, slip, slip velocity, fault stresses, rupture time, process zone time
+! ! rupture time = first time when slip velocity = threshold V_RUPT (defined below)
+! ! process zone time = first time when slip = Dc
+! type dataXZ_type
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: stg=>null(), sta=>null(), d1=>null(), d2=>null(), v1=>null(), v2=>null(), &
+! t1=>null(), t2=>null(), t3=>null(), tRUP=>null(), tPZ=>null()
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: xcoord=>null(), ycoord=>null(), zcoord=>null()
+! integer :: npoin=0
+! end type dataXZ_type
- type rsf_type
- private
- integer :: StateLaw = 1 ! 1=ageing law, 2=slip law
- real(kind=CUSTOM_REAL), dimension(:), pointer :: V0=>null(), f0=>null(), L=>null(), &
- V_init=>null(), &
- a=>null(), b=>null(), theta=>null(), &
- T=>null(), C=>null(), &
- fw=>null(), Vw=>null()
- end type rsf_type
+! type swf_type
+! private
+! integer :: kind
+! logical :: healing = .false.
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: Dc=>null(), mus=>null(), mud=>null(), &
+! theta=>null(), T=>null(), C=>null()
+! end type swf_type
- type, extends (fault_type) :: bc_dynflt_type
- private
- real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null()
- real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(), Fload=>null()
- integer, dimension(:), pointer :: npoin_perproc=>null(), poin_offset=>null()
- type(dataT_type) :: dataT
- type(dataXZ_type) :: dataXZ,dataXZ_all
- type(swf_type), pointer :: swf => null()
- type(rsf_type), pointer :: rsf => null()
- logical :: allow_opening = .false. ! default : do not allow opening
- end type bc_dynflt_type
+! type rsf_type
+! private
+! integer :: StateLaw = 1 ! 1=ageing law, 2=slip law
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: V0=>null(), f0=>null(), L=>null(), &
+! V_init=>null(), &
+! a=>null(), b=>null(), theta=>null(), &
+! T=>null(), C=>null(), &
+! fw=>null(), Vw=>null()
+! end type rsf_type
- type(bc_dynflt_type), allocatable, save :: faults(:)
+! type, extends (fault_type) :: bc_dynandkinflt_type
+! private
+! real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null()
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(), Fload=>null()
+! integer, dimension(:), pointer :: npoin_perproc=>null(), poin_offset=>null()
+! type(dataT_type) :: dataT
+! type(dataXZ_type) :: dataXZ,dataXZ_all
+! type(swf_type), pointer :: swf => null()
+! type(rsf_type), pointer :: rsf => null()
+! logical :: allow_opening = .false. ! default : do not allow opening
+! end type bc_dynandkinflt_type
+ type(bc_dynandkinflt_type), allocatable, save :: faults(:)
+
!slip velocity threshold for healing
!WARNING: not very robust
real(kind=CUSTOM_REAL), save :: V_HEALING
@@ -187,7 +189,7 @@
subroutine init_one_fault(bc,IIN_BIN,IIN_PAR,dt,NT,iflt)
- type(bc_dynflt_type), intent(inout) :: bc
+ type(bc_dynandkinflt_type), intent(inout) :: bc
integer, intent(in) :: IIN_BIN,IIN_PAR,NT,iflt
real(kind=CUSTOM_REAL), intent(in) :: dt
@@ -418,7 +420,7 @@
use specfem_par, only: it,NSTEP,myrank
real(kind=CUSTOM_REAL), intent(inout) :: MxA(:,:)
- type(bc_dynflt_type), intent(inout) :: bc
+ type(bc_dynandkinflt_type), intent(inout) :: bc
real(kind=CUSTOM_REAL), intent(in) :: V(:,:),D(:,:)
integer, intent(in) :: iflt
@@ -960,7 +962,7 @@
use specfem_par, only : NPROC,myrank
type(dataXZ_type), intent(inout) :: dataXZ
- type(bc_dynflt_type) :: bc
+ type(bc_dynandkinflt_type) :: bc
integer :: npoin_all,iproc
@@ -1037,7 +1039,7 @@
use specfem_par, only : NPROC
- type(bc_dynflt_type), intent(inout) :: bc
+ type(bc_dynandkinflt_type), intent(inout) :: bc
call gatherv_all_cr(bc%dataXZ%t1,bc%dataXZ%npoin,bc%dataXZ_all%t1,bc%npoin_perproc,bc%poin_offset,bc%dataXZ_all%npoin,NPROC)
call gatherv_all_cr(bc%dataXZ%t2,bc%dataXZ%npoin,bc%dataXZ_all%t2,bc%npoin_perproc,bc%poin_offset,bc%dataXZ_all%npoin,NPROC)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/fault_solver_kinematic.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -12,24 +12,29 @@
private
- type dataXZ_type
- integer :: npoin=0
- real(kind=CUSTOM_REAL), dimension(:), pointer :: d1=>null(), d2=>null(), &
- v1=>null(), v2=>null(), &
- t1=>null(), t2=>null(), t3=>null(), &
- xcoord=>null(), ycoord=>null(), zcoord=>null()
- end type dataXZ_type
+!! DK DK used the "dynamic" version that I moved to "fault_common" instead
+!! DK DK works fine because it has all the elements needed below, plus some others that are then simply unused
+! type dataXZ_type
+! integer :: npoin=0
+! real(kind=CUSTOM_REAL), dimension(:), pointer :: d1=>null(), d2=>null(), &
+! v1=>null(), v2=>null(), &
+! t1=>null(), t2=>null(), t3=>null(), &
+! xcoord=>null(), ycoord=>null(), zcoord=>null()
+! end type dataXZ_type
- type, extends (fault_type) :: bc_kinflt_type
- private
- type(dataT_type) :: dataT
- type(dataXZ_type) :: dataXZ
- real(kind=CUSTOM_REAL) :: kin_dt
- integer :: kin_it
- real(kind=CUSTOM_REAL), dimension(:,:), pointer :: v_kin_t1,v_kin_t2
- end type bc_kinflt_type
+!! DK DK not needed any more, merged into a new "bc_dynandkinflt_type" to avoid having to use the "class" keyword,
+!! DK DK which is currently not supported by many Fortran compilers (and it is crucial for us to keep full portability)
+! type, extends (fault_type) :: bc_kinflt_type
+! private
+! type(dataT_type) :: dataT
+! type(dataXZ_type) :: dataXZ
+! real(kind=CUSTOM_REAL) :: kin_dt
+! integer :: kin_it
+! real(kind=CUSTOM_REAL), dimension(:,:), pointer :: v_kin_t1,v_kin_t2
+! end type bc_kinflt_type
- type(bc_kinflt_type), allocatable, save :: faults(:)
+!! DK DK now use bc_dynandkinflt_type here instead
+ type(bc_dynandkinflt_type), allocatable, save :: faults(:)
!Number of time steps defined by the user : NTOUT
integer, save :: NTOUT,NSNAP
@@ -126,7 +131,8 @@
subroutine init_one_fault(bc,IIN_BIN,IIN_PAR,dt,NT,iflt)
- type(bc_kinflt_type), intent(inout) :: bc
+!! DK DK now use bc_dynandkinflt_type here instead
+ type(bc_dynandkinflt_type), intent(inout) :: bc
integer, intent(in) :: IIN_BIN,IIN_PAR,NT,iflt
real(kind=CUSTOM_REAL), intent(in) :: dt
@@ -194,7 +200,8 @@
use specfem_par, only:it,NSTEP
real(kind=CUSTOM_REAL), intent(inout) :: MxA(:,:)
- type(bc_kinflt_type), intent(inout) :: bc
+!! DK DK now use bc_dynandkinflt_type here instead
+ type(bc_dynandkinflt_type), intent(inout) :: bc
real(kind=CUSTOM_REAL), intent(in) :: V(:,:),D(:,:)
integer,intent(in) :: iflt
integer :: it_kin,itime
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -141,7 +141,7 @@
implicit none
! flag for any movie simulation
- if( MOVIE_SURFACE .or. CREATE_SHAKEMAP .or. MOVIE_VOLUME .or. PNM_GIF_IMAGE ) then
+ if( MOVIE_SURFACE .or. CREATE_SHAKEMAP .or. MOVIE_VOLUME .or. PNM_IMAGE ) then
MOVIE_SIMULATION = .true.
else
MOVIE_SIMULATION = .false.
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90 2013-01-17 03:31:03 UTC (rev 21262)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/write_movie_output.f90 2013-01-17 03:36:21 UTC (rev 21263)
@@ -40,7 +40,7 @@
CREATE_SHAKEMAP .or. &
( MOVIE_SURFACE .and. mod(it,NTSTEP_BETWEEN_FRAMES) == 0) .or. &
( MOVIE_VOLUME .and. mod(it,NTSTEP_BETWEEN_FRAMES) == 0) .or. &
- ( PNM_GIF_IMAGE .and. mod(it,NTSTEP_BETWEEN_FRAMES) == 0) &
+ ( PNM_IMAGE .and. mod(it,NTSTEP_BETWEEN_FRAMES) == 0) &
) ) then
! acoustic domains
if ( ACOUSTIC_SIMULATION ) then
@@ -78,9 +78,9 @@
call wmo_movie_volume_output()
endif
- ! creates cross-section GIF image
- if (PNM_GIF_IMAGE .and. mod(it,NTSTEP_BETWEEN_FRAMES) == 0 ) then
- call write_PNM_GIF_create_image()
+ ! creates cross-section PNM image
+ if (PNM_IMAGE .and. mod(it,NTSTEP_BETWEEN_FRAMES) == 0 ) then
+ call write_PNM_create_image()
endif
end subroutine write_movie_output
More information about the CIG-COMMITS
mailing list