Ignore:
Timestamp:
09/22/14 14:17:33 (10 years ago)
Author:
mhnguyen
Message:

Ticket 50: Implementing the getting/setting methods for Fortran interface

+) Add some C and Fortran functions to set and get data to/from CVariable with an id
+) Add method to send, receive and dispatch in CVariable
+) Add dispatch method in server class

Test
-) On Curie
-) Test data: integer, float, double, boolean, string
-) File: one and multiple, using_server: ON and OFF
+) All test cases passed and had correct results

File:
1 edited

Legend:

Unmodified
Added
Removed

  • XIOS/trunk/src/interface/fortran/idata.F90

    r461 r489  
    44   USE, INTRINSIC :: ISO_C_BINDING 
    55   USE ICONTEXT 
    6     
     6 
    77   INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 
    88 
    … …  
    1717         INTEGER  (kind = C_INT)                    :: f_return_comm 
    1818      END SUBROUTINE cxios_init_client 
    19        
     19 
    2020      SUBROUTINE  cxios_context_initialize(context_id,len_context_id,f_comm) BIND(C) 
    2121         USE ISO_C_BINDING 
    … …  
    3131         LOGICAL  (kind = C_BOOL)                   :: initialized 
    3232      END SUBROUTINE cxios_context_is_initialized 
    33        
    34        
     33 
     34 
    3535       SUBROUTINE  cxios_context_close_definition() BIND(C) 
    3636         USE ISO_C_BINDING 
    3737      END SUBROUTINE cxios_context_close_definition 
    38       
     38 
    3939 
    4040       SUBROUTINE  cxios_context_finalize() BIND(C) 
    4141         USE ISO_C_BINDING 
    4242      END SUBROUTINE cxios_context_finalize 
    43       
    44   
     43 
     44 
    4545      SUBROUTINE  cxios_finalize() BIND(C) 
    4646      END SUBROUTINE cxios_finalize 
    … …  
    4949      END SUBROUTINE cxios_solve_inheritance 
    5050 
    51   
     51 
    5252      SUBROUTINE cxios_write_data_k81(fieldid, fieldid_size, data_k8, data_Xsize) BIND(C) 
    5353         USE ISO_C_BINDING 
    … …  
    5757         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize 
    5858      END SUBROUTINE cxios_write_data_k81 
    59        
     59 
    6060      SUBROUTINE cxios_write_data_k82(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize) BIND(C) 
    6161         USE ISO_C_BINDING 
    … …  
    6565         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize 
    6666      END SUBROUTINE cxios_write_data_k82 
    67        
     67 
    6868      SUBROUTINE cxios_write_data_k83(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize, data_Zsize) BIND(C) 
    6969         USE ISO_C_BINDING 
    … …  
    7373         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize, data_Zsize 
    7474      END SUBROUTINE cxios_write_data_k83 
    75        
     75 
    7676      SUBROUTINE cxios_write_data_k41(fieldid, fieldid_size, data_k4, data_Xsize) BIND(C) 
    7777         USE ISO_C_BINDING 
    … …  
    8181         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize 
    8282      END SUBROUTINE cxios_write_data_k41 
    83        
     83 
    8484      SUBROUTINE cxios_write_data_k42(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize) BIND(C) 
    8585         USE ISO_C_BINDING 
    … …  
    8989         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize 
    9090      END SUBROUTINE cxios_write_data_k42 
    91        
     91 
    9292      SUBROUTINE cxios_write_data_k43(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize, data_Zsize) BIND(C) 
    9393         USE ISO_C_BINDING 
    … …  
    9797         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize, data_Zsize 
    9898      END SUBROUTINE cxios_write_data_k43 
    99        
     99 
     100      ! Binding C and Fortran interface of get_variable (icdata.cpp) 
     101      SUBROUTINE cxios_get_variable_data_k8(vardid, varid_size, data_k8, is_var_existed) BIND(C) 
     102         USE ISO_C_BINDING 
     103         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     104         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     105         REAL     (kind = C_DOUBLE)               :: data_k8 
     106         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     107      END SUBROUTINE cxios_get_variable_data_k8 
     108 
     109      SUBROUTINE cxios_get_variable_data_k4(vardid, varid_size, data_k4, is_var_existed) BIND(C) 
     110         USE ISO_C_BINDING 
     111         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     112         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     113         REAL     (kind = C_FLOAT)                :: data_k4 
     114         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     115      END SUBROUTINE cxios_get_variable_data_k4 
     116 
     117      SUBROUTINE cxios_get_variable_data_int(vardid, varid_size, data_int, is_var_existed) BIND(C) 
     118         USE ISO_C_BINDING 
     119         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     120         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     121         INTEGER  (kind = C_INT)                  :: data_int 
     122         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     123      END SUBROUTINE cxios_get_variable_data_int 
     124 
     125      SUBROUTINE cxios_get_variable_data_logic(vardid, varid_size, data_logic, is_var_existed) BIND(C) 
     126         USE ISO_C_BINDING 
     127         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     128         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     129         LOGICAL  (kind = 4)                      :: data_logic 
     130         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     131      END SUBROUTINE cxios_get_variable_data_logic 
     132 
     133      SUBROUTINE cxios_get_variable_data_char(vardid, varid_size, data_char, data_size_in, is_var_existed) BIND(C) 
     134         USE ISO_C_BINDING 
     135         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     136         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     137         INTEGER  (kind = C_INT)   , VALUE        :: data_size_in 
     138         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: data_char 
     139         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     140      END SUBROUTINE cxios_get_variable_data_char 
     141 
     142      ! Binding C and Fortran interface of set_variable (icdata.cpp) 
     143      SUBROUTINE cxios_set_variable_data_k8(vardid, varid_size, data_k8, is_var_existed) BIND(C) 
     144         USE ISO_C_BINDING 
     145         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     146         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     147         REAL     (kind = C_DOUBLE), VALUE        :: data_k8 
     148         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     149      END SUBROUTINE cxios_set_variable_data_k8 
     150 
     151      SUBROUTINE cxios_set_variable_data_k4(vardid, varid_size, data_k4, is_var_existed) BIND(C) 
     152         USE ISO_C_BINDING 
     153         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     154         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     155         REAL     (kind = C_FLOAT) , VALUE        :: data_k4 
     156         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     157      END SUBROUTINE cxios_set_variable_data_k4 
     158 
     159      SUBROUTINE cxios_set_variable_data_int(vardid, varid_size, data_int, is_var_existed) BIND(C) 
     160         USE ISO_C_BINDING 
     161         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     162         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     163         INTEGER  (kind = C_INT)   , VALUE        :: data_int 
     164         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     165      END SUBROUTINE cxios_set_variable_data_int 
     166 
     167      SUBROUTINE cxios_set_variable_data_logic(vardid, varid_size, data_logic, is_var_existed) BIND(C) 
     168         USE ISO_C_BINDING 
     169         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     170         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     171         LOGICAL  (kind = 4)       , VALUE        :: data_logic 
     172         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     173      END SUBROUTINE cxios_set_variable_data_logic 
     174 
     175      SUBROUTINE cxios_set_variable_data_char(vardid, varid_size, data_char, data_size_in, is_var_existed) BIND(C) 
     176         USE ISO_C_BINDING 
     177         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid 
     178         INTEGER  (kind = C_INT)   , VALUE        :: varid_size 
     179         INTEGER  (kind = C_INT)   , VALUE        :: data_size_in 
     180         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: data_char 
     181         LOGICAL  (kind = C_BOOL)                 :: is_var_existed 
     182      END SUBROUTINE cxios_set_variable_data_char 
     183 
    100184   END INTERFACE 
    101     
    102     
     185 
     186 
    103187   CONTAINS ! Fonctions disponibles pour les utilisateurs. 
    104188 
    … …  
    107191     CALL cxios_init_server() 
    108192   END SUBROUTINE xios(init_server) 
    109     
     193 
    110194   SUBROUTINE  xios(initialize)(client_id, local_comm, return_comm) 
    111195   IMPLICIT NONE 
    112196   INCLUDE 'mpif.h' 
    113197   CHARACTER(LEN=*),INTENT(IN) :: client_id 
    114    INTEGER,INTENT(IN),OPTIONAL         :: local_comm   
     198   INTEGER,INTENT(IN),OPTIONAL         :: local_comm 
    115199   INTEGER,INTENT(OUT),OPTIONAL        :: return_comm 
    116200   INTEGER :: f_local_comm 
    117201   INTEGER :: f_return_comm 
    118     
     202 
    119203      IF (PRESENT(local_comm)) THEN 
    120         f_local_comm=local_comm  
     204        f_local_comm=local_comm 
    121205      ELSE 
    122         f_local_comm = MPI_COMM_NULL  
     206        f_local_comm = MPI_COMM_NULL 
    123207      ENDIF 
    124        
     208 
    125209      CALL cxios_init_client(client_id,LEN(client_id),f_local_comm,f_return_comm) 
    126   
     210 
    127211      IF (PRESENT(return_comm)) return_comm=f_return_comm 
    128212 
    … …  
    134218   CHARACTER(LEN=*),INTENT(IN)  :: context_id 
    135219   INTEGER, INTENT(IN)          :: comm 
    136        
     220 
    137221      CALL cxios_context_initialize(context_id,LEN(context_id),comm) 
    138   
     222 
    139223    END SUBROUTINE  xios(context_initialize) 
    140224 
    … …  
    145229   CHARACTER(LEN=*),INTENT(IN)  :: context_id 
    146230   LOGICAL(KIND=C_BOOL) :: is_init 
    147           
     231 
    148232      CALL cxios_context_is_initialized(context_id, LEN(context_id), is_init) 
    149233      xios(context_is_initialized) = is_init 
    150   
    151     END FUNCTION xios(context_is_initialized)    
    152  
    153      
     234 
     235    END FUNCTION xios(context_is_initialized) 
     236 
     237 
    154238   SUBROUTINE  xios(finalize) 
    155239   IMPLICIT NONE 
    … …  
    159243    END SUBROUTINE  xios(finalize) 
    160244 
    161     
     245 
    162246   SUBROUTINE xios(close_context_definition)() 
    163247   IMPLICIT NONE 
    … …  
    165249   END SUBROUTINE xios(close_context_definition) 
    166250 
    167     
     251 
    168252   SUBROUTINE xios(context_finalize)() 
    169253   IMPLICIT NONE 
    170254      CALL cxios_context_finalize() 
    171255   END SUBROUTINE xios(context_finalize) 
    172     
     256 
    173257   SUBROUTINE xios(solve_inheritance)() 
    174258   IMPLICIT NONE 
    175259      CALL cxios_solve_inheritance() 
    176260   END SUBROUTINE xios(solve_inheritance) 
    177    
    178     
     261 
     262 
    179263   SUBROUTINE xios(send_field_r8_1d)(fieldid, data1d_k8) 
    180264   IMPLICIT NONE 
    … …  
    183267      CALL cxios_write_data_k81(fieldid, len(fieldid), data1d_k8, size(data1d_k8, 1)) 
    184268   END SUBROUTINE xios(send_field_r8_1d) 
    185     
     269 
    186270   SUBROUTINE  xios(send_field_r8_2d)(fieldid, data2d_k8) 
    187271   IMPLICIT NONE 
    … …  
    190274      CALL cxios_write_data_k82(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2)) 
    191275   END SUBROUTINE  xios(send_field_r8_2d) 
    192     
     276 
    193277   SUBROUTINE  xios(send_field_r8_3d)(fieldid, data3d_k8) 
    194278   IMPLICIT NONE 
    … …  
    197281      CALL cxios_write_data_k83(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3)) 
    198282   END SUBROUTINE  xios(send_field_r8_3d) 
    199     
     283 
    200284   SUBROUTINE xios(send_field_r4_1d)(fieldid, data1d_k4) 
    201285   IMPLICIT NONE 
    … …  
    204288      CALL cxios_write_data_k41(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1)) 
    205289   END SUBROUTINE xios(send_field_r4_1d) 
    206     
     290 
    207291   SUBROUTINE xios(send_field_r4_2d)(fieldid, data2d_k4) 
    208292   IMPLICIT NONE 
    … …  
    211295      CALL cxios_write_data_k42(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2)) 
    212296   END SUBROUTINE xios(send_field_r4_2d) 
    213     
     297 
    214298   SUBROUTINE xios(send_field_r4_3d)(fieldid, data3d_k4) 
    215299   IMPLICIT NONE 
    … …  
    218302      CALL cxios_write_data_k43(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3)) 
    219303   END SUBROUTINE xios(send_field_r4_3d) 
    220     
    221     
     304 
     305   ! Get variable functions 
     306   LOGICAL FUNCTION xios(getVar_k8)(varId, data_k8) 
     307   IMPLICIT NONE 
     308      LOGICAL  (kind = 1)                           :: val 
     309      CHARACTER(len = *)               , INTENT(IN) :: varId 
     310      REAL     (kind = 8)              , INTENT(OUT):: data_k8 
     311 
     312      CALL cxios_get_variable_data_k8(varId, len(varId), data_k8, val) 
     313 
     314      xios(getVar_k8) = val 
     315   END FUNCTION xios(getVar_k8) 
     316 
     317   LOGICAL FUNCTION xios(getVar_k4)(varId, data_k4) 
     318   IMPLICIT NONE 
     319      LOGICAL  (kind = 1)                           :: val 
     320      CHARACTER(len = *)               , INTENT(IN) :: varId 
     321      REAL     (kind = 4)              , INTENT(OUT):: data_k4 
     322 
     323      CALL cxios_get_variable_data_k4(varId, len(varId), data_k4, val) 
     324 
     325      xios(getVar_k4) = val 
     326   END FUNCTION xios(getVar_k4) 
     327 
     328   LOGICAL FUNCTION xios(getVar_int)(varId, data_int) 
     329   IMPLICIT NONE 
     330      LOGICAL  (kind = 1)                           :: val 
     331      CHARACTER(len = *)               , INTENT(IN) :: varId 
     332      INTEGER                          , INTENT(OUT):: data_int 
     333 
     334      CALL cxios_get_variable_data_int(varId, len(varId), data_int, val) 
     335 
     336      xios(getVar_int) = val 
     337   END FUNCTION xios(getVar_int) 
     338 
     339   LOGICAL FUNCTION xios(getVar_logic)(varId, data_logic) 
     340   IMPLICIT NONE 
     341      LOGICAL  (kind = 1)                           :: val 
     342      CHARACTER(len  = *)              , INTENT(IN) :: varId 
     343      LOGICAL  (kind = 4)              , INTENT(OUT):: data_logic 
     344 
     345      CALL cxios_get_variable_data_logic(varId, len(varId), data_logic, val) 
     346 
     347      xios(getVar_logic) = val 
     348   END FUNCTION xios(getVar_logic) 
     349 
     350   LOGICAL FUNCTION xios(getVar_char)(varId, data_char) 
     351   IMPLICIT NONE 
     352      LOGICAL  (kind = 1)                           :: val 
     353      CHARACTER(len  = *)              , INTENT(IN) :: varId 
     354      CHARACTER(len  = *)              , INTENT(OUT):: data_char 
     355 
     356      CALL cxios_get_variable_data_char(varId, len(varId), data_char, len(data_char), val) 
     357 
     358      xios(getVar_char) = val 
     359   END FUNCTION xios(getVar_char) 
     360 
     361   ! Set variable functions 
     362   LOGICAL FUNCTION xios(setVar_k8)(varId, data_k8) 
     363   IMPLICIT NONE 
     364      LOGICAL  (kind = 1)                           :: val 
     365      CHARACTER(len = *)               , INTENT(IN) :: varId 
     366      REAL     (kind = 8)              , INTENT(IN) :: data_k8 
     367 
     368      CALL cxios_set_variable_data_k8(varId, len(varId), data_k8, val) 
     369 
     370      xios(setVar_k8) = val 
     371   END FUNCTION xios(setVar_k8) 
     372 
     373   LOGICAL FUNCTION xios(setVar_k4)(varId, data_k4) 
     374   IMPLICIT NONE 
     375      LOGICAL  (kind = 1)                           :: val 
     376      CHARACTER(len = *)               , INTENT(IN) :: varId 
     377      REAL     (kind = 4)              , INTENT(IN) :: data_k4 
     378 
     379      CALL cxios_set_variable_data_k4(varId, len(varId), data_k4, val) 
     380 
     381      xios(setVar_k4) = val 
     382   END FUNCTION xios(setVar_k4) 
     383 
     384   LOGICAL FUNCTION xios(setVar_int)(varId, data_int) 
     385   IMPLICIT NONE 
     386      LOGICAL  (kind = 1)                           :: val 
     387      CHARACTER(len = *)               , INTENT(IN) :: varId 
     388      INTEGER                          , INTENT(IN) :: data_int 
     389 
     390      CALL cxios_set_variable_data_int(varId, len(varId), data_int, val) 
     391 
     392      xios(setVar_int) = val 
     393   END FUNCTION xios(setVar_int) 
     394 
     395   LOGICAL FUNCTION xios(setVar_logic)(varId, data_logic) 
     396   IMPLICIT NONE 
     397      LOGICAL  (kind = 1)                           :: val 
     398      CHARACTER(len  = *)              , INTENT(IN) :: varId 
     399      LOGICAL  (kind = 4)              , INTENT(IN) :: data_logic 
     400 
     401      CALL cxios_set_variable_data_logic(varId, len(varId), data_logic, val) 
     402 
     403      xios(setVar_logic) = val 
     404   END FUNCTION xios(setVar_logic) 
     405 
     406   LOGICAL FUNCTION xios(setVar_char)(varId, data_char) 
     407   IMPLICIT NONE 
     408      LOGICAL  (kind = 1)                           :: val 
     409      CHARACTER(len  = *)              , INTENT(IN) :: varId 
     410      CHARACTER(len  = *)              , INTENT(IN) :: data_char 
     411 
     412      CALL cxios_set_variable_data_char(varId, len(varId), data_char, len(data_char), val) 
     413 
     414      xios(setVar_char) = val 
     415   END FUNCTION xios(setVar_char) 
     416 
    222417END MODULE IDATA 
Note: See TracChangeset for help on using the changeset viewer.