File: template_02.f90

package info (click to toggle)
lfortran 0.45.0-1
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 46,332 kB
  • sloc: cpp: 137,068; f90: 51,260; python: 6,444; ansic: 4,277; yacc: 2,285; fortran: 806; sh: 524; makefile: 30; javascript: 15
file content (51 lines) | stat: -rw-r--r-- 1,266 bytes parent folder | download
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
module template_02_m
  implicit none

  requirement eq(t, ne)
    type, deferred :: t
    function ne(lhs, rhs)
      type(t), intent(in) :: lhs, rhs
      logical :: ne
    end function
  end requirement

  template change_positions_tmpl(t, ne)
    require :: eq(t, ne)
    private
    public :: change_positions_t
  contains
    function change_positions_t(vec) result(mask)
      type(t), intent(in) :: vec(:)
      integer, allocatable :: pos(:), mask(:)
      integer :: i, j, n
      n = size(vec)
      allocate (pos(n))
      if (n < 1) return
      pos = 0
      pos(1) = 1
      j = 1
      do i = 2,n
        if (ne(vec(i), vec(i-1))) then
          j = j+1
          pos(j) = i
        end if
      end do
      allocate(mask(j))
      do i = 1,j
        mask(i) = pos(i)
      end do
    end function
  end template

end module

program template_02
  use template_02_m
  implicit none
  instantiate change_positions_tmpl(integer, operator(/=)), &
    only: change_positions_int => change_positions_t
  instantiate change_positions_tmpl(character, operator(/=)), &
    only: change_positions_chr => change_positions_t
  print *, change_positions_int([3, 3, 6, 2, 2, 2, 1])
  print *, change_positions_chr(["a", "a", "b", "p", "p", "p", "o"])
end program