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

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

Mise à jour importante :

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