starting to modernize the examples

examples/example_hybrd.f90

@@ -5,52 +5,41 @@
 !> -x(8) + (3-2*x(9))*x(9) = -1
 program example_hybrd
 
- use minpack_module, only: hybrd, enorm, dpmpar
- implicit none
- integer j, n, maxfev, ml, mu, mode, nprint, info, nfev, ldfjac, lr, nwrite
- double precision xtol, epsfcn, factor, fnorm
- double precision x(9), fvec(9), diag(9), fjac(9, 9), r(45), qtf(9), &
- wa1(9), wa2(9), wa3(9), wa4(9)
-
- !> Logical output unit is assumed to be number 6.
- data nwrite/6/
+ use minpack_module, only: wp, hybrd, enorm, dpmpar
+ use iso_fortran_env, only: nwrite => output_unit
 
- n = 9
-
- !> The following starting values provide a rough solution.
- do j = 1, 9
- x(j) = -1.0d0
- end do
+ implicit none
 
- ldfjac = 9
- lr = 45
+ integer,parameter :: n = 9
+ integer,parameter :: ldfjac = n
+ integer,parameter :: lr = (n*(n+1))/2
 
- !> Set xtol to the square root of the machine precision.
- !> unless high precision solutions are required,
- !> this is the recommended setting.
- xtol = dsqrt(dpmpar(1))
+ integer :: maxfev, ml, mu, mode, nprint, info, nfev
+ real(wp) :: epsfcn, factor, fnorm, xtol
+ real(wp) :: x(n), fvec(n), diag(n), fjac(n, n), r(lr), qtf(n), &
+  wa1(n), wa2(n), wa3(n), wa4(n)
 
+ xtol = dsqrt(dpmpar(1)) ! square root of the machine precision.
  maxfev = 2000
  ml = 1
  mu = 1
- epsfcn = 0.0d0
+ epsfcn = 0.0_wp
  mode = 2
- do j = 1, 9
- diag(j) = 1.0d0
- end do
- factor = 1.0d2
+ factor = 100.0_wp
  nprint = 0
+ diag = 1.0_wp
+ x = -1.0_wp ! starting values to provide a rough solution.
 
  call hybrd(fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, &
  mode, factor, nprint, info, nfev, fjac, ldfjac, &
  r, lr, qtf, wa1, wa2, wa3, wa4)
  fnorm = enorm(n, fvec)
- write (nwrite, 1000) fnorm, nfev, info, (x(j), j=1, n)
 
-1000 format(5x, "FINAL L2 NORM OF THE RESIDUALS", d15.7// &
- 5x, "NUMBER OF FUNCTION EVALUATIONS", i10// &
- 5x, "EXIT PARAMETER", 16x, i10// &
- 5x, "FINAL APPROXIMATE SOLUTION"//(5x, 3d15.7))
+ write (nwrite, '(5x,a,d15.7//5x,a,i10//5x,a,16x,i10//5x,a//(5x,3d15.7))') &
+ "FINAL L2 NORM OF THE RESIDUALS", fnorm, &
+ "NUMBER OF FUNCTION EVALUATIONS", nfev, &
+ "EXIT PARAMETER", info, &
+ "FINAL APPROXIMATE SOLUTION", x
 
  !> Results obtained with different compilers or machines
  !> may be slightly different.
@@ -75,28 +64,29 @@ subroutine fcn(n, x, fvec, iflag)
  implicit none
  integer, intent(in) :: n
  integer, intent(inout) :: iflag
- double precision, intent(in) :: x(n)
- double precision, intent(out) :: fvec(n)
-
- integer k
- double precision one, temp, temp1, temp2, three, two, zero
- data zero, one, two, three/0.0d0, 1.0d0, 2.0d0, 3.0d0/
-
- if (iflag /= 0) go to 5
-
- !! Insert print statements here when nprint is positive.
-
- return
-5 continue
- do k = 1, n
- temp = (three - two*x(k))*x(k)
- temp1 = zero
- if (k /= 1) temp1 = x(k - 1)
- temp2 = zero
- if (k /= n) temp2 = x(k + 1)
- fvec(k) = temp - temp1 - two*temp2 + one
- end do
- return
+ real(wp), intent(in) :: x(n)
+ real(wp), intent(out) :: fvec(n)
+
+ integer :: k !! counter
+ real(wp) :: temp, temp1, temp2
+
+ real(wp),parameter :: zero = 0.0_wp
+ real(wp),parameter :: one = 1.0_wp
+ real(wp),parameter :: two = 2.0_wp
+ real(wp),parameter :: three = 3.0_wp
+
+ if (iflag == 0) then
+ !! Insert print statements here when nprint is positive.
+ else
+ do k = 1, n
+ temp = (three - two*x(k))*x(k)
+ temp1 = zero
+ if (k /= 1) temp1 = x(k - 1)
+ temp2 = zero
+ if (k /= n) temp2 = x(k + 1)
+ fvec(k) = temp - temp1 - two*temp2 + one
+ end do
+ end if
 
  end subroutine fcn
 

examples/example_hybrd1.f90

@@ -6,11 +6,11 @@
 !> -x(8) + (3-2*x(9))*x(9) = -1
 program example_hybrd1
 
- use minpack_module, only: hybrd1, dpmpar, enorm
+ use minpack_module, only: wp, hybrd1, dpmpar, enorm
  implicit none
  integer j, n, info, lwa, nwrite
- double precision tol, fnorm
- double precision x(9), fvec(9), wa(180)
+ real(wp) tol, fnorm
+ real(wp) x(9), fvec(9), wa(180)
 
  !> Logical output unit is assumed to be number 6.
  data nwrite/6/
@@ -59,11 +59,11 @@ subroutine fcn(n, x, fvec, iflag)
  implicit none
  integer, intent(in) :: n
  integer, intent(inout) :: iflag
- double precision, intent(in) :: x(n)
- double precision, intent(out) :: fvec(n)
+ real(wp), intent(in) :: x(n)
+ real(wp), intent(out) :: fvec(n)
 
  integer k
- double precision one, temp, temp1, temp2, three, two, zero
+ real(wp) one, temp, temp1, temp2, three, two, zero
  data zero, one, two, three/0.0d0, 1.0d0, 2.0d0, 3.0d0/
 
  do k = 1, n