! M01NDF Example Program Text
! Mark 30.2 Release. NAG Copyright 2024.
Module m01ndfe_mod
! M01NDF Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: ex1, ex2
! .. Parameters ..
Integer, Parameter, Public :: nin = 5, nout = 6
Contains
Subroutine ex1(rv,n,m1,m2,item,m)
! Example 1: Calling M01NDF in direct search mode
! .. Use Statements ..
Use nag_library, Only: m01ndf
! .. Implicit None Statement ..
Implicit None
! .. Scalar Arguments ..
Integer, Intent (In) :: m, m1, m2, n
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (In) :: item(m), rv(n)
! .. Local Scalars ..
Real (Kind=nag_wp) :: h
Integer :: i, ifail, lk, mode
Logical :: valid
! .. Local Arrays ..
Integer :: dummy(1)
Integer, Allocatable :: idx(:), k(:)
! .. Executable Statements ..
Write (nout,*)
Write (nout,*)
Write (nout,*) 'Example 1'
Write (nout,*)
Allocate (idx(m))
! Stop if an error occurs
ifail = 0
! First call M01NDF with MODE=0 to calculate the necessary values for H
! and LK
mode = 0
lk = 1
! Validate input parameters the first time M01NDF is called
valid = .True.
! Note the use of DUMMY instead of K in the first call to M01NDF
Call m01ndf(valid,mode,rv,n,m1,m2,item,m,idx,h,dummy,lk,ifail)
! Allocate K using the value of LK returned in the previous call
Allocate (k(lk))
! There is no need to validate input parameters again
valid = .False.
! Call M01NDF again with MODE=4 to populate K and to search RV
mode = 4
Call m01ndf(valid,mode,rv,n,m1,m2,item,m,idx,h,k,lk,ifail)
Write (nout,99999)(item(i),idx(i),i=1,m)
Deallocate (idx,k)
99999 Format (1X,'Search for item ',F7.1,' returned index: ',I4)
End Subroutine ex1
Subroutine ex2(rv,n,m1,m2,item,m)
! Example 2: Calling M01NDF in binary search mode
! .. Use Statements ..
Use nag_library, Only: m01ndf
! .. Implicit None Statement ..
Implicit None
! .. Scalar Arguments ..
Integer, Intent (In) :: m, m1, m2, n
! .. Array Arguments ..
Real (Kind=nag_wp), Intent (In) :: item(m), rv(n)
! .. Local Scalars ..
Real (Kind=nag_wp) :: h
Integer :: i, ifail, lk, mode
Logical :: valid
! .. Local Arrays ..
Integer :: dummy(1)
Integer, Allocatable :: idx(:)
! .. Executable Statements ..
Write (nout,*)
Write (nout,*)
Write (nout,*) 'Example 2'
Write (nout,*)
Allocate (idx(m))
! Stop if an error occurs
ifail = 0
! Validate input parameters
valid = .True.
! Mode 3 does not use H or K
mode = 3
h = 0.0_nag_wp
lk = 1
! Make a single call to M01NDF to search RV for the ITEMs without
! using H or K
Call m01ndf(valid,mode,rv,n,m1,m2,item,m,idx,h,dummy,lk,ifail)
Write (nout,99999)(item(i),idx(i),i=1,m)
99999 Format (1X,'Search for item ',F7.1,' returned index: ',I4)
End Subroutine ex2
End Module m01ndfe_mod
Program m01ndfe
! M01NDF Example Main Program
! This example reads the data file once and then searches the same data
! twice using two different search algorithms.
! .. Use Statements ..
Use m01ndfe_mod, Only: ex1, ex2, nin, nout
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Integer :: i, m, m1, m2, n
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: item(:), rv(:)
! .. Executable Statements ..
Write (nout,*) 'M01NDF Example Program Results'
! Skip heading in data file
Read (nin,*)
! Read in example parameters
Read (nin,*) n, m1, m2
Read (nin,*) m
Allocate (rv(n),item(m))
! Read in vector to be searched
Read (nin,*)(rv(i),i=1,n)
Write (nout,*)
Write (nout,*) 'Vector to be searched is:'
Write (nout,99999)(rv(i),i=1,n)
! Read in items to search for
Read (nin,*)(item(i),i=1,m)
Call ex1(rv,n,m1,m2,item,m)
Call ex2(rv,n,m1,m2,item,m)
Deallocate (rv,item)
99999 Format (1X,8F7.1)
End Program m01ndfe