Context Navigation

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

Last change on this file since 42 was 42, checked in by ymipsl, 15 years ago
Correction bug sur les ids des file_group + possibilitÃ© de fixer les attributs des groupes Ã partir de l'ioserver
File size: 19.7 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	INTERFACE field__set_attribut
53	MODULE PROCEDURE field__set_attribut_id,field__set_attribut_pt
54	END INTERFACE
55
56	INCLUDE 'vector_field_def.inc'
57
58	TYPE(vector_field),POINTER,SAVE :: field_Ids
59	TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids
60
61
62	CONTAINS
63	INCLUDE 'vector_field_contains.inc'
64
65	SUBROUTINE field__swap_context(saved_field_ids,saved_ids)
66	IMPLICIT NONE
67	TYPE(vector_field),POINTER :: saved_field_ids
68	TYPE(sorted_list),POINTER :: saved_ids
69
70	field_Ids=>saved_field_ids
71	Ids=>saved_Ids
72
73	END SUBROUTINE field__swap_context
74
75	SUBROUTINE field__init
76	IMPLICIT NONE
77
78	CALL vector_field__new(field_Ids)
79	CALL sorted_list__new(Ids)
80
81	END SUBROUTINE field__init
82
83	SUBROUTINE field__get(Id,Pt_field)
84	USE string_function
85	IMPLICIT NONE
86	CHARACTER(LEN=*),INTENT(IN) :: Id
87	TYPE(field),POINTER :: Pt_field
88
89	INTEGER :: Pos
90	LOGICAL :: success
91
92	CALL sorted_list__find(Ids,hash(Id),Pos,success)
93	IF (success) THEN
94	Pt_field=>field_ids%at(Pos)%Pt
95	ELSE
96	Pt_field=>NULL()
97	ENDIF
98
99	END SUBROUTINE field__get
100
101
102	SUBROUTINE field__new(pt_field,Id)
103	USE string_function
104	IMPLICIT NONE
105	TYPE(field), POINTER :: pt_field
106	CHARACTER(LEN=*),OPTIONAL :: Id
107
108	INTEGER :: Pos
109
110	Pt_field%has_id=.FALSE.
111	pt_field%has_name = .FALSE.
112	pt_field%has_description = .FALSE.
113	pt_field%has_unit = .FALSE.
114	pt_field%has_operation = .FALSE.
115	pt_field%has_freq_op = .FALSE.
116	pt_field%has_axis_ref = .FALSE.
117	pt_field%has_grid_ref = .FALSE.
118	pt_field%has_zoom_ref = .FALSE.
119	pt_field%has_prec = .FALSE.
120	pt_field%has_level = .FALSE.
121	pt_field%has_field_ref = .FALSE.
122	pt_field%has_field_base = .FALSE.
123	pt_field%has_enabled = .FALSE.
124	Pt_field%solved_field_ref=.FALSE.
125	Pt_field%has_axis=.FALSE.
126	Pt_field%has_grid=.FALSE.
127	Pt_field%has_zoom=.FALSE.
128
129	IF (PRESENT(Id)) THEN
130	Pt_field%id=TRIM(ADJUSTL(Id))
131	Pt_field%has_id=.TRUE.
132	CALL vector_field__set_new(field_Ids,Pt_field,Pos)
133	CALL sorted_list__Add(Ids,hash(id),Pos)
134	ENDIF
135
136	END SUBROUTINE field__new
137
138
139	SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, zoom_ref, prec, level, &
140	enabled)
141
142	TYPE(field), pointer :: p_field
143	CHARACTER(len=*), OPTIONAL :: name
144	CHARACTER(len=*), OPTIONAL :: ref
145	CHARACTER(len=*), OPTIONAL :: description
146	CHARACTER(len=*), OPTIONAL :: unit
147	CHARACTER(len=*), OPTIONAL :: operation
148	INTEGER, OPTIONAL :: freq_op
149	CHARACTER(len=*),OPTIONAL :: axis_ref
150	CHARACTER(len=*),OPTIONAL :: grid_ref
151	CHARACTER(len=*),OPTIONAL :: zoom_ref
152	INTEGER, OPTIONAL :: prec
153	INTEGER, OPTIONAL :: level
154	LOGICAL, OPTIONAL :: enabled
155
156	IF (PRESENT(name)) THEN
157	p_field%name=TRIM(ADJUSTL(name))
158	p_field%has_name = .TRUE.
159	ENDIF
160	IF (PRESENT(ref)) THEN
161	p_field%field_ref=TRIM(ADJUSTL(ref))
162	p_field%has_field_ref = .TRUE.
163	ENDIF
164	IF (PRESENT(description)) THEN
165	p_field%description=TRIM(ADJUSTL(description))
166	p_field%has_description = .TRUE.
167	ENDIF
168
169	IF (PRESENT(unit)) then
170	p_field%unit=TRIM(ADJUSTL(unit))
171	p_field%has_unit = .TRUE.
172	ENDIF
173	IF (PRESENT(operation)) THEN
174	p_field%operation=TRIM(ADJUSTL(operation))
175	p_field%has_operation = .TRUE.
176	ENDIF
177	IF (PRESENT(freq_op)) THEN
178	p_field%freq_op=freq_op
179	p_field%has_freq_op = .TRUE.
180	ENDIF
181	IF (PRESENT(axis_ref)) THEN
182	p_field%axis_ref=TRIM(ADJUSTL(axis_ref))
183	p_field%has_axis_ref = .TRUE.
184	ENDIF
185	IF (PRESENT(grid_ref)) THEN
186	p_field%grid_ref=TRIM(ADJUSTL(grid_ref))
187	p_field%has_grid_ref = .TRUE.
188	ENDIF
189
190	IF (PRESENT(zoom_ref)) THEN
191	p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref))
192	p_field%has_zoom_ref = .TRUE.
193	ENDIF
194
195	IF (PRESENT(prec)) then
196	p_field%prec=prec
197	p_field%has_prec = .TRUE.
198	ENDIF
199
200	IF (PRESENT(level)) then
201	p_field%level=level
202	p_field%has_level = .TRUE.
203	ENDIF
204
205	IF (PRESENT(enabled)) then
206	p_field%enabled=enabled
207	p_field%has_enabled = .TRUE.
208	ENDIF
209
210	END SUBROUTINE field__set
211
212	SUBROUTINE field__set_attribut_id(id,attrib,Ok)
213	USE mod_attribut
214	USE mod_field_attribut
215	USE error_msg
216	IMPLICIT NONE
217	CHARACTER(LEN=*),INTENT(IN) :: id
218	TYPE(attribut),INTENT(IN) :: attrib
219	LOGICAL,OPTIONAL,INTENT(out) :: Ok
220
221	TYPE(field),POINTER :: Pt_field
222	INTEGER :: Pos
223	LOGICAL :: success
224
225	CALL sorted_list__find(Ids,hash(Id),Pos,success)
226	IF (success) THEN
227	Pt_field=>field_ids%at(Pos)%Pt
228	CALL field__set_attribut(Pt_field,attrib)
229	IF (PRESENT(OK)) ok=.TRUE.
230	ELSE
231	IF (.NOT.PRESENT(OK)) THEN
232	WRITE(message,*) 'Field id :',id,'is undefined'
233	CALL error('mod_field::field__set_attribut')
234	ELSE
235	OK=.FALSE.
236	ENDIF
237	ENDIF
238	END SUBROUTINE field__set_attribut_id
239
240
241	SUBROUTINE field__set_attribut_pt(pt_field,attrib)
242	USE mod_attribut
243	USE mod_field_attribut
244	USE error_msg
245	IMPLICIT NONE
246	TYPE(field),POINTER :: Pt_field
247	TYPE(attribut),INTENT(IN) :: attrib
248
249	SELECT CASE(attrib%name)
250	CASE (field__name)
251	IF (attrib%type==string0) CALL field__set(pt_field,name=attrib%string0_ptr) ; RETURN
252	CASE (field__field_ref)
253	IF (attrib%type==string0) CALL field__set(pt_field,ref=attrib%string0_ptr) ; RETURN
254	CASE (field__description)
255	IF (attrib%type==string0) CALL field__set(pt_field,description=attrib%string0_ptr) ; RETURN
256	CASE (field__unit)
257	IF (attrib%type==string0) CALL field__set(pt_field,unit=attrib%string0_ptr) ; RETURN
258	CASE (field__operation)
259	IF (attrib%type==string0) CALL field__set(pt_field,operation=attrib%string0_ptr) ; RETURN
260	CASE (field__freq_op)
261	IF (attrib%type==integer0) CALL field__set(pt_field,freq_op=attrib%integer0_ptr) ; RETURN
262	CASE (field__axis_ref)
263	IF (attrib%type==string0) CALL field__set(pt_field,axis_ref=attrib%string0_ptr) ; RETURN
264	CASE (field__grid_ref)
265	IF (attrib%type==string0) CALL field__set(pt_field,grid_ref=attrib%string0_ptr) ; RETURN
266	CASE (field__zoom_ref)
267	IF (attrib%type==string0) CALL field__set(pt_field,zoom_ref=attrib%string0_ptr) ; RETURN
268	CASE (field__prec)
269	IF (attrib%type==integer0) CALL field__set(pt_field,prec=attrib%integer0_ptr) ; RETURN
270	CASE (field__level)
271	IF (attrib%type==integer0) CALL field__set(pt_field,level=attrib%integer0_ptr) ; RETURN
272	CASE (field__enabled)
273	IF (attrib%type==logical0) CALL field__set(pt_field,enabled=attrib%logical0_ptr) ; RETURN
274	END SELECT
275
276	WRITE(message,*) 'field attribut ',attrib%name,' : type :',attrib%type,' : Attribute type is incompatible with the provided value'
277	CALL error('mod_field::field__set_attribut')
278
279	END SUBROUTINE field__set_attribut_pt
280
281	SUBROUTINE field__print(pt_field)
282
283	TYPE(field), POINTER :: pt_field
284
285	PRINT *,"--- FIELD ---"
286
287	IF (pt_field%has_id) THEN
288	PRINT *, 'id : ',TRIM(pt_field%id)
289	ELSE
290	PRINT *, 'id undefined '
291	ENDIF
292
293	IF (pt_field%has_name) THEN
294	PRINT *, 'name : ',TRIM(pt_field%name)
295	ELSE
296	PRINT *, 'name undefined '
297	ENDIF
298	IF (pt_field%has_description) THEN
299	PRINT *, 'description : ',TRIM(pt_field%description)
300	ELSE
301	PRINT *, 'description undefined '
302	ENDIF
303	IF (pt_field%has_unit) THEN
304	PRINT *, 'unit : ',TRIM(pt_field%unit)
305	ELSE
306	PRINT *, 'unit undefined '
307	ENDIF
308	IF (pt_field%has_operation) THEN
309	PRINT *, 'operation ',TRIM(pt_field%operation)
310	ELSE
311	PRINT *, 'operation undefined '
312	ENDIF
313	IF (pt_field%has_freq_op) THEN
314	PRINT *, 'freq_op ',pt_field%freq_op
315	ELSE
316	PRINT *, 'freq_op undefined '
317	ENDIF
318
319	IF (pt_field%has_axis_ref) THEN
320	PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
321	ELSE
322	PRINT *, 'axis_ref undefined '
323	ENDIF
324
325	IF (pt_field%has_grid_ref) THEN
326	PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
327	ELSE
328	PRINT *, 'grid_ref undefined '
329	ENDIF
330
331	IF (pt_field%has_zoom_ref) THEN
332	PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
333	ELSE
334	PRINT *, 'zoom_ref undefined '
335	ENDIF
336
337	IF (pt_field%has_field_ref) THEN
338	PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
339	ELSE
340	PRINT *, 'field_ref undefined '
341	ENDIF
342
343	! call vert_axis__print(pt_field%p_vert_axis)
344	!
345	! IF (pt_field%is_vert_axis_ref_def) THEN
346	! PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
347	! ELSE
348	! PRINT *, 'pt_field%vert_axis_ref undefined '
349	! ENDIF
350	IF (pt_field%has_prec) THEN
351	PRINT *, 'prec ',pt_field%prec
352	ELSE
353	PRINT *, 'prec undefined '
354	ENDIF
355	IF (pt_field%has_level) then
356	PRINT *, 'level ',pt_field%level
357	ELSE
358	PRINT *, 'level undefined '
359	ENDIF
360	IF (pt_field%has_field_base) THEN
361	PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
362	ELSE
363	PRINT *, 'field_base indefini'
364	ENDIF
365
366	IF (pt_field%has_enabled) THEN
367	PRINT *, 'enabled : ',pt_field%enabled
368	ELSE
369	PRINT *, 'enabled indefini'
370	ENDIF
371
372	PRINT *,"------------"
373
374	END SUBROUTINE field__print
375
376	! SUBROUTINE field__resolve_ref_vert_axis(p_field)
377	!
378	! TYPE(field), POINTER :: p_field
379	! CHARACTER(len=str_len) :: name
380	!
381	! IF (p_field%is_vert_axis_ref_def) THEN
382	! name=p_field%vert_axis_ref
383	! IF (vert_axis_def__is_exist(name)) THEN
384	! CALL vert_axis_def__get(name,p_field%p_vert_axis)
385	! p_field%is_vert_axis_def = .TRUE.
386	! ENDIF
387	! ENDIF
388	!
389	! END SUBROUTINE field__resolve_ref_vert_axis
390
391	SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
392
393	TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
394
395	IF (pt_field_in%has_name) THEN
396	pt_field_out%name=pt_field_in%name
397	pt_field_out%has_name=.TRUE.
398	ELSE IF ( pt_field_default%has_name) THEN
399	pt_field_out%name=pt_field_default%name
400	pt_field_out%has_name=.TRUE.
401	ELSE
402	pt_field_out%has_name=.FALSE.
403	ENDIF
404
405	IF (pt_field_in%has_description) THEN
406	pt_field_out%description=pt_field_in%description
407	pt_field_out%has_description=.TRUE.
408	ELSE IF ( pt_field_default%has_description ) THEN
409	pt_field_out%description=pt_field_default%description
410	pt_field_out%has_description=.TRUE.
411	ELSE
412	pt_field_out%has_description=.FALSE.
413	ENDIF
414
415	IF (pt_field_in%has_unit) THEN
416	pt_field_out%unit=pt_field_in%unit
417	pt_field_out%has_unit=.TRUE.
418	ELSE IF ( pt_field_default%has_unit ) THEN
419	pt_field_out%unit=pt_field_default%unit
420	pt_field_out%has_unit=.TRUE.
421	ELSE
422	pt_field_out%has_unit=.FALSE.
423	ENDIF
424
425	IF (pt_field_in%has_operation) THEN
426	pt_field_out%operation=pt_field_in%operation
427	pt_field_out%has_operation=.TRUE.
428	ELSE IF ( pt_field_default%has_operation ) THEN
429	pt_field_out%operation=pt_field_default%operation
430	pt_field_out%has_operation=.TRUE.
431	ELSE
432	pt_field_out%has_operation=.FALSE.
433	ENDIF
434
435	IF (pt_field_in%has_freq_op) THEN
436	pt_field_out%freq_op=pt_field_in%freq_op
437	pt_field_out%has_freq_op=.TRUE.
438	ELSE IF ( pt_field_default%has_freq_op ) THEN
439	pt_field_out%freq_op=pt_field_default%freq_op
440	pt_field_out%has_freq_op=.TRUE.
441	ELSE
442	pt_field_out%has_freq_op=.FALSE.
443	ENDIF
444
445	! IF (pt_field_in%has_axis) THEN
446	! pt_field_out%p_axis => pt_field_in%p_axis
447	! pt_field_out%has_axis=.TRUE.
448	! ELSE IF ( pt_field_default%has_axis ) THEN
449	! pt_field_out%p_axis => pt_field_default%p_axis
450	! pt_field_out%has_axis=.TRUE.
451	! ELSE
452	! pt_field_out%has_axis=.FALSE.
453	! ENDIF
454
455	IF (pt_field_in%has_axis_ref) THEN
456	pt_field_out%axis_ref=pt_field_in%axis_ref
457	pt_field_out%has_axis_ref=.TRUE.
458	ELSE IF ( pt_field_default%has_axis_ref ) THEN
459	pt_field_out%axis_ref=pt_field_default%axis_ref
460	pt_field_out%has_axis_ref=.TRUE.
461	ELSE
462	pt_field_out%has_axis_ref=.FALSE.
463	ENDIF
464
465	IF (pt_field_in%has_grid_ref) THEN
466	pt_field_out%grid_ref=pt_field_in%grid_ref
467	pt_field_out%has_grid_ref=.TRUE.
468	ELSE IF ( pt_field_default%has_grid_ref ) THEN
469	pt_field_out%grid_ref=pt_field_default%grid_ref
470	pt_field_out%has_grid_ref=.TRUE.
471	ELSE
472	pt_field_out%has_grid_ref=.FALSE.
473	ENDIF
474
475	IF (pt_field_in%has_zoom_ref) THEN
476	pt_field_out%zoom_ref=pt_field_in%zoom_ref
477	pt_field_out%has_zoom_ref=.TRUE.
478	ELSE IF ( pt_field_default%has_zoom_ref ) THEN
479	pt_field_out%zoom_ref=pt_field_default%zoom_ref
480	pt_field_out%has_zoom_ref=.TRUE.
481	ELSE
482	pt_field_out%has_zoom_ref=.FALSE.
483	ENDIF
484
485	IF (pt_field_in%has_prec) THEN
486	pt_field_out%prec=pt_field_in%prec
487	pt_field_out%has_prec=.TRUE.
488	ELSE IF ( pt_field_default%has_prec ) THEN
489	pt_field_out%prec=pt_field_default%prec
490	pt_field_out%has_prec=.TRUE.
491	ELSE
492	pt_field_out%has_prec=.FALSE.
493	ENDIF
494
495	IF (pt_field_in%has_level) THEN
496	pt_field_out%level=pt_field_in%level
497	pt_field_out%has_level=.TRUE.
498	ELSE IF ( pt_field_default%has_level ) THEN
499	pt_field_out%level=pt_field_default%level
500	pt_field_out%has_level=.TRUE.
501	ELSE
502	pt_field_out%has_level=.FALSE.
503	ENDIF
504
505	IF (pt_field_in%has_enabled) THEN
506	pt_field_out%enabled=pt_field_in%enabled
507	pt_field_out%has_enabled=.TRUE.
508	ELSE IF ( pt_field_default%has_enabled ) THEN
509	pt_field_out%enabled=pt_field_default%enabled
510	pt_field_out%has_enabled=.TRUE.
511	ELSE
512	pt_field_out%has_enabled=.FALSE.
513	ENDIF
514
515	END SUBROUTINE field__apply_default
516
517	! FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
518	!
519	! LOGICAL :: field__is_vert_axis_attached
520	! TYPE(field), POINTER :: p_field
521	! CHARACTER(len=*), INTENT(IN) :: vert_axis_name
522	!
523	! field__is_vert_axis_attached = .false.
524	! IF (p_field%is_vert_axis_def) THEN
525	! IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
526	! ENDIF
527	!
528	! END FUNCTION field__is_vert_axis_attached
529
530	RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
531	USE error_msg
532	IMPLICIT NONE
533	TYPE(field), POINTER :: pt_field
534
535	TYPE(field), POINTER :: field_ref
536
537	IF (.NOT. pt_field%solved_field_ref) THEN
538
539	IF (pt_field%has_field_ref) THEN
540
541	CALL field__get(pt_field%field_ref,field_ref)
542
543	IF (.NOT. ASSOCIATED(field_ref)) THEN
544	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
545	" has a unknown reference to field : id =",pt_field%field_ref
546	CALL error("field__solve_field_ref")
547	ENDIF
548
549	CALL field__get_field_base(field_ref,pt_field%field_base)
550	Pt_field%has_field_base=.TRUE.
551
552	CALL field__apply_default(field_ref,pt_field,pt_field)
553
554
555	ELSE
556
557	IF (pt_field%has_id) THEN
558	pt_field%field_base=>pt_field
559	ENDIF
560
561	ENDIF
562
563	IF (.NOT. pt_field%has_name) THEN
564	IF (pt_field%has_id) THEN
565	pt_field%name=pt_field%id
566	pt_field%has_name=.TRUE.
567	ENDIF
568	ENDIF
569
570	Pt_field%solved_field_ref=.TRUE.
571
572	ENDIF
573
574	END SUBROUTINE field__solve_field_ref
575
576
577	RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
578	IMPLICIT NONE
579	TYPE(field), POINTER :: pt_field
580	TYPE(field), POINTER :: pt_field_base
581
582
583	IF (.NOT. Pt_field%solved_field_ref) THEN
584	CALL field__solve_field_ref(Pt_field)
585	ENDIF
586
587	IF (pt_field%has_field_base) THEN
588	pt_field_base=>pt_field%field_base
589	ELSE
590	pt_field_base=>pt_field
591	ENDIF
592
593	END SUBROUTINE field__get_field_base
594
595	SUBROUTINE field__solve_axis_ref(pt_field)
596	USE error_msg
597	IMPLICIT NONE
598	TYPE(field), POINTER :: pt_field
599
600	IF (pt_field%has_axis_ref) THEN
601	CALL axis__get(pt_field%axis_ref,pt_field%axis)
602	IF (ASSOCIATED(pt_field%axis)) THEN
603	pt_field%has_axis=.TRUE.
604	ELSE
605	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
606	" has a unknown reference to axis : id =",pt_field%axis_ref
607	CALL error("mod_field::field__solve_axis_ref")
608	ENDIF
609	ENDIF
610
611	END SUBROUTINE field__solve_axis_ref
612
613	SUBROUTINE field__solve_grid_ref(pt_field)
614	USE error_msg
615	IMPLICIT NONE
616	TYPE(field), POINTER :: pt_field
617
618	IF (pt_field%has_grid_ref) THEN
619	CALL grid__get(pt_field%grid_ref,pt_field%grid)
620	IF (ASSOCIATED(pt_field%grid)) THEN
621	pt_field%has_grid=.TRUE.
622	ELSE
623	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
624	" has a unknown reference to grid : id =",pt_field%grid_ref
625	CALL error("mod_field::field__solve_grid_ref")
626	ENDIF
627	ENDIF
628
629	END SUBROUTINE field__solve_grid_ref
630
631	SUBROUTINE field__solve_zoom_ref(pt_field)
632	USE error_msg
633	IMPLICIT NONE
634	TYPE(field), POINTER :: pt_field
635
636	IF (.NOT. pt_field%has_zoom_ref) THEN
637	IF (pt_field%has_grid_ref) THEN
638	pt_field%has_zoom_ref=.TRUE.
639	pt_field%zoom_ref=pt_field%grid_ref
640	ENDIF
641	ENDIF
642
643	IF (pt_field%has_zoom_ref) THEN
644	CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
645	IF (ASSOCIATED(pt_field%zoom)) THEN
646	pt_field%has_zoom=.TRUE.
647	ELSE
648	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
649	" has a unknown reference to zoom : id =",pt_field%zoom_ref
650	CALL error("mod_field::field__solve_zoom_ref")
651	ENDIF
652	ENDIF
653
654	END SUBROUTINE field__solve_zoom_ref
655
656
657	END MODULE mod_field

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

Download in other formats: