Changeset 42 for XMLIO_SERVER/trunk/src/XMLIO/mod_file_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_file_group.f90 (modified) (3 diffs)

XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90

@@ -18 +18 @@
   TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids 
 
+  INTERFACE file_group__set_attribut
+    MODULE PROCEDURE file_group__set_attribut_id,file_group__set_attribut_pt
+  END INTERFACE
+
 CONTAINS
 
@@ -57 +61 @@
     
   END SUBROUTINE file_group__get
-    
+
+  SUBROUTINE file_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(file_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+      CALL file_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'file group id :',id,' is undefined'
+        CALL error('mod_file_group::file_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE file_group__set_attribut_id
+  
+  SUBROUTINE file_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(file_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==file_object) THEN
+      CALL file__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE file_group__set_attribut_pt
+  
+      
   RECURSIVE SUBROUTINE file_group__new(Pt_fg,Id)
   USE string_function
@@ -89 +135 @@
     TYPE(file_group),POINTER             :: Pt_fg
     TYPE(file_group),POINTER             :: Pt_fg_out
-    CHARACTER(LEN=str_len),OPTIONAL      :: Id
+    CHARACTER(LEN=*),OPTIONAL      :: Id
     
     CALL vector_file_group__get_new(Pt_fg%groups,Pt_fg_out)