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

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

Mise à jour importante :

  • ajout de la grille type LMDZ
  • ajout des context
  • ajout de namelist pour parametrer l'utilisation du server : avec/sans MPI, en utlisant ou pas OASIS
File size: 6.2 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
161  END SUBROUTINE  field_group__solve_ref
162     
163  RECURSIVE SUBROUTINE field_group__solve_field_ref(Pt_fg)
164  IMPLICIT NONE
165    TYPE(field_group),POINTER  :: Pt_fg
166   
167    INTEGER :: i
168
169    DO i=1,Pt_fg%groups%size
170      CALL field_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
171    ENDDO
172   
173    DO i=1,Pt_fg%fields%size
174      CALL field__solve_field_ref(Pt_fg%fields%at(i)%pt)
175    ENDDO
176 
177  END SUBROUTINE field_group__solve_field_ref
178
179  RECURSIVE SUBROUTINE field_group__solve_axis_ref(Pt_fg)
180  IMPLICIT NONE
181    TYPE(field_group),POINTER  :: Pt_fg
182   
183    INTEGER :: i
184
185    DO i=1,Pt_fg%groups%size
186      CALL field_group__solve_axis_ref(Pt_fg%groups%at(i)%pt)
187    ENDDO
188   
189    DO i=1,Pt_fg%fields%size
190      CALL field__solve_axis_ref(Pt_fg%fields%at(i)%pt)
191    ENDDO
192 
193  END SUBROUTINE field_group__solve_axis_ref
194
195  RECURSIVE SUBROUTINE field_group__solve_grid_ref(Pt_fg)
196  IMPLICIT NONE
197    TYPE(field_group),POINTER  :: Pt_fg
198     
199    INTEGER :: i
200 
201    DO i=1,Pt_fg%groups%size
202      CALL field_group__solve_grid_ref(Pt_fg%groups%at(i)%pt)
203    ENDDO
204       
205    DO i=1,Pt_fg%fields%size
206      CALL field__solve_grid_ref(Pt_fg%fields%at(i)%pt)
207    ENDDO
208 
209  END SUBROUTINE field_group__solve_grid_ref
210 
211  RECURSIVE SUBROUTINE field_group__print(Pt_fg)
212  IMPLICIT NONE
213    TYPE(field_group),POINTER  :: Pt_fg
214   
215    INTEGER :: i
216   
217    PRINT *,"--- FIELD GROUP ---"
218    IF (Pt_fg%has_id) THEN
219      PRINT *,"id :",TRIM(Pt_fg%id)
220    ELSE
221      PRINT *,"id undefined"
222    ENDIF
223   
224    PRINT *,"field default attribut :"
225    CALL field__print(Pt_fg%default_attribut)   
226
227    PRINT *,"owned field groups :",Pt_fg%groups%size     
228    DO i=1,Pt_fg%groups%size
229      CALL field_group__print(Pt_fg%groups%at(i)%pt)
230    ENDDO
231
232    PRINT *,"owned field :",Pt_fg%fields%size     
233    DO i=1,Pt_fg%fields%size
234      CALL field__print(Pt_fg%fields%at(i)%pt)
235    ENDDO
236   
237    PRINT *,"------------"
238   
239  END SUBROUTINE field_group__print     
240
241END MODULE mod_field_group
Note: See TracBrowser for help on using the repository browser.