1! Copyright 2016-2023 Free Software Foundation, Inc. 2! 3! This program is free software; you can redistribute it and/or modify 4! it under the terms of the GNU General Public License as published by 5! the Free Software Foundation; either version 3 of the License, or 6! (at your option) any later version. 7! 8! This program is distributed in the hope that it will be useful, 9! but WITHOUT ANY WARRANTY; without even the implied warranty of 10! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11! GNU General Public License for more details. 12! 13! You should have received a copy of the GNU General Public License 14! along with this program. If not, see <http://www.gnu.org/licenses/>. 15 16module mod1 17 integer :: var_i = 1 18 integer :: var_const 19 parameter (var_const = 20) 20 21CONTAINS 22 23 SUBROUTINE sub_nested_outer 24 integer :: local_int 25 character (len=20) :: name 26 27 name = 'sub_nested_outer_mod1' 28 local_int = 11 29 30 END SUBROUTINE sub_nested_outer 31end module mod1 32 33! Public sub_nested_outer 34SUBROUTINE sub_nested_outer 35 integer :: local_int 36 character (len=16) :: name 37 38 name = 'sub_nested_outer external' 39 local_int = 11 40END SUBROUTINE sub_nested_outer 41 42! Needed indirection to call public sub_nested_outer from main 43SUBROUTINE sub_nested_outer_ind 44 character (len=20) :: name 45 46 name = 'sub_nested_outer_ind' 47 CALL sub_nested_outer 48END SUBROUTINE sub_nested_outer_ind 49 50! public routine with internal subroutine 51SUBROUTINE sub_with_sub_nested_outer() 52 integer :: local_int 53 character (len=16) :: name 54 55 name = 'subroutine_with_int_sub' 56 local_int = 1 57 58 CALL sub_nested_outer ! Should call the internal fct 59 60CONTAINS 61 62 SUBROUTINE sub_nested_outer 63 integer :: local_int 64 local_int = 11 65 END SUBROUTINE sub_nested_outer 66 67END SUBROUTINE sub_with_sub_nested_outer 68 69! Main 70program TestNestedFuncs 71 USE mod1, sub_nested_outer_use_mod1 => sub_nested_outer 72 IMPLICIT NONE 73 74 TYPE :: t_State 75 integer :: code 76 END TYPE t_State 77 78 TYPE (t_State) :: v_state 79 integer index, local_int 80 81 index = 13 82 CALL sub_nested_outer ! Call internal sub_nested_outer 83 CALL sub_nested_outer_ind ! Call external sub_nested_outer via sub_nested_outer_ind 84 CALL sub_with_sub_nested_outer ! Call external routine with nested sub_nested_outer 85 CALL sub_nested_outer_use_mod1 ! Call sub_nested_outer imported via module 86 index = 11 ! BP_main 87 v_state%code = 27 88 89CONTAINS 90 91 SUBROUTINE sub_nested_outer 92 integer local_int 93 local_int = 19 94 v_state%code = index + local_int ! BP_outer 95 call sub_nested_inner 96 local_int = 22 ! BP_outer_2 97 RETURN 98 END SUBROUTINE sub_nested_outer 99 100 SUBROUTINE sub_nested_inner 101 integer local_int 102 local_int = 17 103 v_state%code = index + local_int ! BP_inner 104 RETURN 105 END SUBROUTINE sub_nested_inner 106 107end program TestNestedFuncs 108