Context Navigation

source: XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90 @ 35

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

File size: 16.8 KB

Line
1	MODULE mod_field
2
3	USE mod_xmlio_parameters
4	USE mod_sorted_list
5	USE mod_axis
6	USE mod_grid
7	USE mod_zoom
8
9	IMPLICIT NONE
10
11	TYPE, PUBLIC :: field
12	CHARACTER(len=str_len) :: id
13	LOGICAL :: has_id
14	CHARACTER(len=str_len) :: name
15	LOGICAL :: has_name
16	CHARACTER(len=str_len) :: description
17	LOGICAL :: has_description
18	CHARACTER(len=str_len) :: unit
19	LOGICAL :: has_unit
20	CHARACTER(len=str_len) :: operation
21	LOGICAL :: has_operation
22	INTEGER :: freq_op
23	LOGICAL :: has_freq_op
24	CHARACTER(len=str_len) :: axis_ref
25	LOGICAL :: has_axis_ref
26	CHARACTER(len=str_len) :: grid_ref
27	LOGICAL :: has_grid_ref
28	CHARACTER(len=str_len) :: zoom_ref
29	LOGICAL :: has_zoom_ref
30	INTEGER :: level
31	LOGICAL :: has_level
32	INTEGER :: prec
33	LOGICAL :: has_prec
34	CHARACTER(len=str_len) :: field_ref
35	LOGICAL :: has_field_ref
36	TYPE(field),POINTER :: field_base
37	LOGICAL :: has_field_base
38	LOGICAL :: enabled
39	LOGICAL :: has_enabled
40	LOGICAL :: solved_field_ref
41	TYPE(axis), POINTER :: axis
42	LOGICAL :: has_axis
43	TYPE(grid),POINTER :: grid
44	LOGICAL :: has_grid
45	TYPE(zoom),POINTER :: zoom
46	LOGICAL :: has_zoom
47	INTEGER :: internal(internal_field)
48
49
50	END TYPE field
51
52	INCLUDE 'vector_field_def.inc'
53
54	TYPE(vector_field),POINTER,SAVE :: field_Ids
55	TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids
56
57
58	CONTAINS
59	INCLUDE 'vector_field_contains.inc'
60
61	SUBROUTINE field__swap_context(saved_field_ids,saved_ids)
62	IMPLICIT NONE
63	TYPE(vector_field),POINTER :: saved_field_ids
64	TYPE(sorted_list),POINTER :: saved_ids
65
66	field_Ids=>saved_field_ids
67	Ids=>saved_Ids
68
69	END SUBROUTINE field__swap_context
70
71	SUBROUTINE field__init
72	IMPLICIT NONE
73
74	CALL vector_field__new(field_Ids)
75	CALL sorted_list__new(Ids)
76
77	END SUBROUTINE field__init
78
79	SUBROUTINE field__get(Id,Pt_field)
80	USE string_function
81	IMPLICIT NONE
82	CHARACTER(LEN=*),INTENT(IN) :: Id
83	TYPE(field),POINTER :: Pt_field
84
85	INTEGER :: Pos
86	LOGICAL :: success
87
88	CALL sorted_list__find(Ids,hash(Id),Pos,success)
89	IF (success) THEN
90	Pt_field=>field_ids%at(Pos)%Pt
91	ELSE
92	Pt_field=>NULL()
93	ENDIF
94
95	END SUBROUTINE field__get
96
97
98	SUBROUTINE field__new(pt_field,Id)
99	USE string_function
100	IMPLICIT NONE
101	TYPE(field), POINTER :: pt_field
102	CHARACTER(LEN=*),OPTIONAL :: Id
103
104	INTEGER :: Pos
105
106	Pt_field%has_id=.FALSE.
107	pt_field%has_name = .FALSE.
108	pt_field%has_description = .FALSE.
109	pt_field%has_unit = .FALSE.
110	pt_field%has_operation = .FALSE.
111	pt_field%has_freq_op = .FALSE.
112	pt_field%has_axis_ref = .FALSE.
113	pt_field%has_grid_ref = .FALSE.
114	pt_field%has_zoom_ref = .FALSE.
115	pt_field%has_prec = .FALSE.
116	pt_field%has_level = .FALSE.
117	pt_field%has_field_ref = .FALSE.
118	pt_field%has_field_base = .FALSE.
119	pt_field%has_enabled = .FALSE.
120	Pt_field%solved_field_ref=.FALSE.
121	Pt_field%has_axis=.FALSE.
122	Pt_field%has_grid=.FALSE.
123	Pt_field%has_zoom=.FALSE.
124
125	IF (PRESENT(Id)) THEN
126	Pt_field%id=TRIM(ADJUSTL(Id))
127	Pt_field%has_id=.TRUE.
128	CALL vector_field__set_new(field_Ids,Pt_field,Pos)
129	CALL sorted_list__Add(Ids,hash(id),Pos)
130	ENDIF
131
132	END SUBROUTINE field__new
133
134
135	SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, zoom_ref, prec, level, &
136	enabled)
137
138	TYPE(field), pointer :: p_field
139	CHARACTER(len=*), OPTIONAL :: name
140	CHARACTER(len=*), OPTIONAL :: ref
141	CHARACTER(len=*), OPTIONAL :: description
142	CHARACTER(len=*), OPTIONAL :: unit
143	CHARACTER(len=*), OPTIONAL :: operation
144	INTEGER, OPTIONAL :: freq_op
145	CHARACTER(len=*),OPTIONAL :: axis_ref
146	CHARACTER(len=*),OPTIONAL :: grid_ref
147	CHARACTER(len=*),OPTIONAL :: zoom_ref
148	INTEGER, OPTIONAL :: prec
149	INTEGER, OPTIONAL :: level
150	LOGICAL, OPTIONAL :: enabled
151
152	IF (PRESENT(name)) THEN
153	p_field%name=TRIM(ADJUSTL(name))
154	p_field%has_name = .TRUE.
155	ENDIF
156	IF (PRESENT(ref)) THEN
157	p_field%field_ref=TRIM(ADJUSTL(ref))
158	p_field%has_field_ref = .TRUE.
159	ENDIF
160	IF (PRESENT(description)) THEN
161	p_field%description=TRIM(ADJUSTL(description))
162	p_field%has_description = .TRUE.
163	ENDIF
164
165	IF (PRESENT(unit)) then
166	p_field%unit=TRIM(ADJUSTL(unit))
167	p_field%has_unit = .TRUE.
168	ENDIF
169	IF (PRESENT(operation)) THEN
170	p_field%operation=TRIM(ADJUSTL(operation))
171	p_field%has_operation = .TRUE.
172	ENDIF
173	IF (PRESENT(freq_op)) THEN
174	p_field%freq_op=freq_op
175	p_field%has_freq_op = .TRUE.
176	ENDIF
177	IF (PRESENT(axis_ref)) THEN
178	p_field%axis_ref=TRIM(ADJUSTL(axis_ref))
179	p_field%has_axis_ref = .TRUE.
180	ENDIF
181	IF (PRESENT(grid_ref)) THEN
182	p_field%grid_ref=TRIM(ADJUSTL(grid_ref))
183	p_field%has_grid_ref = .TRUE.
184	ENDIF
185
186	IF (PRESENT(zoom_ref)) THEN
187	p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref))
188	p_field%has_zoom_ref = .TRUE.
189	ENDIF
190
191	IF (PRESENT(prec)) then
192	p_field%prec=prec
193	p_field%has_prec = .TRUE.
194	ENDIF
195
196	IF (PRESENT(level)) then
197	p_field%level=level
198	p_field%has_level = .TRUE.
199	ENDIF
200
201	IF (PRESENT(enabled)) then
202	p_field%enabled=enabled
203	p_field%has_enabled = .TRUE.
204	ENDIF
205
206	END SUBROUTINE field__set
207
208
209	SUBROUTINE field__print(pt_field)
210
211	TYPE(field), POINTER :: pt_field
212
213	PRINT *,"--- FIELD ---"
214
215	IF (pt_field%has_id) THEN
216	PRINT *, 'id : ',TRIM(pt_field%id)
217	ELSE
218	PRINT *, 'id undefined '
219	ENDIF
220
221	IF (pt_field%has_name) THEN
222	PRINT *, 'name : ',TRIM(pt_field%name)
223	ELSE
224	PRINT *, 'name undefined '
225	ENDIF
226	IF (pt_field%has_description) THEN
227	PRINT *, 'description : ',TRIM(pt_field%description)
228	ELSE
229	PRINT *, 'description undefined '
230	ENDIF
231	IF (pt_field%has_unit) THEN
232	PRINT *, 'unit : ',TRIM(pt_field%unit)
233	ELSE
234	PRINT *, 'unit undefined '
235	ENDIF
236	IF (pt_field%has_operation) THEN
237	PRINT *, 'operation ',TRIM(pt_field%operation)
238	ELSE
239	PRINT *, 'operation undefined '
240	ENDIF
241	IF (pt_field%has_freq_op) THEN
242	PRINT *, 'freq_op ',pt_field%freq_op
243	ELSE
244	PRINT *, 'freq_op undefined '
245	ENDIF
246
247	IF (pt_field%has_axis_ref) THEN
248	PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
249	ELSE
250	PRINT *, 'axis_ref undefined '
251	ENDIF
252
253	IF (pt_field%has_grid_ref) THEN
254	PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
255	ELSE
256	PRINT *, 'grid_ref undefined '
257	ENDIF
258
259	IF (pt_field%has_zoom_ref) THEN
260	PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
261	ELSE
262	PRINT *, 'zoom_ref undefined '
263	ENDIF
264
265	IF (pt_field%has_field_ref) THEN
266	PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
267	ELSE
268	PRINT *, 'field_ref undefined '
269	ENDIF
270
271	! call vert_axis__print(pt_field%p_vert_axis)
272	!
273	! IF (pt_field%is_vert_axis_ref_def) THEN
274	! PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
275	! ELSE
276	! PRINT *, 'pt_field%vert_axis_ref undefined '
277	! ENDIF
278	IF (pt_field%has_prec) THEN
279	PRINT *, 'prec ',pt_field%prec
280	ELSE
281	PRINT *, 'prec undefined '
282	ENDIF
283	IF (pt_field%has_level) then
284	PRINT *, 'level ',pt_field%level
285	ELSE
286	PRINT *, 'level undefined '
287	ENDIF
288	IF (pt_field%has_field_base) THEN
289	PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
290	ELSE
291	PRINT *, 'field_base indefini'
292	ENDIF
293
294	IF (pt_field%has_enabled) THEN
295	PRINT *, 'enabled : ',pt_field%enabled
296	ELSE
297	PRINT *, 'enabled indefini'
298	ENDIF
299
300	PRINT *,"------------"
301
302	END SUBROUTINE field__print
303
304	! SUBROUTINE field__resolve_ref_vert_axis(p_field)
305	!
306	! TYPE(field), POINTER :: p_field
307	! CHARACTER(len=str_len) :: name
308	!
309	! IF (p_field%is_vert_axis_ref_def) THEN
310	! name=p_field%vert_axis_ref
311	! IF (vert_axis_def__is_exist(name)) THEN
312	! CALL vert_axis_def__get(name,p_field%p_vert_axis)
313	! p_field%is_vert_axis_def = .TRUE.
314	! ENDIF
315	! ENDIF
316	!
317	! END SUBROUTINE field__resolve_ref_vert_axis
318
319	SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
320
321	TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
322
323	IF (pt_field_in%has_name) THEN
324	pt_field_out%name=pt_field_in%name
325	pt_field_out%has_name=.TRUE.
326	ELSE IF ( pt_field_default%has_name) THEN
327	pt_field_out%name=pt_field_default%name
328	pt_field_out%has_name=.TRUE.
329	ELSE
330	pt_field_out%has_name=.FALSE.
331	ENDIF
332
333	IF (pt_field_in%has_description) THEN
334	pt_field_out%description=pt_field_in%description
335	pt_field_out%has_description=.TRUE.
336	ELSE IF ( pt_field_default%has_description ) THEN
337	pt_field_out%description=pt_field_default%description
338	pt_field_out%has_description=.TRUE.
339	ELSE
340	pt_field_out%has_description=.FALSE.
341	ENDIF
342
343	IF (pt_field_in%has_unit) THEN
344	pt_field_out%unit=pt_field_in%unit
345	pt_field_out%has_unit=.TRUE.
346	ELSE IF ( pt_field_default%has_unit ) THEN
347	pt_field_out%unit=pt_field_default%unit
348	pt_field_out%has_unit=.TRUE.
349	ELSE
350	pt_field_out%has_unit=.FALSE.
351	ENDIF
352
353	IF (pt_field_in%has_operation) THEN
354	pt_field_out%operation=pt_field_in%operation
355	pt_field_out%has_operation=.TRUE.
356	ELSE IF ( pt_field_default%has_operation ) THEN
357	pt_field_out%operation=pt_field_default%operation
358	pt_field_out%has_operation=.TRUE.
359	ELSE
360	pt_field_out%has_operation=.FALSE.
361	ENDIF
362
363	IF (pt_field_in%has_freq_op) THEN
364	pt_field_out%freq_op=pt_field_in%freq_op
365	pt_field_out%has_freq_op=.TRUE.
366	ELSE IF ( pt_field_default%has_freq_op ) THEN
367	pt_field_out%freq_op=pt_field_default%freq_op
368	pt_field_out%has_freq_op=.TRUE.
369	ELSE
370	pt_field_out%has_freq_op=.FALSE.
371	ENDIF
372
373	! IF (pt_field_in%has_axis) THEN
374	! pt_field_out%p_axis => pt_field_in%p_axis
375	! pt_field_out%has_axis=.TRUE.
376	! ELSE IF ( pt_field_default%has_axis ) THEN
377	! pt_field_out%p_axis => pt_field_default%p_axis
378	! pt_field_out%has_axis=.TRUE.
379	! ELSE
380	! pt_field_out%has_axis=.FALSE.
381	! ENDIF
382
383	IF (pt_field_in%has_axis_ref) THEN
384	pt_field_out%axis_ref=pt_field_in%axis_ref
385	pt_field_out%has_axis_ref=.TRUE.
386	ELSE IF ( pt_field_default%has_axis_ref ) THEN
387	pt_field_out%axis_ref=pt_field_default%axis_ref
388	pt_field_out%has_axis_ref=.TRUE.
389	ELSE
390	pt_field_out%has_axis_ref=.FALSE.
391	ENDIF
392
393	IF (pt_field_in%has_grid_ref) THEN
394	pt_field_out%grid_ref=pt_field_in%grid_ref
395	pt_field_out%has_grid_ref=.TRUE.
396	ELSE IF ( pt_field_default%has_grid_ref ) THEN
397	pt_field_out%grid_ref=pt_field_default%grid_ref
398	pt_field_out%has_grid_ref=.TRUE.
399	ELSE
400	pt_field_out%has_grid_ref=.FALSE.
401	ENDIF
402
403	IF (pt_field_in%has_zoom_ref) THEN
404	pt_field_out%zoom_ref=pt_field_in%zoom_ref
405	pt_field_out%has_zoom_ref=.TRUE.
406	ELSE IF ( pt_field_default%has_zoom_ref ) THEN
407	pt_field_out%zoom_ref=pt_field_default%zoom_ref
408	pt_field_out%has_zoom_ref=.TRUE.
409	ELSE
410	pt_field_out%has_zoom_ref=.FALSE.
411	ENDIF
412
413	IF (pt_field_in%has_prec) THEN
414	pt_field_out%prec=pt_field_in%prec
415	pt_field_out%has_prec=.TRUE.
416	ELSE IF ( pt_field_default%has_prec ) THEN
417	pt_field_out%prec=pt_field_default%prec
418	pt_field_out%has_prec=.TRUE.
419	ELSE
420	pt_field_out%has_prec=.FALSE.
421	ENDIF
422
423	IF (pt_field_in%has_level) THEN
424	pt_field_out%level=pt_field_in%level
425	pt_field_out%has_level=.TRUE.
426	ELSE IF ( pt_field_default%has_level ) THEN
427	pt_field_out%level=pt_field_default%level
428	pt_field_out%has_level=.TRUE.
429	ELSE
430	pt_field_out%has_level=.FALSE.
431	ENDIF
432
433	IF (pt_field_in%has_enabled) THEN
434	pt_field_out%enabled=pt_field_in%enabled
435	pt_field_out%has_enabled=.TRUE.
436	ELSE IF ( pt_field_default%has_enabled ) THEN
437	pt_field_out%enabled=pt_field_default%enabled
438	pt_field_out%has_enabled=.TRUE.
439	ELSE
440	pt_field_out%has_enabled=.FALSE.
441	ENDIF
442
443	END SUBROUTINE field__apply_default
444
445	! FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
446	!
447	! LOGICAL :: field__is_vert_axis_attached
448	! TYPE(field), POINTER :: p_field
449	! CHARACTER(len=*), INTENT(IN) :: vert_axis_name
450	!
451	! field__is_vert_axis_attached = .false.
452	! IF (p_field%is_vert_axis_def) THEN
453	! IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
454	! ENDIF
455	!
456	! END FUNCTION field__is_vert_axis_attached
457
458	RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
459	USE error_msg
460	IMPLICIT NONE
461	TYPE(field), POINTER :: pt_field
462
463	TYPE(field), POINTER :: field_ref
464
465	IF (.NOT. pt_field%solved_field_ref) THEN
466
467	IF (pt_field%has_field_ref) THEN
468
469	CALL field__get(pt_field%field_ref,field_ref)
470
471	IF (.NOT. ASSOCIATED(field_ref)) THEN
472	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
473	" has a unknown reference to field : id =",pt_field%field_ref
474	CALL error("field__solve_field_ref")
475	ENDIF
476
477	CALL field__get_field_base(field_ref,pt_field%field_base)
478	Pt_field%has_field_base=.TRUE.
479
480	CALL field__apply_default(field_ref,pt_field,pt_field)
481
482
483	ELSE
484
485	IF (pt_field%has_id) THEN
486	pt_field%field_base=>pt_field
487	ENDIF
488
489	ENDIF
490
491	IF (.NOT. pt_field%has_name) THEN
492	IF (pt_field%has_id) THEN
493	pt_field%name=pt_field%id
494	pt_field%has_name=.TRUE.
495	ENDIF
496	ENDIF
497
498	Pt_field%solved_field_ref=.TRUE.
499
500	ENDIF
501
502	END SUBROUTINE field__solve_field_ref
503
504
505	RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
506	IMPLICIT NONE
507	TYPE(field), POINTER :: pt_field
508	TYPE(field), POINTER :: pt_field_base
509
510
511	IF (.NOT. Pt_field%solved_field_ref) THEN
512	CALL field__solve_field_ref(Pt_field)
513	ENDIF
514
515	IF (pt_field%has_field_base) THEN
516	pt_field_base=>pt_field%field_base
517	ELSE
518	pt_field_base=>pt_field
519	ENDIF
520
521	END SUBROUTINE field__get_field_base
522
523	SUBROUTINE field__solve_axis_ref(pt_field)
524	USE error_msg
525	IMPLICIT NONE
526	TYPE(field), POINTER :: pt_field
527
528	IF (pt_field%has_axis_ref) THEN
529	CALL axis__get(pt_field%axis_ref,pt_field%axis)
530	IF (ASSOCIATED(pt_field%axis)) THEN
531	pt_field%has_axis=.TRUE.
532	ELSE
533	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
534	" has a unknown reference to axis : id =",pt_field%axis_ref
535	CALL error("mod_field::field__solve_axis_ref")
536	ENDIF
537	ENDIF
538
539	END SUBROUTINE field__solve_axis_ref
540
541	SUBROUTINE field__solve_grid_ref(pt_field)
542	USE error_msg
543	IMPLICIT NONE
544	TYPE(field), POINTER :: pt_field
545
546	IF (pt_field%has_grid_ref) THEN
547	CALL grid__get(pt_field%grid_ref,pt_field%grid)
548	IF (ASSOCIATED(pt_field%grid)) THEN
549	pt_field%has_grid=.TRUE.
550	ELSE
551	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
552	" has a unknown reference to grid : id =",pt_field%grid_ref
553	CALL error("mod_field::field__solve_grid_ref")
554	ENDIF
555	ENDIF
556
557	END SUBROUTINE field__solve_grid_ref
558
559	SUBROUTINE field__solve_zoom_ref(pt_field)
560	USE error_msg
561	IMPLICIT NONE
562	TYPE(field), POINTER :: pt_field
563
564	IF (.NOT. pt_field%has_zoom_ref) THEN
565	IF (pt_field%has_grid_ref) THEN
566	pt_field%has_zoom_ref=.TRUE.
567	pt_field%zoom_ref=pt_field%grid_ref
568	ENDIF
569	ENDIF
570
571	IF (pt_field%has_zoom_ref) THEN
572	CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
573	IF (ASSOCIATED(pt_field%zoom)) THEN
574	pt_field%has_zoom=.TRUE.
575	ELSE
576	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
577	" has a unknown reference to zoom : id =",pt_field%zoom_ref
578	CALL error("mod_field::field__solve_zoom_ref")
579	ENDIF
580	ENDIF
581
582	END SUBROUTINE field__solve_zoom_ref
583
584
585	END MODULE mod_field

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

Download in other formats: