1 | |
---|
2 | SUBROUTINE vector_file_group__new(vect,vect_size) |
---|
3 | use mod_xmlio_parameters |
---|
4 | IMPLICIT NONE |
---|
5 | TYPE(vector_file_group), INTENT(INOUT) :: vect |
---|
6 | INTEGER, OPTIONAL, INTENT(IN) :: vect_size |
---|
7 | |
---|
8 | IF (ASSOCIATED(vect%at)) CALL vector_file_group__delete(vect) |
---|
9 | |
---|
10 | IF (PRESENT(vect_size)) THEN |
---|
11 | vect%size_max=MAX(1,vect_size) |
---|
12 | ELSE |
---|
13 | vect%size_max=default_vector_size |
---|
14 | ENDIF |
---|
15 | |
---|
16 | ALLOCATE(vect%at(vect%size_max)) |
---|
17 | |
---|
18 | vect%size=0 |
---|
19 | vect%grow_factor=default_vector_grow_factor |
---|
20 | |
---|
21 | END SUBROUTINE vector_file_group__new |
---|
22 | |
---|
23 | SUBROUTINE vector_file_group__delete(vect) |
---|
24 | IMPLICIT NONE |
---|
25 | TYPE(vector_file_group), INTENT(IN OUT) :: vect |
---|
26 | |
---|
27 | INTEGER :: i |
---|
28 | |
---|
29 | DO i=1,vect%size |
---|
30 | IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt) |
---|
31 | ! doit-on avoir une subroutine du genre : CALL file_group__delete() ??? |
---|
32 | ENDDO |
---|
33 | |
---|
34 | IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at) |
---|
35 | vect%size_max=0 |
---|
36 | |
---|
37 | END SUBROUTINE vector_file_group__delete |
---|
38 | |
---|
39 | SUBROUTINE vector_file_group__get_new(vect,pt_value,pos) |
---|
40 | IMPLICIT NONE |
---|
41 | |
---|
42 | TYPE(vector_file_group), INTENT(INOUT) :: vect |
---|
43 | TYPE(file_group),POINTER :: pt_value |
---|
44 | INTEGER,OPTIONAL,INTENT(OUT) :: Pos |
---|
45 | |
---|
46 | IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect) |
---|
47 | |
---|
48 | vect%size=vect%size+1 |
---|
49 | ALLOCATE(vect%at(vect%size)%pt) |
---|
50 | vect%at(vect%size)%owned=.TRUE. |
---|
51 | pt_value=>vect%at(vect%size)%pt |
---|
52 | IF (PRESENT(pos)) pos=vect%size |
---|
53 | |
---|
54 | END SUBROUTINE vector_file_group__get_new |
---|
55 | |
---|
56 | SUBROUTINE vector_file_group__set_new(vect,pt_value,pos) |
---|
57 | IMPLICIT NONE |
---|
58 | |
---|
59 | TYPE(vector_file_group), INTENT(INOUT) :: vect |
---|
60 | TYPE(file_group),POINTER :: pt_value |
---|
61 | INTEGER,OPTIONAL,INTENT(OUT) :: Pos |
---|
62 | |
---|
63 | IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect) |
---|
64 | |
---|
65 | vect%size=vect%size+1 |
---|
66 | vect%at(vect%size)%pt=>pt_value |
---|
67 | vect%at(vect%size)%owned=.FALSE. |
---|
68 | IF (PRESENT(pos)) pos=vect%size |
---|
69 | |
---|
70 | END SUBROUTINE vector_file_group__set_new |
---|
71 | |
---|
72 | SUBROUTINE vector_file_group__increase(vect) |
---|
73 | TYPE(vector_file_group), INTENT(INOUT) :: vect |
---|
74 | TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: Pt_tmp |
---|
75 | INTEGER :: new_size |
---|
76 | INTEGER :: i |
---|
77 | |
---|
78 | vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor)) |
---|
79 | ALLOCATE(Pt_tmp(vect%size_max)) |
---|
80 | |
---|
81 | DO i=1,vect%size |
---|
82 | Pt_tmp(i)%pt=>vect%at(i)%pt |
---|
83 | ENDDO |
---|
84 | |
---|
85 | DEALLOCATE(vect%at) |
---|
86 | vect%at=>Pt_tmp |
---|
87 | |
---|
88 | END SUBROUTINE vector_file_group__increase |
---|
89 | |
---|