Changeset 40 for XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.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/IOSERVER/mod_pack.f90 (modified) (3 diffs)

XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.f90

@@ -9 +9 @@
                        pack_i,pack_i1,pack_i2,pack_i3,pack_i4,                 &
                        pack_l,pack_l1,pack_l2,pack_l3,pack_l4,                 &
-                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4
+                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4,                 &
+                       pack_attr
     END INTERFACE pack
 
@@ -16 +17 @@
                        unpack_i,unpack_i1,unpack_i2,unpack_i3,unpack_i4,       &
                        unpack_l,unpack_l1,unpack_l2,unpack_l3,unpack_l4,       &
-                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4
+                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4,       &
+                       unpack_attr
     END INTERFACE unpack
 
@@ -466 +468 @@
      END SUBROUTINE unpack_field4
       
+     SUBROUTINE pack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL pack(attrib%object)
+       CALL pack(attrib%name)
+       CALL pack(attrib%type)
+       CALL pack(attrib%dim)
+       CALL pack(attrib%ndim)
+       CALL pack(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           CALL pack(attrib%integer0_ptr)
+         CASE (integer1)
+           CALL pack(attrib%integer1_ptr)
+         CASE (integer2)
+           CALL pack(attrib%integer2_ptr)
+         CASE (real0)
+           CALL pack(attrib%real0_ptr)
+         CASE (real1)
+           CALL pack(attrib%real1_ptr)
+         CASE (real2)
+           CALL pack(attrib%real2_ptr)
+         CASE (logical0)
+           CALL pack(attrib%logical0_ptr)
+         CASE (logical1)
+           CALL pack(attrib%logical1_ptr)
+         CASE (logical2)
+           CALL pack(attrib%logical2_ptr)
+         CASE (string0)
+           CALL pack_string0(attrib%string0_ptr)
+         CASE (string1)
+           CALL pack_string1(attrib%string1_ptr)
+         CASE (string2)
+           CALL pack(attrib%string2_ptr)
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE pack_string0(str)
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL pack(str)
+       END SUBROUTINE
+
+       SUBROUTINE pack_string1(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:)
+           CALL pack(str)
+       END SUBROUTINE
+       
+       SUBROUTINE pack_string2(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:,:)
+           CALL pack(str)
+       END SUBROUTINE
+
+     END SUBROUTINE pack_attr  
+
+     SUBROUTINE unpack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL unpack(attrib%object)
+       CALL unpack(attrib%name)
+       CALL unpack(attrib%type)
+       CALL unpack(attrib%dim)
+       CALL unpack(attrib%ndim)
+       CALL unpack(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           ALLOCATE(attrib%integer0_ptr)
+           CALL unpack(attrib%integer0_ptr)
+         CASE (integer1)
+           ALLOCATE(attrib%integer1_ptr(attrib%dim(1)))
+           CALL unpack(attrib%integer1_ptr)
+         CASE (integer2)
+           ALLOCATE(attrib%integer2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack(attrib%integer2_ptr)
+         CASE (real0)
+           ALLOCATE(attrib%real0_ptr)
+           CALL unpack(attrib%real0_ptr)
+         CASE (real1)
+           ALLOCATE(attrib%real1_ptr(attrib%dim(1)))
+           CALL unpack(attrib%real1_ptr)
+         CASE (real2)
+           ALLOCATE(attrib%real2_ptr(attrib%dim(1),attrib%dim(2)))
+         CASE (logical0)
+           ALLOCATE(attrib%logical0_ptr)
+           CALL unpack(attrib%logical0_ptr)
+         CASE (logical1)
+           ALLOCATE(attrib%logical1_ptr(attrib%dim(1)))
+           CALL unpack(attrib%logical1_ptr)
+         CASE (logical2)
+           ALLOCATE(attrib%logical2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack(attrib%logical2_ptr)
+         CASE (string0)
+           ALLOCATE(attrib%string0_ptr)
+           CALL unpack_string0
+         CASE (string1)
+           ALLOCATE(attrib%string1_ptr(attrib%dim(1)))
+           CALL unpack_string1
+         CASE (string2)
+           ALLOCATE(attrib%string2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_string2
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE unpack_string0
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL unpack(str)
+           attrib%string0_ptr=str
+       END SUBROUTINE
+
+       SUBROUTINE unpack_string1
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1))
+           CALL unpack(str)
+           attrib%string1_ptr=str
+       END SUBROUTINE
+       
+       SUBROUTINE unpack_string2
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1),attrib%dim(2))
+           CALL unpack(str)
+           attrib%string2_ptr=str
+       END SUBROUTINE
+
+     END SUBROUTINE unpack_attr              
+
+     
   END MODULE mod_pack