Changeset 138 for XMLIO_V2/dev/dev_rv/src/XMLIO/c_interface.f03
- Timestamp:
- 12/10/10 16:04:54 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
XMLIO_V2/dev/dev_rv/src/XMLIO/c_interface.f03
r137 r138 23 23 INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 24 24 25 SUBROUTINE xios_handle_create(ret, dtype, idt, idt_size) bind(C)25 SUBROUTINE xios_handle_create(ret, dtype, idt, idt_size) BIND(C) 26 26 import C_CHAR, C_INT 27 27 INTEGER (kind = C_INT) :: ret … … 71 71 END TYPE XDuration 72 72 73 INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 74 75 SUBROUTINE xios_set_timestep(ts_year, ts_month, ts_day, & 76 ts_hour, ts_minute, ts_second) BIND(C) 77 import C_DOUBLE 78 REAL (kind = C_DOUBLE), VALUE :: ts_year, ts_month, ts_day, & 79 ts_hour, ts_minute, ts_second 80 END SUBROUTINE xios_set_timestep 81 82 SUBROUTINE xios_update_calendar(step) BIND(C) 83 import C_INT 84 INTEGER (kind = C_INT), VALUE :: step 85 END SUBROUTINE xios_update_calendar 86 87 END INTERFACE 88 89 CONTAINS ! Fonctions disponibles pour les utilisateurs. 90 91 SUBROUTINE set_timestep(timestep) 92 TYPE(XDuration), INTENT(IN):: timestep 93 94 CALL xios_set_timestep(timestep%year, timestep%month , timestep%day, & 95 timestep%hour, timestep%minute, timestep%second) 96 END SUBROUTINE set_timestep 97 98 SUBROUTINE update_calendar(step) 99 INTEGER, INTENT(IN):: step 100 IF (step < 1) THEN 101 PRINT *, "L'argument 'step' ne peut être négatif ou nul" 102 STOP 103 END IF 104 CALL xios_update_calendar(step) 105 END SUBROUTINE update_calendar 106 73 107 END MODULE ICALENDAR 74 108 … … 82 116 INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 83 117 84 SUBROUTINE xios_xml_tree_add(parent_, parent_type, child_, child_type, child_id, child_id_size) bind(C)118 SUBROUTINE xios_xml_tree_add(parent_, parent_type, child_, child_type, child_id, child_id_size) BIND(C) 85 119 import C_CHAR, C_INT 86 120 INTEGER (kind = C_INT), VALUE :: parent_ … … 92 126 END SUBROUTINE xios_xml_tree_add 93 127 94 SUBROUTINE xios_xml_tree_show(filename, filename_size) bind(C)128 SUBROUTINE xios_xml_tree_show(filename, filename_size) BIND(C) 95 129 import C_CHAR, C_INT 96 130 CHARACTER(kind = C_CHAR), DIMENSION(*) :: filename … … 101 135 ! Attribut des éléments de type field et field_group ! 102 136 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 103 SUBROUTINE xios_xml_set_field_name(field, ftype, fname, fname_size) bind(C)137 SUBROUTINE xios_xml_set_field_name(field, ftype, fname, fname_size) BIND(C) 104 138 import C_CHAR, C_INT 105 139 INTEGER (kind = C_INT), VALUE :: field, ftype … … 108 142 END SUBROUTINE xios_xml_set_field_name 109 143 110 SUBROUTINE xios_xml_set_field_sname(field, ftype, fsname, fsname_size) bind(C)144 SUBROUTINE xios_xml_set_field_sname(field, ftype, fsname, fsname_size) BIND(C) 111 145 import C_CHAR, C_INT 112 146 INTEGER (kind = C_INT), VALUE :: field, ftype … … 115 149 END SUBROUTINE xios_xml_set_field_sname 116 150 117 SUBROUTINE xios_xml_set_field_lname(field, ftype, flname, flname_size) bind(C)151 SUBROUTINE xios_xml_set_field_lname(field, ftype, flname, flname_size) BIND(C) 118 152 import C_CHAR, C_INT 119 153 INTEGER (kind = C_INT), VALUE :: field, ftype … … 122 156 END SUBROUTINE xios_xml_set_field_lname 123 157 124 SUBROUTINE xios_xml_set_field_unit(field, ftype, funit, funit_size) bind(C)158 SUBROUTINE xios_xml_set_field_unit(field, ftype, funit, funit_size) BIND(C) 125 159 import C_CHAR, C_INT 126 160 INTEGER (kind = C_INT), VALUE :: field, ftype … … 129 163 END SUBROUTINE xios_xml_set_field_unit 130 164 131 SUBROUTINE xios_xml_set_field_operation(field, ftype, foperation, foperation_size) bind(C)165 SUBROUTINE xios_xml_set_field_operation(field, ftype, foperation, foperation_size) BIND(C) 132 166 import C_CHAR, C_INT 133 167 INTEGER (kind = C_INT), VALUE :: field, ftype … … 136 170 END SUBROUTINE xios_xml_set_field_operation 137 171 138 SUBROUTINE xios_xml_set_field_freq_op(field, ftype, year, month, day, hour, minute, second) bind(C)172 SUBROUTINE xios_xml_set_field_freq_op(field, ftype, year, month, day, hour, minute, second) BIND(C) 139 173 import C_DOUBLE, C_INT 140 174 INTEGER (kind = C_INT), VALUE :: field, ftype … … 142 176 END SUBROUTINE xios_xml_set_field_freq_op 143 177 144 SUBROUTINE xios_xml_set_field_level(field, ftype, flevel) bind(C)178 SUBROUTINE xios_xml_set_field_level(field, ftype, flevel) BIND(C) 145 179 import C_INT 146 180 INTEGER (kind = C_INT), VALUE :: field, ftype … … 148 182 END SUBROUTINE xios_xml_set_field_level 149 183 150 SUBROUTINE xios_xml_set_field_prec(field, ftype, fprec) bind(C)184 SUBROUTINE xios_xml_set_field_prec(field, ftype, fprec) BIND(C) 151 185 import C_INT 152 186 INTEGER (kind = C_INT), VALUE :: field, ftype … … 154 188 END SUBROUTINE xios_xml_set_field_prec 155 189 156 SUBROUTINE xios_xml_set_field_enabled(field, ftype, fenabled) bind(C)190 SUBROUTINE xios_xml_set_field_enabled(field, ftype, fenabled) BIND(C) 157 191 import C_INT, C_BOOL 158 192 INTEGER (kind = C_INT), VALUE :: field, ftype … … 160 194 END SUBROUTINE xios_xml_set_field_enabled 161 195 162 SUBROUTINE xios_xml_set_field_dref(field, ftype, fdref, fdref_size) bind(C)196 SUBROUTINE xios_xml_set_field_dref(field, ftype, fdref, fdref_size) BIND(C) 163 197 import C_CHAR, C_INT 164 198 INTEGER (kind = C_INT), VALUE :: field, ftype … … 167 201 END SUBROUTINE xios_xml_set_field_dref 168 202 169 SUBROUTINE xios_xml_set_field_aref(field, ftype, faref, faref_size) bind(C)203 SUBROUTINE xios_xml_set_field_aref(field, ftype, faref, faref_size) BIND(C) 170 204 import C_CHAR, C_INT 171 205 INTEGER (kind = C_INT), VALUE :: field, ftype … … 174 208 END SUBROUTINE xios_xml_set_field_aref 175 209 176 SUBROUTINE xios_xml_set_field_gref(field, ftype, fgref, fgref_size) bind(C)210 SUBROUTINE xios_xml_set_field_gref(field, ftype, fgref, fgref_size) BIND(C) 177 211 import C_CHAR, C_INT 178 212 INTEGER (kind = C_INT), VALUE :: field, ftype … … 181 215 END SUBROUTINE xios_xml_set_field_gref 182 216 183 SUBROUTINE xios_xml_set_field_zref(field, ftype, fzref, fzref_size) bind(C)217 SUBROUTINE xios_xml_set_field_zref(field, ftype, fzref, fzref_size) BIND(C) 184 218 import C_CHAR, C_INT 185 219 INTEGER (kind = C_INT), VALUE :: field, ftype … … 188 222 END SUBROUTINE xios_xml_set_field_zref 189 223 190 SUBROUTINE xios_xml_set_field_fref(field, ftype, ffref, ffref_size) bind(C)224 SUBROUTINE xios_xml_set_field_fref(field, ftype, ffref, ffref_size) BIND(C) 191 225 import C_CHAR, C_INT 192 226 INTEGER (kind = C_INT), VALUE :: field, ftype … … 199 233 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 200 234 201 SUBROUTINE xios_xml_set_file_name(file_, ftype, fname, fname_size) bind(C)235 SUBROUTINE xios_xml_set_file_name(file_, ftype, fname, fname_size) BIND(C) 202 236 import C_CHAR, C_INT 203 237 INTEGER (kind = C_INT), VALUE :: file_, ftype … … 206 240 END SUBROUTINE xios_xml_set_file_name 207 241 208 SUBROUTINE xios_xml_set_file_description(file_, ftype, fdescription, fdescription_size) bind(C)242 SUBROUTINE xios_xml_set_file_description(file_, ftype, fdescription, fdescription_size) BIND(C) 209 243 import C_CHAR, C_INT 210 244 INTEGER (kind = C_INT), VALUE :: file_, ftype … … 213 247 END SUBROUTINE xios_xml_set_file_description 214 248 215 SUBROUTINE xios_xml_set_file_output_freq(file_, ftype, year, month, day, hour, minute, second) bind(C)249 SUBROUTINE xios_xml_set_file_output_freq(file_, ftype, year, month, day, hour, minute, second) BIND(C) 216 250 import C_DOUBLE, C_INT 217 251 INTEGER (kind = C_INT), VALUE :: file_, ftype … … 219 253 END SUBROUTINE xios_xml_set_file_output_freq 220 254 221 SUBROUTINE xios_xml_set_file_olevel(file_, ftype, folevel) bind(C)255 SUBROUTINE xios_xml_set_file_olevel(file_, ftype, folevel) BIND(C) 222 256 import C_INT 223 257 INTEGER (kind = C_INT), VALUE :: file_, ftype … … 225 259 END SUBROUTINE xios_xml_set_file_olevel 226 260 227 SUBROUTINE xios_xml_set_file_enabled(file_, ftype, fenabled) bind(C)261 SUBROUTINE xios_xml_set_file_enabled(file_, ftype, fenabled) BIND(C) 228 262 import C_INT, C_BOOL 229 263 INTEGER (kind = C_INT), VALUE :: file_, ftype … … 234 268 ! Attribut des éléments de type grid et grid_group ! 235 269 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 236 SUBROUTINE xios_xml_set_grid_name(grid, ftype, gname, gname_size) bind(C)270 SUBROUTINE xios_xml_set_grid_name(grid, ftype, gname, gname_size) BIND(C) 237 271 import C_CHAR, C_INT 238 272 INTEGER (kind = C_INT), VALUE :: grid, ftype … … 241 275 END SUBROUTINE xios_xml_set_grid_name 242 276 243 SUBROUTINE xios_xml_set_grid_description(grid, ftype, gdescription, gdescription_size) bind(C)277 SUBROUTINE xios_xml_set_grid_description(grid, ftype, gdescription, gdescription_size) BIND(C) 244 278 import C_CHAR, C_INT 245 279 INTEGER (kind = C_INT), VALUE :: grid, ftype … … 248 282 END SUBROUTINE xios_xml_set_grid_description 249 283 250 SUBROUTINE xios_xml_set_grid_dref(grid, ftype, dref, dref_size) bind(C)284 SUBROUTINE xios_xml_set_grid_dref(grid, ftype, dref, dref_size) BIND(C) 251 285 import C_CHAR, C_INT 252 286 INTEGER (kind = C_INT), VALUE :: grid, ftype … … 255 289 END SUBROUTINE xios_xml_set_grid_dref 256 290 257 SUBROUTINE xios_xml_set_grid_aref(grid, ftype, aref, aref_size) bind(C)291 SUBROUTINE xios_xml_set_grid_aref(grid, ftype, aref, aref_size) BIND(C) 258 292 import C_CHAR, C_INT 259 293 INTEGER (kind = C_INT), VALUE :: grid, ftype … … 265 299 ! Attribut des éléments de type axis et axis_group ! 266 300 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 267 SUBROUTINE xios_xml_set_axis_name(axis, ftype, aname, aname_size) bind(C)301 SUBROUTINE xios_xml_set_axis_name(axis, ftype, aname, aname_size) BIND(C) 268 302 import C_CHAR, C_INT 269 303 INTEGER (kind = C_INT), VALUE :: axis, ftype … … 272 306 END SUBROUTINE xios_xml_set_axis_name 273 307 274 SUBROUTINE xios_xml_set_axis_sname(axis, ftype, asname, asname_size) bind(C)308 SUBROUTINE xios_xml_set_axis_sname(axis, ftype, asname, asname_size) BIND(C) 275 309 import C_CHAR, C_INT 276 310 INTEGER (kind = C_INT), VALUE :: axis, ftype … … 279 313 END SUBROUTINE xios_xml_set_axis_sname 280 314 281 SUBROUTINE xios_xml_set_axis_lname(axis, ftype, alname, alname_size) bind(C)315 SUBROUTINE xios_xml_set_axis_lname(axis, ftype, alname, alname_size) BIND(C) 282 316 import C_CHAR, C_INT 283 317 INTEGER (kind = C_INT), VALUE :: axis, ftype … … 286 320 END SUBROUTINE xios_xml_set_axis_lname 287 321 288 SUBROUTINE xios_xml_set_axis_unit(axis, ftype, aunit, aunit_size) bind(C)322 SUBROUTINE xios_xml_set_axis_unit(axis, ftype, aunit, aunit_size) BIND(C) 289 323 import C_CHAR, C_INT 290 324 INTEGER (kind = C_INT), VALUE :: axis, ftype … … 293 327 END SUBROUTINE xios_xml_set_axis_unit 294 328 295 SUBROUTINE xios_xml_set_axis_value(axis, ftype, avalue, avalue_size) bind(C)329 SUBROUTINE xios_xml_set_axis_value(axis, ftype, avalue, avalue_size) BIND(C) 296 330 import C_DOUBLE, C_INT 297 331 INTEGER (kind = C_INT), VALUE :: axis, ftype … … 304 338 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 305 339 306 SUBROUTINE xios_xml_set_domain_name(domain, ftype, dname, dname_size) bind(C)340 SUBROUTINE xios_xml_set_domain_name(domain, ftype, dname, dname_size) BIND(C) 307 341 import C_CHAR, C_INT 308 342 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 311 345 END SUBROUTINE xios_xml_set_domain_name 312 346 313 SUBROUTINE xios_xml_set_domain_sname(domain, ftype, dsname, dsname_size) bind(C)347 SUBROUTINE xios_xml_set_domain_sname(domain, ftype, dsname, dsname_size) BIND(C) 314 348 import C_CHAR, C_INT 315 349 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 318 352 END SUBROUTINE xios_xml_set_domain_sname 319 353 320 SUBROUTINE xios_xml_set_domain_lname(domain, ftype, dlname, dlname_size) bind(C)354 SUBROUTINE xios_xml_set_domain_lname(domain, ftype, dlname, dlname_size) BIND(C) 321 355 import C_CHAR, C_INT 322 356 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 325 359 END SUBROUTINE xios_xml_set_domain_lname 326 360 327 SUBROUTINE xios_xml_set_domain_niglo(domain, ftype, niglo) bind(C)361 SUBROUTINE xios_xml_set_domain_niglo(domain, ftype, niglo) BIND(C) 328 362 import C_INT 329 363 INTEGER (kind = C_INT), VALUE :: domain, ftype, niglo 330 364 END SUBROUTINE xios_xml_set_domain_niglo 331 365 332 SUBROUTINE xios_xml_set_domain_njglo(domain, ftype, njglo) bind(C)366 SUBROUTINE xios_xml_set_domain_njglo(domain, ftype, njglo) BIND(C) 333 367 import C_INT 334 368 INTEGER (kind = C_INT), VALUE :: domain, ftype, njglo 335 369 END SUBROUTINE xios_xml_set_domain_njglo 336 370 337 SUBROUTINE xios_xml_set_domain_ibegin(domain, ftype, ibegin) bind(C)371 SUBROUTINE xios_xml_set_domain_ibegin(domain, ftype, ibegin) BIND(C) 338 372 import C_INT 339 373 INTEGER (kind = C_INT), VALUE :: domain, ftype, ibegin 340 374 END SUBROUTINE xios_xml_set_domain_ibegin 341 375 342 SUBROUTINE xios_xml_set_domain_iend(domain, ftype, iend) bind(C)376 SUBROUTINE xios_xml_set_domain_iend(domain, ftype, iend) BIND(C) 343 377 import C_INT 344 378 INTEGER (kind = C_INT), VALUE :: domain, ftype, iend 345 379 END SUBROUTINE xios_xml_set_domain_iend 346 380 347 SUBROUTINE xios_xml_set_domain_ni(domain, ftype, ni) bind(C)381 SUBROUTINE xios_xml_set_domain_ni(domain, ftype, ni) BIND(C) 348 382 import C_INT 349 383 INTEGER (kind = C_INT), VALUE :: domain, ftype, ni 350 384 END SUBROUTINE xios_xml_set_domain_ni 351 385 352 SUBROUTINE xios_xml_set_domain_jbegin(domain, ftype, jbegin) bind(C)386 SUBROUTINE xios_xml_set_domain_jbegin(domain, ftype, jbegin) BIND(C) 353 387 import C_INT 354 388 INTEGER (kind = C_INT), VALUE :: domain, ftype, jbegin 355 389 END SUBROUTINE xios_xml_set_domain_jbegin 356 390 357 SUBROUTINE xios_xml_set_domain_jend(domain, ftype, jend) bind(C)391 SUBROUTINE xios_xml_set_domain_jend(domain, ftype, jend) BIND(C) 358 392 import C_INT 359 393 INTEGER (kind = C_INT), VALUE :: domain, ftype, jend 360 394 END SUBROUTINE xios_xml_set_domain_jend 361 395 362 SUBROUTINE xios_xml_set_domain_nj(domain, ftype, nj) bind(C)396 SUBROUTINE xios_xml_set_domain_nj(domain, ftype, nj) BIND(C) 363 397 import C_INT 364 398 INTEGER (kind = C_INT), VALUE :: domain, ftype, nj 365 399 END SUBROUTINE xios_xml_set_domain_nj 366 400 367 SUBROUTINE xios_xml_set_domain_mask(domain, ftype, mask, maskXsize, maskYsize) bind(C)401 SUBROUTINE xios_xml_set_domain_mask(domain, ftype, mask, maskXsize, maskYsize) BIND(C) 368 402 import C_BOOL, C_INT 369 403 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 372 406 END SUBROUTINE xios_xml_set_domain_mask 373 407 374 SUBROUTINE xios_xml_set_domain_ddim(domain, ftype, dadim) bind(C)408 SUBROUTINE xios_xml_set_domain_ddim(domain, ftype, dadim) BIND(C) 375 409 import C_INT 376 410 INTEGER (kind = C_INT), VALUE :: domain, ftype, dadim 377 411 END SUBROUTINE xios_xml_set_domain_ddim 378 412 379 SUBROUTINE xios_xml_set_domain_dni(domain, ftype, dni) bind(C)413 SUBROUTINE xios_xml_set_domain_dni(domain, ftype, dni) BIND(C) 380 414 import C_INT 381 415 INTEGER (kind = C_INT), VALUE :: domain, ftype, dni 382 416 END SUBROUTINE xios_xml_set_domain_dni 383 417 384 SUBROUTINE xios_xml_set_domain_dnj(domain, ftype, dnj) bind(C)418 SUBROUTINE xios_xml_set_domain_dnj(domain, ftype, dnj) BIND(C) 385 419 import C_INT 386 420 INTEGER (kind = C_INT), VALUE :: domain, ftype, dnj 387 421 END SUBROUTINE xios_xml_set_domain_dnj 388 422 389 SUBROUTINE xios_xml_set_domain_dibegin(domain, ftype, dibegin) bind(C)423 SUBROUTINE xios_xml_set_domain_dibegin(domain, ftype, dibegin) BIND(C) 390 424 import C_INT 391 425 INTEGER (kind = C_INT), VALUE :: domain, ftype, dibegin 392 426 END SUBROUTINE xios_xml_set_domain_dibegin 393 427 394 SUBROUTINE xios_xml_set_domain_djbegin(domain, ftype, djbegin) bind(C)428 SUBROUTINE xios_xml_set_domain_djbegin(domain, ftype, djbegin) BIND(C) 395 429 import C_INT 396 430 INTEGER (kind = C_INT), VALUE :: domain, ftype, djbegin 397 431 END SUBROUTINE xios_xml_set_domain_djbegin 398 432 399 SUBROUTINE xios_xml_set_domain_dnindex(domain, ftype, dnindex) bind(C)433 SUBROUTINE xios_xml_set_domain_dnindex(domain, ftype, dnindex) BIND(C) 400 434 import C_INT 401 435 INTEGER (kind = C_INT), VALUE :: domain, ftype, dnindex 402 436 END SUBROUTINE xios_xml_set_domain_dnindex 403 437 404 SUBROUTINE xios_xml_set_domain_diindex(domain, ftype, diindex, diindex_size) bind(C)438 SUBROUTINE xios_xml_set_domain_diindex(domain, ftype, diindex, diindex_size) BIND(C) 405 439 import C_INT 406 440 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 409 443 END SUBROUTINE xios_xml_set_domain_diindex 410 444 411 SUBROUTINE xios_xml_set_domain_djindex(domain, ftype, djindex, djindex_size) bind(C)445 SUBROUTINE xios_xml_set_domain_djindex(domain, ftype, djindex, djindex_size) BIND(C) 412 446 import C_INT 413 447 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 416 450 END SUBROUTINE xios_xml_set_domain_djindex 417 451 418 SUBROUTINE xios_xml_set_domain_lonvalue(domain, ftype, lonvalue, lonvalue_xsize, lonvalue_ysize) bind(C)452 SUBROUTINE xios_xml_set_domain_lonvalue(domain, ftype, lonvalue, lonvalue_xsize, lonvalue_ysize) BIND(C) 419 453 import C_DOUBLE, C_INT 420 454 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 423 457 END SUBROUTINE xios_xml_set_domain_lonvalue 424 458 425 SUBROUTINE xios_xml_set_domain_latvalue(domain, ftype, latvalue, latvalue_xsize, lonvalue_ysize) bind(C)459 SUBROUTINE xios_xml_set_domain_latvalue(domain, ftype, latvalue, latvalue_xsize, lonvalue_ysize) BIND(C) 426 460 import C_DOUBLE, C_INT 427 461 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 430 464 END SUBROUTINE xios_xml_set_domain_latvalue 431 465 432 SUBROUTINE xios_xml_set_domain_domtype(domain, ftype, domtype, domtype_size) bind(C)466 SUBROUTINE xios_xml_set_domain_domtype(domain, ftype, domtype, domtype_size) BIND(C) 433 467 import C_CHAR, C_INT 434 468 INTEGER (kind = C_INT), VALUE :: domain, ftype … … 829 863 INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 830 864 831 SUBROUTINE xios_xml_Parse_File(filename, filename_size) bind(C)865 SUBROUTINE xios_xml_Parse_File(filename, filename_size) BIND(C) 832 866 import C_CHAR, C_INT 833 867 CHARACTER(kind = C_CHAR), DIMENSION(*) :: filename … … 835 869 END SUBROUTINE xios_xml_Parse_File 836 870 837 SUBROUTINE xios_xml_Parse_String(xmlcontent, xmlcontent_size) bind(C)871 SUBROUTINE xios_xml_Parse_String(xmlcontent, xmlcontent_size) BIND(C) 838 872 import C_CHAR, C_INT 839 873 CHARACTER(kind = C_CHAR), DIMENSION(*) :: xmlcontent … … 868 902 INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 869 903 870 SUBROUTINE xios_context_set_current(context, withswap) bind(C)904 SUBROUTINE xios_context_set_current(context, withswap) BIND(C) 871 905 import C_BOOL, C_INT 872 906 INTEGER (kind = C_INT), VALUE :: context … … 874 908 END SUBROUTINE xios_context_set_current 875 909 876 SUBROUTINE xios_context_create(context, context_id, context_id_size, calendar_type) bind(C) 910 SUBROUTINE xios_context_create(context, context_id, context_id_size, calendar_type, & 911 year, month, day, hour, minute, second) BIND(C) 877 912 import C_CHAR, C_INT 878 913 INTEGER (kind = C_INT) :: context 879 914 CHARACTER(kind = C_CHAR), DIMENSION(*) :: context_id 880 915 INTEGER (kind = C_INT), VALUE :: context_id_size 881 INTEGER (kind = C_INT), VALUE :: calendar_type 916 INTEGER (kind = C_INT), VALUE :: calendar_type, year, month, day, hour, minute, second 882 917 END SUBROUTINE xios_context_create 883 918 … … 905 940 906 941 ! Créer un nouveau contexte à partir d'un id, d'un type de calendrier et d'une date. 907 SUBROUTINE context_create(context_hdl, context_id, calendar_type) 908 USE IXHANDLE 909 TYPE(XHandle), INTENT(OUT) :: context_hdl 910 CHARACTER(len = *), INTENT(IN) :: context_id 911 INTEGER, INTENT(IN) :: calendar_type 912 CALL xios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type) 942 SUBROUTINE context_create(context_hdl, context_id, calendar_type, init_date) 943 USE IXHANDLE 944 USE ICALENDAR 945 TYPE(XHandle), INTENT(OUT) :: context_hdl 946 CHARACTER(len = *), INTENT(IN) :: context_id 947 INTEGER, INTENT(IN) :: calendar_type 948 TYPE(XDate), INTENT(IN), OPTIONAL :: init_date 949 IF (PRESENT(init_date)) THEN 950 CALL xios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, & 951 init_date%year, init_date%month, init_date%day, & 952 init_date%hour, init_date%minute, init_date%second) 953 ELSE 954 CALL xios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, & 955 0, 1, 1, 0, 0, 0) 956 END IF 913 957 IF (context_hdl%daddr .EQ. 0) THEN 914 958 PRINT *, "(F2003 interface) Impossible de créer le context !" … … 934 978 INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99 935 979 936 SUBROUTINE xios_dtreatment_start(context_hdl, filetype) bind(C)980 SUBROUTINE xios_dtreatment_start(context_hdl, filetype) BIND(C) 937 981 import C_INT 938 982 INTEGER (kind = C_INT), VALUE :: context_hdl 939 983 INTEGER (kind = C_INT), VALUE :: filetype 940 984 END SUBROUTINE xios_dtreatment_start 985 986 SUBROUTINE xios_dtreatment_end() BIND(C) 987 ! Sans argument 988 END SUBROUTINE xios_dtreatment_end 989 990 SUBROUTINE xios_write_data(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize, data_Zsize) BIND(C) 991 import C_INT, C_CHAR, C_PTR, C_FLOAT, C_DOUBLE, C_BOOL 992 CHARACTER(kind = C_CHAR), DIMENSION(*) :: fieldid 993 INTEGER (kind = C_INT), VALUE :: fieldid_size 994 REAL(kind = C_DOUBLE), DIMENSION(*) :: data_k8 995 INTEGER (kind = C_INT), VALUE :: data_Xsize, data_Ysize, data_Zsize 996 END SUBROUTINE xios_write_data 941 997 942 998 END INTERFACE … … 963 1019 END SUBROUTINE dtreatment_start 964 1020 1021 SUBROUTINE dtreatment_end(context_hdl) 1022 USE ICONTEXT 1023 USE IXHANDLE 1024 TYPE(XHandle), INTENT(IN), VALUE :: context_hdl 1025 IF ((context_hdl%dtype .NE. ECONTEXT) .OR. (context_hdl%daddr .EQ. 0)) THEN 1026 PRINT *, "(F2003 interface) Impossible de traiter un contexte invalide !" 1027 STOP 1028 END IF 1029 CALL context_set_current(context_hdl) 1030 CALL xios_dtreatment_end() 1031 END SUBROUTINE dtreatment_end 1032 1033 SUBROUTINE write_data (fieldid, & 1034 data1d_k8, data2d_k8, data3d_k8) 1035 CHARACTER(len = *), INTENT(IN) :: fieldid 1036 REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: data1d_k8(:), data2d_k8(:,:), data3d_k8(:,:,:) 1037 IF((.NOT. PRESENT(data1d_k8)) .AND. & 1038 (.NOT. PRESENT(data2d_k8)) .AND. & 1039 (.NOT. PRESENT(data3d_k8))) THEN 1040 PRINT *, "(F2003 interface) Veuillez spécifier des données à écrire !" 1041 STOP 1042 END IF 1043 IF (PRESENT (data1d_k8)) THEN 1044 CALL xios_write_data(fieldid, len(fieldid), data1d_k8, & 1045 size(data1d_k8, 1), -1, -1) 1046 ELSE IF (PRESENT (data2d_k8)) THEN 1047 CALL xios_write_data(fieldid, len(fieldid), data2d_k8, & 1048 size(data2d_k8, 1), size(data2d_k8, 2), -1) 1049 ELSE IF (PRESENT (data3d_k8)) THEN 1050 CALL xios_write_data(fieldid, len(fieldid), data3d_k8, & 1051 size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3)) 1052 END IF 1053 END SUBROUTINE 1054 965 1055 END MODULE IDATATREATMENT 966 1056
Note: See TracChangeset
for help on using the changeset viewer.