source: XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.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: 8.9 KB
Line 
1MODULE mod_event_server
2  USE mod_pack, ONLY : unpack, unpack_field
3  USE mod_event_parameters
4  USE iomanager
5 
6CONTAINS
7
8  SUBROUTINE Process_event(current_rank,is_terminated)
9  IMPLICIT NONE
10    INTEGER :: event_id
11    INTEGER, INTENT(IN) :: current_rank
12    LOGICAL,INTENT(OUT) :: is_terminated
13     
14    CALL iom__set_current_rank(current_rank)
15     
16    is_terminated=.FALSE.
17   
18    CALL unpack(event_id)
19   
20    SELECT CASE (event_id)
21   
22      CASE (event_id_swap_context)
23        CALL event__swap_context
24       
25      CASE (event_id_parse_xml_file)
26        CALL event__parse_xml_file 
27
28      CASE (event_id_set_vert_axis)
29        CALL event__set_vert_axis 
30     
31      CASE (event_id_set_grid_dimension)
32        CALL event__set_grid_dimension
33     
34      CASE (event_id_set_grid_domain)
35        CALL event__set_grid_domain
36
37      CASE (event_id_set_grid_type_nemo)
38        CALL event__set_grid_type_nemo
39
40      CASE (event_id_set_grid_type_lmdz)
41        CALL event__set_grid_type_lmdz
42
43      CASE (event_id_set_time_parameters)
44        CALL event__set_time_parameters
45
46      CASE (event_id_close_io_definition)
47        CALL event__close_io_definition 
48
49      CASE (event_id_set_timestep)
50        CALL event__set_timestep
51
52      CASE (event_id_enable_field)
53        CALL event__enable_field
54     
55      CASE (event_id_disable_field)
56        CALL event__disable_field
57
58      CASE (event_id_write_Field1d)
59        CALL event__write_Field1d
60
61      CASE (event_id_write_Field2d)
62        CALL event__write_Field2d
63
64      CASE (event_id_write_Field3d)
65        CALL event__write_Field3d
66
67      CASE (event_id_stop_ioserver)
68        is_terminated=.TRUE. 
69        PRINT *,"TERMINATE_EVENT RECEIVED"
70
71      CASE DEFAULT 
72        STOP 'UNDEFINED EVENT'
73     
74     END SELECT
75     
76   END SUBROUTINE Process_event
77   
78  SUBROUTINE event__swap_context
79  IMPLICIT NONE
80    INTEGER :: id_size
81   
82    CALL unpack(id_size)
83    CALL sub_internal(id_size)
84     
85  CONTAINS
86   
87    SUBROUTINE sub_internal(id_size)
88      INTEGER :: id_size
89      CHARACTER(LEN=id_size) :: id     
90     
91       CALL unpack(id)
92     
93       CALL iom__swap_context(id)
94       
95     END SUBROUTINE sub_internal
96 
97  END SUBROUTINE event__swap_context
98 
99
100  SUBROUTINE event__parse_xml_file
101  IMPLICIT NONE
102    INTEGER :: name_size
103   
104    CALL unpack(name_size)
105    CALL sub_internal(name_size)
106     
107  CONTAINS
108   
109    SUBROUTINE sub_internal(name_size)
110      INTEGER :: name_size
111      CHARACTER(LEN=name_size) :: filename     
112     
113       CALL unpack(filename)
114     
115       CALL iom__parse_xml_file(filename)
116     END SUBROUTINE sub_internal
117 
118  END SUBROUTINE event__parse_xml_file
119 
120 
121  SUBROUTINE event__set_grid_dimension
122  IMPLICIT NONE   
123    INTEGER :: name_size
124    INTEGER :: ni_glo
125    INTEGER :: nj_glo
126   
127    CALL unpack(name_size)
128    CALL sub_internal(name_size)
129     
130  CONTAINS
131   
132    SUBROUTINE sub_internal(name_size)
133      INTEGER :: name_size
134      CHARACTER(LEN=name_size) :: name     
135     
136       CALL unpack(name)
137       CALL unpack(ni_glo)
138       CALL unpack(nj_glo)
139     
140       CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
141     END SUBROUTINE sub_internal
142   
143   END SUBROUTINE event__set_grid_dimension
144
145
146  SUBROUTINE event__set_grid_domain 
147  IMPLICIT NONE   
148    INTEGER :: name_size
149    INTEGER :: ni
150    INTEGER :: nj
151    INTEGER :: ibegin
152    INTEGER :: jbegin
153    REAL,ALLOCATABLE :: lon(:,:)
154    REAL,ALLOCATABLE :: lat(:,:)
155
156    CALL unpack(name_size)
157    CALL sub_internal(name_size)
158     
159  CONTAINS
160   
161    SUBROUTINE sub_internal(name_size)
162      INTEGER :: name_size
163      CHARACTER(LEN=name_size) :: name     
164     
165       CALL unpack(name)
166   
167       CALL unpack(ni)
168       CALL unpack(nj)
169       CALL unpack(ibegin)
170       CALL unpack(jbegin)
171   
172       ALLOCATE(lon(ni,nj))
173       ALLOCATE(lat(ni,nj))
174       CALL unpack(lon)
175       CALL unpack(lat)
176   
177       CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
178
179     END SUBROUTINE sub_internal
180   
181  END SUBROUTINE event__set_grid_domain   
182
183
184  SUBROUTINE event__set_grid_type_nemo 
185  IMPLICIT NONE   
186    INTEGER :: name_size
187
188    CALL unpack(name_size)
189    CALL sub_internal(name_size)
190     
191  CONTAINS
192   
193    SUBROUTINE sub_internal(name_size)
194      INTEGER :: name_size
195      CHARACTER(LEN=name_size) :: name     
196     
197       CALL unpack(name)
198       CALL iom__set_grid_type_nemo(name)
199
200     END SUBROUTINE sub_internal
201   
202  END SUBROUTINE event__set_grid_type_nemo   
203
204  SUBROUTINE event__set_grid_type_lmdz 
205  IMPLICIT NONE   
206    INTEGER :: name_size
207
208    CALL unpack(name_size)
209    CALL sub_internal(name_size)
210     
211  CONTAINS
212   
213    SUBROUTINE sub_internal(name_size)
214      INTEGER :: name_size
215      CHARACTER(LEN=name_size) :: name     
216      INTEGER                  :: nbp
217      INTEGER                  :: offset
218     
219       CALL unpack(name)
220       CALL unpack(nbp)
221       CALL unpack(offset)
222       CALL iom__set_grid_type_lmdz(name,nbp,offset)
223
224     END SUBROUTINE sub_internal
225   
226  END SUBROUTINE event__set_grid_type_lmdz   
227
228  SUBROUTINE event__set_vert_axis
229  IMPLICIT NONE
230    INTEGER :: name_size
231    INTEGER :: vert_size 
232    REAL,ALLOCATABLE :: vert_value(:)
233   
234    CALL unpack(name_size)
235    CALL sub_internal(name_size)
236
237  CONTAINS
238   
239    SUBROUTINE sub_internal(name_size)
240      INTEGER :: name_size
241      CHARACTER(LEN=name_size) :: name
242   
243      CALL unpack(name)
244      CALL unpack(vert_size)
245      ALLOCATE(vert_value(vert_size))
246      CALL unpack(vert_value) 
247     
248      CALL iom__set_vert_axis(name,vert_value)
249     
250    END SUBROUTINE sub_internal
251  END SUBROUTINE event__set_vert_axis
252
253  SUBROUTINE event__set_time_parameters
254  IMPLICIT NONE
255    INTEGER   :: itau0
256    REAL      :: zjulian
257    REAL      :: zdt
258     
259    CALL unpack(itau0)
260    CALL unpack(zjulian)
261    CALL unpack(zdt)
262   
263    CALL iom__set_time_parameters(itau0,zjulian,zdt)
264     
265  END SUBROUTINE event__set_time_parameters
266 
267
268  SUBROUTINE event__enable_field
269  IMPLICIT NONE
270    INTEGER :: lenc
271     
272    CALL unpack(lenc)
273    CALL sub_internal(lenc)
274 
275  CONTAINS
276    SUBROUTINE sub_internal(lenc)
277    IMPLICIT NONE
278      INTEGER :: lenc
279      CHARACTER(len=lenc) :: varname
280     
281      CALL unpack(varname)
282     
283      CALL iom__enable_field(varname)
284
285    END SUBROUTINE sub_internal
286  END SUBROUTINE event__enable_field
287 
288
289  SUBROUTINE event__disable_field
290  IMPLICIT NONE
291    INTEGER :: lenc
292     
293    CALL unpack(lenc)
294    CALL sub_internal(lenc)
295 
296  CONTAINS
297    SUBROUTINE sub_internal(lenc)
298    IMPLICIT NONE
299      INTEGER :: lenc
300      CHARACTER(len=lenc) :: varname
301     
302      CALL unpack(varname)
303     
304      CALL iom__disable_field(varname)
305
306    END SUBROUTINE sub_internal
307   
308  END SUBROUTINE event__disable_field
309 
310     
311  SUBROUTINE event__write_field1D
312  IMPLICIT NONE
313    INTEGER :: lenc
314    INTEGER :: dim1
315     
316    CALL unpack(lenc)
317    CALL unpack(dim1)
318    CALL sub_internal(lenc,dim1)
319 
320  CONTAINS
321    SUBROUTINE sub_internal(lenc,dim1)
322    IMPLICIT NONE
323      INTEGER :: lenc
324      INTEGER :: dim1
325      CHARACTER(len=lenc) :: varname
326      REAL                :: var(dim1)
327     
328      CALL unpack(varname)
329      CALL unpack_field(var)
330     
331      CALL iom__write_Field1d(varname,var)
332
333    END SUBROUTINE sub_internal
334  END SUBROUTINE event__write_field1d
335
336  SUBROUTINE event__write_field2D
337  IMPLICIT NONE
338    INTEGER :: lenc
339    INTEGER :: dim1
340    INTEGER :: dim2
341     
342    CALL unpack(lenc)
343    CALL unpack(dim1)
344    CALL unpack(dim2)
345    CALL sub_internal(lenc,dim1,dim2)
346 
347  CONTAINS
348    SUBROUTINE sub_internal(lenc,dim1,dim2)
349    IMPLICIT NONE
350      INTEGER :: lenc
351      INTEGER :: dim1
352      INTEGER :: dim2
353      CHARACTER(len=lenc) :: varname
354      REAL                :: var(dim1,dim2)
355     
356      CALL unpack(varname)
357      CALL unpack_field(var)
358     
359      CALL iom__write_Field2d(varname,var)
360
361    END SUBROUTINE sub_internal
362  END SUBROUTINE event__write_field2d
363   
364   
365  SUBROUTINE event__write_field3d
366  IMPLICIT NONE
367    INTEGER :: lenc
368    INTEGER :: dim1
369    INTEGER :: dim2
370    INTEGER :: dim3
371   
372    CALL unpack(lenc)
373    CALL unpack(dim1)
374    CALL unpack(dim2)
375    CALL unpack(dim3)
376    CALL sub_internal(lenc,dim1,dim2,dim3)
377 
378  CONTAINS
379 
380    SUBROUTINE sub_internal(lenc,dim1,dim2,dim3)
381    IMPLICIT NONE
382      INTEGER :: lenc
383      INTEGER :: dim1
384      INTEGER :: dim2
385      INTEGER :: dim3
386 
387      CHARACTER(len=lenc) :: varname
388      REAL                :: var(dim1,dim2,dim3)
389       
390      CALL unpack(varname)
391      CALL unpack_field(var)
392       
393      CALL iom__write_field3d(varname,var)
394         
395    END SUBROUTINE sub_internal
396
397  END SUBROUTINE event__write_field3d
398   
399   
400  SUBROUTINE event__set_timestep
401  IMPLICIT NONE
402    INTEGER :: timestep
403     
404    CALL unpack(timestep)
405    CALL iom__set_timestep(timestep)
406   
407  END SUBROUTINE event__set_timestep
408   
409   
410  SUBROUTINE event__close_io_definition
411  IMPLICIT NONE
412   
413    CALL iom__close_io_definition
414   
415  END SUBROUTINE event__close_io_definition
416   
417   
418END MODULE mod_event_server   
Note: See TracBrowser for help on using the repository browser.