[cig-commits] r17026 - seismo/3D/SPECFEM3D_GLOBE/trunk
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Tue Jun 29 11:34:25 PDT 2010
Author: danielpeter
Date: 2010-06-29 11:34:24 -0700 (Tue, 29 Jun 2010)
New Revision: 17026
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/model_gll.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/specfem3D.f90
Log:
fixes a mesher problem with IBM compilers found by Rosa Martin in create_regions_mesh.f90; bug fix for GLL models in model_gll.f90
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90 2010-06-28 17:49:54 UTC (rev 17025)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/create_regions_mesh.f90 2010-06-29 18:34:24 UTC (rev 17026)
@@ -776,12 +776,6 @@
write(27) normal_400
write(27) normal_670
close(27)
-
- deallocate(ibelm_moho_top,ibelm_moho_bot)
- deallocate(ibelm_400_top,ibelm_400_bot)
- deallocate(ibelm_670_top,ibelm_670_bot)
- deallocate(normal_moho,normal_400,normal_670)
- deallocate(jacobian2D_moho,jacobian2D_400,jacobian2D_670)
endif
! compute volume, bottom and top area of that part of the slice
@@ -846,6 +840,11 @@
deallocate(rho_vp,rho_vs)
deallocate(Qmu_store)
deallocate(tau_e_store)
+ deallocate(ibelm_moho_top,ibelm_moho_bot)
+ deallocate(ibelm_400_top,ibelm_400_bot)
+ deallocate(ibelm_670_top,ibelm_670_bot)
+ deallocate(normal_moho,normal_400,normal_670)
+ deallocate(jacobian2D_moho,jacobian2D_400,jacobian2D_670)
end subroutine create_regions_mesh
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/model_gll.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/model_gll.f90 2010-06-28 17:49:54 UTC (rev 17025)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/model_gll.f90 2010-06-29 18:34:24 UTC (rev 17026)
@@ -59,14 +59,17 @@
integer :: myrank
! local parameters
- double precision :: min_dvs,max_dvs
+ double precision :: min_dvs,max_dvs,min_dvs_all,max_dvs_all,scaleval
integer :: ier
allocate( MGLL_V%vp_new(NGLLX,NGLLY,NGLLZ,NSPEC(IREGION_CRUST_MANTLE)) )
allocate( MGLL_V%vs_new(NGLLX,NGLLY,NGLLZ,NSPEC(IREGION_CRUST_MANTLE)) )
allocate( MGLL_V%rho_new(NGLLX,NGLLY,NGLLZ,NSPEC(IREGION_CRUST_MANTLE)) )
+
! non-dimensionalize scaling values
- MGLL_V%scale_velocity = 1000.0d0/(PI*GRAV*RHOAV*R_EARTH)
+ ! (model velocities must be given as km/s)
+ scaleval = dsqrt(PI*GRAV*RHOAV)
+ MGLL_V%scale_velocity = 1000.0d0/(R_EARTH*scaleval)
MGLL_V%scale_density = 1000.0d0/RHOAV
call read_gll_model(myrank,MGLL_V,NSPEC)
@@ -74,11 +77,11 @@
! checks velocity range
max_dvs = maxval( MGLL_V%vs_new )
min_dvs = minval( MGLL_V%vs_new )
- call mpi_reduce(max_dvs, max_dvs, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, MPI_COMM_WORLD,ier)
- call mpi_reduce(min_dvs, min_dvs, 1, MPI_DOUBLE_PRECISION, MPI_MIN, 0, MPI_COMM_WORLD,ier)
+ call mpi_reduce(max_dvs, max_dvs_all, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, MPI_COMM_WORLD,ier)
+ call mpi_reduce(min_dvs, min_dvs_all, 1, MPI_DOUBLE_PRECISION, MPI_MIN, 0, MPI_COMM_WORLD,ier)
if( myrank == 0 ) then
write(IMAIN,*)'model GLL:'
- write(IMAIN,*) ' vs new min/max: ',min_dvs,max_dvs
+ write(IMAIN,*) ' vs new min/max: ',min_dvs_all,max_dvs_all
write(IMAIN,*)
endif
@@ -112,13 +115,18 @@
!--------------------------------------------------------------------
! USER PARAMETER
- character(len=150),parameter:: MGLL_path = 'KERNELS/model_m1/'
+ character(len=150),parameter:: MGLL_path = 'DATA/GLL/'
!--------------------------------------------------------------------
! local parameters
integer :: ier
character(len=150) :: prname
+ if( myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*)'reading in model from ',trim(MGLL_path)
+ endif
+
! only crust and mantle
write(prname,'(a,i6.6,a)') MGLL_path(1:len_trim(MGLL_path))//'proc',myrank,'_reg1_'
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/specfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/specfem3D.f90 2010-06-28 17:49:54 UTC (rev 17025)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/specfem3D.f90 2010-06-29 18:34:24 UTC (rev 17026)
@@ -1251,9 +1251,9 @@
write(IMAIN,*)
if(ATTENUATION_VAL) then
write(IMAIN,*) 'incorporating attenuation using ',N_SLS,' standard linear solids'
-
+
if(ATTENUATION_3D_VAL) write(IMAIN,*) 'using 3D attenuation'
-
+
if(USE_ATTENUATION_MIMIC ) write(IMAIN,*) 'mimicking effects on velocity only'
else
write(IMAIN,*) 'no attenuation'
@@ -1892,7 +1892,7 @@
! call rthetaphi_2_xyz(rval,thetaval,phival,xstore_crust_mantle(indx(1)),&
! ystore_crust_mantle(indx(1)),zstore_crust_mantle(indx(1)))
! print*,'x/y/z:',rval,thetaval,phival
- ! call exit_MPI(myrank,'error stability')
+ ! call exit_MPI(myrank,'error stability')
!endif
@@ -2746,7 +2746,7 @@
b_displ_outer_core,b_veloc_outer_core,b_accel_outer_core, &
b_R_memory_crust_mantle,b_R_memory_inner_core, &
b_epsilondev_crust_mantle,b_epsilondev_inner_core, &
- b_A_array_rotation,b_B_array_rotation,LOCAL_PATH)
+ b_A_array_rotation,b_B_array_rotation,LOCAL_PATH)
endif
! write the seismograms with time shift
@@ -3145,7 +3145,7 @@
! synchronize all processes, waits until all processes have written their seismograms
call MPI_BARRIER(MPI_COMM_WORLD,ier)
if( ier /= 0 ) call exit_mpi(myrank,'error synchronize after time loop')
-
+
! closes Stacey absorbing boundary snapshots
if( ABSORBING_CONDITIONS ) then
! crust mantle
@@ -3168,7 +3168,7 @@
.or. (SIMULATION_TYPE == 1 .and. SAVE_FORWARD))) then
call close_file_abs(3)
endif
-
+
! outer core
if (nspec2D_xmin_outer_core > 0 .and. (SIMULATION_TYPE == 3 &
.or. (SIMULATION_TYPE == 1 .and. SAVE_FORWARD))) then
@@ -3194,7 +3194,7 @@
.or. (SIMULATION_TYPE == 1 .and. SAVE_FORWARD))) then
call close_file_abs(8)
endif
-
+
endif
! synchronize all processes
More information about the CIG-COMMITS
mailing list