Changeset 40 for XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90

Timestamp:

09/17/09 10:02:37 (15 years ago)

Author:

ymipsl

Message:

• Les attributs XML peuvent désormais être passer dynamiquement à travers l'interface du server IO.
• ajout d'un attribut name_suffix pour les fichiers

YM

File:

• XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90 (modified) (7 diffs)

XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90

@@ -10 +10 @@
     CHARACTER(len=str_len)           :: name
     LOGICAL                          :: has_name
+    CHARACTER(len=str_len)           :: name_suffix
+    LOGICAL                          :: has_name_suffix
     CHARACTER(len=str_len)           :: description
     LOGICAL                          :: has_description
@@ -79 +81 @@
    pt_file%has_id           = .FALSE.
    pt_file%has_name         = .FALSE.
+   pt_file%has_name_suffix  = .FALSE.
    pt_file%has_description  = .FALSE.
    pt_file%has_output_freq  = .FALSE.
@@ -93 +96 @@
   END SUBROUTINE file__new
 
-  SUBROUTINE file__set(pt_file, name, description, output_freq, output_level,enabled)
+  SUBROUTINE file__set(pt_file, name, name_suffix, description, output_freq, output_level,enabled)
   IMPLICIT NONE
     TYPE(file), POINTER         :: pt_file
     CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: name_suffix
     CHARACTER(len=*)  ,OPTIONAL :: description
     INTEGER           ,OPTIONAL :: output_freq
@@ -107 +111 @@
     ENDIF
 
+    IF (PRESENT(name_suffix)) THEN
+        pt_file%name_suffix=TRIM(ADJUSTL(name_suffix))
+        pt_file%has_name_suffix = .TRUE.
+    ENDIF
+
     IF (PRESENT(description)) THEN
         pt_file%description=TRIM(ADJUSTL(description))
@@ -129 +138 @@
   END SUBROUTINE file__set
 
+  SUBROUTINE file__set_attribut(id,attrib)
+  USE mod_attribut
+  USE mod_file_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    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)
+      CASE (file__name)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name=attrib%string0_ptr) ; RETURN
+      CASE (file__name_suffix)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name_suffix=attrib%string0_ptr) ; RETURN
+      CASE (file__description)
+        IF (attrib%type==string0) CALL  file__set(pt_file,description=attrib%string0_ptr) ; RETURN
+      CASE (file__output_freq)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_freq=attrib%integer0_ptr) ; RETURN
+      CASE (file__output_level)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_level=attrib%integer0_ptr) ; RETURN
+      CASE (file__enabled)
+        IF (attrib%type==logical0) CALL  file__set(pt_file,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'file id ',id,' : Attribute type is incompatible with the provided value'
+     CALL error('mod_file::file__set_attribut')
+    
+  END SUBROUTINE file__set_attribut
+  
+     
   SUBROUTINE file__get_field_list(pt_file,pt_field_list)
   IMPLICIT NONE
@@ -153 +203 @@
     ELSE
       PRINT *,"name undefined"
+    ENDIF
+
+    IF (pt_file%has_name_suffix) THEN
+      PRINT *,"name_suffix = ",TRIM(pt_file%name_suffix)
+    ELSE
+      PRINT *,"name_suffix undefined"
     ENDIF
     
@@ -199 +255 @@
     ELSE
         pt_file_out%has_name=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_in%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE IF ( pt_file_default%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_default%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE
+        pt_file_out%has_name_suffix=.FALSE.
     ENDIF