From 186be70b5d0e56cbe2274df1d7c465c36f1e4c3a Mon Sep 17 00:00:00 2001 From: zoziha Date: Wed, 12 Apr 2023 22:26:30 +0800 Subject: [PATCH] fortran_std=f2008 --- examples/example_hybrd1.f90 | 2 +- meson.build | 1 + test/test_chkder.f90 | 2 +- test/test_hybrd.f90 | 6 +++--- test/test_hybrj.f90 | 2 +- test/test_lmder.f90 | 10 +++++----- test/test_lmdif.f90 | 6 +++--- test/test_lmstr.f90 | 8 ++++---- 8 files changed, 19 insertions(+), 18 deletions(-) diff --git a/examples/example_hybrd1.f90 b/examples/example_hybrd1.f90 index bd5beb4..4c2b5a9 100644 --- a/examples/example_hybrd1.f90 +++ b/examples/example_hybrd1.f90 @@ -14,7 +14,7 @@ program example_hybrd1 integer,parameter :: n = 9 integer,parameter :: lwa = (n*(3*n+13))/2 - integer :: j, info + integer :: info real(wp) :: tol, fnorm real(wp) :: x(n), fvec(n), wa(lwa) diff --git a/meson.build b/meson.build index 7d5e9e8..84a0e24 100644 --- a/meson.build +++ b/meson.build @@ -6,6 +6,7 @@ project( default_options: [ 'default_library=both', 'buildtype=debugoptimized', + 'fortran_std=f2008', ], ) if get_option('api') diff --git a/test/test_chkder.f90 b/test/test_chkder.f90 index 776d8a8..a752bed 100644 --- a/test/test_chkder.f90 +++ b/test/test_chkder.f90 @@ -155,7 +155,7 @@ end function dfloat !> ! Get expected `diff` vectors for each case. - pure function solution(nprob) result(x) + function solution(nprob) result(x) implicit none diff --git a/test/test_hybrd.f90 b/test/test_hybrd.f90 index 9bd829d..3de3b4b 100644 --- a/test/test_hybrd.f90 +++ b/test/test_hybrd.f90 @@ -166,7 +166,7 @@ end function dfloat !> ! Get expected `x` vectors for each case. - pure function solution(nprob) result(x) + function solution(nprob) result(x) implicit none @@ -385,7 +385,7 @@ subroutine vecfcn(n, x, Fvec, Nprob) real(wp), parameter :: c8 = 5.0e-1_wp real(wp), parameter :: c9 = 2.9e1_wp - integer :: i, iev, ivar, j, k, k1, k2, kp1, ml, mu + integer :: i, iev, j, k, k1, k2, kp1, ml, mu real(wp) :: h, prod, sum, sum1, sum2, temp, temp1, & temp2, ti, tj, tk, tpi @@ -598,7 +598,7 @@ subroutine initpt(n, x, Nprob, Factor) !! the standard starting point. if factor is unity, no !! multiplication is performed. - integer :: ivar, j + integer :: j real(wp) :: h, tj real(wp), parameter :: zero = 0.0_wp diff --git a/test/test_hybrj.f90 b/test/test_hybrj.f90 index 2955cee..567947a 100644 --- a/test/test_hybrj.f90 +++ b/test/test_hybrj.f90 @@ -182,7 +182,7 @@ end function dfloat !> ! Get expected `x` vectors for each case. - pure function solution(nprob) result(x) + function solution(nprob) result(x) implicit none diff --git a/test/test_lmder.f90 b/test/test_lmder.f90 index 2ed31ac..5e5466b 100644 --- a/test/test_lmder.f90 +++ b/test/test_lmder.f90 @@ -28,7 +28,7 @@ program test_lmder 1,1,5,2,5,1,1,1,3,1,3,3,3,2,2,1,1,1,1,4,1,& 1,1,2,1,2,2,2,2,2,1,1] !! original `info` from the original minpack - integer :: i, ic, info, k, ldfjac, lwa, m, n, NFEv, NJEv, NPRob, ntries, icase, iunit + integer :: i, ic, info, k, ldfjac, lwa, m, n, NFEv, NJEv, NPRob, ntries, icase real(wp) :: factor, fnorm1, fnorm2 integer :: ma(53), na(53), nf(53), nj(53), np(53), nx(53) real(wp) :: fnm(53) @@ -196,7 +196,7 @@ end function dfloat !> ! Get expected `x` vectors for each case. - pure function solution(nprob) result(x) + function solution(nprob) result(x) implicit none @@ -376,7 +376,7 @@ subroutine ssqjac(m, n, x, Fjac, Ldfjac, Nprob) real(wp), parameter :: c45 = 45.0_wp real(wp), parameter :: c100 = 100.0_wp - integer :: i, ivar, j, k, mm1, nm1 + integer :: i, j, k, mm1, nm1 real(wp) :: div, dx, prod, s2, temp, ti, tmp1, tmp2, tmp3, tmp4, tpi Fjac(1:m, 1:n) = zero @@ -724,7 +724,7 @@ subroutine initpt(n, x, Nprob, Factor) real(wp), parameter :: c16 = 4.5_wp real(wp), parameter :: c17 = 5.5_wp - integer :: ivar, j + integer :: j real(wp) :: h x(1:n) = zero @@ -931,7 +931,7 @@ subroutine ssqfcn(m, n, x, Fvec, Nprob) real(wp),parameter :: c29 = 29.0_wp real(wp),parameter :: c45 = 45.0_wp - integer :: i, iev, ivar, j, nm1 + integer :: i, iev, j, nm1 real(wp) :: div, dx, prod, sum, s1, s2, temp, ti, & tmp1, tmp2, tmp3, tmp4, tpi diff --git a/test/test_lmdif.f90 b/test/test_lmdif.f90 index 978aae5..361a41d 100644 --- a/test/test_lmdif.f90 +++ b/test/test_lmdif.f90 @@ -179,7 +179,7 @@ end function dfloat !> ! Get expected `x` vectors for each case. - pure function solution(nprob) result(x) + function solution(nprob) result(x) implicit none @@ -394,7 +394,7 @@ subroutine ssqfcn(m, n, x, Fvec, Nprob) 7.1e-1_wp, 7.29e-1_wp, 7.2e-1_wp, 6.36e-1_wp, 5.81e-1_wp, 4.28e-1_wp, & 2.92e-1_wp, 1.62e-1_wp, 9.8e-2_wp, 5.4e-2_wp] - integer :: i, iev, ivar, j, nm1 + integer :: i, iev, j, nm1 real(wp) :: div, dx, prod, sum, s1, s2, temp, ti, tmp1, tmp2, tmp3, tmp4, tpi Fvec(1:m) = zero @@ -634,7 +634,7 @@ subroutine initpt(n, x, Nprob, Factor) real(wp),parameter :: c16 = 4.5_wp real(wp),parameter :: c17 = 5.5_wp - integer :: ivar, j + integer :: j real(wp) :: h x(1:n) = zero diff --git a/test/test_lmstr.f90 b/test/test_lmstr.f90 index 908b798..e977170 100644 --- a/test/test_lmstr.f90 +++ b/test/test_lmstr.f90 @@ -207,7 +207,7 @@ end function dfloat !> ! Get expected `x` vectors for each case. - pure function solution(nprob) result(x) + function solution(nprob) result(x) implicit none @@ -386,7 +386,7 @@ subroutine ssqjac(m, n, x, Fjac, Ldfjac, Nprob) real(wp),parameter :: v(11) = [4.0_wp, 2.0_wp, 1.0_wp, 5.0e-1_wp, 2.5e-1_wp, 1.67e-1_wp, & 1.25e-1_wp, 1.0e-1_wp, 8.33e-2_wp, 7.14e-2_wp, 6.25e-2_wp] - integer :: i, ivar, j, k, mm1, nm1 + integer :: i, j, k, mm1, nm1 real(wp) :: div, dx, prod, s2, temp, ti, tmp1, tmp2, tmp3, tmp4, tpi Fjac(1:m, 1:n) = zero @@ -680,7 +680,7 @@ subroutine initpt(n, x, Nprob, Factor) real(wp),parameter :: c16 = 4.5_wp real(wp),parameter :: c17 = 5.5_wp - integer :: ivar, j + integer :: j real(wp) :: h x(1:n) = zero @@ -870,7 +870,7 @@ subroutine ssqfcn(m, n, x, Fvec, Nprob) 7.1e-1_wp, 7.29e-1_wp, 7.2e-1_wp, 6.36e-1_wp, 5.81e-1_wp, 4.28e-1_wp, & 2.92e-1_wp, 1.62e-1_wp, 9.8e-2_wp, 5.4e-2_wp] - integer :: i, iev, ivar, j, nm1 + integer :: i, iev, j, nm1 real(wp) :: div, dx, prod, sum, s1, s2, temp, & ti, tmp1, tmp2, tmp3, tmp4, tpi