Changeset 42 for XMLIO_SERVER/trunk/src/XMLIO/mod_grid_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_grid_group.f90 (modified) (2 diffs)

XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90

@@ -18 +18 @@
   TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
 
+  INTERFACE grid_group__set_attribut
+    MODULE PROCEDURE grid_group__set_attribut_id,grid_group__set_attribut_pt
+  END INTERFACE
+
 CONTAINS
 
@@ -57 +61 @@
     
   END SUBROUTINE grid_group__get
-    
+
+
+  SUBROUTINE grid_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(grid_group),POINTER             :: Pt_gg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+      CALL grid_group__set_attribut(Pt_gg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid group id :',id,'is undefined'
+        CALL error('mod_grid_group::grid_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE grid_group__set_attribut_id
+  
+  SUBROUTINE grid_group__set_attribut_pt(pt_gg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: Pt_gg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==grid_object) THEN
+      CALL grid__set_attribut(pt_gg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE grid_group__set_attribut_pt    
+
+
+
   RECURSIVE SUBROUTINE grid_group__new(Pt_gg,Id)
   USE string_function