Description
I'm trying to test out templates. I'm using Brad Richardson's tutorial examples as a starting point.
I get the following message in the output windows when using LFortran.
syntax error: Newline is unexpected here
--> input:241:33
|
241 | instantiate sort_template(sp)
| ^
Note: Please report unclear or confusing messages as bugs at
https://github.com/lfortran/lfortran/issues.
Compilation Time: 13.599999904632568 ms
Here is the complete source code.
!#################################
! Templated sort routine
!
! This is based on the pre Fortran 2028
! syntax for a generic sorting module.
!
!#################################
! include 'integer_kind_module.f90'
module integer_kind_module
implicit none
integer, parameter :: i8 = selected_int_kind(2)
integer, parameter :: i16 = selected_int_kind(4)
integer, parameter :: i32 = selected_int_kind(9)
integer, parameter :: i64 = selected_int_kind(15)
end module
!#################################
! include 'precision_module.f90'
module precision_module
implicit none
!
! Updated with the release of Nag 7 which
! supports 16 bit reals.
!
! single, double, quad naming used by lapack.
! hence sp, dp, qp
!
! we have used hp as half precision
!
! integer, parameter :: hp = selected_real_kind( 3, 4)
integer, parameter :: sp = selected_real_kind( 6, 37)
integer, parameter :: dp = selected_real_kind(15, 307)
integer, parameter :: qp = selected_real_kind(30, 291)
end module
!#################################
! include 'timing_module.f90'
module timing_module
use integer_kind_module
use precision_module
implicit none
integer, dimension (8), private :: dt
real (dp) :: r_count
real (dp) :: r_count_rate
real (dp) :: start_time = 0.0_dp
real (dp) :: end_time = 0.0_dp
real (dp) :: last_time = 0.0_dp
real (dp) :: total_time = 0.0_dp
real (dp) :: difference = 0.0_dp
integer (i64) :: count,count_rate,count_max
integer (i64) , parameter :: nag_count_rate = 10000000
integer (i64) , parameter :: gfortran_count_rate = 1000000000
integer (i64) , parameter :: intel_count_rate = 1000000
contains
subroutine start_timing()
implicit none
call date_and_time(values=dt)
100 format (1x, i4, '/', i2, '/', i2, 1x, i2, ':', i2, ':', i2, 1x, i3)
print 100, dt(1:3), dt(5:8)
call system_clock(count,count_rate,count_max)
r_count = count
r_count_rate = count_rate
start_time = r_count/r_count_rate
last_time = start_time
end subroutine start_timing
subroutine end_timing()
implicit none
call date_and_time(values=dt)
print 100, dt(1:3), dt(5:8)
100 format (1x, i4, '/', i2, '/', i2, 1x, i2, ':', i2, ':', i2, 1x, i3)
call system_clock(count,count_rate,count_max)
r_count = count
end_time = r_count/r_count_rate
total_time = end_time - start_time
print 200,total_time
200 format(' Total time = ',12x,f18.6)
end subroutine end_timing
subroutine print_time_difference()
implicit none
call system_clock(count,count_rate,count_max)
r_count = count
end_time = r_count/r_count_rate
difference = end_time - last_time
last_time = end_time
print 100, difference
100 format(' Time difference = ',f18.6)
end subroutine print_time_difference
function time_difference()
implicit none
real (dp) :: time_difference
call system_clock(count,count_rate,count_max)
r_count = count
end_time = r_count/r_count_rate
time_difference = end_time - last_time
last_time = end_time
end function time_difference
end module
!#################################
module sort_template_module
template sort_template(k)
! use precision_module
! use integer_kind_module
private
public :: sort
integer, parameter :: k
contains
subroutine sort(x, n)
use precision_module
use integer_kind_module
type(k) , intent(inout) :: x(:)
integer , intent(in) :: n
call quicksort(1, n)
contains
recursive subroutine quicksort(l, r)
implicit none
integer, intent (in) :: l, r
integer :: i, j
type (k) :: v, t
! used to include the common sorting code
! include 'quicksort_include_code.f90'
i = l
j = r
v = x(int((l+r)/2))
do
do while (x(i)<v)
i = i + 1
end do
do while (v<x(j))
j = j - 1
end do
if (i<=j) then
t = x(i)
x(i) = x(j)
x(j) = t
i = i + 1
j = j - 1
end if
if (i>j) exit
end do
if (l<j) then
call quicksort(l, j)
end if
if (i<r) then
call quicksort(i, r)
end if
end subroutine
end subroutine
end template
end module
!#################################
program test
use precision_module
use integer_kind_module
use timing_module
use sort_template_module
implicit none
integer, parameter :: n = 1000
character (12) :: nn = '1,000'
character (80) :: report_file_name = 'ch3801_report.txt'
real (sp), allocatable, dimension (:) :: x_sp
real (sp), allocatable, dimension (:) :: t_x_sp
real (dp), allocatable, dimension (:) :: x_dp
real (dp), allocatable, dimension (:) :: t_x_dp
real (qp), allocatable, dimension (:) :: x_qp
integer (i32), allocatable, dimension (:) :: y_i32
integer (i64), allocatable, dimension (:) :: y_i64
instantiate sort_template(sp)
instantiate sort_template(dp)
instantiate sort_template(qp)
instantiate sort_template(i32)
instantiate sort_template(i64)
integer :: allocate_status = 0
character (20), dimension (5) :: heading1 = &
[ ' 32 bit real', &
' 32 bit int ', &
' 64 bit real', &
' 64 bit int ', &
' 128 bit real' ]
character (20), dimension (3) :: &
heading2 = [ ' Allocate ', &
' Random ', &
' Sort ' ]
print *, 'Program starts'
print *, 'N = ', nn
call start_timing()
open (unit=100, file=report_file_name)
print *, heading1(1)
allocate (x_sp(1:n), stat=allocate_status)
if (allocate_status/=0) then
print *, ' Allocate failed. Program terminates'
stop 10
end if
print 100, heading2(1), time_difference()
100 format (a20, 2x, f18.6)
call random_number(x_sp)
t_x_sp = x_sp
print 100, heading2(2), time_difference()
call sort_data(x_sp, n)
print 100, heading2(3), time_difference()
write (unit=100, fmt='(a)') ' First 10 32 bit reals'
write (unit=100, fmt=110) x_sp(1:10)
110 format (5(2x,e14.6))
print *, heading1(2)
allocate (y_i32(1:n), stat=allocate_status)
if (allocate_status/=0) then
print *, 'Allocate failed. Program terminates'
stop 30
end if
print 100, heading2(1), time_difference()
y_i32 = int(t_x_sp*1000000000, i32)
deallocate (x_sp)
deallocate (t_x_sp)
print 100, heading2(2), time_difference()
call sort_data(y_i32, n)
print 100, heading2(3), time_difference()
write (unit=100, fmt='(a)') 'First 10 32 bit integers'
write (unit=100, fmt=120) y_i32(1:10)
120 format (5(2x,i10))
deallocate (y_i32)
print *, heading1(3)
allocate (x_dp(1:n), stat=allocate_status)
if (allocate_status/=0) then
print *, 'Allocate failed. Program terminates'
stop 30
end if
allocate (t_x_dp(1:n), stat=allocate_status)
if (allocate_status/=0) then
print *, 'Allocate failed. Program terminates'
stop 40
end if
print 100, heading2(1), time_difference()
call random_number(x_dp)
t_x_dp = x_dp
print 100, heading2(2), time_difference()
call sort_data(x_dp, n)
print 100, heading2(3), time_difference()
write (unit=100, fmt='(a)') 'First 10 64 bit reals'
write (unit=100, fmt=110) x_dp(1:10)
print *, heading1(4)
allocate (y_i64(1:n), stat=allocate_status)
if (allocate_status/=0) then
print *, 'Allocate failed. Program terminates'
stop 40
end if
print 100, heading2(1), time_difference()
y_i64 = int(t_x_dp*1000000000000000_i64, i64)
deallocate (x_dp)
deallocate (t_x_dp)
print 100, heading2(2), time_difference()
call sort_data(y_i64, n)
print 100, heading2(3), time_difference()
write (unit=100, fmt='(a)') 'First 10 64 bit integers'
write (unit=100, fmt=120) y_i64(1:10)
deallocate (y_i64)
print *, heading1(5)
allocate (x_qp(1:n), stat=allocate_status)
if (allocate_status/=0) then
print *, 'Allocate failed. Program terminates'
stop 50
end if
print 100, heading2(1), time_difference()
call random_number(x_qp)
print 100, heading2(2), time_difference()
call sort_data(x_qp, n)
print 100, heading2(3), time_difference()
write (unit=100, fmt='(a)') 'First 10 128 bitreals'
write (unit=100, fmt=110) x_qp(1:10)
close (200)
print *, 'Program terminates'
call end_timing()
end program