updates receiver check

Author: danielpeter

src/generate_databases/setup_mesh_adjacency.f90

@@ -255,7 +255,8 @@ subroutine setup_mesh_adjacency()
     else
       ! no neighbors
       ! warning
-      print *,'*** Warning: found mesh element with no neighbors : slice ',myrank,' - element ',ispec_ref,' ***'
+      print *,'*** Warning: found mesh element with no neighbors : slice ',myrank, &
+              ' - element ',ispec_ref,'out of',NSPEC_AB,' ***'
     endif
 
     ! again loop to get neighbors of neighbors

src/specfem3D/locate_receivers.f90

@@ -39,7 +39,8 @@ subroutine locate_receivers(rec_filename,utm_x_source,utm_y_source)
                          xi_receiver,eta_receiver,gamma_receiver,nu_rec, &
                          station_name,network_name, &
                          stlat,stlon,stbur, &
-                         x_target_station,y_target_station,z_target_station
+                         x_target_station,y_target_station,z_target_station, &
+                         NPROC
   ! PML
   use pml_par, only: is_CPML
 
@@ -55,7 +56,7 @@ subroutine locate_receivers(rec_filename,utm_x_source,utm_y_source)
   double precision, allocatable, dimension(:) :: x_target,y_target,z_target
   double precision, allocatable, dimension(:) :: x_found,y_found,z_found
 
-  integer :: irec,ier,ispec
+  integer :: irec,ier,ispec,islice
 
   ! timer MPI
   double precision, external :: wtime
@@ -283,35 +284,51 @@ subroutine locate_receivers(rec_filename,utm_x_source,utm_y_source)
   call bcast_all_dp(nu_rec,NDIM*NDIM*nrec)
   call bcast_all_dp(final_distance,nrec)
 
-  ! checks if valid receiver element
-  if (myrank == 0) then
-    ! locate point might return a zero ispec if point outside/above mesh
-    do irec = 1,nrec
+  ! checks if we got valid receiver elements
+  ! locate point might return a zero ispec if point outside/above mesh
+  do irec = 1,nrec
+    ! slice the receiver is in
+    islice = islice_selected_rec(irec)
+
+    ! checks slice
+    if (islice < 0 .or. islice > NPROC-1) then
+      print *,'Error locating station # ',irec,'    ',trim(network_name(irec)),'    ',trim(station_name(irec))
+      print *,'  found in an invalid slice: ',islice
+      call exit_MPI(myrank,'Error something is wrong with the slice number of receiver')
+    endif
+
+    ! checks found element
+    if (myrank == islice_selected_rec(irec)) then
+      ! element index
       ispec = ispec_selected_rec(irec)
       ! checks if valid
       if (ispec < 1 .or. ispec > NSPEC_AB) then
         ! invalid element
         print *,'Error locating station # ',irec,'    ',trim(network_name(irec)),'    ',trim(station_name(irec))
         if (SUPPRESS_UTM_PROJECTION) then
-          print *,'     original x: ',sngl(stutm_x(irec))
-          print *,'     original y: ',sngl(stutm_y(irec))
+          print *,'  original x: ',sngl(stutm_x(irec))
+          print *,'  original y: ',sngl(stutm_y(irec))
         else
-          print *,'     original UTM x: ',sngl(stutm_x(irec))
-          print *,'     original UTM y: ',sngl(stutm_y(irec))
+          print *,'  original UTM x: ',sngl(stutm_x(irec))
+          print *,'  original UTM y: ',sngl(stutm_y(irec))
         endif
         if (USE_SOURCES_RECEIVERS_Z) then
-          print *,'     original z: ',sngl(stbur(irec))
+          print *,'  original z: ',sngl(stbur(irec))
         else
-          print *,'     original depth: ',sngl(stbur(irec)),' m'
+          print *,'  original depth: ',sngl(stbur(irec)),' m'
         endif
-        print *,'  only found invalid element: slice ',islice_selected_rec(irec)
-        print *,'                              ispec ',ispec_selected_rec(irec)
-        print *,'                              domain ',idomain(irec)
-        print *,'                              final_distance: ',final_distance(irec)
+        print *,'  found in an invalid element: slice         :',islice_selected_rec(irec)
+        print *,'                               ispec         :',ispec_selected_rec(irec),'out of ',NSPEC_AB
+        print *,'                               domain        :',idomain(irec)
+        print *,'                               xi/eta/gamma  :',xi_receiver(irec),eta_receiver(irec),gamma_receiver(irec)
+        print *,'                               final_distance: ',final_distance(irec)
+        print *
+        print *,'Please check your receiver position in file DATA/STATIONS, and move it closer the mesh geometry - exiting...'
+        print *
         call exit_MPI(myrank,'Error locating receiver')
       endif
-    enddo
-  endif
+    endif
+  enddo
   call synchronize_all()
 
   ! warning if receiver in C-PML region