From 216b0de9a865d9dd58b0e62d2e1f7caa908d5ea3 Mon Sep 17 00:00:00 2001 From: Vincent Vanlaer Date: Mon, 29 Jul 2024 22:02:16 -0400 Subject: [PATCH 1/4] num: set free form test files extension to f90 --- num/test/make/makefile_base | 19 ++----------------- ...ple_ode_solver.f => sample_ode_solver.f90} | 0 num/test/src/{test_beam.f => test_beam.f90} | 0 .../src/{test_bobyqa.f => test_bobyqa.f90} | 0 num/test/src/{test_brent.f => test_brent.f90} | 0 .../{test_chemakzo.f => test_chemakzo.f90} | 0 .../{test_diffusion.f => test_diffusion.f90} | 0 ...est_int_support.f => test_int_support.f90} | 0 .../{test_integrate.f => test_integrate.f90} | 0 .../src/{test_medakzo.f => test_medakzo.f90} | 0 .../src/{test_newton.f => test_newton.f90} | 0 .../src/{test_newuoa.f => test_newuoa.f90} | 0 num/test/src/{test_num.f => test_num.f90} | 0 num/test/src/{test_pollu.f => test_pollu.f90} | 0 .../src/{test_simplex.f => test_simplex.f90} | 0 .../src/{test_support.f => test_support.f90} | 0 num/test/src/{test_vdpol.f => test_vdpol.f90} | 0 17 files changed, 2 insertions(+), 17 deletions(-) rename num/test/src/{sample_ode_solver.f => sample_ode_solver.f90} (100%) rename num/test/src/{test_beam.f => test_beam.f90} (100%) rename num/test/src/{test_bobyqa.f => test_bobyqa.f90} (100%) rename num/test/src/{test_brent.f => test_brent.f90} (100%) rename num/test/src/{test_chemakzo.f => test_chemakzo.f90} (100%) rename num/test/src/{test_diffusion.f => test_diffusion.f90} (100%) rename num/test/src/{test_int_support.f => test_int_support.f90} (100%) rename num/test/src/{test_integrate.f => test_integrate.f90} (100%) rename num/test/src/{test_medakzo.f => test_medakzo.f90} (100%) rename num/test/src/{test_newton.f => test_newton.f90} (100%) rename num/test/src/{test_newuoa.f => test_newuoa.f90} (100%) rename num/test/src/{test_num.f => test_num.f90} (100%) rename num/test/src/{test_pollu.f => test_pollu.f90} (100%) rename num/test/src/{test_simplex.f => test_simplex.f90} (100%) rename num/test/src/{test_support.f => test_support.f90} (100%) rename num/test/src/{test_vdpol.f => test_vdpol.f90} (100%) diff --git a/num/test/make/makefile_base b/num/test/make/makefile_base index 0e379c86c..e0f20c6b8 100644 --- a/num/test/make/makefile_base +++ b/num/test/make/makefile_base @@ -82,22 +82,6 @@ COMPILE_NC = $(FC) $(FCbasic) $(FCopenmp) $(FCstatic) $(FCopt) $(FCfixed) $(TEST COMPILE_LEGACY_NC = $(filter-out -std=f2008, $(COMPILE_NC)) -std=legacy TEST_COMPILE_LEGACY = $(filter-out -std=f2008, $(TEST_COMPILE)) -std=legacy -test_brent.o test_simplex.o : %.o : %.f -ifneq ($(QUIET),) - @echo TEST_COMPILE_LEGACY $< - @$(TEST_COMPILE_LEGACY) $(FCfree) $< -else - $(TEST_COMPILE_LEGACY) $(FCfree) $< -endif - -test_bobyqa.o test_newuoa.o : %.o : %.f -ifneq ($(QUIET),) - @echo TEST_COMPILE_LEGACY $< - @$(TEST_COMPILE_LEGACY) $(FCfixed) $< -else - $(TEST_COMPILE_LEGACY) $(FCfixed) $< -endif - bari_vdpol.o bari_vdpol3.o bari_vdpol_x.o bari_vdpol3_x.o bari_medakzo.o bari_hires.o \ bari_pollu.o bari_rober.o bari_beam.o bari_chemakzo.o : %.o : %.f ifneq ($(QUIET),) @@ -107,7 +91,7 @@ else $(COMPILE_LEGACY_NC) $< endif -%.o: %.f +%.o: %.f90 ifneq ($(QUIET),) @echo TEST_COMPILE_LEGACY $< @$(TEST_COMPILE_LEGACY) $(FCfree) $< @@ -122,6 +106,7 @@ endif SRC_PATH = $(TEST_SRC_DIR) vpath %.f $(SRC_PATH) +vpath %.f90 $(SRC_PATH) vpath %.mod $(LOCAL_LIB_DIR):$(MESA_DIR)/include diff --git a/num/test/src/sample_ode_solver.f b/num/test/src/sample_ode_solver.f90 similarity index 100% rename from num/test/src/sample_ode_solver.f rename to num/test/src/sample_ode_solver.f90 diff --git a/num/test/src/test_beam.f b/num/test/src/test_beam.f90 similarity index 100% rename from num/test/src/test_beam.f rename to num/test/src/test_beam.f90 diff --git a/num/test/src/test_bobyqa.f b/num/test/src/test_bobyqa.f90 similarity index 100% rename from num/test/src/test_bobyqa.f rename to num/test/src/test_bobyqa.f90 diff --git a/num/test/src/test_brent.f b/num/test/src/test_brent.f90 similarity index 100% rename from num/test/src/test_brent.f rename to num/test/src/test_brent.f90 diff --git a/num/test/src/test_chemakzo.f b/num/test/src/test_chemakzo.f90 similarity index 100% rename from num/test/src/test_chemakzo.f rename to num/test/src/test_chemakzo.f90 diff --git a/num/test/src/test_diffusion.f b/num/test/src/test_diffusion.f90 similarity index 100% rename from num/test/src/test_diffusion.f rename to num/test/src/test_diffusion.f90 diff --git a/num/test/src/test_int_support.f b/num/test/src/test_int_support.f90 similarity index 100% rename from num/test/src/test_int_support.f rename to num/test/src/test_int_support.f90 diff --git a/num/test/src/test_integrate.f b/num/test/src/test_integrate.f90 similarity index 100% rename from num/test/src/test_integrate.f rename to num/test/src/test_integrate.f90 diff --git a/num/test/src/test_medakzo.f b/num/test/src/test_medakzo.f90 similarity index 100% rename from num/test/src/test_medakzo.f rename to num/test/src/test_medakzo.f90 diff --git a/num/test/src/test_newton.f b/num/test/src/test_newton.f90 similarity index 100% rename from num/test/src/test_newton.f rename to num/test/src/test_newton.f90 diff --git a/num/test/src/test_newuoa.f b/num/test/src/test_newuoa.f90 similarity index 100% rename from num/test/src/test_newuoa.f rename to num/test/src/test_newuoa.f90 diff --git a/num/test/src/test_num.f b/num/test/src/test_num.f90 similarity index 100% rename from num/test/src/test_num.f rename to num/test/src/test_num.f90 diff --git a/num/test/src/test_pollu.f b/num/test/src/test_pollu.f90 similarity index 100% rename from num/test/src/test_pollu.f rename to num/test/src/test_pollu.f90 diff --git a/num/test/src/test_simplex.f b/num/test/src/test_simplex.f90 similarity index 100% rename from num/test/src/test_simplex.f rename to num/test/src/test_simplex.f90 diff --git a/num/test/src/test_support.f b/num/test/src/test_support.f90 similarity index 100% rename from num/test/src/test_support.f rename to num/test/src/test_support.f90 diff --git a/num/test/src/test_vdpol.f b/num/test/src/test_vdpol.f90 similarity index 100% rename from num/test/src/test_vdpol.f rename to num/test/src/test_vdpol.f90 From e2beeade2d359a80aafccff8f16a76968a8c9f73 Mon Sep 17 00:00:00 2001 From: Vincent Vanlaer Date: Mon, 29 Jul 2024 22:25:55 -0400 Subject: [PATCH 2/4] num: make test src f2008 standard compliant --- num/test/make/makefile_base | 11 +-- num/test/src/bari_beam.f | 16 ++-- num/test/src/test_brent.f90 | 179 ++++++++++++++++++----------------- num/test/src/test_newuoa.f90 | 5 +- 4 files changed, 109 insertions(+), 102 deletions(-) diff --git a/num/test/make/makefile_base b/num/test/make/makefile_base index e0f20c6b8..5001683e8 100644 --- a/num/test/make/makefile_base +++ b/num/test/make/makefile_base @@ -79,24 +79,21 @@ nodeps : $(.DEFAULT_GOAL) COMPILE_NC = $(FC) $(FCbasic) $(FCopenmp) $(FCstatic) $(FCopt) $(FCfixed) $(TEST_INCLUDES) -c -COMPILE_LEGACY_NC = $(filter-out -std=f2008, $(COMPILE_NC)) -std=legacy -TEST_COMPILE_LEGACY = $(filter-out -std=f2008, $(TEST_COMPILE)) -std=legacy - bari_vdpol.o bari_vdpol3.o bari_vdpol_x.o bari_vdpol3_x.o bari_medakzo.o bari_hires.o \ bari_pollu.o bari_rober.o bari_beam.o bari_chemakzo.o : %.o : %.f ifneq ($(QUIET),) @echo COMPILE_LEGACY_NC $< - @$(COMPILE_LEGACY_NC) $< + @$(COMPILE_NC) $< else - $(COMPILE_LEGACY_NC) $< + $(COMPILE_NC) $< endif %.o: %.f90 ifneq ($(QUIET),) @echo TEST_COMPILE_LEGACY $< - @$(TEST_COMPILE_LEGACY) $(FCfree) $< + @$(TEST_COMPILE) $(FCfree) $< else - $(TEST_COMPILE_LEGACY) $(FCfree) $< + $(TEST_COMPILE) $(FCfree) $< endif ################################################################# diff --git a/num/test/src/bari_beam.f b/num/test/src/bari_beam.f index 04707809a..4fb02f250 100644 --- a/num/test/src/bari_beam.f +++ b/num/test/src/bari_beam.f @@ -18,8 +18,9 @@ c c----------------------------------------------------------------------- subroutine beam_init(neqn,y,yprime,consis) + use const_def, only: dp integer neqn - double precision y(neqn),yprime(neqn) + real(dp) y(neqn),yprime(neqn) logical consis integer i @@ -32,11 +33,12 @@ subroutine beam_init(neqn,y,yprime,consis) end c----------------------------------------------------------------------- subroutine beam_feval(nvar,t,th,df,ierr,rpar,ipar) + use const_def, only: dp use math_lib - IMPLICIT real*8 (A-H,O-Z) + IMPLICIT real(dp) (A-H,O-Z) integer ierr,ipar(*) integer, parameter :: N=40, NN=2*N, NCOM=N, NSQ=N*N, NQUATR=NSQ*NSQ, NNCOM=NN - double precision rpar(*), an, deltas + real(dp) rpar(*), an, deltas DIMENSION DF(NN),TH(150),U(150),V(150),W(150) DIMENSION ALPHA(150),BETA(150),STH(150),CTH(150) C --- SET DEFAULT VALUES @@ -115,8 +117,9 @@ subroutine beam_feval(nvar,t,th,df,ierr,rpar,ipar) END c----------------------------------------------------------------------- subroutine beam_jeval(ldim,neqn,t,y,yprime,dfdy,ierr,rpar,ipar) + use const_def, only: dp integer ldim,neqn,ierr,ipar(*) - double precision t,y(neqn),yprime(neqn),dfdy(ldim,neqn),rpar(*) + real(dp) t,y(neqn),yprime(neqn),dfdy(ldim,neqn),rpar(*) c c dummy subroutine c @@ -124,11 +127,12 @@ subroutine beam_jeval(ldim,neqn,t,y,yprime,dfdy,ierr,rpar,ipar) end c----------------------------------------------------------------------- subroutine beam_solut(neqn,t,y) + use const_def, only: dp integer neqn - double precision t,y(neqn) + real(dp) t,y(neqn) c c -c computed using double precision RADAU on an +c computed using real(dp) RADAU on an c Alphaserver DS20E, with a 667 MHz EV67 processor. c c uround = 1.01d-19 diff --git a/num/test/src/test_brent.f90 b/num/test/src/test_brent.f90 index e2ce34f93..16f5a80bd 100644 --- a/num/test/src/test_brent.f90 +++ b/num/test/src/test_brent.f90 @@ -4,6 +4,7 @@ module test_brent use num_lib use math_lib use utils_lib, only: mesa_error + use const_def, only: dp implicit none @@ -45,13 +46,13 @@ subroutine test_global_min_all ! implicit none - real ( kind = 8 ) a - real ( kind = 8 ) b - real ( kind = 8 ) c - real ( kind = 8 ) e - real ( kind = 8 ) m - real ( kind = 8 ) machep - real ( kind = 8 ) t + real(dp) a + real(dp) b + real(dp) c + real(dp) e + real(dp) m + real(dp) machep + real(dp) t write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST_GLOMIN_ALL' @@ -133,18 +134,19 @@ end subroutine test_global_min_all subroutine test_glomin_one ( a, b, c, m, machep, e, t, f, title ) - real*8, intent(in) :: a, b, c, m, machep, e, t + real(dp), intent(in) :: a, b, c, m, machep, e, t interface - real*8 function f(x) - real*8, intent(in) :: x + real(dp) function f(x) + use const_def, only: dp + real(dp), intent(in) :: x end function f end interface - real ( kind = 8 ) fa - real ( kind = 8 ) fb - real ( kind = 8 ) fx + real (dp) fa + real (dp) fb + real (dp) fx character ( len = * ) title - real ( kind = 8 ) x + real (dp) x integer :: max_tries, ierr include 'formats' @@ -167,28 +169,28 @@ end function f end subroutine test_glomin_one - real*8 function h_01 ( x ) - real*8, intent(in) :: x + real(dp) function h_01 ( x ) + real(dp), intent(in) :: x h_01 = 2.0D+00 - x end function h_01 - real*8 function h_02 ( x ) - real*8, intent(in) :: x + real(dp) function h_02 ( x ) + real(dp), intent(in) :: x h_02 = x * x end function h_02 - real*8 function h_03 ( x ) - real*8, intent(in) :: x + real(dp) function h_03 ( x ) + real(dp), intent(in) :: x h_03 = x * x * ( x + 1.0D+00 ) end function h_03 - real*8 function h_04 ( x ) - real*8, intent(in) :: x + real(dp) function h_04 ( x ) + real(dp), intent(in) :: x h_04 = ( x + sin ( x ) ) * exp( - x * x ) end function h_04 - real*8 function h_05 ( x ) - real*8, intent(in) :: x + real(dp) function h_05 ( x ) + real(dp), intent(in) :: x h_05 = ( x - sin ( x ) ) * exp( - x * x ) end function h_05 @@ -213,10 +215,10 @@ subroutine test_local_min_all ! implicit none - real ( kind = 8 ) a - real ( kind = 8 ) b - real ( kind = 8 ) eps - real ( kind = 8 ) t + real(dp) a + real(dp) b + real(dp) eps + real(dp) t write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST_LOCAL_MIN_ALL' @@ -281,31 +283,32 @@ subroutine test_local_min_one ( a, b, eps, t, f, title ) ! ! Parameters: ! - ! Input, real ( kind = 8 ) A, B, the endpoints of the interval. + ! Input, real(dp) A, B, the endpoints of the interval. ! - ! Input, real ( kind = 8 ) EPS, a positive relative error tolerance. + ! Input, real(dp) EPS, a positive relative error tolerance. ! - ! Input, real ( kind = 8 ) T, a positive absolute error tolerance. + ! Input, real(dp) T, a positive absolute error tolerance. ! - ! Input, external real ( kind = 8 ) F, the name of a user-supplied + ! Input, external real(dp) F, the name of a user-supplied ! function, of the form "FUNCTION F ( X )", which evaluates the ! function whose local minimum is being sought. ! ! Input, character ( LEN = * ) TITLE, a title for the problem. ! implicit none - real*8, intent(in) :: a, b, eps, t + real(dp), intent(in) :: a, b, eps, t interface - real*8 function f(x) - real*8, intent(in) :: x + real(dp) function f(x) + use const_def, only: dp + real(dp), intent(in) :: x end function f end interface character (len=*) :: title - real ( kind = 8 ) fa - real ( kind = 8 ) fb - real ( kind = 8 ) fx - real ( kind = 8 ) x + real (dp) fa + real (dp) fb + real (dp) fx + real (dp) x integer :: max_tries, ierr include 'formats' @@ -327,86 +330,86 @@ end function f return end subroutine test_local_min_one - real*8 function g_01 ( x ) - real*8, intent(in) :: x + real(dp) function g_01 ( x ) + real(dp), intent(in) :: x g_01 = ( x - 2.0D+00 ) * ( x - 2.0D+00 ) + 1.0D+00 end function g_01 - real*8 function g_02 ( x ) - real*8, intent(in) :: x + real(dp) function g_02 ( x ) + real(dp), intent(in) :: x g_02 = x * x + exp( - x ) end function g_02 - real*8 function g_03 ( x ) - real*8, intent(in) :: x + real(dp) function g_03 ( x ) + real(dp), intent(in) :: x g_03 = ( ( x * x + 2.0D+00 ) * x + 1.0D+00 ) * x + 3.0D+00 end function g_03 - real*8 function g_04 ( x ) - real*8, intent(in) :: x + real(dp) function g_04 ( x ) + real(dp), intent(in) :: x g_04 = exp( x ) + 0.01D+00 / x end function g_04 - real*8 function g_05 ( x ) - real*8, intent(in) :: x + real(dp) function g_05 ( x ) + real(dp), intent(in) :: x g_05 = exp( x ) - 2.0D+00 * x + 0.01D+00 / x - 0.000001D+00 / x / x end function g_05 - real*8 function f_01 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) + real(dp) function f_01 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) integer, intent(in) :: lrpar, lipar - real*8, intent(in) :: x - real*8, intent(out) :: dfdx + real(dp), intent(in) :: x + real(dp), intent(out) :: dfdx integer, intent(inout), pointer :: ipar(:) ! (lipar) - real*8, intent(inout), pointer :: rpar(:) ! (lrpar) + real(dp), intent(inout), pointer :: rpar(:) ! (lrpar) integer, intent(out) :: ierr f_01 = sin ( x ) - 0.5D+00 * x ierr = 0 dfdx = 0 end function f_01 - real*8 function f_02 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) + real(dp) function f_02 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) integer, intent(in) :: lrpar, lipar - real*8, intent(in) :: x - real*8, intent(out) :: dfdx + real(dp), intent(in) :: x + real(dp), intent(out) :: dfdx integer, intent(inout), pointer :: ipar(:) ! (lipar) - real*8, intent(inout), pointer :: rpar(:) ! (lrpar) + real(dp), intent(inout), pointer :: rpar(:) ! (lrpar) integer, intent(out) :: ierr f_02 = 2.0D+00 * x - exp( - x ) ierr = 0 dfdx = 0 end function f_02 - real*8 function f_03 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) + real(dp) function f_03 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) integer, intent(in) :: lrpar, lipar - real*8, intent(in) :: x - real*8, intent(out) :: dfdx + real(dp), intent(in) :: x + real(dp), intent(out) :: dfdx integer, intent(inout), pointer :: ipar(:) ! (lipar) - real*8, intent(inout), pointer :: rpar(:) ! (lrpar) + real(dp), intent(inout), pointer :: rpar(:) ! (lrpar) integer, intent(out) :: ierr f_03 = x * exp( - x ) ierr = 0 dfdx = 0 end function f_03 - real*8 function f_04 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) + real(dp) function f_04 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) integer, intent(in) :: lrpar, lipar - real*8, intent(in) :: x - real*8, intent(out) :: dfdx + real(dp), intent(in) :: x + real(dp), intent(out) :: dfdx integer, intent(inout), pointer :: ipar(:) ! (lipar) - real*8, intent(inout), pointer :: rpar(:) ! (lrpar) + real(dp), intent(inout), pointer :: rpar(:) ! (lrpar) integer, intent(out) :: ierr f_04 = exp( x ) - 1.0D+00 / 100.0D+00 / x / x ierr = 0 dfdx = 0 end function f_04 - real*8 function f_05 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) + real(dp) function f_05 ( x, dfdx, lrpar, rpar, lipar, ipar, ierr ) integer, intent(in) :: lrpar, lipar - real*8, intent(in) :: x - real*8, intent(out) :: dfdx + real(dp), intent(in) :: x + real(dp), intent(out) :: dfdx integer, intent(inout), pointer :: ipar(:) ! (lipar) - real*8, intent(inout), pointer :: rpar(:) ! (lrpar) + real(dp), intent(inout), pointer :: rpar(:) ! (lrpar) integer, intent(out) :: ierr f_05 = ( x + 3.0D+00 ) * ( x - 1.0D+00 ) * ( x - 1.0D+00 ) ierr = 0 @@ -434,10 +437,10 @@ subroutine test_brent_zero ( ) ! implicit none - real ( kind = 8 ) a - real ( kind = 8 ) b - real ( kind = 8 ) machep - real ( kind = 8 ) t + real(dp) a + real(dp) b + real(dp) machep + real(dp) t machep = epsilon ( machep ) t = machep @@ -497,15 +500,15 @@ subroutine test_zero_one ( a, b, machep, t, f, title ) ! ! Parameters: ! - ! Input, real ( kind = 8 ) A, B, the two endpoints of the change of sign + ! Input, real(dp) A, B, the two endpoints of the change of sign ! interval. ! - ! Input, real ( kind = 8 ) MACHEP, an estimate for the relative machine + ! Input, real(dp) MACHEP, an estimate for the relative machine ! precision. ! - ! Input, real ( kind = 8 ) T, a positive error tolerance. + ! Input, real(dp) T, a positive error tolerance. ! - ! Input, external real ( kind = 8 ) F, the name of a user-supplied + ! Input, external real(dp) F, the name of a user-supplied ! function, of the form "FUNCTION F ( X )", which evaluates the ! function whose zero is being sought. ! @@ -517,22 +520,22 @@ subroutine test_zero_one ( a, b, machep, t, f, title ) include 'num_root_fcn.dek' ! f provides function values end interface - real ( kind = 8 ) a - real ( kind = 8 ) b - real ( kind = 8 ) fa - real ( kind = 8 ) fb - real ( kind = 8 ) fz - real ( kind = 8 ) machep - real ( kind = 8 ) t + real(dp) a + real(dp) b + real(dp) fa + real(dp) fb + real(dp) fz + real(dp) machep + real(dp) t character ( len = * ) title - real ( kind = 8 ) z - real ( kind = 8 ) dfdx + real(dp) z + real(dp) dfdx integer, parameter :: lrpar = 0, lipar = 0 integer :: ierr - real*8, target :: rpar_ary(lrpar) + real(dp), target :: rpar_ary(lrpar) integer, target :: ipar_ary(lipar) - real*8, pointer :: rpar(:) + real(dp), pointer :: rpar(:) integer, pointer :: ipar(:) include 'formats' diff --git a/num/test/src/test_newuoa.f90 b/num/test/src/test_newuoa.f90 index fc377f520..b56a8563f 100644 --- a/num/test/src/test_newuoa.f90 +++ b/num/test/src/test_newuoa.f90 @@ -2,6 +2,7 @@ module test_newuoa use num_def use num_lib + use const_def, only: dp integer :: nfcn @@ -16,6 +17,7 @@ subroutine do_test_newuoa IMPLICIT real(dp) (A-H,O-Z) DIMENSION X(10),W(10000) real(dp), parameter :: max_valid_value = 1d99 + integer :: IPRINT,I,N,NPT,MAXFUN include 'formats' IPRINT=0 MAXFUN=5000 @@ -43,7 +45,8 @@ subroutine calfun(n,x,f) real(dp), intent(in) :: x(*) real(dp), intent(out) :: f - real(dp) :: Y(10,10) + integer :: I,J,IW,MAXFUN,NP + real(dp) :: Y(10,10), sum nfcn = nfcn + 1 DO 10 J=1,N Y(1,J)=1.0D0 From 533a61e88b305dcd681d840598e85f43a39c62b7 Mon Sep 17 00:00:00 2001 From: Vincent Vanlaer Date: Tue, 30 Jul 2024 22:29:31 -0400 Subject: [PATCH 3/4] num: make private include files f2008 standard compliant --- num/make/makefile_base | 15 +++++---------- num/private/decomc.dek | 16 ++++++++-------- num/private/estrad.dek | 8 ++++---- num/private/slvrad.dek | 6 +++--- num/test/src/bari_beam.f | 2 +- num/test/src/test_bobyqa.f90 | 3 +++ 6 files changed, 24 insertions(+), 26 deletions(-) diff --git a/num/make/makefile_base b/num/make/makefile_base index fc6e43232..32b1569c3 100644 --- a/num/make/makefile_base +++ b/num/make/makefile_base @@ -69,26 +69,21 @@ nodeps : $(.DEFAULT_GOAL) # # COMPULATION RULES -#COMPILE_LEGACY = $(filter-out -std=f2008, $(COMPILE_TO_TEST)) -COMPILE_LEGACY = $(filter-out -std=f2008, $(COMPILE_TO_DEPLOY)) -std=legacy +COMPILE = $(COMPILE_TO_DEPLOY) $(FCfixed) -COMPILE = $(COMPILE_LEGACY) $(FCfixed) - -COMPILE_FREE = $(COMPILE_LEGACY) $(FCfree) +COMPILE_FREE = $(COMPILE_TO_DEPLOY) $(FCfree) #COMPILE_XTRA = $(COMPILE_NO_CHECKS) $(FCfixed) -c COMPILE_XTRA = $(COMPILE_BASIC) $(FCopt) $(FCfixed) -c -COMPILE_LEGACY_XTRA = $(filter-out -std=f2008, $(COMPILE_XTRA)) -std=legacy - COMPILE_CMD = $(COMPILE) mod_bobyqa.o mod_newuoa.o mod_dop853.o mod_dopri5.o mod_dc_decsol.o mod_rosenbrock.o : %.o : %.f ifneq ($(QUIET),) - @echo COMPILE_LEGACY_XTRA $< - @$(COMPILE_LEGACY_XTRA) $< + @echo COMPILE_XTRA $< + @$(COMPILE_XTRA) $< else - $(COMPILE_LEGACY_XTRA) $< + $(COMPILE_XTRA) $< endif %.o : %.mod diff --git a/num/private/decomc.dek b/num/private/decomc.dek index 8fd2bdf15..685ef4a59 100644 --- a/num/private/decomc.dek +++ b/num/private/decomc.dek @@ -10,6 +10,10 @@ #include "mtx_decsolc.dek" #include "mtx_decsolcs.dek" end interface + integer :: m1, m2, nm1, lde1, ijob + integer :: mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag + integer :: nzmax, isparse, lcd, lrd, lid + integer :: ierr, ip2(nm1), n, ldjac, ldmas, mlmas, mumas integer :: ia(*), ja(nzmax) ! ia(n+1) when used; ia(2) when not. double precision :: sparse_jac(nzmax) double precision :: sar(nzmax), sai(nzmax) @@ -19,10 +23,6 @@ double precision :: fjac(ldjac,n), fmas(ldmas,nm1) double precision :: e2r(lde1,nm1), e2i(lde1,nm1) double precision :: br(n), bi(n), alphn, betan - integer :: ierr, ip2(nm1), n, ldjac, ldmas, mlmas, mumas - integer :: m1, m2, nm1, lde1, ijob - integer :: mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag - integer :: nzmax, isparse, lcd, lrd, lid ! LOCALS integer :: i, j, k, jm1, mm, imle, ib, hint @@ -313,6 +313,10 @@ #include "mtx_decsolc.dek" #include "mtx_decsolcs.dek" end interface + integer :: m1, m2, nm1, lde1, ijob + integer :: mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag + integer :: nzmax, isparse, lcd, lrd, lid + integer :: ierr, ip2(nm1), n, ldjac, ldmas, mlmas, mumas integer :: ia(:) ! (n+1) integer :: ja(:) ! (nzmax) real(dp) :: sparse_jac(:) ! (nzmax) @@ -328,10 +332,6 @@ double precision :: br(n), bi(n), alphn, betan - integer :: ierr, ip2(nm1), n, ldjac, ldmas, mlmas, mumas - integer :: m1, m2, nm1, lde1, ijob - integer :: mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag - integer :: nzmax, isparse, lcd, lrd, lid goto (1,2,3,4,5,6,55,8,9,55,11,12,13,14,15), ijob diff --git a/num/private/estrad.dek b/num/private/estrad.dek index 6094819fe..a64e3e991 100644 --- a/num/private/estrad.dek +++ b/num/private/estrad.dek @@ -11,6 +11,10 @@ #include "mtx_decsol.dek" #include "mtx_decsols.dek" end interface + integer, pointer :: ip1(:) ! (nm1) + integer :: n, iphes(n), nerror, ldjac, mljac, mujac, ldmas, mlmas, mumas + integer :: nfcn, ijob, m1, m2, nm1, lde1, lrpar, lipar, ier, mle, mue + integer :: mbjac, mbb, mdiag, mdiff, mbdiag, nzmax, isparse, lrd, lid integer :: ia(:) ! (n+1) integer :: ja(:) ! (nzmax) double precision :: sa(nzmax) @@ -19,10 +23,6 @@ integer, intent(inout), pointer :: ipar(:) ! (lipar) real(dp), intent(inout), pointer :: rpar(:) ! (lrpar) - integer, pointer :: ip1(:) ! (nm1) - integer :: iphes(n), n, nerror, ldjac, mljac, mujac, ldmas, mlmas, mumas - integer :: nfcn, ijob, m1, m2, nm1, lde1, lrpar, lipar, ier, mle, mue - integer :: mbjac, mbb, mdiag, mdiff, mbdiag, nzmax, isparse, lrd, lid double precision :: fjac(ldjac,n), fmas(ldmas,nm1) double precision, pointer :: e1_1D(:) double precision :: x, scal(n), y0(n), y(n) diff --git a/num/private/slvrad.dek b/num/private/slvrad.dek index ebe4d7f24..53c2e9373 100644 --- a/num/private/slvrad.dek +++ b/num/private/slvrad.dek @@ -11,6 +11,9 @@ #include "mtx_decsolc.dek" #include"mtx_decsolcs.dek" end interface + integer :: ldjac, mljac, mujac, ldmas, mlmas, mumas, m1, m2, nm1, lde1, ier, ijob + integer :: n, mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag, nzmax, isparse, lcd, lrd, lid + integer :: iphes(n) integer :: ia(:) ! (n+1) integer :: ja(:) ! (nzmax) double precision :: sa(nzmax), sar(nzmax), sai(nzmax) @@ -21,9 +24,6 @@ double precision, pointer :: e1_1D(:) double precision :: e2r(lde1,nm1), e2i(lde1,nm1), cont(n) double precision, pointer, dimension(:) :: z1, z2, z3, f1, f2, f3 ! (n) - integer :: ldjac, mljac, mujac, ldmas, mlmas, mumas, m1, m2, nm1, lde1, ier, ijob - integer :: n, mle, mue, mbjac, mbb, mdiag, mdiff, mbdiag, nzmax, isparse, lcd, lrd, lid - integer :: iphes(n) integer, pointer, dimension(:) :: ip1, ip2 ! (nm1) diff --git a/num/test/src/bari_beam.f b/num/test/src/bari_beam.f index 4fb02f250..904db44c6 100644 --- a/num/test/src/bari_beam.f +++ b/num/test/src/bari_beam.f @@ -36,7 +36,7 @@ subroutine beam_feval(nvar,t,th,df,ierr,rpar,ipar) use const_def, only: dp use math_lib IMPLICIT real(dp) (A-H,O-Z) - integer ierr,ipar(*) + integer ierr,nvar,i,ipar(*) integer, parameter :: N=40, NN=2*N, NCOM=N, NSQ=N*N, NQUATR=NSQ*NSQ, NNCOM=NN real(dp) rpar(*), an, deltas DIMENSION DF(NN),TH(150),U(150),V(150),W(150) diff --git a/num/test/src/test_bobyqa.f90 b/num/test/src/test_bobyqa.f90 index fddf3596d..1745dd53b 100644 --- a/num/test/src/test_bobyqa.f90 +++ b/num/test/src/test_bobyqa.f90 @@ -11,6 +11,7 @@ subroutine do_test_bobyqa IMPLICIT real(dp) (A-H,O-Z) DIMENSION X(100),XL(100),XU(100),W(10000) real(dp), parameter :: max_valid_value = 1d99 + integer I,IPRINT,n,MAXFUN,NPT include 'formats' BDL=-1.0D0 BDU=1.0D0 @@ -41,6 +42,8 @@ subroutine calfun(n,x,f) integer, intent(in) :: n real(dp), intent(in) :: x(*) real(dp), intent(out) :: f + integer :: i,j,iw,np + real(dp) :: sum real(dp) :: Y(10,10) nfcn = nfcn + 1 From 9f1fe8fd9262300009cf821fe896c1499b794282 Mon Sep 17 00:00:00 2001 From: Vincent Vanlaer Date: Tue, 30 Jul 2024 22:55:04 -0400 Subject: [PATCH 4/4] build: ensure test source files actually use -std=f2008 --- num/test/make/makefile_base | 17 +++++++---------- utils/makefile_header | 2 +- 2 files changed, 8 insertions(+), 11 deletions(-) diff --git a/num/test/make/makefile_base b/num/test/make/makefile_base index 5001683e8..5ab88af39 100644 --- a/num/test/make/makefile_base +++ b/num/test/make/makefile_base @@ -77,23 +77,20 @@ nodeps : $(.DEFAULT_GOAL) # # COMPILATION RULES -COMPILE_NC = $(FC) $(FCbasic) $(FCopenmp) $(FCstatic) $(FCopt) $(FCfixed) $(TEST_INCLUDES) -c - -bari_vdpol.o bari_vdpol3.o bari_vdpol_x.o bari_vdpol3_x.o bari_medakzo.o bari_hires.o \ - bari_pollu.o bari_rober.o bari_beam.o bari_chemakzo.o : %.o : %.f +%.o : %.f ifneq ($(QUIET),) - @echo COMPILE_LEGACY_NC $< - @$(COMPILE_NC) $< + @echo TEST_COMPILE fixed $< + @$(TEST_COMPILE) $(FCfixed) -fimplicit-none $< else - $(COMPILE_NC) $< + $(TEST_COMPILE) $(FCfixed)-fimplicit-none $< endif %.o: %.f90 ifneq ($(QUIET),) - @echo TEST_COMPILE_LEGACY $< - @$(TEST_COMPILE) $(FCfree) $< + @echo TEST_COMPILE free $< + @$(TEST_COMPILE) $(FCfree) -fimplicit-none $< else - $(TEST_COMPILE) $(FCfree) $< + $(TEST_COMPILE) $(FCfree) -fimplicit-none $< endif ################################################################# diff --git a/utils/makefile_header b/utils/makefile_header index 6b964fefe..368d5ab90 100644 --- a/utils/makefile_header +++ b/utils/makefile_header @@ -247,7 +247,7 @@ LOCAL_LIB_DIR = $(PACKAGE_DIR)/make MESA_LIB_DIR = $(MESA_DIR)/lib MESA_INCLUDE_DIR = $(MESA_DIR)/include TEST_INCLUDES = -I$(LOCAL_LIB_DIR) -I$(PACKAGE_DIR)/public -I$(MESA_INCLUDE_DIR) -TEST_COMPILE_FLAGS = $(FCbasic) $(FCopenmp) $(TEST_INCLUDES) $(FCchecks) $(FCdebug) $(LIB_FLAGS) -c +TEST_COMPILE_FLAGS = $(FCbasic) $(FCopenmp) $(TEST_INCLUDES) $(FCchecks) $(FCdebug) $(LIB_FLAGS) $(FCstandard) $(FCimpno) -c TEST_COMPILE = $(FC) $(TEST_COMPILE_FLAGS) $(LD_FLAGS) # Library lists / linking commands