diff --git a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_mesher.txt b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_mesher.txt index ffe47a0f5..b6f23a9ca 100644 --- a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_mesher.txt +++ b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_mesher.txt @@ -1,28 +1,28 @@ - + **************************** *** Specfem3D MPI Mesher *** **************************** - - + + There are 24 MPI processes Processes are numbered from 0 to 23 - + There are 48 elements along xi in each chunk There are 48 elements along eta in each chunk - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks in the global mesh There is a total of 24 slices in the global mesh - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + Shape functions defined by NGNOD = 27 control nodes Surface shape functions defined by NGNOD2D = 9 control nodes - + model: 1D_transversely_isotropic_prem no oceans no ellipticity @@ -30,7 +30,7 @@ no self-gravitation no rotation no attenuation - + no 3-D lateral variations no heterogeneities in the mantle no crustal variations @@ -38,49 +38,49 @@ incorporating anisotropy no inner-core anisotropy no general mantle anisotropy - + Reference radius of the Earth used is 6371. km - + Central cube is at a radius of 950. km creating global slice addressing - + Spatial distribution of the slices 3 1 2 0 - + 11 9 7 5 19 17 10 8 6 4 18 16 - + 23 21 22 20 - + 15 13 14 12 - - + + additional mesh optimizations - + moho: no element stretching for 3-D moho surface - + internal topography 410/660: no element stretching for 3-D internal surfaces - - - + + + ******************************************* creating mesh in region 1 this region is the crust and mantle ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 11 9.1% current clock (NOT elapsed) time is: 16h 18min 17sec creating layer 2 out of 11 @@ -103,19 +103,19 @@ 90.9% current clock (NOT elapsed) time is: 16h 18min 17sec creating layer 11 out of 11 100.0% current clock (NOT elapsed) time is: 16h 18min 17sec - - + + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 11 9.1% current clock (NOT elapsed) time is: 16h 18min 18sec creating layer 2 out of 11 @@ -138,22 +138,22 @@ 90.9% current clock (NOT elapsed) time is: 16h 18min 19sec creating layer 11 out of 11 100.0% current clock (NOT elapsed) time is: 16h 18min 19sec - - + + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + There is a total of 24 messages to assemble faces between chunks - + Generating message 1 for faces out of 24 Generating message 2 for faces out of 24 Generating message 3 for faces out of 24 @@ -178,9 +178,9 @@ Generating message 22 for faces out of 24 Generating message 23 for faces out of 24 Generating message 24 for faces out of 24 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -189,97 +189,97 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + crust/mantle region: #max of points in MPI buffers along xi npoin2D_xi = 5449 #max of array elements transferred npoin2D_xi*NDIM = 16347 - + #max of points in MPI buffers along eta npoin2D_eta = 5449 #max of array elements transferred npoin2D_eta*NDIM = 16347 - + crust mantle MPI: maximum interfaces: 7 MPI addressing maximum interfaces: 7 MPI addressing : all interfaces okay - + total MPI interface points : 530952 unique MPI interface points: 512640 maximum valence : 3 total unique MPI interface points: 512640 - - - ...element inner/outer separation - + + + ...element inner/outer separation + for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 26.831274 % percentage of volume elements in crust/mantle 73.1687241 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 12.566370579194894 exact area: 12.566370614359172 calculated bottom area: 3.7493225048710057 exact area: 3.7493254667646689 - + ******************************************* creating mesh in region 2 this region is the outer core ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 2 50.0% current clock (NOT elapsed) time is: 16h 18min 20sec creating layer 2 out of 2 100.0% current clock (NOT elapsed) time is: 16h 18min 20sec - - + + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 2 50.0% current clock (NOT elapsed) time is: 16h 18min 20sec creating layer 2 out of 2 100.0% current clock (NOT elapsed) time is: 16h 18min 20sec - - + + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + There is a total of 24 messages to assemble faces between chunks - + Generating message 1 for faces out of 24 Generating message 2 for faces out of 24 Generating message 3 for faces out of 24 @@ -304,9 +304,9 @@ Generating message 22 for faces out of 24 Generating message 23 for faces out of 24 Generating message 24 for faces out of 24 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -315,92 +315,92 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + outer core region: #max of points in MPI buffers along xi npoin2D_xi = 1337 #max of array elements transferred npoin2D_xi*NDIM = 4011 - + #max of points in MPI buffers along eta npoin2D_eta = 1385 #max of array elements transferred npoin2D_eta*NDIM = 4155 - + outer core MPI: maximum interfaces: 7 MPI addressing maximum interfaces: 7 MPI addressing : all interfaces okay - + total MPI interface points : 132072 unique MPI interface points: 120384 maximum valence : 3 total assembled MPI interface points: 120384 - - - ...element inner/outer separation + + + ...element inner/outer separation percentage of edge elements in outer core 63.5658875 % percentage of volume elements in outer core 36.4341125 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 3.7493225048710057 exact area: 3.7493254667646689 calculated bottom area: 0.46155180134655271 exact area: 0.46155768002682868 - + ******************************************* creating mesh in region 3 this region is the inner core ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 1 100.0% current clock (NOT elapsed) time is: 16h 18min 22sec - + creating central cube - + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 1 100.0% current clock (NOT elapsed) time is: 16h 18min 22sec - + creating central cube - + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + There is a total of 24 messages to assemble faces between chunks - + Generating message 1 for faces out of 24 Generating message 2 for faces out of 24 Generating message 3 for faces out of 24 @@ -425,9 +425,9 @@ Generating message 22 for faces out of 24 Generating message 23 for faces out of 24 Generating message 24 for faces out of 24 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -436,87 +436,87 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + inner core region: #max of points in MPI buffers along xi npoin2D_xi = 429 #max of array elements transferred npoin2D_xi*NDIM = 1287 - + #max of points in MPI buffers along eta npoin2D_eta = 429 #max of array elements transferred npoin2D_eta*NDIM = 1287 - - + + including central cube - + inner core MPI: inner core with central cube MPI: maximum interfaces: 15 MPI addressing maximum interfaces: 15 MPI addressing : all interfaces okay - + total MPI interface points : 21864 unique MPI interface points: 17880 maximum valence : 7 total assembled MPI interface points: 17880 - - - ...element inner/outer separation + + + ...element inner/outer separation percentage of edge elements in inner core 56.9444427 % percentage of volume elements in inner core 43.0555573 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 0.46155180134655271 exact area: 0.46155768002682868 calculated bottom area: 0.21169690506049865 more or less similar area (central cube): 0.17787790385168642 - + calculated volume: 4.1887901261443377 exact volume: 4.1887902047863905 - + computed total Earth mass for this density model and mesh: 5.97553703266215937E+24 kg (should be not too far from 5.974E+24 kg) - + average density for this density model and mesh: 5516.5241764240236 kg/m3 (should be not too far from 5514 kg/m3) - - position of the center of mass of the Earth for this density model and mesh: + + position of the center of mass of the Earth for this density model and mesh: x = -0.60622063369426571 km y = -0.43310399187886112 km z = -0.5200786374770423 km distance to center = 0.90860569757076592 km - - + + Repartition of elements in regions: ---------------------------------- - + total number of elements in each slice: 5319 - + - crust and mantle: 91.3705597 % - outer core: 7.27580357 % - inner core: 1.35363793 % - + for some mesh statistics, see comments in file OUTPUT_FILES/values_from_mesher.h - + Load balancing = 100 % by definition - - + + the time step of the solver will be DT = 0.189999998 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - - + + Elapsed time for mesh generation and buffer creation in seconds = 4.7216651439666748 Elapsed time for mesh generation and buffer creation in hh:mm:ss = 0 h 00 m 04 s - + End of mesh generation - + diff --git a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.kernel.txt b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.kernel.txt index e176cee51..486bf7ae2 100644 --- a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.kernel.txt +++ b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.kernel.txt @@ -1,33 +1,33 @@ - + ****************************** **** Specfem3D MPI Solver **** ****************************** - - + + Fixing slow underflow trapping problem using small initial field - + There are 24 MPI processes Processes are numbered from 0 to 23 - + There are 48 elements along xi in each chunk There are 48 elements along eta in each chunk - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + NDIM = 3 - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - + model: 1D_transversely_isotropic_prem no oceans no ellipticity @@ -35,7 +35,7 @@ no self-gravitation no rotation no attenuation - + no 3-D lateral variations no heterogeneities in the mantle no crustal variations @@ -43,8 +43,8 @@ incorporating transverse isotropy no inner-core anisotropy no general mantle anisotropy - - + + mesh databases: reading in crust/mantle databases... reading in outer core databases... @@ -54,161 +54,161 @@ Spatial distribution of the slices 3 1 2 0 - + 11 9 7 5 19 17 10 8 6 4 18 16 - + 23 21 22 20 - + 15 13 14 12 - + reading in MPI databases... for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 26.8312759 % percentage of volume elements in crust/mantle 73.1687241 % - + percentage of edge elements in outer core 63.5658913 % percentage of volume elements in outer core 36.4341087 % - + percentage of edge elements in inner core 56.9444466 % percentage of volume elements in inner core 43.0555534 % - - + + Elapsed time for reading mesh in seconds = 2.29643583 - - + + sources: - + ************************************* locating source 1 ************************************* - + source located in slice 4 in element 3090 - + xi coordinate of source in that element: -0.91500744121227218 eta coordinate of source in that element: 0.86669995081172757 gamma coordinate of source in that element: -0.34571178817636433 - + half duration: 20. seconds time shift: 0. seconds - + magnitude of the source: scalar moment M0 = 2.62997300366372602E+28 dyne-cm moment magnitude Mw = 8.2466343844251071 - - + + original (requested) position of the source: - + latitude: -13.82 longitude: -67.25 depth: 647.10000000000002 km - + position of the source that will be used: - + latitude: -13.820000000000006 longitude: -67.249999999999986 depth: 647.09999999999911 km - + Error in location of the source: 5.001529789E-13 km - + maximum error in location of the sources: 5.001529789E-13 km - - + + Elapsed time for detection of sources in seconds = 6.14500045776367187E-3 - + End of source detection - done - - + + receivers: - + Total number of receivers = 1 - - + + ******************** locating receivers ******************** - + reading receiver information... - + Stations sorted by epicentral distance: Station # 1: IU.ANMO epicentral distance: 61.119137 degrees - + maximum error in location of all the receivers: 1.59147695E-12 km - + Elapsed time for receiver detection in seconds = 2.46348381042480469E-2 - + End of receiver detection - done - - + + 3 adjoint component traces found in all slices - + found a total of 1 receivers in all slices this total is okay - + source arrays: number of sources is 1 size of source array = 1.430511475E-3 MB = 1.396983862E-6 GB - + seismograms: seismograms written by all processes writing out seismograms at every NTSTEP_BETWEEN_OUTPUT_SEISMOS = 5000 maximum number of local receivers is 1 in slice 8 size of maximum seismogram array = 5.722045898E-2 MB = 5.587935448E-5 GB - + adjoint source arrays: reading adjoint sources at every NTSTEP_BETWEEN_READ_ADJSRC = 5000 using asynchronous buffer for file I/O of adjoint sources maximum number of local adjoint sources is 1 in slice 8 size of maximum adjoint source array = 7.15255737 MB = 6.98491931E-3 GB - - + + Total number of samples for seismograms = 5000 - - + + Reference radius of the Earth used is 6371. km - - + + no oceans - + no ellipticity - + no surface topography - + no self-gravitation - + no rotation - + no attenuation - - - + + + preparing mass matrices preparing constants preparing gravity arrays preparing wavefields - + Elapsed time for preparing timerun in seconds = 7.926797867E-2 - - + + time loop: - + scheme: Newmark time step: 0.189999998 s number of time steps: 5000 total simulated time: 15.3301668 minutes start time : -30. seconds - + All processes are synchronized before time loop - + Starting time iteration loop... - + Time step # 5 Time: -0.487333328 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 0. @@ -232,7 +232,7 @@ **** BEWARE: the above time estimates are not reliable **** because fewer than 100 iterations have been performed ************************************************************ - + Time step # 1000 Time: 2.66350007 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 0. @@ -252,7 +252,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 21 s We have done 20. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:13 - + Time step # 2000 Time: 5.83016682 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 35591.5625 @@ -272,7 +272,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 15 s We have done 40. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:13 - + Time step # 3000 Time: 8.9968338 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 1380.02905 @@ -292,7 +292,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 13 s We have done 60. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:13 - + Time step # 4000 Time: 12.1634998 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 899.361694 @@ -312,7 +312,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 13 s We have done 80. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:13 - + Time step # 5000 Time: 15.3301668 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 805.966492 @@ -331,15 +331,15 @@ Estimated total run time in seconds = 612.35191988945007 Estimated total run time in hh:mm:ss = 0 h 10 m 12 s We have done 100. % of that - - + + Total number of time steps written: 5000 - + Writing the seismograms in parallel took 3.22659015655517578E-2 seconds - + Time-Loop Complete. Timing info: Total elapsed time in seconds = 612.50991606712341 Total elapsed time in hh:mm:ss = 0 h 10 m 12 s - + End of the simulation - + diff --git a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.txt b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.txt index fdee3fc62..52bbdfe57 100644 --- a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.txt +++ b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/output_solver.txt @@ -1,33 +1,33 @@ - + ****************************** **** Specfem3D MPI Solver **** ****************************** - - + + Fixing slow underflow trapping problem using small initial field - + There are 24 MPI processes Processes are numbered from 0 to 23 - + There are 48 elements along xi in each chunk There are 48 elements along eta in each chunk - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + NDIM = 3 - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - + model: 1D_transversely_isotropic_prem no oceans no ellipticity @@ -35,7 +35,7 @@ no self-gravitation no rotation no attenuation - + no 3-D lateral variations no heterogeneities in the mantle no crustal variations @@ -43,8 +43,8 @@ incorporating transverse isotropy no inner-core anisotropy no general mantle anisotropy - - + + mesh databases: reading in crust/mantle databases... reading in outer core databases... @@ -54,152 +54,152 @@ Spatial distribution of the slices 3 1 2 0 - + 11 9 7 5 19 17 10 8 6 4 18 16 - + 23 21 22 20 - + 15 13 14 12 - + reading in MPI databases... for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 26.8312759 % percentage of volume elements in crust/mantle 73.1687241 % - + percentage of edge elements in outer core 63.5658913 % percentage of volume elements in outer core 36.4341087 % - + percentage of edge elements in inner core 56.9444466 % percentage of volume elements in inner core 43.0555534 % - - + + Elapsed time for reading mesh in seconds = 8.96540833 - - + + sources: - + ************************************* locating source 1 ************************************* - + source located in slice 4 in element 3090 - + xi coordinate of source in that element: -0.91500744121227218 eta coordinate of source in that element: 0.86669995081172757 gamma coordinate of source in that element: -0.34571178817636433 - + half duration: 20. seconds time shift: 0. seconds - + magnitude of the source: scalar moment M0 = 2.62997300366372602E+28 dyne-cm moment magnitude Mw = 8.2466343844251071 - - + + original (requested) position of the source: - + latitude: -13.82 longitude: -67.25 depth: 647.10000000000002 km - + position of the source that will be used: - + latitude: -13.820000000000006 longitude: -67.249999999999986 depth: 647.09999999999911 km - + Error in location of the source: 5.001529789E-13 km - + maximum error in location of the sources: 5.001529789E-13 km - - + + Elapsed time for detection of sources in seconds = 4.53710556030273437E-3 - + End of source detection - done - - + + receivers: - + Total number of receivers = 1 - - + + ******************** locating receivers ******************** - + reading receiver information... - + Stations sorted by epicentral distance: Station # 1: IU.ANMO epicentral distance: 61.119137 degrees - + maximum error in location of all the receivers: 1.59147695E-12 km - + Elapsed time for receiver detection in seconds = 1.0546739101409912 - + End of receiver detection - done - - + + found a total of 1 receivers in all slices this total is okay - + source arrays: number of sources is 1 size of source array = 1.430511475E-3 MB = 1.396983862E-6 GB - + seismograms: seismograms written by all processes writing out seismograms at every NTSTEP_BETWEEN_OUTPUT_SEISMOS = 5000 maximum number of local receivers is 1 in slice 8 size of maximum seismogram array = 5.722045898E-2 MB = 5.587935448E-5 GB - - + + Total number of samples for seismograms = 5000 - - + + Reference radius of the Earth used is 6371. km - - + + no oceans - + no ellipticity - + no surface topography - + no self-gravitation - + no rotation - + no attenuation - - - + + + preparing mass matrices preparing constants preparing gravity arrays preparing wavefields - + Elapsed time for preparing timerun in seconds = 6.385397911E-2 - - + + time loop: - + scheme: Newmark time step: 0.189999998 s number of time steps: 5000 total simulated time: 15.3301668 minutes start time : -30. seconds - + All processes are synchronized before time loop - + Starting time iteration loop... - + Time step # 5 Time: -0.487333328 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 2.98604682E-5 @@ -221,7 +221,7 @@ **** BEWARE: the above time estimates are not reliable **** because fewer than 100 iterations have been performed ************************************************************ - + Time step # 1000 Time: 2.66350007 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44318068 @@ -239,7 +239,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 36 s We have done 20. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 16:23 - + Time step # 2000 Time: 5.83016682 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44285548 @@ -257,7 +257,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 34 s We have done 40. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 16:23 - + Time step # 3000 Time: 8.9968338 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44194162 @@ -275,7 +275,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 33 s We have done 60. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 16:23 - + Time step # 4000 Time: 12.1634998 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44229388 @@ -293,7 +293,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 33 s We have done 80. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 16:23 - + Time step # 5000 Time: 15.3301668 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44285643 @@ -310,15 +310,15 @@ Estimated total run time in seconds = 272.90501523017883 Estimated total run time in hh:mm:ss = 0 h 04 m 32 s We have done 100. % of that - - + + Total number of time steps written: 5000 - + Writing the seismograms in parallel took 2.88558006286621094E-2 seconds - + Time-Loop Complete. Timing info: Total elapsed time in seconds = 272.99081015586853 Total elapsed time in hh:mm:ss = 0 h 04 m 32 s - + End of the simulation - + diff --git a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/values_from_mesher.h b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/values_from_mesher.h index 7610f8e39..0e08a2619 100644 --- a/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/values_from_mesher.h +++ b/EXAMPLES/global_PREM_kernels/amplitude/REF_SEIS/values_from_mesher.h @@ -1,4 +1,4 @@ - + ! ! this is the parameter file for static compilation of the solver ! @@ -25,11 +25,11 @@ ! total for full 6-chunk mesh: ! --------------------------- ! - ! exact total number of spectral elements in entire mesh = + ! exact total number of spectral elements in entire mesh = ! 126576. - ! approximate total number of points in entire mesh = + ! approximate total number of points in entire mesh = ! 8562043. - ! approximate total number of degrees of freedom in entire mesh = + ! approximate total number of degrees of freedom in entire mesh = ! 24356289. ! ! resolution of the mesh at the surface: @@ -41,7 +41,7 @@ ! average distance between points in km = 52.1226234 ! average size of a spectral element in km = 208.490494 ! - + ! approximate static memory needed by the solver: ! ---------------------------------------------- ! @@ -70,36 +70,36 @@ ! = 3.6107733119999999E-3 TB ! = 3.28397919656708837E-3 TiB ! - + integer, parameter :: NEX_XI_VAL = 48 integer, parameter :: NEX_ETA_VAL = 48 - + integer, parameter :: NSPEC_CRUST_MANTLE = 4860 integer, parameter :: NSPEC_OUTER_CORE = 387 integer, parameter :: NSPEC_INNER_CORE = 72 - + integer, parameter :: NGLOB_CRUST_MANTLE = 326725 integer, parameter :: NGLOB_OUTER_CORE = 27705 integer, parameter :: NGLOB_INNER_CORE = 5577 - + integer, parameter :: NSPECMAX_ANISO_IC = 1 - + integer, parameter :: NSPECMAX_ISO_MANTLE = 4860 integer, parameter :: NSPECMAX_TISO_MANTLE = 4860 integer, parameter :: NSPECMAX_ANISO_MANTLE = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_ATTENUATION = 1 integer, parameter :: NSPEC_INNER_CORE_ATTENUATION = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_STR_OR_ATT = 4860 integer, parameter :: NSPEC_INNER_CORE_STR_OR_ATT = 72 - + integer, parameter :: NSPEC_CRUST_MANTLE_STR_AND_ATT = 1 integer, parameter :: NSPEC_INNER_CORE_STR_AND_ATT = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_STRAIN_ONLY = 4860 integer, parameter :: NSPEC_INNER_CORE_STRAIN_ONLY = 72 - + integer, parameter :: NSPEC_CRUST_MANTLE_ADJOINT = 4860 integer, parameter :: NSPEC_OUTER_CORE_ADJOINT = 387 integer, parameter :: NSPEC_INNER_CORE_ADJOINT = 72 @@ -107,47 +107,47 @@ integer, parameter :: NGLOB_OUTER_CORE_ADJOINT = 27705 integer, parameter :: NGLOB_INNER_CORE_ADJOINT = 5577 integer, parameter :: NSPEC_OUTER_CORE_ROT_ADJOINT = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_STACEY = 1 integer, parameter :: NSPEC_OUTER_CORE_STACEY = 1 - + integer, parameter :: NGLOB_CRUST_MANTLE_OCEANS = 1 - + logical, parameter :: TRANSVERSE_ISOTROPY_VAL = .true. - + logical, parameter :: ANISOTROPIC_3D_MANTLE_VAL = .false. - + logical, parameter :: ANISOTROPIC_INNER_CORE_VAL = .false. - + logical, parameter :: ATTENUATION_VAL = .false. - + logical, parameter :: ATTENUATION_3D_VAL = .false. - + logical, parameter :: ELLIPTICITY_VAL = .false. - + logical, parameter :: GRAVITY_VAL = .false. - + logical, parameter :: OCEANS_VAL = .false. - + integer, parameter :: NX_BATHY_VAL = 1 integer, parameter :: NY_BATHY_VAL = 1 - + logical, parameter :: ROTATION_VAL = .false. integer, parameter :: NSPEC_OUTER_CORE_ROTATION = 1 - + logical, parameter :: PARTIAL_PHYS_DISPERSION_ONLY_VAL = .false. - + integer, parameter :: NPROC_XI_VAL = 2 integer, parameter :: NPROC_ETA_VAL = 2 integer, parameter :: NCHUNKS_VAL = 6 integer, parameter :: NPROCTOT_VAL = 24 - + integer, parameter :: ATT1_VAL = 1 integer, parameter :: ATT2_VAL = 1 integer, parameter :: ATT3_VAL = 1 integer, parameter :: ATT4_VAL = 1 integer, parameter :: ATT5_VAL = 1 - + integer, parameter :: NSPEC2DMAX_XMIN_XMAX_CM = 330 integer, parameter :: NSPEC2DMAX_YMIN_YMAX_CM = 330 integer, parameter :: NSPEC2D_BOTTOM_CM = 36 @@ -165,26 +165,26 @@ integer, parameter :: NSPEC2D_670 = 1 integer, parameter :: NSPEC2D_CMB = 1 integer, parameter :: NSPEC2D_ICB = 1 - + logical, parameter :: USE_DEVILLE_PRODUCTS_VAL = .true. integer, parameter :: NSPEC_CRUST_MANTLE_3DMOVIE = 1 integer, parameter :: NGLOB_CRUST_MANTLE_3DMOVIE = 1 - + integer, parameter :: NSPEC_OUTER_CORE_3DMOVIE = 1 integer, parameter :: NM_KL_REG_PTS_VAL = 1 - + integer, parameter :: NGLOB_XY_CM = 1 integer, parameter :: NGLOB_XY_IC = 1 - + logical, parameter :: ATTENUATION_1D_WITH_3D_STORAGE_VAL = .true. - + logical, parameter :: FORCE_VECTORIZATION_VAL = .true. - + integer, parameter :: NT_DUMP_ATTENUATION = 100000000 - + double precision, parameter :: ANGULAR_WIDTH_ETA_IN_DEGREES_VAL = 90.000000 double precision, parameter :: ANGULAR_WIDTH_XI_IN_DEGREES_VAL = 90.000000 double precision, parameter :: CENTER_LATITUDE_IN_DEGREES_VAL = 0.000000 double precision, parameter :: CENTER_LONGITUDE_IN_DEGREES_VAL = 0.000000 double precision, parameter :: GAMMA_ROTATION_AZIMUTH_VAL = 0.000000 - + diff --git a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_mesher.txt b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_mesher.txt index 1999a8c4a..1410fe3dd 100644 --- a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_mesher.txt +++ b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_mesher.txt @@ -1,28 +1,28 @@ - + **************************** *** Specfem3D MPI Mesher *** **************************** - - + + There are 24 MPI processes Processes are numbered from 0 to 23 - + There are 48 elements along xi in each chunk There are 48 elements along eta in each chunk - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks in the global mesh There is a total of 24 slices in the global mesh - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + Shape functions defined by NGNOD = 27 control nodes Surface shape functions defined by NGNOD2D = 9 control nodes - + model: 1D_transversely_isotropic_prem no oceans no ellipticity @@ -30,7 +30,7 @@ no self-gravitation no rotation no attenuation - + no 3-D lateral variations no heterogeneities in the mantle no crustal variations @@ -38,49 +38,49 @@ incorporating anisotropy no inner-core anisotropy no general mantle anisotropy - + Reference radius of the Earth used is 6371. km - + Central cube is at a radius of 950. km creating global slice addressing - + Spatial distribution of the slices 3 1 2 0 - + 11 9 7 5 19 17 10 8 6 4 18 16 - + 23 21 22 20 - + 15 13 14 12 - - + + additional mesh optimizations - + moho: no element stretching for 3-D moho surface - + internal topography 410/660: no element stretching for 3-D internal surfaces - - - + + + ******************************************* creating mesh in region 1 this region is the crust and mantle ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 11 9.1% current clock (NOT elapsed) time is: 16h 57min 48sec creating layer 2 out of 11 @@ -103,19 +103,19 @@ 90.9% current clock (NOT elapsed) time is: 16h 57min 48sec creating layer 11 out of 11 100.0% current clock (NOT elapsed) time is: 16h 57min 48sec - - + + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 11 9.1% current clock (NOT elapsed) time is: 16h 57min 49sec creating layer 2 out of 11 @@ -138,22 +138,22 @@ 90.9% current clock (NOT elapsed) time is: 16h 57min 49sec creating layer 11 out of 11 100.0% current clock (NOT elapsed) time is: 16h 57min 50sec - - + + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + There is a total of 24 messages to assemble faces between chunks - + Generating message 1 for faces out of 24 Generating message 2 for faces out of 24 Generating message 3 for faces out of 24 @@ -178,9 +178,9 @@ Generating message 22 for faces out of 24 Generating message 23 for faces out of 24 Generating message 24 for faces out of 24 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -189,97 +189,97 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + crust/mantle region: #max of points in MPI buffers along xi npoin2D_xi = 5449 #max of array elements transferred npoin2D_xi*NDIM = 16347 - + #max of points in MPI buffers along eta npoin2D_eta = 5449 #max of array elements transferred npoin2D_eta*NDIM = 16347 - + crust mantle MPI: maximum interfaces: 7 MPI addressing maximum interfaces: 7 MPI addressing : all interfaces okay - + total MPI interface points : 530952 unique MPI interface points: 512640 maximum valence : 3 total unique MPI interface points: 512640 - - - ...element inner/outer separation - + + + ...element inner/outer separation + for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 26.831274 % percentage of volume elements in crust/mantle 73.1687241 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 12.566370579194894 exact area: 12.566370614359172 calculated bottom area: 3.7493225048710057 exact area: 3.7493254667646689 - + ******************************************* creating mesh in region 2 this region is the outer core ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 2 50.0% current clock (NOT elapsed) time is: 16h 57min 52sec creating layer 2 out of 2 100.0% current clock (NOT elapsed) time is: 16h 57min 52sec - - + + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 2 50.0% current clock (NOT elapsed) time is: 16h 57min 52sec creating layer 2 out of 2 100.0% current clock (NOT elapsed) time is: 16h 57min 52sec - - + + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + There is a total of 24 messages to assemble faces between chunks - + Generating message 1 for faces out of 24 Generating message 2 for faces out of 24 Generating message 3 for faces out of 24 @@ -304,9 +304,9 @@ Generating message 22 for faces out of 24 Generating message 23 for faces out of 24 Generating message 24 for faces out of 24 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -315,92 +315,92 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + outer core region: #max of points in MPI buffers along xi npoin2D_xi = 1337 #max of array elements transferred npoin2D_xi*NDIM = 4011 - + #max of points in MPI buffers along eta npoin2D_eta = 1385 #max of array elements transferred npoin2D_eta*NDIM = 4155 - + outer core MPI: maximum interfaces: 7 MPI addressing maximum interfaces: 7 MPI addressing : all interfaces okay - + total MPI interface points : 132072 unique MPI interface points: 120384 maximum valence : 3 total assembled MPI interface points: 120384 - - - ...element inner/outer separation + + + ...element inner/outer separation percentage of edge elements in outer core 63.5658875 % percentage of volume elements in outer core 36.4341125 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 3.7493225048710057 exact area: 3.7493254667646689 calculated bottom area: 0.46155180134655271 exact area: 0.46155768002682868 - + ******************************************* creating mesh in region 3 this region is the inner core ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 1 100.0% current clock (NOT elapsed) time is: 16h 57min 53sec - + creating central cube - + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 1 100.0% current clock (NOT elapsed) time is: 16h 57min 53sec - + creating central cube - + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + There is a total of 24 messages to assemble faces between chunks - + Generating message 1 for faces out of 24 Generating message 2 for faces out of 24 Generating message 3 for faces out of 24 @@ -425,9 +425,9 @@ Generating message 22 for faces out of 24 Generating message 23 for faces out of 24 Generating message 24 for faces out of 24 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -436,87 +436,87 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + inner core region: #max of points in MPI buffers along xi npoin2D_xi = 429 #max of array elements transferred npoin2D_xi*NDIM = 1287 - + #max of points in MPI buffers along eta npoin2D_eta = 429 #max of array elements transferred npoin2D_eta*NDIM = 1287 - - + + including central cube - + inner core MPI: inner core with central cube MPI: maximum interfaces: 15 MPI addressing maximum interfaces: 15 MPI addressing : all interfaces okay - + total MPI interface points : 21864 unique MPI interface points: 17880 maximum valence : 7 total assembled MPI interface points: 17880 - - - ...element inner/outer separation + + + ...element inner/outer separation percentage of edge elements in inner core 56.9444427 % percentage of volume elements in inner core 43.0555573 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 0.46155180134655271 exact area: 0.46155768002682868 calculated bottom area: 0.21169690506049865 more or less similar area (central cube): 0.17787790385168642 - + calculated volume: 4.1887901261443377 exact volume: 4.1887902047863905 - + computed total Earth mass for this density model and mesh: 5.97553703266215937E+24 kg (should be not too far from 5.974E+24 kg) - + average density for this density model and mesh: 5516.5241764240236 kg/m3 (should be not too far from 5514 kg/m3) - - position of the center of mass of the Earth for this density model and mesh: + + position of the center of mass of the Earth for this density model and mesh: x = -0.60622063369426571 km y = -0.43310399187886112 km z = -0.5200786374770423 km distance to center = 0.90860569757076592 km - - + + Repartition of elements in regions: ---------------------------------- - + total number of elements in each slice: 5319 - + - crust and mantle: 91.3705597 % - outer core: 7.27580357 % - inner core: 1.35363793 % - + for some mesh statistics, see comments in file OUTPUT_FILES/values_from_mesher.h - + Load balancing = 100 % by definition - - + + the time step of the solver will be DT = 0.189999998 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - - + + Elapsed time for mesh generation and buffer creation in seconds = 5.6958909034729004 Elapsed time for mesh generation and buffer creation in hh:mm:ss = 0 h 00 m 05 s - + End of mesh generation - + diff --git a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.kernel.txt b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.kernel.txt index 69ae862ef..9deaf1bf3 100644 --- a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.kernel.txt +++ b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.kernel.txt @@ -1,33 +1,33 @@ - + ****************************** **** Specfem3D MPI Solver **** ****************************** - - + + Fixing slow underflow trapping problem using small initial field - + There are 24 MPI processes Processes are numbered from 0 to 23 - + There are 48 elements along xi in each chunk There are 48 elements along eta in each chunk - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + NDIM = 3 - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - + model: 1D_transversely_isotropic_prem no oceans no ellipticity @@ -35,7 +35,7 @@ no self-gravitation no rotation no attenuation - + no 3-D lateral variations no heterogeneities in the mantle no crustal variations @@ -43,8 +43,8 @@ incorporating transverse isotropy no inner-core anisotropy no general mantle anisotropy - - + + mesh databases: reading in crust/mantle databases... reading in outer core databases... @@ -54,161 +54,161 @@ Spatial distribution of the slices 3 1 2 0 - + 11 9 7 5 19 17 10 8 6 4 18 16 - + 23 21 22 20 - + 15 13 14 12 - + reading in MPI databases... for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 26.8312759 % percentage of volume elements in crust/mantle 73.1687241 % - + percentage of edge elements in outer core 63.5658913 % percentage of volume elements in outer core 36.4341087 % - + percentage of edge elements in inner core 56.9444466 % percentage of volume elements in inner core 43.0555534 % - - + + Elapsed time for reading mesh in seconds = 6.27329397 - - + + sources: - + ************************************* locating source 1 ************************************* - + source located in slice 4 in element 3090 - + xi coordinate of source in that element: -0.91500744121227218 eta coordinate of source in that element: 0.86669995081172757 gamma coordinate of source in that element: -0.34571178817636433 - + half duration: 20. seconds time shift: 0. seconds - + magnitude of the source: scalar moment M0 = 2.62997300366372602E+28 dyne-cm moment magnitude Mw = 8.2466343844251071 - - + + original (requested) position of the source: - + latitude: -13.82 longitude: -67.25 depth: 647.10000000000002 km - + position of the source that will be used: - + latitude: -13.820000000000006 longitude: -67.249999999999986 depth: 647.09999999999911 km - + Error in location of the source: 5.001529789E-13 km - + maximum error in location of the sources: 5.001529789E-13 km - - + + Elapsed time for detection of sources in seconds = 1.09851360321044922E-2 - + End of source detection - done - - + + receivers: - + Total number of receivers = 1 - - + + ******************** locating receivers ******************** - + reading receiver information... - + Stations sorted by epicentral distance: Station # 1: IU.ANMO epicentral distance: 61.119137 degrees - + maximum error in location of all the receivers: 1.59147695E-12 km - + Elapsed time for receiver detection in seconds = 3.83470058441162109E-2 - + End of receiver detection - done - - + + 3 adjoint component traces found in all slices - + found a total of 1 receivers in all slices this total is okay - + source arrays: number of sources is 1 size of source array = 1.430511475E-3 MB = 1.396983862E-6 GB - + seismograms: seismograms written by all processes writing out seismograms at every NTSTEP_BETWEEN_OUTPUT_SEISMOS = 5000 maximum number of local receivers is 1 in slice 8 size of maximum seismogram array = 5.722045898E-2 MB = 5.587935448E-5 GB - + adjoint source arrays: reading adjoint sources at every NTSTEP_BETWEEN_READ_ADJSRC = 5000 using asynchronous buffer for file I/O of adjoint sources maximum number of local adjoint sources is 1 in slice 8 size of maximum adjoint source array = 7.15255737 MB = 6.98491931E-3 GB - - + + Total number of samples for seismograms = 5000 - - + + Reference radius of the Earth used is 6371. km - - + + no oceans - + no ellipticity - + no surface topography - + no self-gravitation - + no rotation - + no attenuation - - - + + + preparing mass matrices preparing constants preparing gravity arrays preparing wavefields - + Elapsed time for preparing timerun in seconds = 7.913208008E-2 - - + + time loop: - + scheme: Newmark time step: 0.189999998 s number of time steps: 5000 total simulated time: 15.3301668 minutes start time : -30. seconds - + All processes are synchronized before time loop - + Starting time iteration loop... - + Time step # 5 Time: -0.487333328 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 0. @@ -232,7 +232,7 @@ **** BEWARE: the above time estimates are not reliable **** because fewer than 100 iterations have been performed ************************************************************ - + Time step # 1000 Time: 2.66350007 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 0. @@ -252,7 +252,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 17 s We have done 20. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:23 - + Time step # 2000 Time: 5.83016682 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 646337.5 @@ -272,7 +272,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 13 s We have done 40. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:23 - + Time step # 3000 Time: 8.9968338 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 32524.6914 @@ -292,7 +292,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 12 s We have done 60. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:23 - + Time step # 4000 Time: 12.1634998 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 23925.1348 @@ -312,7 +312,7 @@ Estimated total run time in hh:mm:ss = 0 h 10 m 12 s We have done 80. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:24 - + Time step # 5000 Time: 15.3301668 minutes Max norm displacement vector U in solid in all slices for adjoint prop. (m)= 16747.6523 @@ -331,15 +331,15 @@ Estimated total run time in seconds = 612.07528495788574 Estimated total run time in hh:mm:ss = 0 h 10 m 12 s We have done 100. % of that - - + + Total number of time steps written: 5000 - + Writing the seismograms in parallel took 3.17928791046142578E-2 seconds - + Time-Loop Complete. Timing info: Total elapsed time in seconds = 612.23387908935547 Total elapsed time in hh:mm:ss = 0 h 10 m 12 s - + End of the simulation - + diff --git a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.txt b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.txt index 80d0ffc04..7dc0e3bb5 100644 --- a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.txt +++ b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/output_solver.txt @@ -1,33 +1,33 @@ - + ****************************** **** Specfem3D MPI Solver **** ****************************** - - + + Fixing slow underflow trapping problem using small initial field - + There are 24 MPI processes Processes are numbered from 0 to 23 - + There are 48 elements along xi in each chunk There are 48 elements along eta in each chunk - + There are 2 slices along xi in each chunk There are 2 slices along eta in each chunk There is a total of 4 slices in each chunk There are 6 chunks There is a total of 24 slices in all the chunks - + NDIM = 3 - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - + model: 1D_transversely_isotropic_prem no oceans no ellipticity @@ -35,7 +35,7 @@ no self-gravitation no rotation no attenuation - + no 3-D lateral variations no heterogeneities in the mantle no crustal variations @@ -43,8 +43,8 @@ incorporating transverse isotropy no inner-core anisotropy no general mantle anisotropy - - + + mesh databases: reading in crust/mantle databases... reading in outer core databases... @@ -54,152 +54,152 @@ Spatial distribution of the slices 3 1 2 0 - + 11 9 7 5 19 17 10 8 6 4 18 16 - + 23 21 22 20 - + 15 13 14 12 - + reading in MPI databases... for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 26.8312759 % percentage of volume elements in crust/mantle 73.1687241 % - + percentage of edge elements in outer core 63.5658913 % percentage of volume elements in outer core 36.4341087 % - + percentage of edge elements in inner core 56.9444466 % percentage of volume elements in inner core 43.0555534 % - - + + Elapsed time for reading mesh in seconds = 2.36160398 - - + + sources: - + ************************************* locating source 1 ************************************* - + source located in slice 4 in element 3090 - + xi coordinate of source in that element: -0.91500744121227218 eta coordinate of source in that element: 0.86669995081172757 gamma coordinate of source in that element: -0.34571178817636433 - + half duration: 20. seconds time shift: 0. seconds - + magnitude of the source: scalar moment M0 = 2.62997300366372602E+28 dyne-cm moment magnitude Mw = 8.2466343844251071 - - + + original (requested) position of the source: - + latitude: -13.82 longitude: -67.25 depth: 647.10000000000002 km - + position of the source that will be used: - + latitude: -13.820000000000006 longitude: -67.249999999999986 depth: 647.09999999999911 km - + Error in location of the source: 5.001529789E-13 km - + maximum error in location of the sources: 5.001529789E-13 km - - + + Elapsed time for detection of sources in seconds = 7.73596763610839844E-3 - + End of source detection - done - - + + receivers: - + Total number of receivers = 1 - - + + ******************** locating receivers ******************** - + reading receiver information... - + Stations sorted by epicentral distance: Station # 1: IU.ANMO epicentral distance: 61.119137 degrees - + maximum error in location of all the receivers: 1.59147695E-12 km - + Elapsed time for receiver detection in seconds = 6.85408115386962891E-2 - + End of receiver detection - done - - + + found a total of 1 receivers in all slices this total is okay - + source arrays: number of sources is 1 size of source array = 1.430511475E-3 MB = 1.396983862E-6 GB - + seismograms: seismograms written by all processes writing out seismograms at every NTSTEP_BETWEEN_OUTPUT_SEISMOS = 5000 maximum number of local receivers is 1 in slice 8 size of maximum seismogram array = 5.722045898E-2 MB = 5.587935448E-5 GB - - + + Total number of samples for seismograms = 5000 - - + + Reference radius of the Earth used is 6371. km - - + + no oceans - + no ellipticity - + no surface topography - + no self-gravitation - + no rotation - + no attenuation - - - + + + preparing mass matrices preparing constants preparing gravity arrays preparing wavefields - + Elapsed time for preparing timerun in seconds = 6.382393837E-2 - - + + time loop: - + scheme: Newmark time step: 0.189999998 s number of time steps: 5000 total simulated time: 15.3301668 minutes start time : -30. seconds - + All processes are synchronized before time loop - + Starting time iteration loop... - + Time step # 5 Time: -0.487333328 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 2.98604682E-5 @@ -221,7 +221,7 @@ **** BEWARE: the above time estimates are not reliable **** because fewer than 100 iterations have been performed ************************************************************ - + Time step # 1000 Time: 2.66350007 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44318068 @@ -239,7 +239,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 30 s We have done 20. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:03 - + Time step # 2000 Time: 5.83016682 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44285548 @@ -257,7 +257,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 34 s We have done 40. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:03 - + Time step # 3000 Time: 8.9968338 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44194162 @@ -275,7 +275,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 33 s We have done 60. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:03 - + Time step # 4000 Time: 12.1634998 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44229388 @@ -293,7 +293,7 @@ Estimated total run time in hh:mm:ss = 0 h 04 m 33 s We have done 80. % of that The run will finish approximately on (in local time): Mon Jun 15, 2015 17:02 - + Time step # 5000 Time: 15.3301668 minutes Max norm displacement vector U in solid in all slices for forward prop. (m) = 1.44285643 @@ -310,15 +310,15 @@ Estimated total run time in seconds = 273.03498888015747 Estimated total run time in hh:mm:ss = 0 h 04 m 33 s We have done 100. % of that - - + + Total number of time steps written: 5000 - + Writing the seismograms in parallel took 0.17110681533813477 seconds - + Time-Loop Complete. Timing info: Total elapsed time in seconds = 273.27775001525879 Total elapsed time in hh:mm:ss = 0 h 04 m 33 s - + End of the simulation - + diff --git a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/values_from_mesher.h b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/values_from_mesher.h index 7610f8e39..0e08a2619 100644 --- a/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/values_from_mesher.h +++ b/EXAMPLES/global_PREM_kernels/traveltime/REF_SEIS/values_from_mesher.h @@ -1,4 +1,4 @@ - + ! ! this is the parameter file for static compilation of the solver ! @@ -25,11 +25,11 @@ ! total for full 6-chunk mesh: ! --------------------------- ! - ! exact total number of spectral elements in entire mesh = + ! exact total number of spectral elements in entire mesh = ! 126576. - ! approximate total number of points in entire mesh = + ! approximate total number of points in entire mesh = ! 8562043. - ! approximate total number of degrees of freedom in entire mesh = + ! approximate total number of degrees of freedom in entire mesh = ! 24356289. ! ! resolution of the mesh at the surface: @@ -41,7 +41,7 @@ ! average distance between points in km = 52.1226234 ! average size of a spectral element in km = 208.490494 ! - + ! approximate static memory needed by the solver: ! ---------------------------------------------- ! @@ -70,36 +70,36 @@ ! = 3.6107733119999999E-3 TB ! = 3.28397919656708837E-3 TiB ! - + integer, parameter :: NEX_XI_VAL = 48 integer, parameter :: NEX_ETA_VAL = 48 - + integer, parameter :: NSPEC_CRUST_MANTLE = 4860 integer, parameter :: NSPEC_OUTER_CORE = 387 integer, parameter :: NSPEC_INNER_CORE = 72 - + integer, parameter :: NGLOB_CRUST_MANTLE = 326725 integer, parameter :: NGLOB_OUTER_CORE = 27705 integer, parameter :: NGLOB_INNER_CORE = 5577 - + integer, parameter :: NSPECMAX_ANISO_IC = 1 - + integer, parameter :: NSPECMAX_ISO_MANTLE = 4860 integer, parameter :: NSPECMAX_TISO_MANTLE = 4860 integer, parameter :: NSPECMAX_ANISO_MANTLE = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_ATTENUATION = 1 integer, parameter :: NSPEC_INNER_CORE_ATTENUATION = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_STR_OR_ATT = 4860 integer, parameter :: NSPEC_INNER_CORE_STR_OR_ATT = 72 - + integer, parameter :: NSPEC_CRUST_MANTLE_STR_AND_ATT = 1 integer, parameter :: NSPEC_INNER_CORE_STR_AND_ATT = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_STRAIN_ONLY = 4860 integer, parameter :: NSPEC_INNER_CORE_STRAIN_ONLY = 72 - + integer, parameter :: NSPEC_CRUST_MANTLE_ADJOINT = 4860 integer, parameter :: NSPEC_OUTER_CORE_ADJOINT = 387 integer, parameter :: NSPEC_INNER_CORE_ADJOINT = 72 @@ -107,47 +107,47 @@ integer, parameter :: NGLOB_OUTER_CORE_ADJOINT = 27705 integer, parameter :: NGLOB_INNER_CORE_ADJOINT = 5577 integer, parameter :: NSPEC_OUTER_CORE_ROT_ADJOINT = 1 - + integer, parameter :: NSPEC_CRUST_MANTLE_STACEY = 1 integer, parameter :: NSPEC_OUTER_CORE_STACEY = 1 - + integer, parameter :: NGLOB_CRUST_MANTLE_OCEANS = 1 - + logical, parameter :: TRANSVERSE_ISOTROPY_VAL = .true. - + logical, parameter :: ANISOTROPIC_3D_MANTLE_VAL = .false. - + logical, parameter :: ANISOTROPIC_INNER_CORE_VAL = .false. - + logical, parameter :: ATTENUATION_VAL = .false. - + logical, parameter :: ATTENUATION_3D_VAL = .false. - + logical, parameter :: ELLIPTICITY_VAL = .false. - + logical, parameter :: GRAVITY_VAL = .false. - + logical, parameter :: OCEANS_VAL = .false. - + integer, parameter :: NX_BATHY_VAL = 1 integer, parameter :: NY_BATHY_VAL = 1 - + logical, parameter :: ROTATION_VAL = .false. integer, parameter :: NSPEC_OUTER_CORE_ROTATION = 1 - + logical, parameter :: PARTIAL_PHYS_DISPERSION_ONLY_VAL = .false. - + integer, parameter :: NPROC_XI_VAL = 2 integer, parameter :: NPROC_ETA_VAL = 2 integer, parameter :: NCHUNKS_VAL = 6 integer, parameter :: NPROCTOT_VAL = 24 - + integer, parameter :: ATT1_VAL = 1 integer, parameter :: ATT2_VAL = 1 integer, parameter :: ATT3_VAL = 1 integer, parameter :: ATT4_VAL = 1 integer, parameter :: ATT5_VAL = 1 - + integer, parameter :: NSPEC2DMAX_XMIN_XMAX_CM = 330 integer, parameter :: NSPEC2DMAX_YMIN_YMAX_CM = 330 integer, parameter :: NSPEC2D_BOTTOM_CM = 36 @@ -165,26 +165,26 @@ integer, parameter :: NSPEC2D_670 = 1 integer, parameter :: NSPEC2D_CMB = 1 integer, parameter :: NSPEC2D_ICB = 1 - + logical, parameter :: USE_DEVILLE_PRODUCTS_VAL = .true. integer, parameter :: NSPEC_CRUST_MANTLE_3DMOVIE = 1 integer, parameter :: NGLOB_CRUST_MANTLE_3DMOVIE = 1 - + integer, parameter :: NSPEC_OUTER_CORE_3DMOVIE = 1 integer, parameter :: NM_KL_REG_PTS_VAL = 1 - + integer, parameter :: NGLOB_XY_CM = 1 integer, parameter :: NGLOB_XY_IC = 1 - + logical, parameter :: ATTENUATION_1D_WITH_3D_STORAGE_VAL = .true. - + logical, parameter :: FORCE_VECTORIZATION_VAL = .true. - + integer, parameter :: NT_DUMP_ATTENUATION = 100000000 - + double precision, parameter :: ANGULAR_WIDTH_ETA_IN_DEGREES_VAL = 90.000000 double precision, parameter :: ANGULAR_WIDTH_XI_IN_DEGREES_VAL = 90.000000 double precision, parameter :: CENTER_LATITUDE_IN_DEGREES_VAL = 0.000000 double precision, parameter :: CENTER_LONGITUDE_IN_DEGREES_VAL = 0.000000 double precision, parameter :: GAMMA_ROTATION_AZIMUTH_VAL = 0.000000 - + diff --git a/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/output_mesher.txt b/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/output_mesher.txt index c4b08ac08..e13e68b33 100644 --- a/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/output_mesher.txt +++ b/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/output_mesher.txt @@ -1,28 +1,28 @@ - + **************************** *** Specfem3D MPI Mesher *** **************************** - - + + There are 384 MPI processes Processes are numbered from 0 to 383 - + There are 256 elements along xi in each chunk There are 256 elements along eta in each chunk - + There are 8 slices along xi in each chunk There are 8 slices along eta in each chunk There is a total of 64 slices in each chunk There are 6 chunks in the global mesh There is a total of 384 slices in the global mesh - + NGLLX = 5 NGLLY = 5 NGLLZ = 5 - + Shape functions defined by NGNOD = 27 control nodes Surface shape functions defined by NGNOD2D = 9 control nodes - + model: s362ani incorporating the oceans using equivalent load incorporating ellipticity @@ -30,7 +30,7 @@ incorporating self-gravitation (Cowling approximation) incorporating rotation incorporating attenuation using 3 standard linear solids - + incorporating 3-D lateral variations no heterogeneities in the mantle incorporating crustal variations @@ -38,12 +38,12 @@ incorporating anisotropy no inner-core anisotropy no general mantle anisotropy - + Reference radius of the Earth used is 6371. km - + Central cube is at a radius of 965. km creating global slice addressing - + Spatial distribution of the slices 63 55 47 39 31 23 15 7 62 54 46 38 30 22 14 6 @@ -53,7 +53,7 @@ 58 50 42 34 26 18 10 2 57 49 41 33 25 17 9 1 56 48 40 32 24 16 8 0 - + 191 183 175 167 159 151 143 135 127 119 111 103 95 87 79 71 319 311 303 295 287 279 271 263 190 182 174 166 158 150 142 134 126 118 110 102 94 86 78 70 318 310 302 294 286 278 270 262 189 181 173 165 157 149 141 133 125 117 109 101 93 85 77 69 317 309 301 293 285 277 269 261 @@ -62,7 +62,7 @@ 186 178 170 162 154 146 138 130 122 114 106 98 90 82 74 66 314 306 298 290 282 274 266 258 185 177 169 161 153 145 137 129 121 113 105 97 89 81 73 65 313 305 297 289 281 273 265 257 184 176 168 160 152 144 136 128 120 112 104 96 88 80 72 64 312 304 296 288 280 272 264 256 - + 383 375 367 359 351 343 335 327 382 374 366 358 350 342 334 326 381 373 365 357 349 341 333 325 @@ -71,7 +71,7 @@ 378 370 362 354 346 338 330 322 377 369 361 353 345 337 329 321 376 368 360 352 344 336 328 320 - + 255 247 239 231 223 215 207 199 254 246 238 230 222 214 206 198 253 245 237 229 221 213 205 197 @@ -80,38 +80,38 @@ 250 242 234 226 218 210 202 194 249 241 233 225 217 209 201 193 248 240 232 224 216 208 200 192 - - + + incorporating topography topography/bathymetry: min/max = -7747, 5507 - + incorporating crustal model: CRUST2.0 - - + + additional mesh optimizations - + moho: default 2-layer crust incorporating element stretching for 3-D moho surface - + internal topography 410/660: incorporating element stretching for 3-D internal surfaces - - - + + + ******************************************* creating mesh in region 1 this region is the crust and mantle ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 10 10.0% current clock (NOT elapsed) time is: 14h 41min 30sec creating layer 2 out of 10 @@ -132,19 +132,19 @@ 90.0% current clock (NOT elapsed) time is: 14h 41min 31sec creating layer 10 out of 10 100.0% current clock (NOT elapsed) time is: 14h 41min 32sec - - + + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 10 10.0% current clock (NOT elapsed) time is: 14h 41min 42sec creating layer 2 out of 10 @@ -165,22 +165,22 @@ 90.0% current clock (NOT elapsed) time is: 14h 42min 11sec creating layer 10 out of 10 100.0% current clock (NOT elapsed) time is: 14h 42min 23sec - - + + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 8 slices along xi in each chunk There are 8 slices along eta in each chunk There is a total of 64 slices in each chunk There are 6 chunks There is a total of 384 slices in all the chunks - + There is a total of 96 messages to assemble faces between chunks - + Generating message 1 for faces out of 96 Generating message 2 for faces out of 96 Generating message 3 for faces out of 96 @@ -277,9 +277,9 @@ Generating message 94 for faces out of 96 Generating message 95 for faces out of 96 Generating message 96 for faces out of 96 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -288,96 +288,96 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + crust/mantle region: #max of points in MPI buffers along xi npoin2D_xi = 9449 #max of array elements transferred npoin2D_xi*NDIM = 28347 - + #max of points in MPI buffers along eta npoin2D_eta = 9449 #max of array elements transferred npoin2D_eta*NDIM = 28347 - + crust mantle MPI: maximum interfaces: 8 MPI addressing maximum interfaces: 8 MPI addressing : all interfaces okay - + total MPI interface points : 14745000 unique MPI interface points: 14278656 maximum valence : 3 total unique MPI interface points: 14278656 - - - ...element inner/outer separation - + + + ...element inner/outer separation + for overlapping of communications with calculations: - + percentage of edge elements in crust/mantle 21.7225609 % percentage of volume elements in crust/mantle 78.2774353 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix updates mass matrix with ocean load - + ...saving binary files - + calculated top area: 12.557554609515575 calculated bottom area: 3.7492435210568309 - + ******************************************* creating mesh in region 2 this region is the outer core ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 2 50.0% current clock (NOT elapsed) time is: 14h 42min 32sec creating layer 2 out of 2 100.0% current clock (NOT elapsed) time is: 14h 42min 32sec - - + + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 2 50.0% current clock (NOT elapsed) time is: 14h 42min 32sec creating layer 2 out of 2 100.0% current clock (NOT elapsed) time is: 14h 42min 32sec - - + + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 8 slices along xi in each chunk There are 8 slices along eta in each chunk There is a total of 64 slices in each chunk There are 6 chunks There is a total of 384 slices in all the chunks - + There is a total of 96 messages to assemble faces between chunks - + Generating message 1 for faces out of 96 Generating message 2 for faces out of 96 Generating message 3 for faces out of 96 @@ -474,9 +474,9 @@ Generating message 94 for faces out of 96 Generating message 95 for faces out of 96 Generating message 96 for faces out of 96 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -485,90 +485,90 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + outer core region: #max of points in MPI buffers along xi npoin2D_xi = 2425 #max of array elements transferred npoin2D_xi*NDIM = 7275 - + #max of points in MPI buffers along eta npoin2D_eta = 2425 #max of array elements transferred npoin2D_eta*NDIM = 7275 - + outer core MPI: maximum interfaces: 8 MPI addressing maximum interfaces: 8 MPI addressing : all interfaces okay - + total MPI interface points : 3871464 unique MPI interface points: 3575808 maximum valence : 3 total assembled MPI interface points: 3575808 - - - ...element inner/outer separation + + + ...element inner/outer separation percentage of edge elements in outer core 51.6666641 % percentage of volume elements in outer core 48.3333359 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 3.7492435210568309 calculated bottom area: 0.46192991171231401 - + ******************************************* creating mesh in region 3 this region is the inner core ******************************************* - - + + first pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 1 100.0% current clock (NOT elapsed) time is: 14h 42min 34sec - + creating central cube - + ...creating global addressing - + ...creating MPI buffers - + second pass - - ...allocating arrays - - ...setting up layers - - ...creating mesh elements + + ...allocating arrays + + ...setting up layers + + ...creating mesh elements creating layer 1 out of 1 100.0% current clock (NOT elapsed) time is: 14h 42min 34sec - + creating central cube - + ...precomputing Jacobian - + ...creating chunk buffers - + ----- creating chunk buffers ----- - + There are 8 slices along xi in each chunk There are 8 slices along eta in each chunk There is a total of 64 slices in each chunk There are 6 chunks There is a total of 384 slices in all the chunks - + There is a total of 96 messages to assemble faces between chunks - + Generating message 1 for faces out of 96 Generating message 2 for faces out of 96 Generating message 3 for faces out of 96 @@ -665,9 +665,9 @@ Generating message 94 for faces out of 96 Generating message 95 for faces out of 96 Generating message 96 for faces out of 96 - + all the messages for chunk faces have the right size - + Generating message 1 for corners out of 8 Generating message 2 for corners out of 8 Generating message 3 for corners out of 8 @@ -676,84 +676,84 @@ Generating message 6 for corners out of 8 Generating message 7 for corners out of 8 Generating message 8 for corners out of 8 - + ...preparing MPI interfaces - + inner core region: #max of points in MPI buffers along xi npoin2D_xi = 2397 #max of array elements transferred npoin2D_xi*NDIM = 7191 - + #max of points in MPI buffers along eta npoin2D_eta = 2397 #max of array elements transferred npoin2D_eta*NDIM = 7191 - - + + including central cube - + inner core MPI: inner core with central cube MPI: maximum interfaces: 27 MPI addressing maximum interfaces: 27 MPI addressing : all interfaces okay - + total MPI interface points : 1079824 unique MPI interface points: 930176 maximum valence : 7 total assembled MPI interface points: 930176 - - - ...element inner/outer separation + + + ...element inner/outer separation percentage of edge elements in inner core 41.4285698 % percentage of volume elements in inner core 58.5714302 % - - - ...element mesh coloring + + + ...element mesh coloring mesh coloring: F - + ...creating mass matrix - + ...saving binary files - + calculated top area: 0.46192991171231401 calculated bottom area: 0.21843460470891174 - + calculated volume: 4.1841084918319433 - + computed total Earth mass for this density model and mesh: 5.97523264202969452E+24 kg (should be not too far from 5.974E+24 kg) - + average density for this density model and mesh: 5522.4153387054293 kg/m3 (should be not too far from 5514 kg/m3) - - position of the center of mass of the Earth for this density model and mesh: + + position of the center of mass of the Earth for this density model and mesh: x = -0.12617275021836824 km y = -0.4602914702173016 km z = -0.8419323628591151 km distance to center = 0.96780054974256147 km - - + + Repartition of elements in regions: ---------------------------------- - + total number of elements in each slice: 12016 - + - crust and mantle: 87.3501968 % - outer core: 7.98934746 % - inner core: 4.66045284 % - + for some mesh statistics, see comments in file OUTPUT_FILES/values_from_mesher.h - + Load balancing = 100 % by definition - - + + the time step of the solver will be DT = 0.161500007 - + using single precision for the calculations - + smallest and largest possible floating-point numbers are: 1.175494351E-38, 3.402823466E+38 - - + + Elapsed time for mesh generation and buffer creation in seconds = 71.347068071365356 Elapsed time for mesh generation and buffer creation in hh:mm:ss = 0 h 01 m 11 s - + End of mesh generation - + diff --git a/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/plot_sac_seismograms.sh b/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/plot_sac_seismograms.sh index 4c933fdd4..e27811918 100755 --- a/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/plot_sac_seismograms.sh +++ b/EXAMPLES/global_s362ani_shakemovie/REF_SEIS/plot_sac_seismograms.sh @@ -1,7 +1,7 @@ #!/bin/bash sac <0) then @@ -170,7 +170,7 @@ program combine_paraview_movie_data !print *, 'reading from file:',local_data_file open(unit = IIN,file = trim(prname)//trim(local_data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'Error opening file: ',trim(prname)//trim(local_data_file) + print *,'Error opening file: ',trim(prname)//trim(local_data_file) stop 'Error opening file it.bin' endif if (npoint(iproc)>0) then @@ -182,7 +182,7 @@ program combine_paraview_movie_data !print *, 'reading from file:',local_data_file open(unit = IIN,file = trim(prname)//trim(local_data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'Error opening file: ',trim(prname)//trim(local_data_file) + print *,'Error opening file: ',trim(prname)//trim(local_data_file) stop 'Error opening file it.bin' endif if (npoint(iproc)>0) then @@ -194,7 +194,7 @@ program combine_paraview_movie_data !print *, 'reading from file:',local_data_file open(unit = IIN,file = trim(prname)//trim(local_data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'Error opening file: ',trim(prname)//trim(local_data_file) + print *,'Error opening file: ',trim(prname)//trim(local_data_file) stop 'Error opening file it.bin' endif if (npoint(iproc)>0) then @@ -206,7 +206,7 @@ program combine_paraview_movie_data !print *, 'reading from file:',local_data_file open(unit = IIN,file = trim(prname)//trim(local_data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'Error opening file: ',trim(prname)//trim(local_data_file) + print *,'Error opening file: ',trim(prname)//trim(local_data_file) stop 'Error opening file it.bin' endif if (npoint(iproc)>0) then @@ -218,7 +218,7 @@ program combine_paraview_movie_data !print *, 'reading from file:',local_data_file open(unit = IIN,file = trim(prname)//trim(local_data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'Error opening file: ',trim(prname)//trim(local_data_file) + print *,'Error opening file: ',trim(prname)//trim(local_data_file) stop 'Error opening file it.bin' endif if (npoint(iproc)>0) then @@ -230,7 +230,7 @@ program combine_paraview_movie_data !print *, 'reading from file:',local_data_file open(unit = IIN,file = trim(prname)//trim(local_data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'Error opening file: ',trim(prname)//trim(local_data_file) + print *,'Error opening file: ',trim(prname)//trim(local_data_file) stop 'Error opening file it.bin' endif if (npoint(iproc)>0) then @@ -301,7 +301,7 @@ program combine_paraview_movie_data do i = 1, nelement_local read(IIN,iostat=ios) n1, n2, n3, n4, n5, n6, n7, n8 if (ios /= 0) then - print*,'Error reading file: ',trim(local_element_file) + print *,'Error reading file: ',trim(local_element_file) stop 'Error reading file movie3D_elements.bin, please check if number of elements is correct (MOVIE_COARSE?)' endif n1 = n1+np diff --git a/src/auxiliaries/combine_vol_data_adios_impl.f90 b/src/auxiliaries/combine_vol_data_adios_impl.f90 index 40fc01d3a..34983f7be 100644 --- a/src/auxiliaries/combine_vol_data_adios_impl.f90 +++ b/src/auxiliaries/combine_vol_data_adios_impl.f90 @@ -184,10 +184,10 @@ subroutine read_scalars_adios_mesh(mesh_handle, iproc, ir, nglob, nspec) call adios_selection_writeblock(sel, iproc) call adios_schedule_read(mesh_handle, sel, trim(reg_name) // "/nglob", 0, 1, nglob, ier) if (ier /= 0) then - print* - print* ,'Error adios: could not read parameter: ',trim(reg_name) // "/nglob" - print* ,' please check if your input mesh file is correct...' - print* + print * + print * ,'Error adios: could not read parameter: ',trim(reg_name) // "/nglob" + print * ,' please check if your input mesh file is correct...' + print * stop 'Error adios adios_schedule_read() for nglob' endif @@ -225,10 +225,10 @@ subroutine read_coordinates_adios_mesh(mesh_handle, iproc, ir, nglob, nspec, & call adios_schedule_read(mesh_handle, sel_scalar, trim(reg_name) // "ibool/offset", & 0, 1, offset_ibool, ier) if (ier /= 0) then - print* - print* ,'Error adios: could not read parameter: ',trim(reg_name) // "ibool/offset" - print* ,' please check if your input mesh file is correct...' - print* + print * + print * ,'Error adios: could not read parameter: ',trim(reg_name) // "ibool/offset" + print * ,' please check if your input mesh file is correct...' + print * stop 'Error adios adios_schedule_read() for ibool/offset' endif @@ -331,10 +331,10 @@ subroutine read_values_adios(value_handle, var_name, iproc, ir, nspec, data) call adios_schedule_read(value_handle, sel, trim(data_name) // "/offset", 0, 1, offset, ier) if (ier /= 0) then - print* - print* ,'Error adios: could not read parameter: ',trim(data_name) // "/offset" - print* ,' please check if your input data file is correct...' - print* + print * + print * ,'Error adios: could not read parameter: ',trim(data_name) // "/offset" + print * ,' please check if your input data file is correct...' + print * stop 'Error adios adios_schedule_read() for data offset' endif diff --git a/src/auxiliaries/create_movie_AVS_DX.f90 b/src/auxiliaries/create_movie_AVS_DX.f90 index be928f589..73b646aa6 100644 --- a/src/auxiliaries/create_movie_AVS_DX.f90 +++ b/src/auxiliaries/create_movie_AVS_DX.f90 @@ -315,7 +315,7 @@ program xcreate_movie_AVS_DX open(unit=IOUT,file=trim(OUTPUT_FILES)//trim(outputname), & status='old',action='read',form='unformatted',iostat=ierror) if (ierror /= 0) then - print*,'Error opening file: ',trim(OUTPUT_FILES)//trim(outputname) + print *,'Error opening file: ',trim(OUTPUT_FILES)//trim(outputname) stop 'Error opening moviedata file' endif @@ -347,7 +347,7 @@ program xcreate_movie_AVS_DX open(unit=IOUT,file=trim(OUTPUT_FILES)//outputname, & status='old',action='read',form='unformatted',iostat=ierror) if (ierror /= 0) then - print*,'Error opening file: ',trim(OUTPUT_FILES)//outputname + print *,'Error opening file: ',trim(OUTPUT_FILES)//outputname stop 'Error opening moviedata file' endif diff --git a/src/auxiliaries/create_movie_GMT_global.f90 b/src/auxiliaries/create_movie_GMT_global.f90 index cfa69e395..a6350a01d 100644 --- a/src/auxiliaries/create_movie_GMT_global.f90 +++ b/src/auxiliaries/create_movie_GMT_global.f90 @@ -347,7 +347,7 @@ program create_movie_GMT_global open(unit=IOUT,file=trim(OUTPUT_FILES)//trim(outputname), & status='old',action='read',form='unformatted',iostat=ierror) if (ierror /= 0) then - print*,'Error opening file: ',trim(OUTPUT_FILES)//trim(outputname) + print *,'Error opening file: ',trim(OUTPUT_FILES)//trim(outputname) stop 'Error opening moviedata file' endif @@ -381,7 +381,7 @@ program create_movie_GMT_global open(unit=IOUT,file=trim(OUTPUT_FILES)//trim(outputname), & status='old',action='read',form='unformatted',iostat=ierror) if (ierror /= 0) then - print*,'Error opening file: ',trim(OUTPUT_FILES)//trim(outputname) + print *,'Error opening file: ',trim(OUTPUT_FILES)//trim(outputname) stop 'Error opening moviedata file' endif @@ -405,7 +405,7 @@ program create_movie_GMT_global ! initialize factor mute_factor = 1.0 - print*,'simulation time: ',(it-1)*DT - t0,'(s)' + print *,'simulation time: ',(it-1)*DT - t0,'(s)' ! muting radius grows/shrinks with time if ((it-1)*DT - t0 > STARTTIME_TO_MUTE) then @@ -430,7 +430,7 @@ program create_movie_GMT_global if (distance < 0.0 ) distance = 0.0 if (distance > 80.0 ) distance = 80.0 - print*,'muting radius: ',0.7 * distance,'(degrees)' + print *,'muting radius: ',0.7 * distance,'(degrees)' ! new radius of mute area (in rad) RADIUS_TO_MUTE = 0.7 * distance * DEGREES_TO_RADIANS @@ -663,7 +663,7 @@ program create_movie_GMT_global if (zmesh < SMALL_VAL_ANGLE .and. zmesh >= ZERO) zmesh = SMALL_VAL_ANGLE thetaval = atan2(sqrt(xmesh*xmesh+ymesh*ymesh),zmesh) ! thetaval between 0 and PI / 2 - !print*,'thetaval:',thetaval * 180. / PI + !print *,'thetaval:',thetaval * 180. / PI ! close to north pole if (thetaval >= 0.495 * PI ) istamp1 = ieoff ! close to south pole diff --git a/src/gpu/kernels.gen/crust_mantle_impl_kernel_adjoint.cu b/src/gpu/kernels.gen/crust_mantle_impl_kernel_adjoint.cu index 2a1989e14..5b8427fab 100644 --- a/src/gpu/kernels.gen/crust_mantle_impl_kernel_adjoint.cu +++ b/src/gpu/kernels.gen/crust_mantle_impl_kernel_adjoint.cu @@ -437,7 +437,7 @@ static __device__ void compute_element_cm_tiso(const int offset, const float * d *(sigma_xz) = (c15) * (duxdxl) + (c56) * (duxdyl_plus_duydxl) + (c25) * (duydyl) + (c55) * (duzdxl_plus_duxdzl) + (c45) * (duzdyl_plus_duydzl) + (c35) * (duzdzl); *(sigma_yz) = (c14) * (duxdxl) + (c46) * (duxdyl_plus_duydxl) + (c24) * (duydyl) + (c45) * (duzdxl_plus_duxdzl) + (c44) * (duzdyl_plus_duydzl) + (c34) * (duzdzl); } -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif diff --git a/src/gpu/kernels.gen/crust_mantle_impl_kernel_forward.cu b/src/gpu/kernels.gen/crust_mantle_impl_kernel_forward.cu index 5a1a07fb7..708b4192a 100644 --- a/src/gpu/kernels.gen/crust_mantle_impl_kernel_forward.cu +++ b/src/gpu/kernels.gen/crust_mantle_impl_kernel_forward.cu @@ -437,7 +437,7 @@ static __device__ void compute_element_cm_tiso(const int offset, const float * d *(sigma_xz) = (c15) * (duxdxl) + (c56) * (duxdyl_plus_duydxl) + (c25) * (duydyl) + (c55) * (duzdxl_plus_duxdzl) + (c45) * (duzdyl_plus_duydzl) + (c35) * (duzdzl); *(sigma_yz) = (c14) * (duxdxl) + (c46) * (duxdyl_plus_duydxl) + (c24) * (duydyl) + (c45) * (duzdxl_plus_duxdzl) + (c44) * (duzdyl_plus_duydzl) + (c34) * (duzdzl); } -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif diff --git a/src/gpu/kernels.gen/inner_core_impl_kernel_adjoint.cu b/src/gpu/kernels.gen/inner_core_impl_kernel_adjoint.cu index 4c442d0bb..e9673c1bd 100644 --- a/src/gpu/kernels.gen/inner_core_impl_kernel_adjoint.cu +++ b/src/gpu/kernels.gen/inner_core_impl_kernel_adjoint.cu @@ -220,7 +220,7 @@ static __device__ void compute_element_ic_gravity(const int tx, const int iglob, rho_s_H2[0] = (factor) * ((sx_l) * (Hxyl) + (sy_l) * (Hyyl) + (sz_l) * (Hyzl)); rho_s_H3[0] = (factor) * ((sx_l) * (Hxzl) + (sy_l) * (Hyzl) + (sz_l) * (Hzzl)); } -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif diff --git a/src/gpu/kernels.gen/inner_core_impl_kernel_forward.cu b/src/gpu/kernels.gen/inner_core_impl_kernel_forward.cu index d86410662..2f9e03a20 100644 --- a/src/gpu/kernels.gen/inner_core_impl_kernel_forward.cu +++ b/src/gpu/kernels.gen/inner_core_impl_kernel_forward.cu @@ -220,7 +220,7 @@ static __device__ void compute_element_ic_gravity(const int tx, const int iglob, rho_s_H2[0] = (factor) * ((sx_l) * (Hxyl) + (sy_l) * (Hyyl) + (sz_l) * (Hyzl)); rho_s_H3[0] = (factor) * ((sx_l) * (Hxzl) + (sy_l) * (Hyzl) + (sz_l) * (Hzzl)); } -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif diff --git a/src/gpu/kernels.gen/kernel_proto.cu.h b/src/gpu/kernels.gen/kernel_proto.cu.h index 372502491..a27a82df6 100644 --- a/src/gpu/kernels.gen/kernel_proto.cu.h +++ b/src/gpu/kernels.gen/kernel_proto.cu.h @@ -37,22 +37,22 @@ __global__ void compute_iso_undoatt_kernel(const float * epsilondev_xx, const fl __global__ void compute_strain_kernel(const float * d_displ, const float * d_veloc, float * epsilondev_xx, float * epsilondev_yy, float * epsilondev_xy, float * epsilondev_xz, float * epsilondev_yz, float * epsilon_trace_over_3, const int NSPEC, const int NSPEC_STRAIN_ONLY, const float deltat, const int * d_ibool, const float * d_xix, const float * d_xiy, const float * d_xiz, const float * d_etax, const float * d_etay, const float * d_etaz, const float * d_gammax, const float * d_gammay, const float * d_gammaz, const float * d_hprime_xx); __global__ void outer_core_impl_kernel_forward(const int nb_blocks_to_compute, const int * d_ibool, const int * d_phase_ispec_inner, const int num_phase_ispec, const int d_iphase, const int use_mesh_coloring_gpu, const float * __restrict__ d_potential, float * d_potential_dot_dot, const float * __restrict__ d_xix, const float * __restrict__ d_xiy, const float * __restrict__ d_xiz, const float * __restrict__ d_etax, const float * __restrict__ d_etay, const float * __restrict__ d_etaz, const float * __restrict__ d_gammax, const float * __restrict__ d_gammay, const float * __restrict__ d_gammaz, const float * __restrict__ d_hprime_xx, const float * __restrict__ d_hprimewgll_xx, const float * __restrict__ wgllwgll_xy, const float * __restrict__ wgllwgll_xz, const float * __restrict__ wgllwgll_yz, const int GRAVITY, const float * __restrict__ d_xstore, const float * __restrict__ d_ystore, const float * __restrict__ d_zstore, const float * __restrict__ d_d_ln_density_dr_table, const float * __restrict__ d_minus_rho_g_over_kappa_fluid, const float * __restrict__ wgll_cube, const int ROTATION, const float time, const float two_omega_earth, const float deltat, float * d_A_array_rotation, float * d_B_array_rotation, const int NSPEC_OUTER_CORE); __global__ void outer_core_impl_kernel_adjoint(const int nb_blocks_to_compute, const int * d_ibool, const int * d_phase_ispec_inner, const int num_phase_ispec, const int d_iphase, const int use_mesh_coloring_gpu, const float * __restrict__ d_potential, float * d_potential_dot_dot, const float * __restrict__ d_xix, const float * __restrict__ d_xiy, const float * __restrict__ d_xiz, const float * __restrict__ d_etax, const float * __restrict__ d_etay, const float * __restrict__ d_etaz, const float * __restrict__ d_gammax, const float * __restrict__ d_gammay, const float * __restrict__ d_gammaz, const float * __restrict__ d_hprime_xx, const float * __restrict__ d_hprimewgll_xx, const float * __restrict__ wgllwgll_xy, const float * __restrict__ wgllwgll_xz, const float * __restrict__ wgllwgll_yz, const int GRAVITY, const float * __restrict__ d_xstore, const float * __restrict__ d_ystore, const float * __restrict__ d_zstore, const float * __restrict__ d_d_ln_density_dr_table, const float * __restrict__ d_minus_rho_g_over_kappa_fluid, const float * __restrict__ wgll_cube, const int ROTATION, const float time, const float two_omega_earth, const float deltat, float * d_A_array_rotation, float * d_B_array_rotation, const int NSPEC_OUTER_CORE); -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif void inner_core_impl_kernel_forward(const int nb_blocks_to_compute, const int * d_ibool, const int * d_idoubling, const int * d_phase_ispec_inner, const int num_phase_ispec, const int d_iphase, const float deltat, const int use_mesh_coloring_gpu, const float * __restrict__ d_displ, float * d_accel, const float * __restrict__ d_xix, const float * __restrict__ d_xiy, const float * __restrict__ d_xiz, const float * __restrict__ d_etax, const float * __restrict__ d_etay, const float * __restrict__ d_etaz, const float * __restrict__ d_gammax, const float * __restrict__ d_gammay, const float * __restrict__ d_gammaz, const float * __restrict__ d_hprime_xx, const float * __restrict__ d_hprimewgll_xx, const float * __restrict__ d_wgllwgll_xy, const float * __restrict__ d_wgllwgll_xz, const float * __restrict__ d_wgllwgll_yz, const float * __restrict__ d_kappavstore, const float * __restrict__ d_muvstore, const int COMPUTE_AND_STORE_STRAIN, float * epsilondev_xx, float * epsilondev_yy, float * epsilondev_xy, float * epsilondev_xz, float * epsilondev_yz, float * epsilon_trace_over_3, const int ATTENUATION, const int PARTIAL_PHYS_DISPERSION_ONLY, const int USE_3D_ATTENUATION_ARRAYS, const float * __restrict__ one_minus_sum_beta, const float * __restrict__ factor_common, float * R_xx, float * R_yy, float * R_xy, float * R_xz, float * R_yz, const float * __restrict__ alphaval, const float * __restrict__ betaval, const float * __restrict__ gammaval, const int ANISOTROPY, const float * __restrict__ d_c11store, const float * __restrict__ d_c12store, const float * __restrict__ d_c13store, const float * __restrict__ d_c33store, const float * __restrict__ d_c44store, const int GRAVITY, const float * __restrict__ d_xstore, const float * __restrict__ d_ystore, const float * __restrict__ d_zstore, const float * __restrict__ d_minus_gravity_table, const float * __restrict__ d_minus_deriv_gravity_table, const float * __restrict__ d_density_table, const float * __restrict__ wgll_cube, const int NSPEC_INNER_CORE_STRAIN_ONLY, const int NSPEC_INNER_CORE); -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif void inner_core_impl_kernel_adjoint(const int nb_blocks_to_compute, const int * d_ibool, const int * d_idoubling, const int * d_phase_ispec_inner, const int num_phase_ispec, const int d_iphase, const float deltat, const int use_mesh_coloring_gpu, const float * __restrict__ d_displ, float * d_accel, const float * __restrict__ d_xix, const float * __restrict__ d_xiy, const float * __restrict__ d_xiz, const float * __restrict__ d_etax, const float * __restrict__ d_etay, const float * __restrict__ d_etaz, const float * __restrict__ d_gammax, const float * __restrict__ d_gammay, const float * __restrict__ d_gammaz, const float * __restrict__ d_hprime_xx, const float * __restrict__ d_hprimewgll_xx, const float * __restrict__ d_wgllwgll_xy, const float * __restrict__ d_wgllwgll_xz, const float * __restrict__ d_wgllwgll_yz, const float * __restrict__ d_kappavstore, const float * __restrict__ d_muvstore, const int COMPUTE_AND_STORE_STRAIN, float * epsilondev_xx, float * epsilondev_yy, float * epsilondev_xy, float * epsilondev_xz, float * epsilondev_yz, float * epsilon_trace_over_3, const int ATTENUATION, const int PARTIAL_PHYS_DISPERSION_ONLY, const int USE_3D_ATTENUATION_ARRAYS, const float * __restrict__ one_minus_sum_beta, const float * __restrict__ factor_common, float * R_xx, float * R_yy, float * R_xy, float * R_xz, float * R_yz, const float * __restrict__ alphaval, const float * __restrict__ betaval, const float * __restrict__ gammaval, const int ANISOTROPY, const float * __restrict__ d_c11store, const float * __restrict__ d_c12store, const float * __restrict__ d_c13store, const float * __restrict__ d_c33store, const float * __restrict__ d_c44store, const int GRAVITY, const float * __restrict__ d_xstore, const float * __restrict__ d_ystore, const float * __restrict__ d_zstore, const float * __restrict__ d_minus_gravity_table, const float * __restrict__ d_minus_deriv_gravity_table, const float * __restrict__ d_density_table, const float * __restrict__ wgll_cube, const int NSPEC_INNER_CORE_STRAIN_ONLY, const int NSPEC_INNER_CORE); -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif void crust_mantle_impl_kernel_forward(const int nb_blocks_to_compute, const int * d_ibool, const int * d_ispec_is_tiso, const int * d_phase_ispec_inner, const int num_phase_ispec, const int d_iphase, const float deltat, const int use_mesh_coloring_gpu, const float * __restrict__ d_displ, float * d_accel, const float * __restrict__ d_xix, const float * __restrict__ d_xiy, const float * __restrict__ d_xiz, const float * __restrict__ d_etax, const float * __restrict__ d_etay, const float * __restrict__ d_etaz, const float * __restrict__ d_gammax, const float * __restrict__ d_gammay, const float * __restrict__ d_gammaz, const float * __restrict__ d_hprime_xx, const float * __restrict__ d_hprimewgll_xx, const float * __restrict__ d_wgllwgll_xy, const float * __restrict__ d_wgllwgll_xz, const float * __restrict__ d_wgllwgll_yz, const float * __restrict__ d_kappavstore, const float * __restrict__ d_muvstore, const float * __restrict__ d_kappahstore, const float * __restrict__ d_muhstore, const float * __restrict__ d_eta_anisostore, const int COMPUTE_AND_STORE_STRAIN, float * epsilondev_xx, float * epsilondev_yy, float * epsilondev_xy, float * epsilondev_xz, float * epsilondev_yz, float * epsilon_trace_over_3, const int ATTENUATION, const int PARTIAL_PHYS_DISPERSION_ONLY, const int USE_3D_ATTENUATION_ARRAYS, const float * __restrict__ one_minus_sum_beta, const float * __restrict__ factor_common, float * R_xx, float * R_yy, float * R_xy, float * R_xz, float * R_yz, const float * __restrict__ alphaval, const float * __restrict__ betaval, const float * __restrict__ gammaval, const int ANISOTROPY, const float * __restrict__ d_c11store, const float * __restrict__ d_c12store, const float * __restrict__ d_c13store, const float * __restrict__ d_c14store, const float * __restrict__ d_c15store, const float * __restrict__ d_c16store, const float * __restrict__ d_c22store, const float * __restrict__ d_c23store, const float * __restrict__ d_c24store, const float * __restrict__ d_c25store, const float * __restrict__ d_c26store, const float * __restrict__ d_c33store, const float * __restrict__ d_c34store, const float * __restrict__ d_c35store, const float * __restrict__ d_c36store, const float * __restrict__ d_c44store, const float * __restrict__ d_c45store, const float * __restrict__ d_c46store, const float * __restrict__ d_c55store, const float * __restrict__ d_c56store, const float * __restrict__ d_c66store, const int GRAVITY, const float * __restrict__ d_xstore, const float * __restrict__ d_ystore, const float * __restrict__ d_zstore, const float * __restrict__ d_minus_gravity_table, const float * __restrict__ d_minus_deriv_gravity_table, const float * __restrict__ d_density_table, const float * __restrict__ wgll_cube, const int NSPEC_CRUST_MANTLE_STRAIN_ONLY); -__global__ +__global__ #ifdef USE_LAUNCH_BOUNDS __launch_bounds__(NGLL3_PADDED, LAUNCH_MIN_BLOCKS) #endif diff --git a/src/gpu/noise_tomography_gpu.c b/src/gpu/noise_tomography_gpu.c index 833a5254c..be78888e7 100644 --- a/src/gpu/noise_tomography_gpu.c +++ b/src/gpu/noise_tomography_gpu.c @@ -176,7 +176,7 @@ void FC_FUNC_ (noise_add_surface_movie_gpu, #endif // note: the data copy here is blocking and waits for the operation to finish // to speed up noise simulations, one could try an asynchronuous/non-blocking copy to overlap computations - + // copies surface movie to GPU gpuCopy_todevice_realw (&mp->d_noise_surface_movie, h_noise_surface_movie, NDIM*NGLL2 *(mp->nspec2D_top_crust_mantle)); diff --git a/src/meshfem3D/add_topography_410_650.f90 b/src/meshfem3D/add_topography_410_650.f90 index dd08b2d47..d3e00bd8d 100644 --- a/src/meshfem3D/add_topography_410_650.f90 +++ b/src/meshfem3D/add_topography_410_650.f90 @@ -101,7 +101,7 @@ subroutine add_topography_410_650(myrank,xelm,yelm,zelm) if ( topo650out < min_650 ) min_650 = topo650out if ( topo650out > max_650 ) max_650 = topo650out ! debug - !print*,'topo410 / topo650: ',r,xcolat,xlon,topo410out,topo650out + !print *,'topo410 / topo650: ',r,xcolat,xlon,topo410out,topo650out endif ! non-dimensionalize the topography, which is in km @@ -142,12 +142,12 @@ subroutine add_topography_410_650(myrank,xelm,yelm,zelm) call max_all_cr(max_650,max_650_all) if (myrank == 0) then if (r <= R220/R_EARTH .and. r >= R771/R_EARTH) then - print*,'add_topography_410_650: min/max_410 = ',min_410_all,max_410_all,'min/max_650 = ',min_650_all,max_650_all + print *,'add_topography_410_650: min/max_410 = ',min_410_all,max_410_all,'min/max_650 = ',min_650_all,max_650_all endif endif !if (r <= R220/R_EARTH .and. r >= R771/R_EARTH) then - ! print*,myrank,'add_topography_410_650: min/max_410 = ',min_410,max_410,'min/max_650 = ',min_650,max_650 - ! print*,myrank,'add_topography_410_650: depth = ',(1.d0 - r)*R_EARTH_KM,' 410-km = ',topo410out,' 650-km = ',topo650out + ! print *,myrank,'add_topography_410_650: min/max_410 = ',min_410,max_410,'min/max_650 = ',min_650,max_650 + ! print *,myrank,'add_topography_410_650: depth = ',(1.d0 - r)*R_EARTH_KM,' 410-km = ',topo410out,' 650-km = ',topo650out !endif endif diff --git a/src/meshfem3D/calc_jacobian.f90 b/src/meshfem3D/calc_jacobian.f90 index f6a514d27..3e53d9cbd 100644 --- a/src/meshfem3D/calc_jacobian.f90 +++ b/src/meshfem3D/calc_jacobian.f90 @@ -198,10 +198,10 @@ subroutine recalc_jacobian_gll3D(myrank,xstore,ystore,zstore,xigll,yigll,zigll,& ! ! converts position to geocentric coordinates call xyz_2_rthetaphi_dble(xmesh,ymesh,zmesh,r,theta,phi) - print*,'Error Jacobian rank:',myrank - print*,' location r/lat/lon: ',r*R_EARTH_KM, & + print *,'Error Jacobian rank:',myrank + print *,' location r/lat/lon: ',r*R_EARTH_KM, & 90.0-(theta*RADIANS_TO_DEGREES),phi*RADIANS_TO_DEGREES - print*,' Jacobian: ',jacobian + print *,' Jacobian: ',jacobian call exit_MPI(myrank,'3D Jacobian undefined in recalc_jacobian_gll3D.f90') endif diff --git a/src/meshfem3D/create_MPI_interfaces.f90 b/src/meshfem3D/create_MPI_interfaces.f90 index 2a8fa3e64..dde2d70ab 100644 --- a/src/meshfem3D/create_MPI_interfaces.f90 +++ b/src/meshfem3D/create_MPI_interfaces.f90 @@ -637,13 +637,13 @@ subroutine cmi_read_buffer_data(iregion_code, & icount_faces = icount_faces + 1 if (icount_faces > NUMFACES_SHARED) then - print*,'Error ',myrank,' icount_faces: ',icount_faces,'NUMFACES_SHARED:',NUMFACES_SHARED - print*,'iregion_code:',iregion_code + print *,'Error ',myrank,' icount_faces: ',icount_faces,'NUMFACES_SHARED:',NUMFACES_SHARED + print *,'iregion_code:',iregion_code call exit_MPI(myrank,'more than NUMFACES_SHARED faces for this slice') endif if (icount_faces > 2 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) then - print*,'Error ',myrank,' icount_faces: ',icount_faces,'NPROC_XI:',NPROC_XI,'NPROC_ETA:',NPROC_ETA - print*,'iregion_code:',iregion_code + print *,'Error ',myrank,' icount_faces: ',icount_faces,'NPROC_XI:',NPROC_XI,'NPROC_ETA:',NPROC_ETA + print *,'iregion_code:',iregion_code call exit_MPI(myrank,'more than two faces for this slice') endif endif diff --git a/src/meshfem3D/create_central_cube_buffers.f90 b/src/meshfem3D/create_central_cube_buffers.f90 index 9528876aa..dba5a33a7 100644 --- a/src/meshfem3D/create_central_cube_buffers.f90 +++ b/src/meshfem3D/create_central_cube_buffers.f90 @@ -183,7 +183,7 @@ subroutine create_central_cube_buffers(myrank,iproc_xi,iproc_eta,ichunk, & ! check that total number of faces found is correct if (imsg /= nb_msgs_theor_in_cube) then - print*,'Error ',myrank,'nb_msgs_theor_in_cube:',nb_msgs_theor_in_cube,imsg + print *,'Error ',myrank,'nb_msgs_theor_in_cube:',nb_msgs_theor_in_cube,imsg call exit_MPI(myrank,'wrong number of faces found for central cube') endif @@ -258,7 +258,7 @@ subroutine create_central_cube_buffers(myrank,iproc_xi,iproc_eta,ichunk, & ! check that total number of faces found is correct if (imsg /= nb_msgs_theor_in_cube) then - print*,'Error ',myrank,'nb_msgs_theor_in_cube:',nb_msgs_theor_in_cube,imsg + print *,'Error ',myrank,'nb_msgs_theor_in_cube:',nb_msgs_theor_in_cube,imsg call exit_MPI(myrank,'wrong number of faces found for central cube') endif @@ -336,7 +336,7 @@ subroutine create_central_cube_buffers(myrank,iproc_xi,iproc_eta,ichunk, & endif enddo if (ipoin /= npoin2D_cube_from_slices) then - print*,'Error',myrank,'bottom points:',npoin2D_cube_from_slices,ipoin + print *,'Error',myrank,'bottom points:',npoin2D_cube_from_slices,ipoin call exit_MPI(myrank,'wrong number of points found for bottom CC AB or !AB') endif diff --git a/src/meshfem3D/create_chunk_buffers.f90 b/src/meshfem3D/create_chunk_buffers.f90 index 4b52ef905..a5fb8c90e 100644 --- a/src/meshfem3D/create_chunk_buffers.f90 +++ b/src/meshfem3D/create_chunk_buffers.f90 @@ -730,8 +730,8 @@ subroutine create_chunk_buffers(iregion_code,nspec,ibool,idoubling, & ! checks bounds if (npoin2D_faces(icount_faces) > NGLOB2DMAX_XY) then - print*,'Error ',myrank,' npoin2D_faces: ',npoin2D_faces(icount_faces),icount_faces - print*,'iregion_code:',iregion_code + print *,'Error ',myrank,' npoin2D_faces: ',npoin2D_faces(icount_faces),icount_faces + print *,'iregion_code:',iregion_code call exit_MPI(myrank,'incorrect nb of points in face buffer') endif @@ -1020,8 +1020,8 @@ subroutine create_chunk_buffers(iregion_code,nspec,ibool,idoubling, & ! check that no duplicates have been found if (nglob /= NGLOB1D_RADIAL) then - print*,'Error ',myrank,' npoin1D_corner: ',nglob,'NGLOB1D_RADIAL:',NGLOB1D_RADIAL - print*,'iregion_code:',iregion_code + print *,'Error ',myrank,' npoin1D_corner: ',nglob,'NGLOB1D_RADIAL:',NGLOB1D_RADIAL + print *,'iregion_code:',iregion_code call exit_MPI(myrank,'duplicates found for corners') endif @@ -1030,8 +1030,8 @@ subroutine create_chunk_buffers(iregion_code,nspec,ibool,idoubling, & ! checks counter if (icount_corners > 1 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) then - print*,'Error ',myrank,'icount_corners:',icount_corners - print*,'iregion_code:',iregion_code + print *,'Error ',myrank,'icount_corners:',icount_corners + print *,'iregion_code:',iregion_code call exit_MPI(myrank,'more than one corner for this slice') endif if (icount_corners > 4) call exit_MPI(myrank,'more than four corners for this slice') diff --git a/src/meshfem3D/get_MPI_interfaces.f90 b/src/meshfem3D/get_MPI_interfaces.f90 index 2e79120ec..193e6dd42 100644 --- a/src/meshfem3D/get_MPI_interfaces.f90 +++ b/src/meshfem3D/get_MPI_interfaces.f90 @@ -143,9 +143,9 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & ! checks ranks range if (rank < 0 .or. rank >= NPROCTOT) then - print*,'Error face rank: ',myrank,'ispec=',ispec - print*,' neighbor rank = ',rank,'exceeds total nproc:',NPROCTOT - print*,' face ',iface + print *,'Error face rank: ',myrank,'ispec=',ispec + print *,' neighbor rank = ',rank,'exceeds total nproc:',NPROCTOT + print *,' face ',iface call exit_mpi(myrank,'Error face neighbor MPI rank') endif @@ -164,7 +164,7 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & if (.not. is_done) then iinterface = iinterface + 1 if (iinterface > MAX_NEIGHBOURS) then - print*,'Error interfaces rank:',myrank,'iinterface = ',iinterface,MAX_NEIGHBOURS + print *,'Error interfaces rank:',myrank,'iinterface = ',iinterface,MAX_NEIGHBOURS call exit_mpi(myrank,'interface face exceeds MAX_NEIGHBOURS range') endif ! adds as neighbor new interface @@ -209,12 +209,12 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & if (work_test_flag(iglob) < 0) then if (IREGION == IREGION_INNER_CORE .and. INCLUDE_CENTRAL_CUBE) then ! we might have missed an interface point on an edge, just re-set to missing value - print*,'warning face flag:',myrank,'ispec=',ispec,'rank=',rank - print*,' flag=',work_test_flag(iglob),'iface jk=',iface,j,k,'missed iglob=',iglob + print *,'warning face flag:',myrank,'ispec=',ispec,'rank=',rank + print *,' flag=',work_test_flag(iglob),'iface jk=',iface,j,k,'missed iglob=',iglob !work_test_flag(iglob) = 0 else - print*,'Error face flag:',myrank,'ispec=',ispec,'rank=',rank - print*,' flag=',work_test_flag(iglob),'iface jk=',iface,j,k,'iglob=',iglob + print *,'Error face flag:',myrank,'ispec=',ispec,'rank=',rank + print *,' flag=',work_test_flag(iglob),'iface jk=',iface,j,k,'iglob=',iglob call exit_mpi(myrank,'Error face flag') endif endif @@ -279,9 +279,9 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & ! checks ranks range if (rank < 0 .or. rank >= NPROCTOT) then - print*,'Error egde rank: ',myrank - print*,' neighbor rank = ',rank,'exceeds total nproc:',NPROCTOT - print*,' edge ',iedge + print *,'Error egde rank: ',myrank + print *,' neighbor rank = ',rank,'exceeds total nproc:',NPROCTOT + print *,' edge ',iedge call exit_mpi(myrank,'Error edge neighbor MPI rank') endif @@ -300,7 +300,7 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & if (.not. is_done) then iinterface = iinterface + 1 if (iinterface > MAX_NEIGHBOURS) then - print*,'Error interfaces rank:',myrank,'iinterface = ',iinterface,MAX_NEIGHBOURS + print *,'Error interfaces rank:',myrank,'iinterface = ',iinterface,MAX_NEIGHBOURS call exit_mpi(myrank,'interface edge exceeds MAX_NEIGHBOURS range') endif ! adds as neighbor new interface @@ -363,12 +363,12 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & if (work_test_flag(iglob) < 0) then if (IREGION == IREGION_INNER_CORE .and. INCLUDE_CENTRAL_CUBE) then ! we might have missed an interface point on an edge, just re-set to missing value - print*,'warning edge flag:',myrank,'ispec=',ispec,'rank=',rank - print*,' flag=',work_test_flag(iglob),'iedge jk=',iedge,k,'missed iglob=',iglob + print *,'warning edge flag:',myrank,'ispec=',ispec,'rank=',rank + print *,' flag=',work_test_flag(iglob),'iedge jk=',iedge,k,'missed iglob=',iglob !work_test_flag(iglob) = 0 else - print*,'Error edge flag:',myrank,'ispec=',ispec,'rank=',rank - print*,' flag=',work_test_flag(iglob),'iedge jk=',iedge,k,'iglob=',iglob + print *,'Error edge flag:',myrank,'ispec=',ispec,'rank=',rank + print *,' flag=',work_test_flag(iglob),'iedge jk=',iedge,k,'iglob=',iglob call exit_mpi(myrank,'Error edge flag') endif endif @@ -432,9 +432,9 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & ! checks ranks range if (rank < 0 .or. rank >= NPROCTOT) then - print*,'Error corner: ',myrank - print*,' neighbor rank = ',rank,'exceeds total nproc:',NPROCTOT - print*,' corner ',icorner + print *,'Error corner: ',myrank + print *,' neighbor rank = ',rank,'exceeds total nproc:',NPROCTOT + print *,' corner ',icorner call exit_mpi(myrank,'Error corner neighbor MPI rank') endif @@ -453,7 +453,7 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & if (.not. is_done) then iinterface = iinterface + 1 if (iinterface > MAX_NEIGHBOURS) then - print*,'Error interfaces rank:',myrank,'iinterface = ',iinterface,MAX_NEIGHBOURS + print *,'Error interfaces rank:',myrank,'iinterface = ',iinterface,MAX_NEIGHBOURS call exit_mpi(myrank,'interface corner exceed MAX_NEIGHBOURS range') endif ! adds as neighbor new interface @@ -491,19 +491,19 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & ! debug: user output if (add_central_cube) then - print*, 'rank',myrank,'interfaces : ',iinterface + print *, 'rank',myrank,'interfaces : ',iinterface do j = 1,iinterface - print*, ' my_neighbours: ',my_neighbours(j),nibool_neighbours(j) + print *, ' my_neighbours: ',my_neighbours(j),nibool_neighbours(j) enddo - print*, ' test flag min/max: ',minval(work_test_flag),maxval(work_test_flag) - print*, ' outer elements: ',npoin - print* + print *, ' test flag min/max: ',minval(work_test_flag),maxval(work_test_flag) + print *, ' outer elements: ',npoin + print * endif ! checks if all points were recognized if (minval(work_test_flag) < 0 .or. maxval(work_test_flag) > 0) then - print*,'Error MPI interface rank: ',myrank - print*,' work_test_flag min/max :',minval(work_test_flag),maxval(work_test_flag) + print *,'Error MPI interface rank: ',myrank + print *,' work_test_flag min/max :',minval(work_test_flag),maxval(work_test_flag) call exit_mpi(myrank,'Error: MPI points remain unrecognized, please check mesh interfaces') endif @@ -516,7 +516,7 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & rank = my_neighbours(ii) do j = ii+1,num_interfaces if (rank == my_neighbours(j)) then - print*,'test MPI: rank ',myrank,'my_neighbours:',rank,my_neighbours(j),'interfaces:',ii,j + print *,'test MPI: rank ',myrank,'my_neighbours:',rank,my_neighbours(j),'interfaces:',ii,j call exit_mpi(myrank,'Error test my_neighbours not unique') endif enddo @@ -535,12 +535,12 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & if (IREGION == IREGION_INNER_CORE .and. INCLUDE_CENTRAL_CUBE) then ! missing points might have been counted more than once if (ibool_neighbours(j,iinterface) > 0) then - print*,'warning MPI interface rank:',myrank - print*,' interface: ',my_neighbours(iinterface),'point: ',j,'of',npoin,'iglob=',ibool_neighbours(j,iinterface) + print *,'warning MPI interface rank:',myrank + print *,' interface: ',my_neighbours(iinterface),'point: ',j,'of',npoin,'iglob=',ibool_neighbours(j,iinterface) ! decrease number of points nibool_neighbours(iinterface) = nibool_neighbours(iinterface) - 1 if (nibool_neighbours(iinterface) <= 0) then - print*,'Error zero MPI interface rank:',myrank,'interface=',my_neighbours(iinterface) + print *,'Error zero MPI interface rank:',myrank,'interface=',my_neighbours(iinterface) call exit_mpi(myrank,'Error: zero MPI points on interface') endif ! shift values @@ -554,8 +554,8 @@ subroutine get_MPI_interfaces(myrank,NGLOB,NSPEC, & max_nibool_interfaces = maxval( nibool_neighbours(1:num_interfaces) ) endif else - print*,'Error MPI interface rank:',myrank - print*,' interface: ',my_neighbours(iinterface),'point: ',j,'of',npoin,'iglob=',ibool_neighbours(j,iinterface) + print *,'Error MPI interface rank:',myrank + print *,' interface: ',my_neighbours(iinterface),'point: ',j,'of',npoin,'iglob=',ibool_neighbours(j,iinterface) call exit_mpi(myrank,'Error: MPI points not unique on interface') endif endif @@ -700,9 +700,9 @@ subroutine add_interface_point(iglob,rank,icurrent, & ! checks if flag was set correctly if (work_test_flag(iglob) <= 0) then ! we might have missed an interface point on an edge, just re-set to missing value - print*,'warning ',myrank,' flag: missed rank=',rank - print*,' flag=',work_test_flag(iglob),'missed iglob=',iglob,'interface=',icurrent - print* + print *,'warning ',myrank,' flag: missed rank=',rank + print *,' flag=',work_test_flag(iglob),'missed iglob=',iglob,'interface=',icurrent + print * endif ! we might have missed an interface point on an edge, just re-set to missing value if (is_face_edge) then diff --git a/src/meshfem3D/get_jacobian_boundaries.f90 b/src/meshfem3D/get_jacobian_boundaries.f90 index 798d19a4b..a5efb5b27 100644 --- a/src/meshfem3D/get_jacobian_boundaries.f90 +++ b/src/meshfem3D/get_jacobian_boundaries.f90 @@ -444,7 +444,7 @@ subroutine get_jacobian_boundaries(myrank,iboun,nspec,xstore,ystore,zstore, & ! check theoretical value of elements at the bottom if (ispecb5 /= NSPEC2D_BOTTOM) then - print*,'Error ispecb5:',ispecb5,NSPEC2D_BOTTOM + print *,'Error ispecb5:',ispecb5,NSPEC2D_BOTTOM call exit_MPI(myrank,'ispecb5 should equal NSPEC2D_BOTTOM') endif diff --git a/src/meshfem3D/get_model.F90 b/src/meshfem3D/get_model.F90 index b514fc8f7..d6988c446 100644 --- a/src/meshfem3D/get_model.F90 +++ b/src/meshfem3D/get_model.F90 @@ -178,8 +178,8 @@ subroutine get_model(myrank,iregion_code,ispec,nspec,idoubling, & ! checks vpv: if close to zero then there is probably an error if (vpv < TINYVAL) then - print*,'Error vpv: ',vpv,' vph:',vph,' vsv: ',vsv,' vsh: ',vsh,' rho:',rho - print*,'radius:',r*R_EARTH_KM + print *,'Error vpv: ',vpv,' vph:',vph,' vsv: ',vsv,' vsh: ',vsh,' rho:',rho + print *,'radius:',r*R_EARTH_KM call exit_mpi(myrank,'Error get_model values') endif @@ -305,8 +305,8 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & ! checks layers if (abs(rmax - rmin ) < TINYVAL) then ! there's probably an error - print*,'Error layer radius min/max:',rmin,rmax - print*,' point radius: ',r_prem + print *,'Error layer radius min/max:',rmin,rmax + print *,' point radius: ',r_prem call exit_mpi(myrank,'Error in get_model_check_idoubling() layer radius') endif @@ -324,8 +324,8 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & idoubling /= IFLAG_TOP_CENTRAL_CUBE .and. & idoubling /= IFLAG_IN_FICTITIOUS_CUBE) then call xyz_2_rthetaphi_dble(x,y,z,r,theta,phi) - print*,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS - print*,' idoubling/IFLAG: ',idoubling,IFLAG_INNER_CORE_NORMAL,'-to-',IFLAG_IN_FICTITIOUS_CUBE + print *,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS + print *,' idoubling/IFLAG: ',idoubling,IFLAG_INNER_CORE_NORMAL,'-to-',IFLAG_IN_FICTITIOUS_CUBE call exit_MPI(myrank,'Error in get_model_check_idoubling() wrong doubling flag for inner core point') endif ! @@ -334,8 +334,8 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & else if (r_m > RICB .and. r_m < RCMB) then if (idoubling /= IFLAG_OUTER_CORE_NORMAL) then call xyz_2_rthetaphi_dble(x,y,z,r,theta,phi) - print*,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS - print*,' idoubling/IFLAG: ',idoubling,IFLAG_OUTER_CORE_NORMAL + print *,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS + print *,' idoubling/IFLAG: ',idoubling,IFLAG_OUTER_CORE_NORMAL call exit_MPI(myrank,'Error in get_model_check_idoubling() wrong doubling flag for outer core point') endif ! @@ -344,9 +344,9 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & else if (r_m > RCMB .and. r_m < RTOPDDOUBLEPRIME) then if (idoubling /= IFLAG_MANTLE_NORMAL) then call xyz_2_rthetaphi_dble(x,y,z,r,theta,phi) - print*,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS - print*,' dprime radius/RCMB/RTOPDDOUBLEPRIME:',r_m, RCMB,RTOPDDOUBLEPRIME - print*,' idoubling/IFLAG: ',idoubling,IFLAG_MANTLE_NORMAL + print *,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS + print *,' dprime radius/RCMB/RTOPDDOUBLEPRIME:',r_m, RCMB,RTOPDDOUBLEPRIME + print *,' idoubling/IFLAG: ',idoubling,IFLAG_MANTLE_NORMAL call exit_MPI(myrank,'Error in get_model_check_idoubling() wrong doubling flag for D" point') endif ! @@ -355,8 +355,8 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & else if (r_m > RTOPDDOUBLEPRIME .and. r_m < R670) then if (idoubling /= IFLAG_MANTLE_NORMAL) then call xyz_2_rthetaphi_dble(x,y,z,r,theta,phi) - print*,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS - print*,' idoubling/IFLAG: ',idoubling,IFLAG_MANTLE_NORMAL + print *,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS + print *,' idoubling/IFLAG: ',idoubling,IFLAG_MANTLE_NORMAL call exit_MPI(myrank,'Error in get_model_check_idoubling() wrong doubling flag for top D" -> d670 point') endif @@ -366,8 +366,8 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & else if (r_m > R670 .and. r_m < R220) then if (idoubling /= IFLAG_670_220) then call xyz_2_rthetaphi_dble(x,y,z,r,theta,phi) - print*,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS - print*,' idoubling/IFLAG: ',idoubling,IFLAG_670_220 + print *,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS + print *,' idoubling/IFLAG: ',idoubling,IFLAG_670_220 call exit_MPI(myrank,'Error in get_model_check_idoubling() wrong doubling flag for d670 -> d220 point') endif @@ -377,8 +377,8 @@ subroutine get_model_check_idoubling(r_prem,x,y,z,rmin,rmax,idoubling, & else if (r_m > R220) then if (idoubling /= IFLAG_220_80 .and. idoubling /= IFLAG_80_MOHO .and. idoubling /= IFLAG_CRUST) then call xyz_2_rthetaphi_dble(x,y,z,r,theta,phi) - print*,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS - print*,' idoubling/IFLAG: ',idoubling,IFLAG_220_80,IFLAG_80_MOHO,IFLAG_CRUST + print *,'Error point r/lat/lon:',r_m,90.0 - theta/DEGREES_TO_RADIANS,phi/DEGREES_TO_RADIANS + print *,' idoubling/IFLAG: ',idoubling,IFLAG_220_80,IFLAG_80_MOHO,IFLAG_CRUST call exit_MPI(myrank,'Error in get_model_check_idoubling() wrong doubling flag for d220 -> Moho -> surface point') endif diff --git a/src/meshfem3D/get_perm_color.f90 b/src/meshfem3D/get_perm_color.f90 index a8b6c73f0..6f58ac0a1 100644 --- a/src/meshfem3D/get_perm_color.f90 +++ b/src/meshfem3D/get_perm_color.f90 @@ -373,7 +373,7 @@ subroutine get_color_faster(ibool, is_on_a_slice_edge, ispec_is_d, & mask_ibool(iglob5) .or. mask_ibool(iglob6) .or. mask_ibool(iglob7) .or. mask_ibool(iglob8)) then ! if element of this color has a common point with another element of that same color ! then there is a problem, the color set is not correct - print*,'Error check color:',icolor + print *,'Error check color:',icolor stop 'Error detected: found a common point inside a color set' else mask_ibool(iglob1) = .true. @@ -395,7 +395,7 @@ subroutine get_color_faster(ibool, is_on_a_slice_edge, ispec_is_d, & enddo ! debug output !if (myrank == 0) then - ! print*, ' the ',maxval(color),' color sets are OK' + ! print *, ' the ',maxval(color),' color sets are OK' !endif deallocate(mask_ibool) @@ -1068,7 +1068,7 @@ subroutine get_final_perm(color,perm,first_elem_number_in_this_color, & ! checks if (counter_outer + icounter -1 /= nspec_domain) then - print*,'Error: perm: ',nspec_domain,counter_outer,icounter,counter_outer+icounter-1 + print *,'Error: perm: ',nspec_domain,counter_outer,icounter,counter_outer+icounter-1 stop 'Error get_final_perm: counter incomplete' endif diff --git a/src/meshfem3D/initialize_mesher.f90 b/src/meshfem3D/initialize_mesher.f90 index 48477b865..08ee29d1e 100644 --- a/src/meshfem3D/initialize_mesher.f90 +++ b/src/meshfem3D/initialize_mesher.f90 @@ -74,7 +74,7 @@ subroutine initialize_mesher() ! check that the code is running with the requested number of processes if (sizeprocs /= NPROCTOT) then - if (myrank == 0) print*,'Error wrong number of MPI processes ',sizeprocs,' should be ',NPROCTOT,', please check...' + if (myrank == 0) print *,'Error wrong number of MPI processes ',sizeprocs,' should be ',NPROCTOT,', please check...' call exit_MPI(myrank,'wrong number of MPI processes') endif diff --git a/src/meshfem3D/model_crust_1_0.f90 b/src/meshfem3D/model_crust_1_0.f90 index 8d22e5c89..0f0ffd2c3 100644 --- a/src/meshfem3D/model_crust_1_0.f90 +++ b/src/meshfem3D/model_crust_1_0.f90 @@ -459,7 +459,7 @@ subroutine crust_1_0_CAPsmoothed(lat,lon,velp,vels,rho,thick) ! checks latitude/longitude if (lat > 90.0d0 .or. lat < -90.0d0 .or. lon > 180.0d0 .or. lon < -180.0d0) then - print*,'Error in lat/lon:',lat,lon + print *,'Error in lat/lon:',lat,lon stop 'Error in latitude/longitude range in crust1.0' endif @@ -501,7 +501,7 @@ subroutine crust_1_0_CAPsmoothed(lat,lon,velp,vels,rho,thick) ! checks latitude/longitude value if (xlat(i) > 90.0d0 .or. xlat(i) < -90.0d0 .or. xlon(i) > 180.0d0 .or. xlon(i) < -180.0d0) then - print*,'Error in lat/lon range:',xlat(i),xlon(i) + print *,'Error in lat/lon range:',xlat(i),xlon(i) stop 'Error in latitude/longitude range in crust1.0' endif @@ -509,7 +509,7 @@ subroutine crust_1_0_CAPsmoothed(lat,lon,velp,vels,rho,thick) if (icolat == 181) icolat = 180 ! checks if (icolat>180 .or. icolat<1) then - print*,'Error in lat/lon range: icolat = ',icolat + print *,'Error in lat/lon range: icolat = ',icolat stop 'Error in routine icolat/ilon crust1.0' endif @@ -517,7 +517,7 @@ subroutine crust_1_0_CAPsmoothed(lat,lon,velp,vels,rho,thick) if (ilon == 361) ilon = 1 ! checks if (ilon<1 .or. ilon>360) then - print*,'Error in lat/lon range: ilon = ',ilon + print *,'Error in lat/lon range: ilon = ',ilon stop 'Error in routine icolat/ilon crust1.0' endif diff --git a/src/meshfem3D/model_crust_2_0.f90 b/src/meshfem3D/model_crust_2_0.f90 index 1e1cd7434..9dcadae72 100644 --- a/src/meshfem3D/model_crust_2_0.f90 +++ b/src/meshfem3D/model_crust_2_0.f90 @@ -353,7 +353,7 @@ subroutine crust_2_0_CAPsmoothed(lat,lon,velp,vels,rho,thick,abbreviation,code,c ! checks latitude/longitude if (lat > 90.0d0 .or. lat < -90.0d0 .or. lon > 180.0d0 .or. lon < -180.0d0) then - print*,'Error in lat/lon:',lat,lon + print *,'Error in lat/lon:',lat,lon stop 'Error in latitude/longitude range in crust2.0' endif diff --git a/src/meshfem3D/model_crustmaps.f90 b/src/meshfem3D/model_crustmaps.f90 index 1e4e9938b..75b8a28ca 100644 --- a/src/meshfem3D/model_crustmaps.f90 +++ b/src/meshfem3D/model_crustmaps.f90 @@ -639,8 +639,8 @@ subroutine CAP_vardegree(lon,lat,xlon,xlat,weight,CAP_DEGREE,NTHETA,NPHI) ! checks cap degree size if (CAP_DEGREE < TINYVAL) then ! no cap smoothing - print*,'Error cap:',CAP_DEGREE - print*,' lat/lon:',lat,lon + print *,'Error cap:',CAP_DEGREE + print *,' lat/lon:',lat,lon stop 'Error cap_degree too small' endif @@ -719,7 +719,7 @@ subroutine CAP_vardegree(lon,lat,xlon,xlat,weight,CAP_DEGREE,NTHETA,NPHI) enddo if (abs(total - ONE) > 0.001d0) then - print*,'Error cap:',total,CAP_DEGREE + print *,'Error cap:',total,CAP_DEGREE stop 'Error in cap integration for variable degree' endif diff --git a/src/meshfem3D/model_epcrust.f90 b/src/meshfem3D/model_epcrust.f90 index 4b2487f27..8376c15c7 100644 --- a/src/meshfem3D/model_epcrust.f90 +++ b/src/meshfem3D/model_epcrust.f90 @@ -277,8 +277,8 @@ subroutine epcrust_smooth_base(x,y,x1,y1,weight) weight(:)=ZERO if (cap_degree_EP < TINYVAL) then - print*, 'Error cap:', cap_degree_EP - print*, 'lat/lon:', x,y + print *, 'Error cap:', cap_degree_EP + print *, 'lat/lon:', x,y stop 'Error cap_degree too small' endif @@ -342,7 +342,7 @@ subroutine epcrust_smooth_base(x,y,x1,y1,weight) enddo if (abs(total-1.0d0) > 0.001d0) then - print*,'Error cap:',total,cap_degree_EP + print *,'Error cap:',total,cap_degree_EP stop endif diff --git a/src/meshfem3D/model_gapp2.f90 b/src/meshfem3D/model_gapp2.f90 index 0cd3e44ab..2383ac3c9 100644 --- a/src/meshfem3D/model_gapp2.f90 +++ b/src/meshfem3D/model_gapp2.f90 @@ -120,9 +120,9 @@ subroutine read_mantle_gapmodel() ! checks bounds if (nnr /= mr .or. no /= mo .or. na /= ma) then - print*,'Error GAPP2 model bounds: ' - print*,' file dimensions: nnr,no,na = ',nnr,no,na - print*,' module dimensions: mr,mo,ma = ',mr,mo,ma + print *,'Error GAPP2 model bounds: ' + print *,' file dimensions: nnr,no,na = ',nnr,no,na + print *,' module dimensions: mr,mo,ma = ',mr,mo,ma close(IIN) call exit_MPI(0,'please check GAPP2 model dimensions, and update model_gapp2.f90') endif @@ -133,9 +133,9 @@ subroutine read_mantle_gapmodel() ! checks bounds write(IMAIN,*) " nr1 = ",nr1 if (nr1 /= mr1) then - print*,'Error GAPP2 model bounds: ' - print*,' file dimensions: nr1 = ',nr1 - print*,' module dimensions: mr1 = ',mr1 + print *,'Error GAPP2 model bounds: ' + print *,' file dimensions: nr1 = ',nr1 + print *,' module dimensions: mr1 = ',mr1 close(IIN) call exit_MPI(0,'please check GAPP2 model dimensions, and update model_gapp2.f90') endif @@ -153,7 +153,7 @@ subroutine read_mantle_gapmodel() !read(IIN,*,iostat=ier) (vp3(ia,io,ir),io=no/2,no) if (ier /= 0) then - print*,'Error GAPP2 read: ia,ir = ',ia,ir + print *,'Error GAPP2 read: ia,ir = ',ia,ir call exit_MPI(0,'Error GAPP2 read') endif enddo diff --git a/src/meshfem3D/model_gll.f90 b/src/meshfem3D/model_gll.f90 index db60823b4..6f0554cf7 100644 --- a/src/meshfem3D/model_gll.f90 +++ b/src/meshfem3D/model_gll.f90 @@ -274,7 +274,7 @@ subroutine read_gll_model(myrank,MGLL_V,NSPEC) open(unit=IIN,file=prname(1:len_trim(prname))//'vs.bin', & status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',prname(1:len_trim(prname))//'vs.bin' + print *,'Error opening: ',prname(1:len_trim(prname))//'vs.bin' call exit_MPI(myrank,'Error model GLL') endif read(IIN) MGLL_V%vs_new(:,:,:,1:nspec(IREGION_CRUST_MANTLE)) @@ -306,7 +306,7 @@ subroutine read_gll_model(myrank,MGLL_V,NSPEC) open(unit=IIN,file=prname(1:len_trim(prname))//'vsv.bin', & status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',prname(1:len_trim(prname))//'vsv.bin' + print *,'Error opening: ',prname(1:len_trim(prname))//'vsv.bin' call exit_MPI(myrank,'Error model GLL') endif read(IIN) MGLL_V%vsv_new(:,:,:,1:nspec(IREGION_CRUST_MANTLE)) @@ -315,7 +315,7 @@ subroutine read_gll_model(myrank,MGLL_V,NSPEC) open(unit=IIN,file=prname(1:len_trim(prname))//'vsh.bin', & status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',prname(1:len_trim(prname))//'vsh.bin' + print *,'Error opening: ',prname(1:len_trim(prname))//'vsh.bin' call exit_MPI(myrank,'Error model GLL') endif read(IIN) MGLL_V%vsh_new(:,:,:,1:nspec(IREGION_CRUST_MANTLE)) @@ -325,7 +325,7 @@ subroutine read_gll_model(myrank,MGLL_V,NSPEC) open(unit=IIN,file=prname(1:len_trim(prname))//'eta.bin', & status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',prname(1:len_trim(prname))//'eta.bin' + print *,'Error opening: ',prname(1:len_trim(prname))//'eta.bin' call exit_MPI(myrank,'Error model GLL') endif read(IIN) MGLL_V%eta_new(:,:,:,1:nspec(IREGION_CRUST_MANTLE)) @@ -337,7 +337,7 @@ subroutine read_gll_model(myrank,MGLL_V,NSPEC) open(unit=IIN,file=prname(1:len_trim(prname))//'rho.bin', & status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',prname(1:len_trim(prname))//'rho.bin' + print *,'Error opening: ',prname(1:len_trim(prname))//'rho.bin' call exit_MPI(myrank,'Error model GLL') endif read(IIN) MGLL_V%rho_new(:,:,:,1:nspec(IREGION_CRUST_MANTLE)) diff --git a/src/meshfem3D/model_gll_adios.F90 b/src/meshfem3D/model_gll_adios.F90 index c080ab163..e0958d0b0 100644 --- a/src/meshfem3D/model_gll_adios.F90 +++ b/src/meshfem3D/model_gll_adios.F90 @@ -91,7 +91,7 @@ subroutine read_gll_model_adios(myrank,MGLL_V,NSPEC) call adios_read_open_file (adios_handle, trim(file_name), 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif diff --git a/src/meshfem3D/model_s362ani.f90 b/src/meshfem3D/model_s362ani.f90 index 9e1420cae..79c5058d6 100644 --- a/src/meshfem3D/model_s362ani.f90 +++ b/src/meshfem3D/model_s362ani.f90 @@ -912,7 +912,7 @@ subroutine gt3dmodl(targetfile, & ! checks error if (ierror /= 0) then - print*,'Error: reading model in get3dmodel() routine failed with error code ',ierror + print *,'Error: reading model in get3dmodel() routine failed with error code ',ierror stop 'Error in model s362ani in get3dmodl() routine' endif diff --git a/src/meshfem3D/moho_stretching.f90 b/src/meshfem3D/moho_stretching.f90 index 172976cff..698205c11 100644 --- a/src/meshfem3D/moho_stretching.f90 +++ b/src/meshfem3D/moho_stretching.f90 @@ -109,11 +109,11 @@ subroutine moho_stretching_honor_crust(myrank,xelm,yelm,zelm, & if (.not. USE_OLD_VERSION_5_1_5_FORMAT) then ! limits moho depth to a threshold value to avoid stretching problems if (moho < MOHO_MINIMUM) then - print*,'moho value exceeds minimum (in km): ',moho*R_EARTH_KM,MOHO_MINIMUM*R_EARTH_KM,'lat/lon:',lat,lon + print *,'moho value exceeds minimum (in km): ',moho*R_EARTH_KM,MOHO_MINIMUM*R_EARTH_KM,'lat/lon:',lat,lon moho = MOHO_MINIMUM endif if (moho > MOHO_MAXIMUM) then - print*,'moho value exceeds maximum (in km): ',moho*R_EARTH_KM,MOHO_MAXIMUM*R_EARTH_KM,'lat/lon:',lat,lon + print *,'moho value exceeds maximum (in km): ',moho*R_EARTH_KM,MOHO_MAXIMUM*R_EARTH_KM,'lat/lon:',lat,lon moho = MOHO_MAXIMUM endif endif @@ -213,7 +213,7 @@ subroutine moho_stretching_honor_crust(myrank,xelm,yelm,zelm, & ! small stretch check: stretching should affect only points above R220 if (r*R_EARTH < R220) then - print*,'Error moho stretching: ',r*R_EARTH,R220,moho*R_EARTH + print *,'Error moho stretching: ',r*R_EARTH,R220,moho*R_EARTH call exit_mpi(myrank,'incorrect moho stretching') endif @@ -338,7 +338,7 @@ subroutine moho_stretching_honor_crust_reg(myrank,xelm,yelm,zelm, & ! small stretch check: stretching should affect only points above R220 if (r*R_EARTH < R220) then - print*,'Error moho stretching: ',r*R_EARTH,R220,moho*R_EARTH + print *,'Error moho stretching: ',r*R_EARTH,R220,moho*R_EARTH call exit_mpi(myrank,'incorrect moho stretching') endif diff --git a/src/meshfem3D/save_arrays_solver_adios.F90 b/src/meshfem3D/save_arrays_solver_adios.F90 index e9dd6199e..288c0a45d 100644 --- a/src/meshfem3D/save_arrays_solver_adios.F90 +++ b/src/meshfem3D/save_arrays_solver_adios.F90 @@ -573,10 +573,10 @@ subroutine save_arrays_solver_adios(myrank,nspec,nglob,idoubling,ibool, & ! debug daniel !call synchronize_all() - !print*,myrank,'nspec2d top :',NSPEC2D_TOP,NSPEC2D_TOP_wmax - !print*,myrank,'nspec2d bottom :',NSPEC2D_BOTTOM,NSPEC2D_BOTTOM_wmax - !print*,myrank,'nspec2d xmin_xmax:',NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_XMIN_XMAX_wmax - !print*,myrank,'nspec2d ymin_ymax:',NSPEC2DMAX_YMIN_YMAX,NSPEC2DMAX_YMIN_YMAX_wmax + !print *,myrank,'nspec2d top :',NSPEC2D_TOP,NSPEC2D_TOP_wmax + !print *,myrank,'nspec2d bottom :',NSPEC2D_BOTTOM,NSPEC2D_BOTTOM_wmax + !print *,myrank,'nspec2d xmin_xmax:',NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_XMIN_XMAX_wmax + !print *,myrank,'nspec2d ymin_ymax:',NSPEC2DMAX_YMIN_YMAX,NSPEC2DMAX_YMIN_YMAX_wmax !call synchronize_all() ! checks @@ -584,7 +584,7 @@ subroutine save_arrays_solver_adios(myrank,nspec,nglob,idoubling,ibool, & NSPEC2D_BOTTOM /= NSPEC2D_BOTTOM_wmax .or. & NSPEC2DMAX_XMIN_XMAX /= NSPEC2DMAX_XMIN_XMAX_wmax .or. & NSPEC2DMAX_YMIN_YMAX /= NSPEC2DMAX_YMIN_YMAX_wmax) then - print*,myrank,'Error nspec2d for coupling surfaces' + print *,myrank,'Error nspec2d for coupling surfaces' call exit_mpi(myrank,'Error nspec2d for coupling surfaces in adios saved file') endif diff --git a/src/meshfem3D/setup_color_perm.f90 b/src/meshfem3D/setup_color_perm.f90 index c3a1bcba9..dba94d119 100644 --- a/src/meshfem3D/setup_color_perm.f90 +++ b/src/meshfem3D/setup_color_perm.f90 @@ -192,7 +192,7 @@ subroutine setup_color_perm(iregion_code) if (minval(perm) < 0) & call exit_MPI(myrank, 'minval(perm) should be at least 0') if (maxval(perm) > num_phase_ispec_inner_core) then - print*,'Error perm inner core:',minval(perm),maxval(perm),num_phase_ispec_inner_core + print *,'Error perm inner core:',minval(perm),maxval(perm),num_phase_ispec_inner_core call exit_MPI(myrank, 'maxval(perm) should be num_phase_ispec_inner_core') endif @@ -352,7 +352,7 @@ subroutine setup_color(myrank,nspec,nglob,ibool,perm, & allocate(num_of_elems_in_this_color(nb_colors_outer_elements + nb_colors_inner_elements),stat=ier) if (ier /= 0) then - print*,'Error',myrank,' allocating num_of_elems_in_this_color:',nb_colors_outer_elements,nb_colors_inner_elements, & + print *,'Error',myrank,' allocating num_of_elems_in_this_color:',nb_colors_outer_elements,nb_colors_inner_elements, & nb_colors_outer_elements + nb_colors_inner_elements call exit_MPI(myrank,'Error allocating num_of_elems_in_this_color array') endif @@ -378,7 +378,7 @@ subroutine setup_color(myrank,nspec,nglob,ibool,perm, & if (sum(num_of_elems_in_this_color(1:nb_colors_outer_elements)) /= nspec_outer) then print *,'Error number of outer elements in this color:',idomain print *,'rank: ',myrank,' nspec_outer = ',nspec_outer - print*,'nb_colors_outer_elements = ',nb_colors_outer_elements + print *,'nb_colors_outer_elements = ',nb_colors_outer_elements print *,'total number of elements in all the colors of the mesh for outer elements = ', & sum(num_of_elems_in_this_color(1:nb_colors_outer_elements)) call exit_MPI(myrank, 'incorrect total number of elements in all the colors of the mesh for outer elements') @@ -430,7 +430,7 @@ subroutine setup_color(myrank,nspec,nglob,ibool,perm, & if (allocated(num_of_elems_in_this_color) ) deallocate(num_of_elems_in_this_color) allocate(num_of_elems_in_this_color(nb_colors_outer_elements + nb_colors_inner_elements),stat=ier) if (ier /= 0) then - print*,'Error',myrank,' allocating num_of_elems_in_this_color:',nb_colors_outer_elements,nb_colors_inner_elements, & + print *,'Error',myrank,' allocating num_of_elems_in_this_color:',nb_colors_outer_elements,nb_colors_inner_elements, & nb_colors_outer_elements + nb_colors_inner_elements call exit_MPI(myrank,'Error allocating num_of_elems_in_this_color array') endif @@ -520,9 +520,9 @@ subroutine setup_color(myrank,nspec,nglob,ibool,perm, & ! checks if (ispec_outer < 1 .or. ispec_outer > num_phase_ispec_d) then - print*,'Error outer permutation:',idomain - print*,'rank:',myrank,' ispec_outer = ',ispec_outer - print*,'num_phase_ispec_d = ',num_phase_ispec_d + print *,'Error outer permutation:',idomain + print *,'rank:',myrank,' ispec_outer = ',ispec_outer + print *,'num_phase_ispec_d = ',num_phase_ispec_d call exit_MPI(myrank,'Error outer permutation') endif @@ -534,9 +534,9 @@ subroutine setup_color(myrank,nspec,nglob,ibool,perm, & ! checks if (ispec_inner < 1 .or. ispec_inner > num_phase_ispec_d) then - print*,'Error inner permutation:',idomain - print*,'rank:',myrank,' ispec_inner = ',ispec_inner - print*,'num_phase_ispec_d = ',num_phase_ispec_d + print *,'Error inner permutation:',idomain + print *,'rank:',myrank,' ispec_inner = ',ispec_inner + print *,'num_phase_ispec_d = ',num_phase_ispec_d call exit_MPI(myrank,'Error inner permutation') endif @@ -719,7 +719,7 @@ subroutine setup_permutation(myrank,nspec,nglob,ibool, & ! checks counter if (icounter /= nspec) then - print*,'Error temp perm: ',icounter,nspec + print *,'Error temp perm: ',icounter,nspec stop 'Error temporary global permutation incomplete' endif ! checks values @@ -738,7 +738,7 @@ subroutine setup_permutation(myrank,nspec,nglob,ibool, & if (new_ispec < 1 .or. new_ispec > nspec ) call exit_MPI(myrank,'Error temp_perm_global ispec bounds') ! checks if already set if (mask_global(new_ispec)) then - print*,'Error temp_perm_global:',ispec,new_ispec,'element already set' + print *,'Error temp_perm_global:',ispec,new_ispec,'element already set' call exit_MPI(myrank,'Error global permutation') else mask_global(new_ispec) = .true. @@ -749,7 +749,7 @@ subroutine setup_permutation(myrank,nspec,nglob,ibool, & ! checks number of set elements if (count(mask_global(:)) /= nspec) then - print*,'Error temp_perm_global:',count(mask_global(:)),nspec,'permutation incomplete' + print *,'Error temp_perm_global:',count(mask_global(:)),nspec,'permutation incomplete' call exit_MPI(myrank,'Error global permutation incomplete') endif deallocate(mask_global) diff --git a/src/meshfem3D/test_MPI_interfaces.f90 b/src/meshfem3D/test_MPI_interfaces.f90 index 6ec1b1aee..68c35fca6 100644 --- a/src/meshfem3D/test_MPI_interfaces.f90 +++ b/src/meshfem3D/test_MPI_interfaces.f90 @@ -55,18 +55,18 @@ subroutine test_MPI_neighbours(iregion_code, & ! debug output !do iproc = 0,NPROCTOT-1 ! if (myrank == iproc) then - ! print*, 'MPI rank',myrank,'interfaces : ',num_interfaces,'region',iregion_code + ! print *, 'MPI rank',myrank,'interfaces : ',num_interfaces,'region',iregion_code ! do j = 1,num_interfaces - ! print*, ' my_neighbours: ',my_neighbours(j),nibool_interfaces(j) + ! print *, ' my_neighbours: ',my_neighbours(j),nibool_interfaces(j) ! enddo - ! print* + ! print * ! endif ! call synchronize_all() !enddo ! checks maximum number of interface points if (max_nibool_interfaces == 0 .and. NPROCTOT > 1) then - print*,'test MPI: rank ',myrank,'max_nibool_interfaces is zero' + print *,'test MPI: rank ',myrank,'max_nibool_interfaces is zero' call exit_mpi(myrank,'Error test max_nibool_interfaces zero') endif @@ -90,7 +90,7 @@ subroutine test_MPI_neighbours(iregion_code, & do i = 1,num_interfaces ! number of interface points if (nibool_interfaces(i) > max_nibool_interfaces) then - print*,'Error test MPI: rank',myrank,'nibool values:',nibool_interfaces(i),max_nibool_interfaces + print *,'Error test MPI: rank',myrank,'nibool values:',nibool_interfaces(i),max_nibool_interfaces call exit_mpi(myrank,'Error test MPI: nibool exceeds max_nibool_interfaces') endif @@ -102,14 +102,14 @@ subroutine test_MPI_neighbours(iregion_code, & ! checks zero entry if (iglob <= 0) then - print*,'Error test MPI: rank ',myrank,'ibool value:',iglob,'interface:',i,'point:',j + print *,'Error test MPI: rank ',myrank,'ibool value:',iglob,'interface:',i,'point:',j call exit_mpi(myrank,'Error test MPI: ibool values invalid') endif ! checks duplicate if (j < nibool_interfaces(i)) then if (iglob == ibool_interfaces(j+1,i)) then - print*,'Error test MPI: rank',myrank,'ibool duplicate:',iglob,'interface:',i,'point:',j + print *,'Error test MPI: rank',myrank,'ibool duplicate:',iglob,'interface:',i,'point:',j call exit_mpi(myrank,'Error test MPI: ibool duplicates') endif endif @@ -118,7 +118,7 @@ subroutine test_MPI_neighbours(iregion_code, & if (.not. mask(iglob)) then mask(iglob) = .true. else - print*,'Error test MPI: rank',myrank,'ibool masked:',iglob,'interface:',i,'point:',j + print *,'Error test MPI: rank',myrank,'ibool masked:',iglob,'interface:',i,'point:',j call exit_mpi(myrank,'Error test MPI: ibool masked already') endif enddo @@ -185,11 +185,11 @@ subroutine test_MPI_neighbours(iregion_code, & ! checks values if (ineighbour < 0 .or. ineighbour > NPROCTOT-1) then - print*,'Error neighbour:',iproc,ineighbour + print *,'Error neighbour:',iproc,ineighbour call exit_mpi(myrank,'Error ineighbour') endif if (ipoints <= 0) then - print*,'Error neighbour points:',iproc,ipoints + print *,'Error neighbour points:',iproc,ipoints call exit_mpi(myrank,'Error ineighbour points') endif @@ -201,21 +201,21 @@ subroutine test_MPI_neighbours(iregion_code, & if (test_interfaces_nibool(j,ineighbour) == ipoints) then is_okay = .true. else - print*,'Error ',iproc,'neighbour ',ineighbour,' points =',ipoints - print*,' ineighbour has points = ',test_interfaces_nibool(j,ineighbour) - print* + print *,'Error ',iproc,'neighbour ',ineighbour,' points =',ipoints + print *,' ineighbour has points = ',test_interfaces_nibool(j,ineighbour) + print * call exit_mpi(myrank,'Error ineighbour points differ') endif exit endif enddo if (.not. is_okay) then - print*,'Error ',iproc,' neighbour not found: ',ineighbour - print*,'iproc ',iproc,' interfaces:' - print*,test_interfaces(1:dummy_i(iproc),iproc) - print*,'ineighbour ',ineighbour,' interfaces:' - print*,test_interfaces(1:dummy_i(ineighbour),ineighbour) - print* + print *,'Error ',iproc,' neighbour not found: ',ineighbour + print *,'iproc ',iproc,' interfaces:' + print *,test_interfaces(1:dummy_i(iproc),iproc) + print *,'ineighbour ',ineighbour,' interfaces:' + print *,test_interfaces(1:dummy_i(ineighbour),ineighbour) + print * call exit_mpi(myrank,'Error ineighbour not found') endif enddo @@ -316,14 +316,14 @@ subroutine test_MPI_cm() if (valence(iglob) /= nint(test_flag_vector(1,iglob)) .or. & valence(iglob) /= nint(test_flag_vector(2,iglob)) .or. & valence(iglob) /= nint(test_flag_vector(3,iglob))) then - print*,'Error test MPI: rank',myrank,'valence:',valence(iglob),'flag:',test_flag_vector(:,:) + print *,'Error test MPI: rank',myrank,'valence:',valence(iglob),'flag:',test_flag_vector(:,:) call exit_mpi(myrank,'Error test MPI crust mantle valence') endif enddo ! checks within slice if (i /= num_unique) then - print*,'Error test crust mantle : rank',myrank,'unique MPI points:',i,num_unique + print *,'Error test crust mantle : rank',myrank,'unique MPI points:',i,num_unique call exit_mpi(myrank,'Error MPI assembly crust mantle') endif @@ -334,7 +334,7 @@ subroutine test_MPI_cm() if (myrank == 0) then ! checks if (inum /= icount) then - print*,'Error crust mantle : total MPI points:',myrank,'total: ',inum,icount + print *,'Error crust mantle : total MPI points:',myrank,'total: ',inum,icount call exit_mpi(myrank,'Error MPI assembly crust mantle') endif @@ -426,14 +426,14 @@ subroutine test_MPI_oc() ! checks valence if (valence(iglob) /= nint(test_flag(iglob))) then - print*,'Error test MPI: rank',myrank,'valence:',valence(iglob),'flag:',test_flag(iglob) + print *,'Error test MPI: rank',myrank,'valence:',valence(iglob),'flag:',test_flag(iglob) call exit_mpi(myrank,'Error test outer core valence') endif enddo ! checks within slice if (i /= num_unique) then - print*,'Error test outer core : rank',myrank,'unique MPI points:',i,num_unique + print *,'Error test outer core : rank',myrank,'unique MPI points:',i,num_unique call exit_mpi(myrank,'Error MPI assembly outer core') endif call sum_all_i(i,inum) @@ -442,7 +442,7 @@ subroutine test_MPI_oc() if (myrank == 0) then ! checks if (inum /= icount) then - print*,'Error outer core : total MPI points:',myrank,'total: ',inum,icount + print *,'Error outer core : total MPI points:',myrank,'total: ',inum,icount call exit_mpi(myrank,'Error MPI assembly outer_core') endif @@ -537,7 +537,7 @@ subroutine test_MPI_ic() if (valence(iglob) /= nint(test_flag_vector(1,iglob)) .or. & valence(iglob) /= nint(test_flag_vector(2,iglob)) .or. & valence(iglob) /= nint(test_flag_vector(3,iglob))) then - print*,'Error test MPI: rank',myrank,'valence:',valence(iglob),'flag:',test_flag_vector(:,:) + print *,'Error test MPI: rank',myrank,'valence:',valence(iglob),'flag:',test_flag_vector(:,:) call exit_mpi(myrank,'Error test MPI inner core valence') endif @@ -545,7 +545,7 @@ subroutine test_MPI_ic() ! checks within slice if (i /= num_unique) then - print*,'Error test inner core : rank',myrank,'unique MPI points:',i,num_unique + print *,'Error test inner core : rank',myrank,'unique MPI points:',i,num_unique call exit_mpi(myrank,'Error MPI assembly inner core') endif call sum_all_i(i,inum) @@ -553,7 +553,7 @@ subroutine test_MPI_ic() if (myrank == 0) then ! checks if (inum /= icount) then - print*,'Error inner core : total MPI points:',myrank,'total: ',inum,icount + print *,'Error inner core : total MPI points:',myrank,'total: ',inum,icount call exit_mpi(myrank,'Error MPI assembly inner core') endif diff --git a/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 b/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 index 842375b25..0827777f3 100644 --- a/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 +++ b/src/meshfem3D/write_AVS_DX_global_chunks_data.f90 @@ -577,14 +577,14 @@ subroutine write_AVS_DX_global_chunks_data(myrank,prname,nspec,iboun,ibool, & + 5.d0*vsh*vsh + (6.d0+4.d0*eta_aniso)*vsv*vsv)/15.d0) if (abs(rhostore(i,j,k,ispec))< 1.e-20) then - print*,' attention: rhostore close to zero',rhostore(i,j,k,ispec),r,i,j,k,ispec + print *,' attention: rhostore close to zero',rhostore(i,j,k,ispec),r,i,j,k,ispec dvp = 0.0 dvs = 0.0 else if (abs(sngl(vp))< 1.e-20) then - print*,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec + print *,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec dvp = 0.0 else if (abs(sngl(vs))< 1.e-20) then - print*,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec + print *,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec dvs = 0.0 else dvp = dvp + (sqrt((kappavstore(i,j,k,ispec)+4.*muvstore(i,j,k,ispec)/3.)/rhostore(i,j,k,ispec)) - sngl(vp))/sngl(vp) diff --git a/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 b/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 index 6e5b2bec3..6f33be5c2 100644 --- a/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 +++ b/src/meshfem3D/write_AVS_DX_global_chunks_data_adios.f90 @@ -895,16 +895,16 @@ subroutine prepare_AVS_DX_global_chunks_data_adios(myrank,prname,nspec, & + 5.d0*vsh*vsh + (6.d0+4.d0*eta_aniso)*vsv*vsv)/15.d0) if (abs(rhostore(i,j,k,ispec))< 1.e-20) then - print*,' attention: rhostore close to zero', & + print *,' attention: rhostore close to zero', & rhostore(i,j,k,ispec),r,i,j,k,ispec dvp = 0.0 dvs = 0.0 else if (abs(sngl(vp))< 1.e-20) then - print*,' attention: vp close to zero', & + print *,' attention: vp close to zero', & sngl(vp),r,i,j,k,ispec dvp = 0.0 else if (abs(sngl(vs))< 1.e-20) then - print*,' attention: vs close to zero', & + print *,' attention: vs close to zero', & sngl(vs),r,i,j,k,ispec dvs = 0.0 else diff --git a/src/meshfem3D/write_AVS_DX_global_faces_data.f90 b/src/meshfem3D/write_AVS_DX_global_faces_data.f90 index 12633e5c6..2b3327d94 100644 --- a/src/meshfem3D/write_AVS_DX_global_faces_data.f90 +++ b/src/meshfem3D/write_AVS_DX_global_faces_data.f90 @@ -379,14 +379,14 @@ subroutine write_AVS_DX_global_faces_data(myrank,prname,nspec,iMPIcut_xi,iMPIcut + 5.d0*vsh*vsh + (6.d0+4.d0*eta_aniso)*vsv*vsv)/15.d0) if (abs(rhostore(i,j,k,ispec))< 1.e-20) then - print*,' attention: rhostore close to zero',rhostore(i,j,k,ispec),r,i,j,k,ispec + print *,' attention: rhostore close to zero',rhostore(i,j,k,ispec),r,i,j,k,ispec dvp = 0.0 dvs = 0.0 else if (abs(sngl(vp))< 1.e-20) then - print*,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec + print *,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec dvp = 0.0 else if (abs(sngl(vs))< 1.e-20) then - print*,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec + print *,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec dvs = 0.0 else dvp = dvp + (sqrt((kappavstore(i,j,k,ispec)+4.*muvstore(i,j,k,ispec)/3.)/rhostore(i,j,k,ispec)) - sngl(vp))/sngl(vp) diff --git a/src/meshfem3D/write_AVS_DX_global_faces_data_adios.f90 b/src/meshfem3D/write_AVS_DX_global_faces_data_adios.f90 index ee38ef238..efa6e5e59 100644 --- a/src/meshfem3D/write_AVS_DX_global_faces_data_adios.f90 +++ b/src/meshfem3D/write_AVS_DX_global_faces_data_adios.f90 @@ -557,15 +557,15 @@ subroutine prepare_AVS_DX_global_faces_data_adios(myrank, nspec, & + 5.d0*vsh*vsh + (6.d0+4.d0*eta_aniso)*vsv*vsv)/15.d0) if (abs(rhostore(i,j,k,ispec))< 1.e-20) then - print*,'attention: rhostore close to zero', & + print *,'attention: rhostore close to zero', & rhostore(i,j,k,ispec),r,i,j,k,ispec dvp = 0.0 dvs = 0.0 else if (abs(sngl(vp))< 1.e-20) then - print*,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec + print *,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec dvp = 0.0 else if (abs(sngl(vs))< 1.e-20) then - print*,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec + print *,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec dvs = 0.0 else dvp = dvp + (sqrt((kappavstore(i,j,k,ispec) & diff --git a/src/meshfem3D/write_AVS_DX_surface_data.f90 b/src/meshfem3D/write_AVS_DX_surface_data.f90 index 3d972d70d..1c94fe3c0 100644 --- a/src/meshfem3D/write_AVS_DX_surface_data.f90 +++ b/src/meshfem3D/write_AVS_DX_surface_data.f90 @@ -243,14 +243,14 @@ subroutine write_AVS_DX_surface_data(myrank,prname,nspec,iboun, & + 5.d0*vsh*vsh + (6.d0+4.d0*eta_aniso)*vsv*vsv)/15.d0) if (abs(rhostore(i,j,k,ispec))< 1.e-20) then - print*,' attention: rhostore close to zero',rhostore(i,j,k,ispec),r,i,j,k,ispec + print *,' attention: rhostore close to zero',rhostore(i,j,k,ispec),r,i,j,k,ispec dvp = 0.0 dvs = 0.0 else if (abs(sngl(vp))< 1.e-20) then - print*,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec + print *,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec dvp = 0.0 else if (abs(sngl(vs))< 1.e-20) then - print*,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec + print *,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec dvs = 0.0 else dvp = dvp + (sqrt((kappavstore(i,j,k,ispec)+4.*muvstore(i,j,k,ispec)/3.) & diff --git a/src/meshfem3D/write_AVS_DX_surface_data_adios.f90 b/src/meshfem3D/write_AVS_DX_surface_data_adios.f90 index 74438dffb..a209c56d9 100644 --- a/src/meshfem3D/write_AVS_DX_surface_data_adios.f90 +++ b/src/meshfem3D/write_AVS_DX_surface_data_adios.f90 @@ -370,15 +370,15 @@ subroutine prepare_AVS_DX_surfaces_data_adios(myrank,nspec,iboun, & + 5.d0*vsh*vsh + (6.d0+4.d0*eta_aniso)*vsv*vsv)/15.d0) if (abs(rhostore(i,j,k,ispec))< 1.e-20) then - print*,' attention: rhostore close to zero', & + print *,' attention: rhostore close to zero', & rhostore(i,j,k,ispec),r,i,j,k,ispec dvp = 0.0 dvs = 0.0 else if (abs(sngl(vp))< 1.e-20) then - print*,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec + print *,' attention: vp close to zero',sngl(vp),r,i,j,k,ispec dvp = 0.0 else if (abs(sngl(vs))< 1.e-20) then - print*,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec + print *,' attention: vs close to zero',sngl(vs),r,i,j,k,ispec dvs = 0.0 else dvp = dvp + (sqrt((kappavstore(i,j,k,ispec) & diff --git a/src/shared/adios_manager.F90 b/src/shared/adios_manager.F90 index c68757106..d878b6845 100644 --- a/src/shared/adios_manager.F90 +++ b/src/shared/adios_manager.F90 @@ -51,14 +51,14 @@ subroutine adios_setup() call adios_init_noxml (comm, adios_err) ! note: return codes for this function have been fixed for ADIOS versions >= 1.6 ! e.g., version 1.5.0 returns 1 here - !print*,'adios init return: ',adios_err + !print *,'adios init return: ',adios_err !if (adios_err /= 0 ) stop 'Error setting up ADIOS: calling adios_init_noxml() routine failed' call adios_allocate_buffer (ADIOS_BUFFER_SIZE_IN_MB, adios_err) ! note: return codes for this function have been fixed for ADIOS versions >= 1.6 ! e.g., version 1.5.0 returns 1 if called first time, 0 if already called - !print*,'adios allocate buffer return: ',adios_err + !print *,'adios allocate buffer return: ',adios_err !call check_adios_err(myrank,adios_err) end subroutine adios_setup diff --git a/src/shared/count_number_of_sources.f90 b/src/shared/count_number_of_sources.f90 index 0e3ab08d5..3f9e92d78 100644 --- a/src/shared/count_number_of_sources.f90 +++ b/src/shared/count_number_of_sources.f90 @@ -51,7 +51,7 @@ subroutine count_number_of_sources(NSOURCES) open(unit=IIN,file=trim(CMTSOLUTION_FILE),status='old',action='read',iostat=ios) if (ios /= 0) then - print*,'Error opening CMTSOLUTION file: ',trim(CMTSOLUTION_FILE) + print *,'Error opening CMTSOLUTION file: ',trim(CMTSOLUTION_FILE) stop 'Error opening CMTSOLUTION file' endif diff --git a/src/shared/get_model_parameters.F90 b/src/shared/get_model_parameters.F90 index 35e022442..d62bee9f2 100644 --- a/src/shared/get_model_parameters.F90 +++ b/src/shared/get_model_parameters.F90 @@ -432,8 +432,8 @@ subroutine get_model_parameters_flags(MODEL,REFERENCE_1D_MODEL,THREE_D_MODEL, & TRANSVERSE_ISOTROPY = .true. else - print* - print*,'Error model: ',trim(MODEL) + print * + print *,'Error model: ',trim(MODEL) stop 'model not implemented yet, edit get_model_parameters.f90, or ensure you have run ./configure correctly, and recompile' endif diff --git a/src/shared/get_timestep_and_layers.f90 b/src/shared/get_timestep_and_layers.f90 index 085d33618..acfcecf6c 100644 --- a/src/shared/get_timestep_and_layers.f90 +++ b/src/shared/get_timestep_and_layers.f90 @@ -484,8 +484,8 @@ subroutine get_timestep_and_layers(NEX_MAX) if (HONOR_1D_SPHERICAL_MOHO ) return ! original values - !print*,'NER:',NER_CRUST - !print*,'DT:',DT + !print *,'NER:',NER_CRUST + !print *,'DT:',DT ! enforce 3 element layers NER_CRUST = 3 diff --git a/src/shared/model_prem.f90 b/src/shared/model_prem.f90 index 504b1065c..6e8b5e5e7 100644 --- a/src/shared/model_prem.f90 +++ b/src/shared/model_prem.f90 @@ -320,7 +320,7 @@ subroutine model_prem_aniso(myrank,x,rho,vpv,vph,vsv,vsh,eta_aniso,Qkappa,Qmu, & ! else if (r > RCMB .and. r < RTOPDDOUBLEPRIME) then if (idoubling /= IFLAG_MANTLE_NORMAL) then - print*,'Error dprime point:',r, RCMB,RTOPDDOUBLEPRIME,idoubling,IFLAG_MANTLE_NORMAL + print *,'Error dprime point:',r, RCMB,RTOPDDOUBLEPRIME,idoubling,IFLAG_MANTLE_NORMAL call exit_MPI(myrank,'wrong doubling flag for D" point in model_prem_aniso()') endif ! diff --git a/src/shared/model_topo_bathy.f90 b/src/shared/model_topo_bathy.f90 index e42415b6f..3ec5dfe22 100644 --- a/src/shared/model_topo_bathy.f90 +++ b/src/shared/model_topo_bathy.f90 @@ -108,8 +108,8 @@ subroutine read_topo_bathy_file(ibathy_topo) ! checks values if (ival < TOPO_MINIMUM .or. ival > TOPO_MAXIMUM) then - print*,'Error read topo_bathy: ival = ',ival,'ix,iy = ',itopo_x,itopo_y - print*,'topo_bathy dimension: nx,ny = ',NX_BATHY,NY_BATHY + print *,'Error read topo_bathy: ival = ',ival,'ix,iy = ',itopo_x,itopo_y + print *,'topo_bathy dimension: nx,ny = ',NX_BATHY,NY_BATHY call exit_mpi(0,'Error reading topo_bathy file') endif @@ -155,9 +155,9 @@ subroutine save_topo_bathy_database(ibathy_topo,LOCAL_PATH) if (ier /= 0) then ! inform about missing database topo file - print*,'TOPOGRAPHY problem:' - print*,'Error opening file: ',prname(1:len_trim(prname))//'topo.bin' - print*,'please check if path exists and rerun mesher' + print *,'TOPOGRAPHY problem:' + print *,'Error opening file: ',prname(1:len_trim(prname))//'topo.bin' + print *,'please check if path exists and rerun mesher' call exit_mpi(0,'Error opening file for database topo') endif @@ -194,13 +194,13 @@ subroutine read_topo_bathy_database(ibathy_topo,LOCAL_PATH) if (ier /= 0) then ! inform user - print*,'TOPOGRAPHY problem:' - print*,'Error opening file: ',prname(1:len_trim(prname))//'topo.bin' - !print*,'please check if file exists and rerun solver' + print *,'TOPOGRAPHY problem:' + print *,'Error opening file: ',prname(1:len_trim(prname))//'topo.bin' + !print *,'please check if file exists and rerun solver' !call exit_mpi(0,'Error opening file for database topo') ! read by original file - print*,'trying original topography file...' + print *,'trying original topography file...' call read_topo_bathy_file(ibathy_topo) ! saves database topo file for next time diff --git a/src/shared/parallel.f90 b/src/shared/parallel.f90 index 36e37aae1..87505918b 100644 --- a/src/shared/parallel.f90 +++ b/src/shared/parallel.f90 @@ -1719,7 +1719,7 @@ subroutine world_split() call MPI_COMM_RANK(MPI_COMM_WORLD,myrank,ier) if (NUMBER_OF_SIMULTANEOUS_RUNS > 1 .and. mod(sizeval,NUMBER_OF_SIMULTANEOUS_RUNS) /= 0) then - if (myrank == 0) print*,'Error: the number of MPI processes ',sizeval, & + if (myrank == 0) print *,'Error: the number of MPI processes ',sizeval, & ' is not a multiple of NUMBER_OF_SIMULTANEOUS_RUNS = ',NUMBER_OF_SIMULTANEOUS_RUNS stop 'the number of MPI processes is not a multiple of NUMBER_OF_SIMULTANEOUS_RUNS' endif diff --git a/src/shared/read_compute_parameters.f90 b/src/shared/read_compute_parameters.f90 index 4ca82d7a8..597aefefe 100644 --- a/src/shared/read_compute_parameters.f90 +++ b/src/shared/read_compute_parameters.f90 @@ -128,7 +128,7 @@ subroutine read_compute_parameters() if (DO_BENCHMARK_RUN_ONLY) NSTEP = NSTEP_FOR_BENCHMARK ! debug - !print*,'initial time steps = ',NSTEP,' record length = ',RECORD_LENGTH_IN_MINUTES,' DT = ',DT + !print *,'initial time steps = ',NSTEP,' record length = ',RECORD_LENGTH_IN_MINUTES,' DT = ',DT ! half-time duration ! diff --git a/src/shared/read_parameter_file.f90 b/src/shared/read_parameter_file.f90 index 4d0063cd8..fe259d16f 100644 --- a/src/shared/read_parameter_file.f90 +++ b/src/shared/read_parameter_file.f90 @@ -282,25 +282,25 @@ subroutine read_parameter_file() ! produces simulations compatible with old globe version 5.1.5 if (USE_OLD_VERSION_5_1_5_FORMAT) then - print* - print*,'**************' - print*,'using globe version 5.1.5 compatible simulation parameters' + print * + print *,'**************' + print *,'using globe version 5.1.5 compatible simulation parameters' if (.not. ATTENUATION_1D_WITH_3D_STORAGE ) & stop 'ATTENUATION_1D_WITH_3D_STORAGE should be set to .true. for compatibility with globe version 5.1.5 ' if (UNDO_ATTENUATION) then - print*,'setting UNDO_ATTENUATION to .false. for compatibility with globe version 5.1.5 ' + print *,'setting UNDO_ATTENUATION to .false. for compatibility with globe version 5.1.5 ' UNDO_ATTENUATION = .false. endif if (USE_LDDRK) then - print*,'setting USE_LDDRK to .false. for compatibility with globe version 5.1.5 ' + print *,'setting USE_LDDRK to .false. for compatibility with globe version 5.1.5 ' USE_LDDRK = .false. endif if (EXACT_MASS_MATRIX_FOR_ROTATION) then - print*,'setting EXACT_MASS_MATRIX_FOR_ROTATION to .false. for compatibility with globe version 5.1.5 ' + print *,'setting EXACT_MASS_MATRIX_FOR_ROTATION to .false. for compatibility with globe version 5.1.5 ' EXACT_MASS_MATRIX_FOR_ROTATION = .false. endif - print*,'**************' - print* + print *,'**************' + print * endif ! checks flags when perfect sphere is set diff --git a/src/shared/read_value_parameters.f90 b/src/shared/read_value_parameters.f90 index 6ceda9350..a3d81c93f 100644 --- a/src/shared/read_value_parameters.f90 +++ b/src/shared/read_value_parameters.f90 @@ -94,7 +94,7 @@ subroutine read_value_string(value_to_read, name, ier) ! checks for string length (buffer overflow) length = len(value_to_read) if (len_trim(string_read) > length) then - print*,'Error reading parameter ',name,': string length ',length,' is too long, please check your Par_file' + print *,'Error reading parameter ',name,': string length ',length,' is too long, please check your Par_file' stop 'Error reading parameter string value' endif diff --git a/src/shared/search_kdtree.f90 b/src/shared/search_kdtree.f90 index 78b59961b..651767886 100644 --- a/src/shared/search_kdtree.f90 +++ b/src/shared/search_kdtree.f90 @@ -171,11 +171,11 @@ subroutine kdtree_setup() points_data => kdtree_nodes_location(:,:) if (be_verbose) then - print*,'kd-tree:' - print*,' total data points: ',npoints - !print*,' box boundaries : x min/max = ',minval(points_data(1,:)),maxval(points_data(1,:)) - !print*,' y min/max = ',minval(points_data(2,:)),maxval(points_data(2,:)) - !print*,' z min/max = ',minval(points_data(3,:)),maxval(points_data(3,:)) + print *,'kd-tree:' + print *,' total data points: ',npoints + !print *,' box boundaries : x min/max = ',minval(points_data(1,:)),maxval(points_data(1,:)) + !print *,' y min/max = ',minval(points_data(2,:)),maxval(points_data(2,:)) + !print *,' z min/max = ',minval(points_data(3,:)),maxval(points_data(3,:)) endif ! theoretical number of node for totally balanced tree @@ -188,8 +188,8 @@ subroutine kdtree_setup() if (numnodes > 2147483646 - i ) stop 'Error number of nodes might exceed integer limit' enddo if (be_verbose) then - print*,' theoretical number of nodes: ',numnodes - print*,' tree memory size: ',( numnodes * 32 )/1024./1024.,'MB' + print *,' theoretical number of nodes: ',numnodes + print *,' tree memory size: ',( numnodes * 32 )/1024./1024.,'MB' endif ! local ordering @@ -214,15 +214,15 @@ subroutine kdtree_setup() if (.not. associated(kdtree) ) stop 'Error creation of kd-tree failed' if (be_verbose) then - print*,' actual number of nodes: ',numnodes + print *,' actual number of nodes: ',numnodes ! tree node size: 4 (idim) + 8 (cut_value) + 4 (ipoint) + 2*4 (ibound_**) + 2*4 (left,right) = 32 bytes - print*,' tree memory size: ',( numnodes * 32 )/1024./1024.,'MB' - print*,' maximum depth : ',maxdepth + print *,' tree memory size: ',( numnodes * 32 )/1024./1024.,'MB' + print *,' maximum depth : ',maxdepth ! timing call cpu_time(ct_end) - print*,' creation timing : ',ct_end - ct_start, '(s)' - print* + print *,' creation timing : ',ct_end - ct_start, '(s)' + print * endif @@ -235,12 +235,12 @@ subroutine kdtree_setup() endif ! test search - print*,'search tree:' + print *,'search tree:' xyz_target(1) = 0.13261298835277557 xyz_target(2) = -8.4083788096904755E-002 xyz_target(3) = 0.97641450166702271 - print*,'search : ',xyz_target(:) + print *,'search : ',xyz_target(:) ipoint_min = -1 dist_min = 1.d30 @@ -248,13 +248,13 @@ subroutine kdtree_setup() call find_nearest_node(npoints,points_data,kdtree,xyz_target,ipoint_min,dist_min) dist_min = sqrt(dist_min) - print*,'found : ',ipoint_min,'distance:',dist_min + print *,'found : ',ipoint_min,'distance:',dist_min if (ipoint_min < 1 ) stop 'Error search kd-tree found no point' - print*,'target : ',xyz_target(:) - print*,'nearest : ',points_data(:,ipoint_min) - print* + print *,'target : ',xyz_target(:) + print *,'nearest : ',points_data(:,ipoint_min) + print * ! safety stop stop 'kdtree_setup safety stop' endif @@ -308,8 +308,8 @@ subroutine kdtree_find_nearest_neighbor(xyz_target,iglob_min,dist_min) ! debug !if (be_verbose) then - ! print*,'target : ',xyz_target(:) - ! print*,'nearest : ',kdtree_nodes_location(:,ipoint_min),'distance:',dist_min*6371.,'(km)',ipoint_min,iglob_min + ! print *,'target : ',xyz_target(:) + ! print *,'nearest : ',kdtree_nodes_location(:,ipoint_min),'distance:',dist_min*6371.,'(km)',ipoint_min,iglob_min !endif end subroutine kdtree_find_nearest_neighbor @@ -464,7 +464,7 @@ subroutine kdtree_get_nearest_n_neighbors(xyz_target,search_radius,num_nodes_get ! checks if num_nodes_get limited by search array size if (kdtree_search_num_nodes < num_nodes_get) then - print*,'Warning: Requested number of n-nodes bigger than actual number of search result kdtree_search_num_nodes' + print *,'Warning: Requested number of n-nodes bigger than actual number of search result kdtree_search_num_nodes' endif ! initializes search results @@ -583,7 +583,7 @@ subroutine kdtree_get_nearest_n_neighbors_ellip(xyz_target,dist_v,dist_h,num_nod ! checks if num_nodes_get limited by search array size if (kdtree_search_num_nodes < num_nodes_get) then - print*,'Warning: Requested number of n-nodes bigger than actual number of search result kdtree_search_num_nodes' + print *,'Warning: Requested number of n-nodes bigger than actual number of search result kdtree_search_num_nodes' endif ! initializes search results @@ -656,7 +656,7 @@ recursive subroutine create_kdtree(npoints,points_data,points_index,node, & ! creates new node allocate(node,stat=ier) if (ier /= 0) then - print*,'Error creating node: ',numnodes + print *,'Error creating node: ',numnodes stop 'Error allocating kd-tree node' endif @@ -724,9 +724,9 @@ recursive subroutine create_kdtree(npoints,points_data,points_index,node, & node%cut_value = cut_value !debug - !print*,'index ',numnodes,'dim:',idim,'range:',ibound_lower,ibound_upper - !print*,' data:',points_data(idim,points_index(ibound_lower)),points_data(idim,points_index(ibound_upper)) - !print*,' min/max:',min,max,'cut value:',cut_value + !print *,'index ',numnodes,'dim:',idim,'range:',ibound_lower,ibound_upper + !print *,' data:',points_data(idim,points_index(ibound_lower)),points_data(idim,points_index(ibound_upper)) + !print *,' min/max:',min,max,'cut value:',cut_value ! temporary index array for sorting allocate(workindex(ibound_upper - ibound_lower + 1),stat=ier) @@ -747,7 +747,7 @@ recursive subroutine create_kdtree(npoints,points_data,points_index,node, & endif enddo !debug - !print*,' ilower/iupper:',ilower,iupper + !print *,' ilower/iupper:',ilower,iupper ! checks if we catched all if (ilower + iupper /= ibound_upper - ibound_lower + 1 ) stop 'Error sorting data points invalid' @@ -808,26 +808,26 @@ recursive subroutine print_kdtree(npoints,points_data,points_index,node,numnodes ! statistics numnodes = numnodes + 1 if (numnodes == 1) then - print*,'printing kd-tree: total number of points = ',npoints - !print*,' index array = ',points_index(:) + print *,'printing kd-tree: total number of points = ',npoints + !print *,' index array = ',points_index(:) endif ! outputs infos for a final node if (.not. associated(node%left) .and. .not. associated(node%right)) then ! checks info if (node%idim /= 0) then - print*,'problem kd-tree node:',node%idim,node%ipoint,numnodes - print*,'point x/y/z: ',points_data(:,node%ipoint) + print *,'problem kd-tree node:',node%idim,node%ipoint,numnodes + print *,'point x/y/z: ',points_data(:,node%ipoint) stop 'Error kd-tree node not correct' endif ! outputs infos if (numnodes < OUTPUT_LENGTH) & - print*,'node:',numnodes,'index:',node%ipoint,' x/y/z = ',points_data(:,node%ipoint) + print *,'node:',numnodes,'index:',node%ipoint,' x/y/z = ',points_data(:,node%ipoint) else ! outputs infos if (numnodes < OUTPUT_LENGTH) & - print*,'node:',numnodes,'dim:',node%idim,'cut = ',node%cut_value + print *,'node:',numnodes,'dim:',node%idim,'cut = ',node%cut_value endif ! checks child nodes @@ -906,12 +906,12 @@ recursive subroutine find_nearest_node(npoints,points_data,node,xyz_target,ipoin ! debug !if (node%idim == 0) then - ! print*,'node',node%id,points_data(:,node%ipoint) + ! print *,'node',node%id,points_data(:,node%ipoint) !else - ! print*,'node',node%id,node%idim,node%cut_value + ! print *,'node',node%id,node%idim,node%cut_value !endif !if (ipoint_min > 0) & - ! print*,'node distance',node%id,ipoint_min,dist_min + ! print *,'node distance',node%id,ipoint_min,dist_min ! in case this is a final node if ( .not. associated(node%left) .and. .not. associated(node%right)) then @@ -924,9 +924,9 @@ recursive subroutine find_nearest_node(npoints,points_data,node,xyz_target,ipoin if (dist < dist_min) then ! debug !if (ipoint_min < 1) then - ! print*,'new node distance',node%id,node%ipoint,dist + ! print *,'new node distance',node%id,node%ipoint,dist !else - ! print*,' new distance',node%id,node%ipoint,dist + ! print *,' new distance',node%id,node%ipoint,dist !endif ! stores minimum point dist_min = dist @@ -1037,7 +1037,7 @@ recursive subroutine find_nearest_n_nodes(npoints,points_data,node,xyz_target,r_ dist = get_distance_squared(xyz_target(:),xyz(:)) if (dist <= r_squared) then ! debug - !print*,' new node: ',node%ipoint,'distance = ',dist,'radius = ',r_squared + !print *,' new node: ',node%ipoint,'distance = ',dist,'radius = ',r_squared ! counts point num_nodes = num_nodes + 1 @@ -1167,7 +1167,7 @@ recursive subroutine find_nearest_n_nodes_ellip(npoints,points_data,node,xyz_tar call get_distance_ellip(xyz_target(:),xyz(:),dist_v,dist_h) if (dist_v <= r_squared_v .and. dist_h <= r_squared_h) then ! debug - !print*,' new node: ',node%ipoint,'distance = ',dist,'radius = ',r_squared + !print *,' new node: ',node%ipoint,'distance = ',dist,'radius = ',r_squared ! counts point num_nodes = num_nodes + 1 diff --git a/src/shared/smooth_weights_vec.F90 b/src/shared/smooth_weights_vec.F90 index 9c4acc326..baf022d1a 100644 --- a/src/shared/smooth_weights_vec.F90 +++ b/src/shared/smooth_weights_vec.F90 @@ -128,7 +128,7 @@ subroutine smoothing_weights_vec(x0,y0,z0,sigma_h2,sigma_v2,exp_val,& ! debug !if (debug) then - ! print*,INDEX_IJK,'smoothing:',dist_v,dist_h,sigma_h2,sigma_v2,ratio,theta,'val',- dist_h/sigma_h2 - dist_v/sigma_v2 + ! print *,INDEX_IJK,'smoothing:',dist_v,dist_h,sigma_h2,sigma_v2,ratio,theta,'val',- dist_h/sigma_h2 - dist_v/sigma_v2 !endif ENDDO_LOOP_IJK diff --git a/src/shared/write_VTK_file.f90 b/src/shared/write_VTK_file.f90 index d1de42445..b8b5dc1eb 100644 --- a/src/shared/write_VTK_file.f90 +++ b/src/shared/write_VTK_file.f90 @@ -75,8 +75,8 @@ subroutine write_VTK_data_points(nglob, & do i = 1,num_points_globalindices iglob = points_globalindices(i) if (iglob <= 0 .or. iglob > nglob) then - print*,'Error: '//prname_file(1:len_trim(prname_file))//'.vtk' - print*,'Error global index: ',iglob,i + print *,'Error: '//prname_file(1:len_trim(prname_file))//'.vtk' + print *,'Error global index: ',iglob,i stop 'Error VTK points file' endif @@ -674,8 +674,8 @@ subroutine write_VTK_data_elem_cr(nspec,nglob, & !-------------------------------------------------------------- !debug - !print*, ' vtk file: ' - !print*, ' ',prname_file(1:len_trim(prname_file))//'.vtk' + !print *, ' vtk file: ' + !print *, ' ',prname_file(1:len_trim(prname_file))//'.vtk' open(IOUT_VTK,file=prname_file(1:len_trim(prname_file))//'.vtk',status='unknown',action='write',iostat=ier) if (ier /= 0) stop 'Error opening VTK file' diff --git a/src/specfem3D/check_stability.f90 b/src/specfem3D/check_stability.f90 index 308a649a2..9efff1786 100644 --- a/src/specfem3D/check_stability.f90 +++ b/src/specfem3D/check_stability.f90 @@ -349,20 +349,20 @@ subroutine check_stability() ! debug output !if (maxval(displ_crust_mantle(1,:)**2 + & ! displ_crust_mantle(2,:)**2 + displ_crust_mantle(3,:)**2) > 1.e4) then - ! print*,'slice',myrank - ! print*,' crust_mantle displ:', maxval(displ_crust_mantle(1,:)), & + ! print *,'slice',myrank + ! print *,' crust_mantle displ:', maxval(displ_crust_mantle(1,:)), & ! maxval(displ_crust_mantle(2,:)),maxval(displ_crust_mantle(3,:)) - ! print*,' indxs: ',maxloc( displ_crust_mantle(1,:)),maxloc( displ_crust_mantle(2,:)),maxloc( displ_crust_mantle(3,:)) + ! print *,' indxs: ',maxloc( displ_crust_mantle(1,:)),maxloc( displ_crust_mantle(2,:)),maxloc( displ_crust_mantle(3,:)) ! indx = maxloc( displ_crust_mantle(3,:) ) ! rval = xstore_crust_mantle(indx(1)) ! thetaval = ystore_crust_mantle(indx(1)) ! phival = zstore_crust_mantle(indx(1)) ! ! !call geocentric_2_geographic_cr(thetaval,thetaval) - ! print*,'r/lat/lon:',rval*R_EARTH_KM,90.0-thetaval*180./PI,phival*180./PI + ! print *,'r/lat/lon:',rval*R_EARTH_KM,90.0-thetaval*180./PI,phival*180./PI ! call rthetaphi_2_xyz(rval,thetaval,phival,xstore_crust_mantle(indx(1)),& ! ystore_crust_mantle(indx(1)),zstore_crust_mantle(indx(1))) - ! print*,'x/y/z:',rval,thetaval,phival + ! print *,'x/y/z:',rval,thetaval,phival ! call exit_MPI(myrank,'Error stability') !endif diff --git a/src/specfem3D/compute_add_sources.f90 b/src/specfem3D/compute_add_sources.f90 index 04e13f83d..72d8db0b7 100644 --- a/src/specfem3D/compute_add_sources.f90 +++ b/src/specfem3D/compute_add_sources.f90 @@ -289,7 +289,7 @@ subroutine compute_add_sources_adjoint() ! checks next index if (ivec_index < 1 .or. ivec_index > NTSTEP_BETWEEN_READ_ADJSRC) then - print*,'Error iadj_vec bounds: rank',myrank,' it = ',it,' index = ',ivec_index, & + print *,'Error iadj_vec bounds: rank',myrank,' it = ',it,' index = ',ivec_index, & 'out of bounds ',1,'to',NTSTEP_BETWEEN_READ_ADJSRC call exit_MPI(myrank,'Error iadj_vec index bounds') endif @@ -352,7 +352,7 @@ subroutine compute_add_sources_backward() endif !debug - !if (myrank == 0 ) print*,'compute_add_sources_backward: it_tmp = ',it_tmp,it + !if (myrank == 0 ) print *,'compute_add_sources_backward: it_tmp = ',it_tmp,it if (.not. GPU_MODE) then ! on CPU diff --git a/src/specfem3D/compute_arrays_source.f90 b/src/specfem3D/compute_arrays_source.f90 index e674b7db2..f26da6613 100644 --- a/src/specfem3D/compute_arrays_source.f90 +++ b/src/specfem3D/compute_arrays_source.f90 @@ -238,9 +238,9 @@ subroutine compute_arrays_source_adjoint(myrank, adj_source_file, & read(IIN_ADJ,*,iostat=ios) junk, adj_src(icomp,index_i) if (ios /= 0) then - print*,'Error reading adjoint source: ',trim(filename) - print*,'rank ',myrank,' - time step: ',itime,' index_start: ',index_start,' index_end: ',index_end - print*,' ',trim(filename)//'has wrong length, please check with your simulation duration' + print *,'Error reading adjoint source: ',trim(filename) + print *,'rank ',myrank,' - time step: ',itime,' index_start: ',index_start,' index_end: ',index_end + print *,' ',trim(filename)//'has wrong length, please check with your simulation duration' call exit_MPI(myrank,'file '//trim(filename)//' has wrong length, please check with your simulation duration') endif enddo diff --git a/src/specfem3D/compute_forces_acoustic_calling_routine.F90 b/src/specfem3D/compute_forces_acoustic_calling_routine.F90 index e620075bf..5d98a3dcb 100644 --- a/src/specfem3D/compute_forces_acoustic_calling_routine.F90 +++ b/src/specfem3D/compute_forces_acoustic_calling_routine.F90 @@ -316,7 +316,7 @@ subroutine compute_forces_acoustic_backward() endif !debug - !if (myrank == 0 ) print*,'compute_forces_acoustic_backward: it = ',it_tmp + !if (myrank == 0 ) print *,'compute_forces_acoustic_backward: it = ',it_tmp ! **************************************************** diff --git a/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 b/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 index 4a6f24576..7a9b93117 100644 --- a/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 +++ b/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 @@ -471,28 +471,28 @@ subroutine compute_forces_viscoelastic_backward() ! iglob = ibool_crust_mantle(1,1,1,100) ! if (SIMULATION_TYPE == 1) then ! if (it == NSTEP .and. myrank == 0) then -! print*,'last step',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100), & +! print *,'last step',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100), & ! displ_crust_mantle(1,iglob),displ_crust_mantle(2,iglob),displ_crust_mantle(3,iglob) ! endif ! if (it == NSTEP-1 .and. myrank == 0) then -! print*,'second last step',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100), & +! print *,'second last step',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100), & ! displ_crust_mantle(1,iglob),displ_crust_mantle(2,iglob),displ_crust_mantle(3,iglob) ! endif ! if (it == NSTEP-2 .and. myrank == 0) then -! print*,'third last step',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100), & +! print *,'third last step',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100), & ! displ_crust_mantle(1,iglob),displ_crust_mantle(2,iglob),displ_crust_mantle(3,iglob) ! endif ! else if (SIMULATION_TYPE == 3) then ! if (it == 1 .and. myrank == 0) then -! print*,'first step',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100), & +! print *,'first step',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100), & ! b_displ_crust_mantle(1,iglob),b_displ_crust_mantle(2,iglob),b_displ_crust_mantle(3,iglob) ! endif ! if (it == 2 .and. myrank == 0) then -! print*,'second step',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100), & +! print *,'second step',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100), & ! b_displ_crust_mantle(1,iglob),b_displ_crust_mantle(2,iglob),b_displ_crust_mantle(3,iglob) ! endif ! if (it == 3 .and. myrank == 0) then -! print*,'third step',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100), & +! print *,'third step',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100), & ! b_displ_crust_mantle(1,iglob),b_displ_crust_mantle(2,iglob),b_displ_crust_mantle(3,iglob) ! endif ! endif @@ -878,11 +878,11 @@ subroutine compute_forces_viscoelastic_backward() ! if (DEBUG) then ! if (SIMULATION_TYPE == 1) then ! if (it > NSTEP - 1000 .and. myrank == 0) then -! print*,'it',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100) +! print *,'it',it,'Rxx:',R_xx_crust_mantle(1,1,1,1,100),epsilondev_xx_crust_mantle(1,1,1,100) ! endif ! else if (SIMULATION_TYPE == 3) then ! if (it <= 1000 .and. myrank == 0) then -! print*,'it',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100) +! print *,'it',it,'Rxx:',b_R_xx_crust_mantle(1,1,1,1,100),b_epsilondev_xx_crust_mantle(1,1,1,100) ! endif ! endif ! endif diff --git a/src/specfem3D/get_attenuation.f90 b/src/specfem3D/get_attenuation.f90 index 81dbf56a7..0d1929774 100644 --- a/src/specfem3D/get_attenuation.f90 +++ b/src/specfem3D/get_attenuation.f90 @@ -217,7 +217,7 @@ subroutine get_attenuation_scale_factor(myrank, T_c_source, tau_mu, tau_sigma, Q !--- check that the correction factor is close to one if (scale_factor < 0.8d0 .or. scale_factor > 1.2d0) then - print*,'Error: incorrect scale factor: ', scale_factor + print *,'Error: incorrect scale factor: ', scale_factor call exit_MPI(myrank,'incorrect correction factor in attenuation model') endif diff --git a/src/specfem3D/get_cmt.f90 b/src/specfem3D/get_cmt.f90 index 82176f7ae..c86dfd54d 100644 --- a/src/specfem3D/get_cmt.f90 +++ b/src/specfem3D/get_cmt.f90 @@ -103,7 +103,7 @@ subroutine get_cmt(yr,jda,ho,mi,sec,tshift_cmt,hdur,lat,long,depth,moment_tensor enddo ! debug - !print*,'line ----',string,'----' + !print *,'line ----',string,'----' ! reads header line with event information (assumes fixed format) ! old line: read(string,"(a4,i5,i3,i3,i3,i3,f6.2)") datasource,yr,mo,da,ho,mi,sec @@ -151,7 +151,7 @@ subroutine get_cmt(yr,jda,ho,mi,sec,tshift_cmt,hdur,lat,long,depth,moment_tensor if ( iend < istart ) stop 'Error determining number with negative length in header line in CMTSOLUTION file' ! debug - !print*,itype,'line ----',string(istart:iend),'----' + !print *,itype,'line ----',string(istart:iend),'----' ! reads in event time information select case (itype) diff --git a/src/specfem3D/initialize_simulation.f90 b/src/specfem3D/initialize_simulation.f90 index d49c3a3df..ab9035473 100644 --- a/src/specfem3D/initialize_simulation.f90 +++ b/src/specfem3D/initialize_simulation.f90 @@ -74,7 +74,7 @@ subroutine initialize_simulation() ! check that the code is running with the requested nb of processes if (sizeprocs /= NPROCTOT) then - if (myrank == 0) print*,'Error wrong number of MPI processes ',sizeprocs,' should be ',NPROCTOT,', please check...' + if (myrank == 0) print *,'Error wrong number of MPI processes ',sizeprocs,' should be ',NPROCTOT,', please check...' call exit_MPI(myrank,'wrong number of MPI processes in the initialization of SPECFEM') endif @@ -524,11 +524,11 @@ subroutine initialize_GPU() endif ! user output - if (myrank == 0 ) print*,'Hybrid CPU-GPU computation:' + if (myrank == 0 ) print *,'Hybrid CPU-GPU computation:' do iproc = 0, NPROCTOT_VAL-1 if (myrank == iproc) then if (myrank < TOTAL_PROCESSES_PER_NODE) then - print*,'rank ',myrank,' has GPU_MODE set to ',GPU_MODE + print *,'rank ',myrank,' has GPU_MODE set to ',GPU_MODE endif endif call synchronize_all() diff --git a/src/specfem3D/iterate_time.F90 b/src/specfem3D/iterate_time.F90 index 63a427cc5..9f78922ed 100644 --- a/src/specfem3D/iterate_time.F90 +++ b/src/specfem3D/iterate_time.F90 @@ -356,19 +356,19 @@ subroutine it_update_vtkwindow() if (mod(it,NTSTEP_BETWEEN_FRAMES) == 0) then ! user output - !if (myrank == 0 ) print*," VTK rendering..." + !if (myrank == 0 ) print *," VTK rendering..." ! updates time currenttime = sngl((it-1)*DT-t0) ! transfers fields from GPU to host if (GPU_MODE) then - !if (myrank == 0 ) print*," VTK: transferring velocity from GPU" + !if (myrank == 0 ) print *," VTK: transferring velocity from GPU" call transfer_veloc_cm_from_device(NDIM*NGLOB_CRUST_MANTLE,veloc_crust_mantle,Mesh_pointer) endif ! updates wavefield - !if (myrank == 0 ) print*," VTK: it = ",it," out of ",it_end," - norm of velocity field" + !if (myrank == 0 ) print *," VTK: it = ",it," out of ",it_end," - norm of velocity field" inum = 0 vtkdata(:) = 0.0 do iglob = 1,NGLOB_CRUST_MANTLE diff --git a/src/specfem3D/iterate_time_undoatt.F90 b/src/specfem3D/iterate_time_undoatt.F90 index 9f699cb1b..4aab03f8a 100644 --- a/src/specfem3D/iterate_time_undoatt.F90 +++ b/src/specfem3D/iterate_time_undoatt.F90 @@ -426,7 +426,7 @@ subroutine iterate_time_undoatt() ! safety check of last time loop increment if (it /= it_end) then - print*,'Error time increments: it_end = ',it_end,' and last it = ',it,' do not match!' + print *,'Error time increments: it_end = ',it_end,' and last it = ',it,' do not match!' call exit_MPI(myrank,'Error invalid time increment ending') endif diff --git a/src/specfem3D/locate_sources.f90 b/src/specfem3D/locate_sources.f90 index 9e292dd3f..9bfd2e4ae 100644 --- a/src/specfem3D/locate_sources.f90 +++ b/src/specfem3D/locate_sources.f90 @@ -579,8 +579,8 @@ subroutine locate_sources(nspec,nglob,ibool, & ! checks that the gather operation went well if (myrank == 0) then if (minval(ispec_selected_source_all(:,:)) <= 0) then - print*,'Error ispec all: procs = ',NPROCTOT_VAL,'sources subset size = ',NSOURCES_SUBSET_current_size - print*,ispec_selected_source_all(:,:) + print *,'Error ispec all: procs = ',NPROCTOT_VAL,'sources subset size = ',NSOURCES_SUBSET_current_size + print *,ispec_selected_source_all(:,:) call exit_MPI(myrank,'gather operation failed for source') endif endif diff --git a/src/specfem3D/noise_tomography.f90 b/src/specfem3D/noise_tomography.f90 index 73dd1bd09..c8738bc5f 100644 --- a/src/specfem3D/noise_tomography.f90 +++ b/src/specfem3D/noise_tomography.f90 @@ -295,7 +295,7 @@ subroutine check_parameters_noise() if (NSPEC_TOP > 2147483646 / (CUSTOM_REAL * NGLLX * NGLLY * NDIM)) then print *,'reclen of noise surface_movie needed exceeds integer 4-byte limit: ',reclen print *,' ',CUSTOM_REAL, NDIM, NGLLX * NGLLY, NSPEC_TOP - print*,'bit size fortran: ',bit_size(NSPEC_TOP) + print *,'bit size fortran: ',bit_size(NSPEC_TOP) call exit_MPI(myrank,"error NSPEC_TOP integer limit") endif @@ -364,7 +364,7 @@ subroutine compute_arrays_source_noise(myrank, & do itime = 1,NSTEP read(IIN_NOISE,*,iostat=ier) junk, noise_src(itime) if (ier /= 0) then - print*,'Error noise source S_squared file length: NSTEP length required is ',NSTEP,' with time step size ',DT + print *,'Error noise source S_squared file length: NSTEP length required is ',NSTEP,' with time step size ',DT call exit_MPI(myrank,'file '//trim(filename)//' has wrong length, please check with your simulation duration') endif enddo @@ -381,7 +381,7 @@ subroutine compute_arrays_source_noise(myrank, & do itime = 1,3 read(IIN_NOISE,*,iostat=ier) nu_master(itime) if (ier /= 0) then - print*,'Error noise nu_master file length: number of required components is 3' + print *,'Error noise nu_master file length: number of required components is 3' call exit_MPI(myrank,& 'file '//trim(filename)//' has wrong length, the vector should have three components (NEZ)') endif diff --git a/src/specfem3D/prepare_timerun.f90 b/src/specfem3D/prepare_timerun.f90 index ac9a59ab3..611843b2b 100644 --- a/src/specfem3D/prepare_timerun.f90 +++ b/src/specfem3D/prepare_timerun.f90 @@ -2854,7 +2854,7 @@ subroutine prepare_vtk_window() ! multiple MPI processes ! user output - !if (myrank == 0 ) print*," gathering all MPI info... " + !if (myrank == 0 ) print *," gathering all MPI info... " ! number of volume points for all partitions together call sum_all_i(free_np,free_np_all) @@ -2916,7 +2916,7 @@ subroutine prepare_vtk_window() if (myrank == 0) then ! locations - !if (myrank == 0 ) print*," locations..." + !if (myrank == 0 ) print *," locations..." call gatherv_all_r(free_x,free_np, & free_x_all,free_points_all,free_offset_all, & free_np_all,NPROC) @@ -2928,7 +2928,7 @@ subroutine prepare_vtk_window() free_np_all,NPROC) ! connectivity - !if (myrank == 0 ) print*," connectivity..." + !if (myrank == 0 ) print *," connectivity..." call gatherv_all_i(free_conn,4*free_nspec, & free_conn_all,free_conn_nspec_all,free_conn_offset_all, & free_nspec_all,NPROC) @@ -2943,7 +2943,7 @@ subroutine prepare_vtk_window() enddo enddo - !if (myrank == 0 ) print*," preparing VTK field..." + !if (myrank == 0 ) print *," preparing VTK field..." ! adds free surface to VTK window call prepare_vtkfreesurface(free_np_all,free_x_all,free_y_all,free_z_all, & @@ -3121,7 +3121,7 @@ subroutine prepare_vtk_window() ! multiple MPI processes ! user output - !if (myrank == 0 ) print*," gathering all MPI info... " + !if (myrank == 0 ) print *," gathering all MPI info... " ! number of volume points for all partitions together call sum_all_i(vol_np,vtkdata_numpoints_all) @@ -3191,7 +3191,7 @@ subroutine prepare_vtk_window() if (myrank == 0) then ! locations - !if (myrank == 0 ) print*," locations..." + !if (myrank == 0 ) print *," locations..." call gatherv_all_r(vol_x,vol_np, & vol_x_all,vtkdata_points_all,vtkdata_offset_all, & vtkdata_numpoints_all,NPROC) @@ -3203,7 +3203,7 @@ subroutine prepare_vtk_window() vtkdata_numpoints_all,NPROC) ! connectivity - !if (myrank == 0 ) print*," connectivity..." + !if (myrank == 0 ) print *," connectivity..." call gatherv_all_i(vol_conn,8*vol_nspec, & vol_conn_all,vol_conn_nspec_all,vol_conn_offset_all, & vol_nspec_all,NPROC) @@ -3218,7 +3218,7 @@ subroutine prepare_vtk_window() enddo enddo - !if (myrank == 0 ) print*," preparing VTK field..." + !if (myrank == 0 ) print *," preparing VTK field..." ! adds total volume wavefield to VTK window call prepare_vtkfield(vtkdata_numpoints_all,vol_x_all,vol_y_all,vol_z_all, & @@ -3244,7 +3244,7 @@ subroutine prepare_vtk_window() else ! serial run - !if (myrank == 0 ) print*," preparing VTK field..." + !if (myrank == 0 ) print *," preparing VTK field..." ! adds volume wavefield to VTK window call prepare_vtkfield(vol_np,vol_x,vol_y,vol_z,vol_nspec,vol_conn) diff --git a/src/specfem3D/read_adjoint_sources.f90 b/src/specfem3D/read_adjoint_sources.f90 index e3f43a214..b2cbcf64d 100644 --- a/src/specfem3D/read_adjoint_sources.f90 +++ b/src/specfem3D/read_adjoint_sources.f90 @@ -59,7 +59,7 @@ subroutine read_adjoint_sources() it_sub_adj = ceiling( dble(it)/dble(NTSTEP_BETWEEN_READ_ADJSRC) ) ! debug - !print*,'read adjoint sources: it_sub_adj = ',it_sub_adj + !print *,'read adjoint sources: it_sub_adj = ',it_sub_adj ! asynchronously reads in adjoint source files if (IO_ASYNC_COPY .and. NSTEP_SUB_ADJ > 1) then @@ -97,8 +97,8 @@ subroutine read_adjoint_sources() endif ! debug timing - !print*,'read adjoint sources: elapsed time = ',wtime() - tstart - !print* + !print *,'read adjoint sources: elapsed time = ',wtime() - tstart + !print * end subroutine read_adjoint_sources @@ -128,12 +128,12 @@ subroutine read_adjoint_sources_local(sourcearrays,nadj_rec_local,it_sub_adj) character(len=MAX_STRING_LEN) :: adj_source_file ! debug - !print*,'reading adjoint sources local:',myrank,' - chunk ',it_sub_adj,'out of ',NSTEP_SUB_ADJ, & + !print *,'reading adjoint sources local:',myrank,' - chunk ',it_sub_adj,'out of ',NSTEP_SUB_ADJ, & ! ' for local adjoint sources = ',nadj_rec_local ! checks chunk number if (it_sub_adj < 1 .or. it_sub_adj > NSTEP_SUB_ADJ) then - print*,'Error reading adjoint sources: chunk number ',it_sub_adj,'is invalid' + print *,'Error reading adjoint sources: chunk number ',it_sub_adj,'is invalid' call exit_MPI(myrank,'Error reading adjoint sources with invalid chunk number') endif @@ -151,7 +151,7 @@ subroutine read_adjoint_sources_local(sourcearrays,nadj_rec_local,it_sub_adj) do irec = 1, nrec ! checks that the source slice number is okay if (islice_selected_rec(irec) < 0 .or. islice_selected_rec(irec) > NPROCTOT_VAL-1) then - print*,'Error rank ',myrank,': adjoint source slice index ',islice_selected_rec(irec),& + print *,'Error rank ',myrank,': adjoint source slice index ',islice_selected_rec(irec),& ' is out of bounds ',NPROCTOT_VAL-1 call exit_MPI(myrank,'Error adjoint source has wrong source slice number in adjoint simulation') endif @@ -255,7 +255,7 @@ subroutine check_adjoint_sources(irec,nadj_files_found) ! checks length if (itime /= NSTEP) then - print*,'adjoint source error: ',trim(filename),' has length',itime,' but should be',NSTEP + print *,'adjoint source error: ',trim(filename),' has length',itime,' but should be',NSTEP call exit_MPI(myrank,& 'file '//trim(filename)//' length is wrong, please check your adjoint sources and your simulation duration') endif diff --git a/src/specfem3D/read_arrays_solver.f90 b/src/specfem3D/read_arrays_solver.f90 index efce5fa7e..9d010e240 100644 --- a/src/specfem3D/read_arrays_solver.f90 +++ b/src/specfem3D/read_arrays_solver.f90 @@ -114,14 +114,14 @@ subroutine read_arrays_solver(iregion_code,myrank, & ! checks dimensions if (lnspec /= nspec) then close(IIN) - print*,'Error file dimension: nspec in file = ',lnspec,' but nspec desired:',nspec - print*,'please check file ',prname(1:len_trim(prname))//'solver_data.bin' + print *,'Error file dimension: nspec in file = ',lnspec,' but nspec desired:',nspec + print *,'please check file ',prname(1:len_trim(prname))//'solver_data.bin' call exit_mpi(myrank,'Error dimensions in solver_data.bin') endif if (lnglob /= nglob) then close(IIN) - print*,'Error file dimension: nglob in file = ',lnglob,' but nglob desired:',nglob - print*,'please check file ',prname(1:len_trim(prname))//'solver_data.bin' + print *,'Error file dimension: nglob in file = ',lnglob,' but nglob desired:',nglob + print *,'please check file ',prname(1:len_trim(prname))//'solver_data.bin' call exit_mpi(myrank,'Error dimensions in solver_data.bin') endif diff --git a/src/specfem3D/read_arrays_solver_adios.F90 b/src/specfem3D/read_arrays_solver_adios.F90 index cd4bc00b0..5ddbe26bb 100644 --- a/src/specfem3D/read_arrays_solver_adios.F90 +++ b/src/specfem3D/read_arrays_solver_adios.F90 @@ -126,7 +126,7 @@ subroutine read_arrays_solver_adios(iregion_code,myrank, & call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -442,15 +442,15 @@ subroutine read_arrays_solver_adios(iregion_code,myrank, & ! checks dimensions if (lnspec /= nspec) then - print*,'Error file dimension: nspec in file = ',lnspec, & + print *,'Error file dimension: nspec in file = ',lnspec, & ' but nspec desired:',nspec - print*,'please check file ', file_name + print *,'please check file ', file_name call exit_mpi(myrank,'Error dimensions in solver_data.bp') endif if (lnglob /= nglob) then - print*,'Error file dimension: nglob in file = ',lnglob, & + print *,'Error file dimension: nglob in file = ',lnglob, & ' but nglob desired:',nglob - print*,'please check file ', file_name + print *,'please check file ', file_name call exit_mpi(myrank,'Error dimensions in solver_data.bp') endif diff --git a/src/specfem3D/read_attenuation_adios.f90 b/src/specfem3D/read_attenuation_adios.f90 index 5273cfb4b..789d40aef 100644 --- a/src/specfem3D/read_attenuation_adios.f90 +++ b/src/specfem3D/read_attenuation_adios.f90 @@ -77,7 +77,7 @@ subroutine read_attenuation_adios(myrank, iregion_code, & call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif diff --git a/src/specfem3D/read_forward_arrays.f90 b/src/specfem3D/read_forward_arrays.f90 index 56fd9427c..dc06bdeee 100644 --- a/src/specfem3D/read_forward_arrays.f90 +++ b/src/specfem3D/read_forward_arrays.f90 @@ -156,8 +156,8 @@ subroutine read_forward_arrays() open(unit=IIN,file=trim(outputname), & status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error: opening proc_****_save_forward_arrays.bin' - print*,'path: ',outputname + print *,'Error: opening proc_****_save_forward_arrays.bin' + print *,'path: ',outputname call exit_mpi(myrank,'Error open file save_forward_arrays.bin') endif @@ -279,7 +279,7 @@ subroutine read_forward_arrays_undoatt() outputname = trim(LOCAL_PATH) // '/' // outputname(1:len_trim(outputname)) ! debug - !if (myrank == 0 ) print*,'reading in: ',trim(LOCAL_PATH)//'/'//trim(outputname),iteration_on_subset_tmp,iteration_on_subset,it + !if (myrank == 0 ) print *,'reading in: ',trim(LOCAL_PATH)//'/'//trim(outputname),iteration_on_subset_tmp,iteration_on_subset,it ! opens corresponding snapshot file for reading open(unit=IIN,file=trim(outputname), & diff --git a/src/specfem3D/read_forward_arrays_adios.F90 b/src/specfem3D/read_forward_arrays_adios.F90 index fc05f6a1f..7be672f46 100644 --- a/src/specfem3D/read_forward_arrays_adios.F90 +++ b/src/specfem3D/read_forward_arrays_adios.F90 @@ -68,7 +68,7 @@ subroutine read_intermediate_forward_arrays_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -249,7 +249,7 @@ subroutine read_forward_arrays_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -437,7 +437,7 @@ subroutine read_forward_arrays_undoatt_adios(iteration_on_subset_tmp) call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif diff --git a/src/specfem3D/read_mesh_databases_adios.f90 b/src/specfem3D/read_mesh_databases_adios.f90 index fac8e3f89..cc00da1c5 100644 --- a/src/specfem3D/read_mesh_databases_adios.f90 +++ b/src/specfem3D/read_mesh_databases_adios.f90 @@ -65,7 +65,7 @@ subroutine read_mesh_databases_coupling_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -508,7 +508,7 @@ subroutine read_mesh_databases_coupling_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -759,7 +759,7 @@ subroutine read_mesh_databases_MPI_CM_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -967,7 +967,7 @@ subroutine read_mesh_databases_MPI_OC_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -1172,7 +1172,7 @@ subroutine read_mesh_databases_MPI_IC_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif @@ -1379,7 +1379,7 @@ subroutine read_mesh_databases_stacey_adios() call adios_read_open_file (adios_handle, file_name, 0, comm, adios_err) if (adios_err /= 0) then - print*,'Error rank ',myrank,' opening adios file: ',trim(file_name) + print *,'Error rank ',myrank,' opening adios file: ',trim(file_name) call check_adios_err(myrank,adios_err) endif diff --git a/src/specfem3D/save_forward_arrays.f90 b/src/specfem3D/save_forward_arrays.f90 index 29e0bb873..cbed0de76 100644 --- a/src/specfem3D/save_forward_arrays.f90 +++ b/src/specfem3D/save_forward_arrays.f90 @@ -214,7 +214,7 @@ subroutine save_forward_arrays_undoatt() outputname = trim(LOCAL_PATH)//'/'//trim(outputname) ! debug - !if (myrank == 0 ) print*,'saving in: ',trim(LOCAL_PATH)//'/'//trim(outputname), iteration_on_subset_tmp,it + !if (myrank == 0 ) print *,'saving in: ',trim(LOCAL_PATH)//'/'//trim(outputname), iteration_on_subset_tmp,it open(unit=IOUT,file=trim(outputname), & status='unknown',form='unformatted',action='write',iostat=ier) diff --git a/src/specfem3D/setup_sources_receivers.f90 b/src/specfem3D/setup_sources_receivers.f90 index ef271a7a9..b38e3178a 100644 --- a/src/specfem3D/setup_sources_receivers.f90 +++ b/src/specfem3D/setup_sources_receivers.f90 @@ -324,7 +324,7 @@ subroutine setup_timesteps() ! checks length for symmetry in case of noise simulations if (NOISE_TOMOGRAPHY /= 0) then if (mod(NSTEP+1,2) /= 0) then - print*,'Error noise simulation: invalid time steps = ',NSTEP,' -> NSTEP + 1 must be a multiple of 2 due to branch symmetry' + print *,'Error noise simulation: invalid time steps = ',NSTEP,' -> NSTEP + 1 must be a multiple of 2 due to branch symmetry' call exit_MPI(myrank,'Error noise simulation: number of timesteps must be symmetric, due to +/- branches') endif endif @@ -343,7 +343,7 @@ subroutine setup_timesteps() endif ! debug - !if (myrank == 0 ) print*,'setup time steps = ',NSTEP,' t0 = ',t0,' DT = ',DT + !if (myrank == 0 ) print *,'setup time steps = ',NSTEP,' t0 = ',t0,' DT = ',DT end subroutine setup_timesteps @@ -659,7 +659,7 @@ subroutine setup_sources_precompute_arrays() ! source interpolated on all GLL points in source element allocate(sourcearrays(NDIM,NGLLX,NGLLY,NGLLZ,NSOURCES),stat=ier) if (ier /= 0 ) then - print*,'Error rank ',myrank,': allocating sourcearrays failed! number of sources = ',NSOURCES + print *,'Error rank ',myrank,': allocating sourcearrays failed! number of sources = ',NSOURCES call exit_MPI(myrank,'Error allocating sourcearrays') endif ! initializes @@ -688,8 +688,8 @@ subroutine setup_sources_precompute_arrays() allocate(adj_sourcearrays(NDIM,NGLLX,NGLLY,NGLLZ,nadj_rec_local,NTSTEP_BETWEEN_READ_ADJSRC), & stat=ier) if (ier /= 0 ) then - print*,'Error rank ',myrank,': allocating adjoint sourcearrays failed! Please check your memory usage...' - print*,' failed number of local adjoint sources = ',nadj_rec_local,' steps = ',NTSTEP_BETWEEN_READ_ADJSRC + print *,'Error rank ',myrank,': allocating adjoint sourcearrays failed! Please check your memory usage...' + print *,' failed number of local adjoint sources = ',nadj_rec_local,' steps = ',NTSTEP_BETWEEN_READ_ADJSRC call exit_MPI(myrank,'Error allocating adjoint sourcearrays') endif ! initializes @@ -707,7 +707,7 @@ subroutine setup_sources_precompute_arrays() arraysize = arraysize * nadj_rec_local * NTSTEP_BETWEEN_READ_ADJSRC ! debug - !print*,'buffer_sourcearrays: size = ',arraysize,' Bytes = ',arraysize/1024./1024.,'MB' + !print *,'buffer_sourcearrays: size = ',arraysize,' Bytes = ',arraysize/1024./1024.,'MB' ! initializes io thread call prepare_adj_io_thread(buffer_sourcearrays,arraysize,nadj_rec_local) diff --git a/src/specfem3D/write_movie_output.f90 b/src/specfem3D/write_movie_output.f90 index f332914ac..6e9d746d5 100644 --- a/src/specfem3D/write_movie_output.f90 +++ b/src/specfem3D/write_movie_output.f90 @@ -84,7 +84,7 @@ subroutine write_movie_output() ! calls shell external command if (myrank == 0) then write(command,"(a,1x,i6.6,' >& out.',i6.6,'.log &')") trim(MOVIE_SCRIPT_NAME),it,it - !print*,trim(command) + !print *,trim(command) call system_command(command) endif endif @@ -265,7 +265,7 @@ subroutine write_movie_output() ! calls shell external command if (myrank == 0) then write(command,"(a,1x,i6.6,' >& out.',i6.6,'.log &')") trim(MOVIE_SCRIPT_NAME),it,it - !print*,trim(command) + !print *,trim(command) call system_command(command) endif endif diff --git a/src/specfem3D/write_movie_surface.f90 b/src/specfem3D/write_movie_surface.f90 index 251212aa8..250f391b3 100644 --- a/src/specfem3D/write_movie_surface.f90 +++ b/src/specfem3D/write_movie_surface.f90 @@ -50,7 +50,7 @@ subroutine movie_surface_count_points() ! checks if (npoin /= nmovie_points) then - print*,'Error: movie points collected ',npoin,'not equal to calculated :',nmovie_points + print *,'Error: movie points collected ',npoin,'not equal to calculated :',nmovie_points call exit_mpi(myrank,'Error confusing number of movie points') endif diff --git a/src/specfem3D/write_output_ASDF.F90 b/src/specfem3D/write_output_ASDF.F90 index 0a824c3b7..92628799a 100644 --- a/src/specfem3D/write_output_ASDF.F90 +++ b/src/specfem3D/write_output_ASDF.F90 @@ -352,7 +352,7 @@ subroutine write_asdf_data(asdf_fn, asdf_container, adios_group, rank, nproc, co ! Open the handle to file containing all the ADIOS variables call adios_open(adios_handle, "EVENTS", asdf_fn, "w", comm, adios_err) if (adios_err /= 0) then - print*,'Error: rank ',rank,' could not open adios file ',trim(asdf_fn) + print *,'Error: rank ',rank,' could not open adios file ',trim(asdf_fn) stop 'Error calling adios_open() routine failed for EVENTS' endif @@ -590,7 +590,7 @@ subroutine write_asdf_data_sub(asdf_container, adios_handle, rank, nproc) ! if (ierr /= 0) call exit_MPI (rank, 'Allocate failed.') ! way 2: fortran 95 if (6*asdf_container%nrecords > BUFFER_LENGTH) then - print*,'Error: buffer length too small - minimum length is ',6*asdf_container%nrecords + print *,'Error: buffer length too small - minimum length is ',6*asdf_container%nrecords stop 'Error in write_asdf_data_sub() routine, BUFFER_LENGTH too small' endif @@ -637,7 +637,7 @@ subroutine write_asdf_data_sub(asdf_container, adios_handle, rank, nproc) ! way 2: fortran 95 if (rn_len_total > BUFFER_LENGTH_TOTAL .or. nw_len_total > BUFFER_LENGTH_TOTAL .or. & rid_len_total > BUFFER_LENGTH_TOTAL .or. comp_len_total > BUFFER_LENGTH_TOTAL) then - print*,'Error: buffer length total too small - lengths are ',rn_len_total,nw_len_total,rid_len_total,comp_len_total + print *,'Error: buffer length total too small - lengths are ',rn_len_total,nw_len_total,rid_len_total,comp_len_total stop 'Error in write_asdf_data_sub() routine, BUFFER_LENGTH_TOTAL too small' endif else diff --git a/src/specfem3D/write_seismograms.f90 b/src/specfem3D/write_seismograms.f90 index 8fd830079..4245aab66 100644 --- a/src/specfem3D/write_seismograms.f90 +++ b/src/specfem3D/write_seismograms.f90 @@ -283,7 +283,7 @@ subroutine write_seismograms_to_file() iproc = islice_selected_rec(irec) ! checks iproc value if (iproc < 0 .or. iproc >= NPROCTOT_VAL) then - print*,'Error :',myrank,'iproc = ',iproc,'NPROCTOT = ',NPROCTOT_VAL + print *,'Error :',myrank,'iproc = ',iproc,'NPROCTOT = ',NPROCTOT_VAL call exit_mpi(myrank,'Error iproc in islice_selected_rec') endif ! sums number of receivers for each slice diff --git a/src/tomography/add_model_iso.f90 b/src/tomography/add_model_iso.f90 index 2c7ddd07d..0942404c8 100644 --- a/src/tomography/add_model_iso.f90 +++ b/src/tomography/add_model_iso.f90 @@ -85,27 +85,27 @@ program add_model ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'program add_model_iso: ' - print*,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val - print*,' NCHUNKS: ',nchunks_val - print* - print*,'model update for vs & vp & rho' - print*,' step_fac = ',step_fac - print* + print * + print *,'***********' + print *,'program add_model_iso: ' + print *,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val + print *,' NCHUNKS: ',nchunks_val + print * + print *,'model update for vs & vp & rho' + print *,' step_fac = ',step_fac + print * if (USE_ALPHA_BETA_RHO) then - print*,'kernel parameterization: (alpha,beta,rho)' + print *,'kernel parameterization: (alpha,beta,rho)' else - print*,'kernel parameterization: (bulk,beta,rho)' + print *,'kernel parameterization: (bulk,beta,rho)' endif - print* + print * if (USE_RHO_SCALING) then - print*,'scaling rho perturbations' - print* + print *,'scaling rho perturbations' + print * endif - print*,'***********' - print* + print *,'***********' + print * endif ! reads in current isotropic model files: vp & vs & rho @@ -213,10 +213,10 @@ subroutine initialize() if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*, 'Error number of processors supposed to run on : ',NPROCTOT_VAL - print*, 'Error number of MPI processors actually run on: ',sizeprocs - print* - print*, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' + print *, 'Error number of processors supposed to run on : ',NPROCTOT_VAL + print *, 'Error number of MPI processors actually run on: ',sizeprocs + print * + print *, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' endif call exit_MPI(myrank,'Error wrong number of MPI processes') endif diff --git a/src/tomography/add_model_tiso.f90 b/src/tomography/add_model_tiso.f90 index f3c90f00f..e391e0ff9 100644 --- a/src/tomography/add_model_tiso.f90 +++ b/src/tomography/add_model_tiso.f90 @@ -89,17 +89,17 @@ program add_model ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'program add_model_tiso: ' - print*,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val - print*,' NCHUNKS: ',nchunks_val - print* - print*,'model update for vsv,vsh,vpv,vph,eta,rho:' - print*,' step_fac = ',step_fac - print* - print*,'***********' - print* + print * + print *,'***********' + print *,'program add_model_tiso: ' + print *,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val + print *,' NCHUNKS: ',nchunks_val + print * + print *,'model update for vsv,vsh,vpv,vph,eta,rho:' + print *,' step_fac = ',step_fac + print * + print *,'***********' + print * endif ! reads in current transverse isotropic model files: vpv.. & vsv.. & eta & rho @@ -262,10 +262,10 @@ subroutine initialize() if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*, 'Error number of processors supposed to run on : ',NPROCTOT_VAL - print*, 'Error number of MPI processors actually run on: ',sizeprocs - print* - print*, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' + print *, 'Error number of processors supposed to run on : ',NPROCTOT_VAL + print *, 'Error number of MPI processors actually run on: ',sizeprocs + print * + print *, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' endif call exit_MPI(myrank,'Error wrong number of MPI processes') endif diff --git a/src/tomography/add_model_tiso_cg.f90 b/src/tomography/add_model_tiso_cg.f90 index 9481e9785..b5492d677 100644 --- a/src/tomography/add_model_tiso_cg.f90 +++ b/src/tomography/add_model_tiso_cg.f90 @@ -103,17 +103,17 @@ program add_model ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'program add_model_tiso_cg: ' - print*,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val - print*,' NCHUNKS: ',nchunks_val - print* - print*,'model update for vsv,vsh,vpv,vph,eta,rho:' - print*,' step_fac = ',step_fac - print* - print*,'***********' - print* + print * + print *,'***********' + print *,'program add_model_tiso_cg: ' + print *,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val + print *,' NCHUNKS: ',nchunks_val + print * + print *,'model update for vsv,vsh,vpv,vph,eta,rho:' + print *,' step_fac = ',step_fac + print * + print *,'***********' + print * endif ! reads in current transverse isotropic model files: vpv.. & vsv.. & eta & rho @@ -279,10 +279,10 @@ subroutine initialize() if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*, 'Error number of processors supposed to run on : ',NPROCTOT_VAL - print*, 'Error number of MPI processors actually run on: ',sizeprocs - print* - print*, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' + print *, 'Error number of processors supposed to run on : ',NPROCTOT_VAL + print *, 'Error number of MPI processors actually run on: ',sizeprocs + print * + print *, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' endif call exit_MPI(myrank,'Error wrong number of MPI processes') endif diff --git a/src/tomography/add_model_tiso_iso.f90 b/src/tomography/add_model_tiso_iso.f90 index cad97e927..1e6fae06c 100644 --- a/src/tomography/add_model_tiso_iso.f90 +++ b/src/tomography/add_model_tiso_iso.f90 @@ -92,27 +92,27 @@ program add_model ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'program add_model_tiso_iso: ' - print*,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val - print*,' NCHUNKS: ',nchunks_val - print* - print*,'model update for vsv,vsh,vpv,vph,eta,rho:' - print*,' step_fac = ',step_fac - print* + print * + print *,'***********' + print *,'program add_model_tiso_iso: ' + print *,' NPROC_XI , NPROC_ETA: ',nproc_xi_val,nproc_eta_val + print *,' NCHUNKS: ',nchunks_val + print * + print *,'model update for vsv,vsh,vpv,vph,eta,rho:' + print *,' step_fac = ',step_fac + print * if (USE_ALPHA_BETA_RHO) then - print*,'kernel parameterization: (alpha,beta,rho)' + print *,'kernel parameterization: (alpha,beta,rho)' else - print*,'kernel parameterization: (bulk,beta,rho)' + print *,'kernel parameterization: (bulk,beta,rho)' endif - print* + print * if (USE_RHO_SCALING) then - print*,'scaling rho perturbations' - print* + print *,'scaling rho perturbations' + print * endif - print*,'***********' - print* + print *,'***********' + print * endif ! reads in current transverse isotropic model files: vpv.. & vsv.. & eta & rho @@ -243,10 +243,10 @@ subroutine initialize() if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*, 'Error number of processors supposed to run on : ',NPROCTOT_VAL - print*, 'Error number of MPI processors actually run on: ',sizeprocs - print* - print*, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' + print *, 'Error number of processors supposed to run on : ',NPROCTOT_VAL + print *, 'Error number of MPI processors actually run on: ',sizeprocs + print * + print *, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xadd_model .. ' endif call exit_MPI(myrank,'Error wrong number of MPI processes') endif diff --git a/src/tomography/compute_kernel_integral.f90 b/src/tomography/compute_kernel_integral.f90 index 8f3858ef6..f0414792f 100644 --- a/src/tomography/compute_kernel_integral.f90 +++ b/src/tomography/compute_kernel_integral.f90 @@ -64,11 +64,11 @@ subroutine compute_kernel_integral_iso() ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'statistics:' - print*,'***********' - print* + print * + print *,'***********' + print *,'statistics:' + print *,'***********' + print * endif ! allocates array @@ -109,11 +109,11 @@ subroutine compute_kernel_integral_iso() do i = 1, NGLLX iglob = ibool(i,j,k,ispec) if (iglob == 0) then - print*,'iglob zero',i,j,k,ispec - print* - print*,'ibool:',ispec - print*,ibool(:,:,:,ispec) - print* + print *,'iglob zero',i,j,k,ispec + print * + print *,'ibool:',ispec + print *,ibool(:,:,:,ispec) + print * call exit_MPI(myrank,'Error ibool') endif @@ -138,10 +138,10 @@ subroutine compute_kernel_integral_iso() ! checks number (isNaN) if (kernel_integral_alpha /= kernel_integral_alpha) then - print*,'Error NaN: ',kernel_integral_alpha - print*,'rank:',myrank - print*,'i,j,k,ispec:',i,j,k,ispec - print*,'volumel: ',volumel,'kernel_bulk:',kernel_bulk(i,j,k,ispec) + print *,'Error NaN: ',kernel_integral_alpha + print *,'rank:',myrank + print *,'i,j,k,ispec:',i,j,k,ispec + print *,'volumel: ',volumel,'kernel_bulk:',kernel_bulk(i,j,k,ispec) call exit_MPI(myrank,'Error NaN') endif @@ -170,13 +170,13 @@ subroutine compute_kernel_integral_iso() call sum_all_cr(volume_glob,volume_glob_sum) if (myrank == 0) then - print*,'integral kernels:' - print*,' a : ',integral_alpha_sum - print*,' beta: ',integral_beta_sum - print*,' rho : ',integral_rho_sum - print* - print*,' total volume:',volume_glob_sum - print* + print *,'integral kernels:' + print *,' a : ',integral_alpha_sum + print *,' beta: ',integral_beta_sum + print *,' rho : ',integral_rho_sum + print * + print *,' total volume:',volume_glob_sum + print * if (volume_glob_sum < 1.e-25) stop 'Error zero total volume' endif @@ -190,11 +190,11 @@ subroutine compute_kernel_integral_iso() norm_beta = sqrt(norm_beta_sum) norm_rho = sqrt(norm_rho_sum) - print*,'norm kernels:' - print*,' a : ',norm_bulk - print*,' beta: ',norm_beta - print*,' rho : ',norm_rho - print* + print *,'norm kernels:' + print *,' a : ',norm_bulk + print *,' beta: ',norm_beta + print *,' rho : ',norm_rho + print * endif ! root-mean square @@ -207,11 +207,11 @@ subroutine compute_kernel_integral_iso() rms_vs = sqrt( rms_vs_sum / volume_glob_sum ) rms_rho = sqrt( rms_rho_sum / volume_glob_sum ) - print*,'root-mean square of perturbations:' - print*,' vp : ',rms_vp - print*,' vs : ',rms_vs - print*,' rho: ',rms_rho - print* + print *,'root-mean square of perturbations:' + print *,' vp : ',rms_vp + print *,' vs : ',rms_vs + print *,' rho: ',rms_rho + print * endif call synchronize_all() @@ -266,11 +266,11 @@ subroutine compute_kernel_integral_tiso() ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'statistics:' - print*,'***********' - print* + print * + print *,'***********' + print *,'statistics:' + print *,'***********' + print * endif ! allocates array @@ -315,11 +315,11 @@ subroutine compute_kernel_integral_tiso() do i = 1, NGLLX iglob = ibool(i,j,k,ispec) if (iglob == 0) then - print*,'iglob zero',i,j,k,ispec - print* - print*,'ibool:',ispec - print*,ibool(:,:,:,ispec) - print* + print *,'iglob zero',i,j,k,ispec + print * + print *,'ibool:',ispec + print *,ibool(:,:,:,ispec) + print * call exit_MPI(myrank,'Error ibool') endif @@ -348,10 +348,10 @@ subroutine compute_kernel_integral_tiso() ! checks number if (integral_bulk /= integral_bulk) then - print*,'Error NaN: ',integral_bulk - print*,'rank:',myrank - print*,'i,j,k,ispec:',i,j,k,ispec - print*,'volumel: ',volumel,'kernel_bulk:',kernel_bulk(i,j,k,ispec) + print *,'Error NaN: ',integral_bulk + print *,'rank:',myrank + print *,'i,j,k,ispec:',i,j,k,ispec + print *,'volumel: ',volumel,'kernel_bulk:',kernel_bulk(i,j,k,ispec) call exit_MPI(myrank,'Error NaN') endif @@ -390,14 +390,14 @@ subroutine compute_kernel_integral_tiso() call sum_all_cr(volume_glob,volume_glob_sum) if (myrank == 0) then - print*,'integral kernels:' - print*,' bulk : ',integral_bulk_sum - print*,' betav: ',integral_betav_sum - print*,' betah: ',integral_betah_sum - print*,' eta : ',integral_eta_sum - print* - print*,' total volume:',volume_glob_sum - print* + print *,'integral kernels:' + print *,' bulk : ',integral_bulk_sum + print *,' betav: ',integral_betav_sum + print *,' betah: ',integral_betah_sum + print *,' eta : ',integral_eta_sum + print * + print *,' total volume:',volume_glob_sum + print * if (volume_glob_sum < 1.e-25) stop 'Error zero total volume' endif @@ -413,12 +413,12 @@ subroutine compute_kernel_integral_tiso() norm_betah = sqrt(norm_betah_sum) norm_eta = sqrt(norm_eta_sum) - print*,'norm kernels:' - print*,' bulk : ',norm_bulk - print*,' betav: ',norm_betav - print*,' betah: ',norm_betah - print*,' eta : ',norm_eta - print* + print *,'norm kernels:' + print *,' bulk : ',norm_bulk + print *,' betav: ',norm_betav + print *,' betah: ',norm_betah + print *,' eta : ',norm_eta + print * endif ! root-mean square @@ -437,14 +437,14 @@ subroutine compute_kernel_integral_tiso() rms_eta = sqrt( rms_eta_sum / volume_glob_sum ) rms_rho = sqrt( rms_rho_sum / volume_glob_sum ) - print*,'root-mean square of perturbations:' - print*,' vpv: ',rms_vpv - print*,' vph: ',rms_vph - print*,' vsv: ',rms_vsv - print*,' vsh: ',rms_vsh - print*,' eta: ',rms_eta - print*,' rho: ',rms_rho - print* + print *,'root-mean square of perturbations:' + print *,' vpv: ',rms_vpv + print *,' vph: ',rms_vph + print *,' vsv: ',rms_vsv + print *,' vsh: ',rms_vsh + print *,' eta: ',rms_eta + print *,' rho: ',rms_rho + print * endif call synchronize_all() @@ -496,11 +496,11 @@ subroutine compute_kernel_integral_tiso_iso() ! user output if (myrank == 0) then - print* - print*,'***********' - print*,'statistics:' - print*,'***********' - print* + print * + print *,'***********' + print *,'statistics:' + print *,'***********' + print * endif ! allocates array @@ -544,11 +544,11 @@ subroutine compute_kernel_integral_tiso_iso() do i = 1, NGLLX iglob = ibool(i,j,k,ispec) if (iglob == 0) then - print*,'iglob zero',i,j,k,ispec - print* - print*,'ibool:',ispec - print*,ibool(:,:,:,ispec) - print* + print *,'iglob zero',i,j,k,ispec + print * + print *,'ibool:',ispec + print *,ibool(:,:,:,ispec) + print * call exit_MPI(myrank,'Error ibool') endif @@ -573,10 +573,10 @@ subroutine compute_kernel_integral_tiso_iso() ! checks number if (integral_bulk /= integral_bulk) then - print*,'Error NaN: ',integral_bulk - print*,'rank:',myrank - print*,'i,j,k,ispec:',i,j,k,ispec - print*,'volumel: ',volumel,'kernel_bulk:',kernel_bulk(i,j,k,ispec) + print *,'Error NaN: ',integral_bulk + print *,'rank:',myrank + print *,'i,j,k,ispec:',i,j,k,ispec + print *,'volumel: ',volumel,'kernel_bulk:',kernel_bulk(i,j,k,ispec) call exit_MPI(myrank,'Error NaN') endif @@ -614,13 +614,13 @@ subroutine compute_kernel_integral_tiso_iso() call sum_all_cr(volume_glob,volume_glob_sum) if (myrank == 0) then - print*,'integral kernels:' - print*,' a : ',integral_bulk_sum - print*,' beta: ',integral_beta_sum - print*,' rho : ',integral_rho_sum - print* - print*,' total volume:',volume_glob_sum - print* + print *,'integral kernels:' + print *,' a : ',integral_bulk_sum + print *,' beta: ',integral_beta_sum + print *,' rho : ',integral_rho_sum + print * + print *,' total volume:',volume_glob_sum + print * if (volume_glob_sum < 1.e-25) stop 'Error zero total volume' endif @@ -634,11 +634,11 @@ subroutine compute_kernel_integral_tiso_iso() norm_beta = sqrt(norm_beta_sum) norm_rho = sqrt(norm_rho_sum) - print*,'norm kernels:' - print*,' a : ',norm_bulk - print*,' beta: ',norm_beta - print*,' rho : ',norm_rho - print* + print *,'norm kernels:' + print *,' a : ',norm_bulk + print *,' beta: ',norm_beta + print *,' rho : ',norm_rho + print * endif ! root-mean square @@ -657,14 +657,14 @@ subroutine compute_kernel_integral_tiso_iso() rms_eta = sqrt( rms_eta_sum / volume_glob_sum ) rms_rho = sqrt( rms_rho_sum / volume_glob_sum ) - print*,'root-mean square of perturbations:' - print*,' vpv: ',rms_vpv - print*,' vph: ',rms_vph - print*,' vsv: ',rms_vsv - print*,' vsh: ',rms_vsh - print*,' eta: ',rms_eta - print*,' rho: ',rms_rho - print* + print *,'root-mean square of perturbations:' + print *,' vpv: ',rms_vpv + print *,' vph: ',rms_vph + print *,' vsv: ',rms_vsv + print *,' vsh: ',rms_vsh + print *,' eta: ',rms_eta + print *,' rho: ',rms_rho + print * endif call synchronize_all() @@ -712,7 +712,7 @@ subroutine compute_jacobian(jacobian) open(IIN,file=trim(m_file),status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif diff --git a/src/tomography/get_cg_direction.f90 b/src/tomography/get_cg_direction.f90 index 8eb63ecde..70007405c 100644 --- a/src/tomography/get_cg_direction.f90 +++ b/src/tomography/get_cg_direction.f90 @@ -92,12 +92,12 @@ subroutine get_gradient_cg_tiso() norm_eta_old = norm_eta_sum if (myrank == 0) then - print*,'norm squared old gradient:' - print*,' bulk : ',norm_bulk_old - print*,' betav: ',norm_betav_old - print*,' betah: ',norm_betah_old - print*,' eta : ',norm_eta_old - print* + print *,'norm squared old gradient:' + print *,' bulk : ',norm_bulk_old + print *,' betav: ',norm_betav_old + print *,' betah: ',norm_betah_old + print *,' eta : ',norm_eta_old + print * ! checks lengths if (norm_bulk_old < 1.e-22 ) call exit_mpi(myrank,'norm old gradient bulk is zero') @@ -126,20 +126,20 @@ subroutine get_gradient_cg_tiso() ratio_eta = norm_eta_sum / norm_eta_old ! if ratio > 0.2 (empirical threshold value), then one should restart with a steepest descent - print*,'Powell ratio: (> 0.2 then restart with steepest descent)' - print*,' bulk : ',ratio_bulk - print*,' betav: ',ratio_betav - print*,' betah: ',ratio_betah - print*,' eta : ',ratio_eta - print* + print *,'Powell ratio: (> 0.2 then restart with steepest descent)' + print *,' bulk : ',ratio_bulk + print *,' betav: ',ratio_betav + print *,' betah: ',ratio_betah + print *,' eta : ',ratio_eta + print * if (ratio_bulk > 0.2 .and. ratio_betav > 0.2 .and. ratio_betah > 0.2 .and. ratio_eta > 0.2) then - print*,' critical ratio found!' - print* - print*,'****************' - print* - print*,' Please consider doing a steepest descent instead cg...' - print* - print*,'****************' + print *,' critical ratio found!' + print * + print *,'****************' + print * + print *,' Please consider doing a steepest descent instead cg...' + print * + print *,'****************' endif endif @@ -164,12 +164,12 @@ subroutine get_gradient_cg_tiso() norm_eta = norm_eta_sum if (myrank == 0) then - print*,'norm squared difference gradient:' - print*,' bulk : ',norm_bulk - print*,' betav: ',norm_betav - print*,' betah: ',norm_betah - print*,' eta : ',norm_eta - print* + print *,'norm squared difference gradient:' + print *,' bulk : ',norm_bulk + print *,' betav: ',norm_betav + print *,' betah: ',norm_betah + print *,' eta : ',norm_eta + print * endif ! calculates ratio based on Polak & Ribiere (1969) @@ -214,12 +214,12 @@ subroutine get_gradient_cg_tiso() alpha_eta = alpha_all endif ! user output - print*,'alpha gradient:' - print*,' bulk : ',alpha_bulk - print*,' betav: ',alpha_betav - print*,' betah: ',alpha_betah - print*,' eta : ',alpha_eta - print* + print *,'alpha gradient:' + print *,' bulk : ',alpha_bulk + print *,' betav: ',alpha_betav + print *,' betah: ',alpha_betah + print *,' eta : ',alpha_eta + print * endif ! broadcast values from rank 0 to all others call bcast_all_singlecr(alpha_bulk) @@ -357,12 +357,12 @@ subroutine get_gradient_cg_tiso() call max_all_cr(maxval(model_deta),max_eta) if (myrank == 0) then - print*,'initial gradient updates:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print *,'initial gradient updates:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif ! determines maximum kernel betav value within given radius @@ -390,11 +390,11 @@ subroutine get_gradient_cg_tiso() depthmax_depth = depthmax_radius(maxindex(1)) depthmax_depth = R_EARTH_KM *( 1.0 - depthmax_depth ) ! maximum in given depth range - print*,' using depth maximum: ' - print*,' between depths (top/bottom) : ',R_top,R_bottom - print*,' maximum kernel value : ',max - print*,' depth of maximum kernel value : ',depthmax_depth - print* + print *,' using depth maximum: ' + print *,' between depths (top/bottom) : ',R_top,R_bottom + print *,' maximum kernel value : ',max + print *,' depth of maximum kernel value : ',depthmax_depth + print * else ! maximum gradient values minmax(1) = abs(min_vsv) @@ -405,8 +405,8 @@ subroutine get_gradient_cg_tiso() ! maximum value of all kernel maxima max = maxval(minmax) endif - print*,'step length:' - print*,' using kernel maximum: ',max + print *,'step length:' + print *,' using kernel maximum: ',max ! checks maximum value if (max < 1.e-25) stop 'Error maximum kernel value too small for update' @@ -414,8 +414,8 @@ subroutine get_gradient_cg_tiso() ! chooses step length such that it becomes the desired, given step factor as inputted step_length = step_fac/max - print*,' step length : ',step_length - print* + print *,' step length : ',step_length + print * endif call bcast_all_singlecr(step_length) @@ -438,12 +438,12 @@ subroutine get_gradient_cg_tiso() norm_betah = sqrt(norm_betah_sum) norm_eta = sqrt(norm_eta_sum) - print*,'norm model updates:' - print*,' bulk : ',norm_bulk - print*,' betav: ',norm_betav - print*,' betah: ',norm_betah - print*,' eta : ',norm_eta - print* + print *,'norm model updates:' + print *,' bulk : ',norm_bulk + print *,' betav: ',norm_betav + print *,' betah: ',norm_betah + print *,' eta : ',norm_eta + print * endif ! multiply model updates by a subjective factor that will change the step @@ -466,12 +466,12 @@ subroutine get_gradient_cg_tiso() call max_all_cr(maxval(model_deta),max_eta) if (myrank == 0) then - print*,'scaled gradient:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print *,'scaled gradient:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif call synchronize_all() diff --git a/src/tomography/get_sd_direction.f90 b/src/tomography/get_sd_direction.f90 index 0aa126d4a..14e6a98c2 100644 --- a/src/tomography/get_sd_direction.f90 +++ b/src/tomography/get_sd_direction.f90 @@ -109,11 +109,11 @@ subroutine get_gradient_steepest_iso() call max_all_cr(maxval(model_drho),max_rho) if (myrank == 0) then - print*,'initial gradient:' - print*,' a min/max : ',min_bulk,max_bulk - print*,' beta min/max: ',min_beta,max_beta - print*,' rho min/max : ',min_rho,max_rho - print* + print *,'initial gradient:' + print *,' a min/max : ',min_bulk,max_bulk + print *,' beta min/max: ',min_beta,max_beta + print *,' rho min/max : ',min_rho,max_rho + print * endif ! statistics output @@ -137,11 +137,11 @@ subroutine get_gradient_steepest_iso() ! determines maximum kernel betav value within given radius if (USE_DEPTH_RANGE_MAXIMUM) then - print*,' using depth maximum: ' - print*,' between depths (top/bottom) : ',R_top,R_bottom - print*,' maximum kernel value : ',max - print*,' depth of maximum kernel value : ',depth_max - print* + print *,' using depth maximum: ' + print *,' between depths (top/bottom) : ',R_top,R_bottom + print *,' maximum kernel value : ',max + print *,' depth of maximum kernel value : ',depth_max + print * else ! maximum gradient values minmax(1) = abs(min_beta) @@ -152,8 +152,8 @@ subroutine get_gradient_steepest_iso() ! maximum value of all kernel maxima max = maxval(minmax) endif - print*,'step length:' - print*,' using kernel maximum: ',max + print *,'step length:' + print *,' using kernel maximum: ',max ! checks maximum value if (max < 1.e-25) stop 'Error maximum kernel value too small for update' @@ -161,8 +161,8 @@ subroutine get_gradient_steepest_iso() ! chooses step length such that it becomes the desired, given step factor as inputted step_length = step_fac/max - print*,' step length value : ',step_length - print* + print *,' step length value : ',step_length + print * endif call bcast_all_singlecr(step_length) @@ -181,11 +181,11 @@ subroutine get_gradient_steepest_iso() norm_beta = sqrt(norm_beta_sum) norm_rho = sqrt(norm_rho_sum) - print*,'norm model updates:' - print*,' a : ',norm_bulk - print*,' beta: ',norm_beta - print*,' rho : ',norm_rho - print* + print *,'norm model updates:' + print *,' a : ',norm_bulk + print *,' beta: ',norm_beta + print *,' rho : ',norm_rho + print * endif ! statistics output @@ -212,11 +212,11 @@ subroutine get_gradient_steepest_iso() call max_all_cr(maxval(model_drho),max_rho) if (myrank == 0) then - print*,'scaled gradient:' - print*,' a min/max : ',min_bulk,max_bulk - print*,' beta min/max: ',min_beta,max_beta - print*,' rho min/max : ',min_rho,max_rho - print* + print *,'scaled gradient:' + print *,' a min/max : ',min_bulk,max_bulk + print *,' beta min/max: ',min_beta,max_beta + print *,' rho min/max : ',min_rho,max_rho + print * endif call synchronize_all() @@ -325,12 +325,12 @@ subroutine get_gradient_steepest_tiso() call max_all_cr(maxval(model_deta),max_eta) if (myrank == 0) then - print*,'initial gradient:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print *,'initial gradient:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif ! determines maximum kernel betav value within given radius @@ -347,11 +347,11 @@ subroutine get_gradient_steepest_tiso() ! determines maximum kernel betav value within given radius if (USE_DEPTH_RANGE_MAXIMUM) then - print*,' using depth maximum: ' - print*,' between depths (top/bottom) : ',R_top,R_bottom - print*,' maximum kernel value : ',max - print*,' depth of maximum kernel value : ',depth_max - print* + print *,' using depth maximum: ' + print *,' between depths (top/bottom) : ',R_top,R_bottom + print *,' maximum kernel value : ',max + print *,' depth of maximum kernel value : ',depth_max + print * else ! maximum gradient values minmax(1) = abs(min_vsv) @@ -362,8 +362,8 @@ subroutine get_gradient_steepest_tiso() ! maximum value of all kernel maxima max = maxval(minmax) endif - print*,'step length:' - print*,' using kernel maximum: ',max + print *,'step length:' + print *,' using kernel maximum: ',max ! checks maximum value if (max < 1.e-25) stop 'Error maximum kernel value too small for update' @@ -371,8 +371,8 @@ subroutine get_gradient_steepest_tiso() ! chooses step length such that it becomes the desired, given step factor as inputted step_length = step_fac/max - print*,' step length value : ',step_length - print* + print *,' step length value : ',step_length + print * endif call bcast_all_singlecr(step_length) @@ -395,12 +395,12 @@ subroutine get_gradient_steepest_tiso() norm_betah = sqrt(norm_betah_sum) norm_eta = sqrt(norm_eta_sum) - print*,'norm model updates:' - print*,' bulk : ',norm_bulk - print*,' betav: ',norm_betav - print*,' betah: ',norm_betah - print*,' eta : ',norm_eta - print* + print *,'norm model updates:' + print *,' bulk : ',norm_bulk + print *,' betav: ',norm_betav + print *,' betah: ',norm_betah + print *,' eta : ',norm_eta + print * endif ! multiply model updates by a subjective factor that will change the step @@ -423,12 +423,12 @@ subroutine get_gradient_steepest_tiso() call max_all_cr(maxval(model_deta),max_eta) if (myrank == 0) then - print*,'scaled gradient:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print *,'scaled gradient:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif call synchronize_all() diff --git a/src/tomography/postprocess_sensitivity_kernels/addition_sem.f90 b/src/tomography/postprocess_sensitivity_kernels/addition_sem.f90 index 21395de35..f8deda5ee 100644 --- a/src/tomography/postprocess_sensitivity_kernels/addition_sem.f90 +++ b/src/tomography/postprocess_sensitivity_kernels/addition_sem.f90 @@ -69,10 +69,10 @@ program addition_sem ! checks compilation setup if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*, 'Error number of processors supposed to run on : ',NPROCTOT_VAL - print*, 'Error number of MPI processors actually run on: ',sizeprocs - print* - print*, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xaddition_sem .. ' + print *, 'Error number of processors supposed to run on : ',NPROCTOT_VAL + print *, 'Error number of MPI processors actually run on: ',sizeprocs + print * + print *, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xaddition_sem .. ' endif call exit_MPI(myrank,'Error wrong number of MPI processes') endif diff --git a/src/tomography/postprocess_sensitivity_kernels/convert_model_file_adios.f90 b/src/tomography/postprocess_sensitivity_kernels/convert_model_file_adios.f90 index 41fc35422..195a79147 100644 --- a/src/tomography/postprocess_sensitivity_kernels/convert_model_file_adios.f90 +++ b/src/tomography/postprocess_sensitivity_kernels/convert_model_file_adios.f90 @@ -144,7 +144,7 @@ program convert_model_file_adios ! checks arguments if (convert_format /= 1 .and. convert_format /= 2) then - print*,'Error: invalid format type',convert_format + print *,'Error: invalid format type',convert_format stop ' Reenter format type in command line options' endif diff --git a/src/tomography/postprocess_sensitivity_kernels/difference_sem.f90 b/src/tomography/postprocess_sensitivity_kernels/difference_sem.f90 index caaf2edd0..76dd40912 100644 --- a/src/tomography/postprocess_sensitivity_kernels/difference_sem.f90 +++ b/src/tomography/postprocess_sensitivity_kernels/difference_sem.f90 @@ -69,10 +69,10 @@ program difference_sem ! checks compilation setup if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*, 'Error number of processors supposed to run on : ',NPROCTOT_VAL - print*, 'Error number of MPI processors actually run on: ',sizeprocs - print* - print*, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xdifference_sem .. ' + print *, 'Error number of processors supposed to run on : ',NPROCTOT_VAL + print *, 'Error number of MPI processors actually run on: ',sizeprocs + print * + print *, 'please rerun with: mpirun -np ',NPROCTOT_VAL,' bin/xdifference_sem .. ' endif call exit_MPI(myrank,'Error wrong number of MPI processes') endif diff --git a/src/tomography/postprocess_sensitivity_kernels/interpolate_model.F90 b/src/tomography/postprocess_sensitivity_kernels/interpolate_model.F90 index 5b8540282..32eddf650 100644 --- a/src/tomography/postprocess_sensitivity_kernels/interpolate_model.F90 +++ b/src/tomography/postprocess_sensitivity_kernels/interpolate_model.F90 @@ -246,7 +246,7 @@ program interpolate_model if (i == 5 .and. len_trim(arg) > 0) then read(arg(1:len_trim(arg)),*,iostat=ier) want_midpoint if (ier /= 0) then - if (myrank == 0) print*,'Error reading in midpoint-search value, please check your arguments...' + if (myrank == 0) print *,'Error reading in midpoint-search value, please check your arguments...' stop ' Reenter command line options' endif endif @@ -267,9 +267,9 @@ program interpolate_model ! console output if (myrank == 0) then - print* - print*,'model interpolation:' - print* + print * + print *,'model interpolation:' + print * endif #ifdef ADIOS_INPUT @@ -316,7 +316,7 @@ program interpolate_model write(solver_file,'(a,i6.6,a)') trim(dir_topo1)//'proc',myrank,'_reg1_'//'solver_data.bin' open(IIN,file=trim(solver_file),status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(solver_file) + print *,'Error opening file: ',trim(solver_file) stop 'Error opening old solver_data.bin file, please check arguments...' endif read(IIN) nspec_max_old @@ -348,61 +348,61 @@ program interpolate_model ! console output if (myrank == 0) then - print*,'source mesh: ' - print*,' processors = ',nproc_eta_old * nproc_xi_old * NCHUNKS_VAL - print*,' nproc_eta / nproc_xi = ',nproc_eta_old,nproc_xi_old - print*,' nspec = ',nspec_max_old - print*,' nglob = ',nglob_max_old - print* - print*,'target mesh: ' - print*,' processors = ',NPROCTOT_VAL - print*,' nproc_eta / nproc_xi = ',NPROC_ETA_VAL,NPROC_XI_VAL - print*,' nex = ',NEX_XI_VAL - print*,' nspec = ',NSPEC_CRUST_MANTLE - print*,' nglob = ',NGLOB_CRUST_MANTLE - print* + print *,'source mesh: ' + print *,' processors = ',nproc_eta_old * nproc_xi_old * NCHUNKS_VAL + print *,' nproc_eta / nproc_xi = ',nproc_eta_old,nproc_xi_old + print *,' nspec = ',nspec_max_old + print *,' nglob = ',nglob_max_old + print * + print *,'target mesh: ' + print *,' processors = ',NPROCTOT_VAL + print *,' nproc_eta / nproc_xi = ',NPROC_ETA_VAL,NPROC_XI_VAL + print *,' nex = ',NEX_XI_VAL + print *,' nspec = ',NSPEC_CRUST_MANTLE + print *,' nglob = ',NGLOB_CRUST_MANTLE + print * if (USE_TRANSVERSE_ISOTROPY) then - print*,'model parameters:',nparams,' - transversely isotropic model' + print *,'model parameters:',nparams,' - transversely isotropic model' else - print*,'model parameters:',nparams,' - isotropic model' + print *,'model parameters:',nparams,' - isotropic model' endif if (USE_ATTENUATION_Q) then - print*,' includes qmu model parameter' + print *,' includes qmu model parameter' endif - print*,' ( ',(trim(fname(i))//" ",i=1,nparams),')' - print* - print*,'input model directory: ',trim(input_model_dir) - print*,'output model directory: ',trim(output_model_dir) - print* - print*,'array size:' - print*,' ibool1 = ',NGLLX*NGLLY*NGLLZ*nspec_max_old*nproc_eta_old*nproc_xi_old*dble(SIZE_INTEGER)/1024./1024.,'MB' - print*,' x1,y1,z1 = ',nglob_max_old*nproc_eta_old*nproc_xi_old*dble(CUSTOM_REAL)/1024./1024.,'MB' - print* - print*,' model1 = ',NGLLX*NGLLY*NGLLZ*nspec_max_old*nparams*nproc_eta_old*nproc_xi_old*dble(CUSTOM_REAL)/1024./1024.,'MB' - print*,' model2 = ',NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE*nparams*dble(CUSTOM_REAL)/1024./1024.,'MB' - print* - print*,'total mpi processes: ',sizeprocs - print* + print *,' ( ',(trim(fname(i))//" ",i=1,nparams),')' + print * + print *,'input model directory: ',trim(input_model_dir) + print *,'output model directory: ',trim(output_model_dir) + print * + print *,'array size:' + print *,' ibool1 = ',NGLLX*NGLLY*NGLLZ*nspec_max_old*nproc_eta_old*nproc_xi_old*dble(SIZE_INTEGER)/1024./1024.,'MB' + print *,' x1,y1,z1 = ',nglob_max_old*nproc_eta_old*nproc_xi_old*dble(CUSTOM_REAL)/1024./1024.,'MB' + print * + print *,' model1 = ',NGLLX*NGLLY*NGLLZ*nspec_max_old*nparams*nproc_eta_old*nproc_xi_old*dble(CUSTOM_REAL)/1024./1024.,'MB' + print *,' model2 = ',NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE*nparams*dble(CUSTOM_REAL)/1024./1024.,'MB' + print * + print *,'total mpi processes: ',sizeprocs + print * if (DO_BRUTE_FORCE_SEARCH) then - print*,'location search by : brute-force approach' + print *,'location search by : brute-force approach' else - print*,'location search by : kd-tree search' + print *,'location search by : kd-tree search' if (USE_MIDPOINT_SEARCH) then - print*,'location search by : uses midpoints of elements only' + print *,'location search by : uses midpoints of elements only' else - print*,' uses internal gll points' + print *,' uses internal gll points' endif if (DO_SEPARATION_410_650) then - print*,' uses element separation for 410-km/650-km discontinuity' + print *,' uses element separation for 410-km/650-km discontinuity' endif if (DO_SEPARATION_TOPO) then - print*,' uses element separation for surface (moho) discontinuity' + print *,' uses element separation for surface (moho) discontinuity' endif if (USE_FALLBACK) then - print*,' uses fall-back to model value of closest point in case of large differences' + print *,' uses fall-back to model value of closest point in case of large differences' endif endif - print* + print * endif call synchronize_all() @@ -414,7 +414,7 @@ program interpolate_model write(m_file,'(a,i6.6,a)') trim(output_model_dir)// '/proc',myrank,'_reg1_'//trim(fname(1))//'.tmp' open(IOUT,file=trim(m_file),status='unknown',form='unformatted',action='write',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(m_file) + print *,'Error opening file: ',trim(m_file) stop 'Error opening new output model file, please check if output directory exists...' endif close(IOUT,status='delete') @@ -505,12 +505,12 @@ program interpolate_model enddo if (ichunk_selected < 1 .or. ichunk_selected > NCHUNKS_VAL ) stop 'Error selecting ichunk' ! debug - !print*, 'selected chunk: ',ichunk_selected,' - eta/xi : ',iproc_eta_selected,iproc_xi_selected + !print *, 'selected chunk: ',ichunk_selected,' - eta/xi : ',iproc_eta_selected,iproc_xi_selected ! user output if (myrank == 0) then - print* - print*, 'loading source mesh ... ' + print * + print *, 'loading source mesh ... ' endif ! reads in model and locations of old, source mesh @@ -531,14 +531,14 @@ program interpolate_model ! user output if (myrank == 0) then - print*,' slice number: ',iprocnum,' out of ',nproc_chunk1 + print *,' slice number: ',iprocnum,' out of ',nproc_chunk1 endif ! old, source mesh locations write(solver_file,'(a,i6.6,a)') trim(dir_topo1)//'proc',rank,'_reg1_'//'solver_data.bin' open(IIN,file=solver_file,status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(solver_file) + print *,'Error opening file: ',trim(solver_file) stop 'Error opening old solver_data.bin file' endif read(IIN) nspec @@ -546,7 +546,7 @@ program interpolate_model ! checks dimensions if (nspec /= nspec_max_old .or. nglob /= nglob_max_old) then - print*,'Error dimension of old, source mesh: solver_data nspec/nglob = ',nspec,nglob + print *,'Error dimension of old, source mesh: solver_data nspec/nglob = ',nspec,nglob stop 'Error new mesh dimensions' endif @@ -560,19 +560,19 @@ program interpolate_model enddo ! user output if (myrank == 0) then - print* - print*,' source mesh chunk read successfully' - print* + print * + print *,' source mesh chunk read successfully' + print * endif call synchronize_all() ! user output if (myrank == 0) then - print*, 'loading source model ... ' + print *, 'loading source model ... ' do iker = 1,nparams - print*, ' for parameter: ',trim(fname(iker)) + print *, ' for parameter: ',trim(fname(iker)) enddo - print* + print * endif ! reads in old model files @@ -588,7 +588,7 @@ program interpolate_model ! user output if (myrank == 0) then - print*,' slice number: ',iprocnum,' out of ',nproc_chunk1 + print *,' slice number: ',iprocnum,' out of ',nproc_chunk1 endif ! reads in model slices @@ -599,7 +599,7 @@ program interpolate_model write(m_file,'(a,i6.6,a)') trim(input_model_dir)//'proc',rank,'_reg1_'//trim(fname(iker))//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(m_file) + print *,'Error opening file: ',trim(m_file) stop 'Error opening old model file' endif read(IIN) model1(:,:,:,:,iker,iprocnum-1) @@ -609,9 +609,9 @@ program interpolate_model enddo ! user output if (myrank == 0) then - print* - print*,' source model chunk read successfully' - print* + print * + print *,' source model chunk read successfully' + print * endif call synchronize_all() @@ -624,16 +624,16 @@ program interpolate_model ! user output if (myrank == 0) then - print* - print*,'reading new mesh slice ... ' - print* + print * + print *,'reading new mesh slice ... ' + print * endif ! checks new mesh locations write(solver_file,'(a,i6.6,a)') trim(dir_topo2)//'proc',rank,'_reg1_'//'solver_data.bin' open(IIN,file=solver_file,status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(solver_file) + print *,'Error opening file: ',trim(solver_file) stop 'Error opening new solver_data.bin file' endif read(IIN) nspec @@ -641,7 +641,7 @@ program interpolate_model ! checks dimensions if (nspec /= NSPEC_CRUST_MANTLE .or. nglob /= NGLOB_CRUST_MANTLE) then - print*,'Error dimension of new mesh: solver_data nspec/nglob = ',nspec,nglob + print *,'Error dimension of new mesh: solver_data nspec/nglob = ',nspec,nglob stop 'Error new mesh dimensions' endif @@ -655,17 +655,17 @@ program interpolate_model ! checks that layers match if (minval(idoubling1) /= minval(idoubling2) .or. maxval(idoubling1) /= maxval(idoubling2)) then - print*,'Error idoubling range:' - print*,'idoubling 1:',minval(idoubling1),maxval(idoubling1) - print*,'idoubling 2:',minval(idoubling2),maxval(idoubling2) + print *,'Error idoubling range:' + print *,'idoubling 1:',minval(idoubling1),maxval(idoubling1) + print *,'idoubling 2:',minval(idoubling2),maxval(idoubling2) stop 'Error invalid idoubling range' endif call synchronize_all() ! user output if (myrank == 0) then - print*,'Earth layers: ',minval(idoubling2),' to ',maxval(idoubling2) - print* + print *,'Earth layers: ',minval(idoubling2),' to ',maxval(idoubling2) + print * endif ! get values in elements for this new slice @@ -677,18 +677,18 @@ program interpolate_model ! user output if (myrank == 0) then - print*,'layer: ',ilayer,' out of ',maxval(idoubling2) + print *,'layer: ',ilayer,' out of ',maxval(idoubling2) select case (ilayer) case (IFLAG_CRUST) - print*,'layer: crust' + print *,'layer: crust' case (IFLAG_80_MOHO) - print*,'layer: 80 - MOHO' + print *,'layer: 80 - MOHO' case (IFLAG_220_80) - print*,'layer: 220 - 80' + print *,'layer: 220 - 80' case (IFLAG_670_220) - print*,'layer: 670 - 220' + print *,'layer: 670 - 220' case (IFLAG_MANTLE_NORMAL) - print*,'layer: mantle normal' + print *,'layer: mantle normal' end select endif @@ -731,7 +731,7 @@ program interpolate_model kdtree_num_nodes = inodes ! debug - !print*,'kdtree nodes: ',kdtree_num_nodes + !print *,'kdtree nodes: ',kdtree_num_nodes ! allocates tree arrays allocate(kdtree_nodes_location(3,kdtree_num_nodes),stat=ier) @@ -812,7 +812,7 @@ program interpolate_model ! serial way !do i = 0,NPROCTOT_VAL-1 ! if (myrank == i) then - ! print*,'kd-tree setup for process: ',myrank + ! print *,'kd-tree setup for process: ',myrank ! call kdtree_setup() ! endif ! call synchronize_all() @@ -824,7 +824,7 @@ program interpolate_model call synchronize_all() ! user output - if (myrank == 0) print*,'looping over elements:' + if (myrank == 0) print *,'looping over elements:' call synchronize_all() ! loop over all elements (mainly those in this layer) @@ -832,7 +832,7 @@ program interpolate_model ! user output if (myrank == 0) then if (ispec == 1 .or. mod(ispec,int(0.1*nspec)) == 0 .or. ispec == nspec) then - print*,' ispec',ispec,' out of ',nspec + print *,' ispec',ispec,' out of ',nspec endif endif @@ -856,7 +856,7 @@ program interpolate_model USE_MIDPOINT_SEARCH,DO_SEPARATION_410_650,DO_SEPARATION_TOPO,USE_FALLBACK) endif enddo ! ispec - if (myrank == 0) print* + if (myrank == 0) print * call synchronize_all() ! frees tree memory @@ -870,14 +870,14 @@ program interpolate_model ! statistics ! user output - if (myrank == 0) print*,'statistics:' + if (myrank == 0) print *,'statistics:' do iker = 1,nparams call max_all_cr(model_maxdiff(iker),val) - if (myrank == 0) print*,' parameter ',trim(fname(iker)),': maximum difference = ',val + if (myrank == 0) print *,' parameter ',trim(fname(iker)),': maximum difference = ',val enddo ! user output - if (myrank == 0) print* + if (myrank == 0) print * call synchronize_all() enddo ! ilayer @@ -906,7 +906,7 @@ program interpolate_model write(m_file,'(a,i6.6,a)') trim(output_model_dir) // '/proc',rank,'_reg1_'//trim(fname(iker))//'.bin' open(IOUT,file=trim(m_file),status='unknown',form='unformatted',action='write',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(m_file) + print *,'Error opening file: ',trim(m_file) stop 'Error opening output model file' endif write(IOUT) model2(:,:,:,:,iker) @@ -990,7 +990,7 @@ subroutine get_model_values_bruteforce(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams ! checks given ispec if (ispec < 1 .or. ispec > nspec) then - print*,'Error: rank ',myrank,' has invalid ispec' + print *,'Error: rank ',myrank,' has invalid ispec' stop 'Error invalid ispec in get_model_values_bruteforce() routine' endif @@ -1129,7 +1129,7 @@ subroutine get_model_values_kdtree(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams,mod ! checks given ispec if (ispec < 1 .or. ispec > nspec) then - print*,'Error: rank ',myrank,' has invalid ispec' + print *,'Error: rank ',myrank,' has invalid ispec' stop 'Error invalid ispec in get_model_values_kdtree() routine' endif @@ -1159,7 +1159,7 @@ subroutine get_model_values_kdtree(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams,mod ! debug !if (myrank == 0 .and. iglob < 100) & - ! print*,'dist_min kdtree midpoint: ',dist_min * R_EARTH_KM,'(km)',typical_size * R_EARTH_KM + ! print *,'dist_min kdtree midpoint: ',dist_min * R_EARTH_KM,'(km)',typical_size * R_EARTH_KM ! special case for 410-km/650-km discontinuity if (DO_SEPARATION_410_650) then @@ -1209,7 +1209,7 @@ subroutine get_model_values_kdtree(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams,mod iglob = ibool2(1,1,1,ispec) elem_height = r - sqrt(x2(iglob)*x2(iglob) + y2(iglob)*y2(iglob) + z2(iglob)*z2(iglob)) ! debug - !if (myrank == 0) print*,'element height: ',elem_height * R_EARTH_KM,'(km)','radius: ',mid_radius*R_EARTH_KM + !if (myrank == 0) print *,'element height: ',elem_height * R_EARTH_KM,'(km)','radius: ',mid_radius*R_EARTH_KM endif endif @@ -1304,7 +1304,7 @@ subroutine get_model_values_kdtree(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams,mod ! debug !if (myrank == 0 .and. iglob < 100) & - ! print*,'dist_min kdtree: ',dist_min * R_EARTH_KM,'(km)',typical_size * R_EARTH_KM + ! print *,'dist_min kdtree: ',dist_min * R_EARTH_KM,'(km)',typical_size * R_EARTH_KM ! restores original target point location for locating/interpolating iglob = ibool2(i,j,k,ispec) @@ -1331,19 +1331,19 @@ subroutine get_model_values_kdtree(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams,mod ! checks distance dist_min = sqrt((x_found-x_target)**2 + (y_found-y_target)**2 + (z_found-z_target)**2) if (dist_min > 2 * typical_size) then - print*,'Warning: rank ',myrank,' - large dist_min: ',dist_min * R_EARTH_KM,'(km)', & + print *,'Warning: rank ',myrank,' - large dist_min: ',dist_min * R_EARTH_KM,'(km)', & 'element size:',typical_size * R_EARTH_KM - print*,'target location:',xyz_target(:) - print*,'target radius :',sqrt(xyz_target(1)**2 + xyz_target(2)**2 + xyz_target(3)**2) * R_EARTH_KM,'(km)' - print*,'gll location :',x_found,y_found,z_found - print*,'gll radius :',sqrt(x_found**2 + y_found**2 + z_found**2) * R_EARTH_KM,'(km)' - print*,'distance gll:',dist_min * R_EARTH_KM,'(km)' + print *,'target location:',xyz_target(:) + print *,'target radius :',sqrt(xyz_target(1)**2 + xyz_target(2)**2 + xyz_target(3)**2) * R_EARTH_KM,'(km)' + print *,'gll location :',x_found,y_found,z_found + print *,'gll radius :',sqrt(x_found**2 + y_found**2 + z_found**2) * R_EARTH_KM,'(km)' + print *,'distance gll:',dist_min * R_EARTH_KM,'(km)' ! debug !stop 'Error gll model value invalid' endif ! debug !if (myrank == 0 .and. iglob < 100) & - ! print*,'dist_min gll point: ',dist_min * R_EARTH_KM,'(km)',typical_size * R_EARTH_KM + ! print *,'dist_min gll point: ',dist_min * R_EARTH_KM,'(km)',typical_size * R_EARTH_KM ! interpolate model values do iker = 1,nparams @@ -1374,24 +1374,24 @@ subroutine get_model_values_kdtree(ispec,nspec,nglob,ibool2,x2,y2,z2,nparams,mod if (DO_WARNING) then ! note: warns for top elements, probably due to crustal structure if (abs(val - val_initial ) > abs( 0.2 * val_initial )) then - print*,'Warning: model ',iker,' value:',val,'is very different from initial value ',val_initial - print*,' rank ',myrank,' - dist_min: ',dist_min * R_EARTH_KM,'(km)' - print*,' element',ispec,'selected ispec:',ispec_selected,'in rank:',rank_selected,'iglob_min:',iglob_min - print*,' typical element size:',typical_size * 0.5 * R_EARTH_KM - print*,' interpolation i,j,k :',i_selected,j_selected,k_selected - print*,' interpolation :',xi,eta,gamma - print*,' target location:',xyz_target(:) - print*,' target radius :',sqrt(xyz_target(1)**2 + xyz_target(2)**2 + xyz_target(3)**2) * R_EARTH_KM,'(km)' - print*,' gll location :',x_found,y_found,z_found - print*,' gll radius :',sqrt(x_found**2 + y_found**2 + z_found**2) * R_EARTH_KM,'(km)' - print*,' distance gll:',dist_min * R_EARTH_KM,'(km)' + print *,'Warning: model ',iker,' value:',val,'is very different from initial value ',val_initial + print *,' rank ',myrank,' - dist_min: ',dist_min * R_EARTH_KM,'(km)' + print *,' element',ispec,'selected ispec:',ispec_selected,'in rank:',rank_selected,'iglob_min:',iglob_min + print *,' typical element size:',typical_size * 0.5 * R_EARTH_KM + print *,' interpolation i,j,k :',i_selected,j_selected,k_selected + print *,' interpolation :',xi,eta,gamma + print *,' target location:',xyz_target(:) + print *,' target radius :',sqrt(xyz_target(1)**2 + xyz_target(2)**2 + xyz_target(3)**2) * R_EARTH_KM,'(km)' + print *,' gll location :',x_found,y_found,z_found + print *,' gll radius :',sqrt(x_found**2 + y_found**2 + z_found**2) * R_EARTH_KM,'(km)' + print *,' distance gll:',dist_min * R_EARTH_KM,'(km)' !stop 'Error model value invalid' endif endif ! debug !if (myrank == 0 .and. iglob < 100) & - ! print*,'new model ',iker,': value ',val,'initial ',val_initial,'diff ',(val - val_initial)/val_initial*100.0,'(%)' + ! print *,'new model ',iker,': value ',val,'initial ',val_initial,'diff ',(val - val_initial)/val_initial*100.0,'(%)' enddo @@ -1407,37 +1407,37 @@ subroutine check_point_result() ! checks valid iglob if (iglob_min < 1 .or. iglob_min > nspec_max_old * nproc_chunk1) then - print*,'Error iglob_min :',iglob_min - print*,'nspec / nproc :',nspec_max_old,nproc_chunk1 + print *,'Error iglob_min :',iglob_min + print *,'nspec / nproc :',nspec_max_old,nproc_chunk1 stop 'Error invalid iglob_min index' endif ! checks valid rank if (rank_selected < 0 .or. rank_selected >= nproc_chunk1) then - print*,'Error rank:',myrank,'invalid selected rank ',rank_selected,'for element',ispec - print*,'target location:',xyz_target(:) + print *,'Error rank:',myrank,'invalid selected rank ',rank_selected,'for element',ispec + print *,'target location:',xyz_target(:) stop 'Error specifying closest rank for element' endif ! checks valid ispec if (ispec_selected < 1 .or. ispec_selected > nspec_max_old) then - print*,'Error rank:',myrank,'invalid selected ispec ',ispec_selected,'for element',ispec - print*,'rank_selected:',rank_selected,'iglob_min:',iglob_min,'nspec_max_old:',nspec_max_old - print*,'target location:',xyz_target(:) - print*,'dist_min: ',dist_min * R_EARTH_KM,'(km)' + print *,'Error rank:',myrank,'invalid selected ispec ',ispec_selected,'for element',ispec + print *,'rank_selected:',rank_selected,'iglob_min:',iglob_min,'nspec_max_old:',nspec_max_old + print *,'target location:',xyz_target(:) + print *,'dist_min: ',dist_min * R_EARTH_KM,'(km)' stop 'Error specifying closest ispec element' endif ! checks minimum distance within a typical element size if (dist_min > 2 * typical_size) then - print*,'Warning: rank ',myrank,' - large dist_min: ',dist_min * R_EARTH_KM,'(km)', & + print *,'Warning: rank ',myrank,' - large dist_min: ',dist_min * R_EARTH_KM,'(km)', & 'element size:',typical_size * R_EARTH_KM - print*,'element',ispec,'selected ispec:',ispec_selected,'in rank:',rank_selected,'iglob_min:',iglob_min - print*,'typical element size:',typical_size * 0.5 * R_EARTH_KM - print*,'target location:',xyz_target(:) - print*,'target radius :',sqrt(xyz_target(1)**2 + xyz_target(2)**2 + xyz_target(3)**2) * R_EARTH_KM,'(km)' - print*,'found location :',kdtree_nodes_location(:,iglob_min) - print*,'found radius :',sqrt(kdtree_nodes_location(1,iglob_min)**2 & + print *,'element',ispec,'selected ispec:',ispec_selected,'in rank:',rank_selected,'iglob_min:',iglob_min + print *,'typical element size:',typical_size * 0.5 * R_EARTH_KM + print *,'target location:',xyz_target(:) + print *,'target radius :',sqrt(xyz_target(1)**2 + xyz_target(2)**2 + xyz_target(3)**2) * R_EARTH_KM,'(km)' + print *,'found location :',kdtree_nodes_location(:,iglob_min) + print *,'found radius :',sqrt(kdtree_nodes_location(1,iglob_min)**2 & + kdtree_nodes_location(2,iglob_min)**2 & + kdtree_nodes_location(3,iglob_min)**2 ) * R_EARTH_KM,'(km)' !debug @@ -1670,7 +1670,7 @@ subroutine locate_single(x_target,y_target,z_target, & distmin = sqrt(distmin) * R_EARTH_KM ! debug - !print*,'distmin = ',sngl(distmin),'(km)' + !print *,'distmin = ',sngl(distmin),'(km)' ! find the best (xi,eta) ! use initial guess in xi, eta and gamma from closest point found @@ -1733,11 +1733,11 @@ subroutine locate_single(x_target,y_target,z_target, & ! if (ier /= 0) then ! ! debug ! if (.true.) then -! print*,'jacobian error in locate_single(): ' -! print*,'jacobian error i,j,k,ispec :',ix_initial_guess,iy_initial_guess,iz_initial_guess,ispec_selected -! print*,'jacobian error iter_loop :',iter_loop +! print *,'jacobian error in locate_single(): ' +! print *,'jacobian error i,j,k,ispec :',ix_initial_guess,iy_initial_guess,iz_initial_guess,ispec_selected +! print *,'jacobian error iter_loop :',iter_loop ! dist = sqrt((x_target-x)**2+(y_target-y)**2+(z_target-z)**2) * R_EARTH_KM -! print*,'jacobian error dist :',dist,'(km)',distmin +! print *,'jacobian error dist :',dist,'(km)',distmin ! endif ! ! ! uses initial guess again @@ -1811,7 +1811,7 @@ subroutine locate_single(x_target,y_target,z_target, & ! debug !if (final_distance > 5.0 ) & - ! print*,'final distance = ',sngl(final_distance),'(km)',distmin,xi,eta,gamma + ! print *,'final distance = ',sngl(final_distance),'(km)',distmin,xi,eta,gamma ! checks if location improved if (distmin <= final_distance) then @@ -1828,14 +1828,14 @@ subroutine locate_single(x_target,y_target,z_target, & ! (usually means receiver outside the mesh given by the user) if (DO_WARNING) then if (final_distance > typical_size * R_EARTH_KM) then - print*, '*****************************************************************' - print*, '***** WARNING: location estimate is poor *****' - print*, '*****************************************************************' - print*, 'closest estimate found: ',sngl(final_distance),'km away',' - not within:',typical_size * R_EARTH_KM - print*, ' in rank ',rank_selected,' in element ',ispec_selected,ix_initial_guess,iy_initial_guess,iz_initial_guess - print*, ' at xi,eta,gamma coordinates = ',xi,eta,gamma - print*, ' at radius ',sqrt(x**2 + y**2 + z**2) * R_EARTH_KM,'(km)' - print*, ' initial distance :',distmin,'(km)' + print *, '*****************************************************************' + print *, '***** WARNING: location estimate is poor *****' + print *, '*****************************************************************' + print *, 'closest estimate found: ',sngl(final_distance),'km away',' - not within:',typical_size * R_EARTH_KM + print *, ' in rank ',rank_selected,' in element ',ispec_selected,ix_initial_guess,iy_initial_guess,iz_initial_guess + print *, ' at xi,eta,gamma coordinates = ',xi,eta,gamma + print *, ' at radius ',sqrt(x**2 + y**2 + z**2) * R_EARTH_KM,'(km)' + print *, ' initial distance :',distmin,'(km)' endif endif diff --git a/src/tomography/postprocess_sensitivity_kernels/smooth_sem.F90 b/src/tomography/postprocess_sensitivity_kernels/smooth_sem.F90 index 15388179f..6b8654a96 100644 --- a/src/tomography/postprocess_sensitivity_kernels/smooth_sem.F90 +++ b/src/tomography/postprocess_sensitivity_kernels/smooth_sem.F90 @@ -274,21 +274,21 @@ program smooth_sem_globe ! user output if (myrank == 0) then - print*,"defaults:" - print*," NPROC_XI , NPROC_ETA : ",NPROC_XI,NPROC_ETA - print*," NCHUNKS : ",NCHUNKS - print*," element size on surface (km): ",element_size - print* - print*," smoothing sigma_h , sigma_v (km) : ",sigma_h,sigma_v + print *,"defaults:" + print *," NPROC_XI , NPROC_ETA : ",NPROC_XI,NPROC_ETA + print *," NCHUNKS : ",NCHUNKS + print *," element size on surface (km): ",element_size + print * + print *," smoothing sigma_h , sigma_v (km) : ",sigma_h,sigma_v ! scalelength: approximately S ~ sigma * sqrt(8.0) for a gaussian smoothing - print*," smoothing scalelengths horizontal, vertical (km): ",sigma_h*sqrt(8.0),sigma_v*sqrt(8.0) - print* - print*," data name : ",trim(kernel_name) - print*," input dir : ",trim(input_dir) - print*," output dir : ",trim(output_dir) - print* - print*,"number of elements per slice: ",NSPEC_AB - print* + print *," smoothing scalelengths horizontal, vertical (km): ",sigma_h*sqrt(8.0),sigma_v*sqrt(8.0) + print * + print *," data name : ",trim(kernel_name) + print *," input dir : ",trim(input_dir) + print *," output dir : ",trim(output_dir) + print * + print *,"number of elements per slice: ",NSPEC_AB + print * endif ! synchronizes call synchronize_all() @@ -379,7 +379,7 @@ program smooth_sem_globe write(prname_lp,'(a,i6.6,a)') trim(topo_dir)//'/proc',myrank,trim(reg_name)//'solver_data.bin' open(IIN,file=trim(prname_lp),status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(prname_lp) + print *,'Error opening file: ',trim(prname_lp) call exit_mpi(myrank,'Error opening solver_data.bin file') endif @@ -454,14 +454,14 @@ program smooth_sem_globe ! search by kd-tree ! user output if (myrank == 0) then - print*,'using kd-tree search:' + print *,'using kd-tree search:' if (DO_SEARCH_ELLIP) then - print*,' search radius horizontal: ',r_search_dist_h * R_EARTH_KM,'km' - print*,' search radius vertical : ',r_search_dist_v * R_EARTH_KM,'km' + print *,' search radius horizontal: ',r_search_dist_h * R_EARTH_KM,'km' + print *,' search radius vertical : ',r_search_dist_v * R_EARTH_KM,'km' else - print*,' search sphere radius: ',r_search * R_EARTH_KM,'km' + print *,' search sphere radius: ',r_search * R_EARTH_KM,'km' endif - print* + print * endif ! set number of tree nodes @@ -483,17 +483,17 @@ program smooth_sem_globe ! brute-force search ! user output if (myrank == 0) then - print*,'using brute-force search:' - print*,' search radius horizontal: ',sigma_h3 * R_EARTH_KM,'km' - print*,' search radius vertical : ',sigma_v3 * R_EARTH_KM,'km' - print* + print *,'using brute-force search:' + print *,' search radius horizontal: ',sigma_h3 * R_EARTH_KM,'km' + print *,' search radius vertical : ',sigma_v3 * R_EARTH_KM,'km' + print * endif endif ! synchronizes call synchronize_all() - if (myrank == 0) print*, 'start looping over elements and points for smoothing ...' + if (myrank == 0) print *, 'start looping over elements and points for smoothing ...' ! synchronizes call synchronize_all() @@ -510,7 +510,7 @@ program smooth_sem_globe iproc = islice(inum) - if (myrank == 0) print*,' reading slice:',iproc + if (myrank == 0) print *,' reading slice:',iproc ! debugging if (DEBUG .and. myrank == 0) then @@ -538,7 +538,7 @@ program smooth_sem_globe ! given in cartesian coordinates open(IIN,file=trim(prname_lp),status='old',action='read',form='unformatted',iostat=ier) if (ier /= 0) then - print*,'Error could not open database file: ',trim(prname_lp) + print *,'Error could not open database file: ',trim(prname_lp) call exit_mpi(myrank,'Error opening slices in solver_data.bin file') endif @@ -600,7 +600,7 @@ program smooth_sem_globe endif ! user output - if (myrank == 0) print*,' reading data file:',iproc,trim(kernel_name) + if (myrank == 0) print *,' reading data file:',iproc,trim(kernel_name) ! data file write(local_data_file,'(a,i6.6,a)') & @@ -621,7 +621,7 @@ program smooth_sem_globe min_old = minval(kernel) max_old = maxval(kernel) endif - if (myrank == 0) print* + if (myrank == 0) print * ! search setup if (.not. DO_BRUTE_FORCE_SEARCH) then @@ -653,11 +653,11 @@ program smooth_sem_globe if (myrank == 0) then tCPU = wtime() - time_start if (mod(ispec-1,NSPEC_AB/NSTEP_PERCENT_INFO) == 0 .and. ispec < (NSPEC_AB - 0.5*NSPEC_AB/NSTEP_PERCENT_INFO)) then - print*,' ',int((ispec-1) / (NSPEC_AB/NSTEP_PERCENT_INFO)) * (100.0 / NSTEP_PERCENT_INFO), & + print *,' ',int((ispec-1) / (NSPEC_AB/NSTEP_PERCENT_INFO)) * (100.0 / NSTEP_PERCENT_INFO), & ' % elements done - Elapsed time in seconds = ',tCPU endif if (ispec == NSPEC_AB) then - print*,' ',100.0,' % elements done - Elapsed time in seconds = ',tCPU + print *,' ',100.0,' % elements done - Elapsed time in seconds = ',tCPU endif endif @@ -711,7 +711,7 @@ program smooth_sem_globe if (DEBUG .and. myrank == 0) then ! user info if (ispec < 10) then - print*,' total number of search elements: ',num_elem_local,'ispec',ispec + print *,' total number of search elements: ',num_elem_local,'ispec',ispec endif ! file output if (ispec == tmp_ispec_dbg) then @@ -726,7 +726,7 @@ program smooth_sem_globe write(filename,'(a,i4.4,a,i6.6)') trim(output_dir)//'/search_elem',tmp_ispec_dbg,'_proc',iproc call write_VTK_data_elem_i(NSPEC_AB,NGLOB_AB,xstore,ystore,zstore, & ibool,ispec_flag,filename) - print*,'file written: ',trim(filename)//'.vtk' + print *,'file written: ',trim(filename)//'.vtk' deallocate(ispec_flag) endif endif @@ -787,9 +787,9 @@ program smooth_sem_globe if (i == 2 .and. j == 3 .and. k == 4) then #endif tmp_bk(:,:,:,ispec2) = exp_val(:,:,:) - print*,'debug',myrank,'ispec',ispec,'ispec2',ispec2,'dist:',dist_h,dist_v - print*,'debug exp',minval(exp_val),maxval(exp_val) - print*,'debug kernel',minval(kernel(:,:,:,ispec2)),maxval(kernel(:,:,:,ispec2)) + print *,'debug',myrank,'ispec',ispec,'ispec2',ispec2,'dist:',dist_h,dist_v + print *,'debug exp',minval(exp_val),maxval(exp_val) + print *,'debug kernel',minval(kernel(:,:,:,ispec2)),maxval(kernel(:,:,:,ispec2)) endif endif endif @@ -805,12 +805,12 @@ program smooth_sem_globe ! checks number !if (isNaN(tk(INDEX_IJK,ispec))) then - ! print*,'Error tk NaN: ',tk(INDEX_IJK,ispec) - ! print*,'rank:',myrank - ! print*,'INDEX_IJK,ispec:',INDEX_IJK,ispec - ! print*,'tk: ',tk(INDEX_IJK,ispec),'bk:',bk(INDEX_IJK,ispec) - ! print*,'sum exp_val: ',sum(exp_val(:,:,:)),'sum factor:',sum(factor(:,:,:)) - ! print*,'sum kernel:',sum(kernel(:,:,:,ispec2)) + ! print *,'Error tk NaN: ',tk(INDEX_IJK,ispec) + ! print *,'rank:',myrank + ! print *,'INDEX_IJK,ispec:',INDEX_IJK,ispec + ! print *,'tk: ',tk(INDEX_IJK,ispec),'bk:',bk(INDEX_IJK,ispec) + ! print *,'sum exp_val: ',sum(exp_val(:,:,:)),'sum factor:',sum(factor(:,:,:)) + ! print *,'sum kernel:',sum(kernel(:,:,:,ispec2)) ! call exit_mpi(myrank, 'Error NaN') !endif @@ -833,7 +833,7 @@ program smooth_sem_globe ! outputs gaussian weighting function write(filename,'(a,i4.4,a,i6.6)') trim(output_dir)//'/search_elem',tmp_ispec_dbg,'_gaussian_proc',iproc call write_VTK_data_elem_cr(NSPEC_AB,NGLOB_AB,xstore,ystore,zstore,ibool,tmp_bk,filename) - print*,'file written: ',trim(filename)//'.vtk' + print *,'file written: ',trim(filename)//'.vtk' endif endif @@ -865,11 +865,11 @@ program smooth_sem_globe ! normalizes/scaling factor if (myrank == 0) then - print*, 'Scaling values:' - print*, ' tk min/max = ',minval(tk),maxval(tk) - print*, ' bk min/max = ',minval(bk),maxval(bk) - print*, ' theoretical norm = ',norm - print* + print *, 'Scaling values:' + print *, ' tk min/max = ',minval(tk),maxval(tk) + print *, ' bk min/max = ',minval(bk),maxval(bk) + print *, ' theoretical norm = ',norm + print * endif ! compute the smoothed kernel values @@ -889,7 +889,7 @@ program smooth_sem_globe !debug !if (tk(INDEX_IJK,ispec) == 0.0_CUSTOM_REAL .and. myrank == 0) then - ! print*,myrank,'zero tk: ',INDEX_IJK,ispec,'tk:',tk(INDEX_IJK,ispec),'bk:',bk(INDEX_IJK,ispec) + ! print *,myrank,'zero tk: ',INDEX_IJK,ispec,'tk:',tk(INDEX_IJK,ispec),'bk:',bk(INDEX_IJK,ispec) !endif @@ -901,10 +901,10 @@ program smooth_sem_globe ! checks number (isNaN check) if (kernel_smooth(INDEX_IJK,ispec) /= kernel_smooth(INDEX_IJK,ispec)) then - print*,'Error kernel_smooth value not a number: ',kernel_smooth(INDEX_IJK,ispec) - print*,'rank:',myrank - print*,'INDEX_IJK,ispec:',INDEX_IJK,ispec - print*,'tk: ',tk(INDEX_IJK,ispec),'bk:',bk(INDEX_IJK,ispec),'norm:',norm + print *,'Error kernel_smooth value not a number: ',kernel_smooth(INDEX_IJK,ispec) + print *,'rank:',myrank + print *,'INDEX_IJK,ispec:',INDEX_IJK,ispec + print *,'tk: ',tk(INDEX_IJK,ispec),'bk:',bk(INDEX_IJK,ispec),'norm:',norm call exit_mpi(myrank, 'Error kernel value is NaN') endif diff --git a/src/tomography/read_kernels.f90 b/src/tomography/read_kernels.f90 index d82d956ec..e5f934427 100644 --- a/src/tomography/read_kernels.f90 +++ b/src/tomography/read_kernels.f90 @@ -39,7 +39,7 @@ subroutine read_kernels_iso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'reading kernels...' + if (myrank == 0) print *,'reading kernels...' ! allocate arrays for storing kernels and perturbations ! isotropic arrays @@ -62,11 +62,11 @@ subroutine read_kernels_iso() fname = 'bulk_c_kernel_smooth' endif write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_bulk(:,:,:,1:nspec) @@ -81,11 +81,11 @@ subroutine read_kernels_iso() fname = 'bulk_beta_kernel_smooth' endif write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_beta(:,:,:,1:nspec) @@ -95,16 +95,16 @@ subroutine read_kernels_iso() if (USE_RHO_SCALING) then ! uses scaling relation with shear perturbations kernel_rho(:,:,:,:) = RHO_SCALING * kernel_beta(:,:,:,:) - if (myrank == 0) print*,' rho kernel uses scaling with shear kernel: scaling value = ',RHO_SCALING + if (myrank == 0) print *,' rho kernel uses scaling with shear kernel: scaling value = ',RHO_SCALING else ! uses rho kernel fname = 'rho_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_rho(:,:,:,1:nspec) @@ -122,17 +122,17 @@ subroutine read_kernels_iso() call max_all_cr(maxval(kernel_rho),max_rho) if (myrank == 0) then - print* - print*,'initial kernels:' + print * + print *,'initial kernels:' if (USE_ALPHA_BETA_RHO) then - print*,' alpha min/max : ',min_vp,max_vp - print*,' beta min/max : ',min_vs,max_vs + print *,' alpha min/max : ',min_vp,max_vp + print *,' beta min/max : ',min_vs,max_vs else - print*,' bulk_c min/max : ',min_vp,max_vp - print*,' bulk_beta min/max: ',min_vs,max_vs + print *,' bulk_c min/max : ',min_vp,max_vp + print *,' bulk_beta min/max: ',min_vs,max_vs endif - print*,' rho min/max : ',min_rho,max_rho - print* + print *,' rho min/max : ',min_rho,max_rho + print * endif call synchronize_all() @@ -164,7 +164,7 @@ subroutine read_kernels_tiso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'reading kernels...' + if (myrank == 0) print *,'reading kernels...' ! allocate arrays for storing kernels and perturbations ! transversely isotropic arrays @@ -183,11 +183,11 @@ subroutine read_kernels_tiso() ! bulk kernel fname = 'bulk_c_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_bulk(:,:,:,1:nspec) @@ -196,11 +196,11 @@ subroutine read_kernels_tiso() ! betav kernel fname = 'bulk_betav_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_betav(:,:,:,1:nspec) @@ -209,11 +209,11 @@ subroutine read_kernels_tiso() ! betah kernel fname = 'bulk_betah_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_betah(:,:,:,1:nspec) @@ -222,11 +222,11 @@ subroutine read_kernels_tiso() ! eta kernel fname = 'eta_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_eta(:,:,:,1:nspec) @@ -247,13 +247,13 @@ subroutine read_kernels_tiso() call max_all_cr(maxval(kernel_eta),max_eta) if (myrank == 0) then - print* - print*,'initial kernels:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print * + print *,'initial kernels:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif call synchronize_all() diff --git a/src/tomography/read_kernels_cg.f90 b/src/tomography/read_kernels_cg.f90 index e17fa5c6d..a67f96d58 100644 --- a/src/tomography/read_kernels_cg.f90 +++ b/src/tomography/read_kernels_cg.f90 @@ -39,7 +39,7 @@ subroutine read_kernels_cg_tiso_old() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'reading kernels...' + if (myrank == 0) print *,'reading kernels...' ! allocate arrays for storing kernels and perturbations ! transversely isotropic arrays @@ -60,24 +60,24 @@ subroutine read_kernels_cg_tiso_old() write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' inquire(file=trim(m_file),EXIST=exist) if (.not. exist) then - print*,'Error file does not exist: ',trim(m_file) + print *,'Error file does not exist: ',trim(m_file) call exit_mpi(myrank,'file not exist') endif ! makes sure all processes have same flag call any_all_l(exist,exist_all) if (.not. exist_all) then - print*,'old kernels do not exist: ',trim(m_file) + print *,'old kernels do not exist: ',trim(m_file) call exit_mpi(myrank,'flags old model not consistent') endif ! bulk kernel fname = 'bulk_c_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_bulk_old(:,:,:,1:nspec) @@ -86,11 +86,11 @@ subroutine read_kernels_cg_tiso_old() ! betav kernel fname = 'bulk_betav_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_betav_old(:,:,:,1:nspec) @@ -99,11 +99,11 @@ subroutine read_kernels_cg_tiso_old() ! betah kernel fname = 'bulk_betah_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_betah_old(:,:,:,1:nspec) @@ -112,11 +112,11 @@ subroutine read_kernels_cg_tiso_old() ! eta kernel fname = 'eta_kernel_smooth' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) kernel_eta_old(:,:,:,1:nspec) @@ -136,13 +136,13 @@ subroutine read_kernels_cg_tiso_old() call max_all_cr(maxval(kernel_eta_old),max_eta) if (myrank == 0) then - print* - print*,'old kernels:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print * + print *,'old kernels:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif ! statistics output @@ -161,13 +161,13 @@ subroutine read_kernels_cg_tiso_old() write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' inquire(file=trim(m_file),EXIST=exist) if (.not. exist) then - print*,'old kernel updates do not exist: ',trim(m_file) + print *,'old kernel updates do not exist: ',trim(m_file) USE_OLD_GRADIENT = .false. endif ! makes sure all processes have same flag call any_all_l(exist,exist_all) if (.not. exist_all) then - if (myrank == 0) print*,'old kernel updates do not exist for all: ',trim(m_file) + if (myrank == 0) print *,'old kernel updates do not exist for all: ',trim(m_file) call exit_mpi(myrank,'flags old model not consistent') endif @@ -177,7 +177,7 @@ subroutine read_kernels_cg_tiso_old() call any_all_l(USE_OLD_GRADIENT,use_old_gradient_all) if (.not. use_old_gradient_all) then - print*,'old kernel updates exists, not consistent for all: ',trim(m_file) + print *,'old kernel updates exists, not consistent for all: ',trim(m_file) call exit_mpi(myrank,'flags old model not consistent') endif @@ -185,7 +185,7 @@ subroutine read_kernels_cg_tiso_old() if (USE_OLD_GRADIENT) then ! user output - if (myrank == 0) print*,'reading old gradients...' + if (myrank == 0) print *,'reading old gradients...' ! allocate arrays for storing old gradients ! transversely isotropic arrays @@ -204,11 +204,11 @@ subroutine read_kernels_cg_tiso_old() ! bulk kernel fname = 'dbulk_c' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_dbulk_old(:,:,:,1:nspec) @@ -217,11 +217,11 @@ subroutine read_kernels_cg_tiso_old() ! betav kernel fname = 'dbetav' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_dbetav_old(:,:,:,1:nspec) @@ -230,11 +230,11 @@ subroutine read_kernels_cg_tiso_old() ! betah kernel fname = 'dbetah' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_dbetah_old(:,:,:,1:nspec) @@ -243,11 +243,11 @@ subroutine read_kernels_cg_tiso_old() ! eta kernel fname = 'deta' write(m_file,'(a,i6.6,a)') trim(KERNEL_OLD_DIR)//'/proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' '//trim(KERNEL_OLD_DIR)//'/proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_deta_old(:,:,:,1:nspec) @@ -267,13 +267,13 @@ subroutine read_kernels_cg_tiso_old() call max_all_cr(maxval(model_deta_old),max_eta) if (myrank == 0) then - print* - print*,'old kernel updates:' - print*,' bulk min/max : ',min_bulk,max_bulk - print*,' betav min/max: ',min_vsv,max_vsv - print*,' betah min/max: ',min_vsh,max_vsh - print*,' eta min/max : ',min_eta,max_eta - print* + print * + print *,'old kernel updates:' + print *,' bulk min/max : ',min_bulk,max_bulk + print *,' betav min/max: ',min_vsv,max_vsv + print *,' betah min/max: ',min_vsh,max_vsh + print *,' eta min/max : ',min_eta,max_eta + print * endif ! statistics output diff --git a/src/tomography/read_model.f90 b/src/tomography/read_model.f90 index 4ec19000b..bc4f68ba5 100644 --- a/src/tomography/read_model.f90 +++ b/src/tomography/read_model.f90 @@ -37,7 +37,7 @@ subroutine read_model_iso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'reading model...' + if (myrank == 0) print *,'reading model...' ! allocate arrays for storing the databases allocate(model_vp(NGLLX,NGLLY,NGLLZ,NSPEC), & @@ -54,11 +54,11 @@ subroutine read_model_iso() ! vp model fname = 'vp' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_vp(:,:,:,1:nspec) @@ -67,11 +67,11 @@ subroutine read_model_iso() ! vs model fname = 'vs' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_vs(:,:,:,1:nspec) @@ -80,11 +80,11 @@ subroutine read_model_iso() ! rho model fname = 'rho' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_rho(:,:,:,1:nspec) @@ -101,12 +101,12 @@ subroutine read_model_iso() call max_all_cr(maxval(model_rho),max_rho) if (myrank == 0) then - print* - print*,'initial models:' - print*,' vp min/max : ',min_vp,max_vp - print*,' vs min/max : ',min_vs,max_vs - print*,' rho min/max: ',min_rho,max_rho - print* + print * + print *,'initial models:' + print *,' vp min/max : ',min_vp,max_vp + print *,' vs min/max : ',min_vs,max_vs + print *,' rho min/max: ',min_rho,max_rho + print * endif call synchronize_all() @@ -139,7 +139,7 @@ subroutine read_model_tiso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'reading model...' + if (myrank == 0) print *,'reading model...' ! allocate arrays for storing the databases allocate(model_vpv(NGLLX,NGLLY,NGLLZ,NSPEC), & @@ -162,11 +162,11 @@ subroutine read_model_tiso() ! vpv model fname = 'vpv' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_vpv(:,:,:,1:nspec) @@ -175,11 +175,11 @@ subroutine read_model_tiso() ! vph model fname = 'vph' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_vph(:,:,:,1:nspec) @@ -188,11 +188,11 @@ subroutine read_model_tiso() ! vsv model fname = 'vsv' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_vsv(:,:,:,1:nspec) @@ -201,11 +201,11 @@ subroutine read_model_tiso() ! vsh model fname = 'vsh' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_vsh(:,:,:,1:nspec) @@ -214,11 +214,11 @@ subroutine read_model_tiso() ! eta model fname = 'eta' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_eta(:,:,:,1:nspec) @@ -227,11 +227,11 @@ subroutine read_model_tiso() ! rho model fname = 'rho' write(m_file,'(a,i6.6,a)') trim(INPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif read(IIN) model_rho(:,:,:,1:nspec) @@ -257,15 +257,15 @@ subroutine read_model_tiso() call max_all_cr(maxval(model_rho),max_rho) if (myrank == 0) then - print* - print*,'initial models:' - print*,' vpv min/max: ',min_vpv,max_vpv - print*,' vph min/max: ',min_vph,max_vph - print*,' vsv min/max: ',min_vsv,max_vsv - print*,' vsh min/max: ',min_vsh,max_vsh - print*,' eta min/max: ',min_eta,max_eta - print*,' rho min/max: ',min_rho,max_rho - print* + print * + print *,'initial models:' + print *,' vpv min/max: ',min_vpv,max_vpv + print *,' vph min/max: ',min_vph,max_vph + print *,' vsv min/max: ',min_vsv,max_vsv + print *,' vsh min/max: ',min_vsh,max_vsh + print *,' eta min/max: ',min_eta,max_eta + print *,' rho min/max: ',min_rho,max_rho + print * endif call synchronize_all() @@ -303,7 +303,7 @@ subroutine read_model_database() write(m_file,'(a,i6.6,a)') trim(INPUT_DATABASES_DIR)//'proc',myrank,trim(REG)//'solver_data.bin' open(IIN,file=trim(m_file),status='old',form='unformatted',action='read',iostat=ier) if (ier /= 0) then - print*,'Error opening: ',trim(m_file) + print *,'Error opening: ',trim(m_file) call exit_mpi(myrank,'file not found') endif diff --git a/src/tomography/read_parameters_tomo.f90 b/src/tomography/read_parameters_tomo.f90 index cdb20076b..41e77f36a 100644 --- a/src/tomography/read_parameters_tomo.f90 +++ b/src/tomography/read_parameters_tomo.f90 @@ -53,7 +53,7 @@ subroutine read_parameters_tomo() ! safety check if (abs(step_fac) < 1.e-15) then - print*,'Error: step factor ',step_fac,' is too small and will lead to no update...' + print *,'Error: step factor ',step_fac,' is too small and will lead to no update...' call exit_MPI(myrank,'Error step factor too small') endif @@ -87,9 +87,9 @@ subroutine read_parameters_tomo() if (PRINT_STATISTICS_FILES .and. myrank == 0) then open(IOUT,file=trim(OUTPUT_STATISTICS_DIR)//'statistics_step_fac',status='unknown',action='write',iostat=ier) if (ier /= 0) then - print*,'Error opening file: ',trim(OUTPUT_STATISTICS_DIR)//'statistics_step_fac' - print*,'Please make sure that directory '//trim(OUTPUT_STATISTICS_DIR)//' exists...' - print* + print *,'Error opening file: ',trim(OUTPUT_STATISTICS_DIR)//'statistics_step_fac' + print *,'Please make sure that directory '//trim(OUTPUT_STATISTICS_DIR)//' exists...' + print * stop 'Error opening statistics file' endif write(IOUT,'(1e24.12)') step_fac @@ -103,15 +103,15 @@ subroutine usage() implicit none if (myrank == 0) then - print*,'Usage: add_model step_factor [INPUT-KERNELS-DIR/] [OUTPUT-MODEL-DIR/]' - print* - print*,'with' - print*,' step_factor - factor to scale gradient (e.g. 0.03 for 3 percent update)' - print*,' INPUT-KERNELS-DIR/ - (optional) directory which holds summed kernels (e.g. alpha_kernel.bin,..)' - print*,' OUTPUT-MODEL-DIR/ - (optional) directory which will hold new model files (e.g. vp_new.bin,..)' - print* - print*,'Please rerun e.g. like: mpirun -np ',sizeprocs,' ./bin/xadd_model 0.03' - print* + print *,'Usage: add_model step_factor [INPUT-KERNELS-DIR/] [OUTPUT-MODEL-DIR/]' + print * + print *,'with' + print *,' step_factor - factor to scale gradient (e.g. 0.03 for 3 percent update)' + print *,' INPUT-KERNELS-DIR/ - (optional) directory which holds summed kernels (e.g. alpha_kernel.bin,..)' + print *,' OUTPUT-MODEL-DIR/ - (optional) directory which will hold new model files (e.g. vp_new.bin,..)' + print * + print *,'Please rerun e.g. like: mpirun -np ',sizeprocs,' ./bin/xadd_model 0.03' + print * endif call synchronize_all() call exit_MPI(myrank,'Error usage: add_model step_factor') diff --git a/src/tomography/sum_kernels.f90 b/src/tomography/sum_kernels.f90 index 344e6ee63..dac89c049 100644 --- a/src/tomography/sum_kernels.f90 +++ b/src/tomography/sum_kernels.f90 @@ -90,12 +90,12 @@ program sum_kernels_globe ! checks if number of MPI process as specified if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*,'' - print*,'Error: run xsum_kernels with the same number of MPI processes ' - print*,' as specified when slices were created' - print*,'' - print*,'for example: mpirun -np ',NPROCTOT_VAL,' ./xsum_kernels ...' - print*,'' + print *,'' + print *,'Error: run xsum_kernels with the same number of MPI processes ' + print *,' as specified when slices were created' + print *,'' + print *,'for example: mpirun -np ',NPROCTOT_VAL,' ./xsum_kernels ...' + print *,'' endif call synchronize_all() stop 'Error total number of slices' @@ -104,9 +104,9 @@ program sum_kernels_globe ! user output if(myrank == 0) then - print*,'summing kernels in INPUT_KERNELS/ directories:' - print*,kernel_list(1:nker) - print* + print *,'summing kernels in INPUT_KERNELS/ directories:' + print *,kernel_list(1:nker) + print * endif ! synchronizes @@ -222,8 +222,8 @@ subroutine sum_kernel(kernel_name,kernel_list,nker) norm = sum( kernel * kernel ) call sum_all_dp(norm,norm_sum) if (myrank == 0) then - print*,' norm kernel: ',sqrt(norm_sum) - print* + print *,' norm kernel: ',sqrt(norm_sum) + print * endif ! source mask diff --git a/src/tomography/sum_preconditioned_kernels.f90 b/src/tomography/sum_preconditioned_kernels.f90 index af30a0300..1da1cf8d5 100644 --- a/src/tomography/sum_preconditioned_kernels.f90 +++ b/src/tomography/sum_preconditioned_kernels.f90 @@ -92,12 +92,12 @@ program sum_preconditioned_kernels_globe ! checks if number of MPI process as specified if (sizeprocs /= NPROCTOT_VAL) then if (myrank == 0) then - print*,'' - print*,'Error: run xsum_kernels with the same number of MPI processes ' - print*,' as specified when slices were created' - print*,'' - print*,'for example: mpirun -np ',NPROCTOT_VAL,' ./xsum_kernels ...' - print*,'' + print *,'' + print *,'Error: run xsum_kernels with the same number of MPI processes ' + print *,' as specified when slices were created' + print *,'' + print *,'for example: mpirun -np ',NPROCTOT_VAL,' ./xsum_kernels ...' + print *,'' endif call synchronize_all() stop 'Error total number of slices' @@ -106,9 +106,9 @@ program sum_preconditioned_kernels_globe ! user output if(myrank == 0) then - print*,'summing kernels in INPUT_KERNELS/ directories:' - print*,kernel_list(1:nker) - print* + print *,'summing kernels in INPUT_KERNELS/ directories:' + print *,kernel_list(1:nker) + print * endif ! synchronizes @@ -231,7 +231,7 @@ subroutine sum_kernel_pre(kernel_name,kernel_list,nker) norm = sum( kernel * kernel ) call sum_all_dp(norm,norm_sum) if (myrank == 0) then - print*,' norm kernel: ',sqrt(norm_sum) + print *,' norm kernel: ',sqrt(norm_sum) endif ! approximate Hessian @@ -251,7 +251,7 @@ subroutine sum_kernel_pre(kernel_name,kernel_list,nker) norm = sum( hess * hess ) call sum_all_dp(norm,norm_sum) if (myrank == 0) then - print*,' norm preconditioner: ',sqrt(norm_sum) + print *,' norm preconditioner: ',sqrt(norm_sum) endif ! note: we take absolute values for hessian (as proposed by Yang) @@ -293,7 +293,7 @@ subroutine sum_kernel_pre(kernel_name,kernel_list,nker) ! sums all kernels from each event total_kernel = total_kernel + kernel - if (myrank == 0) print* + if (myrank == 0) print * enddo ! preconditions summed kernels with summed hessians @@ -370,9 +370,9 @@ subroutine invert_hess( hess_matrix ) ! user output if (myrank == 0) then - print* - print*,'hessian maximum: ',maxh_all - print* + print * + print *,'hessian maximum: ',maxh_all + print * endif ! normalizes hessian diff --git a/src/tomography/write_gradient.f90 b/src/tomography/write_gradient.f90 index 820d3e02b..efbe3cbf5 100644 --- a/src/tomography/write_gradient.f90 +++ b/src/tomography/write_gradient.f90 @@ -35,12 +35,12 @@ subroutine write_gradient_iso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'writing out gradient...' + if (myrank == 0) print *,'writing out gradient...' ! kernel updates fname = 'dbulk' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_dbulk @@ -48,7 +48,7 @@ subroutine write_gradient_iso() fname = 'dbeta' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_dbeta @@ -56,13 +56,13 @@ subroutine write_gradient_iso() fname = 'drho' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_drho close(IOUT) - if (myrank == 0) print* + if (myrank == 0) print * end subroutine write_gradient_iso @@ -80,12 +80,12 @@ subroutine write_gradient_tiso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'writing out gradient...' + if (myrank == 0) print *,'writing out gradient...' ! kernel updates fname = 'dbulk_c' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_dbulk @@ -93,7 +93,7 @@ subroutine write_gradient_tiso() fname = 'dbetav' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_dbetav @@ -101,7 +101,7 @@ subroutine write_gradient_tiso() fname = 'dbetah' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_dbetah @@ -109,13 +109,13 @@ subroutine write_gradient_tiso() fname = 'deta' write(m_file,'(a,i6.6,a)') trim(INPUT_KERNELS_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(INPUT_KERNELS_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_deta close(IOUT) - if (myrank == 0) print* + if (myrank == 0) print * end subroutine write_gradient_tiso diff --git a/src/tomography/write_new_model.f90 b/src/tomography/write_new_model.f90 index 4a5defb82..39308c91b 100644 --- a/src/tomography/write_new_model.f90 +++ b/src/tomography/write_new_model.f90 @@ -37,7 +37,7 @@ subroutine write_new_model_iso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'writing out new model...' + if (myrank == 0) print *,'writing out new model...' ! vp model call max_all_cr(maxval(model_vp_new),max_vp) @@ -45,7 +45,7 @@ subroutine write_new_model_iso() fname = 'vp_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_vp_new @@ -57,7 +57,7 @@ subroutine write_new_model_iso() fname = 'vs_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_vs_new @@ -69,19 +69,19 @@ subroutine write_new_model_iso() fname = 'rho_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_rho_new close(IOUT) if (myrank == 0) then - print* - print*,'new models:' - print*,' vp min/max : ',min_vp,max_vp - print*,' vs min/max : ',min_vs,max_vs - print*,' rho min/max: ',min_rho,max_rho - print* + print * + print *,'new models:' + print *,' vp min/max : ',min_vp,max_vp + print *,' vs min/max : ',min_vs,max_vs + print *,' rho min/max: ',min_rho,max_rho + print * endif call synchronize_all() @@ -110,7 +110,7 @@ subroutine write_new_model_tiso() character(len=MAX_STRING_LEN) :: m_file, fname ! user output - if (myrank == 0) print*,'writing out new model...' + if (myrank == 0) print *,'writing out new model...' ! vpv model call max_all_cr(maxval(model_vpv_new),max_vpv) @@ -118,7 +118,7 @@ subroutine write_new_model_tiso() fname = 'vpv_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_vpv_new @@ -130,7 +130,7 @@ subroutine write_new_model_tiso() fname = 'vph_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_vph_new @@ -142,7 +142,7 @@ subroutine write_new_model_tiso() fname = 'vsv_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_vsv_new @@ -154,7 +154,7 @@ subroutine write_new_model_tiso() fname = 'vsh_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_vsh_new @@ -166,7 +166,7 @@ subroutine write_new_model_tiso() fname = 'eta_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_eta_new @@ -178,7 +178,7 @@ subroutine write_new_model_tiso() fname = 'rho_new' write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//trim(fname)//'.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//trim(fname)//'.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) model_rho_new @@ -186,15 +186,15 @@ subroutine write_new_model_tiso() ! user output if (myrank == 0) then - print* - print*,'new models:' - print*,' vpv min/max: ',min_vpv,max_vpv - print*,' vph min/max: ',min_vph,max_vph - print*,' vsv min/max: ',min_vsv,max_vsv - print*,' vsh min/max: ',min_vsh,max_vsh - print*,' eta min/max: ',min_eta,max_eta - print*,' rho min/max: ',min_rho,max_rho - print* + print * + print *,'new models:' + print *,' vpv min/max: ',min_vpv,max_vpv + print *,' vph min/max: ',min_vph,max_vph + print *,' vsv min/max: ',min_vsv,max_vsv + print *,' vsh min/max: ',min_vsh,max_vsh + print *,' eta min/max: ',min_eta,max_eta + print *,' rho min/max: ',min_rho,max_rho + print * endif call synchronize_all() diff --git a/src/tomography/write_new_model_perturbations.f90 b/src/tomography/write_new_model_perturbations.f90 index 690eeb231..7479dd450 100644 --- a/src/tomography/write_new_model_perturbations.f90 +++ b/src/tomography/write_new_model_perturbations.f90 @@ -38,7 +38,7 @@ subroutine write_new_model_perturbations_iso() character(len=MAX_STRING_LEN) :: m_file ! user output - if (myrank == 0) print*,'writing out model perturbations...' + if (myrank == 0) print *,'writing out model perturbations...' ! vp relative perturbations ! logarithmic perturbation: log( v_new) - log( v_old) = log( v_new / v_old ) @@ -49,7 +49,7 @@ subroutine write_new_model_perturbations_iso() !where( model_vp /= 0.0 ) total_model = ( model_vp_new - model_vp) / model_vp write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'dvpvp.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvpvp.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvpvp.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -62,7 +62,7 @@ subroutine write_new_model_perturbations_iso() where( model_vs /= 0.0 ) total_model = log( model_vs_new / model_vs) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'dvsvs.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvsvs.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvsvs.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -75,7 +75,7 @@ subroutine write_new_model_perturbations_iso() where( model_rho /= 0.0 ) total_model = log( model_rho_new / model_rho) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'drhorho.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'drhorho.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'drhorho.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -84,12 +84,12 @@ subroutine write_new_model_perturbations_iso() call min_all_cr(minval(total_model),min_rho) if (myrank == 0) then - print* - print*,'relative update:' - print*,' dvp/vp min/max : ',min_vp,max_vp - print*,' dvs/vs min/max : ',min_vs,max_vs - print*,' drho/rho min/max: ',min_rho,max_rho - print* + print * + print *,'relative update:' + print *,' dvp/vp min/max : ',min_vp,max_vp + print *,' dvs/vs min/max : ',min_vs,max_vs + print *,' drho/rho min/max: ',min_rho,max_rho + print * endif call synchronize_all() @@ -120,7 +120,7 @@ subroutine write_new_model_perturbations_tiso() character(len=MAX_STRING_LEN) :: m_file ! user output - if (myrank == 0) print*,'writing out model perturbations...' + if (myrank == 0) print *,'writing out model perturbations...' ! vpv relative perturbations ! logarithmic perturbation: log( v_new) - log( v_old) = log( v_new / v_old ) @@ -131,7 +131,7 @@ subroutine write_new_model_perturbations_tiso() !where( model_vpv /= 0.0 ) total_model = ( model_vpv_new - model_vpv) / model_vpv write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'dvpvvpv.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvpvvpv.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvpvvpv.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -144,7 +144,7 @@ subroutine write_new_model_perturbations_tiso() where( model_vph /= 0.0 ) total_model = log( model_vph_new / model_vph) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'dvphvph.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvphvph.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvphvph.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -157,7 +157,7 @@ subroutine write_new_model_perturbations_tiso() where( model_vsv /= 0.0 ) total_model = log( model_vsv_new / model_vsv) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'dvsvvsv.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvsvvsv.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvsvvsv.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -170,7 +170,7 @@ subroutine write_new_model_perturbations_tiso() where( model_vsh /= 0.0 ) total_model = log( model_vsh_new / model_vsh) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'dvshvsh.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvshvsh.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'dvshvsh.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -183,7 +183,7 @@ subroutine write_new_model_perturbations_tiso() where( model_eta /= 0.0 ) total_model = log( model_eta_new / model_eta) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'detaeta.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'detaeta.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'detaeta.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -196,7 +196,7 @@ subroutine write_new_model_perturbations_tiso() where( model_rho /= 0.0 ) total_model = log( model_rho_new / model_rho) write(m_file,'(a,i6.6,a)') trim(OUTPUT_MODEL_DIR)//'proc',myrank,trim(REG)//'drhorho.bin' - if (myrank == 0) print*,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'drhorho.bin' + if (myrank == 0) print *,' ',trim(OUTPUT_MODEL_DIR)//'proc**'//trim(REG)//'drhorho.bin' open(IOUT,file=trim(m_file),form='unformatted',action='write') write(IOUT) total_model @@ -205,15 +205,15 @@ subroutine write_new_model_perturbations_tiso() call min_all_cr(minval(total_model),min_rho) if (myrank == 0) then - print* - print*,'relative update:' - print*,' dvpv/vpv min/max: ',min_vpv,max_vpv - print*,' dvph/vph min/max: ',min_vph,max_vph - print*,' dvsv/vsv min/max: ',min_vsv,max_vsv - print*,' dvsh/vsh min/max: ',min_vsh,max_vsh - print*,' deta/eta min/max: ',min_eta,max_eta - print*,' drho/rho min/max: ',min_rho,max_rho - print* + print * + print *,'relative update:' + print *,' dvpv/vpv min/max: ',min_vpv,max_vpv + print *,' dvph/vph min/max: ',min_vph,max_vph + print *,' dvsv/vsv min/max: ',min_vsv,max_vsv + print *,' dvsh/vsh min/max: ',min_vsh,max_vsh + print *,' deta/eta min/max: ',min_eta,max_eta + print *,' drho/rho min/max: ',min_rho,max_rho + print * endif call synchronize_all() diff --git a/utils/Profiles/write_profile.f90 b/utils/Profiles/write_profile.f90 index 6e0aa1b7d..e63888b2f 100644 --- a/utils/Profiles/write_profile.f90 +++ b/utils/Profiles/write_profile.f90 @@ -328,8 +328,8 @@ program xwrite_profile ! checks vpv: if close to zero then there is probably an error if (vpv < TINYVAL) then - print*,'error vpv: ',vpv,vph,vsv,vsh,rho - print*,'radius:',r*R_EARTH_KM + print *,'error vpv: ',vpv,vph,vsv,vsh,rho + print *,'radius:',r*R_EARTH_KM call exit_mpi(myrank,'error get_model values') endif diff --git a/utils/Visualization/VTK_ParaView/create_slice_VTK.f90 b/utils/Visualization/VTK_ParaView/create_slice_VTK.f90 index 473975799..857befd3c 100644 --- a/utils/Visualization/VTK_ParaView/create_slice_VTK.f90 +++ b/utils/Visualization/VTK_ParaView/create_slice_VTK.f90 @@ -82,7 +82,7 @@ program create_slice_VTK print *, ' - slice_list: file containing slice/proc ids ' print *, ' - filename: looks for filename.bin must be array of (NGLLX,NGLLY,NGLLZ,nspec) ' print *, ' - input_topo_dir: includes "proc***_array_dims.txt ' - print*, ' - input_file_dir: includes "proc****filename.bin ' + print *, ' - input_file_dir: includes "proc****filename.bin ' print *, ' - output_dir: output mesh files go to here ' print *, ' if region is not specified, all 3 regions will be collected, otherwise, only collect regions specified' print *, ' ' @@ -112,7 +112,7 @@ program create_slice_VTK num_node = 0 open(unit = 20, file = trim(arg(1)), status = 'old',iostat = ios) if (ios /= 0) then - print*,'no file: ',trim(arg(1)) + print *,'no file: ',trim(arg(1)) stop 'Error opening slices file' endif @@ -153,8 +153,8 @@ program create_slice_VTK dimension_file = trim(prname_topo) //'array_dims.txt' open(unit = 27,file = trim(dimension_file),status='old',action='read', iostat = ios) if (ios /= 0) then - print*,'error ',ios - print*,'file:',trim(dimension_file) + print *,'error ',ios + print *,'file:',trim(dimension_file) stop 'Error opening file' endif read(27,*) nspec(it) @@ -185,8 +185,8 @@ program create_slice_VTK data_file = trim(prname_file) // trim(filename) // '.bin' open(unit = 27,file = trim(data_file),status='old',action='read', iostat = ios,form ='unformatted') if (ios /= 0) then - print*,'error ',ios - print*,'file:',trim(data_file) + print *,'error ',ios + print *,'file:',trim(data_file) stop 'Error opening file' endif @@ -202,8 +202,8 @@ program create_slice_VTK topo_file = trim(prname_topo) // 'solver_data' // '.bin' open(unit = 28,file = trim(topo_file),status='old',action='read', iostat = ios, form='unformatted') if (ios /= 0) then - print*,'error ',ios - print*,'file:',trim(topo_file) + print *,'error ',ios + print *,'file:',trim(topo_file) stop 'Error opening file' endif xstore(:) = 0.0 diff --git a/utils/adjoint_sources/amplitude/create_adjsrc_amplitude.f90 b/utils/adjoint_sources/amplitude/create_adjsrc_amplitude.f90 index 4134f9d5f..1cc9ae6ea 100644 --- a/utils/adjoint_sources/amplitude/create_adjsrc_amplitude.f90 +++ b/utils/adjoint_sources/amplitude/create_adjsrc_amplitude.f90 @@ -35,19 +35,19 @@ program create_adjsrc_amplitude do while (1 == 1) call getarg(i,arg(i)) if (i < 6 .and. trim(arg(i)) == '') then - print*,'Usage: ' - print*,' xcreate_adjsrc_amplitude t1 t2 ifile[0-5] E/N/Z-ascii-files [baz]' - print*,'with' - print*,' t1: window start time' - print*,' t2: window end time' - print*,' ifile: 0 = adjoint source calculated for each seismogram component' - print*,' ifile: 1 = adjoint source given by East component only' - print*,' ifile: 2 = adjoint source given by North component' - print*,' ifile: 3 = adjoint source given by Z component' - print*,' ifile: 4 = adjoint source given by rotated transversal component (requires baz)' - print*,' ifile: 5 = adjoint source given by rotated radial component (requires baz)' - print*,' E/N/Z-ascii-files : displacement traces stored as ascii files' - print*,' [baz]: (optional) back-azimuth, requires ifile = 4 or ifile = 5' + print *,'Usage: ' + print *,' xcreate_adjsrc_amplitude t1 t2 ifile[0-5] E/N/Z-ascii-files [baz]' + print *,'with' + print *,' t1: window start time' + print *,' t2: window end time' + print *,' ifile: 0 = adjoint source calculated for each seismogram component' + print *,' ifile: 1 = adjoint source given by East component only' + print *,' ifile: 2 = adjoint source given by North component' + print *,' ifile: 3 = adjoint source given by Z component' + print *,' ifile: 4 = adjoint source given by rotated transversal component (requires baz)' + print *,' ifile: 5 = adjoint source given by rotated radial component (requires baz)' + print *,' E/N/Z-ascii-files : displacement traces stored as ascii files' + print *,' [baz]: (optional) back-azimuth, requires ifile = 4 or ifile = 5' stop 'create_adjsrc_amplitude t1 t2 ifile[0-5] E/N/Z-ascii-files [baz]' endif if (trim(arg(i)) == '') exit diff --git a/utils/adjoint_sources/traveltime/create_adjsrc_traveltime.f90 b/utils/adjoint_sources/traveltime/create_adjsrc_traveltime.f90 index 4fc1a64ea..84eead0f8 100644 --- a/utils/adjoint_sources/traveltime/create_adjsrc_traveltime.f90 +++ b/utils/adjoint_sources/traveltime/create_adjsrc_traveltime.f90 @@ -34,19 +34,19 @@ program create_adjsrc_traveltime do while (1 == 1) call getarg(i,arg(i)) if (i < 6 .and. trim(arg(i)) == '') then - print*,'Usage: ' - print*,' xcreate_adjsrc_traveltime t1 t2 ifile[0-5] E/N/Z-ascii-files [baz]' - print*,'with' - print*,' t1: window start time' - print*,' t2: window end time' - print*,' ifile: 0 = adjoint source calculated for each seismogram component' - print*,' ifile: 1 = adjoint source given by East component only' - print*,' ifile: 2 = adjoint source given by North component' - print*,' ifile: 3 = adjoint source given by Z component' - print*,' ifile: 4 = adjoint source given by rotated transversal component (requires baz)' - print*,' ifile: 5 = adjoint source given by rotated radial component (requires baz)' - print*,' E/N/Z-ascii-files : displacement traces stored as ascii files' - print*,' [baz]: (optional) back-azimuth, requires ifile = 4 or ifile = 5' + print *,'Usage: ' + print *,' xcreate_adjsrc_traveltime t1 t2 ifile[0-5] E/N/Z-ascii-files [baz]' + print *,'with' + print *,' t1: window start time' + print *,' t2: window end time' + print *,' ifile: 0 = adjoint source calculated for each seismogram component' + print *,' ifile: 1 = adjoint source given by East component only' + print *,' ifile: 2 = adjoint source given by North component' + print *,' ifile: 3 = adjoint source given by Z component' + print *,' ifile: 4 = adjoint source given by rotated transversal component (requires baz)' + print *,' ifile: 5 = adjoint source given by rotated radial component (requires baz)' + print *,' E/N/Z-ascii-files : displacement traces stored as ascii files' + print *,' [baz]: (optional) back-azimuth, requires ifile = 4 or ifile = 5' stop 'create_adjsrc_traveltime t1 t2 ifile[0-5] E/N/Z-ascii-files [baz]' endif if (trim(arg(i)) == '') exit