- #1

winiepu

- 3

- 0

module nrtype

INTEGER, PARAMETER :: SP = KIND(1.0)

INTEGER, PARAMETER :: DP = KIND(1.0D0)

INTEGER, PARAMETER :: I4B = SELECTED_INT_KIND(9)

INTEGER, PARAMETER :: I2B = SELECTED_INT_KIND(4)

INTEGER, PARAMETER :: I1B = SELECTED_INT_KIND(2)

END module

program mainp

use nrtype

implicit none

call xlocate

end program

subroutine xlocate

USE nrtype

IMPLICIT NONE

!INTEGER(I4B), PARAMETER :: n=3

INTEGER(I4B) :: i,j

REAL(DP) :: x

REAL(DP), DIMENSION(4) :: xx

REAL(DP), DIMENSION(2):: xlim,ab

!real(DP), external:: mylocate1

xx=(/1.0_DP,2.0_DP,3.0_DP,4.0_DP/)

x=1.5_DP

CALL mylocate(xx,x,xlim,ab)

write(*,*) ab

END subroutine xlocate

SUBROUTINE mylocate(xx,x,xlim,ab)

USE nrtype

IMPLICIT NONE

REAL(DP), DIMENSION(2), INTENT(OUT):: xlim, ab

REAL(DP), DIMENSION(:), INTENT(IN) :: xx

REAL(DP), INTENT(IN) :: x

INTEGER(I4B) :: k

INTEGER(I4B) :: n,jl,jm,ju

LOGICAL(I4B) :: ascnd

REAL(DP)::h

n=SIZE(xx)

ascnd = (xx(n) >= xx(1))

jl=0

ju=n+1

DO

IF (ju-jl <= 1) EXIT

jm=(ju+jl)/2

IF (ascnd .EQV. (x >= xx(jm))) THEN

jl=jm

ELSE

ju=jm

END IF

END DO

IF (x == xx(1)) THEN

k=1

ELSE IF (x == xx(n)) THEN

k=n-1

ELSE

k=jl

END IF

h=xx(k+1)-xx(k);

ab(1)=(xx(k+1)-x)/h;

ab(2)=(x-xx(k))/h;

xlim(1)=k;

xlim(2)=k+1;

END SUBROUTINE mylocate