New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
vector_file_group_contains.inc in branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 13 years ago

set proper svn properties to all files...

  • Property svn:keywords set to Id
File size: 2.5 KB
Line 
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   
Note: See TracBrowser for help on using the repository browser.