num: make test src f2008 standard compliant

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

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

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)

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)
 
 

num/test/make/makefile_base

@@ -77,42 +77,20 @@ nodeps : $(.DEFAULT_GOAL)
 #
 # COMPILATION RULES
 
-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
-
-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
+%.o : %.f
 ifneq ($(QUIET),)
-	@echo COMPILE_LEGACY_NC $<
-	@$(COMPILE_LEGACY_NC) $<
+	@echo TEST_COMPILE fixed $<
+	@$(TEST_COMPILE) $(FCfixed) -fimplicit-none $<
 else
-	$(COMPILE_LEGACY_NC) $<
+	$(TEST_COMPILE) $(FCfixed)-fimplicit-none $<
 endif
 
-%.o: %.f
+%.o: %.f90
 ifneq ($(QUIET),)
-	@echo TEST_COMPILE_LEGACY $<
-	@$(TEST_COMPILE_LEGACY) $(FCfree) $<
+	@echo TEST_COMPILE free $<
+	@$(TEST_COMPILE) $(FCfree) -fimplicit-none $<
 else
-	$(TEST_COMPILE_LEGACY) $(FCfree) $<
+	$(TEST_COMPILE) $(FCfree) -fimplicit-none $<
 endif
 
 #################################################################
@@ -122,6 +100,7 @@ endif
 SRC_PATH = $(TEST_SRC_DIR)
 
 vpath %.f $(SRC_PATH)
+vpath %.f90 $(SRC_PATH)
 
 vpath %.mod $(LOCAL_LIB_DIR):$(MESA_DIR)/include
 

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)
-      integer ierr,ipar(*)
+      IMPLICIT real(dp) (A-H,O-Z)
+      integer ierr,nvar,i,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,20 +117,22 @@ 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
       return
       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

num/test/src/test_bobyqa.f → 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