open-catalog/Checks/PWR003/example.f90 at main · codee-com/open-catalog · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
! PWR003: Explicitly declare pure functions

module gravityExample
  use iso_c_binding, only : c_int
  implicit none
  integer(kind=c_int), parameter :: mercury = 0, venus = 1, earth = 2, &
                                    mars = 3, jupiter = 4, saturn = 5, &
                                    uranus = 6, neptune = 7
contains
  function gravityOf(planet)
    use iso_c_binding, only: c_double

    real(kind=c_double) :: gravityOf
    integer(kind=c_int), intent(in) :: planet

    if (planet .eq. mercury) then
      gravityOf = 3.7
    else if (planet .eq. venus) then
      gravityOf = 8.9
    else if (planet .eq. earth) then
      gravityOf = 9.8
    else if (planet .eq. mars) then
      gravityOf = 3.7
    else if (planet .eq. jupiter) then
      gravityOf = 23.1
    else if (planet .eq. saturn) then
      gravityOf = 9.0
    else if (planet .eq. uranus) then
      gravityOf = 8.7
    else if (planet .eq. neptune) then
      gravityOf = 11.0
    else
      gravityOf = 0.0
    endif
  end function gravityOf
end module gravityExample

! Computes the weight of each object in a vector
! NOT-PWR070: Explicit-shape arrays used for C-interoperability
subroutine example_f(n, M, W) bind(c)
  use iso_c_binding, only : c_int, c_double
  use gravityExample, only : mars, gravityOf

  implicit none
  integer(kind=c_int) :: i
  integer(kind=c_int), intent(in), value :: n
  real(kind=c_double), dimension(1:n), intent(in) :: M
  real(kind=c_double), dimension(1:n), intent(out) :: W

  do i = 1, n
    W(i) = M(i) * gravityOf(mars)
  end do
end subroutine example_f