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

XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90

@@ -50 +50 @@
   END TYPE field
   
+  INTERFACE field__set_attribut
+    MODULE PROCEDURE field__set_attribut_id,field__set_attribut_pt
+  END INTERFACE
+  
   INCLUDE 'vector_field_def.inc'
   
@@ -206 +210 @@
   END SUBROUTINE field__set
 
-  SUBROUTINE field__set_attribut(id,attrib)
+  SUBROUTINE field__set_attribut_id(id,attrib,Ok)
   USE mod_attribut
   USE mod_field_attribut
   USE error_msg
   IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN) :: id
-    TYPE(attribut),INTENT(IN) :: attrib
-
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
     TYPE(field),POINTER             :: Pt_field
     INTEGER                         :: Pos
@@ -221 +226 @@
     IF (success) THEN
       Pt_field=>field_ids%at(Pos)%Pt
-    ELSE
-      WRITE(message,*) 'Field id :',id,'is undefined'
-      CALL error('mod_field::field__set_attribut')
+      CALL field__set_attribut(Pt_field,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field id :',id,'is undefined'
+        CALL error('mod_field::field__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
     ENDIF  
-    
+  END SUBROUTINE field__set_attribut_id
+
+    
+  SUBROUTINE field__set_attribut_pt(pt_field,attrib)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field),POINTER             :: Pt_field
+    TYPE(attribut),INTENT(IN) :: attrib
+
     SELECT CASE(attrib%name)
       CASE (field__name)
@@ -253 +274 @@
      END SELECT
 
-     WRITE(message,*) 'field id ',id,' : Attribute type is incompatible with the provided value'
+     WRITE(message,*) 'field attribut ',attrib%name,' : type :',attrib%type,' : Attribute type is incompatible with the provided value'
      CALL error('mod_field::field__set_attribut')
     
-  END SUBROUTINE field__set_attribut    
+  END SUBROUTINE field__set_attribut_pt    
 
   SUBROUTINE field__print(pt_field)