tester.f90

real,           dimension(2,6) :: a
complex,        dimension(2,4) :: b
double complex, dimension(2,3) :: c

real sdot, sdsdot, snrm2, sasum, scnrm2, scasum, slamch
real slange, clange, slansy, clansy
complex cdotu, cdotc
double complex zdotu, zdotc

a = transpose(reshape([1,3,2,4,3,5, 6,4,5,3,4,2],[6,2]))
b = transpose(reshape([(1,2),(3,4),(5,6),(7,8), (8,1),(7,2),(6,3),(5,4)],[4,2]))
c = transpose(reshape([(3,2),(2,4),(1,6), (4,6),(5,4),(6,2)],[3,2]))

write(*,*) 'If the return value interface is fixed, none of these values will'
write(*,*) 'be zero, nor will they be nonsensically large or small. On the'
write(*,*) 'other hand, if the translation is incorrect, it is more likely'
write(*,*) 'that this program will carsh.'
write(*,*) ' '

write(*,*) sdot(6,a(1,:),1,a(2,:),1), sdsdot(6,2.0,a(1,:),1,a(2,:),1), &
	snrm2(6,a(1,:),1), sasum(6,a(2,:),1)
write(*,*) cdotu(4,b(1,:),1,b(2,:),1), cdotc(4,b(1,:),1,b(2,:),1)
write(*,*) scnrm2(4,b(1,:),1), scasum(4,b(2,:),1)
write(*,*) zdotu(3,c(1,:),1,c(2,:),1)
write(*,*) zdotc(3,c(1,:),1,c(2,:),1)

write(*,*) slange('F',2,6,a,2,a),clange('F',2,4,b,2,b), &
	slansy('F','L',2,a,2,a),clansy('F','L',2,a,2,a)

write(*,*) ' '
write(*,*) 'These are the machine constants generated by SLAMCH. We expect'
write(*,*) 'some of them to be small (E-08,E-38).'
write(*,*) ' '

write(*,*) slamch('E'),slamch('S'),slamch('B')
write(*,*) slamch('P'),slamch('R'),slamch('M')
write(*,*) slamch('U'),slamch('L'),slamch('O')

end