source: XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90 @ 8

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

Importation des sources du serveur XMLIO
File size: 7.1 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_parse_xml_file)
23        CALL event__parse_xml_file 
24
25      CASE (event_id_set_vert_axis)
26        CALL event__set_vert_axis 
27     
28      CASE (event_id_set_grid_dimension)
29        CALL event__set_grid_dimension
30     
31      CASE (event_id_set_grid_domain)
32        CALL event__set_grid_domain
33
34      CASE (event_id_set_grid_type_nemo)
35        CALL event__set_grid_type_nemo
36
37      CASE (event_id_set_time_parameters)
38        CALL event__set_time_parameters
39
40      CASE (event_id_close_io_definition)
41        CALL event__close_io_definition 
42
43      CASE (event_id_set_timestep)
44        CALL event__set_timestep
45
46      CASE (event_id_enable_field)
47        CALL event__enable_field
48     
49      CASE (event_id_disable_field)
50        CALL event__disable_field
51
52      CASE (event_id_write_Field2d)
53        CALL event__write_Field2d
54
55      CASE (event_id_write_Field3d)
56        CALL event__write_Field3d
57
58      CASE (event_id_stop_ioserver)
59        is_terminated=.TRUE. 
60        PRINT *,"TERMINATE_EVENT RECEIVED"
61
62      CASE DEFAULT 
63        STOP 'UNDEFINED EVENT'
64     
65     END SELECT
66     
67   END SUBROUTINE Process_event
68   
69
70  SUBROUTINE event__parse_xml_file
71  IMPLICIT NONE
72    INTEGER :: name_size
73   
74    CALL unpack(name_size)
75    CALL sub_internal(name_size)
76     
77  CONTAINS
78   
79    SUBROUTINE sub_internal(name_size)
80      INTEGER :: name_size
81      CHARACTER(LEN=name_size) :: filename     
82     
83       CALL unpack(filename)
84     
85       CALL iom__parse_xml_file(filename)
86     END SUBROUTINE sub_internal
87 
88  END SUBROUTINE event__parse_xml_file
89 
90 
91  SUBROUTINE event__set_grid_dimension
92  IMPLICIT NONE   
93    INTEGER :: name_size
94    INTEGER :: ni_glo
95    INTEGER :: nj_glo
96   
97    CALL unpack(name_size)
98    CALL sub_internal(name_size)
99     
100  CONTAINS
101   
102    SUBROUTINE sub_internal(name_size)
103      INTEGER :: name_size
104      CHARACTER(LEN=name_size) :: name     
105     
106       CALL unpack(name)
107       CALL unpack(ni_glo)
108       CALL unpack(nj_glo)
109     
110       CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
111     END SUBROUTINE sub_internal
112   
113   END SUBROUTINE event__set_grid_dimension
114
115
116  SUBROUTINE event__set_grid_domain 
117  IMPLICIT NONE   
118    INTEGER :: name_size
119    INTEGER :: ni
120    INTEGER :: nj
121    INTEGER :: ibegin
122    INTEGER :: jbegin
123    REAL,ALLOCATABLE :: lon(:,:)
124    REAL,ALLOCATABLE :: lat(:,:)
125
126    CALL unpack(name_size)
127    CALL sub_internal(name_size)
128     
129  CONTAINS
130   
131    SUBROUTINE sub_internal(name_size)
132      INTEGER :: name_size
133      CHARACTER(LEN=name_size) :: name     
134     
135       CALL unpack(name)
136   
137       CALL unpack(ni)
138       CALL unpack(nj)
139       CALL unpack(ibegin)
140       CALL unpack(jbegin)
141   
142       ALLOCATE(lon(ni,nj))
143       ALLOCATE(lat(ni,nj))
144       CALL unpack(lon)
145       CALL unpack(lat)
146   
147       CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
148
149     END SUBROUTINE sub_internal
150   
151  END SUBROUTINE event__set_grid_domain   
152
153
154  SUBROUTINE event__set_grid_type_nemo 
155  IMPLICIT NONE   
156    INTEGER :: name_size
157
158    CALL unpack(name_size)
159    CALL sub_internal(name_size)
160     
161  CONTAINS
162   
163    SUBROUTINE sub_internal(name_size)
164      INTEGER :: name_size
165      CHARACTER(LEN=name_size) :: name     
166     
167       CALL unpack(name)
168       CALL iom__set_grid_type_nemo(name)
169
170     END SUBROUTINE sub_internal
171   
172  END SUBROUTINE event__set_grid_type_nemo   
173
174
175  SUBROUTINE event__set_vert_axis
176  IMPLICIT NONE
177    INTEGER :: name_size
178    INTEGER :: vert_size 
179    REAL,ALLOCATABLE :: vert_value(:)
180   
181    CALL unpack(name_size)
182    CALL sub_internal(name_size)
183
184  CONTAINS
185   
186    SUBROUTINE sub_internal(name_size)
187      INTEGER :: name_size
188      CHARACTER(LEN=name_size) :: name
189   
190      CALL unpack(name)
191      CALL unpack(vert_size)
192      ALLOCATE(vert_value(vert_size))
193      CALL unpack(vert_value) 
194     
195      CALL iom__set_vert_axis(name,vert_value)
196     
197    END SUBROUTINE sub_internal
198  END SUBROUTINE event__set_vert_axis
199
200  SUBROUTINE event__set_time_parameters
201  IMPLICIT NONE
202    INTEGER   :: itau0
203    REAL      :: zjulian
204    REAL      :: zdt
205     
206    CALL unpack(itau0)
207    CALL unpack(zjulian)
208    CALL unpack(zdt)
209   
210    CALL iom__set_time_parameters(itau0,zjulian,zdt)
211     
212  END SUBROUTINE event__set_time_parameters
213 
214
215  SUBROUTINE event__enable_field
216  IMPLICIT NONE
217    INTEGER :: lenc
218     
219    CALL unpack(lenc)
220    CALL sub_internal(lenc)
221 
222  CONTAINS
223    SUBROUTINE sub_internal(lenc)
224    IMPLICIT NONE
225      INTEGER :: lenc
226      CHARACTER(len=lenc) :: varname
227     
228      CALL unpack(varname)
229     
230      CALL iom__enable_field(varname)
231
232    END SUBROUTINE sub_internal
233  END SUBROUTINE event__enable_field
234 
235
236  SUBROUTINE event__disable_field
237  IMPLICIT NONE
238    INTEGER :: lenc
239     
240    CALL unpack(lenc)
241    CALL sub_internal(lenc)
242 
243  CONTAINS
244    SUBROUTINE sub_internal(lenc)
245    IMPLICIT NONE
246      INTEGER :: lenc
247      CHARACTER(len=lenc) :: varname
248     
249      CALL unpack(varname)
250     
251      CALL iom__disable_field(varname)
252
253    END SUBROUTINE sub_internal
254   
255  END SUBROUTINE event__disable_field
256 
257     
258  SUBROUTINE event__write_field2D
259  IMPLICIT NONE
260    INTEGER :: lenc
261    INTEGER :: dim1
262    INTEGER :: dim2
263     
264    CALL unpack(lenc)
265    CALL unpack(dim1)
266    CALL unpack(dim2)
267    CALL sub_internal(lenc,dim1,dim2)
268 
269  CONTAINS
270    SUBROUTINE sub_internal(lenc,dim1,dim2)
271    IMPLICIT NONE
272      INTEGER :: lenc
273      INTEGER :: dim1
274      INTEGER :: dim2
275      CHARACTER(len=lenc) :: varname
276      REAL                :: var(dim1,dim2)
277     
278      CALL unpack(varname)
279      CALL unpack_field(var)
280     
281      CALL iom__write_Field2d(varname,var)
282
283    END SUBROUTINE sub_internal
284  END SUBROUTINE event__write_field2d
285   
286   
287  SUBROUTINE event__write_field3d
288  IMPLICIT NONE
289    INTEGER :: lenc
290    INTEGER :: dim1
291    INTEGER :: dim2
292    INTEGER :: dim3
293   
294    CALL unpack(lenc)
295    CALL unpack(dim1)
296    CALL unpack(dim2)
297    CALL unpack(dim3)
298    CALL sub_internal(lenc,dim1,dim2,dim3)
299 
300  CONTAINS
301 
302    SUBROUTINE sub_internal(lenc,dim1,dim2,dim3)
303    IMPLICIT NONE
304      INTEGER :: lenc
305      INTEGER :: dim1
306      INTEGER :: dim2
307      INTEGER :: dim3
308 
309      CHARACTER(len=lenc) :: varname
310      REAL                :: var(dim1,dim2,dim3)
311       
312      CALL unpack(varname)
313      CALL unpack_field(var)
314       
315      CALL iom__write_field3d(varname,var)
316         
317    END SUBROUTINE sub_internal
318
319  END SUBROUTINE event__write_field3d
320   
321   
322  SUBROUTINE event__set_timestep
323  IMPLICIT NONE
324    INTEGER :: timestep
325     
326    CALL unpack(timestep)
327    CALL iom__set_timestep(timestep)
328   
329  END SUBROUTINE event__set_timestep
330   
331   
332  SUBROUTINE event__close_io_definition
333  IMPLICIT NONE
334   
335    CALL iom__close_io_definition
336   
337  END SUBROUTINE event__close_io_definition
338   
339   
340END MODULE mod_event_server   
Note: See TracBrowser for help on using the repository browser.