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
52
53
54
55
56
57
|
module pintrf_mod
implicit none
private
public :: OBJCON
contains
subroutine OBJCON(x)
implicit none
real, intent(in) :: x(:)
end subroutine OBJCON
end module pintrf_mod
module cobylb_mod_procedure_16
contains
subroutine cobylb(calcfc, amat)
use, non_intrinsic :: pintrf_mod, only : OBJCON
implicit none
procedure(OBJCON) :: calcfc
real, intent(in) :: amat(:,:)
call evaluate(calcfc_internal)
contains
subroutine calcfc_internal(x_internal)
implicit none
real, intent(in) :: x_internal(:)
call calcfc(x_internal)
end subroutine calcfc_internal
subroutine evaluate(calcfc)
use, non_intrinsic :: pintrf_mod, only : OBJCON
implicit none
procedure(OBJCON) :: calcfc
call calcfc([1.0, 2.0])
end subroutine evaluate
end subroutine cobylb
end module
program procedure_16
use cobylb_mod_procedure_16
real :: amat(5, 5)
call cobylb(calcfc, amat)
contains
subroutine calcfc(x)
implicit none
real, intent(in) :: x(:)
print *, x
if (abs(sum(x) - 3.0) > 1e-8) error stop
end subroutine calcfc
end program
|
