median(3f) - [M_datapac:STATISTICS] compute the median of a data vector
SUBROUTINE MEDIAN(X,N,Iwrite,Xmed)
REAL(kind=wp) :: WS , X(:) , Xmed
INTEGER :: Iwrite , N
MEDIAN(3f) computes the sample median of the data in the input
vector X.
The sample median equals that value such that half the data set is
below it and half above it.
X The vector of (unsorted or sorted) observations.
N The integer number of observations in the vector X.
The maximum allowable value of N for this subroutine is 15000.
IWRITE An integer flag code which (if set to 0) will suppress the
printing of the sample median as it is computed; or (if set to
some integer value not equal to 0), like, say, 1) will cause
the printing of the sample median at the time it is computed.
XMED The value of the computed sample median.
Sample program:
program demo_median
use M_datapac, only : median, label
implicit none
character(len=*),parameter :: g='(*(g0,1x))'
real,allocatable :: x(:)
real :: xmed
integer :: iwrite , n
call label('median')
x=[ -10.0, 10.0, 0.0, 1.0, 2.0 ]
n=size(x)
call median(x, n, 1, xmed)
write(*,g)' median of',x,'is',xmed
x=[ 10.0, 20.0, 3.0, 40.0 ]
n=size(x)
call median(x, n, 1, xmed)
write(*,g)' median of',x,'is',xmed
end program demo_median
Results:
The sample median of the 5 observations is 0.10000000E+01
median of -10.00000 10.00000 .000000 1.000000 2.000000 is 1.000000
The sample median of the 4 observations is 0.15000000E+02
median of 10.00000 20.00000 3.000000 40.00000 is 15.00000
The original DATAPAC library was written by James Filliben of the
Statistical Engineering Division, National Institute of Standards
and Technology.
John Urban, 2022.05.31
CC0-1.0
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
real(kind=wp) | :: | X(:) | ||||
integer | :: | N | ||||
integer | :: | Iwrite | ||||
real(kind=wp) | :: | Xmed |
Type | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|
real | :: | WS(15000) |
SUBROUTINE MEDIAN(X,N,Iwrite,Xmed) REAL(kind=wp) :: hold , WS , X(:) , Xmed , Y(15000) INTEGER :: i , iflag , iupper , Iwrite , N , nmid , nmidp1 COMMON /BLOCK2_real64/ WS(15000) EQUIVALENCE (Y(1),WS(1)) ! iupper = 15000 ! ! CHECK THE INPUT ARGUMENTS FOR ERRORS ! IF ( N<1 .OR. N>iupper ) THEN WRITE (G_IO,99001) iupper 99001 FORMAT (& & ' ***** FATAL ERROR--The second input argument to MEDIAN(3f) is outside the allowable (1,',I0,') interval *****') WRITE (G_IO,99002) N 99002 FORMAT (' ','***** The value of the argument is ',I0,' *****') RETURN ELSE IF ( N==1 ) THEN WRITE (G_IO,99003) 99003 FORMAT (' ',& & '***** NON-FATAL DIAGNOSTIC--The second input argument to MEDIAN(3f) has the value 1 *****') Xmed = X(1) ELSE hold = X(1) DO i = 2 , N IF ( X(i)/=hold ) GOTO 50 ENDDO WRITE (G_IO,99004) hold 99004 FORMAT (' ',& & '***** NON-FATAL DIAGNOSTIC--the first input argument (a vector) to MEDIAN(3f) has all elements = ',g0,' *****') Xmed = X(1) ENDIF GOTO 100 ! !-----START POINT----------------------------------------------------- ! 50 CALL SORT(X,N,Y) iflag = N - (N/2)*2 nmid = N/2 nmidp1 = nmid + 1 IF ( iflag==0 ) Xmed = (Y(nmid)+Y(nmidp1))/2.0_wp IF ( iflag==1 ) Xmed = Y(nmidp1) ENDIF ! 100 IF ( Iwrite==0 ) RETURN WRITE (G_IO,99005) 99005 FORMAT (' ') WRITE (G_IO,99006) N , Xmed 99006 FORMAT (' The sample median of the ',I0,' observations is ', g0) END SUBROUTINE MEDIAN