diff --git a/src/FortranChecks/f90sub/derived_types.f90 b/src/FortranChecks/f90sub/derived_types.f90 index 6f56108d62..58c8644bbc 100644 --- a/src/FortranChecks/f90sub/derived_types.f90 +++ b/src/FortranChecks/f90sub/derived_types.f90 @@ -13,12 +13,12 @@ !-------------------------------------------------------------------------------------------------! module rtt_test_derived_types - use iso_c_binding, only : c_double, c_int, c_int64_t, c_ptr, c_null_ptr + use iso_c_binding, only: c_double, c_int, c_int64_t, c_ptr, c_null_ptr implicit none ! Proper enumeration types don't work in F2003, but this is close. Enumerations with bind(C) are ! just integers anyway. See: ! http://www.rhinocerus.net/forum/lang-fortran/92750-no-enumeration-data-type-fortran.html - integer(c_int), parameter :: GREY=0, MULTIGROUP=1, ODF=2 + integer(c_int), parameter :: GREY = 0, MULTIGROUP = 1, ODF = 2 ! Create a derived type that contains some "extra" information type, bind(C) :: my_informative_type @@ -33,11 +33,11 @@ module rtt_test_derived_types interface subroutine rtt_test_derived_type(dt_in, err_code) bind(C, & name="rtt_test_derived_type") - use iso_c_binding, only : c_int + use iso_c_binding, only: c_int import my_informative_type ! F2003 standard, brings in host scope implicit none type(my_informative_type), intent(in) :: dt_in - integer(c_int) , intent(out) :: err_code + integer(c_int), intent(out) :: err_code end subroutine rtt_test_derived_type end interface @@ -49,7 +49,7 @@ end module rtt_test_derived_types subroutine test_derived_types() bind(c) use rtt_test_derived_types - use iso_c_binding, only : c_int, c_int64_t, c_double, c_loc, c_ptr + use iso_c_binding, only: c_int, c_int64_t, c_double, c_loc, c_ptr implicit none !---------------------------------------------------------------------- @@ -61,21 +61,21 @@ subroutine test_derived_types() bind(c) !---------------------------------------------------------------------- ! Initialization - mit%some_double = 3.141592654_c_double - mit%some_int = 137 - mit%some_large_int = 2_c_int64_t**34 - mit%some_enum = MULTIGROUP + mit % some_double = 3.141592654_c_double + mit % some_int = 137 + mit % some_large_int = 2_c_int64_t**34 + mit % some_enum = MULTIGROUP - allocate(int_array(10)) + allocate (int_array(10)) int_array(1) = 2003 int_array(2) = 2012 - mit%some_pointer = c_loc(int_array) + mit % some_pointer = c_loc(int_array) error_code = -1 - print '(a,f7.5)', "On Fortran side, derived type contains double = ", mit%some_double - print '(a,i3)', "integer = ", mit%some_int - print '(a,i11)', "large integer = ", mit%some_large_int + print '(a,f7.5)', "On Fortran side, derived type contains double = ", mit % some_double + print '(a,i3)', "integer = ", mit % some_int + print '(a,i11)', "large integer = ", mit % some_large_int print '(a,i4)', "int_array(1) = ", int_array(1) print '(a,i4)', "int_array(2) = ", int_array(2) print '(a,i1)', "The enumerated type is MULTIGROUP = ", MULTIGROUP @@ -83,11 +83,11 @@ subroutine test_derived_types() bind(c) !---------------------------------------------------------------------- ! Call the c-function with the derived type and check the error code - call rtt_test_derived_type( mit, error_code) + call rtt_test_derived_type(mit, error_code) - deallocate(int_array) + deallocate (int_array) - if( error_code .eq. 0 )then + if (error_code .eq. 0) then print '(a)', "Test: passed" print '(a)', " error code is equal to zero" else @@ -97,7 +97,7 @@ subroutine test_derived_types() bind(c) print '(a)', " " print '(a)', "*********************************************" - if(error_code .ne. 0) then + if (error_code .ne. 0) then print '(a)', "**** test_derived_types Test: FAILED." else print '(a)', "**** test_derived_types Test: PASSED." diff --git a/src/FortranChecks/f90sub/drel.f90 b/src/FortranChecks/f90sub/drel.f90 index 78cc928c3e..935fdfb773 100644 --- a/src/FortranChecks/f90sub/drel.f90 +++ b/src/FortranChecks/f90sub/drel.f90 @@ -12,23 +12,23 @@ subroutine drelf90(nf) bind(c, name="drelf90") - use iso_c_binding, only : c_size_t,C_NULL_CHAR,c_int + use iso_c_binding, only: c_size_t, C_NULL_CHAR, c_int implicit none integer(c_int), intent(out) :: nf interface ec_release ! include "ds++//Release.hh" - subroutine ec_release(release_string,maxlen) bind( C, name="ec_release" ) - use iso_c_binding, only: c_char,c_size_t + subroutine ec_release(release_string, maxlen) bind(C, name="ec_release") + use iso_c_binding, only: c_char, c_size_t implicit none - character(kind=c_char,len=1), intent(out) :: release_string + character(kind=c_char, len=1), intent(out) :: release_string integer(c_size_t), intent(in), value :: maxlen end subroutine ec_release end interface ec_release interface dsxx_is_big_endian ! include "ds++/Endian.hh" - function dsxx_is_big_endian() bind ( C, name = "dsxx_is_big_endian" ) + function dsxx_is_big_endian() bind(C, name="dsxx_is_big_endian") use iso_c_binding, only: c_int implicit none integer(c_int) :: dsxx_is_big_endian @@ -37,17 +37,17 @@ end function dsxx_is_big_endian interface dsxx_byte_swap ! include "ds++/Endian.hh" - subroutine dsxx_byte_swap_int( data ) bind( C, name = "dsxx_byte_swap_int" ) + subroutine dsxx_byte_swap_int(data) bind(C, name="dsxx_byte_swap_int") use iso_c_binding, only: c_int implicit none integer(c_int), intent(inout) :: data end subroutine dsxx_byte_swap_int - subroutine dsxx_byte_swap_int64_t( data ) bind( C, name = "dsxx_byte_swap_int64_t" ) + subroutine dsxx_byte_swap_int64_t(data) bind(C, name="dsxx_byte_swap_int64_t") use iso_c_binding, only: c_int64_t implicit none integer(c_int64_t), intent(inout) :: data end subroutine dsxx_byte_swap_int64_t - subroutine dsxx_byte_swap_double( data ) bind( C, name = "dsxx_byte_swap_double" ) + subroutine dsxx_byte_swap_double(data) bind(C, name="dsxx_byte_swap_double") use iso_c_binding, only: c_double implicit none real(c_double), intent(inout) :: data @@ -67,15 +67,15 @@ end subroutine dsxx_byte_swap_double ! Initialization nf = 0 ! init number of failures to zero - release_string = repeat(' ',maxlen) + release_string = repeat(' ', maxlen) release_string(maxlen:maxlen) = C_NULL_CHAR !---------------------------------------------------------------------- ! Retrieve the version string from ds++ - call ec_release( release_string, len(release_string,kind=c_size_t) ) + call ec_release(release_string, len(release_string, kind=c_size_t)) print '(a)', trim(release_string) - if( release_string(1:6) .eq. "Draco-" )then + if (release_string(1:6) .eq. "Draco-") then print '(a)', "Test: passed" print '(a)', " Found 'Draco-' in release string." else @@ -88,7 +88,7 @@ end subroutine dsxx_byte_swap_double ! Check the ds++/Endian extern "C" functions... is_big_endian = dsxx_is_big_endian() - if( is_big_endian.gt.1.or.is_big_endian.lt.0 )then + if (is_big_endian .gt. 1.or.is_big_endian .lt. 0) then print '(a)', "Test: failed" print '(a)', " dsxx_is_big_endian returned an unexpected value." nf = nf + 1 @@ -96,22 +96,22 @@ end subroutine dsxx_byte_swap_double ! note: integers must be signed in F90 (i.e.: we cannot use Z'DEADBEEF') idata = 1122867 ! 1122867 = z'00112233' call dsxx_byte_swap(idata) - if( idata /= 857870592 )then ! 857870592 = z'33221100' + if (idata /= 857870592) then ! 857870592 = z'33221100' print '(a)', "Test: failed" print '(a)', " dsxx_byte_swap(int) returned an unexpected value." - nf = nf+1 + nf = nf + 1 endif - ddata=42.0 + ddata = 42.0 ! Call swap 2x to get initial value call dsxx_byte_swap(ddata) call dsxx_byte_swap(ddata) - if( ddata /= 42.0 )then + if (ddata /= 42.0) then print '(a)', "Test: failed" print '(a)', " dsxx_byte_swap(double) returned an unexpected value." - nf = nf+1 + nf = nf + 1 endif - if(nf>0)then + if (nf > 0) then print '(a)', "Test: failed" print '(a)', " Endianess checks had some failures." else @@ -124,7 +124,7 @@ end subroutine dsxx_byte_swap_double print '(a)', " " print '(a)', "*********************************************" - if(nf>0)then + if (nf > 0) then print '(a)', "**** cppmain Test: FAILED." else print '(a)', "**** cppmain Test: PASSED." diff --git a/src/FortranChecks/f90sub/sub1.f90 b/src/FortranChecks/f90sub/sub1.f90 index 7a315b9a11..59c73fc6eb 100644 --- a/src/FortranChecks/f90sub/sub1.f90 +++ b/src/FortranChecks/f90sub/sub1.f90 @@ -13,7 +13,7 @@ ! use iso_c_binding -subroutine sub1(alpha,np,nf) bind(c) +subroutine sub1(alpha, np, nf) bind(c) use iso_c_binding, only: c_double, c_size_t implicit none real(c_double), value, intent(in) :: alpha @@ -24,18 +24,18 @@ subroutine sub1(alpha,np,nf) bind(c) double precision :: small !---------------------------------------- - small=1.0d-13 + small = 1.0d-13 - write(*,'(a,f5.1,2i3)') "Hello, world.", alpha, np, nf + write (*, '(a,f5.1,2i3)') "Hello, world.", alpha, np, nf - if( alpha.gt.1.0-small.and.alpha.lt.1.0+small )then - print '(a)',"Test: passed" - print '(a)'," alpha == 1.0" - np = np+1 + if (alpha .gt. 1.0 - small.and.alpha .lt. 1.0 + small) then + print '(a)', "Test: passed" + print '(a)', " alpha == 1.0" + np = np + 1 else - print '(a)',"Test: failed" - print '(a)'," alpha != 1.0" - nf = nf+1 + print '(a)', "Test: failed" + print '(a)', " alpha != 1.0" + nf = nf + 1 endif end subroutine sub1 diff --git a/src/c4/fc4/Draco_MPI.F90 b/src/c4/fc4/Draco_MPI.F90 index 549476c80a..7f479452f2 100644 --- a/src/c4/fc4/Draco_MPI.F90 +++ b/src/c4/fc4/Draco_MPI.F90 @@ -7,7 +7,7 @@ !--------------------------------------------------------------------------------------------------! module draco_mpi - use iso_c_binding, only : c_double, c_intptr_t + use iso_c_binding, only: c_double, c_intptr_t implicit none integer, public, save :: fc4_rank, fc4_num_ranks @@ -20,6 +20,7 @@ module draco_mpi ! Make all the subroutines defined below public, though public check_mpi_error + public fc4_mpi_init public fc4_mpi_finalize public fc4_mpi_barrier @@ -49,7 +50,7 @@ subroutine check_mpi_error(error) ! Check and report a nonzero error code if (error .ne. 0) then call mpi_error_string(error, error_string, error_string_len, ierror) - write(*,"('*** mpi error = ',i18, ' (', a, ')')") error,trim(error_string) + write (*, "('*** mpi error = ',i18, ' (', a, ')')") error, trim(error_string) call MPI_Abort(MPI_COMM_WORLD, 1, ierror) end if #endif @@ -100,7 +101,7 @@ subroutine fc4_mpi_barrier(ierr) integer, intent(out) :: ierr #ifdef C4_MPI external mpi_barrier - call mpi_barrier(MPI_COMM_WORLD,ierr) + call mpi_barrier(MPI_COMM_WORLD, ierr) call check_mpi_error(ierr) #endif end subroutine fc4_mpi_barrier diff --git a/src/c4/ftest/fc4_test.f90 b/src/c4/ftest/fc4_test.f90 index ed74fceab2..6abe03566b 100644 --- a/src/c4/ftest/fc4_test.f90 +++ b/src/c4/ftest/fc4_test.f90 @@ -10,7 +10,7 @@ ! This is a modified version of jayenne/src/api/ftest/API_Test.F90. !------------------------------------------------------------------------------ module fc4_test - use iso_c_binding, only : c_double + use iso_c_binding, only: c_double implicit none integer, save :: f90_num_failures = 0 @@ -25,8 +25,8 @@ subroutine check_fail(ierr, rank) integer, intent(in) :: ierr integer, intent(in) :: rank - if (ierr .ne. 0 ) then - write (*,'("**** Test: FAILED on ", I3, " with error ", I3)') rank, ierr + if (ierr .ne. 0) then + write (*, '("**** Test: FAILED on ", I3, " with error ", I3)') rank, ierr f90_num_failures = f90_num_failures + 1 end if end subroutine check_fail @@ -39,7 +39,7 @@ subroutine it_fails(rank, msg) integer, intent(in) :: rank character(*), intent(in) :: msg - write (*,'("**** Test: FAILED on ", I3, ": ", A)') rank, msg + write (*, '("**** Test: FAILED on ", I3, ": ", A)') rank, msg f90_num_failures = f90_num_failures + 1 @@ -53,7 +53,7 @@ subroutine pass_msg(rank, msg) integer, intent(in) :: rank character(*), intent(in) :: msg - write (*,'("**** Test: PASSED on ", I3, ": ", A)') rank, msg + write (*, '("**** Test: PASSED on ", I3, ": ", A)') rank, msg end subroutine pass_msg @@ -61,4 +61,4 @@ end module fc4_test ! --------------------------------------------------------------------------- ! End fc4_test.f90 -! --------------------------------------------------------------------------- \ No newline at end of file +! --------------------------------------------------------------------------- diff --git a/src/c4/ftest/mpi_hw_ftest.f90 b/src/c4/ftest/mpi_hw_ftest.f90 index f6e7c742f9..664d4e54db 100644 --- a/src/c4/ftest/mpi_hw_ftest.f90 +++ b/src/c4/ftest/mpi_hw_ftest.f90 @@ -13,7 +13,7 @@ subroutine tst_mpi_hw_f(nf) bind(C, name="tst_mpi_hw") use draco_mpi use fc4_test - use iso_c_binding, only : c_int, c_double + use iso_c_binding, only: c_int, c_double implicit none @@ -30,10 +30,10 @@ subroutine tst_mpi_hw_f(nf) bind(C, name="tst_mpi_hw") ! Run the problem ! ------------------------------------ - if ( fc4_rank < fc4_num_ranks ) then - call pass_msg( fc4_rank, "MPI rank index ok" ) + if (fc4_rank < fc4_num_ranks) then + call pass_msg(fc4_rank, "MPI rank index ok") else - call it_fails( fc4_rank, "MPI rank > max" ) + call it_fails(fc4_rank, "MPI rank > max") endif call fc4_mpi_barrier(ierr) diff --git a/src/quadrature/fquadrature/quadrature_interfaces.f90 b/src/quadrature/fquadrature/quadrature_interfaces.f90 index 2aed930ac2..343d1d4c87 100644 --- a/src/quadrature/fquadrature/quadrature_interfaces.f90 +++ b/src/quadrature/fquadrature/quadrature_interfaces.f90 @@ -15,7 +15,7 @@ !-------------------------------------------------------------------------------------------------! module quadrature_interfaces - use iso_c_binding, only : c_double, c_int, c_ptr, c_null_ptr + use iso_c_binding, only: c_double, c_int, c_ptr, c_null_ptr implicit none ! --------------------------------------------------------------------------------------- ! This *must* exactly match the layout in Quadrature_Interface.hh Quadrature Data Struct