[1980] | 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 |
---|