96 lines
3.0 KiB
Fortran
96 lines
3.0 KiB
Fortran
|
!
|
||
|
|
!=======================================================================
|
||
|
|
!
|
||
|
|
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
|