Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_parse_xml.f90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago
set proper svn properties to all files...
Property svn:keywords set to `Id`
File size: 22.3 KB

Line
1	MODULE parsing_xml
2	USE flib_dom
3	USE error_msg
4	USE string_function
5
6	CONTAINS
7
8	SUBROUTINE parsing_xml_file(name)
9	IMPLICIT NONE
10	CHARACTER(len=*), INTENT(IN) :: name
11	TYPE(fnode), POINTER :: myDoc
12
13	myDoc => parsefile(name)
14	CALL parsing_root(myDoc)
15
16	PRINT *, 'Le parsing est termine !!! '
17
18	END SUBROUTINE parsing_xml_file
19
20
21	SUBROUTINE parsing_root(root)
22	IMPLICIT NONE
23	TYPE(fnode), POINTER :: root
24	TYPE(fnode), POINTER :: child_node
25	TYPE(fnodeList), POINTER :: child_list
26
27	INTEGER :: il
28	CHARACTER(len=100) :: node_name
29
30	IF (hasChildNodes(root)) THEN
31	child_list => getChildnodes(root)
32
33	DO il=0,getLength(child_list)-1
34	child_node => item(child_list,il)
35	node_name=getNodename(child_node)
36
37	SELECT CASE (TRIM(node_name))
38
39	CASE ('simulation')
40	CALL parsing_simulation(child_node)
41
42	CASE DEFAULT
43	IF (is_bad_node(node_name)) THEN
44	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing root'
45	CALL Warning("mod_parse_xml:parsing_root")
46	ENDIF
47	END SELECT
48	ENDDO
49	ENDIF
50
51	END SUBROUTINE parsing_root
52
53	SUBROUTINE parsing_simulation(root)
54	IMPLICIT NONE
55	TYPE(fnode), POINTER :: root
56	TYPE(fnode), POINTER :: child_node
57	TYPE(fnodeList), POINTER :: child_list
58
59	INTEGER :: il
60	CHARACTER(len=100) :: node_name
61
62	IF (hasChildNodes(root)) THEN
63	child_list => getChildnodes(root)
64
65	DO il=0,getLength(child_list)-1
66	child_node => item(child_list,il)
67	node_name=getNodename(child_node)
68
69	SELECT CASE (TRIM(node_name))
70
71	CASE ('context')
72	CALL parsing_context(child_node)
73
74	CASE DEFAULT
75	IF (is_bad_node(node_name)) THEN
76	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing simulation'
77	CALL Warning("mod_parse_xml:parsing_simulationt")
78	ENDIF
79	END SELECT
80
81	ENDDO
82	ENDIF
83
84	END SUBROUTINE parsing_simulation
85
86	SUBROUTINE parsing_context(node)
87	USE mod_context
88	USE mod_axis_definition
89	USE mod_grid_definition
90	USE mod_field_definition
91	USE mod_file_definition
92	IMPLICIT NONE
93	TYPE(fnode), POINTER :: node
94
95	TYPE(fnode), POINTER :: child_node
96	TYPE(fnodeList), POINTER :: child_list
97	TYPE(axis),POINTER :: attribute
98	LOGICAL :: is_root
99	INTEGER :: il
100	CHARACTER(len=100) :: node_name
101	CHARACTER(len=100) :: value
102
103	IF (is_attribute_exist(node,"id")) THEN
104	value=getAttribute(node,"id")
105	CALL context__create(TRIM(value))
106	CALL context__swap(TRIM(value))
107	ENDIF
108
109	IF (hasChildNodes(node)) THEN
110	child_list => getChildnodes(node)
111
112	DO il=0,getLength(child_list)-1
113	child_node => item(child_list,il)
114	node_name=getNodename(child_node)
115
116	SELECT CASE (TRIM(node_name))
117
118	CASE ('axis_definition')
119	CALL parsing_axis_group(child_node,axis_definition,root=.TRUE.)
120
121	CASE ('grid_definition')
122	CALL parsing_grid_group(child_node,grid_definition,root=.TRUE.)
123
124	CASE ('field_definition')
125	CALL parsing_field_group(child_node,field_definition,root=.TRUE.)
126
127	CASE ('file_definition')
128	CALL parsing_file_group(child_node,file_definition,root=.TRUE.)
129
130	CASE DEFAULT
131	IF (is_bad_node(node_name)) THEN
132	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing context'
133	CALL Warning("mod_parse_xml:parsing_context")
134	ENDIF
135	END SELECT
136	ENDDO
137
138	ENDIF
139
140	END SUBROUTINE parsing_context
141
142
143	RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root)
144	USE mod_axis_definition
145	USE mod_axis_group
146	USE mod_axis
147	IMPLICIT NONE
148	TYPE(fnode), POINTER :: node
149	TYPE(axis_group),POINTER :: parent
150	LOGICAL,INTENT(IN),OPTIONAL :: root
151
152	TYPE(axis_group),POINTER :: pt_axis_group
153	TYPE(fnode), POINTER :: child_node
154	TYPE(fnodeList), POINTER :: child_list
155	TYPE(axis),POINTER :: attribute
156	LOGICAL :: is_root
157	INTEGER :: il
158	CHARACTER(len=100) :: node_name
159	CHARACTER(len=100) :: value
160
161	is_root=.FALSE.
162	IF (PRESENT(root)) is_root=root
163
164	IF (is_root) THEN
165	pt_axis_group=>parent
166	ELSE
167	IF (is_attribute_exist(node,"id")) THEN
168	value=getAttribute(node,"id")
169	CALL axis_group__get_new_group(parent,pt_axis_group,TRIM(value))
170	ELSE
171	CALL axis_group__get_new_group(parent,pt_axis_group)
172	ENDIF
173	ENDIF
174
175	CALL axis_group__get_default_attrib(pt_axis_group,attribute)
176	CALL parsing_axis_attribute(node,attribute)
177
178	IF (hasChildNodes(node)) THEN
179	child_list => getChildnodes(node)
180
181	DO il=0,getLength(child_list)-1
182	child_node => item(child_list,il)
183	node_name=getNodename(child_node)
184
185	SELECT CASE (TRIM(node_name))
186
187	CASE ('group')
188	CALL parsing_axis_group(child_node,pt_axis_group)
189
190	CASE ('axis')
191	CALL parsing_axis(child_node,pt_axis_group)
192
193	CASE DEFAULT
194	IF (is_bad_node(node_name)) THEN
195	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_axis'
196	CALL Warning("mod_parse_xml:parsing_group_axis")
197	ENDIF
198	END SELECT
199	ENDDO
200	ENDIF
201
202	END SUBROUTINE parsing_axis_group
203
204	SUBROUTINE parsing_axis(node,parent)
205	USE mod_axis_group
206	USE mod_axis
207	IMPLICIT NONE
208	TYPE(fnode), POINTER :: node
209	TYPE(axis_group),POINTER :: parent
210
211	TYPE(axis),POINTER :: pt_axis
212	TYPE(axis),POINTER :: attribute
213	INTEGER :: il
214	CHARACTER(len=100) :: node_name
215	CHARACTER(len=100) :: value
216
217
218	IF (is_attribute_exist(node,"id")) THEN
219	value=getAttribute(node,"id")
220	CALL axis_group__get_new_axis(parent,pt_axis,TRIM(value))
221	ELSE
222	CALL axis_group__get_new_axis(parent,pt_axis)
223	ENDIF
224
225	CALL parsing_axis_attribute(node,pt_axis)
226
227	END SUBROUTINE parsing_axis
228
229
230	SUBROUTINE parsing_axis_attribute(node,pt_axis)
231	USE mod_axis
232	IMPLICIT NONE
233	TYPE(fnode), POINTER :: node
234	TYPE(axis),POINTER :: pt_axis
235
236	CHARACTER(len=100) :: value
237
238	IF (is_attribute_exist(node,"name")) THEN
239	value = getAttribute(node,"name")
240	CALL axis__set(pt_axis,name=TRIM(value))
241	ENDIF
242
243	IF (is_attribute_exist(node,"description")) THEN
244	value = getAttribute(node,"description")
245	CALL axis__set(pt_axis,description=TRIM(value))
246	ENDIF
247
248	IF (is_attribute_exist(node,"unit")) THEN
249	value = getAttribute(node,"unit")
250	CALL axis__set(pt_axis,unit=TRIM(value))
251	ENDIF
252
253	IF (is_attribute_exist(node,"size")) THEN
254	value = getAttribute(node,"size")
255	CALL axis__set(pt_axis,a_size=string_to_integer(value))
256	ENDIF
257
258	IF (is_attribute_exist(node,"positive")) THEN
259	value = getAttribute(node,"positive")
260	CALL axis__set(pt_axis,positive=string_to_logical(value))
261	ENDIF
262
263	END SUBROUTINE parsing_axis_attribute
264
265
266
267
268
269
270
271
272	RECURSIVE SUBROUTINE parsing_grid_group(node,parent,root)
273	USE mod_grid_definition
274	USE mod_grid_group
275	USE mod_grid
276	IMPLICIT NONE
277	TYPE(fnode), POINTER :: node
278	TYPE(grid_group),POINTER :: parent
279	LOGICAL,INTENT(IN),OPTIONAL :: root
280
281	TYPE(grid_group),POINTER :: pt_grid_group
282	TYPE(fnode), POINTER :: child_node
283	TYPE(fnodeList), POINTER :: child_list
284	TYPE(grid),POINTER :: attribute
285	LOGICAL :: is_root
286	INTEGER :: il
287	CHARACTER(len=100) :: node_name
288	CHARACTER(len=100) :: value
289
290	is_root=.FALSE.
291	IF (PRESENT(root)) is_root=root
292
293	IF (is_root) THEN
294	pt_grid_group=>parent
295	ELSE
296	IF (is_attribute_exist(node,"id")) THEN
297	value=getAttribute(node,"id")
298	CALL grid_group__get_new_group(parent,pt_grid_group,TRIM(value))
299	ELSE
300	CALL grid_group__get_new_group(parent,pt_grid_group)
301	ENDIF
302	ENDIF
303
304	CALL grid_group__get_default_attrib(pt_grid_group,attribute)
305	CALL parsing_grid_attribute(node,attribute)
306
307	IF (hasChildNodes(node)) THEN
308	child_list => getChildnodes(node)
309
310	DO il=0,getLength(child_list)-1
311	child_node => item(child_list,il)
312	node_name=getNodename(child_node)
313
314	SELECT CASE (TRIM(node_name))
315
316	CASE ('group')
317	CALL parsing_grid_group(child_node,pt_grid_group)
318
319	CASE ('grid')
320	CALL parsing_grid(child_node,pt_grid_group)
321
322	CASE DEFAULT
323	IF (is_bad_node(node_name)) THEN
324	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_grid'
325	CALL Warning("mod_parse_xml:parsing_group_grid")
326	ENDIF
327	END SELECT
328	ENDDO
329	ENDIF
330
331	END SUBROUTINE parsing_grid_group
332
333	SUBROUTINE parsing_grid(node,parent)
334	USE mod_grid_group
335	USE mod_grid
336	IMPLICIT NONE
337	TYPE(fnode), POINTER :: node
338	TYPE(grid_group),POINTER :: parent
339
340	TYPE(grid),POINTER :: pt_grid
341	TYPE(fnode), POINTER :: child_node
342	TYPE(fnodeList), POINTER :: child_list
343	INTEGER :: il
344	CHARACTER(len=100) :: node_name
345	CHARACTER(len=100) :: value
346
347
348	IF (is_attribute_exist(node,"id")) THEN
349	value=getAttribute(node,"id")
350	CALL grid_group__get_new_grid(parent,pt_grid,TRIM(value))
351	ELSE
352	CALL grid_group__get_new_grid(parent,pt_grid)
353	ENDIF
354
355	CALL parsing_grid_attribute(node,pt_grid)
356
357
358	IF (hasChildNodes(node)) THEN
359	child_list => getChildnodes(node)
360
361	DO il=0,getLength(child_list)-1
362	child_node => item(child_list,il)
363	node_name=getNodename(child_node)
364
365	SELECT CASE (TRIM(node_name))
366
367	CASE ('zoom')
368	CALL parsing_zoom(child_node,pt_grid)
369
370	CASE DEFAULT
371	IF (is_bad_node(node_name)) THEN
372	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing grid'
373	CALL Warning("mod_parse_xml:parsing_grid")
374	ENDIF
375	END SELECT
376	ENDDO
377	ENDIF
378
379	END SUBROUTINE parsing_grid
380
381	SUBROUTINE parsing_grid_attribute(node,pt_grid)
382	USE mod_grid
383	IMPLICIT NONE
384	TYPE(fnode), POINTER :: node
385	TYPE(grid),POINTER :: pt_grid
386
387	CHARACTER(len=100) :: value
388
389	IF (is_attribute_exist(node,"name")) THEN
390	value = getAttribute(node,"name")
391	CALL grid__set(pt_grid,name=TRIM(value))
392	ENDIF
393
394	IF (is_attribute_exist(node,"description")) THEN
395	value = getAttribute(node,"description")
396	CALL grid__set(pt_grid,description=TRIM(value))
397	ENDIF
398
399	END SUBROUTINE parsing_grid_attribute
400
401	SUBROUTINE parsing_zoom(node,parent)
402	USE mod_zoom
403	USE mod_grid
404	IMPLICIT NONE
405	TYPE(fnode), POINTER :: node
406	TYPE(grid),POINTER :: parent
407
408	TYPE(zoom),POINTER :: pt_zoom
409	INTEGER :: il
410	CHARACTER(len=100) :: node_name
411	CHARACTER(len=100) :: value
412
413
414	IF (is_attribute_exist(node,"id")) THEN
415	value=getAttribute(node,"id")
416	CALL grid__get_new_zoom(parent,pt_zoom,TRIM(value))
417	ELSE
418	CALL grid__get_new_zoom(parent,pt_zoom)
419	ENDIF
420
421	CALL parsing_zoom_attribute(node,pt_zoom)
422
423	END SUBROUTINE parsing_zoom
424
425
426	SUBROUTINE parsing_zoom_attribute(node,pt_zoom)
427	USE mod_zoom
428	IMPLICIT NONE
429	TYPE(fnode), POINTER :: node
430	TYPE(zoom),POINTER :: pt_zoom
431
432	CHARACTER(len=100) :: value
433
434	IF (is_attribute_exist(node,"name")) THEN
435	value = getAttribute(node,"name")
436	CALL zoom__set(pt_zoom,name=TRIM(value))
437	ENDIF
438
439	IF (is_attribute_exist(node,"description")) THEN
440	value = getAttribute(node,"description")
441	CALL zoom__set(pt_zoom,description=TRIM(value))
442	ENDIF
443
444	IF (is_attribute_exist(node,"ni")) THEN
445	value = getAttribute(node,"ni")
446	CALL zoom__set(pt_zoom,ni_glo=string_to_integer(value))
447	ENDIF
448
449	IF (is_attribute_exist(node,"nj")) THEN
450	value = getAttribute(node,"nj")
451	CALL zoom__set(pt_zoom,nj_glo=string_to_integer(value))
452	ENDIF
453
454	IF (is_attribute_exist(node,"ibegin")) THEN
455	value = getAttribute(node,"ibegin")
456	CALL zoom__set(pt_zoom,ibegin_glo=string_to_integer(value))
457	ENDIF
458
459	IF (is_attribute_exist(node,"jbegin")) THEN
460	value = getAttribute(node,"jbegin")
461	CALL zoom__set(pt_zoom,jbegin_glo=string_to_integer(value))
462	ENDIF
463
464	END SUBROUTINE parsing_zoom_attribute
465
466
467
468	RECURSIVE SUBROUTINE parsing_field_group(node,parent,root)
469	USE mod_field_definition
470	USE mod_field_group
471	USE mod_field
472	IMPLICIT NONE
473	TYPE(fnode), POINTER :: node
474	TYPE(field_group),POINTER :: parent
475	LOGICAL,INTENT(IN),OPTIONAL :: root
476
477	TYPE(field_group),POINTER :: pt_field_group
478	TYPE(fnode), POINTER :: child_node
479	TYPE(fnodeList), POINTER :: child_list
480	TYPE(field),POINTER :: attribute
481	INTEGER :: il
482	CHARACTER(len=100) :: node_name
483	CHARACTER(len=100) :: value
484	LOGICAL :: is_root
485
486	is_root=.FALSE.
487	IF (PRESENT(root)) is_root=root
488
489	IF (is_root) THEN
490	pt_field_group=>parent
491	ELSE
492	IF (is_attribute_exist(node,"id")) THEN
493	value=getAttribute(node,"id")
494	CALL field_group__get_new_group(parent,pt_field_group,TRIM(value))
495	ELSE
496	CALL field_group__get_new_group(parent,pt_field_group)
497	ENDIF
498	ENDIF
499
500	CALL field_group__get_default_attrib(pt_field_group,attribute)
501	CALL parsing_field_attribute(node,attribute)
502
503	IF (hasChildNodes(node)) THEN
504	child_list => getChildnodes(node)
505
506	DO il=0,getLength(child_list)-1
507	child_node => item(child_list,il)
508	node_name=getNodename(child_node)
509
510	SELECT CASE (TRIM(node_name))
511
512	CASE ('group')
513	CALL parsing_field_group(child_node,pt_field_group)
514
515	CASE ('field')
516	CALL parsing_field(child_node,pt_field_group)
517
518	CASE DEFAULT
519	IF (is_bad_node(node_name)) THEN
520	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_field'
521	CALL Warning("mod_parse_xml:parsing_group_field")
522	ENDIF
523	END SELECT
524	ENDDO
525	ENDIF
526
527	END SUBROUTINE parsing_field_group
528
529	SUBROUTINE parsing_field(node,parent)
530	USE mod_field_group
531	USE mod_field
532	IMPLICIT NONE
533	TYPE(fnode), POINTER :: node
534	TYPE(field_group),POINTER :: parent
535
536	TYPE(field),POINTER :: pt_field
537	TYPE(field),POINTER :: attribute
538	INTEGER :: il
539	CHARACTER(len=100) :: node_name
540	CHARACTER(len=100) :: value
541
542
543	IF (is_attribute_exist(node,"id")) THEN
544	value=getAttribute(node,"id")
545	CALL field_group__get_new_field(parent,pt_field,TRIM(value))
546	ELSE
547	CALL field_group__get_new_field(parent,pt_field)
548	ENDIF
549
550	CALL parsing_field_attribute(node,pt_field)
551
552	END SUBROUTINE parsing_field
553
554
555	SUBROUTINE parsing_field_attribute(node,pt_field)
556	USE mod_field
557	IMPLICIT NONE
558	TYPE(fnode), POINTER :: node
559	TYPE(field),POINTER :: pt_field
560
561	CHARACTER(len=100) :: value
562
563	IF (is_attribute_exist(node,"name")) THEN
564	value = getAttribute(node,"name")
565	CALL field__set(pt_field,name=TRIM(value))
566	ENDIF
567
568	IF (is_attribute_exist(node,"description")) THEN
569	value = getAttribute(node,"description")
570	CALL field__set(pt_field,description=TRIM(value))
571	ENDIF
572
573	IF (is_attribute_exist(node,"unit")) THEN
574	value = getAttribute(node,"unit")
575	CALL field__set(pt_field,unit=TRIM(value))
576	ENDIF
577
578	IF (is_attribute_exist(node,"operation")) THEN
579	value = getAttribute(node,"operation")
580	CALL field__set(pt_field,operation=TRIM(value))
581	ENDIF
582
583	IF (is_attribute_exist(node,"freq_op")) THEN
584	value = getAttribute(node,"freq_op")
585	CALL field__set(pt_field,freq_op=string_to_integer(value))
586	ENDIF
587
588	IF (is_attribute_exist(node,"axis_ref")) THEN
589	value = getAttribute(node,"axis_ref")
590	CALL field__set(pt_field,axis_ref=TRIM(value))
591	ENDIF
592
593	IF (is_attribute_exist(node,"grid_ref")) THEN
594	value = getAttribute(node,"grid_ref")
595	CALL field__set(pt_field,grid_ref=TRIM(value))
596	ENDIF
597
598	IF (is_attribute_exist(node,"zoom_ref")) THEN
599	value = getAttribute(node,"zoom_ref")
600	CALL field__set(pt_field,zoom_ref=TRIM(value))
601	ENDIF
602
603	IF (is_attribute_exist(node,"level")) THEN
604	value = getAttribute(node,"level")
605	CALL field__set(pt_field,level=string_to_integer(value))
606	ENDIF
607
608	IF (is_attribute_exist(node,"prec")) THEN
609	value = getAttribute(node,"prec")
610	CALL field__set(pt_field,prec=string_to_integer(value))
611	ENDIF
612
613	IF (is_attribute_exist(node,"ref")) THEN
614	value = getAttribute(node,"ref")
615	CALL field__set(pt_field,ref=TRIM(value))
616	ENDIF
617
618	IF (is_attribute_exist(node,"enabled")) THEN
619	value = getAttribute(node,"enabled")
620	CALL field__set(pt_field,enabled=string_to_logical(value))
621	ENDIF
622
623
624	END SUBROUTINE parsing_field_attribute
625
626
627	RECURSIVE SUBROUTINE parsing_file_group(node,parent,root)
628	USE mod_file_definition
629	USE mod_file_group
630	USE mod_file
631	IMPLICIT NONE
632	TYPE(fnode), POINTER :: node
633	TYPE(file_group),POINTER :: parent
634	LOGICAL,INTENT(IN),OPTIONAL :: root
635
636	TYPE(file_group),POINTER :: pt_file_group
637	TYPE(fnode), POINTER :: child_node
638	TYPE(fnodeList), POINTER :: child_list
639	TYPE(file),POINTER :: attribute
640	LOGICAL :: is_root
641	INTEGER :: il
642	CHARACTER(len=100) :: node_name
643	CHARACTER(len=100) :: value
644
645	is_root=.FALSE.
646	IF (PRESENT(root)) is_root=root
647
648	IF (is_root) THEN
649	pt_file_group=>parent
650	ELSE
651	IF (is_attribute_exist(node,"id")) THEN
652	value=getAttribute(node,"id")
653	CALL file_group__get_new_group(parent,pt_file_group,TRIM(value))
654	ELSE
655	CALL file_group__get_new_group(parent,pt_file_group)
656	ENDIF
657	ENDIF
658
659	CALL file_group__get_default_attrib(pt_file_group,attribute)
660	CALL parsing_file_attribute(node,attribute)
661
662	IF (hasChildNodes(node)) THEN
663	child_list => getChildnodes(node)
664
665	DO il=0,getLength(child_list)-1
666	child_node => item(child_list,il)
667	node_name=getNodename(child_node)
668
669	SELECT CASE (TRIM(node_name))
670
671	CASE ('group')
672	CALL parsing_file_group(child_node,pt_file_group)
673
674	CASE ('file')
675	CALL parsing_file(child_node,pt_file_group)
676
677	CASE DEFAULT
678	IF (is_bad_node(node_name)) THEN
679	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
680	CALL Warning("mod_parse_xml:parsing_group_file")
681	ENDIF
682	END SELECT
683	ENDDO
684	ENDIF
685
686	END SUBROUTINE parsing_file_group
687
688	SUBROUTINE parsing_file(node,parent)
689	USE mod_file_group
690	USE mod_file
691	IMPLICIT NONE
692	TYPE(fnode), POINTER :: node
693	TYPE(file_group),POINTER :: parent
694
695	TYPE(file),POINTER :: pt_file
696	TYPE(file),POINTER :: attribute
697	TYPE(fnode), POINTER :: child_node
698	TYPE(fnodeList), POINTER :: child_list
699	INTEGER :: il
700	CHARACTER(len=100) :: node_name
701	CHARACTER(len=100) :: value
702
703
704	IF (is_attribute_exist(node,"id")) THEN
705	value=getAttribute(node,"id")
706	CALL file_group__get_new_file(parent,pt_file,TRIM(value))
707	ELSE
708	CALL file_group__get_new_file(parent,pt_file)
709	ENDIF
710
711	CALL parsing_file_attribute(node,pt_file)
712
713	IF (hasChildNodes(node)) THEN
714	child_list => getChildnodes(node)
715
716	DO il=0,getLength(child_list)-1
717	child_node => item(child_list,il)
718	node_name=getNodename(child_node)
719
720	SELECT CASE (TRIM(node_name))
721
722	CASE ('group')
723	CALL parsing_field_group(child_node,pt_file%field_list)
724
725	CASE ('field')
726	CALL parsing_field(child_node,pt_file%field_list)
727
728	CASE DEFAULT
729	IF (is_bad_node(node_name)) THEN
730	WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
731	CALL Warning("mod_parse_xml:parsing_group_file")
732	ENDIF
733	END SELECT
734	ENDDO
735	ENDIF
736	END SUBROUTINE parsing_file
737
738
739	SUBROUTINE parsing_file_attribute(node,pt_file)
740	USE mod_file
741	IMPLICIT NONE
742	TYPE(fnode), POINTER :: node
743	TYPE(file),POINTER :: pt_file
744
745	CHARACTER(len=100) :: value
746
747	IF (is_attribute_exist(node,"name")) THEN
748	value = getAttribute(node,"name")
749	CALL file__set(pt_file,name=TRIM(value))
750	ENDIF
751
752	IF (is_attribute_exist(node,"name_suffix")) THEN
753	value = getAttribute(node,"name_suffix")
754	CALL file__set(pt_file,name_suffix=TRIM(value))
755	ENDIF
756
757	IF (is_attribute_exist(node,"description")) THEN
758	value = getAttribute(node,"description")
759	CALL file__set(pt_file,description=TRIM(value))
760	ENDIF
761
762	IF (is_attribute_exist(node,"output_freq")) THEN
763	value = getAttribute(node,"output_freq")
764	CALL file__set(pt_file,output_freq=string_to_integer(value))
765	ENDIF
766
767	IF (is_attribute_exist(node,"output_level")) THEN
768	value = getAttribute(node,"output_level")
769	CALL file__set(pt_file,output_level=string_to_integer(value))
770	ENDIF
771
772	IF (is_attribute_exist(node,"enabled")) THEN
773	value = getAttribute(node,"enabled")
774	CALL file__set(pt_file,enabled=string_to_logical(value))
775	ENDIF
776
777	END SUBROUTINE parsing_file_attribute
778
779
780
781
782	FUNCTION is_attribute_exist(node, name)
783
784	LOGICAL :: is_attribute_exist
785	TYPE(fnode), POINTER :: node
786	CHARACTER(len=*) :: name
787	CHARACTER(len=100) :: value
788
789	value=""
790
791	is_attribute_exist= .false.
792	value=getAttribute(node, TRIM(name))
793	IF (value .NE. "") is_attribute_exist= .true.
794
795	END FUNCTION is_attribute_exist
796
797	FUNCTION is_bad_node(node_name)
798	IMPLICIT NONE
799	CHARACTER(len=*),INTENT(IN) :: node_name
800	LOGICAL :: is_bad_node
801
802	IF (TRIM(node_name)=='#text' .OR. TRIM(node_name)=='#comment') THEN
803	is_bad_node=.FALSE.
804	ELSE
805	is_bad_node=.TRUE.
806	ENDIF
807
808	END FUNCTION is_bad_node
809
810	END MODULE parsing_xml

Note: See TracBrowser for help on using the repository browser.

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

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90 @ 2281

Download in other formats: