1 | ! A simple function |
---|
2 | logical function func_simple() |
---|
3 | func_simple = .true. |
---|
4 | end function func_simple |
---|
5 | |
---|
6 | ! A simple function, but with less friendly end |
---|
7 | logical function func_simple_1() |
---|
8 | func_simple_1 = .true. |
---|
9 | end function |
---|
10 | |
---|
11 | ! A simple function, but with even less friendly end |
---|
12 | logical function func_simple_2() |
---|
13 | func_simple_2 = .true. |
---|
14 | end |
---|
15 | |
---|
16 | ! A pure simple function |
---|
17 | pure logical function func_simple_pure() |
---|
18 | func_simple_pure = .true. |
---|
19 | end function func_simple_pure |
---|
20 | |
---|
21 | ! A pure recursive function |
---|
22 | recursive pure integer function func_simple_recursive_pure(i) |
---|
23 | integer, intent(in) :: i |
---|
24 | if (i <= 0) then |
---|
25 | func_simple_recursive_pure = i |
---|
26 | else |
---|
27 | func_simple_recursive_pure = i + func_simple_recursive_pure(i - 1) |
---|
28 | end if |
---|
29 | end function func_simple_recursive_pure |
---|
30 | |
---|
31 | ! An elemental simple function |
---|
32 | elemental logical function func_simple_elemental() |
---|
33 | func_simple_elemental = .true. |
---|
34 | end function func_simple_elemental |
---|
35 | |
---|
36 | ! A module with nonsense |
---|
37 | module bar |
---|
38 | type food |
---|
39 | integer :: cooking_method |
---|
40 | end type food |
---|
41 | type organic |
---|
42 | integer :: growing_method |
---|
43 | end type organic |
---|
44 | integer, parameter :: i_am_dim = 10 |
---|
45 | end module bar |
---|
46 | |
---|
47 | ! A module with more nonsense |
---|
48 | module foo |
---|
49 | use bar, only: FOOD |
---|
50 | integer :: foo_int |
---|
51 | contains |
---|
52 | subroutine foo_sub(egg) |
---|
53 | integer, parameter :: egg_dim = 10 |
---|
54 | type(Food), intent(in) :: egg |
---|
55 | write(*, *) egg |
---|
56 | end subroutine foo_sub |
---|
57 | elemental function foo_func() result(f) |
---|
58 | integer :: f |
---|
59 | f = 0 |
---|
60 | end function |
---|
61 | end module foo |
---|
62 | |
---|
63 | ! An function with arguments and module imports |
---|
64 | integer(selected_int_kind(0)) function func_with_use_and_args(egg, ham) |
---|
65 | use foo |
---|
66 | ! Deliberate trailing spaces in next line |
---|
67 | use bar, only : organic, i_am_dim |
---|
68 | implicit none |
---|
69 | integer, intent(in) :: egg(i_am_dim) |
---|
70 | integer, intent(in) :: ham(i_am_dim, 2) |
---|
71 | real bacon |
---|
72 | ! Deliberate trailing spaces in next line |
---|
73 | type( organic ) :: tomato |
---|
74 | func_with_use_and_args = egg(1) + ham(1, 1) |
---|
75 | end function func_with_use_and_args |
---|
76 | |
---|
77 | ! A function with some parameters |
---|
78 | character(20) function func_with_parameters(egg, ham) |
---|
79 | implicit none |
---|
80 | character*(*), parameter :: x_param = '01234567890' |
---|
81 | character(*), parameter :: & ! throw in some comments |
---|
82 | y_param & |
---|
83 | = '!&!&!&!&!&!' ! how to make life interesting |
---|
84 | integer, parameter :: z = 20 |
---|
85 | character(len(x_param)), intent(in) :: egg |
---|
86 | character(len(y_param)), intent(in) :: ham |
---|
87 | func_with_parameters = egg // ham |
---|
88 | end function func_with_parameters |
---|
89 | |
---|
90 | ! A function with some parameters, with a result |
---|
91 | function func_with_parameters_1(egg, ham) result(r) |
---|
92 | implicit none |
---|
93 | integer, parameter :: x_param = 10 |
---|
94 | integer z_param |
---|
95 | parameter(z_param = 2) |
---|
96 | real, intent(in), dimension(x_param) :: egg |
---|
97 | integer, intent(in) :: ham |
---|
98 | logical :: r(z_param) |
---|
99 | r(1) = int(egg(1)) + ham > 0 |
---|
100 | r(2) = .false. |
---|
101 | end function func_with_parameters_1 |
---|
102 | |
---|
103 | ! A function with a contains |
---|
104 | character(10) function func_with_contains(mushroom, tomoato) |
---|
105 | character(5) mushroom |
---|
106 | character(5) tomoato |
---|
107 | func_with_contains = func_with_contains_1() |
---|
108 | contains |
---|
109 | character(10) function func_with_contains_1() |
---|
110 | func_with_contains_1 = mushroom // tomoato |
---|
111 | end function func_with_contains_1 |
---|
112 | end function func_with_contains |
---|
113 | |
---|
114 | ! A function with its result declared after a local in the same statement |
---|
115 | Function func_mix_local_and_result(egg, ham, bacon) Result(Breakfast) |
---|
116 | Integer, Intent(in) :: egg, ham |
---|
117 | Real, Intent(in) :: bacon |
---|
118 | Real :: tomato, breakfast |
---|
119 | Breakfast = real(egg) + real(ham) + bacon |
---|
120 | End Function func_mix_local_and_result |
---|
121 | |
---|
122 | ! A simple subroutine |
---|
123 | subroutine sub_simple() |
---|
124 | end subroutine sub_simple |
---|
125 | |
---|
126 | ! A simple subroutine, with not so friendly end |
---|
127 | subroutine sub_simple_1() |
---|
128 | end subroutine |
---|
129 | |
---|
130 | ! A simple subroutine, with even less friendly end |
---|
131 | subroutine sub_simple_2() |
---|
132 | end |
---|
133 | |
---|
134 | ! A simple subroutine, with funny continuation |
---|
135 | subroutine sub_simple_3() |
---|
136 | end sub& |
---|
137 | &routine& |
---|
138 | & sub_simple_3 |
---|
139 | |
---|
140 | ! A subroutine with a few contains |
---|
141 | subroutine sub_with_contains(foo) ! " & |
---|
142 | ! Deliberate trailing spaces in next line |
---|
143 | use Bar, only: i_am_dim |
---|
144 | character*(len('!"&''&"!')) & ! what a mess! |
---|
145 | foo |
---|
146 | call sub_with_contains_first() |
---|
147 | call sub_with_contains_second() |
---|
148 | call sub_with_contains_third() |
---|
149 | print*, foo |
---|
150 | contains |
---|
151 | subroutine sub_with_contains_first() |
---|
152 | interface |
---|
153 | integer function x() |
---|
154 | end function x |
---|
155 | end interface |
---|
156 | end subroutine sub_with_contains_first |
---|
157 | subroutine sub_with_contains_second() |
---|
158 | end subroutine |
---|
159 | subroutine sub_with_contains_third() |
---|
160 | end subroutine |
---|
161 | end subroutine sub_with_contains |
---|
162 | |
---|
163 | ! A subroutine with a renamed module import |
---|
164 | subroutine sub_with_renamed_import(i_am_dim) |
---|
165 | use bar, only: i_am_not_dim => i_am_dim |
---|
166 | integer, parameter :: d = 2 |
---|
167 | complex :: i_am_dim(d) |
---|
168 | print*, i_am_dim |
---|
169 | end subroutine sub_with_renamed_import |
---|
170 | |
---|
171 | ! A subroutine with an external argument |
---|
172 | subroutine sub_with_external(proc) |
---|
173 | external proc |
---|
174 | call proc() |
---|
175 | end subroutine sub_with_external |
---|
176 | |
---|
177 | ! A subroutine with a variable named "end" |
---|
178 | subroutine sub_with_end() |
---|
179 | integer :: end |
---|
180 | end = 0 |
---|
181 | end subroutine sub_with_end |
---|