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

XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90

@@ -29 +29 @@
   TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
 
+  INTERFACE file__set_attribut
+    MODULE PROCEDURE file__set_attribut_id,file__set_attribut_pt
+  END INTERFACE
+
 CONTAINS
   INCLUDE 'vector_file_contains.inc'
@@ -138 +142 @@
   END SUBROUTINE file__set
 
-  SUBROUTINE file__set_attribut(id,attrib)
+  SUBROUTINE file__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),POINTER              :: Pt_file
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+      CALL file__set_attribut_pt(Pt_file,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'File id : ',id,' is undefined'
+        CALL error('mod_file::file__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE file__set_attribut_id
+      
+  SUBROUTINE file__set_attribut_pt(Pt_file,attrib)
   USE mod_attribut
   USE mod_file_attribut
   USE error_msg
   IMPLICIT NONE
-    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(file),POINTER        :: Pt_file
     TYPE(attribut),INTENT(IN) :: attrib
 
-    TYPE(file),POINTER              :: Pt_file
-    INTEGER                         :: Pos
-    LOGICAL                         :: success
-    
-    CALL sorted_list__find(Ids,hash(Id),Pos,success)
-    IF (success) THEN
-      Pt_file=>file_ids%at(Pos)%Pt
-    ELSE
-      WRITE(message,*) 'File id :',id,'is undefined'
-      CALL error('mod_file::file__set_attribut')
-    ENDIF  
     
     SELECT CASE(attrib%name)
@@ -173 +194 @@
      END SELECT
 
-     WRITE(message,*) 'file id ',id,' : Attribute type is incompatible with the provided value'
+     WRITE(message,*) 'file attribut ',attrib%name,' : type : ',attrib%type,' : Attribute type is incompatible with the provided value'
      CALL error('mod_file::file__set_attribut')
     
-  END SUBROUTINE file__set_attribut
+  END SUBROUTINE file__set_attribut_pt