[cig-commits] [commit] devel: Removes remaining hard-coded OUTPUT_FILES paths (d136c78)

cig_noreply at geodynamics.org cig_noreply at geodynamics.org
Fri Dec 5 07:23:05 PST 2014


Repository : https://github.com/geodynamics/specfem3d_globe

On branch  : devel
Link       : https://github.com/geodynamics/specfem3d_globe/compare/b9fb1aa33196d161098710455fadbb4ed91c5e47...897de40783bd1a4630c2aacd3fa5f8b016d4c189

>---------------------------------------------------------------

commit d136c780921a4dd00782d2f9399973d4615bc1ec
Author: Matthieu Lefebvre <ml15 at princeton.edu>
Date:   Wed Dec 3 09:50:11 2014 -0500

    Removes remaining hard-coded OUTPUT_FILES paths


>---------------------------------------------------------------

d136c780921a4dd00782d2f9399973d4615bc1ec
 src/shared/exit_mpi.f90               |  3 ++-
 src/specfem3D/get_cmt.f90             |  1 -
 src/specfem3D/noise_tomography.f90    | 15 ++++++++-------
 src/specfem3D/read_mesh_databases.F90 | 30 +++++++++++++++---------------
 src/specfem3D/save_kernels.F90        | 14 +++++++-------
 src/specfem3D/save_kernels_adios.F90  |  2 +-
 src/specfem3D/write_output_ASDF.F90   |  4 ++--
 src/specfem3D/write_seismograms.f90   |  2 +-
 8 files changed, 36 insertions(+), 35 deletions(-)

diff --git a/src/shared/exit_mpi.f90 b/src/shared/exit_mpi.f90
index 3bf2bb8..ec79a62 100644
--- a/src/shared/exit_mpi.f90
+++ b/src/shared/exit_mpi.f90
@@ -35,6 +35,7 @@
   subroutine exit_MPI(myrank,error_msg)
 
   use constants
+  use shared_input_parameters, only: OUTPUT_FILES
 
   implicit none
 
@@ -51,7 +52,7 @@
 
   ! write error message to file
   write(outputname,"('/error_message',i6.6,'.txt')") myrank
-  open(unit=IERROR,file='OUTPUT_FILES'//outputname,status='unknown')
+  open(unit=IERROR,file=trim(OUTPUT_FILES)//'/'//outputname,status='unknown')
   write(IERROR,*) error_msg(1:len(error_msg))
   write(IERROR,*) 'Error detected, aborting MPI... proc ',myrank
   close(IERROR)
diff --git a/src/specfem3D/get_cmt.f90 b/src/specfem3D/get_cmt.f90
index 18d5848..6b6bf3c 100644
--- a/src/specfem3D/get_cmt.f90
+++ b/src/specfem3D/get_cmt.f90
@@ -85,7 +85,6 @@
 
     ! gets header line
     read(IIN,"(a256)",iostat=ier) string
-    print *, isource, trim(CMTSOLUTION)
     if (ier /= 0) then
       write(IMAIN,*) 'Error reading header line in source ',isource
       stop 'Error reading header line in station in CMTSOLUTION file'
diff --git a/src/specfem3D/noise_tomography.f90 b/src/specfem3D/noise_tomography.f90
index 1d8a01b..8437d04 100644
--- a/src/specfem3D/noise_tomography.f90
+++ b/src/specfem3D/noise_tomography.f90
@@ -94,7 +94,7 @@
       val_x_all,val_y_all,val_z_all,val_ux_all,val_uy_all,val_uz_all
 
   ! read master receiver ID -- the ID in DATA/STATIONS
-  filename = 'OUTPUT_FILES/NOISE_TOMOGRAPHY/'//'irec_master_noise'
+  filename = trim(OUTPUT_FILES)//'/NOISE_TOMOGRAPHY/'//'irec_master_noise'
   open(unit=IIN_NOISE,file=trim(filename),status='old',action='read',iostat=ios)
   if (ios /= 0) &
     call exit_MPI(myrank, 'file '//trim(filename)//' does NOT exist! This file contains the ID of the master receiver')
@@ -104,7 +104,7 @@
   close(IIN_NOISE)
 
   if (myrank == 0) then
-    open(unit=IOUT_NOISE,file='OUTPUT_FILES/irec_master_noise', &
+    open(unit=IOUT_NOISE,file=trim(OUTPUT_FILES)//'/irec_master_noise', &
           status='unknown',action='write',iostat=ios)
     if (ios /= 0 ) call exit_MPI(myrank,'Error opening output file irec_master_noise')
 
@@ -184,7 +184,7 @@
   ! create_movie_AVS_DX.f90 needs to be modified in order to do that,
   ! i.e., instead of showing the normal component, change it to either x, y or z component, or the norm.
   if (myrank == 0) then
-    open(unit=IOUT_NOISE,file='OUTPUT_FILES/mask_noise', &
+    open(unit=IOUT_NOISE,file=trim(OUTPUT_FILES)//'/mask_noise', &
               status='unknown',form='unformatted',action='write',iostat=ios)
     if (ios /= 0 ) call exit_MPI(myrank,'Error opening output file mask_noise')
 
@@ -222,7 +222,7 @@
 
 
   if (myrank == 0) then
-     open(unit=IOUT_NOISE,file='OUTPUT_FILES/NOISE_SIMULATION', &
+     open(unit=IOUT_NOISE,file=trim(OUTPUT_FILES)//'/NOISE_SIMULATION', &
           status='unknown',action='write',iostat=ier)
      if (ier /= 0 ) call exit_MPI(myrank,'Error opening output file NOISE_SIMULATION')
 
@@ -301,6 +301,7 @@
                                          xigll,yigll,zigll,NSTEP)
 
   use constants_solver
+  use shared_input_parameters, only: OUTPUT_FILES
 
   implicit none
 
@@ -326,7 +327,7 @@
 
   noise_src(:) = 0._CUSTOM_REAL
   ! noise file (source time function)
-  filename = 'OUTPUT_FILES/NOISE_TOMOGRAPHY/'//'S_squared'
+  filename = trim(OUTPUT_FILES)//'/NOISE_TOMOGRAPHY/'//'S_squared'
   open(unit=IIN_NOISE,file=trim(filename),status='old',action='read',iostat=ios)
   if (ios /= 0) &
     call exit_MPI(myrank, 'file '//trim(filename)//' does NOT exist! This file is generated by Matlab scripts')
@@ -339,7 +340,7 @@
   close(IIN_NOISE)
 
   ! master receiver component direction, \nu_master
-  filename = 'OUTPUT_FILES/NOISE_TOMOGRAPHY/'//'nu_master'
+  filename = trim(OUTPUT_FILES)//'/NOISE_TOMOGRAPHY/'//'nu_master'
   open(unit=IIN_NOISE,file=trim(filename),status='old',action='read',iostat=ios)
   if (ios /= 0)  call exit_MPI(myrank,&
         'file '//trim(filename)//' does NOT exist! nu_master is the component direction (NEZ) for master receiver')
@@ -352,7 +353,7 @@
   close(IIN_NOISE)
 
   if (myrank == 0) then
-     open(unit=IOUT_NOISE,file='OUTPUT_FILES/nu_master',status='unknown',action='write')
+     open(unit=IOUT_NOISE,file=trim(OUTPUT_FILES)//'/nu_master',status='unknown',action='write')
      write(IOUT_NOISE,*) 'The direction (NEZ) of selected component of master receiver is', nu_master
      close(IOUT_NOISE)
   endif
diff --git a/src/specfem3D/read_mesh_databases.F90 b/src/specfem3D/read_mesh_databases.F90
index 65ed58d..7929c17 100644
--- a/src/specfem3D/read_mesh_databases.F90
+++ b/src/specfem3D/read_mesh_databases.F90
@@ -1696,9 +1696,9 @@
       if (ier /= 0 ) call exit_mpi(myrank,'Error allocating array ibool_interfaces_crust_mantle')
     endif
 
-    call bcast_all_i_for_database(my_neighbours_crust_mantle(1), 1)
-    call bcast_all_i_for_database(nibool_interfaces_crust_mantle(1), 1)
-    call bcast_all_i_for_database(ibool_interfaces_crust_mantle(1,1), 1)
+    call bcast_all_i_for_database(my_neighbours_crust_mantle(1), size(my_neighbours_crust_mantle))
+    call bcast_all_i_for_database(nibool_interfaces_crust_mantle(1), size(nibool_interfaces_crust_mantle))
+    call bcast_all_i_for_database(ibool_interfaces_crust_mantle(1,1), size(ibool_interfaces_crust_mantle))
   else
     ! dummy array
     max_nibool_interfaces_cm = 0
@@ -1723,7 +1723,7 @@
   endif
 
   if (num_phase_ispec_crust_mantle > 0 ) then
-    call bcast_all_i_for_database(phase_ispec_inner_crust_mantle(1,1), 1)
+    call bcast_all_i_for_database(phase_ispec_inner_crust_mantle(1,1), size(phase_ispec_inner_crust_mantle))
   endif
 
   ! mesh coloring for GPUs
@@ -1739,7 +1739,7 @@
         call exit_mpi(myrank,'Error allocating num_elem_colors_crust_mantle array')
     endif
 
-    call bcast_all_i_for_database(num_elem_colors_crust_mantle(1), 1)
+    call bcast_all_i_for_database(num_elem_colors_crust_mantle(1), size(num_elem_colors_crust_mantle))
   else
     ! allocates dummy arrays
     num_colors_outer_crust_mantle = 0
@@ -1785,9 +1785,9 @@
       if (ier /= 0 ) call exit_mpi(myrank,'Error allocating array ibool_interfaces_outer_core')
     endif
 
-    call bcast_all_i_for_database(my_neighbours_outer_core(1), 1)
-    call bcast_all_i_for_database(nibool_interfaces_outer_core(1), 1)
-    call bcast_all_i_for_database(ibool_interfaces_outer_core(1,1), 1)
+    call bcast_all_i_for_database(my_neighbours_outer_core(1), size(my_neighbours_outer_core))
+    call bcast_all_i_for_database(nibool_interfaces_outer_core(1), size(nibool_interfaces_outer_core))
+    call bcast_all_i_for_database(ibool_interfaces_outer_core(1,1), size(ibool_interfaces_outer_core))
   else
     ! dummy array
     max_nibool_interfaces_oc = 0
@@ -1812,7 +1812,7 @@
   endif
 
   if (num_phase_ispec_outer_core > 0 ) then
-    call bcast_all_i_for_database(phase_ispec_inner_outer_core(1,1), 1)
+    call bcast_all_i_for_database(phase_ispec_inner_outer_core(1,1), size(phase_ispec_inner_outer_core))
   endif
 
   ! mesh coloring for GPUs
@@ -1828,7 +1828,7 @@
         call exit_mpi(myrank,'Error allocating num_elem_colors_outer_core array')
     endif
 
-    call bcast_all_i_for_database(num_elem_colors_outer_core(1), 1)
+    call bcast_all_i_for_database(num_elem_colors_outer_core(1), size(num_elem_colors_outer_core))
   else
     ! allocates dummy arrays
     num_colors_outer_outer_core = 0
@@ -1874,9 +1874,9 @@
       if (ier /= 0 ) call exit_mpi(myrank,'Error allocating array ibool_interfaces_inner_core')
     endif
 
-    call bcast_all_i_for_database(my_neighbours_inner_core(1), 1)
-    call bcast_all_i_for_database(nibool_interfaces_inner_core(1), 1)
-    call bcast_all_i_for_database(ibool_interfaces_inner_core(1,1), 1)
+    call bcast_all_i_for_database(my_neighbours_inner_core(1), size(my_neighbours_inner_core))
+    call bcast_all_i_for_database(nibool_interfaces_inner_core(1), size(nibool_interfaces_inner_core))
+    call bcast_all_i_for_database(ibool_interfaces_inner_core(1,1), size(ibool_interfaces_inner_core))
   else
     ! dummy array
     max_nibool_interfaces_ic = 0
@@ -1901,7 +1901,7 @@
   endif
 
   if (num_phase_ispec_inner_core > 0 ) then
-    call bcast_all_i_for_database(phase_ispec_inner_inner_core(1,1), 1)
+    call bcast_all_i_for_database(phase_ispec_inner_inner_core(1,1), size(phase_ispec_inner_inner_core))
   endif
 
   ! mesh coloring for GPUs
@@ -1917,7 +1917,7 @@
         call exit_mpi(myrank,'Error allocating num_elem_colors_inner_core array')
     endif
 
-    call bcast_all_i_for_database(num_elem_colors_inner_core(1), 1)
+    call bcast_all_i_for_database(num_elem_colors_inner_core(1), size(num_elem_colors_inner_core))
   else
     ! allocates dummy arrays
     num_colors_outer_inner_core = 0
diff --git a/src/specfem3D/save_kernels.F90 b/src/specfem3D/save_kernels.F90
index 0d08575..457e488 100644
--- a/src/specfem3D/save_kernels.F90
+++ b/src/specfem3D/save_kernels.F90
@@ -438,12 +438,12 @@
         ! Output these kernels as netcdf files -- one per processor.
 #ifdef CEM
 
-        call write_kernel_netcdf('./OUTPUT_FILES/alphavKernelCrustMantle.nc', alphav_kl_crust_mantle)
-        call write_kernel_netcdf('./OUTPUT_FILES/alphahKernelCrustMantle.nc', alphah_kl_crust_mantle)
-        call write_kernel_netcdf('./OUTPUT_FILES/betavKernelCrustMantle.nc',  betav_kl_crust_mantle)
-        call write_kernel_netcdf('./OUTPUT_FILES/betahKernelCrustMantle.nc',  betah_kl_crust_mantle)
-        call write_kernel_netcdf('./OUTPUT_FILES/etaKernelCrustMantle.nc',    eta_kl_crust_mantle)
-        call write_kernel_netcdf('./OUTPUT_FILES/rhoKernelCrustMantle.nc',    rho_kl_crust_mantle)
+        call write_kernel_netcdf(trim(OUTPUT_FILES)'/alphavKernelCrustMantle.nc', alphav_kl_crust_mantle)
+        call write_kernel_netcdf(trim(OUTPUT_FILES)'/alphahKernelCrustMantle.nc', alphah_kl_crust_mantle)
+        call write_kernel_netcdf(trim(OUTPUT_FILES)'/betavKernelCrustMantle.nc',  betav_kl_crust_mantle)
+        call write_kernel_netcdf(trim(OUTPUT_FILES)'/betahKernelCrustMantle.nc',  betah_kl_crust_mantle)
+        call write_kernel_netcdf(trim(OUTPUT_FILES)'/etaKernelCrustMantle.nc',    eta_kl_crust_mantle)
+        call write_kernel_netcdf(trim(OUTPUT_FILES)'/rhoKernelCrustMantle.nc',    rho_kl_crust_mantle)
 
         call write_coordinates_netcdf('./OUTPUT_FILES/xyzCrustMantle.nc')
 
@@ -751,7 +751,7 @@
 
     ! writes out kernels to file
     if (.not. ADIOS_FOR_KERNELS) then
-      write(outputname,'(a,i6.6)') 'OUTPUT_FILES/src_frechet.',number_receiver_global(irec_local)
+      write(outputname,'(a,i6.6)') trim(OUTPUT_FILES)//'/src_frechet.',number_receiver_global(irec_local)
       open(unit=IOUT,file=trim(outputname),status='unknown',action='write')
       !
       ! r -> z, theta -> -n, phi -> e, plus factor 2 for Mrt,Mrp,Mtp, and 1e-7 to dyne.cm
diff --git a/src/specfem3D/save_kernels_adios.F90 b/src/specfem3D/save_kernels_adios.F90
index 4655a0f..6a6c798 100644
--- a/src/specfem3D/save_kernels_adios.F90
+++ b/src/specfem3D/save_kernels_adios.F90
@@ -90,7 +90,7 @@ subroutine define_kernel_adios_variables(adios_handle)
   ! Type inference for define_adios_global_array1D. Avoid additional args.
   real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: dummy_real4d
 
-  outputname = "OUTPUT_FILES/kernels.bp"
+  outputname = trim(OUTPUT_FILES)//"/kernels.bp"
   group_name = "SPECFEM3D_GLOBE_KERNELS"
 
   call world_duplicate(comm)
diff --git a/src/specfem3D/write_output_ASDF.F90 b/src/specfem3D/write_output_ASDF.F90
index 0e07a4b..0eb3ad5 100644
--- a/src/specfem3D/write_output_ASDF.F90
+++ b/src/specfem3D/write_output_ASDF.F90
@@ -276,7 +276,7 @@ subroutine write_asdf(asdf_container)
 
   use asdf_data,only: asdf_event
 
-  use specfem_par, only : event_name_SAC,myrank,ADIOS_TRANSPORT_METHOD
+  use specfem_par, only : event_name_SAC,myrank,ADIOS_TRANSPORT_METHOD, OUTPUT_FILES
 
   implicit none
   ! Parameters
@@ -300,7 +300,7 @@ subroutine write_asdf(asdf_container)
   !call check_adios_err(myrank,adios_err)
 
   ! output file name
-  ASDF_FN="OUTPUT_FILES/"//trim(event_name_SAC)//"_sem.bp"
+  ASDF_FN=trim(OUTPUT_FILES)//"/"//trim(event_name_SAC)//"_sem.bp"
 
   call write_asdf_data (ASDF_FN, asdf_container, adios_group, myrank, sizeprocs, comm)
 
diff --git a/src/specfem3D/write_seismograms.f90 b/src/specfem3D/write_seismograms.f90
index 36060c7..a993091 100644
--- a/src/specfem3D/write_seismograms.f90
+++ b/src/specfem3D/write_seismograms.f90
@@ -160,7 +160,7 @@ contains
   if (ier /= 0) call exit_mpi(myrank,'Error while allocating one temporary seismogram')
 
   ! set the base pathname for output files
-  OUTPUT_FILES = 'OUTPUT_FILES'
+  !OUTPUT_FILES = 'OUTPUT_FILES' -- done in parallel.f90
 
   ! writes out seismograms
   if (.not. WRITE_SEISMOGRAMS_BY_MASTER) then



More information about the CIG-COMMITS mailing list