From e874751b009d142822562b354b42a72d3d321584 Mon Sep 17 00:00:00 2001 From: Dimitri Komatitsch Date: Mon, 7 Apr 2014 19:38:28 +0200 Subject: [PATCH] fixed all the warnings given by the Portland and Cray compilers on a Cray at ORNL. In particular, renamed all the variables or functions that had the same name as Fortran intrinsics (although that is correct in Fortran, it can be confusing and it also confuses syntax highlighting, and the Portland compiler prints a warning for each of them) --- flags.guess | 4 +- src/auxiliaries/combine_surf_data.f90 | 6 +- src/auxiliaries/combine_vol_data.F90 | 2 +- .../combine_vol_data_adios_impl.f90 | 4 +- src/auxiliaries/combine_vol_data_shared.f90 | 8 +- .../convolve_source_timefunction.f90 | 18 +- src/auxiliaries/create_movie_AVS_DX.f90 | 16 +- src/auxiliaries/rules.mk | 4 +- src/cuda/initialize_cuda.cu | 2 +- src/cuda/specfem3D_gpu_cuda_method_stubs.c | 242 +++++++++--------- src/meshfem3D/get_global.f90 | 10 +- src/meshfem3D/model_aniso_mantle.f90 | 4 +- src/meshfem3D/model_atten3D_QRFSI12.f90 | 6 +- src/meshfem3D/model_attenuation.f90 | 12 +- src/meshfem3D/model_crust.f90 | 2 +- src/meshfem3D/model_crust_1_0.f90 | 2 +- src/meshfem3D/model_gll.f90 | 74 +++--- src/meshfem3D/model_ppm.f90 | 10 +- src/meshfem3D/model_s362ani.f90 | 14 +- src/meshfem3D/sort_array_coordinates.f90 | 10 +- src/shared/adios_helpers_definitions.f90 | 4 +- src/shared/adios_method_stubs.c | 4 +- src/shared/asdf_helpers.f90 | 2 +- src/shared/asdf_helpers_definitions.f90 | 94 +++---- src/shared/asdf_helpers_writers.f90 | 16 +- src/shared/force_ftz.c | 4 + src/shared/intgrl.f90 | 8 +- src/shared/parallel.f90 | 82 +++--- src/specfem3D/asdf_data.f90 | 2 +- src/specfem3D/check_stability.f90 | 12 +- ...ompute_forces_acoustic_calling_routine.F90 | 16 +- .../compute_forces_outer_core_Dev.F90 | 8 +- .../compute_forces_outer_core_noDev.f90 | 8 +- src/specfem3D/convert_time.f90 | 20 +- src/specfem3D/file_io_threads.c | 24 +- src/specfem3D/iterate_time.F90 | 2 +- src/specfem3D/netlib_specfun_erf.f90 | 28 +- src/specfem3D/read_adjoint_sources.f90 | 4 +- src/specfem3D/setup_sources_receivers.f90 | 26 +- src/specfem3D/write_output_ASCII.f90 | 14 +- src/specfem3D/write_output_ASDF.F90 | 181 ++++++------- src/specfem3D/write_seismograms.f90 | 4 +- 42 files changed, 509 insertions(+), 504 deletions(-) diff --git a/flags.guess b/flags.guess index e07592c36..bc33dbaf2 100644 --- a/flags.guess +++ b/flags.guess @@ -70,13 +70,13 @@ case $my_FC in # Cray Fortran # DEF_FFLAGS="-O3 -Onoaggress -Oipa0 -hfp2 -Ovector3 -Oscalar3 -Ocache2 -Ounroll2 -Ofusion2 -M 1438" # turn on optimization; -Oaggress -Oipa4 would make it even more aggressive - # -eC -eD -ec -en -eI -ea -g -G0 -M 1438 # turn on full debugging and range checking + # -eC -eD -ec -en -eI -ea -g -G0 -M 1193 -M 1438 # turn on full debugging and range checking ;; pgf95|*/pgf95|pgf90|*/pgf90) # # Portland PGI # - DEF_FFLAGS="-fast -Mnobounds -Minline -Mneginfo -Mdclchk -Knoieee -Minform=warn -Mdaz -Mflushz -Mvect -mcmodel=medium" + DEF_FFLAGS="-fast -Mnobounds -Minline -Mneginfo -Mdclchk -Knoieee -Minform=inform -Mdaz -Mflushz -Mvect -mcmodel=medium" # -Mbounds # -fastsse -tp amd64e -Msmart ;; diff --git a/src/auxiliaries/combine_surf_data.f90 b/src/auxiliaries/combine_surf_data.f90 index 91bb780da..154dc3fba 100644 --- a/src/auxiliaries/combine_surf_data.f90 +++ b/src/auxiliaries/combine_surf_data.f90 @@ -37,7 +37,7 @@ program combine_surf_data integer,parameter :: MAX_NUM_NODES = 400 - integer i,j,k,ispec_surf,ios,it,num_node,njunk,ires,idim,iproc,njunk1,njunk2,njunk3,inx,iny + integer i,j,k,ispec_surf,ios,it,num_node,njunk,ires,idimval,iproc,njunk1,njunk2,njunk3,inx,iny character(len=150) :: arg(20),sline,filename,surfname,reg_name,belm_name, indir, outdir character(len=150) :: mesh_file, pt_mesh_file, em_mesh_file, command_name logical :: HIGH_RESOLUTION_MESH,FILE_ARRAY_IS_3D @@ -128,8 +128,8 @@ program combine_surf_data endif ! file dimension - read(arg(7),*) idim - if (idim == 0) then + read(arg(7),*) idimval + if (idimval == 0) then FILE_ARRAY_IS_3D = .false. else FILE_ARRAY_IS_3D = .true. diff --git a/src/auxiliaries/combine_vol_data.F90 b/src/auxiliaries/combine_vol_data.F90 index 33dcdad3e..6771f3272 100644 --- a/src/auxiliaries/combine_vol_data.F90 +++ b/src/auxiliaries/combine_vol_data.F90 @@ -112,7 +112,7 @@ program combine_vol_data_vtk call MPI_Init(ierr) call MPI_Comm_size(MPI_COMM_WORLD, sizeprocs, ierr) print *, sizeprocs, "procs" - if (sizeprocs .ne. 1) then + if (sizeprocs /= 1) then print *, "sequential program. Only mpirun -np 1 ..." call MPI_Abort(MPI_COMM_WORLD, mpier, ierr) endif diff --git a/src/auxiliaries/combine_vol_data_adios_impl.f90 b/src/auxiliaries/combine_vol_data_adios_impl.f90 index 0e4845f3c..1ebb886b0 100644 --- a/src/auxiliaries/combine_vol_data_adios_impl.f90 +++ b/src/auxiliaries/combine_vol_data_adios_impl.f90 @@ -149,8 +149,8 @@ end subroutine read_scalars_adios_mesh !============================================================================= subroutine read_coordinates_adios_mesh(mesh_handle, iproc, ir, nglob, nspec, & xstore, ystore, zstore, ibool) + use constants implicit none - include 'constants.h' ! Parameters integer(kind=8), intent(in) :: mesh_handle integer, intent(in) :: iproc, ir, nglob, nspec @@ -199,8 +199,8 @@ end subroutine read_coordinates_adios_mesh !============================================================================= subroutine read_values_adios(value_handle, var_name, iproc, ir, & nspec, data) + use constants implicit none - include 'constants.h' ! Parameters integer(kind=8), intent(in) :: value_handle character(len=*), intent(in) :: var_name diff --git a/src/auxiliaries/combine_vol_data_shared.f90 b/src/auxiliaries/combine_vol_data_shared.f90 index 63162abea..9bd12dcfe 100644 --- a/src/auxiliaries/combine_vol_data_shared.f90 +++ b/src/auxiliaries/combine_vol_data_shared.f90 @@ -286,7 +286,7 @@ end subroutine prem_density ! copy from intgrl.f90 to avoid compiling issues - subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3) + subroutine intgrl(sumval,r,nir,ner,f,s1,s2,s3) ! Computes the integral of f[i]*r[i]*r[i] from i=nir to i=ner for ! radii values as in model PREM_an640 @@ -296,7 +296,7 @@ subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3) ! Argument variables integer ner,nir double precision f(640),r(640),s1(640),s2(640) - double precision s3(640),sum + double precision s3(640),sumval ! Local variables double precision, parameter :: third = 1.0d0/3.0d0 @@ -316,14 +316,14 @@ subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3) call deriv(f,yprime,n,r,ndis,kdis,s1,s2,s3) nir1 = nir + 1 - sum = 0.0d0 + sumval = 0.0d0 do i=nir1,ner j = i-1 rji = r(i) - r(j) s1l = s1(j) s2l = s2(j) s3l = s3(j) - sum = sum + r(j)*r(j)*rji*(f(j) & + sumval = sumval + r(j)*r(j)*rji*(f(j) & + rji*(0.5d0*s1l + rji*(third*s2l + rji*0.25d0*s3l))) & + 2.0d0*r(j)*rji*rji*(0.5d0*f(j) + rji*(third*s1l + rji*(0.25d0*s2l + rji*fifth*s3l))) & + rji*rji*rji*(third*f(j) + rji*(0.25d0*s1l + rji*(fifth*s2l + rji*sixth*s3l))) diff --git a/src/auxiliaries/convolve_source_timefunction.f90 b/src/auxiliaries/convolve_source_timefunction.f90 index fe17bae62..9e63b6f37 100644 --- a/src/auxiliaries/convolve_source_timefunction.f90 +++ b/src/auxiliaries/convolve_source_timefunction.f90 @@ -41,11 +41,11 @@ program convolve_source_time_function integer :: i,j,N_j,number_remove,nlines - double precision :: alpha,dt,tau_j,source,exponent,t1,t2,displ1,displ2,gamma,height,half_duration_triangle + double precision :: alpha,dt,tau_j,source,exponentval,t1,t2,displ1,displ2,gamma,height,half_duration_triangle logical :: triangle - double precision, dimension(:), allocatable :: time,sem,sem_fil + double precision, dimension(:), allocatable :: timeval,sem,sem_fil ! read file with number of lines in input open(unit=33,file='input_convolve_code.txt',status='old',action='read') @@ -55,18 +55,18 @@ program convolve_source_time_function close(33) ! allocate arrays - allocate(time(nlines),sem(nlines),sem_fil(nlines)) + allocate(timeval(nlines),sem(nlines),sem_fil(nlines)) ! read the input seismogram do i = 1,nlines - read(5,*) time(i),sem(i) + read(5,*) timeval(i),sem(i) enddo ! define a Gaussian with the right exponent to mimic a triangle of equivalent half duration alpha = SOURCE_DECAY_MIMIC_TRIANGLE/half_duration_triangle ! compute the time step - dt = time(2) - time(1) + dt = timeval(2) - timeval(1) ! number of integers for which the source wavelet is different from zero if(triangle) then @@ -109,9 +109,9 @@ program convolve_source_time_function else ! convolve with a Gaussian - exponent = alpha**2 * tau_j**2 - if(exponent < 50.d0) then - source = alpha*exp(-exponent)/sqrt(PI) + exponentval = alpha**2 * tau_j**2 + if(exponentval < 50.d0) then + source = alpha*exp(-exponentval)/sqrt(PI) else source = 0.d0 endif @@ -128,7 +128,7 @@ program convolve_source_time_function ! compute number of samples to remove from end of seismograms number_remove = N_j + 1 do i=1,nlines - number_remove - write(*,*) sngl(time(i)),' ',sngl(sem_fil(i)) + write(*,*) sngl(timeval(i)),' ',sngl(sem_fil(i)) enddo end program convolve_source_time_function diff --git a/src/auxiliaries/create_movie_AVS_DX.f90 b/src/auxiliaries/create_movie_AVS_DX.f90 index 4f5a862c5..ddbbe9fca 100644 --- a/src/auxiliaries/create_movie_AVS_DX.f90 +++ b/src/auxiliaries/create_movie_AVS_DX.f90 @@ -97,7 +97,7 @@ program xcreate_movie_AVS_DX ! for sorting routine integer :: npointot,ilocnum,nglob,ielm,ieoff,ispecloc integer :: NIT - integer, dimension(:), allocatable :: iglob,loc,ireorder + integer, dimension(:), allocatable :: iglob,locval,ireorder logical, dimension(:), allocatable :: ifseg,mask_point double precision, dimension(:), allocatable :: xp,yp,zp,xp_save,yp_save,zp_save,field_display @@ -266,7 +266,7 @@ program xcreate_movie_AVS_DX allocate(iglob(npointot),stat=ierror) if(ierror /= 0) stop 'error while allocating iglob' - allocate(loc(npointot),stat=ierror) + allocate(locval(npointot),stat=ierror) if(ierror /= 0) stop 'error while allocating loc' allocate(ifseg(npointot),stat=ierror) @@ -610,7 +610,7 @@ program xcreate_movie_AVS_DX !--- sort the list based upon coordinates to get rid of multiples print *,'sorting list of points' - call get_global_AVS(nspectot_AVS_max,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) + call get_global_AVS(nspectot_AVS_max,xp,yp,zp,iglob,locval,ifseg,nglob,npointot) !--- print total number of points found print * @@ -866,7 +866,7 @@ end subroutine read_AVS_DX_parameters ! - subroutine get_global_AVS(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) + subroutine get_global_AVS(nspec,xp,yp,zp,iglob,locval,ifseg,nglob,npointot) ! this routine MUST be in double precision to avoid sensitivity ! to roundoff errors in the coordinates of the points @@ -878,7 +878,7 @@ subroutine get_global_AVS(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) implicit none integer npointot - integer iglob(npointot),loc(npointot) + integer iglob(npointot),locval(npointot) logical ifseg(npointot) double precision xp(npointot),yp(npointot),zp(npointot) integer nspec,nglob @@ -913,7 +913,7 @@ subroutine get_global_AVS(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) do ispec=1,nspec ieoff=NGNOD2D_AVS_DX*(ispec-1) do ilocnum=1,NGNOD2D_AVS_DX - loc(ieoff+ilocnum)=ieoff+ilocnum + locval(ieoff+ilocnum)=ieoff+ilocnum enddo enddo @@ -935,7 +935,7 @@ subroutine get_global_AVS(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) else call rank(zp(ioff),ind,ninseg(iseg)) endif - call swap_all(loc(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg)) + call swap_all(locval(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg)) ioff=ioff+ninseg(iseg) enddo @@ -971,7 +971,7 @@ subroutine get_global_AVS(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) ig=0 do i=1,npointot if(ifseg(i)) ig=ig+1 - iglob(loc(i))=ig + iglob(locval(i))=ig enddo nglob=ig diff --git a/src/auxiliaries/rules.mk b/src/auxiliaries/rules.mk index d3f9e9dc3..6e2a590fb 100644 --- a/src/auxiliaries/rules.mk +++ b/src/auxiliaries/rules.mk @@ -84,8 +84,8 @@ all_aux: required $(auxiliaries_TARGETS) aux: required $(auxiliaries_TARGETS) -${E}/xconvolve_source_timefunction: $O/convolve_source_timefunction.aux.o - ${FCCOMPILE_CHECK} -o ${E}/xconvolve_source_timefunction $O/convolve_source_timefunction.aux.o +${E}/xconvolve_source_timefunction: $(auxiliaries_SHARED_OBJECTS) $O/convolve_source_timefunction.aux.o + ${FCCOMPILE_CHECK} -o ${E}/xconvolve_source_timefunction $(auxiliaries_SHARED_OBJECTS) $O/convolve_source_timefunction.aux.o ${E}/xcombine_AVS_DX: $(auxiliaries_SHARED_OBJECTS) $O/get_cmt.solver.o $O/combine_AVS_DX.aux.o ${FCCOMPILE_CHECK} -o ${E}/xcombine_AVS_DX $(auxiliaries_SHARED_OBJECTS) $O/get_cmt.solver.o $O/combine_AVS_DX.aux.o diff --git a/src/cuda/initialize_cuda.cu b/src/cuda/initialize_cuda.cu index 392a04b11..a80093dc0 100644 --- a/src/cuda/initialize_cuda.cu +++ b/src/cuda/initialize_cuda.cu @@ -99,7 +99,7 @@ void FC_FUNC_(initialize_cuda_device, fprintf(stderr,"Error after cudaGetDeviceCount: %s\n", cudaGetErrorString(err)); exit_on_error("CUDA runtime error: cudaGetDeviceCount failed\n\nplease check if driver and runtime libraries work together\nor on titan enable environment: CRAY_CUDA_PROXY=1 to use single GPU with multiple MPI processes\n\nexiting...\n"); } - + // returns device count to fortran if (device_count == 0) exit_on_error("CUDA runtime error: there is no device supporting CUDA\n"); *ncuda_devices = device_count; diff --git a/src/cuda/specfem3D_gpu_cuda_method_stubs.c b/src/cuda/specfem3D_gpu_cuda_method_stubs.c index 286cfcc85..cc798fd44 100644 --- a/src/cuda/specfem3D_gpu_cuda_method_stubs.c +++ b/src/cuda/specfem3D_gpu_cuda_method_stubs.c @@ -1,4 +1,4 @@ -/* +/* !===================================================================== ! ! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0 @@ -34,7 +34,7 @@ typedef float realw; - + // // src/cuda/assemble_MPI_scalar_cuda.cu @@ -43,12 +43,12 @@ typedef float realw; void FC_FUNC_(transfer_boun_pot_from_device, TRANSFER_BOUN_POT_FROM_DEVICE)(long* Mesh_pointer_f, realw* send_buffer, - int* FORWARD_OR_ADJOINT){} + int* FORWARD_OR_ADJOINT){} void FC_FUNC_(transfer_asmbl_pot_to_device, TRANSFER_ASMBL_POT_TO_DEVICE)(long* Mesh_pointer, realw* buffer_recv_scalar, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} // @@ -59,26 +59,26 @@ void FC_FUNC_(transfer_boun_from_device, TRANSFER_BOUN_FROM_DEVICE)(long* Mesh_pointer_f, realw* send_accel_buffer, int* IREGION, - int* FORWARD_OR_ADJOINT){} + int* FORWARD_OR_ADJOINT){} void FC_FUNC_(transfer_asmbl_accel_to_device, TRANSFER_ASMBL_ACCEL_TO_DEVICE)(long* Mesh_pointer, realw* buffer_recv_vector, int* IREGION, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(transfer_buffer_to_device_async, TRANSFER_BUFFER_TO_DEVICE_ASYNC)(long* Mesh_pointer, realw* buffer, int* IREGION, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(sync_copy_from_device, SYNC_copy_FROM_DEVICE)(long* Mesh_pointer, int* iphase, realw* send_buffer, int* IREGION, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} // @@ -86,58 +86,58 @@ void FC_FUNC_(sync_copy_from_device, // void FC_FUNC_(pause_for_debug, - PAUSE_FOR_DEBUG)() {} + PAUSE_FOR_DEBUG)() {} void FC_FUNC_(output_free_device_memory, - OUTPUT_FREE_DEVICE_MEMORY)(int* myrank) {} + OUTPUT_FREE_DEVICE_MEMORY)(int* myrank) {} void FC_FUNC_(get_free_device_memory, - get_FREE_DEVICE_MEMORY)(realw* free, realw* used, realw* total ) {} + get_FREE_DEVICE_MEMORY)(realw* free, realw* used, realw* total ) {} void FC_FUNC_(check_norm_acoustic_from_device, CHECK_NORM_ACOUSTIC_FROM_DEVICE)(realw* norm, long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(check_norm_elastic_from_device, CHECK_NORM_ELASTIC_FROM_DEVICE)(realw* norm, long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(check_norm_strain_from_device, CHECK_NORM_STRAIN_FROM_DEVICE)(realw* strain_norm, realw* strain_norm2, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(check_max_norm_displ_gpu, - CHECK_MAX_NORM_DISPL_GPU)(int* size, realw* displ,long* Mesh_pointer_f,int* announceID) {} + CHECK_MAX_NORM_DISPL_GPU)(int* size, realw* displ,long* Mesh_pointer_f,int* announceID) {} void FC_FUNC_(check_max_norm_vector, - CHECK_MAX_NORM_VECTOR)(int* size, realw* vector1, int* announceID) {} + CHECK_MAX_NORM_VECTOR)(int* size, realw* vector1, int* announceID) {} void FC_FUNC_(check_max_norm_displ, - CHECK_MAX_NORM_DISPL)(int* size, realw* displ, int* announceID) {} + CHECK_MAX_NORM_DISPL)(int* size, realw* displ, int* announceID) {} void FC_FUNC_(check_max_norm_b_displ_gpu, - CHECK_MAX_NORM_B_DISPL_GPU)(int* size, realw* b_displ,long* Mesh_pointer_f,int* announceID) {} + CHECK_MAX_NORM_B_DISPL_GPU)(int* size, realw* b_displ,long* Mesh_pointer_f,int* announceID) {} void FC_FUNC_(check_max_norm_b_accel_gpu, - CHECK_MAX_NORM_B_ACCEL_GPU)(int* size, realw* b_accel,long* Mesh_pointer_f,int* announceID) {} + CHECK_MAX_NORM_B_ACCEL_GPU)(int* size, realw* b_accel,long* Mesh_pointer_f,int* announceID) {} void FC_FUNC_(check_max_norm_b_veloc_gpu, - CHECK_MAX_NORM_B_VELOC_GPU)(int* size, realw* b_veloc,long* Mesh_pointer_f,int* announceID) {} + CHECK_MAX_NORM_B_VELOC_GPU)(int* size, realw* b_veloc,long* Mesh_pointer_f,int* announceID) {} void FC_FUNC_(check_max_norm_b_displ, - CHECK_MAX_NORM_B_DISPL)(int* size, realw* b_displ,int* announceID) {} + CHECK_MAX_NORM_B_DISPL)(int* size, realw* b_displ,int* announceID) {} void FC_FUNC_(check_max_norm_b_accel, - CHECK_MAX_NORM_B_ACCEL)(int* size, realw* b_accel,int* announceID) {} + CHECK_MAX_NORM_B_ACCEL)(int* size, realw* b_accel,int* announceID) {} void FC_FUNC_(check_error_vectors, - CHECK_ERROR_VECTORS)(int* sizef, realw* vector1,realw* vector2) {} + CHECK_ERROR_VECTORS)(int* sizef, realw* vector1,realw* vector2) {} void FC_FUNC_(get_max_accel, - GET_MAX_ACCEL)(int* itf,int* sizef,long* Mesh_pointer) {} + GET_MAX_ACCEL)(int* itf,int* sizef,long* Mesh_pointer) {} // @@ -147,28 +147,28 @@ void FC_FUNC_(check_norm_strain_from_device, void FC_FUNC_(compute_add_sources_cuda, COMPUTE_ADD_SOURCES_CUDA)(long* Mesh_pointer_f, int* NSOURCESf, - double* h_stf_pre_compute) {} + double* h_stf_pre_compute) {} void FC_FUNC_(compute_add_sources_backward_cuda, COMPUTE_ADD_SOURCES_BACKWARD_CUDA)(long* Mesh_pointer_f, int* NSOURCESf, - double* h_stf_pre_compute) {} + double* h_stf_pre_compute) {} void FC_FUNC_(compute_add_sources_adjoint_cuda, COMPUTE_ADD_SOURCES_ADJOINT_CUDA)(long* Mesh_pointer, - int* h_nrec) {} + int* h_nrec) {} void FC_FUNC_(transfer_adj_to_device, TRANSFER_ADJ_TO_DEVICE)(long* Mesh_pointer, int* h_nrec, realw* h_adj_sourcearrays, - int* h_islice_selected_rec) {} + int* h_islice_selected_rec) {} void FC_FUNC_(transfer_adj_to_device_async, TRANSFER_ADJ_TO_DEVICE_ASYNC)(long* Mesh_pointer, int* h_nrec, realw* h_adj_sourcearrays, - int* h_islice_selected_rec) {} + int* h_islice_selected_rec) {} // @@ -177,23 +177,23 @@ void FC_FUNC_(transfer_adj_to_device_async, void FC_FUNC_(compute_coupling_fluid_cmb_cuda, COMPUTE_COUPLING_FLUID_CMB_CUDA)(long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(compute_coupling_fluid_icb_cuda, COMPUTE_COUPLING_FLUID_ICB_CUDA)(long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(compute_coupling_cmb_fluid_cuda, COMPUTE_COUPLING_CMB_FLUID_CUDA)(long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(compute_coupling_icb_fluid_cuda, COMPUTE_COUPLING_ICB_FLUID_CUDA)(long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(compute_coupling_ocean_cuda, COMPUTE_COUPLING_OCEAN_CUDA)(long* Mesh_pointer_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} // @@ -203,7 +203,7 @@ void FC_FUNC_(compute_coupling_ocean_cuda, void FC_FUNC_(compute_forces_crust_mantle_cuda, COMPUTE_FORCES_CRUST_MANTLE_CUDA)(long* Mesh_pointer_f, int* iphase, - int* FORWARD_OR_ADJOINT_f) {} + int* FORWARD_OR_ADJOINT_f) {} // @@ -213,7 +213,7 @@ void FC_FUNC_(compute_forces_crust_mantle_cuda, void FC_FUNC_(compute_forces_inner_core_cuda, COMPUTE_FORCES_INNER_CORE_CUDA)(long* Mesh_pointer_f, int* iphase, - int* FORWARD_OR_ADJOINT_f) {} + int* FORWARD_OR_ADJOINT_f) {} // @@ -224,7 +224,7 @@ void FC_FUNC_(compute_forces_outer_core_cuda, COMPUTE_FORCES_OUTER_CORE_CUDA)(long* Mesh_pointer_f, int* iphase, realw* time_f, - int* FORWARD_OR_ADJOINT_f) {} + int* FORWARD_OR_ADJOINT_f) {} // @@ -232,22 +232,22 @@ void FC_FUNC_(compute_forces_outer_core_cuda, // void FC_FUNC_(compute_kernels_cm_cuda, - COMPUTE_KERNELS_CM_CUDA)(long* Mesh_pointer,realw* deltat_f) {} + COMPUTE_KERNELS_CM_CUDA)(long* Mesh_pointer,realw* deltat_f) {} void FC_FUNC_(compute_kernels_ic_cuda, - COMPUTE_KERNELS_IC_CUDA)(long* Mesh_pointer,realw* deltat_f) {} + COMPUTE_KERNELS_IC_CUDA)(long* Mesh_pointer,realw* deltat_f) {} void FC_FUNC_(compute_kernels_oc_cuda, - COMPUTE_KERNELS_OC_CUDA)(long* Mesh_pointer,realw* deltat_f) {} + COMPUTE_KERNELS_OC_CUDA)(long* Mesh_pointer,realw* deltat_f) {} void FC_FUNC_(compute_kernels_strgth_noise_cu, COMPUTE_KERNELS_STRGTH_NOISE_CU)(long* Mesh_pointer, realw* h_noise_surface_movie, - realw* deltat_f) {} + realw* deltat_f) {} void FC_FUNC_(compute_kernels_hess_cuda, COMPUTE_KERNELS_HESS_CUDA)(long* Mesh_pointer, - realw* deltat_f) {} + realw* deltat_f) {} // @@ -257,16 +257,16 @@ void FC_FUNC_(compute_kernels_hess_cuda, void FC_FUNC_(compute_stacey_acoustic_cuda, COMPUTE_STACEY_ACOUSTIC_CUDA)(long* Mesh_pointer_f, realw* absorb_potential, - int* itype) {} + int* itype) {} void FC_FUNC_(compute_stacey_acoustic_backward_cuda, COMPUTE_STACEY_ACOUSTIC_BACKWARD_CUDA)(long* Mesh_pointer_f, realw* absorb_potential, - int* itype) {} + int* itype) {} void FC_FUNC_(compute_stacey_acoustic_undoatt_cuda, COMPUTE_STACEY_ACOUSTIC_UNDOATT_CUDA)(long* Mesh_pointer_f, - int* itype) {} + int* itype) {} // @@ -276,16 +276,16 @@ void FC_FUNC_(compute_stacey_acoustic_undoatt_cuda, void FC_FUNC_(compute_stacey_elastic_cuda, COMPUTE_STACEY_ELASTIC_CUDA)(long* Mesh_pointer_f, realw* absorb_field, - int* itype) {} + int* itype) {} void FC_FUNC_(compute_stacey_elastic_backward_cuda, COMPUTE_STACEY_ELASTIC_BACKWARD_CUDA)(long* Mesh_pointer_f, realw* absorb_field, - int* itype) {} + int* itype) {} void FC_FUNC_(compute_stacey_elastic_undoatt_cuda, COMPUTE_STACEY_ELASTIC_UNDOATT_CUDA)(long* Mesh_pointer_f, - int* itype) {} + int* itype) {} // @@ -293,39 +293,39 @@ void FC_FUNC_(compute_stacey_elastic_undoatt_cuda, // void FC_FUNC_(initialize_cuda_device, - INITIALIZE_CUDA_DEVICE)(int* myrank_f,int* ncuda_devices) { + INITIALIZE_CUDA_DEVICE)(int* myrank_f,int* ncuda_devices) { fprintf(stderr,"ERROR: GPU_MODE enabled without GPU/CUDA Support. To enable GPU support, reconfigure with --with-cuda flag.\n"); exit(1); -} +} // // src/cuda/noise_tomography_cuda.cu // -void FC_FUNC_(fortranflush,FORTRANFLUSH)(int* rank){} +void FC_FUNC_(fortranflush,FORTRANFLUSH)(int* rank){} -void FC_FUNC_(fortranprint,FORTRANPRINT)(int* id) {} +void FC_FUNC_(fortranprint,FORTRANPRINT)(int* id) {} -void FC_FUNC_(fortranprintf,FORTRANPRINTF)(realw* val) {} +void FC_FUNC_(fortranprintf,FORTRANPRINTF)(realw* val) {} -void FC_FUNC_(fortranprintd,FORTRANPRINTD)(double* val) {} +void FC_FUNC_(fortranprintd,FORTRANPRINTD)(double* val) {} -void FC_FUNC_(make_displ_rand,MAKE_DISPL_RAND)(long* Mesh_pointer_f,realw* h_displ) {} +void FC_FUNC_(make_displ_rand,MAKE_DISPL_RAND)(long* Mesh_pointer_f,realw* h_displ) {} void FC_FUNC_(noise_transfer_surface_to_host, NOISE_TRANSFER_SURFACE_TO_HOST)(long* Mesh_pointer_f, - realw* h_noise_surface_movie) {} + realw* h_noise_surface_movie) {} void FC_FUNC_(noise_add_source_master_rec_cu, NOISE_ADD_SOURCE_MASTER_REC_CU)(long* Mesh_pointer_f, int* it_f, int* irec_master_noise_f, - int* islice_selected_rec) {} + int* islice_selected_rec) {} void FC_FUNC_(noise_add_surface_movie_cuda, NOISE_ADD_SURFACE_MOVIE_CUDA)(long* Mesh_pointer_f, - realw* h_noise_surface_movie) {} + realw* h_noise_surface_movie) {} // @@ -360,7 +360,7 @@ void FC_FUNC_(prepare_constants_device, int* SAVE_BOUNDARY_MESH_f, int* USE_MESH_COLORING_GPU_f, int* ANISOTROPIC_KL_f,int* APPROXIMATE_HESS_KL_f, - realw* deltat_f,realw* b_deltat_f) {} + realw* deltat_f,realw* b_deltat_f) {} void FC_FUNC_(prepare_fields_rotation_device, PREPARE_FIELDS_ROTATION_DEVICE)(long* Mesh_pointer_f, @@ -370,7 +370,7 @@ void FC_FUNC_(prepare_fields_rotation_device, realw* b_two_omega_earth_f, realw* b_A_array_rotation, realw* b_B_array_rotation, - int* NSPEC_OUTER_CORE_ROTATION) {} + int* NSPEC_OUTER_CORE_ROTATION) {} void FC_FUNC_(prepare_fields_gravity_device, PREPARE_FIELDS_gravity_DEVICE)(long* Mesh_pointer_f, @@ -384,7 +384,7 @@ void FC_FUNC_(prepare_fields_gravity_device, realw* minus_g_icb, realw* minus_g_cmb, double* RHO_BOTTOM_OC, - double* RHO_TOP_OC) {} + double* RHO_TOP_OC) {} void FC_FUNC_(prepare_fields_attenuat_device, PREPARE_FIELDS_ATTENUAT_DEVICE)(long* Mesh_pointer_f, @@ -413,7 +413,7 @@ void FC_FUNC_(prepare_fields_attenuat_device, realw* factor_common_inner_core, realw* one_minus_sum_beta_inner_core, realw* alphaval,realw* betaval,realw* gammaval, - realw* b_alphaval,realw* b_betaval,realw* b_gammaval) {} + realw* b_alphaval,realw* b_betaval,realw* b_gammaval) {} void FC_FUNC_(prepare_fields_strain_device, PREPARE_FIELDS_STRAIN_DEVICE)(long* Mesh_pointer_f, @@ -440,7 +440,7 @@ void FC_FUNC_(prepare_fields_strain_device, realw* b_epsilondev_xz_inner_core, realw* b_epsilondev_yz_inner_core, realw* eps_trace_over_3_inner_core, - realw* b_eps_trace_over_3_inner_core) {} + realw* b_eps_trace_over_3_inner_core) {} void FC_FUNC_(prepare_fields_absorb_device, PREPARE_FIELDS_ABSORB_DEVICE)(long* Mesh_pointer_f, @@ -469,7 +469,7 @@ void FC_FUNC_(prepare_fields_absorb_device, int* ibelm_ymin_outer_core,int* ibelm_ymax_outer_core, realw* jacobian2D_xmin_outer_core, realw* jacobian2D_xmax_outer_core, realw* jacobian2D_ymin_outer_core, realw* jacobian2D_ymax_outer_core, - realw* vp_outer_core) {} + realw* vp_outer_core) {} void FC_FUNC_(prepare_mpi_buffers_device, PREPARE_MPI_BUFFERS_DEVICE)(long* Mesh_pointer_f, @@ -484,7 +484,7 @@ void FC_FUNC_(prepare_mpi_buffers_device, int* num_interfaces_outer_core, int* max_nibool_interfaces_oc, int* nibool_interfaces_outer_core, - int* ibool_interfaces_outer_core){} + int* ibool_interfaces_outer_core){} void FC_FUNC_(prepare_fields_noise_device, PREPARE_FIELDS_NOISE_DEVICE)(long* Mesh_pointer_f, @@ -496,14 +496,14 @@ void FC_FUNC_(prepare_fields_noise_device, realw* normal_y_noise, realw* normal_z_noise, realw* mask_noise, - realw* jacobian2D_top_crust_mantle) {} + realw* jacobian2D_top_crust_mantle) {} void FC_FUNC_(prepare_oceans_device, PREPARE_OCEANS_DEVICE)(long* Mesh_pointer_f, int* npoin_oceans, int* h_iglob_ocean_load, realw* h_rmass_ocean_load_selected, - realw* h_normal_ocean_load) {} + realw* h_normal_ocean_load) {} void FC_FUNC_(prepare_crust_mantle_device, PREPARE_CRUST_MANTLE_DEVICE)(long* Mesh_pointer_f, @@ -535,7 +535,7 @@ void FC_FUNC_(prepare_crust_mantle_device, int* NCHUNKS_VAL, int* num_colors_outer, int* num_colors_inner, - int* num_elem_colors) {} + int* num_elem_colors) {} void FC_FUNC_(prepare_outer_core_device, PREPARE_OUTER_CORE_DEVICE)(long* Mesh_pointer_f, @@ -560,7 +560,7 @@ void FC_FUNC_(prepare_outer_core_device, int* h_ibelm_bottom_outer_core, int* num_colors_outer, int* num_colors_inner, - int* num_elem_colors) {} + int* num_elem_colors) {} void FC_FUNC_(prepare_inner_core_device, PREPARE_INNER_CORE_DEVICE)(long* Mesh_pointer_f, @@ -583,11 +583,11 @@ void FC_FUNC_(prepare_inner_core_device, int* h_ibelm_top_inner_core, int* num_colors_outer, int* num_colors_inner, - int* num_elem_colors) {} + int* num_elem_colors) {} void FC_FUNC_(prepare_cleanup_device, PREPARE_CLEANUP_DEVICE)(long* Mesh_pointer_f, - int* NCHUNKS_VAL) {} + int* NCHUNKS_VAL) {} // @@ -595,88 +595,88 @@ void FC_FUNC_(prepare_cleanup_device, // void FC_FUNC_(transfer_fields_cm_to_device, - TRANSFER_FIELDS_CM_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_FIELDS_CM_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_fields_ic_to_device, - TRANSFER_FIELDS_IC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_FIELDS_IC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_fields_oc_to_device, - TRANSFER_FIELDS_OC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_FIELDS_OC_TO_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_fields_cm_to_device, TRANSFER_FIELDS_B_CM_TO_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_fields_ic_to_device, TRANSFER_FIELDS_B_IC_TO_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_fields_oc_to_device, TRANSFER_FIELDS_B_OC_TO_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(transfer_fields_cm_from_device, - TRANSFER_FIELDS_CM_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_FIELDS_CM_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_fields_ic_from_device, - TRANSFER_FIELDS_IC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_FIELDS_IC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_fields_oc_from_device, - TRANSFER_FIELDS_OC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_FIELDS_OC_FROM_DEVICE)(int* size, realw* displ, realw* veloc, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_fields_cm_from_device, TRANSFER_B_FIELDS_CM_FROM_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_fields_ic_from_device, TRANSFER_B_FIELDS_IC_FROM_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_fields_oc_from_device, TRANSFER_B_FIELDS_OC_FROM_DEVICE)(int* size, realw* b_displ, realw* b_veloc, realw* b_accel, - long* Mesh_pointer_f) {} + long* Mesh_pointer_f) {} void FC_FUNC_(transfer_displ_cm_from_device, - TRANSFER_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} + TRANSFER_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_displ_cm_from_device, - TRANSFER_B_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} + TRANSFER_B_DISPL_CM_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_displ_ic_from_device, - TRANSFER_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} + TRANSFER_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_displ_ic_from_device, - TRANSFER_B_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} + TRANSFER_B_DISPL_IC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_displ_oc_from_device, - TRANSFER_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} + TRANSFER_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_displ_oc_from_device, - TRANSFER_B_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} + TRANSFER_B_DISPL_OC_FROM_DEVICE)(int* size, realw* displ, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_veloc_cm_from_device, - TRANSFER_VELOC_CM_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {} + TRANSFER_VELOC_CM_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_veloc_ic_from_device, - TRANSFER_VELOC_IC_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {} + TRANSFER_VELOC_IC_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_veloc_oc_from_device, - TRANSFER_VELOC_OC_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {} + TRANSFER_VELOC_OC_FROM_DEVICE)(int* size, realw* veloc, long* Mesh_pointer_f) {} void FC_FUNC_(transfer_accel_cm_to_device, - TRANSFER_ACCEL_CM_TO_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_ACCEL_CM_TO_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_accel_cm_from_device, - TRANSFER_ACCEL_CM_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_ACCEL_CM_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_b_accel_cm_from_device, - TRANSFER_B_ACCEL_CM_FROM_DEVICE)(int* size, realw* b_accel,long* Mesh_pointer_f) {} + TRANSFER_B_ACCEL_CM_FROM_DEVICE)(int* size, realw* b_accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_accel_ic_from_device, - TRANSFER_ACCEL_IC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_ACCEL_IC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_accel_oc_from_device, - TRANSFER_ACCEL_OC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} + TRANSFER_ACCEL_OC_FROM_DEVICE)(int* size, realw* accel,long* Mesh_pointer_f) {} void FC_FUNC_(transfer_strain_cm_from_device, TRANSFER_STRAIN_CM_FROM_DEVICE)(long* Mesh_pointer, @@ -685,7 +685,7 @@ void FC_FUNC_(transfer_strain_cm_from_device, realw* epsilondev_yy, realw* epsilondev_xy, realw* epsilondev_xz, - realw* epsilondev_yz) {} + realw* epsilondev_yz) {} void FC_FUNC_(transfer_b_strain_cm_to_device, TRANSFER_B_STRAIN_CM_TO_DEVICE)(long* Mesh_pointer, @@ -693,7 +693,7 @@ void FC_FUNC_(transfer_b_strain_cm_to_device, realw* epsilondev_yy, realw* epsilondev_xy, realw* epsilondev_xz, - realw* epsilondev_yz) {} + realw* epsilondev_yz) {} void FC_FUNC_(transfer_strain_ic_from_device, TRANSFER_STRAIN_IC_FROM_DEVICE)(long* Mesh_pointer, @@ -702,7 +702,7 @@ void FC_FUNC_(transfer_strain_ic_from_device, realw* epsilondev_yy, realw* epsilondev_xy, realw* epsilondev_xz, - realw* epsilondev_yz) {} + realw* epsilondev_yz) {} void FC_FUNC_(transfer_b_strain_ic_to_device, TRANSFER_B_STRAIN_IC_TO_DEVICE)(long* Mesh_pointer, @@ -710,7 +710,7 @@ void FC_FUNC_(transfer_b_strain_ic_to_device, realw* epsilondev_yy, realw* epsilondev_xy, realw* epsilondev_xz, - realw* epsilondev_yz) {} + realw* epsilondev_yz) {} void FC_FUNC_(transfer_rmemory_cm_from_device, TRANSFER_RMEMORY_CM_FROM_DEVICE)(long* Mesh_pointer, @@ -718,7 +718,7 @@ void FC_FUNC_(transfer_rmemory_cm_from_device, realw* R_yy, realw* R_xy, realw* R_xz, - realw* R_yz) {} + realw* R_yz) {} void FC_FUNC_(transfer_b_rmemory_cm_to_device, TRANSFER_B_RMEMORY_CM_TO_DEVICE)(long* Mesh_pointer, @@ -726,7 +726,7 @@ void FC_FUNC_(transfer_b_rmemory_cm_to_device, realw* b_R_yy, realw* b_R_xy, realw* b_R_xz, - realw* b_R_yz) {} + realw* b_R_yz) {} void FC_FUNC_(transfer_rmemory_ic_from_device, TRANSFER_RMEMORY_IC_FROM_DEVICE)(long* Mesh_pointer, @@ -734,7 +734,7 @@ void FC_FUNC_(transfer_rmemory_ic_from_device, realw* R_yy, realw* R_xy, realw* R_xz, - realw* R_yz) {} + realw* R_yz) {} void FC_FUNC_(transfer_b_rmemory_ic_to_device, TRANSFER_B_RMEMORY_IC_TO_DEVICE)(long* Mesh_pointer, @@ -742,17 +742,17 @@ void FC_FUNC_(transfer_b_rmemory_ic_to_device, realw* b_R_yy, realw* b_R_xy, realw* b_R_xz, - realw* b_R_yz) {} + realw* b_R_yz) {} void FC_FUNC_(transfer_rotation_from_device, TRANSFER_ROTATION_FROM_DEVICE)(long* Mesh_pointer, realw* A_array_rotation, - realw* B_array_rotation) {} + realw* B_array_rotation) {} void FC_FUNC_(transfer_b_rotation_to_device, TRANSFER_B_ROTATION_TO_DEVICE)(long* Mesh_pointer, realw* A_array_rotation, - realw* B_array_rotation) {} + realw* B_array_rotation) {} void FC_FUNC_(transfer_kernels_cm_to_host, TRANSFER_KERNELS_CM_TO_HOST)(long* Mesh_pointer, @@ -760,30 +760,30 @@ void FC_FUNC_(transfer_kernels_cm_to_host, realw* h_alpha_kl, realw* h_beta_kl, realw* h_cijkl_kl, - int* NSPEC) {} + int* NSPEC) {} void FC_FUNC_(transfer_kernels_ic_to_host, TRANSFER_KERNELS_IC_TO_HOST)(long* Mesh_pointer, realw* h_rho_kl, realw* h_alpha_kl, realw* h_beta_kl, - int* NSPEC) {} + int* NSPEC) {} void FC_FUNC_(transfer_kernels_oc_to_host, TRANSFER_KERNELS_OC_TO_HOST)(long* Mesh_pointer, realw* h_rho_kl, realw* h_alpha_kl, - int* NSPEC) {} + int* NSPEC) {} void FC_FUNC_(transfer_kernels_noise_to_host, TRANSFER_KERNELS_NOISE_TO_HOST)(long* Mesh_pointer, realw* h_Sigma_kl, - int* NSPEC) {} + int* NSPEC) {} void FC_FUNC_(transfer_kernels_hess_cm_tohost, TRANSFER_KERNELS_HESS_CM_TOHOST)(long* Mesh_pointer, realw* h_hess_kl, - int* NSPEC) {} + int* NSPEC) {} // @@ -795,39 +795,39 @@ void FC_FUNC_(update_displacement_ic_cuda, realw* deltat_f, realw* deltatsqover2_f, realw* deltatover2_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(update_displacement_cm_cuda, UPDATE_DISPLACMENT_CM_CUDA)(long* Mesh_pointer_f, realw* deltat_f, realw* deltatsqover2_f, realw* deltatover2_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(update_displacement_oc_cuda, UPDATE_DISPLACEMENT_OC_cuda)(long* Mesh_pointer_f, realw* deltat_f, realw* deltatsqover2_f, realw* deltatover2_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(multiply_accel_elastic_cuda, MULTIPLY_ACCEL_ELASTIC_CUDA)(long* Mesh_pointer, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(update_veloc_elastic_cuda, UPDATE_VELOC_ELASTIC_CUDA)(long* Mesh_pointer, realw* deltatover2_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(multiply_accel_acoustic_cuda, MULTIPLY_ACCEL_ACOUSTIC_CUDA)(long* Mesh_pointer, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} void FC_FUNC_(update_veloc_acoustic_cuda, UPDATE_VELOC_ACOUSTIC_CUDA)(long* Mesh_pointer, realw* deltatover2_f, - int* FORWARD_OR_ADJOINT) {} + int* FORWARD_OR_ADJOINT) {} // @@ -847,7 +847,7 @@ void FC_FUNC_(write_seismograms_transfer_cuda, int* number_receiver_global, int* ispec_selected_rec, int* ispec_selected_source, - int* ibool) {} + int* ibool) {} void FC_FUNC_(transfer_seismo_from_device_async, TRANSFER_SEISMO_FROM_DEVICE_ASYNC)(long* Mesh_pointer_f, @@ -856,5 +856,5 @@ void FC_FUNC_(transfer_seismo_from_device_async, int* number_receiver_global, int* ispec_selected_rec, int* ispec_selected_source, - int* ibool) {} + int* ibool) {} diff --git a/src/meshfem3D/get_global.f90 b/src/meshfem3D/get_global.f90 index 4ae21f69e..08588fc6f 100644 --- a/src/meshfem3D/get_global.f90 +++ b/src/meshfem3D/get_global.f90 @@ -25,7 +25,7 @@ ! !===================================================================== - subroutine get_global(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) + subroutine get_global(nspec,xp,yp,zp,iglob,locval,ifseg,nglob,npointot) ! this routine MUST be in double precision to avoid sensitivity ! to roundoff errors in the coordinates of the points @@ -43,7 +43,7 @@ subroutine get_global(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) double precision, dimension(npointot), intent(in) :: xp,yp,zp - integer, dimension(npointot), intent(out) :: iglob,loc + integer, dimension(npointot), intent(out) :: iglob,locval logical, dimension(npointot), intent(out) :: ifseg integer, intent(out) :: nglob @@ -65,7 +65,7 @@ subroutine get_global(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) do ispec=1,nspec ieoff=NGLLX * NGLLY * NGLLZ * (ispec-1) do ilocnum=1,NGLLX * NGLLY * NGLLZ - loc(ilocnum+ieoff)=ilocnum+ieoff + locval(ilocnum+ieoff)=ilocnum+ieoff enddo enddo @@ -87,7 +87,7 @@ subroutine get_global(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) call rank(zp(ioff),ind,ninseg(iseg)) endif - call swap_all(loc(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg)) + call swap_all(locval(ioff),xp(ioff),yp(ioff),zp(ioff),iwork,work,ind,ninseg(iseg)) ioff=ioff+ninseg(iseg) enddo @@ -124,7 +124,7 @@ subroutine get_global(nspec,xp,yp,zp,iglob,loc,ifseg,nglob,npointot) ig=0 do i=1,npointot if(ifseg(i)) ig=ig+1 - iglob(loc(i))=ig + iglob(locval(i))=ig enddo nglob=ig diff --git a/src/meshfem3D/model_aniso_mantle.f90 b/src/meshfem3D/model_aniso_mantle.f90 index 923b64e87..bbd844cd4 100644 --- a/src/meshfem3D/model_aniso_mantle.f90 +++ b/src/meshfem3D/model_aniso_mantle.f90 @@ -554,7 +554,7 @@ subroutine lecmod(nri,pari,ra) double precision epa(14,47),ra(47),dcori(47),ri(47) double precision corpar(21,47) double precision aa,an,al,af,ac,vpv,vph,vsv,vsh,rho,red,a2l - character(len=80) null + character(len=80) nullval character(len=150) Adrem119 ifanis = 1 @@ -562,7 +562,7 @@ subroutine lecmod(nri,pari,ra) call get_value_string(Adrem119, 'model.Adrem119', 'DATA/Montagner_model/Adrem119') open(unit=13,file=Adrem119,status='old',action='read') - read(13,*,end = 77) nlayer,minlay,moho,nout,neff,nband,kiti,null + read(13,*,end = 77) nlayer,minlay,moho,nout,neff,nband,kiti,nullval if(kiti == 0) read(13,"(20a4)",end = 77) idum1 read(13,"(20a4)",end = 77) idum2 diff --git a/src/meshfem3D/model_atten3D_QRFSI12.f90 b/src/meshfem3D/model_atten3D_QRFSI12.f90 index d6bce9b6e..f7851d31b 100644 --- a/src/meshfem3D/model_atten3D_QRFSI12.f90 +++ b/src/meshfem3D/model_atten3D_QRFSI12.f90 @@ -119,7 +119,7 @@ subroutine read_atten_model_3D_QRFSI12() ! local parameters integer :: j,k,l,m,ier - integer :: index,ll,mm + integer :: indexval,ll,mm double precision :: v1,v2 character(len=150) :: QRFSI12,QRFSI12_ref @@ -137,7 +137,7 @@ subroutine read_atten_model_3D_QRFSI12() endif do k=1,NKQ - read(10,*)index + read(10,*) indexval j=0 do l=0,MAXL_Q do m=0,l @@ -148,7 +148,7 @@ subroutine read_atten_model_3D_QRFSI12() else j=j+2 read(10,*)ll,mm,v1,v2 - ! write(*,*) 'k,l,m,ll,mm:',k,l,m,ll,mm,v1 + ! write(*,*) 'k,l,m,ll,mm:',k,l,m,ll,mm,v1 QRFSI12_Q_dqmu(k,j-1)=2.*v1 QRFSI12_Q_dqmu(k,j)=-2.*v2 endif diff --git a/src/meshfem3D/model_attenuation.f90 b/src/meshfem3D/model_attenuation.f90 index d2bb83260..ce45fb41d 100644 --- a/src/meshfem3D/model_attenuation.f90 +++ b/src/meshfem3D/model_attenuation.f90 @@ -544,7 +544,7 @@ subroutine attenuation_tau_sigma(tau_s, n, min_period, max_period) double precision min_period, max_period double precision f1, f2 double precision exp1, exp2 - double precision dexp + double precision dexpval integer i f1 = 1.0d0 / max_period @@ -553,9 +553,9 @@ subroutine attenuation_tau_sigma(tau_s, n, min_period, max_period) exp1 = log10(f1) exp2 = log10(f2) - dexp = (exp2-exp1) / ((n*1.0d0) - 1) + dexpval = (exp2-exp1) / ((n*1.0d0) - 1) do i = 1,n - tau_s(i) = 1.0 / (PI * 2.0d0 * 10**(exp1 + (i - 1)* 1.0d0 *dexp)) + tau_s(i) = 1.0 / (PI * 2.0d0 * 10**(exp1 + (i - 1)* 1.0d0 *dexpval)) enddo end subroutine attenuation_tau_sigma @@ -597,7 +597,7 @@ subroutine attenuation_invert_by_simplex(t2, t1, n, Q_real, omega_not, tau_s, ta ! Internal integer i, iterations, err,prnt - double precision f1, f2, exp1,exp2,dexp, min_value + double precision f1, f2, exp1,exp2,dexpval, min_value double precision, allocatable, dimension(:) :: f integer, parameter :: nf = 100 double precision, external :: attenuation_eval @@ -632,9 +632,9 @@ subroutine attenuation_invert_by_simplex(t2, t1, n, Q_real, omega_not, tau_s, ta enddo ! Set the Tau_sigma (tau_s) to be equally spaced in log10 frequency - dexp = (exp2-exp1) / ((n*1.0d0) - 1) + dexpval = (exp2-exp1) / ((n*1.0d0) - 1) do i = 1,n - tau_s(i) = 1.0 / (PI * 2.0d0 * 10**(exp1 + (i - 1)* 1.0d0 *dexp)) + tau_s(i) = 1.0 / (PI * 2.0d0 * 10**(exp1 + (i - 1)* 1.0d0 *dexpval)) enddo ! Shove the paramters into the module diff --git a/src/meshfem3D/model_crust.f90 b/src/meshfem3D/model_crust.f90 index 07e81d150..30d80741f 100644 --- a/src/meshfem3D/model_crust.f90 +++ b/src/meshfem3D/model_crust.f90 @@ -41,7 +41,7 @@ ! 5) upper crust ! 6) middle crust ! 7) lower crust -! + Parameters VP, VS and rho are given explicitly for these 7 layers as well as the mantle below the Moho. +! + Parameters VP, VS and rho are given explicitly for these 7 layers as well as the mantle below the Moho. ! ! reads and smooths crust2.0 model !-------------------------------------------------------------------------------------------------- diff --git a/src/meshfem3D/model_crust_1_0.f90 b/src/meshfem3D/model_crust_1_0.f90 index c0794ef9e..b221400be 100644 --- a/src/meshfem3D/model_crust_1_0.f90 +++ b/src/meshfem3D/model_crust_1_0.f90 @@ -145,7 +145,7 @@ subroutine model_crust_1_0(lat,lon,x,vp,vs,rho,moho,found_crust,elem_in_crust) ! gets smoothed structure call crust_1_0_CAPsmoothed(lat,lon,vps,vss,rhos,thicks) - ! note: we ignore water & ice sheets + ! note: we ignore water & ice sheets ! (only elastic layers are considered) ! whole sediment thickness diff --git a/src/meshfem3D/model_gll.f90 b/src/meshfem3D/model_gll.f90 index bbb6c0531..37579f8b0 100644 --- a/src/meshfem3D/model_gll.f90 +++ b/src/meshfem3D/model_gll.f90 @@ -63,7 +63,7 @@ subroutine model_gll_broadcast(myrank,MGLL_V,NSPEC) ! local parameters double precision :: scaleval - real(kind=CUSTOM_REAL) :: min,max,min_all,max_all + real(kind=CUSTOM_REAL) :: minvalue,maxvalue,min_all,max_all integer :: ier ! allocates arrays @@ -103,26 +103,26 @@ subroutine model_gll_broadcast(myrank,MGLL_V,NSPEC) endif ! Vs - max = maxval( MGLL_V%vs_new ) - min = minval( MGLL_V%vs_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%vs_new ) + minvalue = minval( MGLL_V%vs_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' vs new min/max: ',min_all,max_all endif ! Vp - max = maxval( MGLL_V%vp_new ) - min = minval( MGLL_V%vp_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%vp_new ) + minvalue = minval( MGLL_V%vp_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' vp new min/max: ',min_all,max_all endif ! density - max = maxval( MGLL_V%rho_new ) - min = minval( MGLL_V%rho_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%rho_new ) + minvalue = minval( MGLL_V%rho_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' rho new min/max: ',min_all,max_all write(IMAIN,*) @@ -137,50 +137,50 @@ subroutine model_gll_broadcast(myrank,MGLL_V,NSPEC) endif ! Vsv - max = maxval( MGLL_V%vsv_new ) - min = minval( MGLL_V%vsv_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%vsv_new ) + minvalue = minval( MGLL_V%vsv_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' vsv new min/max: ',min_all,max_all endif ! Vsh - max = maxval( MGLL_V%vsh_new ) - min = minval( MGLL_V%vsh_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%vsh_new ) + minvalue = minval( MGLL_V%vsh_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' vsh new min/max: ',min_all,max_all endif ! Vpv - max = maxval( MGLL_V%vpv_new ) - min = minval( MGLL_V%vpv_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%vpv_new ) + minvalue = minval( MGLL_V%vpv_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' vpv new min/max: ',min_all,max_all endif ! Vph - max = maxval( MGLL_V%vph_new ) - min = minval( MGLL_V%vph_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%vph_new ) + minvalue = minval( MGLL_V%vph_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' vph new min/max: ',min_all,max_all endif ! density - max = maxval( MGLL_V%rho_new ) - min = minval( MGLL_V%rho_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%rho_new ) + minvalue = minval( MGLL_V%rho_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' rho new min/max: ',min_all,max_all endif ! eta - max = maxval( MGLL_V%eta_new ) - min = minval( MGLL_V%eta_new ) - call max_all_cr(max, max_all) - call min_all_cr(min, min_all) + maxvalue = maxval( MGLL_V%eta_new ) + minvalue = minval( MGLL_V%eta_new ) + call max_all_cr(maxvalue, max_all) + call min_all_cr(minvalue, min_all) if( myrank == 0 ) then write(IMAIN,*) ' eta new min/max: ',min_all,max_all write(IMAIN,*) diff --git a/src/meshfem3D/model_ppm.f90 b/src/meshfem3D/model_ppm.f90 index 240beb230..72e9813e0 100644 --- a/src/meshfem3D/model_ppm.f90 +++ b/src/meshfem3D/model_ppm.f90 @@ -433,7 +433,7 @@ subroutine get_PPMmodel_value(lat,lon,depth,dvs) !integer i,j,k !double precision r_top,r_bottom - integer index,num_latperlon,num_lonperdepth + integer indexval,num_latperlon,num_lonperdepth dvs = 0.0 @@ -448,10 +448,10 @@ subroutine get_PPMmodel_value(lat,lon,depth,dvs) num_latperlon = PPM_num_latperlon ! int( (PPM_maxlat - PPM_minlat) / PPM_dlat) + 1 num_lonperdepth = PPM_num_lonperdepth ! int( (PPM_maxlon - PPM_minlon) / PPM_dlon ) + 1 - index = int( (depth-PPM_mindepth)/PPM_ddepth )*num_lonperdepth*num_latperlon & - + int( (lon-PPM_minlon)/PPM_dlon )*num_latperlon & - + int( (lat-PPM_minlat)/PPM_dlat ) + 1 - dvs = PPM_dvs(index) + indexval = int( (depth-PPM_mindepth)/PPM_ddepth )*num_lonperdepth*num_latperlon & + + int( (lon-PPM_minlon)/PPM_dlon )*num_latperlon & + + int( (lat-PPM_minlat)/PPM_dlat ) + 1 + dvs = PPM_dvs(indexval) ! ! loop-wise: slower performance ! do i=1,PPM_num_v diff --git a/src/meshfem3D/model_s362ani.f90 b/src/meshfem3D/model_s362ani.f90 index eabf6215f..207cd16a6 100644 --- a/src/meshfem3D/model_s362ani.f90 +++ b/src/meshfem3D/model_s362ani.f90 @@ -1839,7 +1839,7 @@ subroutine legndr(THETA,L,M,X,XP,XCOSEC) !real(kind=4) :: X(2),XP(2),XCOSEC(2) !! X, XP, XCOSEC should go from 1 to M+1 - double precision :: SMALL,SUM,COMPAR,CT,ST,FCT,COT,X1,X2,X3,F1,F2,XM,TH + double precision :: SMALL,sumval,COMPAR,CT,ST,FCT,COT,X1,X2,X3,F1,F2,XM,TH double precision, parameter :: FPI = 12.56637062D0 @@ -1851,7 +1851,7 @@ subroutine legndr(THETA,L,M,X,XP,XCOSEC) !!!!!! illegal statement, removed by Dimitri Komatitsch DFLOAT(I)=FLOAT(I) - SUM=0.D0 + sumval=0.D0 LP1=L+1 TH=THETA CT=DCOS(TH) @@ -1895,14 +1895,14 @@ subroutine legndr(THETA,L,M,X,XP,XCOSEC) X2=dble(L)*(X1-CT*X2)*FCT/ST X(1)=X3 X(2)=X2 - SUM=X3*X3 + sumval=X3*X3 XP(1)=-X2 XP(2)=dble(L*(L+1))*X3-COT*X2 X(2)=-X(2)/SFL3 XCOSEC(2)=X(2)*COSEC XP(2)=-XP(2)/SFL3 - SUM=SUM+2.D0*X(2)*X(2) - IF(SUM-COMPAR > SMALL) RETURN + sumval=sumval+2.D0*X(2)*X(2) + IF(sumval-COMPAR > SMALL) RETURN X1=X3 X2=-X2/DSQRT(dble(L*(L+1))) @@ -1912,8 +1912,8 @@ subroutine legndr(THETA,L,M,X,XP,XCOSEC) F2=DSQRT(dble((L+I-2)*(L-I+3))) XM=K X3=-(2.D0*COT*(XM-1.D0)*X2+F2*X1)/F1 - SUM=SUM+2.D0*X3*X3 - IF(SUM-COMPAR > SMALL.AND.I /= LP1) RETURN + sumval=sumval+2.D0*X3*X3 + IF(sumval-COMPAR > SMALL.AND.I /= LP1) RETURN X(I)=X3 XCOSEC(I)=X(I)*COSEC X1=X2 diff --git a/src/meshfem3D/sort_array_coordinates.f90 b/src/meshfem3D/sort_array_coordinates.f90 index 8dea051aa..302e63884 100644 --- a/src/meshfem3D/sort_array_coordinates.f90 +++ b/src/meshfem3D/sort_array_coordinates.f90 @@ -28,7 +28,7 @@ ! subroutines to sort MPI buffers to assemble between chunks subroutine sort_array_coordinates(npointot,x,y,z, & - ibool,iglob,loc,ifseg,nglob, & + ibool,iglob,locval,ifseg,nglob, & ind,ninseg,iwork,work) ! this routine MUST be in double precision to avoid sensitivity @@ -42,7 +42,7 @@ subroutine sort_array_coordinates(npointot,x,y,z, & double precision,dimension(npointot) :: x,y,z - integer,dimension(npointot) :: ibool,iglob,loc + integer,dimension(npointot) :: ibool,iglob,locval integer,dimension(npointot) :: ind,ninseg logical,dimension(npointot) :: ifseg @@ -55,7 +55,7 @@ subroutine sort_array_coordinates(npointot,x,y,z, & ! establish initial pointers do ipoin=1,npointot - loc(ipoin)=ipoin + locval(ipoin)=ipoin enddo ifseg(:)=.false. @@ -77,7 +77,7 @@ subroutine sort_array_coordinates(npointot,x,y,z, & call rank_buffers(z(ioff),ind,ninseg(iseg)) endif - call swap_all_buffers(ibool(ioff),loc(ioff), & + call swap_all_buffers(ibool(ioff),locval(ioff), & x(ioff),y(ioff),z(ioff),iwork,work,ind,ninseg(iseg)) ioff=ioff+ninseg(iseg) @@ -116,7 +116,7 @@ subroutine sort_array_coordinates(npointot,x,y,z, & ig=0 do i=1,npointot if(ifseg(i)) ig=ig+1 - iglob(loc(i))=ig + iglob(locval(i))=ig enddo nglob=ig diff --git a/src/shared/adios_helpers_definitions.f90 b/src/shared/adios_helpers_definitions.f90 index 215219b54..ec353bc82 100644 --- a/src/shared/adios_helpers_definitions.f90 +++ b/src/shared/adios_helpers_definitions.f90 @@ -1330,7 +1330,7 @@ end subroutine define_adios_global_1d_string_1d subroutine define_adios_local_1d_string_1d(adios_group, group_size_inc, & local_dim, path, array_name, var) - + implicit none ! Parameters integer(kind=8), intent(in) :: adios_group @@ -1338,7 +1338,7 @@ subroutine define_adios_local_1d_string_1d(adios_group, group_size_inc, & integer, intent(in) :: local_dim integer(kind=8), intent(inout) :: group_size_inc character(len=*), intent(in) :: var - ! Local + ! Local character(len=256) :: full_name integer(kind=8) :: var_id diff --git a/src/shared/adios_method_stubs.c b/src/shared/adios_method_stubs.c index 2402084dd..79975fc53 100644 --- a/src/shared/adios_method_stubs.c +++ b/src/shared/adios_method_stubs.c @@ -117,10 +117,10 @@ void FC_FUNC_(init_asdf_data, INIT_ASDF_DATA)(void* asdf_event, int* total_seismos_local){} void FC_FUNC_(store_asdf_data, STORE_ASDF_DATA) - (void* my_asdf, realw* seismogram_tmp, int* irec_local, int *irec, + (void* my_asdf, realw* seismogram_tmp, int* irec_local, int *irec, char* chn, int* iorientation){} -void FC_FUNC_(close_asdf_data, CLOSE_ASDF_DATA)(void *my_asdf, +void FC_FUNC_(close_asdf_data, CLOSE_ASDF_DATA)(void *my_asdf, int *total_seismos_local){} void FC_FUNC_(write_asdf, WRITE_ASDF)(void* my_asdf){} diff --git a/src/shared/asdf_helpers.f90 b/src/shared/asdf_helpers.f90 index 13b96d3a3..c8a12a27c 100644 --- a/src/shared/asdf_helpers.f90 +++ b/src/shared/asdf_helpers.f90 @@ -32,7 +32,7 @@ !! * Scalar definition !! * Global arrays definition !! -!! \author MPBL +!! \author MPBL !------------------------------------------------------------------------------- module asdf_helpers_mod use asdf_helpers_definitions_mod diff --git a/src/shared/asdf_helpers_definitions.f90 b/src/shared/asdf_helpers_definitions.f90 index 432c43aec..fb023a19e 100644 --- a/src/shared/asdf_helpers_definitions.f90 +++ b/src/shared/asdf_helpers_definitions.f90 @@ -31,7 +31,7 @@ !! * Scalar definition !! * Global arrays definition !! -!! \author MPBL +!! \author MPBL !------------------------------------------------------------------------------- module asdf_helpers_definitions_mod implicit none @@ -48,7 +48,7 @@ module asdf_helpers_definitions_mod public :: define_adios_local_string_1d_array public :: define_adios_global_array1D - ! Generic interface to define scalar variables in ADIOS + ! Generic interface to define scalar variables in ADIOS interface define_adios_scalar module procedure define_adios_double_scalar module procedure define_adios_float_scalar @@ -80,9 +80,9 @@ module asdf_helpers_definitions_mod module procedure define_adios_global_1d_string_1d end interface define_adios_global_string_1d_array - interface define_adios_local_string_1d_array - module procedure define_adios_local_1d_string_1d - end interface define_adios_local_string_1d_array + interface define_adios_local_string_1d_array + module procedure define_adios_local_1d_string_1d + end interface define_adios_local_string_1d_array ! Cannot include an interface in another interface interface define_adios_global_array1D @@ -103,13 +103,13 @@ module asdf_helpers_definitions_mod !=============================================================================== -!> Define an ADIOS scalar double precision variable and autoincrement +!> Define an ADIOS scalar double precision variable and autoincrement !! the adios group size by (8). !! \param adios_group The adios group where the variables belongs !! \param group_size_inc The inout adios group size to increment !! with the size of the variable !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param name The variable name in the ADIOS file. !! \param var The variable to be defined. Used for type inference. Can be !! ignored. @@ -134,20 +134,20 @@ subroutine define_adios_double_scalar (adios_group, group_size_inc, & ! Local Variables integer(kind=8) :: varid ! dummy variable, adios use var name - ! adios: 6 == real(kind=8) + ! adios: 6 == real(kind=8) call adios_define_var (adios_group, trim(name), trim(path), 6, "", "", "", varid) group_size_inc = group_size_inc + 8 end subroutine define_adios_double_scalar !=============================================================================== -!> Define an ADIOS scalar single precision variable and autoincrement +!> Define an ADIOS scalar single precision variable and autoincrement !! the adios group size by (8). !! \param adios_group The adios group where the variables belongs !! \param group_size_inc The inout adios group size to increment !! with the size of the variable !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param name The variable name in the ADIOS file. !! \param var The variable to be defined. Used for type inference. Can be ! ignored. @@ -165,10 +165,10 @@ subroutine define_adios_float_scalar(adios_group, group_size_inc, & ! Local Variables integer(kind=8) :: varid ! dummy variable, adios use var name - ! adios: 6 == real(kind=8) - !print *, len_trim(name) - !print *, trim(path) - !print *, len_trim(path) + ! adios: 6 == real(kind=8) + !print *, len_trim(name) + !print *, trim(path) + !print *, len_trim(path) call adios_define_var (adios_group, trim(name), trim(path), 5, "", "", "", varid) group_size_inc = group_size_inc + 4 end subroutine define_adios_float_scalar @@ -181,7 +181,7 @@ end subroutine define_adios_float_scalar !! \param group_size_inc The inout adios group size to increment !! with the size of the variable !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param name The variable name in the ADIOS file. !! \param var The variable to be defined. Used for type inference. Can be ! ignored. @@ -203,7 +203,7 @@ subroutine define_adios_integer_scalar(adios_group, group_size_inc, & !full_name = trim(path) // trim(name) - ! adios: 2 ~ integer(kind=4) + ! adios: 2 ~ integer(kind=4) !write (*,'("--- adios_define_var scalar path=",a20," name=",a20)') path, name call adios_define_var (adios_group, trim(name), trim(path), adios_integer, & "", "", "", varid) @@ -217,7 +217,7 @@ end subroutine define_adios_integer_scalar !! \param group_size_inc The inout adios group size to increment !! with the size of the variable !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param name The variable name in the ADIOS file. !! \param var The variable to be defined. Used for type inference. Can be ! ignored. @@ -235,7 +235,7 @@ subroutine define_adios_byte_scalar (adios_group, group_size_inc, & ! Local Variables integer(kind=8) :: varid ! dummy variable, adios use var name - ! adios: 0 == byte == any_data_type(kind=1) + ! adios: 0 == byte == any_data_type(kind=1) call adios_define_var (adios_group, trim(name), trim(path), 0, "", "", "", varid) group_size_inc = group_size_inc + 1 end subroutine define_adios_byte_scalar @@ -258,8 +258,8 @@ subroutine define_adios_global_dims_1d(adios_group, group_size_inc, & integer, intent(in) :: local_dim integer(kind=8), intent(inout) :: group_size_inc - !print *,"in define dims" - !print *,"array_name:", trim(array_name) + !print *,"in define dims" + !print *,"array_name:", trim(array_name) call define_adios_integer_scalar (adios_group, & group_size_inc, trim(array_name), "local_dim", local_dim) @@ -289,7 +289,7 @@ subroutine define_adios_global_1d_real_generic(adios_group, group_size_inc, & integer(kind=8), intent(inout) :: group_size_inc ! Variables integer(kind=8) :: var_id - + ! Define the dimensions of the array. local_dim used as a dummy ! variable to call the integer routine. call define_adios_global_dims_1d(adios_group, group_size_inc, array_name, & @@ -329,8 +329,8 @@ subroutine define_adios_global_1d_real_1d(adios_group, group_size_inc, & character(len=256) :: full_name full_name = trim(path) // trim(array_name) - !print *, "in define:", trim(full_name) - + !print *, "in define:", trim(full_name) + call define_adios_global_1d_real_generic(adios_group, group_size_inc, & full_name, local_dim) end subroutine define_adios_global_1d_real_1d @@ -487,7 +487,7 @@ subroutine define_adios_global_1d_double_generic(adios_group, group_size_inc, & integer(kind=8), intent(inout) :: group_size_inc ! Variables integer(kind=8) :: var_id - + ! Define the dimensions of the array. local_dim used as a dummy ! variable to call the integer routine. call define_adios_global_dims_1d(adios_group, group_size_inc, array_name, & @@ -526,7 +526,7 @@ subroutine define_adios_global_1d_double_1d(adios_group, group_size_inc, & character(len=256) :: full_name full_name = trim(path) // trim(array_name) - + call define_adios_global_1d_double_generic(adios_group, group_size_inc, & full_name, local_dim) end subroutine define_adios_global_1d_double_1d @@ -723,7 +723,7 @@ subroutine define_adios_global_1d_int_1d(adios_group, group_size_inc, & character(len=256) :: full_name full_name = trim(path) // trim(array_name) - + call define_adios_global_1d_int_generic(adios_group, group_size_inc, & full_name, local_dim) end subroutine define_adios_global_1d_int_1d @@ -880,7 +880,7 @@ subroutine define_adios_global_1d_long_generic(adios_group, group_size_inc, & integer(kind=8), intent(inout) :: group_size_inc ! Variables integer(kind=8) :: var_id - + ! Define the dimensions of the array. local_dim used as a dummy ! variable to call the integer routine. call define_adios_global_dims_1d(adios_group, group_size_inc, array_name, & @@ -919,7 +919,7 @@ subroutine define_adios_global_1d_long_1d(adios_group, group_size_inc, & character(len=256) :: full_name full_name = trim(path) // trim(array_name) - + call define_adios_global_1d_long_generic(adios_group, group_size_inc, & full_name, local_dim) end subroutine define_adios_global_1d_long_1d @@ -1075,15 +1075,15 @@ subroutine define_adios_global_1d_logical_generic(adios_group, group_size_inc, & integer(kind=8), intent(inout) :: group_size_inc ! Variables integer(kind=8) :: var_id - + ! Define the dimensions of the array. local_dim used as a dummy ! variable to call the integer routine. call define_adios_global_dims_1d(adios_group, group_size_inc, array_name, & local_dim) ! The Fortran standard does not specify how variables of LOGICAL type are - ! represented, beyond requiring that LOGICAL variables of default kind - ! have the same storage size as default INTEGER and REAL variables. + ! represented, beyond requiring that LOGICAL variables of default kind + ! have the same storage size as default INTEGER and REAL variables. ! Hence the 'adios_integer' (2) data type to store logical values call adios_define_var(adios_group, "array", array_name, 2, & trim(array_name) // "/local_dim", trim(array_name) // "/global_dim", & @@ -1118,7 +1118,7 @@ subroutine define_adios_global_1d_logical_1d(adios_group, group_size_inc, & character(len=256) :: full_name full_name = trim(path) // trim(array_name) - + call define_adios_global_1d_logical_generic(adios_group, group_size_inc, & full_name, local_dim) end subroutine define_adios_global_1d_logical_1d @@ -1267,7 +1267,7 @@ subroutine define_adios_global_1d_string_generic(adios_group, group_size_inc, & integer(kind=8), intent(inout) :: group_size_inc ! Variables integer(kind=8) :: var_id - + ! Define the dimensions of the array. local_dim used as a dummy ! variable to call the integer routine. call define_adios_global_dims_1d(adios_group, group_size_inc, array_name, & @@ -1293,33 +1293,33 @@ subroutine define_adios_global_1d_string_1d(adios_group, group_size_inc, & character(len=256) :: full_name full_name = trim(path) // trim(array_name) - print *,"full name", trim(full_name),"local_dim:",local_dim - + print *,"full name", trim(full_name),"local_dim:",local_dim + call define_adios_global_1d_string_generic(adios_group, group_size_inc, & full_name, local_dim) end subroutine define_adios_global_1d_string_1d subroutine define_adios_local_1d_string_1d(adios_group, group_size_inc, & - local_dim, path, array_name, var) - - implicit none - ! Parameters + local_dim, path, array_name, var) + + implicit none + ! Parameters integer(kind=8), intent(in) :: adios_group character(len=*), intent(in) :: path, array_name integer, intent(in) :: local_dim integer(kind=8), intent(inout) :: group_size_inc character(len=*), intent(in) :: var - ! Local - character(len=256) :: full_name - integer(kind=8) :: var_id + ! Local + character(len=256) :: full_name + integer(kind=8) :: var_id - full_name = trim(path)//trim(array_name) + full_name = trim(path)//trim(array_name) - !print *,"in define local:" - !print *,"full_name:", trim(full_name) + !print *,"in define local:" + !print *,"full_name:", trim(full_name) - call adios_define_var(adios_group, array_name, path, 9, "", "", "", var_id ) - group_size_inc = group_size_inc + 1*local_dim + call adios_define_var(adios_group, array_name, path, 9, "", "", "", var_id ) + group_size_inc = group_size_inc + 1*local_dim end subroutine define_adios_local_1d_string_1d diff --git a/src/shared/asdf_helpers_writers.f90 b/src/shared/asdf_helpers_writers.f90 index 761003d8e..c3e73a73f 100644 --- a/src/shared/asdf_helpers_writers.f90 +++ b/src/shared/asdf_helpers_writers.f90 @@ -34,7 +34,7 @@ !! \note We do not define function to write scalars variables into adios !! since it is already a single function call. !! -!! \author MPBL +!! \author MPBL !------------------------------------------------------------------------------- module asdf_helpers_writers_mod implicit none @@ -120,7 +120,7 @@ end subroutine write_1D_global_array_adios_dims !! \param local_dim The number of elements to be writen by each process. Might !! eventually be padded. !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param array_name The array name in the ADIOS file. !! \param array The array to be written subroutine write_adios_global_1d_real_1d(adios_handle, myrank, sizeprocs, & @@ -149,7 +149,7 @@ end subroutine write_adios_global_1d_real_1d !! \param local_dim The number of elements to be writen by each process. Might !! eventually be padded. !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param array_name The array name in the ADIOS file. !! \param array The array to be written subroutine write_adios_global_1d_double_1d(adios_handle, myrank, sizeprocs, & @@ -178,7 +178,7 @@ end subroutine write_adios_global_1d_double_1d !! \param local_dim The number of elements to be writen by each process. Might !! eventually be padded. !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param array_name The array name in the ADIOS file. !! \param array The array to be written subroutine write_adios_global_1d_integer_1d(adios_handle, myrank, sizeprocs, & @@ -207,7 +207,7 @@ end subroutine write_adios_global_1d_integer_1d !! \param local_dim The number of elements to be writen by each process. Might !! eventually be padded. !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param array_name The array name in the ADIOS file. !! \param array The array to be written subroutine write_adios_global_1d_long_1d(adios_handle, myrank, sizeprocs, & @@ -236,7 +236,7 @@ end subroutine write_adios_global_1d_long_1d !! \param local_dim The number of elements to be writen by each process. Might !! eventually be padded. !! \param path The logical path structuring the data and containing -!! the variable +!! the variable !! \param array_name The array name in the ADIOS file. !! \param array The array to be written subroutine write_adios_global_1d_logical_1d(adios_handle, myrank, sizeprocs, & @@ -269,8 +269,8 @@ subroutine write_adios_global_1d_string_1d(adios_handle, myrank, sizeprocs, & ! Variables integer :: adios_err - print *,"tag2:",trim(array_name) - print *,"tag2:",trim(array) + print *,"tag2:",trim(array_name) + print *,"tag2:",trim(array) call write_1D_global_array_adios_dims(adios_handle, myrank, & local_dim, global_dim, offset, sizeprocs, array_name) call adios_write(adios_handle, trim(array_name)// "/array", array(1:local_dim), adios_err) diff --git a/src/shared/force_ftz.c b/src/shared/force_ftz.c index 4cd2da309..21a58823f 100644 --- a/src/shared/force_ftz.c +++ b/src/shared/force_ftz.c @@ -47,6 +47,10 @@ /* * The FTZ bit (bit 15) in the MXCSR register must be masked (value = 1). */ /* * The underflow exception (bit 11) needs to be masked (value = 1). */ +/* This routine is not strictly necessary for SPECFEM, thus if it does not compile on your system + (since it calls some low-level system routines) just suppress all the lines below (i.e. make it an empty file) + and comment out the call to force_ftz() in the main SPECFEM program */ + #include "config.h" #define FTZ_BIT 15 diff --git a/src/shared/intgrl.f90 b/src/shared/intgrl.f90 index 461ab2c00..3a77455ba 100644 --- a/src/shared/intgrl.f90 +++ b/src/shared/intgrl.f90 @@ -25,7 +25,7 @@ ! !===================================================================== - subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3) + subroutine intgrl(sumval,r,nir,ner,f,s1,s2,s3) ! Computes the integral of f[i]*r[i]*r[i] from i=nir to i=ner for ! radii values as in model PREM_an640 @@ -35,7 +35,7 @@ subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3) ! Argument variables integer :: ner,nir double precision :: f(640),r(640),s1(640),s2(640) - double precision :: s3(640),sum + double precision :: s3(640),sumval ! Local variables double precision, parameter :: third = 1.0d0/3.0d0 @@ -56,14 +56,14 @@ subroutine intgrl(sum,r,nir,ner,f,s1,s2,s3) call deriv(f,yprime,n,r,ndis,kdis,s1,s2,s3) nir1 = nir + 1 - sum = 0.0d0 + sumval = 0.0d0 do i=nir1,ner j = i-1 rji = r(i) - r(j) s1l = s1(j) s2l = s2(j) s3l = s3(j) - sum = sum + r(j)*r(j)*rji*(f(j) & + sumval = sumval + r(j)*r(j)*rji*(f(j) & + rji*(0.5d0*s1l + rji*(third*s2l + rji*0.25d0*s3l))) & + 2.0d0*r(j)*rji*rji*(0.5d0*f(j) + rji*(third*s1l + rji*(0.25d0*s2l + rji*fifth*s3l))) & + rji*rji*rji*(third*f(j) + rji*(0.25d0*s1l + rji*(fifth*s2l + rji*sixth*s3l))) diff --git a/src/shared/parallel.f90 b/src/shared/parallel.f90 index 4224e699f..51adb9f46 100644 --- a/src/shared/parallel.f90 +++ b/src/shared/parallel.f90 @@ -336,25 +336,25 @@ end subroutine max_all_i !------------------------------------------------------------------------------------------------- ! - subroutine max_allreduce_i(buffer,count) + subroutine max_allreduce_i(buffer,countval) use mpi implicit none - integer :: count - integer,dimension(count),intent(inout) :: buffer + integer :: countval + integer,dimension(countval),intent(inout) :: buffer ! local parameters integer :: ier - integer,dimension(count) :: send + integer,dimension(countval) :: send ! seems not to be supported on all kind of MPI implementations... - !call MPI_ALLREDUCE(MPI_IN_PLACE, buffer, count, MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ier) + !call MPI_ALLREDUCE(MPI_IN_PLACE, buffer, countval, MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ier) send(:) = buffer(:) - call MPI_ALLREDUCE(send, buffer, count, MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ier) + call MPI_ALLREDUCE(send, buffer, countval, MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ier) if( ier /= 0 ) stop 'Allreduce to get max values failed.' end subroutine max_allreduce_i @@ -456,18 +456,18 @@ end subroutine bcast_all_singlei !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_i(buffer, count) + subroutine bcast_all_i(buffer, countval) use mpi implicit none - integer :: count - integer, dimension(count) :: buffer + integer :: countval + integer, dimension(countval) :: buffer integer :: ier - call MPI_BCAST(buffer,count,MPI_INTEGER,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,countval,MPI_INTEGER,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_i @@ -475,7 +475,7 @@ end subroutine bcast_all_i !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_cr(buffer, count) + subroutine bcast_all_cr(buffer, countval) use mpi use constants @@ -484,12 +484,12 @@ subroutine bcast_all_cr(buffer, count) include "precision.h" - integer :: count - real(kind=CUSTOM_REAL), dimension(count) :: buffer + integer :: countval + real(kind=CUSTOM_REAL), dimension(countval) :: buffer integer :: ier - call MPI_BCAST(buffer,count,CUSTOM_MPI_TYPE,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,countval,CUSTOM_MPI_TYPE,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_cr @@ -497,18 +497,18 @@ end subroutine bcast_all_cr !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_r(buffer, count) + subroutine bcast_all_r(buffer, countval) use mpi implicit none - integer :: count - real, dimension(count) :: buffer + integer :: countval + real, dimension(countval) :: buffer integer :: ier - call MPI_BCAST(buffer,count,MPI_REAL,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,countval,MPI_REAL,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_r @@ -535,18 +535,18 @@ end subroutine bcast_all_singler !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_dp(buffer, count) + subroutine bcast_all_dp(buffer, countval) use :: mpi implicit none - integer :: count - double precision, dimension(count) :: buffer + integer :: countval + double precision, dimension(countval) :: buffer integer :: ier - call MPI_BCAST(buffer,count,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,countval,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_dp @@ -573,18 +573,18 @@ end subroutine bcast_all_singledp !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_ch(buffer, count) + subroutine bcast_all_ch(buffer, countval) use :: mpi implicit none - integer :: count - character(len=count) :: buffer + integer :: countval + character(len=countval) :: buffer integer :: ier - call MPI_BCAST(buffer,count,MPI_CHARACTER,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,countval,MPI_CHARACTER,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_ch @@ -592,18 +592,18 @@ end subroutine bcast_all_ch !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_ch_array(buffer,ndim,count) + subroutine bcast_all_ch_array(buffer,ndim,countval) use :: mpi implicit none - integer :: count,ndim - character(len=count),dimension(ndim) :: buffer + integer :: countval,ndim + character(len=countval),dimension(ndim) :: buffer integer :: ier - call MPI_BCAST(buffer,ndim*count,MPI_CHARACTER,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,ndim*countval,MPI_CHARACTER,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_ch_array @@ -611,18 +611,18 @@ end subroutine bcast_all_ch_array !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_ch_array2(buffer,ndim1,ndim2,count) + subroutine bcast_all_ch_array2(buffer,ndim1,ndim2,countval) use :: mpi implicit none - integer :: count,ndim1,ndim2 - character(len=count),dimension(ndim1,ndim2) :: buffer + integer :: countval,ndim1,ndim2 + character(len=countval),dimension(ndim1,ndim2) :: buffer integer :: ier - call MPI_BCAST(buffer,ndim1*ndim2*count,MPI_CHARACTER,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,ndim1*ndim2*countval,MPI_CHARACTER,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_ch_array2 @@ -630,18 +630,18 @@ end subroutine bcast_all_ch_array2 !------------------------------------------------------------------------------------------------- ! - subroutine bcast_all_l(buffer, count) + subroutine bcast_all_l(buffer, countval) use :: mpi implicit none - integer :: count - logical,dimension(count) :: buffer + integer :: countval + logical,dimension(countval) :: buffer integer :: ier - call MPI_BCAST(buffer,count,MPI_LOGICAL,0,MPI_COMM_WORLD,ier) + call MPI_BCAST(buffer,countval,MPI_LOGICAL,0,MPI_COMM_WORLD,ier) end subroutine bcast_all_l @@ -1068,18 +1068,18 @@ end subroutine gatherv_all_cr - subroutine world_size(size) + subroutine world_size(sizeval) use mpi implicit none - integer,intent(out) :: size + integer,intent(out) :: sizeval ! local parameters integer :: ier - call MPI_COMM_SIZE(MPI_COMM_WORLD,size,ier) + call MPI_COMM_SIZE(MPI_COMM_WORLD,sizeval,ier) if( ier /= 0 ) stop 'error getting MPI world size' end subroutine world_size diff --git a/src/specfem3D/asdf_data.f90 b/src/specfem3D/asdf_data.f90 index 3026d1e0f..2ce4f9f0b 100644 --- a/src/specfem3D/asdf_data.f90 +++ b/src/specfem3D/asdf_data.f90 @@ -35,7 +35,7 @@ module asdf_data real, allocatable :: sample_rate(:), scale_factor(:) real, allocatable :: ev_to_sta_AZ(:), sta_to_ev_AZ(:) - real, allocatable :: great_circle_arc(:) + real, allocatable :: great_circle_arc(:) real, allocatable :: dist(:) real, allocatable :: P_pick(:), S_pick(:) diff --git a/src/specfem3D/check_stability.f90 b/src/specfem3D/check_stability.f90 index ed9190755..92c866837 100644 --- a/src/specfem3D/check_stability.f90 +++ b/src/specfem3D/check_stability.f90 @@ -62,7 +62,7 @@ subroutine check_stability() ! timer MPI double precision :: tCPU double precision, external :: wtime - double precision :: time + double precision :: timeval double precision :: t_remain,t_total integer :: ihours,iminutes,iseconds,int_tCPU, & ihours_remain,iminutes_remain,iseconds_remain,int_t_remain, & @@ -196,11 +196,11 @@ subroutine check_stability() iseconds_total = int_t_total - 3600*ihours_total - 60*iminutes_total ! current time (in seconds) - time = dble(it-1)*DT - t0 + timeval = dble(it-1)*DT - t0 ! user output write(IMAIN,*) 'Time step # ',it - write(IMAIN,*) 'Time: ',sngl((time)/60.d0),' minutes' + write(IMAIN,*) 'Time: ',sngl((timeval)/60.d0),' minutes' ! rescale maximum displacement to correct dimensions Usolidnorm_all = Usolidnorm_all * sngl(scale_displ) @@ -401,7 +401,7 @@ subroutine check_stability_backward() ! timer MPI double precision :: tCPU double precision, external :: wtime - double precision :: time + double precision :: timeval integer :: ihours,iminutes,iseconds,int_tCPU integer :: it_run,nstep_run @@ -457,11 +457,11 @@ subroutine check_stability_backward() ! no further time estimation since only partially computed solution yet... ! current time (in seconds) - time = dble(it-1)*DT - t0 + timeval = dble(it-1)*DT - t0 ! user output write(IMAIN,*) 'Time step for back propagation # ',it - write(IMAIN,*) 'Time: ',sngl((time)/60.d0),' minutes' + write(IMAIN,*) 'Time: ',sngl((timeval)/60.d0),' minutes' ! rescale maximum displacement to correct dimensions b_Usolidnorm_all = b_Usolidnorm_all * sngl(scale_displ) diff --git a/src/specfem3D/compute_forces_acoustic_calling_routine.F90 b/src/specfem3D/compute_forces_acoustic_calling_routine.F90 index 225d0fb6d..2385e1618 100644 --- a/src/specfem3D/compute_forces_acoustic_calling_routine.F90 +++ b/src/specfem3D/compute_forces_acoustic_calling_routine.F90 @@ -39,7 +39,7 @@ subroutine compute_forces_acoustic() implicit none ! local parameters - real(kind=CUSTOM_REAL) :: time + real(kind=CUSTOM_REAL) :: timeval ! non blocking MPI ! iphase: iphase = 1 is for computing outer elements in the outer_core, ! iphase = 2 is for computing inner elements in the outer core (former icall parameter) @@ -51,15 +51,15 @@ subroutine compute_forces_acoustic() ! current simulated time if(USE_LDDRK)then if(CUSTOM_REAL == SIZE_REAL) then - time = sngl((dble(it-1)*DT+dble(C_LDDRK(istage))*DT-t0)*scale_t_inv) + timeval = sngl((dble(it-1)*DT+dble(C_LDDRK(istage))*DT-t0)*scale_t_inv) else - time = (dble(it-1)*DT+dble(C_LDDRK(istage))*DT-t0)*scale_t_inv + timeval = (dble(it-1)*DT+dble(C_LDDRK(istage))*DT-t0)*scale_t_inv endif else if(CUSTOM_REAL == SIZE_REAL) then - time = sngl((dble(it-1)*DT-t0)*scale_t_inv) + timeval = sngl((dble(it-1)*DT-t0)*scale_t_inv) else - time = (dble(it-1)*DT-t0)*scale_t_inv + timeval = (dble(it-1)*DT-t0)*scale_t_inv endif endif @@ -85,7 +85,7 @@ subroutine compute_forces_acoustic() ! on CPU if( USE_DEVILLE_PRODUCTS_VAL ) then ! uses Deville et al. (2002) routine - call compute_forces_outer_core_Dev(time,deltat,two_omega_earth, & + call compute_forces_outer_core_Dev(timeval,deltat,two_omega_earth, & NSPEC_OUTER_CORE_ROTATION,NGLOB_OUTER_CORE, & A_array_rotation,B_array_rotation, & A_array_rotation_lddrk,B_array_rotation_lddrk, & @@ -93,7 +93,7 @@ subroutine compute_forces_acoustic() div_displ_outer_core,phase_is_inner) else ! div_displ_outer_core is initialized to zero in the following subroutine. - call compute_forces_outer_core(time,deltat,two_omega_earth, & + call compute_forces_outer_core(timeval,deltat,two_omega_earth, & NSPEC_OUTER_CORE_ROTATION,NGLOB_OUTER_CORE, & A_array_rotation,B_array_rotation, & A_array_rotation_lddrk,B_array_rotation_lddrk, & @@ -103,7 +103,7 @@ subroutine compute_forces_acoustic() else ! on GPU ! includes FORWARD_OR_ADJOINT == 1 - call compute_forces_outer_core_cuda(Mesh_pointer,iphase,time,1) + call compute_forces_outer_core_cuda(Mesh_pointer,iphase,timeval,1) ! initiates asynchronuous mpi transfer if( GPU_ASYNC_COPY .and. iphase == 2 ) then diff --git a/src/specfem3D/compute_forces_outer_core_Dev.F90 b/src/specfem3D/compute_forces_outer_core_Dev.F90 index c47b2d30d..0a62a09df 100644 --- a/src/specfem3D/compute_forces_outer_core_Dev.F90 +++ b/src/specfem3D/compute_forces_outer_core_Dev.F90 @@ -31,7 +31,7 @@ - subroutine compute_forces_outer_core_Dev(time,deltat,two_omega_earth, & + subroutine compute_forces_outer_core_Dev(timeval,deltat,two_omega_earth, & NSPEC,NGLOB, & A_array_rotation,B_array_rotation, & A_array_rotation_lddrk,B_array_rotation_lddrk, & @@ -66,7 +66,7 @@ subroutine compute_forces_outer_core_Dev(time,deltat,two_omega_earth, & integer :: NSPEC,NGLOB ! for the Euler scheme for rotation - real(kind=CUSTOM_REAL) time,deltat,two_omega_earth + real(kind=CUSTOM_REAL) timeval,deltat,two_omega_earth real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC) :: & A_array_rotation,B_array_rotation @@ -222,8 +222,8 @@ subroutine compute_forces_outer_core_Dev(time,deltat,two_omega_earth, & ! store the source for the Euler scheme for A_rotation and B_rotation two_omega_deltat = deltat * two_omega_earth - cos_two_omega_t = cos(two_omega_earth*time) - sin_two_omega_t = sin(two_omega_earth*time) + cos_two_omega_t = cos(two_omega_earth*timeval) + sin_two_omega_t = sin(two_omega_earth*timeval) ! time step deltat of Euler scheme is included in the source source_euler_A(INDEX_IJK) = two_omega_deltat & diff --git a/src/specfem3D/compute_forces_outer_core_noDev.f90 b/src/specfem3D/compute_forces_outer_core_noDev.f90 index 4fadfafe6..33c62892e 100644 --- a/src/specfem3D/compute_forces_outer_core_noDev.f90 +++ b/src/specfem3D/compute_forces_outer_core_noDev.f90 @@ -25,7 +25,7 @@ ! !===================================================================== - subroutine compute_forces_outer_core(time,deltat,two_omega_earth, & + subroutine compute_forces_outer_core(timeval,deltat,two_omega_earth, & NSPEC,NGLOB, & A_array_rotation,B_array_rotation, & A_array_rotation_lddrk,B_array_rotation_lddrk, & @@ -56,7 +56,7 @@ subroutine compute_forces_outer_core(time,deltat,two_omega_earth, & integer :: NSPEC,NGLOB ! for the Euler scheme for rotation - real(kind=CUSTOM_REAL) time,deltat,two_omega_earth + real(kind=CUSTOM_REAL) timeval,deltat,two_omega_earth real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC) :: & A_array_rotation,B_array_rotation @@ -163,8 +163,8 @@ subroutine compute_forces_outer_core(time,deltat,two_omega_earth, & ! store the source for the Euler scheme for A_rotation and B_rotation two_omega_deltat = deltat * two_omega_earth - cos_two_omega_t = cos(two_omega_earth*time) - sin_two_omega_t = sin(two_omega_earth*time) + cos_two_omega_t = cos(two_omega_earth*timeval) + sin_two_omega_t = sin(two_omega_earth*timeval) ! time step deltat of Euler scheme is included in the source source_euler_A(i,j,k) = two_omega_deltat & diff --git a/src/specfem3D/convert_time.f90 b/src/specfem3D/convert_time.f90 index c6eccbe15..550748422 100644 --- a/src/specfem3D/convert_time.f90 +++ b/src/specfem3D/convert_time.f90 @@ -35,7 +35,7 @@ ! extended by Dimitri Komatitsch, University of Toulouse, France, April 2011, ! to go beyond the year 2020; I extended that to the year 3000 and thus had to write a loop to fill array "year()". - subroutine convtime(timestamp,yr,mon,day,hr,min) + subroutine convtime(timestamp,yr,mon,day,hr,minvalue) ! Originally written by Shawn Smith (ssmith AT coaps.fsu.edu) ! Updated Spring 1999 for Y2K compliance by Anthony Arguez (anthony AT coaps.fsu.edu). @@ -49,7 +49,7 @@ subroutine convtime(timestamp,yr,mon,day,hr,min) integer, intent(out) :: timestamp - integer, intent(in) :: yr,mon,day,hr,min + integer, intent(in) :: yr,mon,day,hr,minvalue integer :: year(1980:MAX_YEAR),month(12),leap_mon(12) @@ -95,13 +95,13 @@ subroutine convtime(timestamp,yr,mon,day,hr,min) if (hr < 0 .or. hr > 23) stop 'Error in convtime: hour out of range (0-23)' - if (min < 0 .or. min > 60) stop 'Error in convtime: minute out of range (0-60)' + if (minvalue < 0 .or. minvalue > 60) stop 'Error in convtime: minute out of range (0-60)' ! convert time (test if leap year) if (is_leap_year(yr)) then - timestamp = year(yr)+leap_mon(mon)+((day-1)*min_day)+(hr*min_hr)+min + timestamp = year(yr)+leap_mon(mon)+((day-1)*min_day)+(hr*min_hr)+minvalue else - timestamp = year(yr)+month(mon)+((day-1)*min_day)+(hr*min_hr)+min + timestamp = year(yr)+month(mon)+((day-1)*min_day)+(hr*min_hr)+minvalue endif end subroutine convtime @@ -110,7 +110,7 @@ end subroutine convtime !---- ! - subroutine invtime(timestamp,yr,mon,day,hr,min) + subroutine invtime(timestamp,yr,mon,day,hr,minvalue) ! This subroutine will convert a minutes timestamp to a year/month ! date. Based on the function convtime by Shawn Smith (COAPS). @@ -130,7 +130,7 @@ subroutine invtime(timestamp,yr,mon,day,hr,min) integer, intent(in) :: timestamp - integer, intent(out) :: yr,mon,day,hr,min + integer, intent(out) :: yr,mon,day,hr,minvalue integer :: year(1980:MAX_YEAR),month(13),leap_mon(13) @@ -202,7 +202,7 @@ subroutine invtime(timestamp,yr,mon,day,hr,min) mon=imon day=1 hr=0 - min=0 + minvalue=0 return endif @@ -225,7 +225,7 @@ subroutine invtime(timestamp,yr,mon,day,hr,min) mon=imon day=1 hr=0 - min=0 + minvalue=0 return endif endif @@ -263,7 +263,7 @@ subroutine invtime(timestamp,yr,mon,day,hr,min) hr=ihour ! the remainder at this point is the minutes, so return them directly - min=itime + minvalue=itime end subroutine invtime diff --git a/src/specfem3D/file_io_threads.c b/src/specfem3D/file_io_threads.c index 03487b5dc..f2a8fdde7 100644 --- a/src/specfem3D/file_io_threads.c +++ b/src/specfem3D/file_io_threads.c @@ -29,7 +29,7 @@ /* --------------------------------------- -// asynchronuous file i/o +// asynchronous file i/o --------------------------------------- */ @@ -133,7 +133,7 @@ void wait_adj_io_thread() { } // checks finished flag assert(ptDataAdj.finished == true); // Adjoint thread has completed, but somehow it isn't finished? - + // reset ptDataAdj.started = false; } @@ -151,7 +151,7 @@ FC_FUNC_(prepare_adj_io_thread,CREATE_IO_ADJ_THREAD)(char *buffer, long* length, // checks if buffer valid assert(buffer != NULL); // "Adjoint thread: associated buffer is invalid" if( bytes_to_read <= 0 ) exit_error("Adjoint thread: associated buffer length is invalid"); - + // initializes thread info ptDataAdj.started = false; ptDataAdj.finished = false; @@ -185,12 +185,12 @@ FC_FUNC_(read_adj_io_thread,CREATE_IO_ADJ_THREAD)(int* it_sub_adj){ rc = pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); if( rc != 0 ) exit_error("Adjoint thread: setting thread state failed"); - + // sets new thread info ptDataAdj.started = true; ptDataAdj.finished = false; ptDataAdj.it_sub = *it_sub_adj; - + // create and launch the thread. // note: using it_sub_adj as argument (void*) it_sub_adj did not work... rc = pthread_create(&adj_io_thread,&attr,fread_adj_thread,NULL); @@ -236,9 +236,9 @@ void *fwrite_thread(void *fileID) { int fid; fid = (int)fileID; - + fwrite(ptData[fid].buffer, 1, ptData[fid].bytes_to_rw,fp_abs[fid]); - + ptData[fid].finished = true; pthread_exit(NULL); } @@ -248,9 +248,9 @@ void *fread_thread(void *fileID) { int fid; fid = (int)fileID; - + fread(ptData[fid].buffer, 1, ptData[fid].bytes_to_rw,fp_abs[fid]); - + ptData[fid].finished = true; pthread_exit(NULL); } @@ -280,7 +280,7 @@ void write_abs_ptio(int *fid, char *buffer, int *length, int *index) { pthread_attr_t attr; pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); - + ptData[*fid].started = true; ptData[*fid].finished = false; ptData[*fid].bytes_to_rw = bytes_to_write; @@ -312,7 +312,7 @@ void read_abs_ptio(int *fid, char *buffer, int *length, int *index) { pthread_attr_t attr; pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); - + ptData[*fid].started = true; ptData[*fid].finished = false; ptData[*fid].bytes_to_rw = bytes_to_read; @@ -336,7 +336,7 @@ void wait_io_thread(int *fid) { } // checks finished flag assert(ptData[*fid].finished == true && "Thread has completed, but somehow it isn't finished?"); - + // reset ptData[*fid].started = false; } diff --git a/src/specfem3D/iterate_time.F90 b/src/specfem3D/iterate_time.F90 index c33d69c5e..49b71e694 100644 --- a/src/specfem3D/iterate_time.F90 +++ b/src/specfem3D/iterate_time.F90 @@ -139,7 +139,7 @@ subroutine iterate_time() call write_seismograms() ! asdf uses adios that defines the MPI communicator group that the solver is ! run with. this means every processor in the group is needed for write_seismograms - elseif (OUTPUT_SEISMOS_ASDF) then + else if (OUTPUT_SEISMOS_ASDF) then call write_seismograms() endif diff --git a/src/specfem3D/netlib_specfun_erf.f90 b/src/specfem3D/netlib_specfun_erf.f90 index 6741c84f1..1169133c4 100644 --- a/src/specfem3D/netlib_specfun_erf.f90 +++ b/src/specfem3D/netlib_specfun_erf.f90 @@ -25,7 +25,7 @@ ! !===================================================================== - subroutine calerf(ARG,RESULT,JINT) + subroutine calerf(ARG,RESULT,jintval) !------------------------------------------------------------------ ! @@ -50,12 +50,12 @@ subroutine calerf(ARG,RESULT,JINT) ! routine. The function subprograms invoke CALERF with the ! statement ! -! call CALERF(ARG,RESULT,JINT) +! call CALERF(ARG,RESULT,jintval) ! ! where the parameter usage is as follows ! ! Function Parameters for CALERF -! call ARG Result JINT +! call ARG Result jintval ! ! ERF(ARG) ANY REAL ARGUMENT ERF(ARG) 0 ! @@ -114,7 +114,7 @@ subroutine calerf(ARG,RESULT,JINT) implicit none - integer I,JINT + integer I,jintval double precision A,ARG,B,C,D,DEL,FOUR,HALF,P,ONE,Q,RESULT,SIXTEEN,SQRPI, & TWO,THRESHOLD,X,XBIG,XDEN,XHUGE,XINF,XMAX,XNEG,XNUM,XSMALL, & Y,YSQ,ZERO @@ -183,8 +183,8 @@ subroutine calerf(ARG,RESULT,JINT) enddo RESULT = X * (XNUM + A(4)) / (XDEN + B(4)) - if (JINT /= 0) RESULT = ONE - RESULT - if (JINT == 2) RESULT = EXP(YSQ) * RESULT + if (jintval /= 0) RESULT = ONE - RESULT + if (jintval == 2) RESULT = EXP(YSQ) * RESULT goto 800 !------------------------------------------------------------------ @@ -200,7 +200,7 @@ subroutine calerf(ARG,RESULT,JINT) enddo RESULT = (XNUM + C(8)) / (XDEN + D(8)) - if (JINT /= 2) then + if (jintval /= 2) then YSQ = AINT(Y*SIXTEEN)/SIXTEEN DEL = (Y-YSQ)*(Y+YSQ) RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT @@ -212,7 +212,7 @@ subroutine calerf(ARG,RESULT,JINT) else RESULT = ZERO if (Y >= XBIG) then - if (JINT /= 2 .OR. Y >= XMAX) goto 300 + if (jintval /= 2 .OR. Y >= XMAX) goto 300 if (Y >= XHUGE) then RESULT = SQRPI / Y goto 300 @@ -229,7 +229,7 @@ subroutine calerf(ARG,RESULT,JINT) RESULT = YSQ *(XNUM + P(5)) / (XDEN + Q(5)) RESULT = (SQRPI - RESULT) / Y - if (JINT /= 2) then + if (jintval /= 2) then YSQ = AINT(Y*SIXTEEN)/SIXTEEN DEL = (Y-YSQ)*(Y+YSQ) RESULT = EXP(-YSQ*YSQ) * EXP(-DEL) * RESULT @@ -239,10 +239,10 @@ subroutine calerf(ARG,RESULT,JINT) !------------------------------------------------------------------ ! Fix up for negative argument, erf, etc. !------------------------------------------------------------------ - 300 if (JINT == 0) then + 300 if (jintval == 0) then RESULT = (HALF - RESULT) + HALF if (X < ZERO) RESULT = -RESULT - else if (JINT == 1) then + else if (jintval == 1) then if (X < ZERO) RESULT = TWO - RESULT else if (X < ZERO) then @@ -272,11 +272,11 @@ double precision function netlib_specfun_erf(X) implicit none - integer JINT + integer jintval double precision X, RESULT - JINT = 0 - call calerf(X,RESULT,JINT) + jintval = 0 + call calerf(X,RESULT,jintval) netlib_specfun_erf = RESULT end function netlib_specfun_erf diff --git a/src/specfem3D/read_adjoint_sources.f90 b/src/specfem3D/read_adjoint_sources.f90 index 484d41fe1..8ea50093a 100644 --- a/src/specfem3D/read_adjoint_sources.f90 +++ b/src/specfem3D/read_adjoint_sources.f90 @@ -69,12 +69,12 @@ subroutine read_adjoint_sources() call read_adj_io_thread(it_sub_adj) ! first chunk of adjoint sources must ready at begining, so we wait. - ! waits for previous read to finish and + ! waits for previous read to finish and ! copy over buffered data into tmp_sourcearray call sync_adj_io_thread(adj_sourcearrays) else - ! waits for previous read to finish and + ! waits for previous read to finish and ! copy over buffered data into tmp_sourcearray call sync_adj_io_thread(adj_sourcearrays) endif diff --git a/src/specfem3D/setup_sources_receivers.f90 b/src/specfem3D/setup_sources_receivers.f90 index c48f25698..db14caf26 100644 --- a/src/specfem3D/setup_sources_receivers.f90 +++ b/src/specfem3D/setup_sources_receivers.f90 @@ -336,7 +336,7 @@ subroutine setup_receivers() integer :: ier integer,dimension(:),allocatable :: tmp_rec_local_all integer :: maxrec,maxproc(1) - double precision :: size + double precision :: sizeval ! user output if( myrank == 0 ) then @@ -470,12 +470,12 @@ subroutine setup_receivers() if( myrank == 0 ) then ! note: all process allocate the full sourcearrays array ! sourcearrays(NDIM,NGLLX,NGLLY,NGLLZ,NSOURCES) - size = dble(NSOURCES) * dble(NDIM * NGLLX * NGLLY * NGLLZ * CUSTOM_REAL / 1024. / 1024. ) + sizeval = dble(NSOURCES) * dble(NDIM * NGLLX * NGLLY * NGLLZ * CUSTOM_REAL / 1024. / 1024. ) ! outputs info write(IMAIN,*) 'source arrays:' write(IMAIN,*) ' number of sources is ',NSOURCES - write(IMAIN,*) ' size of source array = ', sngl(size),'MB' - write(IMAIN,*) ' = ', sngl(size/1024.d0),'GB' + write(IMAIN,*) ' size of source array = ', sngl(sizeval),'MB' + write(IMAIN,*) ' = ', sngl(sizeval/1024.d0),'GB' write(IMAIN,*) call flush_IMAIN() endif @@ -496,17 +496,17 @@ subroutine setup_receivers() ! seismograms array size in MB if( SIMULATION_TYPE == 1 .or. SIMULATION_TYPE == 3 ) then ! seismograms need seismograms(NDIM,nrec_local,NTSTEP_BETWEEN_OUTPUT_SEISMOS) - size = dble(maxrec) * dble(NDIM * NTSTEP_BETWEEN_OUTPUT_SEISMOS * CUSTOM_REAL / 1024. / 1024. ) + sizeval = dble(maxrec) * dble(NDIM * NTSTEP_BETWEEN_OUTPUT_SEISMOS * CUSTOM_REAL / 1024. / 1024. ) else ! adjoint seismograms need seismograms(NDIM*NDIM,nrec_local,NTSTEP_BETWEEN_OUTPUT_SEISMOS) - size = dble(maxrec) * dble(NDIM * NDIM * NTSTEP_BETWEEN_OUTPUT_SEISMOS * CUSTOM_REAL / 1024. / 1024. ) + sizeval = dble(maxrec) * dble(NDIM * NDIM * NTSTEP_BETWEEN_OUTPUT_SEISMOS * CUSTOM_REAL / 1024. / 1024. ) endif ! outputs info write(IMAIN,*) 'seismograms:' write(IMAIN,*) ' writing out seismograms at every NTSTEP_BETWEEN_OUTPUT_SEISMOS = ',NTSTEP_BETWEEN_OUTPUT_SEISMOS write(IMAIN,*) ' maximum number of local receivers is ',maxrec,' in slice ',maxproc(1) - write(IMAIN,*) ' size of maximum seismogram array = ', sngl(size),'MB' - write(IMAIN,*) ' = ', sngl(size/1024.d0),'GB' + write(IMAIN,*) ' size of maximum seismogram array = ', sngl(sizeval),'MB' + write(IMAIN,*) ' = ', sngl(sizeval/1024.d0),'GB' write(IMAIN,*) call flush_IMAIN() endif @@ -532,9 +532,9 @@ subroutine setup_receivers() !enddo ! adj_sourcearrays size in MB ! adj_sourcearrays(NDIM,NGLLX,NGLLY,NGLLZ,nadj_rec_local,NTSTEP_BETWEEN_READ_ADJSRC) - size = dble(maxrec) * dble(NDIM * NGLLX * NGLLY * NGLLZ * NTSTEP_BETWEEN_READ_ADJSRC * CUSTOM_REAL / 1024. / 1024. ) - ! note: in case IO_ASYNC_COPY is set, and depending of NSTEP_SUB_ADJ, - ! this memory requirement might double. + sizeval = dble(maxrec) * dble(NDIM * NGLLX * NGLLY * NGLLZ * NTSTEP_BETWEEN_READ_ADJSRC * CUSTOM_REAL / 1024. / 1024. ) + ! note: in case IO_ASYNC_COPY is set, and depending of NSTEP_SUB_ADJ, + ! this memory requirement might double. ! at this point, NSTEP_SUB_ADJ is not set yet... ! outputs info write(IMAIN,*) 'adjoint source arrays:' @@ -543,8 +543,8 @@ subroutine setup_receivers() write(IMAIN,*) ' using asynchronuous buffer for file i/o of adjoint sources' endif write(IMAIN,*) ' maximum number of local adjoint sources is ',maxrec,' in slice ',maxproc(1) - write(IMAIN,*) ' size of maximum adjoint source array = ', sngl(size),'MB' - write(IMAIN,*) ' = ', sngl(size/1024.d0),'GB' + write(IMAIN,*) ' size of maximum adjoint source array = ', sngl(sizeval),'MB' + write(IMAIN,*) ' = ', sngl(sizeval/1024.d0),'GB' write(IMAIN,*) call flush_IMAIN() endif diff --git a/src/specfem3D/write_output_ASCII.f90 b/src/specfem3D/write_output_ASCII.f90 index 53c43110c..1c71d2498 100644 --- a/src/specfem3D/write_output_ASCII.f90 +++ b/src/specfem3D/write_output_ASCII.f90 @@ -53,7 +53,7 @@ subroutine write_output_ASCII(seismogram_tmp,iorientation,sisname,sisname_big_fi integer :: it integer :: ier,isample double precision :: value - double precision :: time + double precision :: timeval character(len=256) :: sisname_2 ! add .ascii extension to seismogram file name for ASCII seismograms @@ -91,25 +91,25 @@ subroutine write_output_ASCII(seismogram_tmp,iorientation,sisname,sisname_big_fi ! current time if( SIMULATION_TYPE == 3 ) then - time = dble(NSTEP-it)*DT - t0 + timeval = dble(NSTEP-it)*DT - t0 else - time = dble(it-1)*DT - t0 + timeval = dble(it-1)*DT - t0 endif ! writes out to file if(SAVE_ALL_SEISMOS_IN_ONE_FILE .and. USE_BINARY_FOR_LARGE_FILE) then ! distinguish between single and double precision for reals if(CUSTOM_REAL == SIZE_REAL) then - write(IOUT) sngl(time),sngl(value) + write(IOUT) sngl(timeval),sngl(value) else - write(IOUT) time,value + write(IOUT) timeval,value endif else ! distinguish between single and double precision for reals if(CUSTOM_REAL == SIZE_REAL) then - write(IOUT,*) sngl(time),' ',sngl(value) + write(IOUT,*) sngl(timeval),' ',sngl(value) else - write(IOUT,*) time,' ',value + write(IOUT,*) timeval,' ',value endif endif enddo diff --git a/src/specfem3D/write_output_ASDF.F90 b/src/specfem3D/write_output_ASDF.F90 index 6fb58bf97..5ac1bd402 100644 --- a/src/specfem3D/write_output_ASDF.F90 +++ b/src/specfem3D/write_output_ASDF.F90 @@ -1,6 +1,6 @@ !------------------------------------------------------------------------------- !> \file write_output_ASDF.F90 -!! \brief Write subroutines for writing ASDF seismograms to file using +!! \brief Write subroutines for writing ASDF seismograms to file using !! the ADIOS library !! \author JAS and Wenjie Lei !------------------------------------------------------------------------------ @@ -115,8 +115,9 @@ subroutine store_asdf_data(asdf_container, seismogram_tmp, irec_local, & event_name=>event_name_SAC,cmt_lat=>cmt_lat_SAC,cmt_lon=>cmt_lon_SAC,& cmt_depth=>cmt_depth_SAC,cmt_hdur=>cmt_hdur_SAC + use constants + implicit none - include "constants.h" ! Parameters character(len=4),intent(in) :: chn @@ -145,7 +146,7 @@ subroutine store_asdf_data(asdf_container, seismogram_tmp, irec_local, & asdf_container%receiver_lo(i) = stlon(irec_local) asdf_container%receiver_el(i) = stele(irec_local) asdf_container%receiver_dpt(i) = stbur(irec_local) - asdf_container%begin_value(i) = seismo_offset*DT-t0+tshift_cmt + asdf_container%begin_value(i) = seismo_offset*DT-t0+tshift_cmt asdf_container%end_value(i) = -12345 ! instrument orientation if(iorientation == 1) then !N @@ -254,7 +255,7 @@ subroutine close_asdf_data(asdf_container, total_seismos_local) do i = 1, total_seismos_local deallocate(asdf_container%records(i)%record, STAT=ierr) if (ierr /= 0) call exit_MPI_without_rank('Deallocate failed.') - enddo + enddo deallocate (asdf_container%receiver_name_array, STAT=ierr) if (ierr /= 0) call exit_MPI_without_rank('Deallocate failed.') deallocate (asdf_container%network_array, STAT=ierr) @@ -288,7 +289,7 @@ subroutine write_asdf(asdf_container) ! declare new group that uses MPI call adios_declare_group (adios_group, "EVENTS", "iter", 1, adios_err) call adios_select_method (adios_group, "MPI", "", "", adios_err) - + ASDF_FN="OUTPUT_FILES/"//trim(event_name_SAC)//"_sem.bp" call write_asdf_data (ASDF_FN, asdf_container, adios_group, myrank, & sizeprocs, comm, ierr) @@ -482,15 +483,15 @@ subroutine define_asdf_data (adios_group, my_group_size, asdf_container, & enddo !define attribute - call adios_define_attribute ( adios_group , "nreceivers", "desc", & + call adios_define_attribute ( adios_group , "nreceivers", "desc", & adios_string, "Number of receivers ", "" , adios_err ) - call adios_define_attribute ( adios_group , "nrecords", "desc", & + call adios_define_attribute ( adios_group , "nrecords", "desc", & adios_string, "Number of records ", "" , adios_err ) - call adios_define_attribute ( adios_group , "min_period", "desc", & - adios_string, "Low pass filter in Hz (0 if none applied) ", "", & + call adios_define_attribute ( adios_group , "min_period", "desc", & + adios_string, "Low pass filter in Hz (0 if none applied) ", "", & adios_err) - call adios_define_attribute ( adios_group , "max_period", "desc", & - adios_string, "High pass filter in Hz (0 if none applied) ", "" , & + call adios_define_attribute ( adios_group , "max_period", "desc", & + adios_string, "High pass filter in Hz (0 if none applied) ", "" , & adios_err ) call adios_define_attribute (adios_group , "event_lat", "desc",adios_string, & "Event CMT latitude (degrees, north positive) ",& @@ -578,7 +579,7 @@ subroutine define_asdf_data (adios_group, my_group_size, asdf_container, & adios_string, "Receiver number ", "", adios_err) call adios_define_attribute (adios_group , "component", "desc", adios_string,& "Receiver component name ", "" , adios_err ) - + end subroutine define_asdf_data @@ -656,7 +657,7 @@ subroutine write_asdf_data_sub (asdf_container, adios_handle, rank, & rank, nproc, comm, ierr) call gather_string_total_length(component_len, comp_len_total,& rank, nproc, comm, ierr) - if (rank .eq. 0) then + if (rank == 0) then allocate(character(len=rn_len_total) :: receiver_name_total, STAT=ierr) if (ierr /= 0) call exit_MPI (rank, 'Allocate failed.') allocate(character(len=nw_len_total) :: network_total, STAT=ierr) @@ -669,21 +670,21 @@ subroutine write_asdf_data_sub (asdf_container, adios_handle, rank, & call synchronize_all() !write all local strings into global string - call gather_string_offset_info(receiver_name_len, rn_len_total,rn_offset, & - receiver_name, receiver_name_total, & + call gather_string_offset_info(receiver_name_len, rn_len_total,rn_offset, & + receiver_name, receiver_name_total, & rank, nproc, comm, ierr) - call gather_string_offset_info(network_len, nw_len_total, nw_offset, & - network, network_total, & + call gather_string_offset_info(network_len, nw_len_total, nw_offset, & + network, network_total, & rank, nproc, comm, ierr) - call gather_string_offset_info(component_len, comp_len_total, comp_offset, & - component, component_total, & + call gather_string_offset_info(component_len, comp_len_total, comp_offset, & + component, component_total, & rank, nproc, comm, ierr) - call gather_string_offset_info(receiver_id_len, rid_len_total,rid_offset, & - receiver_id, receiver_id_total, & + call gather_string_offset_info(receiver_id_len, rid_len_total,rid_offset, & + receiver_id, receiver_id_total, & rank, nproc, comm, ierr) !========================== !write out the string info - if(rank.eq.0)then + if(rank==0)then call adios_write(adios_handle, "receiver_name", trim(receiver_name_total), & adios_err) call adios_write(adios_handle, "network", trim(network_total), adios_err) @@ -711,7 +712,7 @@ subroutine write_asdf_data_sub (asdf_container, adios_handle, rank, & !=========================== !scalar - if(rank.eq.0)then + if(rank==0)then call adios_write(adios_handle, "nrecords", nrecords_total, adios_err) call adios_write(adios_handle, "receiver_name_len", rn_len_total, adios_err) call adios_write(adios_handle, "network_len", nw_len_total, adios_err) @@ -725,85 +726,85 @@ subroutine write_asdf_data_sub (asdf_container, adios_handle, rank, & !=========================== !write out the array - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "npoints", asdf_container%npoints) - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "gmt_year", asdf_container%gmt_year) - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "gmt_day", asdf_container%gmt_day) - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "gmt_hour", asdf_container%gmt_hour) - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "gmt_min", asdf_container%gmt_min) - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "gmt_sec", asdf_container%gmt_sec) - call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_integer_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "gmt_msec", asdf_container%gmt_msec) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "event_lat", asdf_container%event_lat) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "event_lo", asdf_container%event_lo) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "event_dpt", asdf_container%event_dpt) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "receiver_lat", asdf_container%receiver_lat) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "receiver_lo", asdf_container%receiver_lo) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "receiver_el", asdf_container%receiver_el) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "receiver_dpt", asdf_container%receiver_dpt) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "begin_value", asdf_container%begin_value) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "end_value", asdf_container%end_value) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "cmp_azimuth", asdf_container%cmp_azimuth) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & - nrecords_total, offset, "cmp_incident_ang", & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & + nrecords_total, offset, "cmp_incident_ang", & asdf_container%cmp_incident_ang) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "sample_rate", asdf_container%sample_rate) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "scale_factor", asdf_container%scale_factor) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "ev_to_sta_AZ", asdf_container%ev_to_sta_AZ) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "sta_to_ev_AZ", asdf_container%sta_to_ev_AZ) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & - nrecords_total, offset, "great_circle_arc", & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & + nrecords_total, offset, "great_circle_arc", & asdf_container%great_circle_arc) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "dist", asdf_container%dist) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "P_pick", asdf_container%P_pick) - call write_adios_global_real_1d_array(adios_handle, rank, nproc, & - asdf_container%nrecords, & + call write_adios_global_real_1d_array(adios_handle, rank, nproc, & + asdf_container%nrecords, & nrecords_total, offset, "S_pick", asdf_container%S_pick) deallocate(receiver_name, STAT=ierr) @@ -843,12 +844,12 @@ subroutine gather_offset_info(local_dim, global_dim, offset,& if (ierr /= 0) call exit_MPI (rank, 'Allocate failed.') allocate(offset_proc(nproc), STAT=ierr) if (ierr /= 0) call exit_MPI (rank, 'Allocate failed.') - + call synchronize_all() call MPI_Gather(local_dim, 1, MPI_INTEGER, dim_all_proc, 1, & MPI_INTEGER, 0, comm, ierr) - if(rank.eq.0)then + if(rank==0)then offset_proc(1)=0 do i=2, nproc offset_proc(i)=sum(dim_all_proc(1:(i-1))) @@ -887,7 +888,7 @@ subroutine gather_string_total_length(local_dim, global_dim,& integer, allocatable :: local_dim_all_proc(:) - if(rank.eq.0)then + if(rank==0)then allocate(local_dim_all_proc(nproc),STAT=ierr) if (ierr /= 0) call exit_MPI (rank, 'Allocate failed.') endif @@ -896,7 +897,7 @@ subroutine gather_string_total_length(local_dim, global_dim,& call MPI_Gather(local_dim, 1, MPI_INTEGER, local_dim_all_proc, 1, & MPI_INTEGER, 0, comm, ierr) call synchronize_all() - if(rank.eq.0)then + if(rank==0)then global_dim=sum(local_dim_all_proc(1:nproc)) deallocate(local_dim_all_proc,STAT=ierr) if (ierr /= 0) call exit_MPI (rank, 'Deallocate failed.') @@ -915,8 +916,8 @@ end subroutine gather_string_total_length !! \param nproc The number of processors !! \param comm The communication group of processors !! \param ierr The error -subroutine gather_string_offset_info(local_dim, global_dim, offset, & - string_piece, string_total, & +subroutine gather_string_offset_info(local_dim, global_dim, offset, & + string_piece, string_total, & rank, nproc, comm, ierr) use mpi implicit none @@ -931,7 +932,7 @@ subroutine gather_string_offset_info(local_dim, global_dim, offset, & integer, allocatable :: offset_all_proc(:) integer :: i, mpi_status(MPI_STATUS_SIZE) - if(rank.eq.0)then + if(rank==0)then allocate(local_dim_all_proc(nproc),STAT=ierr) if (ierr /= 0) call exit_MPI (rank, 'Allocate failed.') allocate(offset_all_proc(nproc),STAT=ierr) @@ -943,7 +944,7 @@ subroutine gather_string_offset_info(local_dim, global_dim, offset, & MPI_INTEGER, 0, comm, ierr) call synchronize_all() - if(rank.eq.0)then + if(rank==0)then offset_all_proc(1)=0 do i=2, nproc offset_all_proc(i)=sum(local_dim_all_proc(1:(i-1))) @@ -952,9 +953,9 @@ subroutine gather_string_offset_info(local_dim, global_dim, offset, & buffer_string='' string_total=trim(string_total)//trim(string_piece(1:local_dim)) endif - + call synchronize_all() - if(rank.eq.0)then + if(rank==0)then offset_all_proc(1)=0 do i=2, nproc offset_all_proc(i)=sum(local_dim_all_proc(1:(i-1))) @@ -963,8 +964,8 @@ subroutine gather_string_offset_info(local_dim, global_dim, offset, & buffer_string='' string_total=trim(string_total)//trim(string_piece(1:local_dim)) endif - - if(rank.eq.0)then + + if(rank==0)then do i=1,nproc-1 call MPI_Recv(buffer_string, local_dim_all_proc(i+1),MPI_CHARACTER,& i, 1, comm, mpi_status,ierr) @@ -980,7 +981,7 @@ subroutine gather_string_offset_info(local_dim, global_dim, offset, & 1, MPI_INTEGER, 0, comm, ierr) call MPI_Bcast(global_dim, 1, MPI_INTEGER, 0, comm, ierr) - if (rank.eq.0) then + if (rank==0) then deallocate(local_dim_all_proc,STAT=ierr) if (ierr /= 0) call exit_MPI (rank, 'Deallocate failed.') deallocate(offset_all_proc,STAT=ierr) diff --git a/src/specfem3D/write_seismograms.f90 b/src/specfem3D/write_seismograms.f90 index 461c91cec..9c42d01b7 100644 --- a/src/specfem3D/write_seismograms.f90 +++ b/src/specfem3D/write_seismograms.f90 @@ -25,7 +25,7 @@ ! !===================================================================== -module write_seismograms_mod +module write_seismograms_mod contains @@ -641,4 +641,4 @@ subroutine band_instrument_code(DT,bic) end subroutine band_instrument_code -end module write_seismograms_mod +end module write_seismograms_mod