Context Navigation

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

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

Les attributs XML peuvent dÃ©sormais Ãªtre passer dynamiquement Ã travers l'interface du server IO.
ajout d'un attribut name_suffix pour les fichiers

YM

File size: 19.1 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	SUBROUTINE field__set_attribut(id,attrib)
209	USE mod_attribut
210	USE mod_field_attribut
211	USE error_msg
212	IMPLICIT NONE
213	CHARACTER(LEN=*),INTENT(IN) :: id
214	TYPE(attribut),INTENT(IN) :: attrib
215
216	TYPE(field),POINTER :: Pt_field
217	INTEGER :: Pos
218	LOGICAL :: success
219
220	CALL sorted_list__find(Ids,hash(Id),Pos,success)
221	IF (success) THEN
222	Pt_field=>field_ids%at(Pos)%Pt
223	ELSE
224	WRITE(message,*) 'Field id :',id,'is undefined'
225	CALL error('mod_field::field__set_attribut')
226	ENDIF
227
228	SELECT CASE(attrib%name)
229	CASE (field__name)
230	IF (attrib%type==string0) CALL field__set(pt_field,name=attrib%string0_ptr) ; RETURN
231	CASE (field__field_ref)
232	IF (attrib%type==string0) CALL field__set(pt_field,ref=attrib%string0_ptr) ; RETURN
233	CASE (field__description)
234	IF (attrib%type==string0) CALL field__set(pt_field,description=attrib%string0_ptr) ; RETURN
235	CASE (field__unit)
236	IF (attrib%type==string0) CALL field__set(pt_field,unit=attrib%string0_ptr) ; RETURN
237	CASE (field__operation)
238	IF (attrib%type==string0) CALL field__set(pt_field,operation=attrib%string0_ptr) ; RETURN
239	CASE (field__freq_op)
240	IF (attrib%type==integer0) CALL field__set(pt_field,freq_op=attrib%integer0_ptr) ; RETURN
241	CASE (field__axis_ref)
242	IF (attrib%type==string0) CALL field__set(pt_field,axis_ref=attrib%string0_ptr) ; RETURN
243	CASE (field__grid_ref)
244	IF (attrib%type==string0) CALL field__set(pt_field,grid_ref=attrib%string0_ptr) ; RETURN
245	CASE (field__zoom_ref)
246	IF (attrib%type==string0) CALL field__set(pt_field,zoom_ref=attrib%string0_ptr) ; RETURN
247	CASE (field__prec)
248	IF (attrib%type==integer0) CALL field__set(pt_field,prec=attrib%integer0_ptr) ; RETURN
249	CASE (field__level)
250	IF (attrib%type==integer0) CALL field__set(pt_field,level=attrib%integer0_ptr) ; RETURN
251	CASE (field__enabled)
252	IF (attrib%type==logical0) CALL field__set(pt_field,enabled=attrib%logical0_ptr) ; RETURN
253	END SELECT
254
255	WRITE(message,*) 'field id ',id,' : Attribute type is incompatible with the provided value'
256	CALL error('mod_field::field__set_attribut')
257
258	END SUBROUTINE field__set_attribut
259
260	SUBROUTINE field__print(pt_field)
261
262	TYPE(field), POINTER :: pt_field
263
264	PRINT *,"--- FIELD ---"
265
266	IF (pt_field%has_id) THEN
267	PRINT *, 'id : ',TRIM(pt_field%id)
268	ELSE
269	PRINT *, 'id undefined '
270	ENDIF
271
272	IF (pt_field%has_name) THEN
273	PRINT *, 'name : ',TRIM(pt_field%name)
274	ELSE
275	PRINT *, 'name undefined '
276	ENDIF
277	IF (pt_field%has_description) THEN
278	PRINT *, 'description : ',TRIM(pt_field%description)
279	ELSE
280	PRINT *, 'description undefined '
281	ENDIF
282	IF (pt_field%has_unit) THEN
283	PRINT *, 'unit : ',TRIM(pt_field%unit)
284	ELSE
285	PRINT *, 'unit undefined '
286	ENDIF
287	IF (pt_field%has_operation) THEN
288	PRINT *, 'operation ',TRIM(pt_field%operation)
289	ELSE
290	PRINT *, 'operation undefined '
291	ENDIF
292	IF (pt_field%has_freq_op) THEN
293	PRINT *, 'freq_op ',pt_field%freq_op
294	ELSE
295	PRINT *, 'freq_op undefined '
296	ENDIF
297
298	IF (pt_field%has_axis_ref) THEN
299	PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
300	ELSE
301	PRINT *, 'axis_ref undefined '
302	ENDIF
303
304	IF (pt_field%has_grid_ref) THEN
305	PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
306	ELSE
307	PRINT *, 'grid_ref undefined '
308	ENDIF
309
310	IF (pt_field%has_zoom_ref) THEN
311	PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
312	ELSE
313	PRINT *, 'zoom_ref undefined '
314	ENDIF
315
316	IF (pt_field%has_field_ref) THEN
317	PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
318	ELSE
319	PRINT *, 'field_ref undefined '
320	ENDIF
321
322	! call vert_axis__print(pt_field%p_vert_axis)
323	!
324	! IF (pt_field%is_vert_axis_ref_def) THEN
325	! PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
326	! ELSE
327	! PRINT *, 'pt_field%vert_axis_ref undefined '
328	! ENDIF
329	IF (pt_field%has_prec) THEN
330	PRINT *, 'prec ',pt_field%prec
331	ELSE
332	PRINT *, 'prec undefined '
333	ENDIF
334	IF (pt_field%has_level) then
335	PRINT *, 'level ',pt_field%level
336	ELSE
337	PRINT *, 'level undefined '
338	ENDIF
339	IF (pt_field%has_field_base) THEN
340	PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
341	ELSE
342	PRINT *, 'field_base indefini'
343	ENDIF
344
345	IF (pt_field%has_enabled) THEN
346	PRINT *, 'enabled : ',pt_field%enabled
347	ELSE
348	PRINT *, 'enabled indefini'
349	ENDIF
350
351	PRINT *,"------------"
352
353	END SUBROUTINE field__print
354
355	! SUBROUTINE field__resolve_ref_vert_axis(p_field)
356	!
357	! TYPE(field), POINTER :: p_field
358	! CHARACTER(len=str_len) :: name
359	!
360	! IF (p_field%is_vert_axis_ref_def) THEN
361	! name=p_field%vert_axis_ref
362	! IF (vert_axis_def__is_exist(name)) THEN
363	! CALL vert_axis_def__get(name,p_field%p_vert_axis)
364	! p_field%is_vert_axis_def = .TRUE.
365	! ENDIF
366	! ENDIF
367	!
368	! END SUBROUTINE field__resolve_ref_vert_axis
369
370	SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
371
372	TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
373
374	IF (pt_field_in%has_name) THEN
375	pt_field_out%name=pt_field_in%name
376	pt_field_out%has_name=.TRUE.
377	ELSE IF ( pt_field_default%has_name) THEN
378	pt_field_out%name=pt_field_default%name
379	pt_field_out%has_name=.TRUE.
380	ELSE
381	pt_field_out%has_name=.FALSE.
382	ENDIF
383
384	IF (pt_field_in%has_description) THEN
385	pt_field_out%description=pt_field_in%description
386	pt_field_out%has_description=.TRUE.
387	ELSE IF ( pt_field_default%has_description ) THEN
388	pt_field_out%description=pt_field_default%description
389	pt_field_out%has_description=.TRUE.
390	ELSE
391	pt_field_out%has_description=.FALSE.
392	ENDIF
393
394	IF (pt_field_in%has_unit) THEN
395	pt_field_out%unit=pt_field_in%unit
396	pt_field_out%has_unit=.TRUE.
397	ELSE IF ( pt_field_default%has_unit ) THEN
398	pt_field_out%unit=pt_field_default%unit
399	pt_field_out%has_unit=.TRUE.
400	ELSE
401	pt_field_out%has_unit=.FALSE.
402	ENDIF
403
404	IF (pt_field_in%has_operation) THEN
405	pt_field_out%operation=pt_field_in%operation
406	pt_field_out%has_operation=.TRUE.
407	ELSE IF ( pt_field_default%has_operation ) THEN
408	pt_field_out%operation=pt_field_default%operation
409	pt_field_out%has_operation=.TRUE.
410	ELSE
411	pt_field_out%has_operation=.FALSE.
412	ENDIF
413
414	IF (pt_field_in%has_freq_op) THEN
415	pt_field_out%freq_op=pt_field_in%freq_op
416	pt_field_out%has_freq_op=.TRUE.
417	ELSE IF ( pt_field_default%has_freq_op ) THEN
418	pt_field_out%freq_op=pt_field_default%freq_op
419	pt_field_out%has_freq_op=.TRUE.
420	ELSE
421	pt_field_out%has_freq_op=.FALSE.
422	ENDIF
423
424	! IF (pt_field_in%has_axis) THEN
425	! pt_field_out%p_axis => pt_field_in%p_axis
426	! pt_field_out%has_axis=.TRUE.
427	! ELSE IF ( pt_field_default%has_axis ) THEN
428	! pt_field_out%p_axis => pt_field_default%p_axis
429	! pt_field_out%has_axis=.TRUE.
430	! ELSE
431	! pt_field_out%has_axis=.FALSE.
432	! ENDIF
433
434	IF (pt_field_in%has_axis_ref) THEN
435	pt_field_out%axis_ref=pt_field_in%axis_ref
436	pt_field_out%has_axis_ref=.TRUE.
437	ELSE IF ( pt_field_default%has_axis_ref ) THEN
438	pt_field_out%axis_ref=pt_field_default%axis_ref
439	pt_field_out%has_axis_ref=.TRUE.
440	ELSE
441	pt_field_out%has_axis_ref=.FALSE.
442	ENDIF
443
444	IF (pt_field_in%has_grid_ref) THEN
445	pt_field_out%grid_ref=pt_field_in%grid_ref
446	pt_field_out%has_grid_ref=.TRUE.
447	ELSE IF ( pt_field_default%has_grid_ref ) THEN
448	pt_field_out%grid_ref=pt_field_default%grid_ref
449	pt_field_out%has_grid_ref=.TRUE.
450	ELSE
451	pt_field_out%has_grid_ref=.FALSE.
452	ENDIF
453
454	IF (pt_field_in%has_zoom_ref) THEN
455	pt_field_out%zoom_ref=pt_field_in%zoom_ref
456	pt_field_out%has_zoom_ref=.TRUE.
457	ELSE IF ( pt_field_default%has_zoom_ref ) THEN
458	pt_field_out%zoom_ref=pt_field_default%zoom_ref
459	pt_field_out%has_zoom_ref=.TRUE.
460	ELSE
461	pt_field_out%has_zoom_ref=.FALSE.
462	ENDIF
463
464	IF (pt_field_in%has_prec) THEN
465	pt_field_out%prec=pt_field_in%prec
466	pt_field_out%has_prec=.TRUE.
467	ELSE IF ( pt_field_default%has_prec ) THEN
468	pt_field_out%prec=pt_field_default%prec
469	pt_field_out%has_prec=.TRUE.
470	ELSE
471	pt_field_out%has_prec=.FALSE.
472	ENDIF
473
474	IF (pt_field_in%has_level) THEN
475	pt_field_out%level=pt_field_in%level
476	pt_field_out%has_level=.TRUE.
477	ELSE IF ( pt_field_default%has_level ) THEN
478	pt_field_out%level=pt_field_default%level
479	pt_field_out%has_level=.TRUE.
480	ELSE
481	pt_field_out%has_level=.FALSE.
482	ENDIF
483
484	IF (pt_field_in%has_enabled) THEN
485	pt_field_out%enabled=pt_field_in%enabled
486	pt_field_out%has_enabled=.TRUE.
487	ELSE IF ( pt_field_default%has_enabled ) THEN
488	pt_field_out%enabled=pt_field_default%enabled
489	pt_field_out%has_enabled=.TRUE.
490	ELSE
491	pt_field_out%has_enabled=.FALSE.
492	ENDIF
493
494	END SUBROUTINE field__apply_default
495
496	! FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
497	!
498	! LOGICAL :: field__is_vert_axis_attached
499	! TYPE(field), POINTER :: p_field
500	! CHARACTER(len=*), INTENT(IN) :: vert_axis_name
501	!
502	! field__is_vert_axis_attached = .false.
503	! IF (p_field%is_vert_axis_def) THEN
504	! IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
505	! ENDIF
506	!
507	! END FUNCTION field__is_vert_axis_attached
508
509	RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
510	USE error_msg
511	IMPLICIT NONE
512	TYPE(field), POINTER :: pt_field
513
514	TYPE(field), POINTER :: field_ref
515
516	IF (.NOT. pt_field%solved_field_ref) THEN
517
518	IF (pt_field%has_field_ref) THEN
519
520	CALL field__get(pt_field%field_ref,field_ref)
521
522	IF (.NOT. ASSOCIATED(field_ref)) THEN
523	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
524	" has a unknown reference to field : id =",pt_field%field_ref
525	CALL error("field__solve_field_ref")
526	ENDIF
527
528	CALL field__get_field_base(field_ref,pt_field%field_base)
529	Pt_field%has_field_base=.TRUE.
530
531	CALL field__apply_default(field_ref,pt_field,pt_field)
532
533
534	ELSE
535
536	IF (pt_field%has_id) THEN
537	pt_field%field_base=>pt_field
538	ENDIF
539
540	ENDIF
541
542	IF (.NOT. pt_field%has_name) THEN
543	IF (pt_field%has_id) THEN
544	pt_field%name=pt_field%id
545	pt_field%has_name=.TRUE.
546	ENDIF
547	ENDIF
548
549	Pt_field%solved_field_ref=.TRUE.
550
551	ENDIF
552
553	END SUBROUTINE field__solve_field_ref
554
555
556	RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
557	IMPLICIT NONE
558	TYPE(field), POINTER :: pt_field
559	TYPE(field), POINTER :: pt_field_base
560
561
562	IF (.NOT. Pt_field%solved_field_ref) THEN
563	CALL field__solve_field_ref(Pt_field)
564	ENDIF
565
566	IF (pt_field%has_field_base) THEN
567	pt_field_base=>pt_field%field_base
568	ELSE
569	pt_field_base=>pt_field
570	ENDIF
571
572	END SUBROUTINE field__get_field_base
573
574	SUBROUTINE field__solve_axis_ref(pt_field)
575	USE error_msg
576	IMPLICIT NONE
577	TYPE(field), POINTER :: pt_field
578
579	IF (pt_field%has_axis_ref) THEN
580	CALL axis__get(pt_field%axis_ref,pt_field%axis)
581	IF (ASSOCIATED(pt_field%axis)) THEN
582	pt_field%has_axis=.TRUE.
583	ELSE
584	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
585	" has a unknown reference to axis : id =",pt_field%axis_ref
586	CALL error("mod_field::field__solve_axis_ref")
587	ENDIF
588	ENDIF
589
590	END SUBROUTINE field__solve_axis_ref
591
592	SUBROUTINE field__solve_grid_ref(pt_field)
593	USE error_msg
594	IMPLICIT NONE
595	TYPE(field), POINTER :: pt_field
596
597	IF (pt_field%has_grid_ref) THEN
598	CALL grid__get(pt_field%grid_ref,pt_field%grid)
599	IF (ASSOCIATED(pt_field%grid)) THEN
600	pt_field%has_grid=.TRUE.
601	ELSE
602	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
603	" has a unknown reference to grid : id =",pt_field%grid_ref
604	CALL error("mod_field::field__solve_grid_ref")
605	ENDIF
606	ENDIF
607
608	END SUBROUTINE field__solve_grid_ref
609
610	SUBROUTINE field__solve_zoom_ref(pt_field)
611	USE error_msg
612	IMPLICIT NONE
613	TYPE(field), POINTER :: pt_field
614
615	IF (.NOT. pt_field%has_zoom_ref) THEN
616	IF (pt_field%has_grid_ref) THEN
617	pt_field%has_zoom_ref=.TRUE.
618	pt_field%zoom_ref=pt_field%grid_ref
619	ENDIF
620	ENDIF
621
622	IF (pt_field%has_zoom_ref) THEN
623	CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
624	IF (ASSOCIATED(pt_field%zoom)) THEN
625	pt_field%has_zoom=.TRUE.
626	ELSE
627	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
628	" has a unknown reference to zoom : id =",pt_field%zoom_ref
629	CALL error("mod_field::field__solve_zoom_ref")
630	ENDIF
631	ENDIF
632
633	END SUBROUTINE field__solve_zoom_ref
634
635
636	END MODULE mod_field

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

Download in other formats: