[8] | 1 | |
---|
| 2 | SUBROUTINE vector_axis__new(vect,vect_size) |
---|
| 3 | use mod_xmlio_parameters |
---|
| 4 | IMPLICIT NONE |
---|
| 5 | TYPE(vector_axis), INTENT(INOUT) :: vect |
---|
| 6 | INTEGER, OPTIONAL, INTENT(IN) :: vect_size |
---|
| 7 | |
---|
| 8 | IF (ASSOCIATED(vect%at)) CALL vector_axis__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_axis__new |
---|
| 22 | |
---|
| 23 | SUBROUTINE vector_axis__delete(vect) |
---|
| 24 | IMPLICIT NONE |
---|
| 25 | TYPE(vector_axis), 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 axis__delete() ??? |
---|
| 32 | ENDDO |
---|
| 33 | |
---|
| 34 | IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at) |
---|
| 35 | vect%size_max=0 |
---|
| 36 | |
---|
| 37 | END SUBROUTINE vector_axis__delete |
---|
| 38 | |
---|
| 39 | SUBROUTINE vector_axis__get_new(vect,pt_value,pos) |
---|
| 40 | IMPLICIT NONE |
---|
| 41 | |
---|
| 42 | TYPE(vector_axis), INTENT(INOUT) :: vect |
---|
| 43 | TYPE(axis),POINTER :: pt_value |
---|
| 44 | INTEGER,OPTIONAL,INTENT(OUT) :: Pos |
---|
| 45 | |
---|
| 46 | IF (vect%size==vect%size_max) CALL vector_axis__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_axis__get_new |
---|
| 55 | |
---|
| 56 | SUBROUTINE vector_axis__set_new(vect,pt_value,pos) |
---|
| 57 | IMPLICIT NONE |
---|
| 58 | |
---|
| 59 | TYPE(vector_axis), INTENT(INOUT) :: vect |
---|
| 60 | TYPE(axis),POINTER :: pt_value |
---|
| 61 | INTEGER,OPTIONAL,INTENT(OUT) :: Pos |
---|
| 62 | |
---|
| 63 | IF (vect%size==vect%size_max) CALL vector_axis__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_axis__set_new |
---|
| 71 | |
---|
| 72 | SUBROUTINE vector_axis__increase(vect) |
---|
| 73 | TYPE(vector_axis), INTENT(INOUT) :: vect |
---|
[17] | 74 | TYPE (Pt_axis__), POINTER, DIMENSION(:) :: Pt_tmp |
---|
[8] | 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_axis__increase |
---|
| 89 | |
---|