Test program for array_mod
Test mixval to verify operation
Test mixval to verify operation
Test mixval to verify operation
Test deDup to verify operation
Test linspace to verify operation
Test meshGridX and meshGridY to verify operation
Test linearInterp to verify operation
Test TDMA to verify operation
Test solveLU to verify operation
program testArray_prg
!! Test program for array_mod
use kinds_mod
use array_mod
implicit none
call testMixval
call testSpan
call testFlatten
call testDeDup
call testLinspace
call testMeshGrid
call testLinearInterp
call testTDMA
call testLU
contains
subroutine testMixval
!! Test mixval to verify operation
logical,dimension(1)::results
integer,parameter::N = 10
real(wp),dimension(N)::x
real(wp),dimension(2)::test,true
call random_number(x)
test = mixval(x)
true = [minval(x),maxval(x)]
results(1) = all(test==true)
if( .not.all(results) ) error stop "Failed mixval check"
end subroutine testMixval
subroutine testSpan
!! Test mixval to verify operation
logical,dimension(1)::results
integer,parameter::N = 10
real(wp),dimension(N)::x
real(wp)::test,true
call random_number(x)
test = span(x)
true = maxval(x)-minval(x)
results(1) = test==true
if( .not.all(results) ) error stop "Failed span check"
end subroutine testSpan
subroutine testFlatten
!! Test mixval to verify operation
logical,dimension(1)::results
integer,parameter::N = 3
integer,parameter::M = 4
real(wp),dimension(N,M)::x
real(wp),dimension(N*M)::y
call random_number(x)
y = flatten(x)
results(1) = all( abs(y-reshape(x,[N*M]))<2.0_wp**4*epsilon(1.0_wp) )
if( .not.all(results) ) error stop "Failed flatten check"
end subroutine testFlatten
subroutine testDeDup
!! Test deDup to verify operation
logical,dimension(1)::results
results(1) = all( deDup([1,1,2,3,2,4])==[1,2,3,4] )
if( .not.all(results) ) error stop "Failed deDup check"
end subroutine testDeDup
subroutine testLinspace
!! Test linspace to verify operation
logical,dimension(1)::results
real(wp),dimension(:),allocatable::x,y
integer::N,k
N = 100
x = linspace(0.0_wp,1.0_wp,N)
y = [( real(k-1,wp)/real(N-1,wp) , k=1,N )]
results(1) = norm2(x-y)<1.0E-10_wp
if( .not.all(results) ) error stop "Failed linspace check"
end subroutine testLinspace
subroutine testMeshGrid
!! Test meshGridX and meshGridY to verify operation
logical,dimension(6)::results
real(wp),dimension(:),allocatable::x,y
real(wp),dimension(:,:),allocatable::XX,YY
integer::N,M
N = 5
M = 6
x = linspace(0.0_wp,1.0_wp,N)
y = linspace(0.0_wp,1.0_wp,M)
XX = meshGridX(x,y)
YY = meshGridY(x,y)
results(1) = all(XX(:,1)==x)
results(2) = all(YY(1,:)==y)
results(3) = all(XX(:,1)==XX(:,M))
results(4) = all(YY(1,:)==YY(N,:))
results(5) = all(shape(XX)==[N,M])
results(6) = all(shape(YY)==[N,M])
if( .not.all(results) ) error stop "Failed linspace check"
end subroutine testMeshGrid
subroutine testLinearInterp
!! Test linearInterp to verify operation
logical,dimension(1)::results
real(wp),dimension(:),allocatable::x1,x2,y
integer::N,k
N = 100
x1 = linspace(0.0_wp,5.0_wp,N)
x2 = linspace(0.0_wp,5.0_wp,N/4)
allocate(y(N))
do k=1,N
y(k) = linearInterp(x1(k),x2,2.0_wp*x2)
end do
results(1) = norm2(y-2.0_wp*x1)<1.0E-10_wp
if( .not.all(results) ) error stop "Failed linearInterp check"
end subroutine testLinearInterp
subroutine testTDMA
!! Test TDMA to verify operation
real(wp),dimension(:,:),allocatable::A
real(wp),dimension(:),allocatable::b,x,xt
integer::N,k
N = 10
allocate( A(N,-1:+1) , x(N) , b(N) )
xt = linspace(0.0_wp,1.0_wp,N)
A(1,-1:+1) = [0.0_wp,1.0_wp,0.0_wp]
b( 1 ) = 0.0_wp
do k=2,N-1
A(k,-1) = 1.0_wp
A(k, 0) = -2.0_wp
A(k,+1) = 1.0_wp
b( k ) = 0.0_wp
end do
A(N,-1:+1) = [0.0_wp,1.0_wp,0.0_wp]
b( N ) = 1.0_wp
x = TDMA(A,b)
do k=1,N
write(*,*) xt(k),x(k)
end do
write(*,*) norm2(xt-x)
end subroutine testTDMA
subroutine testLU
!! Test solveLU to verify operation
real(wp),dimension(:,:),allocatable::A
real(wp),dimension(:),allocatable::x,b,bc
integer::N
do N=2,100
if(allocated(A)) deallocate(A)
if(allocated(b)) deallocate(b)
allocate( A(N,N) , b(N) )
call random_number(A)
call random_number(b)
x = solveLU(A,b)
bc = matmul(A,x)
if( norm2(bc-b)>1.0E-10_wp ) stop 'solveLU Failed'
end do
end subroutine testLU
end program testArray_prg