Changeset 42 for XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90

Timestamp:

10/30/09 16:29:39 (15 years ago)

Author:

ymipsl

Message:

Correction bug sur les ids des file_group
+ possibilité de fixer les attributs des groupes à partir de l'ioserver

File:

• XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90 (modified) (2 diffs)

XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90

@@ -19 +19 @@
   TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
 
+  INTERFACE field_group__set_attribut
+    MODULE PROCEDURE field_group__set_attribut_id,field_group__set_attribut_pt
+  END INTERFACE
+
 CONTAINS
 
@@ -59 +63 @@
     
   END SUBROUTINE field_group__get
-    
+
+  SUBROUTINE field_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+      CALL field_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field group id :',id,'is undefined'
+        CALL error('mod_field_group::field_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE field_group__set_attribut_id
+  
+  SUBROUTINE field_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==field_object) THEN
+      CALL field__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE field_group__set_attribut_pt
+    
+      
   RECURSIVE SUBROUTINE field_group__new(Pt_fg,Id)
   USE string_function