Skip to content

Commit

Permalink
Reformat fortran sources to prepare to enforce fprettyify style guide.
Browse files Browse the repository at this point in the history
+ See `.fprettify.rc`.
+ I'll be updating format checker CI and git commit hooks soon.
  • Loading branch information
KineticTheory committed May 10, 2021
1 parent c5f56fa commit 35cb634
Show file tree
Hide file tree
Showing 7 changed files with 62 additions and 61 deletions.
36 changes: 18 additions & 18 deletions src/FortranChecks/f90sub/derived_types.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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

Expand All @@ -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

!----------------------------------------------------------------------
Expand All @@ -61,33 +61,33 @@ 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
print '(a)', " "

!----------------------------------------------------------------------
! 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
Expand All @@ -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."
Expand Down
38 changes: 19 additions & 19 deletions src/FortranChecks/f90sub/drel.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -88,30 +88,30 @@ 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
endif
! 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
Expand All @@ -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."
Expand Down
20 changes: 10 additions & 10 deletions src/FortranChecks/f90sub/sub1.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
7 changes: 4 additions & 3 deletions src/c4/fc4/Draco_MPI.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
12 changes: 6 additions & 6 deletions src/c4/ftest/fc4_test.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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

Expand All @@ -53,12 +53,12 @@ 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

end module fc4_test

! ---------------------------------------------------------------------------
! End fc4_test.f90
! ---------------------------------------------------------------------------
! ---------------------------------------------------------------------------
8 changes: 4 additions & 4 deletions src/c4/ftest/mpi_hw_ftest.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion src/quadrature/fquadrature/quadrature_interfaces.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 35cb634

Please sign in to comment.