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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

mod_field.f90 in vendors/XMLIO_SERVER/current/src/XMLIO – NEMO

Context Navigation

source: vendors/XMLIO_SERVER/current/src/XMLIO/mod_field.f90 @ 1897

Last change on this file since 1897 was 1897, checked in by flavoni, 14 years ago
importing XMLIO_SERVER vendor
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, &
277	' : Attribute type is incompatible with the provided value'
278	CALL error('mod_field::field__set_attribut')
279
280	END SUBROUTINE field__set_attribut_pt
281
282	SUBROUTINE field__print(pt_field)
283
284	TYPE(field), POINTER :: pt_field
285
286	PRINT *,"--- FIELD ---"
287
288	IF (pt_field%has_id) THEN
289	PRINT *, 'id : ',TRIM(pt_field%id)
290	ELSE
291	PRINT *, 'id undefined '
292	ENDIF
293
294	IF (pt_field%has_name) THEN
295	PRINT *, 'name : ',TRIM(pt_field%name)
296	ELSE
297	PRINT *, 'name undefined '
298	ENDIF
299	IF (pt_field%has_description) THEN
300	PRINT *, 'description : ',TRIM(pt_field%description)
301	ELSE
302	PRINT *, 'description undefined '
303	ENDIF
304	IF (pt_field%has_unit) THEN
305	PRINT *, 'unit : ',TRIM(pt_field%unit)
306	ELSE
307	PRINT *, 'unit undefined '
308	ENDIF
309	IF (pt_field%has_operation) THEN
310	PRINT *, 'operation ',TRIM(pt_field%operation)
311	ELSE
312	PRINT *, 'operation undefined '
313	ENDIF
314	IF (pt_field%has_freq_op) THEN
315	PRINT *, 'freq_op ',pt_field%freq_op
316	ELSE
317	PRINT *, 'freq_op undefined '
318	ENDIF
319
320	IF (pt_field%has_axis_ref) THEN
321	PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
322	ELSE
323	PRINT *, 'axis_ref undefined '
324	ENDIF
325
326	IF (pt_field%has_grid_ref) THEN
327	PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
328	ELSE
329	PRINT *, 'grid_ref undefined '
330	ENDIF
331
332	IF (pt_field%has_zoom_ref) THEN
333	PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
334	ELSE
335	PRINT *, 'zoom_ref undefined '
336	ENDIF
337
338	IF (pt_field%has_field_ref) THEN
339	PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
340	ELSE
341	PRINT *, 'field_ref undefined '
342	ENDIF
343
344	! call vert_axis__print(pt_field%p_vert_axis)
345	!
346	! IF (pt_field%is_vert_axis_ref_def) THEN
347	! PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
348	! ELSE
349	! PRINT *, 'pt_field%vert_axis_ref undefined '
350	! ENDIF
351	IF (pt_field%has_prec) THEN
352	PRINT *, 'prec ',pt_field%prec
353	ELSE
354	PRINT *, 'prec undefined '
355	ENDIF
356	IF (pt_field%has_level) then
357	PRINT *, 'level ',pt_field%level
358	ELSE
359	PRINT *, 'level undefined '
360	ENDIF
361	IF (pt_field%has_field_base) THEN
362	PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
363	ELSE
364	PRINT *, 'field_base indefini'
365	ENDIF
366
367	IF (pt_field%has_enabled) THEN
368	PRINT *, 'enabled : ',pt_field%enabled
369	ELSE
370	PRINT *, 'enabled indefini'
371	ENDIF
372
373	PRINT *,"------------"
374
375	END SUBROUTINE field__print
376
377	! SUBROUTINE field__resolve_ref_vert_axis(p_field)
378	!
379	! TYPE(field), POINTER :: p_field
380	! CHARACTER(len=str_len) :: name
381	!
382	! IF (p_field%is_vert_axis_ref_def) THEN
383	! name=p_field%vert_axis_ref
384	! IF (vert_axis_def__is_exist(name)) THEN
385	! CALL vert_axis_def__get(name,p_field%p_vert_axis)
386	! p_field%is_vert_axis_def = .TRUE.
387	! ENDIF
388	! ENDIF
389	!
390	! END SUBROUTINE field__resolve_ref_vert_axis
391
392	SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
393
394	TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
395
396	IF (pt_field_in%has_name) THEN
397	pt_field_out%name=pt_field_in%name
398	pt_field_out%has_name=.TRUE.
399	ELSE IF ( pt_field_default%has_name) THEN
400	pt_field_out%name=pt_field_default%name
401	pt_field_out%has_name=.TRUE.
402	ELSE
403	pt_field_out%has_name=.FALSE.
404	ENDIF
405
406	IF (pt_field_in%has_description) THEN
407	pt_field_out%description=pt_field_in%description
408	pt_field_out%has_description=.TRUE.
409	ELSE IF ( pt_field_default%has_description ) THEN
410	pt_field_out%description=pt_field_default%description
411	pt_field_out%has_description=.TRUE.
412	ELSE
413	pt_field_out%has_description=.FALSE.
414	ENDIF
415
416	IF (pt_field_in%has_unit) THEN
417	pt_field_out%unit=pt_field_in%unit
418	pt_field_out%has_unit=.TRUE.
419	ELSE IF ( pt_field_default%has_unit ) THEN
420	pt_field_out%unit=pt_field_default%unit
421	pt_field_out%has_unit=.TRUE.
422	ELSE
423	pt_field_out%has_unit=.FALSE.
424	ENDIF
425
426	IF (pt_field_in%has_operation) THEN
427	pt_field_out%operation=pt_field_in%operation
428	pt_field_out%has_operation=.TRUE.
429	ELSE IF ( pt_field_default%has_operation ) THEN
430	pt_field_out%operation=pt_field_default%operation
431	pt_field_out%has_operation=.TRUE.
432	ELSE
433	pt_field_out%has_operation=.FALSE.
434	ENDIF
435
436	IF (pt_field_in%has_freq_op) THEN
437	pt_field_out%freq_op=pt_field_in%freq_op
438	pt_field_out%has_freq_op=.TRUE.
439	ELSE IF ( pt_field_default%has_freq_op ) THEN
440	pt_field_out%freq_op=pt_field_default%freq_op
441	pt_field_out%has_freq_op=.TRUE.
442	ELSE
443	pt_field_out%has_freq_op=.FALSE.
444	ENDIF
445
446	! IF (pt_field_in%has_axis) THEN
447	! pt_field_out%p_axis => pt_field_in%p_axis
448	! pt_field_out%has_axis=.TRUE.
449	! ELSE IF ( pt_field_default%has_axis ) THEN
450	! pt_field_out%p_axis => pt_field_default%p_axis
451	! pt_field_out%has_axis=.TRUE.
452	! ELSE
453	! pt_field_out%has_axis=.FALSE.
454	! ENDIF
455
456	IF (pt_field_in%has_axis_ref) THEN
457	pt_field_out%axis_ref=pt_field_in%axis_ref
458	pt_field_out%has_axis_ref=.TRUE.
459	ELSE IF ( pt_field_default%has_axis_ref ) THEN
460	pt_field_out%axis_ref=pt_field_default%axis_ref
461	pt_field_out%has_axis_ref=.TRUE.
462	ELSE
463	pt_field_out%has_axis_ref=.FALSE.
464	ENDIF
465
466	IF (pt_field_in%has_grid_ref) THEN
467	pt_field_out%grid_ref=pt_field_in%grid_ref
468	pt_field_out%has_grid_ref=.TRUE.
469	ELSE IF ( pt_field_default%has_grid_ref ) THEN
470	pt_field_out%grid_ref=pt_field_default%grid_ref
471	pt_field_out%has_grid_ref=.TRUE.
472	ELSE
473	pt_field_out%has_grid_ref=.FALSE.
474	ENDIF
475
476	IF (pt_field_in%has_zoom_ref) THEN
477	pt_field_out%zoom_ref=pt_field_in%zoom_ref
478	pt_field_out%has_zoom_ref=.TRUE.
479	ELSE IF ( pt_field_default%has_zoom_ref ) THEN
480	pt_field_out%zoom_ref=pt_field_default%zoom_ref
481	pt_field_out%has_zoom_ref=.TRUE.
482	ELSE
483	pt_field_out%has_zoom_ref=.FALSE.
484	ENDIF
485
486	IF (pt_field_in%has_prec) THEN
487	pt_field_out%prec=pt_field_in%prec
488	pt_field_out%has_prec=.TRUE.
489	ELSE IF ( pt_field_default%has_prec ) THEN
490	pt_field_out%prec=pt_field_default%prec
491	pt_field_out%has_prec=.TRUE.
492	ELSE
493	pt_field_out%has_prec=.FALSE.
494	ENDIF
495
496	IF (pt_field_in%has_level) THEN
497	pt_field_out%level=pt_field_in%level
498	pt_field_out%has_level=.TRUE.
499	ELSE IF ( pt_field_default%has_level ) THEN
500	pt_field_out%level=pt_field_default%level
501	pt_field_out%has_level=.TRUE.
502	ELSE
503	pt_field_out%has_level=.FALSE.
504	ENDIF
505
506	IF (pt_field_in%has_enabled) THEN
507	pt_field_out%enabled=pt_field_in%enabled
508	pt_field_out%has_enabled=.TRUE.
509	ELSE IF ( pt_field_default%has_enabled ) THEN
510	pt_field_out%enabled=pt_field_default%enabled
511	pt_field_out%has_enabled=.TRUE.
512	ELSE
513	pt_field_out%has_enabled=.FALSE.
514	ENDIF
515
516	END SUBROUTINE field__apply_default
517
518	! FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
519	!
520	! LOGICAL :: field__is_vert_axis_attached
521	! TYPE(field), POINTER :: p_field
522	! CHARACTER(len=*), INTENT(IN) :: vert_axis_name
523	!
524	! field__is_vert_axis_attached = .false.
525	! IF (p_field%is_vert_axis_def) THEN
526	! IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
527	! ENDIF
528	!
529	! END FUNCTION field__is_vert_axis_attached
530
531	RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
532	USE error_msg
533	IMPLICIT NONE
534	TYPE(field), POINTER :: pt_field
535
536	TYPE(field), POINTER :: field_ref
537
538	IF (.NOT. pt_field%solved_field_ref) THEN
539
540	IF (pt_field%has_field_ref) THEN
541
542	CALL field__get(pt_field%field_ref,field_ref)
543
544	IF (.NOT. ASSOCIATED(field_ref)) THEN
545	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
546	" has a unknown reference to field : id =",pt_field%field_ref
547	CALL error("field__solve_field_ref")
548	ENDIF
549
550	CALL field__get_field_base(field_ref,pt_field%field_base)
551	Pt_field%has_field_base=.TRUE.
552
553	CALL field__apply_default(field_ref,pt_field,pt_field)
554
555
556	ELSE
557
558	IF (pt_field%has_id) THEN
559	pt_field%field_base=>pt_field
560	ENDIF
561
562	ENDIF
563
564	IF (.NOT. pt_field%has_name) THEN
565	IF (pt_field%has_id) THEN
566	pt_field%name=pt_field%id
567	pt_field%has_name=.TRUE.
568	ENDIF
569	ENDIF
570
571	Pt_field%solved_field_ref=.TRUE.
572
573	ENDIF
574
575	END SUBROUTINE field__solve_field_ref
576
577
578	RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
579	IMPLICIT NONE
580	TYPE(field), POINTER :: pt_field
581	TYPE(field), POINTER :: pt_field_base
582
583
584	IF (.NOT. Pt_field%solved_field_ref) THEN
585	CALL field__solve_field_ref(Pt_field)
586	ENDIF
587
588	IF (pt_field%has_field_base) THEN
589	pt_field_base=>pt_field%field_base
590	ELSE
591	pt_field_base=>pt_field
592	ENDIF
593
594	END SUBROUTINE field__get_field_base
595
596	SUBROUTINE field__solve_axis_ref(pt_field)
597	USE error_msg
598	IMPLICIT NONE
599	TYPE(field), POINTER :: pt_field
600
601	IF (pt_field%has_axis_ref) THEN
602	CALL axis__get(pt_field%axis_ref,pt_field%axis)
603	IF (ASSOCIATED(pt_field%axis)) THEN
604	pt_field%has_axis=.TRUE.
605	ELSE
606	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
607	" has a unknown reference to axis : id =",pt_field%axis_ref
608	CALL error("mod_field::field__solve_axis_ref")
609	ENDIF
610	ENDIF
611
612	END SUBROUTINE field__solve_axis_ref
613
614	SUBROUTINE field__solve_grid_ref(pt_field)
615	USE error_msg
616	IMPLICIT NONE
617	TYPE(field), POINTER :: pt_field
618
619	IF (pt_field%has_grid_ref) THEN
620	CALL grid__get(pt_field%grid_ref,pt_field%grid)
621	IF (ASSOCIATED(pt_field%grid)) THEN
622	pt_field%has_grid=.TRUE.
623	ELSE
624	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
625	" has a unknown reference to grid : id =",pt_field%grid_ref
626	CALL error("mod_field::field__solve_grid_ref")
627	ENDIF
628	ENDIF
629
630	END SUBROUTINE field__solve_grid_ref
631
632	SUBROUTINE field__solve_zoom_ref(pt_field)
633	USE error_msg
634	IMPLICIT NONE
635	TYPE(field), POINTER :: pt_field
636
637	IF (.NOT. pt_field%has_zoom_ref) THEN
638	IF (pt_field%has_grid_ref) THEN
639	pt_field%has_zoom_ref=.TRUE.
640	pt_field%zoom_ref=pt_field%grid_ref
641	ENDIF
642	ENDIF
643
644	IF (pt_field%has_zoom_ref) THEN
645	CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
646	IF (ASSOCIATED(pt_field%zoom)) THEN
647	pt_field%has_zoom=.TRUE.
648	ELSE
649	WRITE (message,*) "The field : id = ",pt_field%id," name = ",Pt_field%name, &
650	" has a unknown reference to zoom : id =",pt_field%zoom_ref
651	CALL error("mod_field::field__solve_zoom_ref")
652	ENDIF
653	ENDIF
654
655	END SUBROUTINE field__solve_zoom_ref
656
657
658	END MODULE mod_field

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

Download in other formats: