[cig-commits] r22134 - in seismo/3D/SPECFEM3D/trunk/src: generate_databases shared specfem3D
danielpeter at geodynamics.org
danielpeter at geodynamics.org
Fri May 24 07:39:36 PDT 2013
Author: danielpeter
Date: 2013-05-24 07:39:36 -0700 (Fri, 24 May 2013)
New Revision: 22134
Modified:
seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90
seismo/3D/SPECFEM3D/trunk/src/shared/gll_library.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
Log:
bug fix for cray compilers in routine jacg() in gll_library.f90; adds flush_IMAIN() calls to update output files (useful for tracing crashed simulations)
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/create_regions_mesh.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -68,6 +68,7 @@
if( myrank == 0) then
write(IMAIN,*)
write(IMAIN,*) ' ...allocating arrays '
+ call flush_IMAIN()
endif
call crm_ext_allocate_arrays(nspec,LOCAL_PATH,myrank, &
nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
@@ -82,6 +83,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...setting up jacobian '
+ call flush_IMAIN()
endif
if (ANY_FAULT_IN_THIS_PROC) then
! compute jacobians with fault open and *store needed for ibool.
@@ -101,6 +103,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...indexing global points'
+ call flush_IMAIN()
endif
if (ANY_FAULT_IN_THIS_PROC) then
call crm_ext_setup_indexing(ibool, &
@@ -115,7 +118,10 @@
if (ANY_FAULT) then
! recalculate *store with faults closed
call sync_all()
- if (myrank == 0) write(IMAIN,*) ' ... resetting up jacobian in fault domains'
+ if (myrank == 0) then
+ write(IMAIN,*) ' ... resetting up jacobian in fault domains'
+ call flush_IMAIN()
+ endif
if (ANY_FAULT_IN_THIS_PROC) call crm_ext_setup_jacobian(myrank, &
xstore,ystore,zstore,nspec, &
nodes_coords_ext_mesh,nnodes_ext_mesh,&
@@ -131,6 +137,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...preparing MPI interfaces '
+ call flush_IMAIN()
endif
call get_MPI(myrank,nglob_dummy,nspec,ibool, &
nelmnts_ext_mesh,elmnts_ext_mesh, &
@@ -155,6 +162,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...setting up absorbing boundaries '
+ call flush_IMAIN()
endif
call get_absorbing_boundary(myrank,nspec,ibool, &
nodes_coords_ext_mesh,nnodes_ext_mesh, &
@@ -169,6 +177,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...setting up Moho surface'
+ call flush_IMAIN()
endif
call crm_setup_moho(myrank,nspec, &
nspec2D_moho_ext,ibelm_moho,nodes_ibelm_moho, &
@@ -179,6 +188,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...determining velocity model'
+ call flush_IMAIN()
endif
call get_model(myrank)
@@ -186,6 +196,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...detecting acoustic-elastic-poroelastic surfaces '
+ call flush_IMAIN()
endif
call get_coupling_surfaces(myrank, &
nspec,ibool,NPROC, &
@@ -197,6 +208,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...element inner/outer separation '
+ call flush_IMAIN()
endif
call crm_setup_inner_outer_elemnts(myrank,nspec, &
num_interfaces_ext_mesh,max_interface_size_ext_mesh, &
@@ -207,6 +219,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...element mesh coloring '
+ call flush_IMAIN()
endif
call setup_color_perm(myrank,nspec,nglob,ibool,ANISOTROPY,SAVE_MESH_FILES)
@@ -219,6 +232,7 @@
if( PML_CONDITIONS ) then
if( myrank == 0) then
write(IMAIN,*) ' ...creating C-PML damping profiles '
+ call flush_IMAIN()
endif
call pml_set_local_dampingcoeff(myrank,xstore_dummy,ystore_dummy,zstore_dummy)
endif
@@ -227,6 +241,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...creating mass matrix '
+ call flush_IMAIN()
endif
call create_mass_matrices(nglob_dummy,nspec,ibool,PML_CONDITIONS,STACEY_ABSORBING_CONDITIONS)
@@ -234,6 +249,7 @@
call sync_all()
if( myrank == 0) then
write(IMAIN,*) ' ...saving databases'
+ call flush_IMAIN()
endif
!call create_name_database(prname,myrank,LOCAL_PATH)
call save_arrays_solver_ext_mesh(nspec,nglob_dummy,APPROXIMATE_OCEAN_LOAD,ibool, &
@@ -968,6 +984,7 @@
write(IMAIN,*) ' top elements :',imoho_top_all
write(IMAIN,*) ' bottom elements:',imoho_bot_all
write(IMAIN,*) '********'
+ call flush_IMAIN()
endif
deallocate(iglob_is_surface)
@@ -1221,6 +1238,7 @@
write(IMAIN,*) ' for overlapping of communications with calculations:'
write(IMAIN,*) ' percentage of edge elements ',100. -percentage_edge,'%'
write(IMAIN,*) ' percentage of volume elements ',percentage_edge,'%'
+ call flush_IMAIN()
endif
end subroutine crm_setup_inner_outer_elemnts
Modified: seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/generate_databases/generate_databases.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -215,6 +215,7 @@
write(IMAIN,*) '*** Specfem3D MPI Mesher - f90 version ***'
write(IMAIN,*) '******************************************'
write(IMAIN,*)
+ call flush_IMAIN()
endif
! read the parameter file
@@ -229,6 +230,7 @@
write(IMAIN,*) 'creating mesh in the model'
write(IMAIN,*) '**************************'
write(IMAIN,*)
+ call flush_IMAIN()
endif
! reads Databases files
@@ -419,7 +421,7 @@
write(IMAIN,*)
endif
endif
-
+ call flush_IMAIN()
endif
! makes sure processes are synchronized
@@ -452,6 +454,7 @@
write(IMAIN,*)
write(IMAIN,*) 'regional topography file read ranges in m from ',minval(itopo_bathy),' to ',maxval(itopo_bathy)
write(IMAIN,*)
+ call flush_IMAIN()
endif
else
NX_TOPO = 1
Modified: seismo/3D/SPECFEM3D/trunk/src/shared/gll_library.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/shared/gll_library.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/shared/gll_library.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -184,6 +184,7 @@
double precision alpha,beta
double precision xjac(np)
+ ! local parameters
integer k,j,i,jmin,jm,n
double precision xlast,dth,x,x1,x2,recsum,delx,xmin,swap
double precision p,pd,pm1,pdm1,pm2,pdm2
@@ -201,7 +202,7 @@
dth = 4.d0*datan(1.d0)/(2.d0*dble(n)+2.d0)
p = 0.d0
pd = 0.d0
- jmin = 0
+
do j=1,np
if(j == 1) then
x = dcos((2.d0*(dble(j)-1.d0)+1.d0)*dth)
@@ -210,6 +211,7 @@
x2 = xlast
x = (x1+x2)/2.d0
endif
+
do k=1,K_MAX_ITER
call jacobf (p,pd,pm1,pdm1,pm2,pdm2,np,alpha,beta,x)
recsum = 0.d0
@@ -219,25 +221,47 @@
enddo
delx = -p/(pd-recsum*p)
x = x+delx
- if(abs(delx) < eps) goto 31
+
+ ! exits loop if increment too small
+ if(abs(delx) < eps) exit
+
enddo
- 31 continue
+
+ ! checks bounds
+ if( np-j+1 < 1 .or. np-j+1 > np ) stop 'error np-j+1-index in jacg'
+
xjac(np-j+1) = x
xlast = x
enddo
+
+ jmin = 0
+
+ ! orders xjac array in increasing values
do i=1,np
xmin = 2.d0
+ jmin = i
+
+ ! looks for index with minimum value
do j=i,np
- if(xjac(j) < xmin) then
- xmin = xjac(j)
+ ! note: some compilers (cray) might be too aggressive in optimizing this loop,
+ ! thus we need this temporary array value x to store and compare values
+ x = xjac(j)
+
+ if( x < xmin) then
+ xmin = x
jmin = j
endif
enddo
+
+ ! checks bounds
+ if(jmin < 1 .or. jmin > np ) stop 'error j-index in jacg'
+
if(jmin /= i) then
swap = xjac(i)
xjac(i) = xjac(jmin)
xjac(jmin) = swap
endif
+
enddo
end subroutine jacg
@@ -440,6 +464,7 @@
double precision z(np),w(np)
double precision alpha,beta
+ ! local paraeters
integer n,np1,np2,i
double precision p,pd,pm1,pdm1,pm2,pdm2
double precision apb,dnp1,dnp2,fac1,fac2,fac3,fnorm,rcoef
@@ -510,6 +535,7 @@
double precision alpha,beta
double precision z(np), w(np)
+ ! local parameters
integer n,nm1,i
double precision p,pd,pm1,pdm1,pm2,pdm2
double precision alpg,betg
@@ -535,7 +561,7 @@
if (nm1 > 0) then
alpg = alpha+one
betg = beta+one
- call zwgjd(z(2),w(2),nm1,alpg,betg)
+ call zwgjd(z(2:n),w(2:n),nm1,alpg,betg)
endif
z(1) = - one
@@ -547,6 +573,7 @@
call jacobf(p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(1))
w(1) = endw1(n,alpha,beta)/(two*pd)
+
call jacobf(p,pd,pm1,pdm1,pm2,pdm2,n,alpha,beta,z(np))
w(np) = endw2(n,alpha,beta)/(two*pd)
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/initialize_simulation.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -131,6 +131,7 @@
end select
write(IMAIN,*)
+ call flush_IMAIN()
endif
! reads in numbers of spectral elements and points for the part of the mesh handled by this process
@@ -426,6 +427,7 @@
if(myrank == 0 ) then
write(IMAIN,*)
write(IMAIN,*) "GPU_MODE Active."
+ call flush_IMAIN()
endif
! check for GPU runs
@@ -455,6 +457,7 @@
write(IMAIN,*) "GPU number of devices per node: min =",ncuda_devices_min
write(IMAIN,*) " max =",ncuda_devices_max
write(IMAIN,*)
+ call flush_IMAIN()
endif
end subroutine initialize_GPU
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.F90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/iterate_time.F90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -72,6 +72,7 @@
write(IMAIN,*)
write(IMAIN,*) 'Starting time iteration loop...'
write(IMAIN,*)
+ call flush_IMAIN()
endif
! create an empty file to monitor the start of the simulation
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_receivers.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -163,6 +163,7 @@
write(IMAIN,*)
write(IMAIN,'(1x,a,a,a)') 'reading receiver information from ', trim(rec_filename), ' file'
write(IMAIN,*)
+ call flush_IMAIN()
endif
! dimension of model in current proc
@@ -207,7 +208,10 @@
open(unit=IOUT_SU,file=trim(OUTPUT_FILES)//'/SU_stations_info.bin', &
status='old',action='read',form='unformatted',iostat=ios)
if (ios /= 0) call exit_mpi(myrank,'error opening file '//trim(rec_filename))
+
write(IMAIN,*) 'station details from SU_stations_info.bin'
+ call flush_IMAIN()
+
allocate(x_found(nrec),y_found(nrec),z_found(nrec))
! reads in station infos
read(IOUT_SU) islice_selected_rec,ispec_selected_rec
@@ -245,6 +249,7 @@
write(IMAIN,*)
write(IMAIN,*) 'End of receiver detection - done'
write(IMAIN,*)
+ call flush_IMAIN()
endif
! everything done
return
@@ -889,7 +894,6 @@
endif
write(IMAIN,*)
-
endif
enddo
@@ -943,7 +947,7 @@
write(IMAIN,*)
write(IMAIN,*) 'End of receiver detection - done'
write(IMAIN,*)
-
+ call flush_IMAIN()
endif ! end of section executed by main process only
! main process broadcasts the results to all the slices
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/locate_source.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -857,6 +857,7 @@
write(IMAIN,*) ' using sources ',NSOURCES
write(IMAIN,*) '*************************************'
write(IMAIN,*)
+ call flush_IMAIN()
endif
if(PRINT_SOURCE_TIME_FUNCTION) then
@@ -868,6 +869,7 @@
write(IMAIN,*)
write(IMAIN,*) 'maximum error in location of the sources: ',sngl(maxval(final_distance_source)),' m'
write(IMAIN,*)
+ call flush_IMAIN()
! sets new utm coordinates for best locations
utm_x_source(:) = x_found_source(:)
@@ -892,6 +894,8 @@
write(IMAIN,*)
write(IMAIN,*) 'End of source detection - done'
write(IMAIN,*)
+ call flush_IMAIN()
+
! output source information to a file so that we can load it and write to SU headers later
open(unit=IOUT_SU,file=trim(OUTPUT_FILES)//'/output_list_sources.txt',status='unknown')
do isource=1,NSOURCES
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/prepare_timerun.F90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -213,7 +213,7 @@
write(IMAIN,*)
write(IMAIN,*)
-
+ call flush_IMAIN()
endif
end subroutine prepare_timerun_user_output
@@ -570,6 +570,7 @@
write(IMAIN,*) " central period (s) : ",sngl(1.0/f_c_source), &
" frequency: ",sngl(f_c_source)
write(IMAIN,*)
+ call flush_IMAIN()
endif
! clear memory variables if attenuation
@@ -714,15 +715,16 @@
! user output
if( myrank == 0 ) then
- write(IMAIN,*)
- write(IMAIN,*) 'incorporating C-PML '
- write(IMAIN,*)
- write(IMAIN,*) 'number of C-PML spectral elements in the global mesh: ', NSPEC_CPML_GLOBAL
- write(IMAIN,*)
- write(IMAIN,*) 'thickness of C-PML layer in X direction: ', CPML_width_x
- write(IMAIN,*) 'thickness of C-PML layer in Y direction: ', CPML_width_y
- write(IMAIN,*) 'thickness of C-PML layer in Z direction: ', CPML_width_z
- write(IMAIN,*)
+ write(IMAIN,*)
+ write(IMAIN,*) 'incorporating C-PML '
+ write(IMAIN,*)
+ write(IMAIN,*) 'number of C-PML spectral elements in the global mesh: ', NSPEC_CPML_GLOBAL
+ write(IMAIN,*)
+ write(IMAIN,*) 'thickness of C-PML layer in X direction: ', CPML_width_x
+ write(IMAIN,*) 'thickness of C-PML layer in Y direction: ', CPML_width_y
+ write(IMAIN,*) 'thickness of C-PML layer in Z direction: ', CPML_width_z
+ write(IMAIN,*)
+ call flush_IMAIN()
endif
call sync_all()
@@ -1221,6 +1223,7 @@
if(myrank == 0 ) then
write(IMAIN,*)
write(IMAIN,*) "GPU Preparing Fields and Constants on Device."
+ call flush_IMAIN()
endif
! prepares general fields on GPU
@@ -1386,6 +1389,7 @@
write(IMAIN,*) " used =",used_mb," MB",nint(used_mb/total_mb*100.0),"%"
write(IMAIN,*) " total =",total_mb," MB",nint(total_mb/total_mb*100.0),"%"
write(IMAIN,*)
+ call flush_IMAIN()
endif
end subroutine prepare_timerun_GPU
@@ -1418,6 +1422,7 @@
write(IMAIN,*)
write(IMAIN,*) 'Using:',NUM_THREADS, ' OpenMP threads'
write(IMAIN,*)
+ call flush_IMAIN()
endif
! allocate cfe_Dev_openmp local arrays for OpenMP version
Modified: seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2013-05-24 13:51:55 UTC (rev 22133)
+++ seismo/3D/SPECFEM3D/trunk/src/specfem3D/read_mesh_databases.f90 2013-05-24 14:39:36 UTC (rev 22134)
@@ -640,6 +640,7 @@
call sum_all_i(count(ispec_is_poroelastic(:)),inum)
if( myrank == 0 ) then
write(IMAIN,*) 'total poroelastic elements :',inum
+ call flush_IMAIN()
endif
! debug
More information about the CIG-COMMITS
mailing list