source: XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90 @ 29

Last change on this file since 29 was 29, checked in by ymipsl, 15 years ago

New Features :

  • Les zoom sont maintenant utilisables.
  • Lorsqu'un serveur ne sort pas de données dans un fichier, le fichier n'est pas crée.
  • Lorsqu'un serveur est le seul a sortir un fichier, l'indexation par numero de process est supprimé.
  • Les axes verticaux ont maintenant un attribut << positive [TRUE/FALSE]>>
File size: 6.6 KB
Line 
1MODULE mod_field_group
2
3  USE mod_field
4  USE mod_xmlio_parameters
5
6  IMPLICIT NONE
7
8  TYPE field_group
9    CHARACTER(LEN=str_len)                    :: id
10    LOGICAL                                   :: has_id
11    TYPE(vector_field_group), POINTER         :: groups
12    TYPE(vector_field),POINTER                :: fields     
13    TYPE(field), POINTER                      :: default_attribut
14  END TYPE field_group
15
16  INCLUDE "vector_field_group_def.inc" 
17
18  TYPE(vector_field_group),SAVE,POINTER      :: field_group_Ids
19  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
20
21CONTAINS
22
23  INCLUDE "vector_field_group_contains.inc"
24
25
26  SUBROUTINE field_group__swap_context(saved_field_group_ids, saved_ids)
27  IMPLICIT NONE
28    TYPE(vector_field_group),POINTER   :: saved_field_group_Ids
29    TYPE(sorted_list),POINTER          :: saved_Ids
30   
31    field_group_ids=>saved_field_group_ids 
32    ids=>saved_ids
33   
34  END SUBROUTINE field_group__swap_context
35
36  SUBROUTINE field_group__init
37  IMPLICIT NONE
38   
39    CALL vector_field_group__new(field_group_Ids)
40    CALL sorted_list__new(Ids)
41   
42  END SUBROUTINE field_group__init
43
44  SUBROUTINE field_group__get(Id,Pt_fg)
45  USE string_function
46  IMPLICIT NONE
47    CHARACTER(LEN=*),INTENT(IN)     :: Id
48    TYPE(field_group),POINTER       :: Pt_fg
49
50    INTEGER                         :: Pos
51    LOGICAL                         :: success
52   
53    CALL sorted_list__find(Ids,hash(Id),Pos,success)
54    IF (success) THEN
55      Pt_fg=>field_group_ids%at(Pos)%Pt
56    ELSE
57      Pt_fg=>NULL()
58    ENDIF
59   
60  END SUBROUTINE field_group__get
61   
62  RECURSIVE SUBROUTINE field_group__new(Pt_fg,Id)
63  USE string_function
64  IMPLICIT NONE
65    TYPE(field_group),POINTER                :: Pt_fg
66    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
67   
68    INTEGER :: Pos
69   
70    ALLOCATE(Pt_fg%groups)
71    ALLOCATE(Pt_fg%fields)
72    ALLOCATE(Pt_fg%default_attribut)
73   
74    CALL vector_field_group__new(Pt_fg%groups)
75    CALL vector_field__new(Pt_fg%fields)
76    CALL field__new(Pt_fg%default_attribut)
77    Pt_fg%has_id=.FALSE.
78     
79    IF (PRESENT(Id)) THEN
80      Pt_fg%id=TRIM(Id)
81      Pt_fg%has_id=.TRUE.
82      CALL vector_field_group__set_new(field_group_Ids,Pt_fg,Pos)
83      CALL sorted_list__Add(Ids,hash(id),Pos)
84    ENDIF
85
86  END SUBROUTINE field_group__new
87
88     
89  SUBROUTINE field_group__get_new_group(Pt_fg,Pt_fg_out,Id)
90  IMPLICIT NONE
91    TYPE(field_group),POINTER            :: Pt_fg
92    TYPE(field_group),POINTER            :: Pt_fg_out
93    CHARACTER(LEN=*),OPTIONAL      :: Id
94   
95    CALL vector_field_group__get_new(Pt_fg%groups,Pt_fg_out)
96 
97    IF (PRESENT(id)) THEN
98      CALL field_group__new(Pt_fg_out,Id)
99    ELSE
100      CALL field_group__new(Pt_fg_out)
101    ENDIF
102   
103  END SUBROUTINE field_group__get_new_group
104
105 
106  SUBROUTINE field_group__get_new_field(Pt_fg,Pt_f_out,Id)
107  IMPLICIT NONE
108    TYPE(field_group),POINTER            :: Pt_fg
109    TYPE(field),POINTER                  :: Pt_f_out
110    CHARACTER(LEN=*),OPTIONAL      :: Id
111   
112    CALL vector_field__get_new(Pt_fg%fields,Pt_f_out)
113   
114    IF (PRESENT(id)) THEN
115      CALL field__new(Pt_f_out,Id)
116    ELSE
117      CALL field__new(Pt_f_out)
118    ENDIF
119   
120  END SUBROUTINE field_group__get_new_field
121 
122 
123  SUBROUTINE field_group__get_default_attrib(Pt_fg,Pt_f)
124  IMPLICIT NONE
125    TYPE(field_group),POINTER  :: Pt_fg
126    TYPE(field),POINTER        :: Pt_f
127   
128    Pt_f=>Pt_fg%default_attribut
129  END SUBROUTINE field_group__get_default_attrib
130
131 
132  RECURSIVE SUBROUTINE field_group__apply_default(Pt_fg,default)
133  IMPLICIT NONE
134    TYPE(field_group),POINTER           :: Pt_fg
135    TYPE(field),POINTER,OPTIONAL        :: default
136   
137    INTEGER :: i
138   
139    IF (PRESENT(default)) THEN
140      CALL field__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
141    ENDIF
142     
143    DO i=1,Pt_fg%groups%size
144      CALL field_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
145    ENDDO
146   
147    DO i=1,Pt_fg%fields%size
148      CALL field__apply_default(Pt_fg%default_attribut,Pt_fg%fields%at(i)%pt,Pt_fg%fields%at(i)%pt)
149    ENDDO
150 
151  END SUBROUTINE field_group__apply_default
152 
153  SUBROUTINE field_group__solve_ref(pt_fg)
154  IMPLICIT NONE
155    TYPE(field_group),POINTER  :: Pt_fg
156
157    CALL field_group__solve_field_ref(Pt_fg)
158    CALL field_group__solve_axis_ref(Pt_fg)
159    CALL field_group__solve_grid_ref(Pt_fg)
160    CALL field_group__solve_zoom_ref(Pt_fg)
161
162  END SUBROUTINE  field_group__solve_ref
163     
164  RECURSIVE SUBROUTINE field_group__solve_field_ref(Pt_fg)
165  IMPLICIT NONE
166    TYPE(field_group),POINTER  :: Pt_fg
167   
168    INTEGER :: i
169
170    DO i=1,Pt_fg%groups%size
171      CALL field_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
172    ENDDO
173   
174    DO i=1,Pt_fg%fields%size
175      CALL field__solve_field_ref(Pt_fg%fields%at(i)%pt)
176    ENDDO
177 
178  END SUBROUTINE field_group__solve_field_ref
179
180  RECURSIVE SUBROUTINE field_group__solve_axis_ref(Pt_fg)
181  IMPLICIT NONE
182    TYPE(field_group),POINTER  :: Pt_fg
183   
184    INTEGER :: i
185
186    DO i=1,Pt_fg%groups%size
187      CALL field_group__solve_axis_ref(Pt_fg%groups%at(i)%pt)
188    ENDDO
189   
190    DO i=1,Pt_fg%fields%size
191      CALL field__solve_axis_ref(Pt_fg%fields%at(i)%pt)
192    ENDDO
193 
194  END SUBROUTINE field_group__solve_axis_ref
195
196  RECURSIVE SUBROUTINE field_group__solve_grid_ref(Pt_fg)
197  IMPLICIT NONE
198    TYPE(field_group),POINTER  :: Pt_fg
199     
200    INTEGER :: i
201 
202    DO i=1,Pt_fg%groups%size
203      CALL field_group__solve_grid_ref(Pt_fg%groups%at(i)%pt)
204    ENDDO
205       
206    DO i=1,Pt_fg%fields%size
207      CALL field__solve_grid_ref(Pt_fg%fields%at(i)%pt)
208    ENDDO
209 
210  END SUBROUTINE field_group__solve_grid_ref
211
212  RECURSIVE SUBROUTINE field_group__solve_zoom_ref(Pt_fg)
213  IMPLICIT NONE
214    TYPE(field_group),POINTER  :: Pt_fg
215     
216    INTEGER :: i
217 
218    DO i=1,Pt_fg%groups%size
219      CALL field_group__solve_zoom_ref(Pt_fg%groups%at(i)%pt)
220    ENDDO
221       
222    DO i=1,Pt_fg%fields%size
223      CALL field__solve_zoom_ref(Pt_fg%fields%at(i)%pt)
224    ENDDO
225 
226  END SUBROUTINE field_group__solve_zoom_ref
227 
228  RECURSIVE SUBROUTINE field_group__print(Pt_fg)
229  IMPLICIT NONE
230    TYPE(field_group),POINTER  :: Pt_fg
231   
232    INTEGER :: i
233   
234    PRINT *,"--- FIELD GROUP ---"
235    IF (Pt_fg%has_id) THEN
236      PRINT *,"id :",TRIM(Pt_fg%id)
237    ELSE
238      PRINT *,"id undefined"
239    ENDIF
240   
241    PRINT *,"field default attribut :"
242    CALL field__print(Pt_fg%default_attribut)   
243
244    PRINT *,"owned field groups :",Pt_fg%groups%size     
245    DO i=1,Pt_fg%groups%size
246      CALL field_group__print(Pt_fg%groups%at(i)%pt)
247    ENDDO
248
249    PRINT *,"owned field :",Pt_fg%fields%size     
250    DO i=1,Pt_fg%fields%size
251      CALL field__print(Pt_fg%fields%at(i)%pt)
252    ENDDO
253   
254    PRINT *,"------------"
255   
256  END SUBROUTINE field_group__print     
257
258END MODULE mod_field_group
Note: See TracBrowser for help on using the repository browser.