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

Last change on this file since 29 was 29, checked in by ymipsl, 13 years ago

New Features :

  • Les zoom sont maintenant utilisables.
  • Lorsqu'un serveur ne sort pas de données dans un fichier, le fichier n'est pas crée.
  • Lorsqu'un serveur est le seul a sortir un fichier, l'indexation par numero de process est supprimé.
  • Les axes verticaux ont maintenant un attribut << positive [TRUE/FALSE]>>
File size: 16.8 KB
Line 
1MODULE 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
58CONTAINS
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, enabled)
136
137    TYPE(field), pointer :: p_field
138    CHARACTER(len=*), OPTIONAL :: name
139    CHARACTER(len=*), OPTIONAL :: ref
140    CHARACTER(len=*), OPTIONAL  :: description
141    CHARACTER(len=*), OPTIONAL  :: unit
142    CHARACTER(len=*), OPTIONAL :: operation
143    INTEGER, OPTIONAL  :: freq_op
144    CHARACTER(len=*),OPTIONAL :: axis_ref
145    CHARACTER(len=*),OPTIONAL :: grid_ref
146    CHARACTER(len=*),OPTIONAL :: zoom_ref
147    INTEGER, OPTIONAL :: prec
148    INTEGER, OPTIONAL :: level
149    LOGICAL, OPTIONAL :: enabled
150
151    IF (PRESENT(name)) THEN
152        p_field%name=TRIM(ADJUSTL(name))
153        p_field%has_name = .TRUE.
154    ENDIF
155    IF (PRESENT(ref)) THEN
156        p_field%field_ref=TRIM(ADJUSTL(ref))
157        p_field%has_field_ref = .TRUE.
158    ENDIF
159    IF (PRESENT(description)) THEN
160        p_field%description=TRIM(ADJUSTL(description))
161        p_field%has_description = .TRUE.
162    ENDIF
163 
164    IF (PRESENT(unit)) then
165        p_field%unit=TRIM(ADJUSTL(unit))
166        p_field%has_unit = .TRUE.
167    ENDIF
168    IF (PRESENT(operation)) THEN
169        p_field%operation=TRIM(ADJUSTL(operation))
170        p_field%has_operation = .TRUE.
171    ENDIF
172    IF (PRESENT(freq_op)) THEN
173        p_field%freq_op=freq_op
174        p_field%has_freq_op = .TRUE.
175    ENDIF
176    IF (PRESENT(axis_ref)) THEN
177        p_field%axis_ref=TRIM(ADJUSTL(axis_ref))
178        p_field%has_axis_ref = .TRUE.
179    ENDIF
180    IF (PRESENT(grid_ref)) THEN
181        p_field%grid_ref=TRIM(ADJUSTL(grid_ref))
182        p_field%has_grid_ref = .TRUE.
183    ENDIF
184
185    IF (PRESENT(zoom_ref)) THEN
186        p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref))
187        p_field%has_zoom_ref = .TRUE.
188    ENDIF
189
190    IF (PRESENT(prec)) then
191        p_field%prec=prec
192        p_field%has_prec = .TRUE.
193    ENDIF
194   
195    IF (PRESENT(level)) then
196        p_field%level=level
197        p_field%has_level = .TRUE.
198    ENDIF
199
200    IF (PRESENT(enabled)) then
201        p_field%enabled=enabled
202        p_field%has_enabled = .TRUE.
203    ENDIF
204
205  END SUBROUTINE field__set
206
207
208  SUBROUTINE field__print(pt_field)
209
210    TYPE(field), POINTER :: pt_field
211   
212    PRINT *,"--- FIELD ---"
213
214    IF (pt_field%has_id) THEN
215        PRINT *, 'id : ',TRIM(pt_field%id)
216    ELSE
217        PRINT *, 'id undefined '
218    ENDIF
219
220    IF (pt_field%has_name) THEN
221        PRINT *, 'name : ',TRIM(pt_field%name)
222    ELSE
223        PRINT *, 'name undefined '
224    ENDIF
225    IF (pt_field%has_description) THEN
226        PRINT *, 'description : ',TRIM(pt_field%description)
227    ELSE
228        PRINT *, 'description undefined '
229    ENDIF
230    IF (pt_field%has_unit) THEN
231        PRINT *, 'unit : ',TRIM(pt_field%unit)
232    ELSE
233        PRINT *, 'unit undefined '
234    ENDIF
235    IF (pt_field%has_operation) THEN
236        PRINT *, 'operation ',TRIM(pt_field%operation)
237    ELSE
238        PRINT *, 'operation undefined '
239    ENDIF
240    IF (pt_field%has_freq_op) THEN
241        PRINT *, 'freq_op ',pt_field%freq_op
242    ELSE
243        PRINT *, 'freq_op undefined '
244    ENDIF
245
246    IF (pt_field%has_axis_ref) THEN
247        PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
248    ELSE
249        PRINT *, 'axis_ref undefined '
250    ENDIF
251
252    IF (pt_field%has_grid_ref) THEN
253        PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
254    ELSE
255        PRINT *, 'grid_ref undefined '
256    ENDIF
257
258    IF (pt_field%has_zoom_ref) THEN
259        PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
260    ELSE
261        PRINT *, 'zoom_ref undefined '
262    ENDIF
263   
264    IF (pt_field%has_field_ref) THEN
265        PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
266    ELSE
267        PRINT *, 'field_ref undefined '
268    ENDIF
269
270!    call vert_axis__print(pt_field%p_vert_axis)
271!
272!    IF (pt_field%is_vert_axis_ref_def) THEN
273!        PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
274!    ELSE
275!        PRINT *, 'pt_field%vert_axis_ref undefined '
276!    ENDIF
277    IF (pt_field%has_prec) THEN
278        PRINT *, 'prec ',pt_field%prec
279    ELSE
280        PRINT *, 'prec undefined '
281    ENDIF
282    IF (pt_field%has_level) then
283        PRINT *, 'level ',pt_field%level
284    ELSE
285        PRINT *, 'level undefined '
286    ENDIF
287    IF (pt_field%has_field_base) THEN
288        PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
289    ELSE
290        PRINT *, 'field_base indefini'
291    ENDIF
292
293    IF (pt_field%has_enabled) THEN
294        PRINT *, 'enabled : ',pt_field%enabled
295    ELSE
296        PRINT *, 'enabled indefini'
297    ENDIF
298 
299    PRINT *,"------------"
300   
301  END SUBROUTINE field__print
302
303!  SUBROUTINE field__resolve_ref_vert_axis(p_field)
304!
305!    TYPE(field), POINTER :: p_field
306!    CHARACTER(len=str_len) :: name
307!
308!    IF (p_field%is_vert_axis_ref_def) THEN
309!        name=p_field%vert_axis_ref
310!        IF (vert_axis_def__is_exist(name)) THEN
311!            CALL vert_axis_def__get(name,p_field%p_vert_axis)
312!            p_field%is_vert_axis_def = .TRUE.
313!        ENDIF
314!    ENDIF
315!
316!  END SUBROUTINE field__resolve_ref_vert_axis
317
318  SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
319
320    TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
321
322    IF (pt_field_in%has_name) THEN
323        pt_field_out%name=pt_field_in%name
324        pt_field_out%has_name=.TRUE.
325    ELSE IF ( pt_field_default%has_name) THEN
326        pt_field_out%name=pt_field_default%name
327        pt_field_out%has_name=.TRUE.
328    ELSE
329        pt_field_out%has_name=.FALSE.
330    ENDIF
331       
332    IF (pt_field_in%has_description) THEN
333        pt_field_out%description=pt_field_in%description
334        pt_field_out%has_description=.TRUE.
335    ELSE IF ( pt_field_default%has_description ) THEN
336        pt_field_out%description=pt_field_default%description
337        pt_field_out%has_description=.TRUE.
338    ELSE
339        pt_field_out%has_description=.FALSE.
340    ENDIF
341
342    IF (pt_field_in%has_unit) THEN
343        pt_field_out%unit=pt_field_in%unit
344        pt_field_out%has_unit=.TRUE.
345    ELSE IF ( pt_field_default%has_unit ) THEN
346        pt_field_out%unit=pt_field_default%unit
347        pt_field_out%has_unit=.TRUE.
348    ELSE
349        pt_field_out%has_unit=.FALSE.
350    ENDIF
351
352    IF (pt_field_in%has_operation) THEN
353        pt_field_out%operation=pt_field_in%operation
354        pt_field_out%has_operation=.TRUE.
355    ELSE IF ( pt_field_default%has_operation ) THEN
356        pt_field_out%operation=pt_field_default%operation
357        pt_field_out%has_operation=.TRUE.
358    ELSE
359        pt_field_out%has_operation=.FALSE.
360    ENDIF
361
362    IF (pt_field_in%has_freq_op) THEN
363        pt_field_out%freq_op=pt_field_in%freq_op
364        pt_field_out%has_freq_op=.TRUE.
365    ELSE IF ( pt_field_default%has_freq_op ) THEN
366        pt_field_out%freq_op=pt_field_default%freq_op
367        pt_field_out%has_freq_op=.TRUE.
368    ELSE
369        pt_field_out%has_freq_op=.FALSE.
370    ENDIF
371
372!    IF (pt_field_in%has_axis) THEN
373!        pt_field_out%p_axis => pt_field_in%p_axis
374!        pt_field_out%has_axis=.TRUE.
375!    ELSE IF ( pt_field_default%has_axis ) THEN
376!        pt_field_out%p_axis => pt_field_default%p_axis
377!        pt_field_out%has_axis=.TRUE.
378!    ELSE
379!        pt_field_out%has_axis=.FALSE.
380!    ENDIF
381   
382    IF (pt_field_in%has_axis_ref) THEN
383        pt_field_out%axis_ref=pt_field_in%axis_ref
384        pt_field_out%has_axis_ref=.TRUE.
385    ELSE IF ( pt_field_default%has_axis_ref ) THEN
386        pt_field_out%axis_ref=pt_field_default%axis_ref
387        pt_field_out%has_axis_ref=.TRUE.
388    ELSE
389        pt_field_out%has_axis_ref=.FALSE.
390    ENDIF
391
392    IF (pt_field_in%has_grid_ref) THEN
393        pt_field_out%grid_ref=pt_field_in%grid_ref
394        pt_field_out%has_grid_ref=.TRUE.
395    ELSE IF ( pt_field_default%has_grid_ref ) THEN
396        pt_field_out%grid_ref=pt_field_default%grid_ref
397        pt_field_out%has_grid_ref=.TRUE.
398    ELSE
399        pt_field_out%has_grid_ref=.FALSE.
400    ENDIF
401
402    IF (pt_field_in%has_zoom_ref) THEN
403        pt_field_out%zoom_ref=pt_field_in%zoom_ref
404        pt_field_out%has_zoom_ref=.TRUE.
405    ELSE IF ( pt_field_default%has_zoom_ref ) THEN
406        pt_field_out%zoom_ref=pt_field_default%zoom_ref
407        pt_field_out%has_zoom_ref=.TRUE.
408    ELSE
409        pt_field_out%has_zoom_ref=.FALSE.
410    ENDIF
411
412    IF (pt_field_in%has_prec) THEN
413        pt_field_out%prec=pt_field_in%prec
414        pt_field_out%has_prec=.TRUE.
415    ELSE IF ( pt_field_default%has_prec ) THEN
416        pt_field_out%prec=pt_field_default%prec
417        pt_field_out%has_prec=.TRUE.
418    ELSE
419        pt_field_out%has_prec=.FALSE.
420    ENDIF
421
422    IF (pt_field_in%has_level) THEN
423        pt_field_out%level=pt_field_in%level
424        pt_field_out%has_level=.TRUE.
425    ELSE IF ( pt_field_default%has_level ) THEN
426        pt_field_out%level=pt_field_default%level
427        pt_field_out%has_level=.TRUE.
428    ELSE
429        pt_field_out%has_level=.FALSE.
430    ENDIF
431
432    IF (pt_field_in%has_enabled) THEN
433        pt_field_out%enabled=pt_field_in%enabled
434        pt_field_out%has_enabled=.TRUE.
435    ELSE IF ( pt_field_default%has_enabled ) THEN
436        pt_field_out%enabled=pt_field_default%enabled
437        pt_field_out%has_enabled=.TRUE.
438    ELSE
439        pt_field_out%has_enabled=.FALSE.
440    ENDIF
441   
442  END SUBROUTINE field__apply_default
443
444!  FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
445!
446!    LOGICAL :: field__is_vert_axis_attached
447!    TYPE(field), POINTER :: p_field
448!    CHARACTER(len=*), INTENT(IN) :: vert_axis_name
449!
450!    field__is_vert_axis_attached = .false.
451!    IF (p_field%is_vert_axis_def) THEN
452!        IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
453!    ENDIF
454!
455!  END FUNCTION field__is_vert_axis_attached
456
457  RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
458  USE error_msg
459  IMPLICIT NONE
460    TYPE(field), POINTER :: pt_field
461   
462    TYPE(field), POINTER :: field_ref
463   
464    IF (.NOT. pt_field%solved_field_ref) THEN
465     
466      IF (pt_field%has_field_ref) THEN
467     
468        CALL field__get(pt_field%field_ref,field_ref)
469     
470        IF (.NOT. ASSOCIATED(field_ref)) THEN
471          WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
472                        " has a unknown reference to field : id =",pt_field%field_ref
473          CALL error("field__solve_field_ref")
474        ENDIF
475     
476        CALL field__get_field_base(field_ref,pt_field%field_base) 
477        Pt_field%has_field_base=.TRUE.
478       
479        CALL field__apply_default(field_ref,pt_field,pt_field)
480       
481         
482      ELSE
483
484        IF (pt_field%has_id) THEN
485          pt_field%field_base=>pt_field
486        ENDIF
487     
488      ENDIF
489     
490      IF (.NOT. pt_field%has_name) THEN
491        IF (pt_field%has_id) THEN
492          pt_field%name=pt_field%id
493          pt_field%has_name=.TRUE.
494        ENDIF
495      ENDIF
496   
497      Pt_field%solved_field_ref=.TRUE.
498   
499    ENDIF
500   
501  END SUBROUTINE field__solve_field_ref
502 
503
504  RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
505  IMPLICIT NONE
506    TYPE(field), POINTER :: pt_field
507    TYPE(field), POINTER :: pt_field_base
508   
509     
510    IF (.NOT. Pt_field%solved_field_ref) THEN
511      CALL field__solve_field_ref(Pt_field)
512    ENDIF
513     
514    IF (pt_field%has_field_base) THEN
515      pt_field_base=>pt_field%field_base
516    ELSE
517      pt_field_base=>pt_field
518    ENDIF
519   
520 END SUBROUTINE field__get_field_base
521
522 SUBROUTINE field__solve_axis_ref(pt_field)
523 USE error_msg
524 IMPLICIT NONE
525   TYPE(field), POINTER :: pt_field
526   
527   IF (pt_field%has_axis_ref) THEN
528     CALL axis__get(pt_field%axis_ref,pt_field%axis)
529     IF (ASSOCIATED(pt_field%axis)) THEN
530       pt_field%has_axis=.TRUE.
531     ELSE
532       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
533                        " has a unknown reference to axis : id =",pt_field%axis_ref
534       CALL error("mod_field::field__solve_axis_ref")
535     ENDIF
536   ENDIF
537   
538 END SUBROUTINE field__solve_axis_ref
539   
540 SUBROUTINE field__solve_grid_ref(pt_field)
541 USE error_msg
542 IMPLICIT NONE
543   TYPE(field), POINTER :: pt_field
544   
545   IF (pt_field%has_grid_ref) THEN
546     CALL grid__get(pt_field%grid_ref,pt_field%grid)
547     IF (ASSOCIATED(pt_field%grid)) THEN
548       pt_field%has_grid=.TRUE.
549     ELSE
550       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
551                        " has a unknown reference to grid : id =",pt_field%grid_ref
552       CALL error("mod_field::field__solve_grid_ref")
553     ENDIF
554   ENDIF
555   
556 END SUBROUTINE field__solve_grid_ref
557   
558 SUBROUTINE field__solve_zoom_ref(pt_field)
559 USE error_msg
560 IMPLICIT NONE
561   TYPE(field), POINTER :: pt_field
562   
563   IF (.NOT. pt_field%has_zoom_ref) THEN
564     IF (pt_field%has_grid_ref) THEN
565       pt_field%has_zoom_ref=.TRUE.
566       pt_field%zoom_ref=pt_field%grid_ref
567     ENDIF
568   ENDIF
569   
570   IF (pt_field%has_zoom_ref) THEN
571     CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
572     IF (ASSOCIATED(pt_field%zoom)) THEN
573       pt_field%has_zoom=.TRUE.
574     ELSE
575       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
576                        " has a unknown reference to zoom : id =",pt_field%zoom_ref
577       CALL error("mod_field::field__solve_zoom_ref")
578     ENDIF
579   ENDIF
580   
581 END SUBROUTINE field__solve_zoom_ref
582
583   
584END MODULE mod_field
Note: See TracBrowser for help on using the repository browser.