Make num comply (mostly) with Fortran 2008 standard

astero/private/adipls_support.f90

@@ -287,8 +287,7 @@ subroutine store_model_for_adipls (s, add_atmosphere, do_redistribute_mesh, ierr
 
          ivers = 0 ! It's not clear what this does in fgong_amdl
 
-         call fgong_amdl( &
-            cgrav, nn_in, iconst, ivar, ivers, global_data, point_data, data, aa, nn, ierr)
+         call fgong_amdl(cgrav, nn_in, iconst, ivar, ivers, global_data, point_data, data, aa, nn, ierr)
          deallocate(global_data, point_data)
 
          if (ierr /= 0) then
@@ -682,8 +681,7 @@ subroutine read_and_store(iriche, iturpr, cgrav)
             write(*,*) 'read_and_store failed in read_fgong_file'
             call mesa_error(__FILE__,__LINE__)
          end if
-         call fgong_amdl( &
-            cgrav, nn, iconst, ivar, ivers, glob, var, data, aa, nn, ierr)
+         call fgong_amdl(cgrav, nn_in, iconst, ivar, ivers, glob, var, data, aa, nn, ierr)
          if (ierr /= 0) then
             write(*,*) 'read_and_store failed in fgong_amdl'
             call mesa_error(__FILE__,__LINE__)
@@ -726,16 +724,16 @@ subroutine store_amdl(nn_in, iriche, iturpr, data, aa, x, nn, ierr)
 
          ! test for singular centre and/or surface
 
-         sincen=aa1(1,1).eq.0
-         sinsur=data(7).ge.0
+         sincen=aa1(1,1) == 0
+         sinsur=data(7) >= 0
          nsin=0
          if (sincen) nsin=nsin+1
          if (sinsur) nsin=nsin+1
 
          ! test for inclusion of g/(g tilde)
 
          idata8 = int(data(8)+0.1)
-         if (mod(idata8/10,10).eq.2) then
+         if (mod(idata8/10,10) == 2) then
             iggt = 1
             iturpr=8
          else
@@ -746,13 +744,13 @@ subroutine store_amdl(nn_in, iriche, iturpr, data, aa, x, nn, ierr)
 
          ! test for number of nonsingular points
 
-         if (iriche.ne.1.or.mod(nn-nsin,2).eq.1) then
+         if (iriche /= 1.or.mod(nn-nsin,2) == 1) then
             nshift=0
          else
             nshift=1
          end if
          nnr=nn
-         if (nshift.ne.0) then
+         if (nshift /= 0) then
             nn=nn-nshift
          end if
 
@@ -772,7 +770,7 @@ subroutine store_amdl(nn_in, iriche, iturpr, data, aa, x, nn, ierr)
             end do
          else
             do n=1,nnr
-               if (n.eq.1) then
+               if (n == 1) then
                   n1=1
                else
                   n1=n+nshift
@@ -788,16 +786,16 @@ subroutine store_amdl(nn_in, iriche, iturpr, data, aa, x, nn, ierr)
 
          ! set g/gtilde (=1 in models without turbulent pressure)
 
-         if (iturpr.eq.1) then
+         if (iturpr == 1) then
             do n=1,nn
-               if (x(n).lt.0.999) then
+               if (x(n) < 0.999) then
                   ggt=1
                else
                   ggt=1./(x(n)*x(n)*x(n)*aa(1,n))
                end if
                aa(10,n)=ggt
             end do
-         else if (iggt.eq.1) then
+         else if (iggt == 1) then
             do n=1,nn
                aa(10,n)=aa(6,n)
             end do
@@ -815,8 +813,7 @@ subroutine store_amdl(nn_in, iriche, iturpr, data, aa, x, nn, ierr)
       end subroutine store_amdl
 
 
-      subroutine fgong_amdl( &
-            cgrav, nn_in, iconst, ivar, ivers, glob, var, data, aa, nn, ierr)
+      subroutine fgong_amdl(cgrav, nn_in, iconst, ivar, ivers, glob, var, data, aa, nn, ierr)
          ! derived from fgong-amdl.d.f
          real(dp), intent(in) :: cgrav
          integer, intent(in) :: nn_in, iconst, ivar, ivers
@@ -834,7 +831,7 @@ subroutine fgong_amdl( &
          ierr = 0
          nn = nn_in
 
-         if (var(1,1).gt.var(1,nn)) then 
+         if (var(1,1) > var(1,nn)) then 
             nn1=nn+1
             do i=1,ivar
                do n=1,nn
@@ -846,7 +843,7 @@ subroutine fgong_amdl( &
             end do
          end if
 
-         if (var(1,1).gt.1.d6) then 
+         if (var(1,1) > 1.d6) then 
             do i=1,ivar
                do n=1,nn
                   var1(i,n+1)=var(i,n)
@@ -895,23 +892,23 @@ subroutine fgong_amdl( &
          aa(4,1)=var(10,1)
          aa(5,1)=0
          aa(6,1)=3.d0
-         if (aa(5,nn).le.10) then 
+         if (aa(5,nn) <= 10) then 
             nn=nn-1 
             !write(6,*) 'Chop off outermost point' 
          end if
          data(1)=glob(1)
          data(2)=glob(2)
          data(3)=var(4,1)
          data(4)=var(5,1)
-         if (glob(11).lt.0.and.glob(11).gt.-10000) then 
+         if (glob(11) < 0.and.glob(11) > -10000) then 
             data(5)=-glob(11)/var(10,1)
             data(6)=-glob(12) 
          else 
             data(5)=four_thirds_pi*cgrav*(var(5,1)*glob(2))**2/(var(4,1)*var(10,1))
             d2amax=0.d0
             do n=2,nn
                d2amax=max(d2amax,aa(5,n)/x(n)**2)
-               if (x(n).ge.0.05d0) exit
+               if (x(n) >= 0.05d0) exit
             end do
             data(6)=d2amax+data(5)
             !write(6,140) data(5), data(6)

astero/private/astero_support.f90

@@ -71,7 +71,7 @@ subroutine get_one_el_info( &
 
          real(dp) :: nu_obs, dist_j, nu, dist, min_dist, min_freq, &
             R, G, M, sig_fac, b, sum_1, sum_2, sum_3, empty(0)
-         integer :: min_dist_j, min_order, n, cnt, int_empty(0)
+         integer :: min_dist_j, min_order, n, cnt, int_empty(0), int_empty2(0)
          integer :: nsel, itrsig, nsig
          real(dp) :: els1, dels, sig1, sig2, dfsig
          integer :: num_l0_terms, k, i, j
@@ -162,7 +162,7 @@ subroutine get_one_el_info( &
             call set_to_closest(freq_target(0,:), &
                model_freq(0,:), empty, empty, &
                model_inertia(0,:), empty, empty, &
-               model_order(0,:), int_empty, int_empty, ierr)
+               model_order(0,:), int_empty, int_empty2, ierr)
 
             model_freq_alt_up(0,:) = model_freq(0,:)
             model_inertia_alt_up(0,:) = model_inertia(0,:)

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)