!
!=======================================================================
!
MODULE TOOLS
!
      USE ACCURACY_REAL
!
CONTAINS
!
!
!=======================================================================
!
      SUBROUTINE TRUNCATE(F,N_F,N_G)
!
!  This subroutine takes an function array F of length N_F
!    and truncates it to length N_G to suppress zero values 
!    when f(x) tends to zero with increasing x.
!
!  It is particularly useful when f(x) in an integrand function
!
!
!  Input parameters:
!
!       * F        : the function array
!       * N_F      : the size of the F array
!
!
!  Outut parameters:
!
!       * N_G      : the size of the truncated array
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  6 Nov 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,SMALL,INF,MIC
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)    :: N_F
      INTEGER, INTENT(OUT)   :: N_G
!
      INTEGER                :: I            ! loop index
      INTEGER                :: I_T          ! threshold index
      INTEGER                :: I_M          ! index of maximum
!
      REAL (WP), INTENT(IN)  :: F(N_F)
!
      REAL (WP)              :: F_MIN,F_MAX
      REAL (WP)              :: F_CUT
!
      REAL (WP), PARAMETER   :: F_SCA = 1.0E+4_WP            
!
      I_T = 1                                                       !
      I_M = 1                                                       !
!
!  Computing the min and max of f(x)
!
      F_MIN = INF                                                   !
      F_MAX = MIC                                                   !
!
      DO I = 1, N_F                                                 !
        F_MIN = MIN(F(I),F_MIN)                                     !
        F_MAX = MAX(F(I),F_MAX)                                     !
      END DO                                                        !
!
!  Computing the index max of f(x)
!
      DO I = 1, N_F                                                 !
        IF( ABS(F_MAX - F(I)) / F_MAX <= SMALL ) THEN               !
          I_M = I                                                   !
          GO TO 10                                                  !
        END IF                                                      !
      END DO                                                        !
  10  CONTINUE                                                      !
!
!  Computing the threshold value F_CUT
!
      F_CUT = MAX(F_MAX,ABS(F_MIN)) / F_SCA                         !
!
!  Finding the first value below threshold
!
      DO I = 1, N_F                                                 !
        IF(ABS(F(I) <= F_CUT) THEN                                  !
          I_T = I                                                   !
          GO TO 20                                                  !
      END DO                                                        !
  20  CONTINUE                                                      !
!
      END SUBROUTINE TRUNCATE
!
END MODULE TOOLS