scan_1d_array_for_nans Subroutine

public subroutine scan_1d_array_for_nans(array_size, array, name)

Test if a double precision is a finite number

FT 11.02.2022


Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: array_size
double precision, intent(in), DIMENSION(:) :: array
character(len=*), intent(in) :: name

Calls

proc~~scan_1d_array_for_nans~~CallsGraph proc~scan_1d_array_for_nans scan_1d_array_for_nans proc~is_finite_number is_finite_number proc~scan_1d_array_for_nans->proc~is_finite_number

Called by

proc~~scan_1d_array_for_nans~~CalledByGraph proc~scan_1d_array_for_nans scan_1d_array_for_nans proc~construct_particles_std construct_particles_std proc~construct_particles_std->proc~scan_1d_array_for_nans proc~read_tov_sph_id read_tov_sph_id proc~read_tov_sph_id->proc~scan_1d_array_for_nans interface~construct_particles_std construct_particles_std interface~construct_particles_std->proc~construct_particles_std program~construct_newtonian_binary construct_newtonian_binary program~construct_newtonian_binary->proc~read_tov_sph_id interface~particles particles interface~particles->interface~construct_particles_std program~convergence_test convergence_test program~convergence_test->interface~particles program~sphincs_id sphincs_id program~sphincs_id->interface~particles

Contents


Variables

Type Visibility Attributes Name Initial
integer, public :: i

Source Code

  SUBROUTINE scan_1d_array_for_nans( array_size, array, name )

    !***********************************************
    !
    !# Test if a double precision is a finite number
    !
    !  FT 11.02.2022
    !
    !***********************************************

    INTEGER,                        INTENT(IN):: array_size
    DOUBLE PRECISION, DIMENSION(:), INTENT(IN):: array
    CHARACTER(LEN=*),               INTENT(IN):: name

    INTEGER:: i

    !$OMP PARALLEL DO DEFAULT( NONE ) &
    !$OMP             SHARED( array, array_size, name ) &
    !$OMP             PRIVATE( i )
    DO i= 1, array_size, 1

      IF(.NOT.is_finite_number(array(i)))THEN
        PRINT *, "** ERROR! The array ", name, "does not contain a finite", &
                 " number at position ", i
        PRINT *, " * ", name, "(", i, ")=", array(i)
        PRINT *
        STOP
      ENDIF

    ENDDO
    !$OMP END PARALLEL DO

  END SUBROUTINE scan_1d_array_for_nans