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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
! { dg-do run }
! PR 35990 - some empty array sections caused pack to crash.
! Test case contributed by Dick Hendrickson, adjusted and
! extended by Thomas Koenig.
program try_gf1048
call gf1048a( 10, 8, 7, 1, 0, .true.)
call gf1048b( 10, 8, 7, 1, 0, .true.)
call gf1048c( 10, 8, 7, 1, 0, .true.)
call gf1048d( 10, 8, 7, 1, 0, .true.)
call P_inta ( 10, 8, 7, 1, 0, .true.)
call P_intb ( 10, 8, 7, 1, 0, .true.)
call P_intc ( 10, 8, 7, 1, 0, .true.)
call P_intd ( 10, 8, 7, 1, 0, .true.)
end program
SUBROUTINE GF1048a(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(10)
BDA( 8:7) = PACK(BDA1( 10: 1), NF_TRUE)
END SUBROUTINE
SUBROUTINE GF1048b(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
END SUBROUTINE
SUBROUTINE GF1048c(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
SUBROUTINE GF1048d(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
CHARACTER(9) BDA(10)
CHARACTER(9) BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTa(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(10)
BDA( 8:7) = PACK(BDA1( 10: 1), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTb(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF8:NF7), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTc(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
SUBROUTINE P_INTd(nf10,nf8,nf7,nf1,nf0,nf_true)
logical nf_true
INTEGER BDA(10)
INTEGER BDA1(nf10)
BDA(NF8:NF7) = PACK(BDA1(NF10:NF1), NF_TRUE)
END SUBROUTINE
|
