1 ! Program to test the ASSOCIATED intrinsic with cross-kinds
2 program intrinsic_associated_2
3 logical*4 :: t4
, L44
, L48
4 logical*8 :: t8
, L84
, L88
5 real*4, pointer :: a4p(:, :)
6 real*8, pointer :: a8p(:, :)
7 real*4, target
:: a4(10, 10)
8 real*8, target
:: a8(10, 10)
15 L44
= t4
.and
. associated (a4p
, a4
)
16 L84
= t8
.and
. associated (a4p
, a4
)
17 L48
= t4
.and
. associated (a8p
, a8
)
18 L88
= t8
.and
. associated (a8p
, a8
)
19 if (.not
. (L44
.and
. L84
.and
. L48
.and
. L88
)) call abort ()
22 L44
= t4
.and
. associated (a4p
, a4
)
23 L84
= t8
.and
. associated (a4p
, a4
)
24 L48
= t4
.and
. associated (a8p
, a8
)
25 L88
= t8
.and
. associated (a8p
, a8
)
26 if (L44
.and
. L84
.and
. L48
.and
. L88
) call abort ()
28 a4p
=> a4(1:10:2, 1:10:2)
30 L44
= t4
.and
. associated (a4p
, a4(1:10:2, 1:10:2))
31 L84
= t8
.and
. associated (a4p
, a4(1:10:2, 1:10:2))
32 L48
= t4
.and
. associated (a8p
, a8(1:4, 1:4))
33 L88
= t8
.and
. associated (a8p
, a8(1:4, 1:4))
34 if (.not
. (L44
.and
. L84
.and
. L48
.and
. L88
)) call abort ()