1 | MODULE buffer_mod |
---|
2 | |
---|
3 | PRIVATE |
---|
4 | REAL,PARAMETER :: grow_factor=1.5 |
---|
5 | |
---|
6 | INTEGER, POINTER, SAVE :: buffer_i(:) |
---|
7 | INTEGER,SAVE :: size_buffer_i = 0 |
---|
8 | !$OMP THREADPRIVATE(buffer_i,size_buffer_i) |
---|
9 | |
---|
10 | REAL,POINTER,SAVE :: buffer_r(:) |
---|
11 | INTEGER,SAVE :: size_buffer_r = 0 |
---|
12 | !$OMP THREADPRIVATE(buffer_r,size_buffer_r) |
---|
13 | |
---|
14 | LOGICAL,POINTER,SAVE :: buffer_l(:) |
---|
15 | INTEGER,SAVE :: size_buffer_l = 0 |
---|
16 | !$OMP THREADPRIVATE(buffer_l,size_buffer_l) |
---|
17 | |
---|
18 | CHARACTER,POINTER,SAVE :: buffer_c(:) |
---|
19 | INTEGER,SAVE :: size_buffer_c = 0 |
---|
20 | !$OMP THREADPRIVATE(buffer_c,size_buffer_c) |
---|
21 | |
---|
22 | INTERFACE get_buffer |
---|
23 | MODULE PROCEDURE get_buffer_i, get_buffer_r, get_buffer_l, get_buffer_c |
---|
24 | END INTERFACE |
---|
25 | |
---|
26 | PUBLIC :: get_buffer |
---|
27 | |
---|
28 | CONTAINS |
---|
29 | |
---|
30 | SUBROUTINE get_buffer_i(buff,buff_size) |
---|
31 | IMPLICIT NONE |
---|
32 | INTEGER,POINTER :: buff(:) |
---|
33 | INTEGER,INTENT(IN) :: buff_size |
---|
34 | |
---|
35 | IF (buff_size>size_buffer_i) THEN |
---|
36 | DEALLOCATE(buffer_i) |
---|
37 | size_buffer_i=MAX(2,INT(size_buffer_i*grow_factor)) |
---|
38 | ALLOCATE(buffer_i(size_buffer_i)) |
---|
39 | ENDIF |
---|
40 | |
---|
41 | buff=>buffer_i |
---|
42 | END SUBROUTINE get_buffer_i |
---|
43 | |
---|
44 | SUBROUTINE get_buffer_r(buff,buff_size) |
---|
45 | IMPLICIT NONE |
---|
46 | REAL,POINTER :: buff(:) |
---|
47 | INTEGER,INTENT(IN) :: buff_size |
---|
48 | |
---|
49 | IF (buff_size>size_buffer_r) THEN |
---|
50 | DEALLOCATE(buffer_r) |
---|
51 | size_buffer_r=MAX(2,INT(size_buffer_r*grow_factor)) |
---|
52 | ALLOCATE(buffer_r(size_buffer_r)) |
---|
53 | ENDIF |
---|
54 | |
---|
55 | buff=>buffer_r |
---|
56 | END SUBROUTINE get_buffer_r |
---|
57 | |
---|
58 | SUBROUTINE get_buffer_l(buff,buff_size) |
---|
59 | IMPLICIT NONE |
---|
60 | LOGICAL,POINTER :: buff(:) |
---|
61 | INTEGER,INTENT(IN) :: buff_size |
---|
62 | |
---|
63 | IF (buff_size>size_buffer_l) THEN |
---|
64 | DEALLOCATE(buffer_l) |
---|
65 | size_buffer_l=MAX(2,INT(size_buffer_l*grow_factor)) |
---|
66 | ALLOCATE(buffer_l(size_buffer_l)) |
---|
67 | ENDIF |
---|
68 | |
---|
69 | buff=>buffer_l |
---|
70 | END SUBROUTINE get_buffer_l |
---|
71 | |
---|
72 | SUBROUTINE get_buffer_c(buff,buff_size) |
---|
73 | IMPLICIT NONE |
---|
74 | CHARACTER,POINTER :: buff(:) |
---|
75 | INTEGER,INTENT(IN) :: buff_size |
---|
76 | |
---|
77 | IF (buff_size>size_buffer_c) THEN |
---|
78 | DEALLOCATE(buffer_c) |
---|
79 | size_buffer_c=MAX(2,INT(size_buffer_c*grow_factor)) |
---|
80 | ALLOCATE(buffer_c(size_buffer_c)) |
---|
81 | ENDIF |
---|
82 | |
---|
83 | buff=>buffer_c |
---|
84 | END SUBROUTINE get_buffer_c |
---|
85 | |
---|
86 | END MODULE buffer_mod |
---|