Commit | Line | Data |
---|---|---|
b811d2c2 | 1 | ! Copyright 2019-2020 Free Software Foundation, Inc. |
5bbd8269 AB |
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 | ||
16 | subroutine show (message, array) | |
17 | character (len=*) :: message | |
18 | integer, dimension (:,:) :: array | |
19 | ||
20 | print *, message | |
21 | do i=LBOUND (array, 2), UBOUND (array, 2), 1 | |
22 | do j=LBOUND (array, 1), UBOUND (array, 1), 1 | |
23 | write(*, fmt="(i4)", advance="no") array (j, i) | |
24 | end do | |
25 | print *, "" | |
26 | end do | |
27 | print *, array | |
28 | print *, "" | |
29 | ||
30 | end subroutine show | |
31 | ||
32 | program test | |
33 | ||
34 | interface | |
35 | subroutine show (message, array) | |
36 | character (len=*) :: message | |
37 | integer, dimension(:,:) :: array | |
38 | end subroutine show | |
39 | end interface | |
40 | ||
41 | integer, dimension (1:10,1:10) :: array | |
42 | integer, allocatable :: other (:, :) | |
43 | ||
44 | allocate (other (-5:4, -2:7)) | |
45 | ||
46 | do i=LBOUND (array, 2), UBOUND (array, 2), 1 | |
47 | do j=LBOUND (array, 1), UBOUND (array, 1), 1 | |
48 | array (j,i) = ((i - 1) * UBOUND (array, 2)) + j | |
49 | end do | |
50 | end do | |
51 | ||
52 | do i=LBOUND (other, 2), UBOUND (other, 2), 1 | |
53 | do j=LBOUND (other, 1), UBOUND (other, 1), 1 | |
54 | other (j,i) = ((i - 1) * UBOUND (other, 2)) + j | |
55 | end do | |
56 | end do | |
57 | ||
58 | call show ("array", array) | |
59 | call show ("array (1:5,1:5)", array (1:5,1:5)) | |
60 | call show ("array (1:10:2,1:10:2)", array (1:10:2,1:10:2)) | |
61 | call show ("array (1:10:3,1:10:2)", array (1:10:3,1:10:2)) | |
62 | call show ("array (1:10:5,1:10:3)", array (1:10:4,1:10:3)) | |
63 | ||
64 | call show ("other", other) | |
65 | call show ("other (-5:0, -2:0)", other (-5:0, -2:0)) | |
66 | call show ("other (-5:4:2, -2:7:3)", other (-5:4:2, -2:7:3)) | |
67 | ||
68 | deallocate (other) | |
69 | print *, "" ! Final Breakpoint. | |
70 | end program test |