1program sample
2 implicit none
3
4 integer, pointer :: iptr
5 integer, target :: i, j
6
7 integer :: lb(2), ub(2)
8 integer, pointer :: rptr(:, :)
9 integer, target :: x(9, 9)
10
11 i = 5
12 j = 9
13
14 ! 出力は iptr = 5, i = 5, j = 9
15 iptr => i
16 write(*, '(" iptr = ", i3, ", i = ", i3, ", j = ", i3)') iptr, i, j
17
18 ! 出力は iptr = 9, i = 5, j = 9
19 iptr => j
20 write(*, '(" iptr = ", i3, ", i = ", i3, ", j = ", i3)') iptr, i, j
21
22 ! 出力は iptr = 0, i = 5, j = 0
23 iptr = 0
24 write(*, '(" iptr = ", i3, ", i = ", i3, ", j = ", i3)') iptr, i, j
25
26 ! 結合を解除
27 if(associated(iptr)) then
28 nullify(iptr)
29 endif
30
31 ! 無名領域との結合
32 allocate(iptr)
33 iptr = 1
34
35 ! 結合を解除
36 deallocate(iptr)
37
38 !
39 ! 配列に対するポインタ
40 !
41 do j = 1, 9
42 do i = 1, 9
43 x(i, j) = i + (j - 1) * 9
44 enddo
45 enddo
46
47 ! 部分配列へ結合
48 rptr => x(2:4, 2:6)
49
50 lb = lbound(rptr) ! (/1, 1/)
51 ub = ubound(rptr) ! (/3, 5/)
52
53 write(*, *) '--- pointer array ---'
54 do j = lb(2), ub(2)
55 do i = lb(1), ub(1)
56 write(*, fmt='(i7)', advance='no') rptr(i, j)
57 enddo
58 write(*, *)
59 enddo
60
61 ! targetを変更 => pointerにも反映される
62 x(3, 3) = -1.0
63
64 write(*, *) '--- pointer array (modified) ---'
65 do j = lb(2), ub(2)
66 do i = lb(1), ub(1)
67 write(*, fmt='(i7)', advance='no') rptr(i, j)
68 enddo
69 write(*, *)
70 enddo
71
72 ! 結合状態を解除
73 nullify(rptr)
74
75 ! pointerにメモリを割りつける(無名領域との結合)
76 if(.not. associated(rptr)) then
77 allocate(rptr(9, 9))
78 endif
79
80 ! この場合これはxの内容をrptrにコピー(=>と=の違いに注意)
81 rptr = x
82
83 ! これはpointerには反映されない
84 x(3, 3) = 0
85
86 write(*, *) '--- allocated pointer array ---'
87 do j = 1, 9
88 do i = 1, 9
89 write(*, fmt='(i7)', advance='no') rptr(i, j)
90 enddo
91 write(*, *)
92 enddo
93
94 deallocate(rptr)
95
96 stop
97endprogram sample