New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Fortran-extract-interface-source.f90 in branches/NERC/dev_r5518_NOC_unchanged/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build – NEMO

source: branches/NERC/dev_r5518_NOC_unchanged/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90 @ 6240

Last change on this file since 6240 was 6240, checked in by jpalmier, 8 years ago

JPALM -- 13-01-2016 -- clean svn_key

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