Changeset 266 for XMLIO_V2/dev/common/src/xmlio/fortran/ixmlioserver.f03.in

Timestamp:

09/06/11 16:45:08 (13 years ago)

Author:

hozdoba

Message:

Corrections après tests sur titane

File:

• XMLIO_V2/dev/common/src/xmlio/fortran/ixmlioserver.f03.in (modified) (8 diffs)

XMLIO_V2/dev/common/src/xmlio/fortran/ixmlioserver.f03.in

@@ -6 +6 @@
 #include "macro.inc"
 
-MODULE IXMLIOSERVER
+MODULE XIOS
    USE, INTRINSIC :: ISO_C_BINDING
 
@@ -110 +110 @@
 
       SUBROUTINE xios_write_data(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize, data_Zsize) BIND(C)
-         import C_INT, C_CHAR, C_PTR, C_FLOAT, C_DOUBLE, C_BOOL
+         import C_INT, C_CHAR, C_PTR, C_DOUBLE, C_BOOL
          CHARACTER(kind = C_CHAR), DIMENSION(*) :: fieldid
          INTEGER  (kind = C_INT),  VALUE        :: fieldid_size
@@ -116 +116 @@
          INTEGER  (kind = C_INT), VALUE         :: data_Xsize, data_Ysize, data_Zsize
       END SUBROUTINE xios_write_data
+      
+      SUBROUTINE xios_write_data_f(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize, data_Zsize) BIND(C)
+         import C_INT, C_CHAR, C_PTR, C_FLOAT, C_BOOL
+         CHARACTER(kind = C_CHAR), DIMENSION(*) :: fieldid
+         INTEGER  (kind = C_INT),  VALUE        :: fieldid_size
+         REAL(kind = C_FLOAT), DIMENSION(*)     :: data_k4
+         INTEGER  (kind = C_INT), VALUE         :: data_Xsize, data_Ysize, data_Zsize
+      END SUBROUTINE xios_write_data_f
+
+      SUBROUTINE  xios_init_ioserver(comm_client) BIND(C)
+         import C_INT
+         INTEGER  (kind = C_INT) :: comm_client
+      END SUBROUTINE xios_init_ioserver
 
 #define DECLARE_ATTRIBUTE(type, name) \
@@ -149 +162 @@
 
    CONTAINS ! Fonctions disponibles pour les utilisateurs.
+
+   SUBROUTINE  init_ioserver(comm_client)
+      INTEGER, INTENT(INOUT) :: comm_client
+      CALL xios_init_ioserver(comm_client)
+   END SUBROUTINE init_ioserver
 
    SUBROUTINE handle_create(ret, dtype, idt)
@@ -165 +183 @@
    SUBROUTINE update_calendar(step)
       INTEGER, INTENT(IN):: step
-      IF (step < 1) THEN
-         PRINT *, "L'argument 'step' ne peut être négatif ou nul"
-         STOP
-      END IF
       CALL xios_update_calendar(step)
    END SUBROUTINE update_calendar
@@ -255 +269 @@
    SUBROUTINE dtreatment_end(context_hdl)
       TYPE(XHandle), INTENT(IN), VALUE :: context_hdl
-      CALL context_set_current(context_hdl)
+      !CALL context_set_current(context_hdl)
       CALL xios_dtreatment_end()
    END SUBROUTINE dtreatment_end
 
-   SUBROUTINE write_data (fieldid,                         &
-                          data1d_k8, data2d_k8, data3d_k8)
+   SUBROUTINE write_data (fieldid, data1d_k4, data2d_k4, data3d_k4, data1d_k8, data2d_k8, data3d_k8)
       CHARACTER(len = *), INTENT(IN)                     :: fieldid
       REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: data1d_k8(:), data2d_k8(:,:), data3d_k8(:,:,:)
+      REAL(kind = 4), DIMENSION(*), OPTIONAL, INTENT(IN) :: data1d_k4(:), data2d_k4(:,:), data3d_k4(:,:,:)
+      
       IF((.NOT. PRESENT(data1d_k8)) .AND. &
          (.NOT. PRESENT(data2d_k8)) .AND. &
@@ -269 +284 @@
          STOP
       END IF
+      
       IF (PRESENT (data1d_k8)) THEN
-         CALL xios_write_data(fieldid, len(fieldid), data1d_k8, &
-                              size(data1d_k8, 1), -1, -1)
+         CALL xios_write_data(fieldid, len(fieldid), data1d_k8, size(data1d_k8, 1), -1, -1)
       ELSE IF (PRESENT (data2d_k8)) THEN
-         CALL xios_write_data(fieldid, len(fieldid), data2d_k8, &
-                              size(data2d_k8, 1), size(data2d_k8, 2), -1)
+         CALL xios_write_data(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2), -1)
       ELSE IF (PRESENT (data3d_k8)) THEN
-         CALL xios_write_data(fieldid, len(fieldid), data3d_k8, &
-                              size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
-      END IF
+         CALL xios_write_data(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
+      END IF
+      
+      IF (PRESENT (data1d_k4)) THEN
+         CALL xios_write_data_f(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1), -1, -1)
+      ELSE IF (PRESENT (data2d_k4)) THEN
+         CALL xios_write_data_f(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2), -1)
+      ELSE IF (PRESENT (data3d_k4)) THEN
+         CALL xios_write_data_f(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3))
+      END IF
+      
+      
    END SUBROUTINE
 
@@ -389 +412 @@
    END SUBROUTINE set_file_attributes
 
-END MODULE IXMLIOSERVER
+END MODULE XIOS