1!------------------------------------------------------------------------------- 2 3! This file is part of Code_Saturne, a general-purpose CFD tool. 4! 5! Copyright (C) 1998-2021 EDF S.A. 6! 7! This program is free software; you can redistribute it and/or modify it under 8! the terms of the GNU General Public License as published by the Free Software 9! Foundation; either version 2 of the License, or (at your option) any later 10! version. 11! 12! This program is distributed in the hope that it will be useful, but WITHOUT 13! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 14! FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 15! details. 16! 17! You should have received a copy of the GNU General Public License along with 18! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin 19! Street, Fifth Floor, Boston, MA 02110-1301, USA. 20 21!------------------------------------------------------------------------------- 22 23!> \file cs_c_bindings.f90 24!> Definition of C function and subroutine bindings. 25 26module cs_c_bindings 27 28 !============================================================================= 29 30 use, intrinsic :: iso_c_binding 31 32 use field 33 34 implicit none 35 36 !============================================================================= 37 38 integer :: MESH_LOCATION_NONE, MESH_LOCATION_CELLS 39 integer :: MESH_LOCATION_INTERIOR_FACES, MESH_LOCATION_BOUNDARY_FACES 40 integer :: MESH_LOCATION_VERTICES, MESH_LOCATION_PARTICLES 41 integer :: MESH_LOCATION_OTHER 42 43 integer :: RESTART_VAL_TYPE_INT_T, RESTART_VAL_TYPE_REAL_T 44 45 integer :: RESTART_DISABLED, RESTART_MAIN, RESTART_AUXILIARY 46 integer :: RESTART_RAD_TRANSFER, RESTART_LAGR, RESTART_LAGR_STAT 47 integer :: RESTART_1D_WALL_THERMAL, RESTART_LES_INFLOW 48 49 integer :: VOLUME_ZONE_INITIALIZATION, VOLUME_ZONE_POROSITY 50 integer :: VOLUME_ZONE_HEAD_LOSS 51 integer :: VOLUME_ZONE_SOURCE_TERM, VOLUME_ZONE_MASS_SOURCE_TERM 52 53 parameter (MESH_LOCATION_NONE=0) 54 parameter (MESH_LOCATION_CELLS=1) 55 parameter (MESH_LOCATION_INTERIOR_FACES=2) 56 parameter (MESH_LOCATION_BOUNDARY_FACES=3) 57 parameter (MESH_LOCATION_VERTICES=4) 58 parameter (MESH_LOCATION_PARTICLES=5) 59 parameter (MESH_LOCATION_OTHER=6) 60 61 parameter (RESTART_VAL_TYPE_INT_T=1) 62 parameter (RESTART_VAL_TYPE_REAL_T=3) 63 64 parameter (RESTART_DISABLED=-1) 65 parameter (RESTART_MAIN=0) 66 parameter (RESTART_AUXILIARY=1) 67 parameter (RESTART_RAD_TRANSFER=2) 68 parameter (RESTART_LAGR=3) 69 parameter (RESTART_LAGR_STAT=4) 70 parameter (RESTART_1D_WALL_THERMAL=5) 71 parameter (RESTART_LES_INFLOW=6) 72 73 parameter (VOLUME_ZONE_INITIALIZATION=1) 74 parameter (VOLUME_ZONE_POROSITY=2) 75 parameter (VOLUME_ZONE_HEAD_LOSS=4) 76 parameter (VOLUME_ZONE_SOURCE_TERM=8) 77 parameter (VOLUME_ZONE_MASS_SOURCE_TERM=16) 78 79 !----------------------------------------------------------------------------- 80 81 type, bind(c) :: var_cal_opt 82 integer(c_int) :: iwarni 83 integer(c_int) :: iconv 84 integer(c_int) :: istat 85 integer(c_int) :: idircl 86 integer(c_int) :: ndircl 87 integer(c_int) :: idiff 88 integer(c_int) :: idifft 89 integer(c_int) :: idften 90 integer(c_int) :: iswdyn 91 integer(c_int) :: ischcv 92 integer(c_int) :: ibdtso 93 integer(c_int) :: isstpc 94 integer(c_int) :: nswrgr 95 integer(c_int) :: nswrsm 96 integer(c_int) :: imvisf 97 integer(c_int) :: imrgra 98 integer(c_int) :: imligr 99 integer(c_int) :: ircflu 100 integer(c_int) :: iwgrec 101 integer(c_int) :: icoupl 102 real(c_double) :: thetav 103 real(c_double) :: blencv 104 real(c_double) :: blend_st 105 real(c_double) :: epsilo 106 real(c_double) :: epsrsm 107 real(c_double) :: epsrgr 108 real(c_double) :: climgr 109 real(c_double) :: relaxv 110 end type var_cal_opt 111 112 !--------------------------------------------------------------------------- 113 114 type, bind(c) :: solving_info 115 integer(c_int) :: nbivar 116 real(c_double) :: rnsmbr 117 real(c_double) :: resvar 118 real(c_double) :: dervar 119 real(c_double) :: l2residual 120 end type solving_info 121 122 !--------------------------------------------------------------------------- 123 124 type, bind(c) :: gwf_soilwater_partition 125 integer(c_int) :: kinetic 126 integer(c_int) :: ikd 127 integer(c_int) :: idel 128 integer(c_int) :: ikp 129 integer(c_int) :: ikm 130 integer(c_int) :: imxsol 131 integer(c_int) :: resol_method 132 end type gwf_soilwater_partition 133 134 !--------------------------------------------------------------------------- 135 136 type, bind(c) :: gas_mix_species_prop 137 real(c_double) :: mol_mas 138 real(c_double) :: cp 139 real(c_double) :: vol_dif 140 real(c_double) :: mu_a 141 real(c_double) :: mu_b 142 real(c_double) :: lambda_a 143 real(c_double) :: lambda_b 144 real(c_double) :: muref 145 real(c_double) :: lamref 146 real(c_double) :: trefmu 147 real(c_double) :: treflam 148 real(c_double) :: smu 149 real(c_double) :: slam 150 end type gas_mix_species_prop 151 152 !============================================================================= 153 154 interface 155 156 subroutine beta_limiter_building(f_id, inc, rovsdt) & 157 bind(C, name='cs_beta_limiter_building') 158 use, intrinsic :: iso_c_binding 159 implicit none 160 integer(c_int), value :: f_id 161 integer(c_int), value :: inc 162 real(c_double), dimension(*) , intent(in) :: rovsdt 163 end subroutine beta_limiter_building 164 165 !--------------------------------------------------------------------------- 166 167 !> \brief Set mapped boundary conditions for a given field and mapping 168 !> locator. 169 170 !> param[in] field_id id of field whose boundary conditions 171 !> are set 172 !> param[in] locator associated mapping locator, as returned 173 !> by \ref cs_boundary_conditions_map. 174 !> param[in] location_type matching values location 175 !> (CS_MESH_LOCATION_CELLS or 176 !> CS_MESH_LOCATION_BOUNDARY_FACES) 177 !> param[in] normalize normalization: 178 !> 0: values are simply mapped 179 !> 1: values are mapped, then multiplied 180 !> by a constant factor so that their 181 !> surface integral on selected faces 182 !> is preserved (relative to the 183 !> input values) 184 !> 2: as 1, but with a boundary-defined 185 !> weight, defined by balance_w 186 !> 3: as 1, but with a cell-defined 187 !> weight, defined by balance_w 188 !> param[in] interpolate interpolation option: 189 !> 0: values are simply based on 190 !> matching cell or face center values 191 !> 1: values are based on matching cell 192 !> or face center values, corrected 193 !> by gradient interpolation 194 !> param[in] n_faces number of selected boundary faces 195 !> param[in] faces list of selected boundary faces (1 to n) 196 !> param[in] balance_w optional balance weight 197 !> param[in] nvar number of variables with BC's 198 !> param[in, out] rcodcl boundary condition values 199 200 subroutine boundary_conditions_mapped_set(field_id, locator, & 201 location_type, normalize, & 202 interpolate, n_faces, faces, & 203 balance_w, nvar, rcodcl) & 204 bind(C, name='cs_f_boundary_conditions_mapped_set') 205 use, intrinsic :: iso_c_binding 206 implicit none 207 integer(c_int), value :: field_id 208 type(c_ptr), value :: locator 209 integer(c_int), value :: location_type, normalize, interpolate 210 integer(c_int), value :: n_faces, nvar 211 integer(c_int), dimension(*), intent(in) :: faces 212 real(kind=c_double), dimension(*), intent(in) :: balance_w, rcodcl 213 end subroutine boundary_conditions_mapped_set 214 215 !--------------------------------------------------------------------------- 216 217 ! Interface to C function copying a var_cal_opt structure associated 218 ! with a field. 219 220 subroutine cs_f_field_set_key_struct_var_cal_opt(f_id, k_value) & 221 bind(C, name='cs_f_field_set_key_struct_var_cal_opt') 222 use, intrinsic :: iso_c_binding 223 implicit none 224 integer(c_int), value :: f_id 225 type(c_ptr), value :: k_value 226 end subroutine cs_f_field_set_key_struct_var_cal_opt 227 228 !--------------------------------------------------------------------------- 229 230 ! Interface to C function setting a var_cal_opt structure associated 231 ! with a field. 232 233 subroutine cs_f_field_get_key_struct_var_cal_opt(f_id, k_value) & 234 bind(C, name='cs_f_field_get_key_struct_var_cal_opt') 235 use, intrinsic :: iso_c_binding 236 implicit none 237 integer(c_int), value :: f_id 238 type(c_ptr), value :: k_value 239 end subroutine cs_f_field_get_key_struct_var_cal_opt 240 241 !--------------------------------------------------------------------------- 242 243 ! Interface to C function returninng a pointer to a cs_equation_param_t 244 ! structure based on a given var_cal_opt structure. 245 246 function equation_param_from_vcopt(k_value) result(eqp) & 247 bind(C, name='cs_f_equation_param_from_var_cal_opt') 248 use, intrinsic :: iso_c_binding 249 implicit none 250 type(c_ptr), value :: k_value 251 type(c_ptr) :: eqp 252 end function equation_param_from_vcopt 253 254 !--------------------------------------------------------------------------- 255 256 !> \brief Return the number of fans. 257 258 !> \return number of defined fans 259 260 function cs_fan_n_fans() result(n_fans) & 261 bind(C, name='cs_fan_n_fans') 262 use, intrinsic :: iso_c_binding 263 implicit none 264 integer(c_int) :: n_fans 265 end function cs_fan_n_fans 266 267 !--------------------------------------------------------------------------- 268 269 ! Interface to C function activating default log. 270 271 subroutine cs_log_default_activate(activate) & 272 bind(C, name='cs_log_default_activate') 273 use, intrinsic :: iso_c_binding 274 implicit none 275 logical(kind=c_bool), value :: activate 276 end subroutine cs_log_default_activate 277 278 !--------------------------------------------------------------------------- 279 280 ! Interface to C function activating default log. 281 282 function cs_log_default_is_active() result(is_active) & 283 bind(C, name='cs_log_default_is_active') 284 use, intrinsic :: iso_c_binding 285 implicit none 286 logical(kind=c_bool) :: is_active 287 end function cs_log_default_is_active 288 289 !--------------------------------------------------------------------------- 290 291 ! Interface to C function logging field and other array statistics 292 ! at relevant time steps. 293 294 ! \brief Log field and other array statistics for a given time step. 295 296 subroutine log_iteration() & 297 bind(C, name='cs_log_iteration') 298 use, intrinsic :: iso_c_binding 299 implicit none 300 end subroutine log_iteration 301 302 !--------------------------------------------------------------------------- 303 304 ! Interface to C function logging L2 time residual at relevant time steps. 305 306 ! \brief Log field and other array statistics for a given time step. 307 308 subroutine log_l2residual() & 309 bind(C, name='cs_log_l2residual') 310 use, intrinsic :: iso_c_binding 311 implicit none 312 end subroutine log_l2residual 313 314 !--------------------------------------------------------------------------- 315 316 ! Initialize turbulence model structures 317 318 subroutine cs_turb_model_init() & 319 bind(C, name='cs_turb_model_init') 320 use, intrinsic :: iso_c_binding 321 implicit none 322 end subroutine cs_turb_model_init 323 324 !--------------------------------------------------------------------------- 325 326 ! Set type and order of the turbulence model 327 328 subroutine cs_set_type_order_turbulence_model() & 329 bind(C, name='cs_set_type_order_turbulence_model') 330 use, intrinsic :: iso_c_binding 331 implicit none 332 end subroutine cs_set_type_order_turbulence_model 333 334 !--------------------------------------------------------------------------- 335 336 ! Temporal and z-axis interpolation for meteorological profiles 337 338 function cs_intprf(nprofz, nproft, profz, proft, & 339 profv, xz, t) result (var) & 340 bind(C, name='cs_intprf') 341 use, intrinsic :: iso_c_binding 342 implicit none 343 integer(c_int), intent(in), value :: nprofz, nproft 344 real(kind=c_double), dimension(nprofz), intent(in) :: profz 345 real(kind=c_double), dimension(nproft), intent(in) :: proft 346 real(kind=c_double), dimension(nprofz,nproft), intent(in) :: profv 347 real(kind=c_double), intent(in), value :: xz, t 348 real(kind=c_double) :: var 349 end function cs_intprf 350 351 !--------------------------------------------------------------------------- 352 353 ! Z-axis interpolation for meteorological profiles 354 355 subroutine cs_intprz(nprofz, profz, profv, xz, z_lv, var) & 356 bind(C, name='cs_intprz') 357 use, intrinsic :: iso_c_binding 358 implicit none 359 integer(c_int), intent(in), value :: nprofz 360 real(kind=c_double), dimension(nprofz), intent(in) :: profz, profv 361 real(kind=c_double), intent(in), value :: xz 362 integer(c_int), dimension(2), intent(out) :: z_lv 363 real(kind=c_double), intent(out) :: var 364 end subroutine cs_intprz 365 366 !--------------------------------------------------------------------------- 367 368 !> \brief Compute filters for dynamic models. 369 370 371 !> \param[in] dim stride of array to filter 372 !> \param[in] val array of values to filter 373 !> \param[out] f_val array of filtered values 374 375 subroutine les_filter(stride, val, f_val) & 376 bind(C, name='cs_les_filter') 377 use, intrinsic :: iso_c_binding 378 implicit none 379 integer(c_int), value :: stride 380 real(kind=c_double), dimension(*) :: val 381 real(kind=c_double), dimension(*), intent(out) :: f_val 382 end subroutine les_filter 383 384 !--------------------------------------------------------------------------- 385 386 !> \brief Create the LES balance structure. 387 388 subroutine les_balance_create() & 389 bind(C, name='cs_les_balance_create') 390 use, intrinsic :: iso_c_binding 391 implicit none 392 end subroutine les_balance_create 393 394 !--------------------------------------------------------------------------- 395 396 !> \brief Destroy the LES balance structure. 397 398 subroutine les_balance_finalize() & 399 bind(C, name='cs_les_balance_finalize') 400 use, intrinsic :: iso_c_binding 401 implicit none 402 end subroutine les_balance_finalize 403 404 !--------------------------------------------------------------------------- 405 406 !> \brief Write the LES balance restart file. 407 408 subroutine les_balance_write_restart() & 409 bind(C, name='cs_les_balance_write_restart') 410 use, intrinsic :: iso_c_binding 411 implicit none 412 end subroutine les_balance_write_restart 413 414 !--------------------------------------------------------------------------- 415 416 !> \brief Compute additional time averages for LES balance. 417 418 subroutine les_balance_update_gradients() & 419 bind(C, name='cs_les_balance_update_gradients') 420 use, intrinsic :: iso_c_binding 421 implicit none 422 end subroutine les_balance_update_gradients 423 424 !--------------------------------------------------------------------------- 425 426 !> \brief Compute the LES balance. 427 428 subroutine les_balance_compute() & 429 bind(C, name='cs_les_balance_compute') 430 use, intrinsic :: iso_c_binding 431 implicit none 432 end subroutine les_balance_compute 433 434 !--------------------------------------------------------------------------- 435 436 !> \brief Destroy name to id map structure. 437 438 !> \param[in, out] m pointer to map structure 439 440 subroutine cs_map_name_to_id_destroy(m) & 441 bind(C, name='cs_map_name_to_id_destroy') 442 use, intrinsic :: iso_c_binding 443 implicit none 444 type(c_ptr), intent(inout) :: m 445 end subroutine cs_map_name_to_id_destroy 446 447 !--------------------------------------------------------------------------- 448 449 !> \brief Read restart metadata. 450 451 subroutine parameters_read_restart_info() & 452 bind(C, name='cs_parameters_read_restart_info') 453 use, intrinsic :: iso_c_binding 454 implicit none 455 end subroutine parameters_read_restart_info 456 457 !--------------------------------------------------------------------------- 458 459 !> \brief Destroy structure associated with a restart file 460 !> (and close the file). 461 462 !> \param[in, out] r pointer to map structure 463 464 subroutine restart_destroy(r) & 465 bind(C, name='cs_restart_destroy') 466 use, intrinsic :: iso_c_binding 467 implicit none 468 type(c_ptr), intent(inout) :: r 469 end subroutine restart_destroy 470 471 !--------------------------------------------------------------------------- 472 473 !> \brief Check the locations associated with a restart file. 474 475 !> For each type of entity, return .true. if the associated number 476 !> of entities matches the current value (and so that we consider the 477 !> mesh locations, false otherwise. 478 479 !> \param[in] r restart structure pointer 480 !> \param[out] lcel match for cells 481 !> \param[out] lfac match for interior faces 482 !> \param[out] lfbr match for boundary faces 483 !> \param[out] lsom match for vertices 484 485 subroutine restart_check_base_location(r, lcel, lfac, lfbr, lsom) & 486 bind(C, name='cs_restart_check_base_location') 487 use, intrinsic :: iso_c_binding 488 implicit none 489 type(c_ptr), value :: r 490 logical(kind=c_bool), intent(out) :: lcel, lfac, lfbr, lsom 491 end subroutine restart_check_base_location 492 493 !--------------------------------------------------------------------------- 494 495 !> \brief Read field metadata from checkpoint. 496 497 !> \param[in] r restart structure pointer 498 !> \param[in] old_field_map old field map pointer 499 500 subroutine restart_read_field_info(r, old_field_map) & 501 bind(C, name='cs_restart_read_field_info') 502 use, intrinsic :: iso_c_binding 503 implicit none 504 type(c_ptr), value :: r 505 type(c_ptr), intent(out) :: old_field_map 506 end subroutine restart_read_field_info 507 508 !--------------------------------------------------------------------------- 509 510 !> \brief Write field metadata to checkpoint. 511 512 !> \param[in] r restart structure pointer 513 514 subroutine restart_write_field_info(r) & 515 bind(C, name='cs_restart_write_field_info') 516 use, intrinsic :: iso_c_binding 517 implicit none 518 type(c_ptr), value :: r 519 end subroutine restart_write_field_info 520 521 !--------------------------------------------------------------------------- 522 523 !> \brief Read boundary condition coefficients for all fields from 524 !> checkpoint. 525 526 !> \param[in] r pointer to restart structure 527 528 subroutine restart_read_bc_coeffs(r) & 529 bind(C, name='cs_restart_read_bc_coeffs') 530 use, intrinsic :: iso_c_binding 531 implicit none 532 type(c_ptr), value :: r 533 end subroutine restart_read_bc_coeffs 534 535 !--------------------------------------------------------------------------- 536 537 !> \brief Write boundary condition coefficients for all fields to 538 !> checkpoint. 539 540 !> \param[in] r pointer to restart structure 541 542 subroutine restart_write_bc_coeffs(r) & 543 bind(C, name='cs_restart_write_bc_coeffs') 544 use, intrinsic :: iso_c_binding 545 implicit none 546 type(c_ptr), value :: r 547 end subroutine restart_write_bc_coeffs 548 549 !--------------------------------------------------------------------------- 550 551 !> \brief Loop over all fields and save them in the restart file which id is 552 !> passed in argument if it matches their "restart_file" key value. 553 554 !> \param[in, out] r restart structure pointer 555 !> \param[in] r_id key value 556 557 subroutine restart_write_fields(r, r_id) & 558 bind(C, name='cs_restart_write_fields') 559 use, intrinsic :: iso_c_binding 560 implicit none 561 type(c_ptr), value :: r 562 integer(c_int), value :: r_id 563 end subroutine restart_write_fields 564 565 !--------------------------------------------------------------------------- 566 567 !> \brief Loop over all fields and read them in the restart file which id is 568 !> passed in argument if it matches their "restart_file" key value. 569 570 !> \param[in, out] r restart structure pointer 571 !> \param[in] r_id key value 572 573 subroutine restart_read_fields(r, r_id) & 574 bind(C, name='cs_restart_read_fields') 575 use, intrinsic :: iso_c_binding 576 implicit none 577 type(c_ptr), value :: r 578 integer(c_int), value :: r_id 579 end subroutine restart_read_fields 580 581 !--------------------------------------------------------------------------- 582 583 !> \brief Remove all previous dumps of checkpoint files which 584 !> are not to be saved. 585 586 subroutine restart_clean_multiwriters_history() & 587 bind(C, name='cs_restart_clean_multiwriters_history') 588 use, intrinsic :: iso_c_binding 589 implicit none 590 end subroutine restart_clean_multiwriters_history 591 592 !--------------------------------------------------------------------------- 593 594 ! Interface to C function returning number of SYRTHES couplingsg. 595 596 function cs_syr_coupling_n_couplings() result(n_couplings) & 597 bind(C, name='cs_syr_coupling_n_couplings') 598 use, intrinsic :: iso_c_binding 599 implicit none 600 integer(kind=c_int) :: n_couplings 601 end function cs_syr_coupling_n_couplings 602 603 !--------------------------------------------------------------------------- 604 605 !> \brief Return the number of temporal moments. 606 607 !> \return number of defined moments 608 609 function cs_time_moment_n_moments() result(n_moments) & 610 bind(C, name='cs_time_moment_n_moments') 611 use, intrinsic :: iso_c_binding 612 implicit none 613 integer(c_int) :: n_moments 614 end function cs_time_moment_n_moments 615 616 !--------------------------------------------------------------------------- 617 618 !> \brief Return if moment is active (1) or not (0). 619 620 !> \return 1 if moment is active, 0 if not 621 622 function cs_time_moment_is_active(m_id) result(is_active) & 623 bind(C, name='cs_time_moment_is_active') 624 use, intrinsic :: iso_c_binding 625 implicit none 626 integer(c_int), value :: m_id 627 integer(c_int) :: is_active 628 end function cs_time_moment_is_active 629 630 !--------------------------------------------------------------------------- 631 632 !> \brief Update temporal moments. 633 634 subroutine time_moment_update_all() & 635 bind(C, name='cs_time_moment_update_all') 636 use, intrinsic :: iso_c_binding 637 implicit none 638 end subroutine time_moment_update_all 639 640 !--------------------------------------------------------------------------- 641 642 !> \brief Log temporal moments initialization 643 644 subroutine time_moment_log_iteration() & 645 bind(C, name='cs_time_moment_log_iteration') 646 use, intrinsic :: iso_c_binding 647 implicit none 648 end subroutine time_moment_log_iteration 649 650 !--------------------------------------------------------------------------- 651 652 !> \brief Get field id associated with a given moment. 653 654 !> For moments not defined by the user, but defined automatically so as 655 !> to allow computation of higher order moments (i.e. variances), no field 656 !> is associated, so the returned value is -1. 657 658 !> \param[in] m_num moment number (based on moment creation order, 659 !> 1 to n numbering) 660 661 !> \return f_id associated field id, or -1 662 663 function time_moment_field_id(m_num) result(f_id) & 664 bind(C, name='cs_f_time_moment_field_id') 665 use, intrinsic :: iso_c_binding 666 implicit none 667 integer(c_int), value :: m_num 668 integer(c_int) :: f_id 669 end function time_moment_field_id 670 671 !--------------------------------------------------------------------------- 672 673 !> \brief Read temporal moments checkpoint information. 674 675 subroutine time_moment_restart_read(r) & 676 bind(C, name='cs_time_moment_restart_read') 677 use, intrinsic :: iso_c_binding 678 implicit none 679 type(c_ptr), value :: r 680 end subroutine time_moment_restart_read 681 682 !--------------------------------------------------------------------------- 683 684 !> \brief Checkpoint temporal moments. 685 686 subroutine time_moment_restart_write(r) & 687 bind(C, name='cs_time_moment_restart_write') 688 use, intrinsic :: iso_c_binding 689 implicit none 690 type(c_ptr), value :: r 691 end subroutine time_moment_restart_write 692 693 !--------------------------------------------------------------------------- 694 695 !> \brief Increment time step for timer statistics. 696 697 !> \param[in] id id of statistic 698 699 subroutine timer_stats_increment_time_step() & 700 bind(C, name='cs_timer_stats_increment_time_step') 701 use, intrinsic :: iso_c_binding 702 implicit none 703 end subroutine timer_stats_increment_time_step 704 705 !--------------------------------------------------------------------------- 706 707 !> \brief Enable or disable plotting for a timer statistic. 708 709 !> \param[in] id id of statistic 710 !> \param[in] plot 0 to disable, 1 to enable 711 712 subroutine timer_stats_set_plot(id, plot) & 713 bind(C, name='cs_timer_stats_set_plot') 714 use, intrinsic :: iso_c_binding 715 implicit none 716 integer(c_int), value :: id, plot 717 end subroutine timer_stats_set_plot 718 719 !--------------------------------------------------------------------------- 720 721 !> \brief Start a timer for a given statistic. 722 723 !> Parents of the current statistic are also started, if not active. 724 725 !> If a timer with the same root but different parents is active, we assume 726 !> the current operation is a subset of the active timer, so the timer is 727 !> not started, so as to avoid having a sum of parts larger thn the total. 728 729 !> \param[in] id id of statistic 730 731 subroutine timer_stats_start(id) & 732 bind(C, name='cs_timer_stats_start') 733 use, intrinsic :: iso_c_binding 734 implicit none 735 integer(c_int), value :: id 736 end subroutine timer_stats_start 737 738 !--------------------------------------------------------------------------- 739 740 !> \brief Stop a timer for a given statistic. 741 742 !> \param[in] id id of statistic 743 744 subroutine timer_stats_stop(id) & 745 bind(C, name='cs_timer_stats_stop') 746 use, intrinsic :: iso_c_binding 747 implicit none 748 integer(c_int), value :: id 749 end subroutine timer_stats_stop 750 751 !--------------------------------------------------------------------------- 752 753 !> \brief Start a timer for a given statistic, stopping previous timers 754 !> of the same type which are not a parent, and starting inactive 755 !> parent timers if necessary. 756 757 !> \param[in] id id of statistic 758 759 !> \return id of previously active statistic, or -1 in case of error 760 761 function timer_stats_switch(id) result(old_id) & 762 bind(C, name='cs_timer_stats_switch') 763 use, intrinsic :: iso_c_binding 764 implicit none 765 integer(c_int), value :: id 766 integer(c_int) :: old_id 767 end function timer_stats_switch 768 769 !--------------------------------------------------------------------------- 770 771 !> \brief Calculation of \f$ u^\star \f$, \f$ k \f$ and \f$\varepsilon \f$ 772 !> from a diameter \f$ D_H \f$ and the reference velocity 773 !> \f$ U_{ref} \f$ 774 !> for a circular duct flow with smooth wall 775 !> (use for inlet boundary conditions). 776 !> 777 !> Both \f$ u^\star \f$ and\f$ (k,\varepsilon )\f$ are returned, so that 778 !> the user may compute other values of \f$ k \f$ and \f$ \varepsilon \f$ 779 !> with \f$ u^\star \f$. 780 !> 781 !> We use the laws from Idel'Cik, i.e. 782 !> the head loss coefficient \f$ \lambda \f$ is defined by: 783 !> \f[ |\dfrac{\Delta P}{\Delta x}| = 784 !> \dfrac{\lambda}{D_H} \frac{1}{2} \rho U_{ref}^2 \f] 785 !> 786 !> then the relation reads \f$u^\star = U_{ref} \sqrt{\dfrac{\lambda}{8}}\f$. 787 !> \f$\lambda \f$ depends on the hydraulic Reynolds number 788 !> \f$ Re = \dfrac{U_{ref} D_H}{ \nu} \f$ and is given by: 789 !> - for \f$ Re < 2000 \f$ 790 !> \f[ \lambda = \dfrac{64}{Re} \f] 791 !> 792 !> - for \f$ Re > 4000 \f$ 793 !> \f[ \lambda = \dfrac{1}{( 1.8 \log_{10}(Re)-1.64 )^2} \f] 794 !> 795 !> - for \f$ 2000 < Re < 4000 \f$, we complete by a straight line 796 !> \f[ \lambda = 0.021377 + 5.3115. 10^{-6} Re \f] 797 !> 798 !> From \f$ u^\star \f$, we can estimate \f$ k \f$ and \f$ \varepsilon\f$ 799 !> from the well known formulae of developped turbulence 800 !> 801 !> \f[ k = \dfrac{u^{\star 2}}{\sqrt{C_\mu}} \f] 802 !> \f[ \varepsilon = \dfrac{ u^{\star 3}}{(\kappa D_H /10)} \f] 803 !> 804 !> \param[in] uref2 square of the reference flow velocity 805 !> \param[in] dh hydraulic diameter \f$ D_H \f$ 806 !> \param[in] rho mass density \f$ \rho \f$ 807 !> \param[in] mu dynamic viscosity \f$ \nu \f$ 808 !> \param[out] ustar2 square of friction speed 809 !> \param[out] k calculated turbulent intensity \f$ k \f$ 810 !> \param[out] eps calculated turbulent dissipation 811 !> \f$ \varepsilon \f$ 812 813 subroutine turbulence_bc_ke_hyd_diam(uref2, dh, rho, mu, & 814 ustar2, k, eps) & 815 bind(C, name='cs_turbulence_bc_ke_hyd_diam') 816 use, intrinsic :: iso_c_binding 817 implicit none 818 real(c_double), value :: uref2, dh, rho, mu 819 real(c_double) :: ustar2, k, eps 820 end subroutine turbulence_bc_ke_hyd_diam 821 822 !--------------------------------------------------------------------------- 823 824 !> \brief Calculation of \f$ k \f$ and \f$\varepsilon\f$ 825 !> from a diameter \f$ D_H \f$, a turbulent intensity \f$ I \f$ 826 !> and the reference velocity \f$ U_{ref} \f$ 827 !> for a circular duct flow with smooth wall 828 !> (for inlet boundary conditions). 829 !> 830 !> \param[in] uref2 square of the reference flow velocity 831 !> \param[in] t_intensity turbulent intensity \f$ I \f$ 832 !> \param[in] dh hydraulic diameter \f$ D_H \f$ 833 !> \param[out] k calculated turbulent intensity \f$ k \f$ 834 !> \param[out] eps calculated turbulent dissipation 835 !> \f$ \varepsilon \f$ 836 837 subroutine turbulence_bc_ke_turb_intensity(uref2, t_intensity, dh, & 838 k, eps) & 839 bind(C, name='cs_turbulence_bc_ke_turb_intensity') 840 use, intrinsic :: iso_c_binding 841 implicit none 842 real(c_double), value :: uref2, t_intensity, dh 843 real(kind=c_double), intent(inout) :: k, eps 844 end subroutine turbulence_bc_ke_turb_intensity 845 846 !--------------------------------------------------------------------------- 847 848 !> \brief Compute matrix \f$ \tens{alpha} \f$ used in the computation of the 849 !> Reynolds stress tensor boundary conditions. 850 !> 851 !> \param[in] is_sym Constant c in description above 852 !> (1 at a symmetry face, 0 at a wall face) 853 !> \param[in] p_lg change of basis matrix (local to global) 854 !> \param[out] alpha transformation matrix 855 856 subroutine turbulence_bc_rij_transform(is_sym, p_lg, alpha) & 857 bind(C, name='cs_turbulence_bc_rij_transform') 858 use, intrinsic :: iso_c_binding 859 implicit none 860 integer(c_int), value :: is_sym 861 real(c_double), dimension(3,3), intent(in) :: p_lg 862 real(c_double), dimension(6,6), intent(out) :: alpha 863 end subroutine turbulence_bc_rij_transform 864 865 !--------------------------------------------------------------------------- 866 867 !> \brief Set inlet boundary condition values for turbulence variables based 868 !> on a diameter \f$ D_H \f$ and the reference velocity 869 !> \f$ U_{ref} \f$ 870 !> for a circular duct flow with smooth wall. 871 !> 872 !> We use the laws from Idel'Cik, i.e. 873 !> the head loss coefficient \f$ \lambda \f$ is defined by: 874 !> \f[ |\dfrac{\Delta P}{\Delta x}| = 875 !> \dfrac{\lambda}{D_H} \frac{1}{2} \rho U_{ref}^2 \f] 876 !> 877 !> then the relation reads \f$u^\star = U_{ref} \sqrt{\dfrac{\lambda}{8}}\f$. 878 !> \f$\lambda \f$ depends on the hydraulic Reynolds number 879 !> \f$ Re = \dfrac{U_{ref} D_H}{ \nu} \f$ and is given by: 880 !> - for \f$ Re < 2000 \f$ 881 !> \f[ \lambda = \dfrac{64}{Re} \f] 882 !> 883 !> - for \f$ Re > 4000 \f$ 884 !> \f[ \lambda = \dfrac{1}{( 1.8 \log_{10}(Re)-1.64 )^2} \f] 885 !> 886 !> - for \f$ 2000 < Re < 4000 \f$, we complete by a straight line 887 !> \f[ \lambda = 0.021377 + 5.3115. 10^{-6} Re \f] 888 !> 889 !> From \f$ u^\star \f$, we can estimate \f$ k \f$ and \f$ \varepsilon\f$ 890 !> from the well known formulae of developped turbulence 891 !> 892 !> \f[ k = \dfrac{u^{\star 2}}{\sqrt{C_\mu}} \f] 893 !> \f[ \varepsilon = \dfrac{ u^{\star 3}}{(\kappa D_H /10)} \f] 894 !> 895 !> \param[in] face_num boundary face number 896 !> \param[in] uref2 square of the reference flow velocity 897 !> \param[in] dh hydraulic diameter \f$ D_H \f$ 898 !> \param[in] rho mass density \f$ \rho \f$ 899 !> \param[in] mu dynamic viscosity \f$ \nu \f$ 900 !> \param[out] rcodcl boundary condition values 901 902 subroutine turbulence_bc_inlet_hyd_diam(face_num, uref2, dh, rho, mu, & 903 rcodcl) & 904 bind(C, name='cs_f_turbulence_bc_inlet_hyd_diam') 905 use, intrinsic :: iso_c_binding 906 implicit none 907 integer(c_int), value :: face_num 908 real(c_double), value :: uref2, dh, rho, mu 909 real(kind=c_double), dimension(*) :: rcodcl 910 end subroutine turbulence_bc_inlet_hyd_diam 911 912 !--------------------------------------------------------------------------- 913 914 !> \brief Set inlet boundary condition values for turbulence variables based 915 !> on a diameter \f$ D_H \f$, a turbulent intensity \f$ I \f$ 916 !> and the reference velocity \f$ U_{ref} \f$ 917 !> for a circular duct flow with smooth wall. 918 !> 919 !> \param[in] face_id boundary face id 920 !> \param[in] uref2 square of the reference flow velocity 921 !> \param[in] t_intensity turbulent intensity \f$ I \f$ 922 !> \param[in] dh hydraulic diameter \f$ D_H \f$ 923 !> \param[out] rcodcl boundary condition values 924 925 subroutine turbulence_bc_inlet_turb_intensity(face_num, & 926 uref2, t_intensity, dh, & 927 rcodcl) & 928 bind(C, name='cs_f_turbulence_bc_inlet_turb_intensity') 929 use, intrinsic :: iso_c_binding 930 implicit none 931 integer(c_int), value :: face_num 932 real(c_double), value :: uref2, t_intensity, dh 933 real(kind=c_double), dimension(*) :: rcodcl 934 end subroutine turbulence_bc_inlet_turb_intensity 935 936 !--------------------------------------------------------------------------- 937 938 !> \brief Set inlet boundary condition values for turbulence variables based 939 !> on given k and epsilon values. 940 !> 941 !> \param[in] face_id boundary face id 942 !> \param[in] k turbulent kinetic energy 943 !> \param[in] epsilon turbulent dissipation 944 !> \param[out] rcodcl boundary condition values 945 946 subroutine turbulence_bc_inlet_k_eps(face_num, & 947 k, eps, & 948 vel_dir, shear_dir, & 949 rcodcl) & 950 bind(C, name='cs_f_turbulence_bc_inlet_k_eps') 951 use, intrinsic :: iso_c_binding 952 implicit none 953 integer(c_int), value :: face_num 954 real(c_double), value :: k, eps 955 real(kind=c_double), dimension(3) :: vel_dir 956 real(kind=c_double), dimension(3) :: shear_dir 957 real(kind=c_double), dimension(*) :: rcodcl 958 end subroutine turbulence_bc_inlet_k_eps 959 960 !--------------------------------------------------------------------------- 961 962 !> \brief Set inlet boundary condition values for turbulence variables based 963 !> on given k and epsilon values only if not initialized already. 964 !> 965 !> \param[in] face_id boundary face id 966 !> \param[in] k turbulent kinetic energy 967 !> \param[in] epsilon turbulent dissipation 968 !> \param[in] vel_dir velocity direction 969 !> \param[in] shear_dir shear direction 970 !> \param[out] rcodcl boundary condition values 971 972 subroutine turbulence_bc_set_uninit_inlet_k_eps(face_num, & 973 k, eps, & 974 vel_dir, shear_dir, & 975 rcodcl) & 976 bind(C, name='cs_f_turbulence_bc_set_uninit_inlet_k_eps') 977 use, intrinsic :: iso_c_binding 978 implicit none 979 integer(c_int), value :: face_num 980 real(c_double), value :: k, eps 981 real(kind=c_double), dimension(3) :: vel_dir 982 real(kind=c_double), dimension(3) :: shear_dir 983 real(kind=c_double), dimension(*) :: rcodcl 984 end subroutine turbulence_bc_set_uninit_inlet_k_eps 985 986 !--------------------------------------------------------------------------- 987 988 !> \brief Compute molar and mass fractions of elementary species Ye, Xe 989 !> (fuel, O2, CO2, H2O, N2) from global species Yg (fuel, oxidant, products) 990 991 !> \param[in] yg global mass fraction 992 !> \param[out] ye elementary mass fraction 993 !> \param[out] xe elementary molar fraction 994 995 subroutine yg2xye(yg, ye, xe) & 996 bind(C, name='cs_combustion_gas_yg2xye') 997 use, intrinsic :: iso_c_binding 998 implicit none 999 real(kind=c_double), dimension(*) :: yg 1000 real(kind=c_double), dimension(*), intent(out) :: ye, xe 1001 end subroutine yg2xye 1002 1003 !--------------------------------------------------------------------------- 1004 1005 !> \brief General user parameters 1006 1007 subroutine user_parameters() & 1008 bind(C, name='cs_user_parameters_wrapper') 1009 use, intrinsic :: iso_c_binding 1010 implicit none 1011 end subroutine user_parameters 1012 1013 !--------------------------------------------------------------------------- 1014 1015 !> \brief General user parameters 1016 1017 subroutine user_porosity() & 1018 bind(C, name='cs_user_porosity_wrapper') 1019 use, intrinsic :: iso_c_binding 1020 implicit none 1021 end subroutine user_porosity 1022 1023 !--------------------------------------------------------------------------- 1024 1025 !> \cond DOXYGEN_SHOULD_SKIP_THIS 1026 1027 !--------------------------------------------------------------------------- 1028 1029 ! Interface to C function handling boundary condition errors and output 1030 1031 subroutine cs_boundary_conditions_error(bc_flag, type_name) & 1032 bind(C, name='cs_boundary_conditions_error') 1033 use, intrinsic :: iso_c_binding 1034 implicit none 1035 integer(c_int), dimension(*), intent(in) :: bc_flag 1036 type(c_ptr), value :: type_name 1037 end subroutine cs_boundary_conditions_error 1038 1039 !--------------------------------------------------------------------------- 1040 1041 ! Interface to C function locating shifted bundary face coordinates on 1042 ! possibly filtered cells or boundary faces for later interpolation. 1043 1044 function cs_boundary_conditions_map(location_type, n_location_elts, & 1045 n_faces, location_elts, faces, & 1046 coord_shift, coord_stride, & 1047 tolerance) result(l) & 1048 bind(C, name='cs_boundary_conditions_map') 1049 use, intrinsic :: iso_c_binding 1050 implicit none 1051 integer(c_int), value :: location_type, n_location_elts, n_faces 1052 integer(c_int), dimension(*), intent(in) :: location_elts, faces 1053 real(kind=c_double), dimension(*) :: coord_shift 1054 integer(c_int), value :: coord_stride 1055 real(kind=c_double), value :: tolerance 1056 type(c_ptr) :: l 1057 end function cs_boundary_conditions_map 1058 1059 !--------------------------------------------------------------------------- 1060 1061 ! Interface to C function creating the bc type and face zone arrays 1062 1063 subroutine cs_f_boundary_conditions_create() & 1064 bind(C, name='cs_boundary_conditions_create') 1065 use, intrinsic :: iso_c_binding 1066 implicit none 1067 end subroutine cs_f_boundary_conditions_create 1068 1069 !--------------------------------------------------------------------------- 1070 1071 ! Interface to C function freeing the bc type and face zone arrays 1072 1073 subroutine cs_f_boundary_conditions_free() & 1074 bind(C, name='cs_boundary_conditions_free') 1075 use, intrinsic :: iso_c_binding 1076 implicit none 1077 end subroutine cs_f_boundary_conditions_free 1078 1079 !--------------------------------------------------------------------------- 1080 1081 ! Interface to C function to get the bc type array pointer 1082 1083 subroutine cs_f_boundary_conditions_get_pointers(itypfb, izfppp) & 1084 bind(C, name='cs_f_boundary_conditions_get_pointers') 1085 use, intrinsic :: iso_c_binding 1086 implicit none 1087 type(c_ptr), intent(out) :: itypfb, izfppp 1088 end subroutine cs_f_boundary_conditions_get_pointers 1089 1090 !--------------------------------------------------------------------------- 1091 1092 ! Interface to C function checking the presence of a control file 1093 ! and dealing with the interactive control. 1094 1095 subroutine cs_control_check_file() & 1096 bind(C, name='cs_control_check_file') 1097 use, intrinsic :: iso_c_binding 1098 implicit none 1099 end subroutine cs_control_check_file 1100 1101 !--------------------------------------------------------------------------- 1102 1103 ! Interface to C function mapping field pointers 1104 1105 subroutine cs_field_pointer_map_base() & 1106 bind(C, name='cs_field_pointer_map_base') 1107 use, intrinsic :: iso_c_binding 1108 implicit none 1109 end subroutine cs_field_pointer_map_base 1110 1111 !--------------------------------------------------------------------------- 1112 1113 ! Interface to C function mapping boundary field pointers 1114 1115 subroutine cs_field_pointer_map_boundary() & 1116 bind(C, name='cs_field_pointer_map_boundary') 1117 use, intrinsic :: iso_c_binding 1118 implicit none 1119 end subroutine cs_field_pointer_map_boundary 1120 1121 !--------------------------------------------------------------------------- 1122 1123 ! Interface to C function returning the product of a matrix (native format) 1124 ! by a vector 1125 1126 subroutine cs_matrix_vector_native_multiply(symmetric, db_size, eb_size, & 1127 f_id, dam, xam, vx, vy) & 1128 bind(C, name='cs_matrix_vector_native_multiply') 1129 use, intrinsic :: iso_c_binding 1130 implicit none 1131 logical(c_bool), value :: symmetric 1132 integer(c_int), dimension(4), intent(in) :: db_size, eb_size 1133 integer(c_int), value :: f_id 1134 real(kind=c_double), dimension(*), intent(in) :: dam, xam, vx 1135 real(kind=c_double), dimension(*), intent(out) :: vy 1136 end subroutine cs_matrix_vector_native_multiply 1137 1138 !--------------------------------------------------------------------------- 1139 1140 ! Interface to C function returning the global dot product of 2 vectors 1141 1142 function cs_gdot(n, x, y) result(gdot) & 1143 bind(C, name='cs_gdot') 1144 use, intrinsic :: iso_c_binding 1145 implicit none 1146 integer(c_int), value :: n 1147 real(kind=c_double), dimension(*), intent(in) :: x, y 1148 real(kind=c_double) :: gdot 1149 end function cs_gdot 1150 1151 !--------------------------------------------------------------------------- 1152 1153 ! Interface to C function returning the global residual of 2 vectors 1154 1155 function cs_gres(n, vol, x, y) result(gres) & 1156 bind(C, name='cs_gres') 1157 use, intrinsic :: iso_c_binding 1158 implicit none 1159 integer(c_int), value :: n 1160 real(kind=c_double), dimension(*), intent(in) :: vol, x, y 1161 real(kind=c_double) :: gres 1162 end function cs_gres 1163 1164 !--------------------------------------------------------------------------- 1165 1166 ! Interface to C function 1167 1168 subroutine cs_bad_cells_regularisation_scalar(var) & 1169 bind(C, name='cs_bad_cells_regularisation_scalar') 1170 use, intrinsic :: iso_c_binding 1171 implicit none 1172 real(kind=c_double), dimension(*) :: var 1173 end subroutine cs_bad_cells_regularisation_scalar 1174 1175 !--------------------------------------------------------------------------- 1176 1177 ! Interface to C function 1178 1179 subroutine cs_bad_cells_regularisation_vector(var, & 1180 boundary_projection) & 1181 bind(C, name='cs_bad_cells_regularisation_vector') 1182 use, intrinsic :: iso_c_binding 1183 implicit none 1184 real(kind=c_double), dimension(*) :: var 1185 integer(c_int), value :: boundary_projection 1186 end subroutine cs_bad_cells_regularisation_vector 1187 1188 !--------------------------------------------------------------------------- 1189 1190 ! Interface to C function 1191 1192 subroutine cs_bad_cells_regularisation_tensor(var, & 1193 boundary_projection) & 1194 bind(C, name='cs_bad_cells_regularisation_tensor') 1195 use, intrinsic :: iso_c_binding 1196 implicit none 1197 real(kind=c_double), dimension(*) :: var 1198 integer(c_int), value :: boundary_projection 1199 end subroutine cs_bad_cells_regularisation_tensor 1200 1201 !--------------------------------------------------------------------------- 1202 1203 ! Interface to C function 1204 1205 subroutine cs_bad_cells_regularisation_sym_tensor(var, & 1206 boundary_projection) & 1207 bind(C, name='cs_bad_cells_regularisation_sym_tensor') 1208 use, intrinsic :: iso_c_binding 1209 implicit none 1210 real(kind=c_double), dimension(*) :: var 1211 integer(c_int), value :: boundary_projection 1212 end subroutine cs_bad_cells_regularisation_sym_tensor 1213 1214 !--------------------------------------------------------------------------- 1215 1216 !> Interface to C function defining turbulence model through the GUI. 1217 1218 subroutine cs_gui_turb_model() & 1219 bind(C, name='cs_gui_turb_model') 1220 use, intrinsic :: iso_c_binding 1221 implicit none 1222 end subroutine cs_gui_turb_model 1223 1224 !--------------------------------------------------------------------------- 1225 1226 !> Interface to C function defining reference length and reference velocity 1227 !> for the initialization of the turbulence variables through the GUI. 1228 1229 subroutine cs_gui_turb_ref_values() & 1230 bind(C, name='cs_gui_turb_ref_values') 1231 use, intrinsic :: iso_c_binding 1232 implicit none 1233 end subroutine cs_gui_turb_ref_values 1234 1235 !--------------------------------------------------------------------------- 1236 1237 !> Interface to C function defining user variables through the GUI. 1238 1239 subroutine cs_gui_user_variables() & 1240 bind(C, name='cs_gui_user_variables') 1241 use, intrinsic :: iso_c_binding 1242 implicit none 1243 end subroutine cs_gui_user_variables 1244 1245 !--------------------------------------------------------------------------- 1246 1247 ! Interface to C function selecting specific physical models. 1248 1249 subroutine cs_gui_physical_model_select() & 1250 bind(C, name='cs_gui_physical_model_select') 1251 use, intrinsic :: iso_c_binding 1252 implicit none 1253 end subroutine cs_gui_physical_model_select 1254 1255 !--------------------------------------------------------------------------- 1256 1257 !> Interface to C function defining time moments through the GUI. 1258 1259 subroutine cs_gui_time_moments() & 1260 bind(C, name='cs_gui_time_moments') 1261 use, intrinsic :: iso_c_binding 1262 implicit none 1263 end subroutine cs_gui_time_moments 1264 1265 !--------------------------------------------------------------------------- 1266 1267 ! Interface to C function adding an array not saved as a permanent field 1268 ! to logging of fields 1269 1270 subroutine cs_log_iteration_add_array(name, category, ml, is_intensive, & 1271 dim, val) & 1272 bind(C, name='cs_log_iteration_add_array') 1273 use, intrinsic :: iso_c_binding 1274 implicit none 1275 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1276 character(kind=c_char, len=1), dimension(*), intent(in) :: category 1277 integer(c_int), value :: ml 1278 logical(c_bool), value :: is_intensive 1279 integer(c_int), value :: dim 1280 real(kind=c_double), dimension(*) :: val 1281 end subroutine cs_log_iteration_add_array 1282 1283 !--------------------------------------------------------------------------- 1284 1285 ! Interface to C function adding an array not saved as a permanent field 1286 ! to logging of fields 1287 1288 subroutine cs_log_iteration_clipping(name, dim, n_clip_min, n_clip_max, & 1289 min_pre_clip, max_pre_clip) & 1290 bind(C, name='cs_log_iteration_clipping') 1291 use, intrinsic :: iso_c_binding 1292 implicit none 1293 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1294 integer(c_int), value :: dim, n_clip_max, n_clip_min 1295 real(kind=c_double), dimension(*) :: min_pre_clip, max_pre_clip 1296 end subroutine cs_log_iteration_clipping 1297 1298 !--------------------------------------------------------------------------- 1299 1300 ! Interface to C function adding an array not saved as a permanent field 1301 ! to logging of fields 1302 1303 subroutine cs_log_iteration_clipping_field(f_id, n_clip_min, n_clip_max, & 1304 min_pre_clip, max_pre_clip, & 1305 n_clip_min_comp, & 1306 n_clip_max_comp) & 1307 bind(C, name='cs_log_iteration_clipping_field') 1308 use, intrinsic :: iso_c_binding 1309 implicit none 1310 integer(c_int), value :: f_id, n_clip_max, n_clip_min 1311 real(kind=c_double), dimension(*) :: min_pre_clip, max_pre_clip 1312 integer(c_int), dimension(*), intent(in) :: n_clip_min_comp, n_clip_max_comp 1313 end subroutine cs_log_iteration_clipping_field 1314 1315 !--------------------------------------------------------------------------- 1316 1317 ! Interface to C function initializing condensation-related field key. 1318 1319 function cs_gas_mix_get_field_key() & 1320 result(k_id) & 1321 bind(C, name='cs_gas_mix_get_field_key') 1322 use, intrinsic :: iso_c_binding 1323 implicit none 1324 integer(c_int) :: k_id 1325 end function cs_gas_mix_get_field_key 1326 1327 !--------------------------------------------------------------------------- 1328 1329 ! Interface to C function initializing condensation-related field key. 1330 1331 function cs_gas_mix_species_to_field_id(sp_id) & 1332 result(f_id) & 1333 bind(C, name='cs_f_gas_mix_species_to_field_id') 1334 use, intrinsic :: iso_c_binding 1335 implicit none 1336 integer(c_int), value :: sp_id 1337 integer(c_int) :: f_id 1338 end function cs_gas_mix_species_to_field_id 1339 1340 !--------------------------------------------------------------------------- 1341 1342 ! Interface to C function to compute properties with Freesteam in a 1343 ! defined thermal plane. 1344 1345 subroutine phys_prop_freesteam(thermo_plane, property, n_vals, & 1346 var1, var2, val) & 1347 bind(C, name='cs_phys_prop_freesteam') 1348 use, intrinsic :: iso_c_binding 1349 implicit none 1350 integer(c_int), intent(in), value :: thermo_plane, property, n_vals 1351 real(kind=c_double), dimension(*), intent(in) :: var1, var2 1352 real(kind=c_double), dimension(*), intent(out) :: val 1353 end subroutine phys_prop_freesteam 1354 1355 !--------------------------------------------------------------------------- 1356 1357 ! Interface to C function 1358 !> \brief Get reference value of a physical property 1359 1360 !> \param[in] name property name 1361 !> \return reference value (c_double) 1362 1363 function cs_physical_property_get_ref_value(name) result(val) & 1364 bind(C, name='cs_physical_property_get_ref_value') 1365 use, intrinsic :: iso_c_binding 1366 implicit none 1367 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1368 real(c_double) :: val 1369 end function cs_physical_property_get_ref_value 1370 1371 !--------------------------------------------------------------------------- 1372 1373 ! Interface to C function 1374 !> \brief Set reference value for a physical property 1375 1376 !> \param[in] name property name 1377 !> \param[in] val new value to set 1378 1379 subroutine cs_physical_property_set_ref_value(name, val) & 1380 bind(C, name='cs_physical_property_set_ref_value') 1381 use, intrinsic :: iso_c_binding 1382 implicit none 1383 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1384 real(kind=c_double), value, intent(in) :: val 1385 end subroutine cs_physical_property_set_ref_value 1386 1387 !--------------------------------------------------------------------------- 1388 1389 ! Interface to C function 1390 !> \brief Create physical property 1391 1392 !> \param[in] name property name 1393 !> \param[in] dim property dimension 1394 !> \param[in] refval reference value 1395 1396 subroutine cs_physical_property_create(name, dim, refval) & 1397 bind(C, name='cs_physical_property_create') 1398 use, intrinsic :: iso_c_binding 1399 implicit none 1400 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1401 integer(c_int), value, intent(in) :: dim 1402 real(kind=c_double), value, intent(in) :: refval 1403 end subroutine cs_physical_property_create 1404 1405 !--------------------------------------------------------------------------- 1406 1407 ! Interface to C function 1408 !> \brief Get property reference values for a given zone 1409 1410 !> \param[in] name property name 1411 !> \param[in] zname zone name 1412 !> \param[in] retval array of values to return 1413 1414 subroutine cs_physical_property_get_zone_values(name, zname, retval) & 1415 bind(C, name='cs_physical_property_get_zone_values') 1416 use, intrinsic :: iso_c_binding 1417 implicit none 1418 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1419 character(kind=c_char, len=1), dimension(*), intent(in) :: zname 1420 real(kind=c_double), dimension(*), intent(out) :: retval 1421 end subroutine cs_physical_property_get_zone_values 1422 1423 !--------------------------------------------------------------------------- 1424 1425 ! Interface to C function 1426 !> \brief Update reference values for a property on a given zone 1427 1428 !> \param[in] name property name 1429 !> \param[in] zname zone name 1430 !> \param[in] vals array of values to set 1431 1432 subroutine cs_physical_property_update_zone_values(name, zname, vals) & 1433 bind(C, name='cs_physical_property_update_zone_values') 1434 use, intrinsic :: iso_c_binding 1435 implicit none 1436 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1437 character(kind=c_char, len=1), dimension(*), intent(in) :: zname 1438 real(kind=c_double), dimension(*), intent(in) :: vals 1439 end subroutine cs_physical_property_update_zone_values 1440 1441 !--------------------------------------------------------------------------- 1442 1443 ! Interface to C function 1444 !> \brief Add a property definition on a given zone using a single value 1445 1446 !> \param[in] name property name 1447 !> \param[in] zname zone name 1448 !> \param[in] dim property dimension 1449 !> \param[in] val reference value for the zone 1450 1451 subroutine cs_physical_property_define_from_value(name, zname, dim, val) & 1452 bind(C, name='cs_physical_property_define_from_value') 1453 use, intrinsic :: iso_c_binding 1454 implicit none 1455 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1456 character(kind=c_char, len=1), dimension(*), intent(in) :: zname 1457 integer(c_int), value :: dim 1458 real(kind=c_double), value, intent(in) :: val 1459 end subroutine cs_physical_property_define_from_value 1460 1461 !--------------------------------------------------------------------------- 1462 1463 ! Interface to C function 1464 !> \brief Add a property multi-diemnsional definition on a given zone 1465 1466 !> \param[in] name property name 1467 !> \param[in] zname zone name 1468 !> \param[in] dim property dimension (>1) 1469 !> \param[in] vals array of values to set 1470 1471 subroutine cs_physical_property_define_from_values(name, zname, dim, vals) & 1472 bind(C, name='cs_physical_property_define_from_values') 1473 use, intrinsic :: iso_c_binding 1474 implicit none 1475 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1476 character(kind=c_char, len=1), dimension(*), intent(in) :: zname 1477 integer(c_int), value :: dim 1478 real(kind=c_double), dimension(*), intent(in) :: vals 1479 end subroutine cs_physical_property_define_from_values 1480 1481 !--------------------------------------------------------------------------- 1482 1483 ! Interface to C function 1484 !> \brief Add a property definition based on a cs_field_t. Field is created if needed 1485 1486 !> \param[in] name property name 1487 !> \param[in] type_flag field type flag 1488 !> \param[in] location_id location id flag 1489 !> \param[in] dim field dimension 1490 !> \param[in] has_previous does the field has val_pre 1491 1492 subroutine cs_physical_property_define_from_field(name, type_flag, & 1493 location_id, dim, has_previous) & 1494 bind(C, name='cs_physical_property_define_from_field') 1495 use, intrinsic :: iso_c_binding 1496 implicit none 1497 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1498 integer(c_int), value :: type_flag 1499 integer(c_int), value :: location_id 1500 integer(c_int), value :: dim 1501 logical(c_bool), value :: has_previous 1502 end subroutine cs_physical_property_define_from_field 1503 1504 !--------------------------------------------------------------------------- 1505 1506 ! Interface to C function 1507 !> \brief Return id of field associated to property 1508 1509 !> \param[in] name property name 1510 !> \return field id (int) 1511 1512 function cs_physical_property_field_id_by_name(name) & 1513 result(f_id) & 1514 bind(C, name='cs_physical_property_field_id_by_name') 1515 use, intrinsic :: iso_c_binding 1516 implicit none 1517 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1518 integer(c_int) :: f_id 1519 end function cs_physical_property_field_id_by_name 1520 1521 !--------------------------------------------------------------------------- 1522 1523 ! Interface to C function for uniform distribution random number 1524 1525 subroutine cs_random_uniform(n, a) & 1526 bind(C, name='cs_random_uniform') 1527 use, intrinsic :: iso_c_binding 1528 implicit none 1529 integer(c_int), intent(in), value :: n 1530 real(kind=c_double), dimension(*), intent(out) :: a 1531 end subroutine cs_random_uniform 1532 1533 !--------------------------------------------------------------------------- 1534 1535 ! Interface to C function for normal distribution random number 1536 1537 subroutine cs_random_normal(n, x) & 1538 bind(C, name='cs_random_normal') 1539 use, intrinsic :: iso_c_binding 1540 implicit none 1541 integer(c_int), intent(in), value :: n 1542 real(kind=c_double), dimension(*), intent(out) :: x 1543 end subroutine cs_random_normal 1544 1545 !--------------------------------------------------------------------------- 1546 1547 ! Interface to C function initializing a restart file 1548 1549 function cs_restart_create(name, path, mode) result(r) & 1550 bind(C, name='cs_restart_create') 1551 use, intrinsic :: iso_c_binding 1552 implicit none 1553 character(kind=c_char, len=1), dimension(*), intent(in) :: name, path 1554 integer(c_int), value :: mode 1555 type(c_ptr) :: r 1556 end function cs_restart_create 1557 1558 !--------------------------------------------------------------------------- 1559 1560 ! Interface to C function reading a section from a restart file. 1561 1562 function cs_restart_read_section(r, sec_name, & 1563 location_id, n_location_vals, & 1564 val_type, val) result(error) & 1565 bind(C, name='cs_restart_read_section') 1566 use, intrinsic :: iso_c_binding 1567 implicit none 1568 type(c_ptr), value :: r 1569 character(kind=c_char, len=1), dimension(*), intent(in) :: sec_name 1570 integer(c_int), value :: location_id, n_location_vals, val_type 1571 type(c_ptr), value :: val 1572 integer(c_int) :: error 1573 end function cs_restart_read_section 1574 1575 !--------------------------------------------------------------------------- 1576 1577 ! Interface to C function reading a section from a restart file, when 1578 ! that section may have used a different name in a previous version. 1579 1580 function cs_restart_read_section_compat(r, sec_name, old_name, & 1581 location_id, n_location_vals, & 1582 val_type, val) result(error) & 1583 bind(C, name='cs_restart_read_section_compat') 1584 use, intrinsic :: iso_c_binding 1585 implicit none 1586 type(c_ptr), value :: r 1587 character(kind=c_char, len=1), dimension(*), intent(in) :: sec_name 1588 character(kind=c_char, len=1), dimension(*), intent(in) :: old_name 1589 integer(c_int), value :: location_id, n_location_vals, val_type 1590 type(c_ptr), value :: val 1591 integer(c_int) :: error 1592 end function cs_restart_read_section_compat 1593 1594 !--------------------------------------------------------------------------- 1595 1596 ! Interface to C function which checks if the restart is from NEPTUNE_CFD 1597 function cs_restart_check_if_restart_from_ncfd(r) result(flag) & 1598 bind(C, name='cs_restart_check_if_restart_from_ncfd') 1599 use, intrinsic :: iso_c_binding 1600 implicit none 1601 type(c_ptr), value :: r 1602 integer(c_int) :: flag 1603 end function cs_restart_check_if_restart_from_ncfd 1604 1605 !--------------------------------------------------------------------------- 1606 1607 ! Interface to C function which returns if the restart is from NEPTUNE_CFD 1608 function cs_restart_is_from_ncfd() result(flag) & 1609 bind(C, name='cs_restart_is_from_ncfd') 1610 use, intrinsic :: iso_c_binding 1611 implicit none 1612 integer(c_int) :: flag 1613 end function cs_restart_is_from_ncfd 1614 1615 !--------------------------------------------------------------------------- 1616 1617 ! Interface to C function writing a section to a checkpoint file. 1618 1619 subroutine cs_restart_write_section(r, sec_name, & 1620 location_id, n_location_vals, & 1621 val_type, val) & 1622 bind(C, name='cs_restart_write_section') 1623 use, intrinsic :: iso_c_binding 1624 implicit none 1625 type(c_ptr), value :: r 1626 character(kind=c_char, len=1), dimension(*), intent(in) :: sec_name 1627 integer(c_int), value :: location_id, n_location_vals, val_type 1628 type(c_ptr), value :: val 1629 integer(c_int) :: error 1630 end subroutine cs_restart_write_section 1631 1632 !--------------------------------------------------------------------------- 1633 1634 ! Interface to C function reading variables 1635 1636 subroutine cs_restart_read_variables(r, old_field_map, & 1637 t_id_flag, read_flag) & 1638 bind(C, name='cs_restart_read_variables') 1639 use, intrinsic :: iso_c_binding 1640 implicit none 1641 type(c_ptr), value :: r 1642 type(c_ptr), value :: old_field_map 1643 integer(kind=c_int), value :: t_id_flag 1644 type(c_ptr), value :: read_flag 1645 ! integer(kind=c_int), dimension(*) :: read_flag ! (swap below to use) 1646 end subroutine cs_restart_read_variables 1647 1648 !--------------------------------------------------------------------------- 1649 1650 ! Interface to C function writing variables 1651 1652 subroutine cs_restart_write_variables(r, t_id_flag, write_flag) & 1653 bind(C, name='cs_restart_write_variables') 1654 use, intrinsic :: iso_c_binding 1655 implicit none 1656 type(c_ptr), value :: r 1657 integer(kind=c_int), value :: t_id_flag 1658 type(c_ptr), value :: write_flag 1659 ! integer(kind=c_int), dimension(*) :: write_flag ! (swap below to use) 1660 end subroutine cs_restart_write_variables 1661 1662 !--------------------------------------------------------------------------- 1663 1664 ! Interface to C function reading a cs_real_3_t vector section from a 1665 ! restart file, when that section may have used a different name and 1666 ! been non-interleaved in a previous version. 1667 1668 function cs_restart_read_real_3_t_compat(r, sec_name, & 1669 old_name_x, old_name_y, & 1670 old_name_z, location_id, & 1671 val) result(ierror) & 1672 bind(C, name='cs_restart_read_real_3_t_compat') 1673 use, intrinsic :: iso_c_binding 1674 implicit none 1675 type(c_ptr), value :: r 1676 character(kind=c_char, len=1), dimension(*), intent(in) :: sec_name 1677 character(kind=c_char, len=1), dimension(*), intent(in) :: old_name_x 1678 character(kind=c_char, len=1), dimension(*), intent(in) :: old_name_y 1679 character(kind=c_char, len=1), dimension(*), intent(in) :: old_name_z 1680 integer(c_int), value :: location_id 1681 real(kind=c_double), dimension(*) :: val 1682 integer(c_int) :: ierror 1683 end function cs_restart_read_real_3_t_compat 1684 1685 !--------------------------------------------------------------------------- 1686 1687 ! Interface to C function reading field values from a restart file, 1688 ! when that section may have used a different name and 1689 ! been non-interleaved in a previous version. 1690 1691 function cs_restart_read_field_vals(r, f_id, t_id) result(ierr) & 1692 bind(C, name='cs_restart_read_field_vals') 1693 use, intrinsic :: iso_c_binding 1694 implicit none 1695 type(c_ptr), value :: r 1696 integer(c_int), value :: f_id, t_id 1697 integer(c_int) :: ierr 1698 end function cs_restart_read_field_vals 1699 1700 !--------------------------------------------------------------------------- 1701 1702 ! Interface to C function writing field values to a restart file. 1703 1704 subroutine cs_restart_write_field_vals(r, f_id, t_id) & 1705 bind(C, name='cs_restart_write_field_vals') 1706 use, intrinsic :: iso_c_binding 1707 implicit none 1708 type(c_ptr), value :: r 1709 integer(c_int), value :: f_id, t_id 1710 end subroutine cs_restart_write_field_vals 1711 1712 !--------------------------------------------------------------------------- 1713 1714 ! Interface to C function reading fields depending on others from checkpoint 1715 1716 function cs_restart_read_linked_fields(r, old_field_map, key, read_flag) & 1717 result(n) & 1718 bind(C, name='cs_restart_read_linked_fields') 1719 use, intrinsic :: iso_c_binding 1720 implicit none 1721 type(c_ptr), value :: r 1722 type(c_ptr), value :: old_field_map 1723 character(kind=c_char, len=1), dimension(*), intent(in) :: key 1724 ! integer(kind=c_int), dimension(*) :: read_flag ! (swap below to use) 1725 type(c_ptr), value :: read_flag 1726 integer(c_int) :: n 1727 end function cs_restart_read_linked_fields 1728 1729 !--------------------------------------------------------------------------- 1730 1731 ! Interface to C function writing fields depending on others to a checkpoint 1732 1733 function cs_restart_write_linked_fields(r, key, write_flag) result(n) & 1734 bind(C, name='cs_restart_write_linked_fields') 1735 use, intrinsic :: iso_c_binding 1736 implicit none 1737 type(c_ptr), value :: r 1738 character(kind=c_char, len=1), dimension(*), intent(in) :: key 1739 ! integer(kind=c_int), dimension(*) :: write_flag ! (swap below to use) 1740 type(c_ptr), value :: write_flag 1741 integer(c_int) :: n 1742 end function cs_restart_write_linked_fields 1743 1744 !--------------------------------------------------------------------------- 1745 1746 ! Interface to C function calling sparse linear equation solver 1747 ! using native matrix arrays. 1748 1749 function cs_sles_solve_native(f_id, name, symmetric, & 1750 diag_block_size, extra_diag_block_size, & 1751 da, xa, precision, r_norm, & 1752 n_iter, residue, rhs, vx) result(state) & 1753 bind(C, name='cs_sles_solve_native') 1754 use, intrinsic :: iso_c_binding 1755 implicit none 1756 integer(c_int), value :: f_id 1757 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1758 logical(kind=c_bool), value :: symmetric 1759 integer(c_int), dimension(*) :: diag_block_size, extra_diag_block_size 1760 real(kind=c_double), value :: precision, r_norm 1761 integer(c_int), intent(out) :: n_iter 1762 real(kind=c_double), intent(out) :: residue 1763 real(kind=c_double), dimension(*), intent(in) :: da, xa, rhs 1764 real(kind=c_double), dimension(*), intent(inout) :: vx 1765 integer(c_int) :: state 1766 end function cs_sles_solve_native 1767 1768 !--------------------------------------------------------------------------- 1769 1770 ! Interface to C function freeing sparse linear equation solver setup 1771 ! using native matrix arrays. 1772 1773 subroutine cs_sles_free_native(f_id, name) & 1774 bind(C, name='cs_sles_free_native') 1775 use, intrinsic :: iso_c_binding 1776 implicit none 1777 integer(c_int), value :: f_id 1778 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1779 end subroutine cs_sles_free_native 1780 1781 !--------------------------------------------------------------------------- 1782 1783 ! Temporarily replace field id with name for matching calls 1784 ! to cs_sles_solve_native. 1785 1786 subroutine cs_sles_push(f_id, name) & 1787 bind(C, name='cs_sles_push') 1788 use, intrinsic :: iso_c_binding 1789 implicit none 1790 integer(c_int), value :: f_id 1791 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1792 end subroutine cs_sles_push 1793 1794 !--------------------------------------------------------------------------- 1795 1796 ! Revert to normal behavior of field id for matching calls 1797 ! to cs_sles_solve_native. 1798 1799 subroutine cs_sles_pop(f_id) & 1800 bind(C, name='cs_sles_pop') 1801 use, intrinsic :: iso_c_binding 1802 implicit none 1803 integer(c_int), value :: f_id 1804 end subroutine cs_sles_pop 1805 1806 !--------------------------------------------------------------------------- 1807 1808 ! Interface to C function defining statistic based on its name. 1809 1810 function cs_timer_stats_create(parent_name, name, label) result(id) & 1811 bind(C, name='cs_timer_stats_create') 1812 use, intrinsic :: iso_c_binding 1813 implicit none 1814 character(kind=c_char, len=1), dimension(*), intent(in) :: parent_name 1815 character(kind=c_char, len=1), dimension(*), intent(in) :: name, label 1816 integer(c_int) :: id 1817 end function cs_timer_stats_create 1818 1819 !--------------------------------------------------------------------------- 1820 1821 ! Interface to C function obtaining a defined statistic based on its name. 1822 1823 function cs_timer_stats_id_by_name(name) result(id) & 1824 bind(C, name='cs_timer_stats_id_by_name') 1825 use, intrinsic :: iso_c_binding 1826 implicit none 1827 character(kind=c_char, len=1), dimension(*), intent(in) :: name 1828 integer(c_int) :: id 1829 end function cs_timer_stats_id_by_name 1830 1831 !--------------------------------------------------------------------------- 1832 1833 ! Interface to C function computing turbulence rotation correction 1834 1835 subroutine cs_turbulence_rotation_correction(dt, rotfct, ce2rc) & 1836 bind(C, name='cs_turbulence_rotation_correction') 1837 use, intrinsic :: iso_c_binding 1838 implicit none 1839 real(kind=c_double), dimension(*) :: dt, rotfct, ce2rc 1840 end subroutine cs_turbulence_rotation_correction 1841 1842 !--------------------------------------------------------------------------- 1843 1844 ! Interface to C function creating a variable field 1845 1846 function cs_variable_field_create(name, label, & 1847 location_id, dim) result(id) & 1848 bind(C, name='cs_variable_field_create') 1849 use, intrinsic :: iso_c_binding 1850 implicit none 1851 character(kind=c_char, len=1), dimension(*), intent(in) :: name, label 1852 integer(c_int), value :: location_id 1853 integer(c_int), value :: dim 1854 integer(c_int) :: id 1855 end function cs_variable_field_create 1856 1857 !--------------------------------------------------------------------------- 1858 1859 ! Interface to C function creating a CDO variable field 1860 1861 function cs_variable_cdo_field_create(name, label, location_id, & 1862 dim, has_previous) result(id) & 1863 bind(C, name='cs_variable_cdo_field_create') 1864 use, intrinsic :: iso_c_binding 1865 implicit none 1866 character(kind=c_char, len=1), dimension(*), intent(in) :: name, label 1867 integer(c_int), value :: location_id 1868 integer(c_int), value :: has_previous 1869 integer(c_int), value :: dim 1870 integer(c_int) :: id 1871 end function cs_variable_cdo_field_create 1872 1873 !--------------------------------------------------------------------------- 1874 1875 ! Add terms from backward differentiation in time. 1876 1877 subroutine cs_backward_differentiation_in_time(field_id, & 1878 exp_part, imp_part) & 1879 bind(C, name='cs_backward_differentiation_in_time') 1880 use, intrinsic :: iso_c_binding 1881 implicit none 1882 integer(c_int), value :: field_id 1883 real(kind=c_double), dimension(*), intent(inout) :: exp_part, imp_part 1884 end subroutine cs_backward_differentiation_in_time 1885 1886 !--------------------------------------------------------------------------- 1887 ! Interface to C function for balance computation 1888 1889 subroutine cs_balance_by_zone(selection_crit, scalar_name) & 1890 bind(C, name='cs_balance_by_zone') 1891 use, intrinsic :: iso_c_binding 1892 implicit none 1893 character(kind=c_char, len=1), dimension(*), intent(in) :: selection_crit 1894 character(kind=c_char, len=1), dimension(*), intent(in) :: scalar_name 1895 end subroutine cs_balance_by_zone 1896 1897 !--------------------------------------------------------------------------- 1898 ! Interface to C function for balance computation 1899 1900 subroutine cs_pressure_drop_by_zone(selection_crit) & 1901 bind(C, name='cs_pressure_drop_by_zone') 1902 use, intrinsic :: iso_c_binding 1903 implicit none 1904 character(kind=c_char, len=1), dimension(*), intent(in) :: selection_crit 1905 end subroutine cs_pressure_drop_by_zone 1906 1907 !--------------------------------------------------------------------------- 1908 ! Interface to C function for balance computation 1909 1910 subroutine cs_surface_balance(selection_crit, scalar_name, normal) & 1911 bind(C, name='cs_surface_balance') 1912 use, intrinsic :: iso_c_binding 1913 implicit none 1914 character(kind=c_char, len=1), dimension(*), intent(in) :: selection_crit 1915 character(kind=c_char, len=1), dimension(*), intent(in) :: scalar_name 1916 real(kind=c_double), dimension(3), intent(in) :: normal 1917 end subroutine cs_surface_balance 1918 1919 !--------------------------------------------------------------------------- 1920 1921 ! Interface to C function building volume zones. 1922 1923 subroutine cs_volume_zone_build_all(mesh_modified) & 1924 bind(C, name='cs_volume_zone_build_all') 1925 use, intrinsic :: iso_c_binding 1926 implicit none 1927 logical(kind=c_bool), value :: mesh_modified 1928 end subroutine cs_volume_zone_build_all 1929 1930 !--------------------------------------------------------------------------- 1931 1932 ! Interface to C function returning the number of volume zones 1933 ! associated with a given zone flag 1934 1935 function cs_volume_zone_n_type_zones(type_flag) result(n) & 1936 bind(C, name='cs_volume_zone_n_type_zones') 1937 use, intrinsic :: iso_c_binding 1938 implicit none 1939 integer(c_int), value :: type_flag 1940 integer(c_int) :: n 1941 end function cs_volume_zone_n_type_zones 1942 1943 !--------------------------------------------------------------------------- 1944 1945 ! Interface to C function returning the number of volume zone cells 1946 ! associated with a given zone flag 1947 1948 function cs_volume_zone_n_type_cells(type_flag) result(n) & 1949 bind(C, name='cs_volume_zone_n_type_cells') 1950 use, intrinsic :: iso_c_binding 1951 implicit none 1952 integer(c_int), value :: type_flag 1953 integer(c_int) :: n 1954 end function cs_volume_zone_n_type_cells 1955 1956 !--------------------------------------------------------------------------- 1957 1958 ! Interface to C function selecting cells in volume zones. 1959 1960 subroutine cs_volume_zone_select_type_cells(type_flag, cell_ids) & 1961 bind(C, name='cs_volume_zone_select_type_cells') 1962 use, intrinsic :: iso_c_binding 1963 implicit none 1964 integer(c_int), value :: type_flag 1965 type(c_ptr), value :: cell_ids 1966 end subroutine cs_volume_zone_select_type_cells 1967 1968 !--------------------------------------------------------------------------- 1969 1970 ! Interface to C function building boundary zones. 1971 1972 subroutine cs_boundary_zone_build_all(mesh_modified) & 1973 bind(C, name='cs_boundary_zone_build_all') 1974 use, intrinsic :: iso_c_binding 1975 implicit none 1976 logical(kind=c_bool), value :: mesh_modified 1977 end subroutine cs_boundary_zone_build_all 1978 1979 !--------------------------------------------------------------------------- 1980 ! Interface to C user function for boundary conditions 1981 1982 subroutine user_boundary_conditions(nvar, bc_type, icodcl, rcodcl) & 1983 bind(C, name='cs_user_boundary_conditions') 1984 use, intrinsic :: iso_c_binding 1985 implicit none 1986 integer(c_int), value :: nvar 1987 integer(kind=c_int), dimension(*), intent(inout) :: bc_type 1988 integer(kind=c_int), dimension(*), intent(inout) :: icodcl 1989 real(kind=c_double), dimension(*), intent(inout) :: rcodcl 1990 end subroutine user_boundary_conditions 1991 1992 !--------------------------------------------------------------------------- 1993 1994 ! Interface to C user function for extra operations 1995 1996 subroutine user_extra_operations_initialize() & 1997 bind(C, name='cs_user_extra_operations_initialize_wrapper') 1998 use, intrinsic :: iso_c_binding 1999 implicit none 2000 end subroutine user_extra_operations_initialize 2001 2002 subroutine user_extra_operations() & 2003 bind(C, name='cs_user_extra_operations_wrapper') 2004 use, intrinsic :: iso_c_binding 2005 implicit none 2006 end subroutine user_extra_operations 2007 2008 !--------------------------------------------------------------------------- 2009 2010 ! Interface to C user function for initialization 2011 2012 subroutine user_initialization() & 2013 bind(C, name='cs_user_initialization_wrapper') 2014 use, intrinsic :: iso_c_binding 2015 implicit none 2016 end subroutine user_initialization 2017 2018 !--------------------------------------------------------------------------- 2019 2020 ! Interface to C user function for physical properties 2021 2022 subroutine user_physical_properties() & 2023 bind(C, name='cs_user_physical_properties_wrapper') 2024 use, intrinsic :: iso_c_binding 2025 implicit none 2026 end subroutine user_physical_properties 2027 2028 !--------------------------------------------------------------------------- 2029 2030 ! Interface to C user function 2031 2032 subroutine user_source_terms(f_id, st_exp, st_imp) & 2033 bind(C, name='cs_user_source_terms_wrapper') 2034 use, intrinsic :: iso_c_binding 2035 implicit none 2036 integer(c_int), value :: f_id 2037 real(kind=c_double), dimension(*), intent(inout) :: st_exp, st_imp 2038 end subroutine user_source_terms 2039 2040 !--------------------------------------------------------------------------- 2041 2042 ! Interface to C user function for user arrays 2043 2044 subroutine cs_gui_user_arrays() & 2045 bind(C, name='cs_gui_user_arrays') 2046 use, intrinsic :: iso_c_binding 2047 implicit none 2048 end subroutine cs_gui_user_arrays 2049 2050 !--------------------------------------------------------------------------- 2051 2052 ! Interface to C user function for physical model options 2053 2054 subroutine cs_user_model() & 2055 bind(C, name='cs_user_model') 2056 use, intrinsic :: iso_c_binding 2057 implicit none 2058 end subroutine cs_user_model 2059 2060 !--------------------------------------------------------------------------- 2061 2062 ! Interface to C user function for time moments 2063 2064 subroutine cs_user_time_moments() & 2065 bind(C, name='cs_user_time_moments') 2066 use, intrinsic :: iso_c_binding 2067 implicit none 2068 end subroutine cs_user_time_moments 2069 2070 !--------------------------------------------------------------------------- 2071 2072 ! Interface to C function for the destruction of a locator structure. 2073 2074 function ple_locator_destroy(this_locator) result (l) & 2075 bind(C, name='ple_locator_destroy') 2076 use, intrinsic :: iso_c_binding 2077 implicit none 2078 type(c_ptr), value :: this_locator 2079 type(c_ptr) :: l 2080 end function ple_locator_destroy 2081 2082 !--------------------------------------------------------------------------- 2083 2084 ! Interface to C function cs_equation_iterative_solve_scalar 2085 2086 subroutine cs_equation_iterative_solve_scalar(idtvar, iterns, & 2087 f_id, name, & 2088 iescap, imucpp, normp, & 2089 vcopt, pvara, pvark, & 2090 coefap, coefbp, cofafp, & 2091 cofbfp, i_massflux, & 2092 b_massflux, i_viscm, & 2093 b_viscm, i_visc, b_visc, & 2094 viscel, weighf, weighb, & 2095 icvflb, icvfli, & 2096 rovsdt, smbrp, pvar, dpvar, & 2097 xcpp, eswork) & 2098 bind(C, name='cs_equation_iterative_solve_scalar') 2099 use, intrinsic :: iso_c_binding 2100 implicit none 2101 integer(c_int), value :: idtvar, iterns, f_id, iescap, imucpp 2102 real(kind=c_double), value :: normp 2103 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2104 type(c_ptr), value :: vcopt 2105 real(kind=c_double), dimension(*), intent(in) :: pvara, pvark, coefap 2106 real(kind=c_double), dimension(*), intent(in) :: coefbp, cofafp, cofbfp 2107 real(kind=c_double), dimension(*), intent(in) :: i_massflux, b_massflux 2108 real(kind=c_double), dimension(*), intent(in) :: i_viscm, b_viscm 2109 real(kind=c_double), dimension(*), intent(in) :: i_visc, b_visc, viscel 2110 real(kind=c_double), dimension(*), intent(in) :: weighf, weighb 2111 integer(c_int), value :: icvflb 2112 integer(c_int), dimension(*), intent(in) :: icvfli 2113 real(kind=c_double), dimension(*), intent(in) :: rovsdt, xcpp 2114 real(kind=c_double), dimension(*), intent(inout) :: smbrp, pvar, dpvar 2115 real(kind=c_double), dimension(*), intent(inout) :: eswork 2116 end subroutine cs_equation_iterative_solve_scalar 2117 2118 !--------------------------------------------------------------------------- 2119 2120 ! Interface to C function cs_equation_iterative_solve_vector 2121 2122 subroutine cs_equation_iterative_solve_vector(idtvar, iterns, & 2123 f_id, name, & 2124 ivisep, iescap, & 2125 vcopt, pvara, pvark, & 2126 coefav, coefbv, cofafv, & 2127 cofbfv, i_massflux, & 2128 b_massflux, i_viscm, & 2129 b_viscm, i_visc, b_visc, & 2130 secvif, secvib, & 2131 viscce, weighf, weighb, & 2132 icvflb, icvfli, fimp, & 2133 smbrp, pvar, eswork) & 2134 bind(C, name='cs_equation_iterative_solve_vector') 2135 use, intrinsic :: iso_c_binding 2136 implicit none 2137 integer(c_int), value :: idtvar, iterns, f_id, iescap, ivisep 2138 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2139 type(c_ptr), value :: vcopt 2140 real(kind=c_double), dimension(*), intent(in) :: pvara, pvark, coefav 2141 real(kind=c_double), dimension(*), intent(in) :: coefbv, cofafv, cofbfv 2142 real(kind=c_double), dimension(*), intent(in) :: i_massflux, b_massflux 2143 real(kind=c_double), dimension(*), intent(in) :: i_visc, b_visc 2144 real(kind=c_double), dimension(*), intent(in) :: i_viscm, b_viscm 2145 real(kind=c_double), dimension(*), intent(in) :: secvif, secvib 2146 real(kind=c_double), dimension(*), intent(in) :: viscce 2147 real(kind=c_double), dimension(*), intent(in) :: weighf, weighb 2148 integer(c_int), value :: icvflb 2149 integer(c_int), dimension(*), intent(in) :: icvfli 2150 real(kind=c_double), dimension(*), intent(inout) :: fimp 2151 real(kind=c_double), dimension(*), intent(inout) :: smbrp, pvar, eswork 2152 end subroutine cs_equation_iterative_solve_vector 2153 2154 !--------------------------------------------------------------------------- 2155 2156 ! Interface to C function cs_equation_iterative_solve_tensor 2157 2158 subroutine cs_equation_iterative_solve_tensor(idtvar, f_id, name, & 2159 vcopt, pvara, pvark, & 2160 coefats, coefbts, cofafts, & 2161 cofbfts, i_massflux, & 2162 b_massflux, i_viscm, & 2163 b_viscm, i_visc, b_visc, & 2164 viscce, weighf, weighb, & 2165 icvflb, icvfli, & 2166 fimp, smbrp, pvar) & 2167 bind(C, name='cs_equation_iterative_solve_tensor') 2168 use, intrinsic :: iso_c_binding 2169 implicit none 2170 integer(c_int), value :: idtvar, f_id 2171 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2172 type(c_ptr), value :: vcopt 2173 real(kind=c_double), dimension(*), intent(in) :: pvara, pvark, coefats 2174 real(kind=c_double), dimension(*), intent(in) :: coefbts, cofafts, cofbfts 2175 real(kind=c_double), dimension(*), intent(in) :: i_massflux, b_massflux 2176 real(kind=c_double), dimension(*), intent(in) :: i_visc, b_visc 2177 real(kind=c_double), dimension(*), intent(in) :: i_viscm, b_viscm 2178 real(kind=c_double), dimension(*), intent(in) :: viscce 2179 real(kind=c_double), dimension(*), intent(in) :: weighf, weighb 2180 integer(c_int), value :: icvflb 2181 integer(c_int), dimension(*), intent(in) :: icvfli 2182 real(kind=c_double), dimension(*), intent(in) :: fimp 2183 real(kind=c_double), dimension(*), intent(inout) :: smbrp, pvar 2184 end subroutine cs_equation_iterative_solve_tensor 2185 2186 !--------------------------------------------------------------------------- 2187 2188 ! Interface to C function cs_clip_turbulent_fluxes 2189 2190 subroutine cs_clip_turbulent_fluxes(flux_id, variance_id) & 2191 bind(C, name='cs_clip_turbulent_fluxes') 2192 use, intrinsic :: iso_c_binding 2193 implicit none 2194 integer(c_int), value :: flux_id 2195 integer(c_int), value :: variance_id 2196 end subroutine cs_clip_turbulent_fluxes 2197 2198 !--------------------------------------------------------------------------- 2199 2200 ! Interface to C function cs_balance_scalar 2201 2202 subroutine cs_balance_scalar(idtvar, f_id , imucpp, imasac, inc, & 2203 iccocg, vcopt , pvar , pvara, & 2204 coefap, coefbp, cofafp, cofbfp, i_massflux, & 2205 b_massflux, i_visc, b_visc, viscel, xcpp, & 2206 weighf, weighb, icvflb, icvfli, & 2207 smbrp) & 2208 bind(C, name='cs_balance_scalar') 2209 use, intrinsic :: iso_c_binding 2210 implicit none 2211 integer(c_int), value :: idtvar, f_id, imasac, imucpp, inc 2212 integer(c_int), value :: iccocg 2213 type(c_ptr), value :: vcopt 2214 real(kind=c_double), dimension(*), intent(in) :: pvar, pvara, coefap 2215 real(kind=c_double), dimension(*), intent(in) :: coefbp, cofafp, cofbfp 2216 real(kind=c_double), dimension(*), intent(in) :: i_massflux, b_massflux 2217 real(kind=c_double), dimension(*), intent(in) :: i_visc, b_visc, viscel 2218 real(kind=c_double), dimension(*), intent(in) :: weighf, weighb, xcpp 2219 integer(c_int), value :: icvflb 2220 integer(c_int), dimension(*), intent(in) :: icvfli 2221 real(kind=c_double), dimension(*), intent(inout) :: smbrp 2222 end subroutine cs_balance_scalar 2223 2224 !--------------------------------------------------------------------------- 2225 2226 ! Interface to C function cs_balance_vector 2227 2228 subroutine cs_balance_vector(idtvar, f_id, imasac, inc, ivisep, & 2229 vcopt, pvar, pvara, coefav, coefbv, cofafv, & 2230 cofbfv, i_massflux, b_massflux, i_visc, & 2231 b_visc, secvif, secvib, viscel, & 2232 weighf, weighb, icvflb, icvfli, & 2233 smbrp) & 2234 bind(C, name='cs_balance_vector') 2235 use, intrinsic :: iso_c_binding 2236 implicit none 2237 integer(c_int), value :: idtvar, f_id, imasac, inc 2238 integer(c_int), value :: ivisep 2239 type(c_ptr), value :: vcopt 2240 real(kind=c_double), dimension(*), intent(in) :: pvar, pvara, coefav 2241 real(kind=c_double), dimension(*), intent(in) :: coefbv, cofafv, cofbfv 2242 real(kind=c_double), dimension(*), intent(in) :: i_massflux, b_massflux 2243 real(kind=c_double), dimension(*), intent(in) :: i_visc, b_visc, viscel 2244 real(kind=c_double), dimension(*), intent(in) :: secvif, secvib 2245 real(kind=c_double), dimension(*), intent(in) :: weighf, weighb 2246 integer(c_int), value :: icvflb 2247 integer(c_int), dimension(*), intent(in) :: icvfli 2248 real(kind=c_double), dimension(*), intent(inout) :: smbrp 2249 end subroutine cs_balance_vector 2250 2251 !--------------------------------------------------------------------------- 2252 2253 !> \brief Read lagrangian moments checkpoint information. 2254 2255 subroutine lagr_moment_restart_read(r) & 2256 bind(C, name='cs_lagr_moment_restart_read') 2257 use, intrinsic :: iso_c_binding 2258 implicit none 2259 type(c_ptr), value :: r 2260 end subroutine lagr_moment_restart_read 2261 2262 !--------------------------------------------------------------------------- 2263 2264 !> \brief Add a species field to the gas mix (set of fields). 2265 2266 subroutine gas_mix_add_species(f_id) & 2267 bind(C, name='cs_gas_mix_add_species') 2268 use, intrinsic :: iso_c_binding 2269 implicit none 2270 integer(c_int), value :: f_id 2271 end subroutine gas_mix_add_species 2272 2273 !--------------------------------------------------------------------------- 2274 2275 !> \brief Free array mapping gas mix species ids to field ids. 2276 2277 subroutine finalize_gas_mix() & 2278 bind(C, name='cs_gas_mix_finalize') 2279 use, intrinsic :: iso_c_binding 2280 implicit none 2281 end subroutine finalize_gas_mix 2282 2283 !--------------------------------------------------------------------------- 2284 2285 !> \brief Create global 1d wall thermal model structure. 2286 2287 subroutine cs_1d_wall_thermal_create() & 2288 bind(C, name='cs_1d_wall_thermal_create') 2289 use, intrinsic :: iso_c_binding 2290 implicit none 2291 end subroutine cs_1d_wall_thermal_create 2292 2293 !--------------------------------------------------------------------------- 2294 2295 !> \brief Allocate the array of structures local_models. 2296 2297 subroutine init_1d_wall_thermal_local_models() & 2298 bind(C, name='cs_1d_wall_thermal_local_models_create') 2299 use, intrinsic :: iso_c_binding 2300 implicit none 2301 end subroutine init_1d_wall_thermal_local_models 2302 2303 !--------------------------------------------------------------------------- 2304 2305 !> \brief Create the 1D mesh for each face and initialize the temperature. 2306 2307 subroutine cs_1d_wall_thermal_mesh_create() & 2308 bind(C, name='cs_1d_wall_thermal_mesh_create') 2309 use, intrinsic :: iso_c_binding 2310 implicit none 2311 end subroutine cs_1d_wall_thermal_mesh_create 2312 2313 !--------------------------------------------------------------------------- 2314 2315 !> \brief Solve the 1D equation for a given face. 2316 2317 !> \param[in] ii face number 2318 !> \param[in] tf fluid temperature at the boundarys 2319 !> \param[in] hf exchange coefficient for the fluid 2320 2321 subroutine cs_1d_wall_thermal_solve(ii, tf, hf) & 2322 bind(C, name='cs_1d_wall_thermal_solve') 2323 use, intrinsic :: iso_c_binding 2324 implicit none 2325 integer(c_int), value :: ii 2326 real(kind=c_double), value :: tf, hf 2327 end subroutine cs_1d_wall_thermal_solve 2328 2329 !--------------------------------------------------------------------------- 2330 2331 !> \brief Read the restart file of the 1D-wall thermal module. 2332 2333 subroutine cs_1d_wall_thermal_read() & 2334 bind(C, name='cs_1d_wall_thermal_read') 2335 use, intrinsic :: iso_c_binding 2336 implicit none 2337 end subroutine cs_1d_wall_thermal_read 2338 2339 !--------------------------------------------------------------------------- 2340 2341 !> \brief Write the restart file of the 1D-wall thermal module. 2342 2343 subroutine cs_1d_wall_thermal_write() & 2344 bind(C, name='cs_1d_wall_thermal_write') 2345 use, intrinsic :: iso_c_binding 2346 implicit none 2347 end subroutine cs_1d_wall_thermal_write 2348 2349 !--------------------------------------------------------------------------- 2350 2351 !> \brief Free members of the global 1d wall thermal structure. 2352 2353 subroutine cs_1d_wall_thermal_free() & 2354 bind(C, name='cs_1d_wall_thermal_free') 2355 use, intrinsic :: iso_c_binding 2356 implicit none 2357 end subroutine cs_1d_wall_thermal_free 2358 2359 !--------------------------------------------------------------------------- 2360 2361 !> \brief Destroy the global 1d wall thermal structure. 2362 2363 subroutine cs_1d_wall_thermal_finalize() & 2364 bind(C, name='cs_1d_wall_thermal_finalize') 2365 use, intrinsic :: iso_c_binding 2366 implicit none 2367 end subroutine cs_1d_wall_thermal_finalize 2368 2369 !--------------------------------------------------------------------------- 2370 2371 !> \brief Data Entry of the 1D wall thermal module. 2372 2373 !> \param[in] iappel Call number 2374 !> \param[in] isuit1 Restart caculation or not 2375 2376 subroutine cs_user_1d_wall_thermal(iappel, isuit1) & 2377 bind(C, name='cs_user_1d_wall_thermal') 2378 use, intrinsic :: iso_c_binding 2379 implicit none 2380 integer(c_int), value :: iappel, isuit1 2381 end subroutine cs_user_1d_wall_thermal 2382 2383 !--------------------------------------------------------------------------- 2384 2385 !> \brief Return pointers to nfpt1d and nfpt1t. 2386 2387 !> \param[out] nfpt1d Pointer to nfpt1d 2388 !> \param[out] nfpt1t Pointer to nfpt1t 2389 2390 subroutine cs_f_1d_wall_thermal_get_pointers(nfpt1d, nfpt1t) & 2391 bind(C, name='cs_f_1d_wall_thermal_get_pointers') 2392 use, intrinsic :: iso_c_binding 2393 implicit none 2394 type(c_ptr), intent(out) :: nfpt1d, nfpt1t 2395 end subroutine cs_f_1d_wall_thermal_get_pointers 2396 2397 !--------------------------------------------------------------------------- 2398 2399 !> \brief Data checking for the 1D thermal wall module. 2400 2401 !> \param[in] iappel Call number 2402 !> \param[in] isuit1 Restart caculation or not 2403 2404 subroutine cs_1d_wall_thermal_check(iappel, isuit1) & 2405 bind(C, name='cs_1d_wall_thermal_check') 2406 use, intrinsic :: iso_c_binding 2407 implicit none 2408 integer(c_int), value :: iappel, isuit1 2409 end subroutine cs_1d_wall_thermal_check 2410 2411 !--------------------------------------------------------------------------- 2412 2413 !> \brief Return a pointer to the ifpt1d array. 2414 2415 !> \param[out] ifpt1d Pointer to ifpt1d 2416 2417 subroutine cs_f_1d_wall_thermal_get_faces(ifpt1d) & 2418 bind(C, name='cs_f_1d_wall_thermal_get_faces') 2419 use, intrinsic :: iso_c_binding 2420 implicit none 2421 type(c_ptr), intent(out) :: ifpt1d 2422 end subroutine cs_f_1d_wall_thermal_get_faces 2423 2424 !--------------------------------------------------------------------------- 2425 2426 !> \brief Return a pointer to the tppt1d array. 2427 2428 !> \param[out] tppt1d Pointer to tppt1d 2429 2430 subroutine cs_f_1d_wall_thermal_get_temp(tppt1d) & 2431 bind(C, name='cs_f_1d_wall_thermal_get_temp') 2432 use, intrinsic :: iso_c_binding 2433 implicit none 2434 type(c_ptr), intent(out) :: tppt1d 2435 end subroutine cs_f_1d_wall_thermal_get_temp 2436 2437 !--------------------------------------------------------------------------- 2438 2439 !> \brief Binding to cs_gui_internal_coupling 2440 2441 subroutine cs_gui_internal_coupling() & 2442 bind(C, name='cs_gui_internal_coupling') 2443 use, intrinsic :: iso_c_binding 2444 implicit none 2445 end subroutine cs_gui_internal_coupling 2446 2447 !--------------------------------------------------------------------------- 2448 2449 !> \brief Binding to cs_user_internal_coupling 2450 2451 subroutine cs_user_internal_coupling() & 2452 bind(C, name='cs_user_internal_coupling') 2453 use, intrinsic :: iso_c_binding 2454 implicit none 2455 end subroutine cs_user_internal_coupling 2456 2457 !--------------------------------------------------------------------------- 2458 2459 !> \brief Binding to cs_user_internal_coupling 2460 2461 subroutine cs_internal_coupling_setup() & 2462 bind(C, name='cs_internal_coupling_setup') 2463 use, intrinsic :: iso_c_binding 2464 implicit none 2465 end subroutine cs_internal_coupling_setup 2466 2467 !--------------------------------------------------------------------------- 2468 2469 !> \brief Binding to cs_ic_field_set_exchcoeff 2470 2471 !> \param[in] field_id field id 2472 !> \param[in] hbnd boundary exchange coefficients passed by face id 2473 2474 subroutine cs_ic_field_set_exchcoeff(field_id, & 2475 hbnd) & 2476 bind(C, name='cs_ic_field_set_exchcoeff') 2477 use, intrinsic :: iso_c_binding 2478 implicit none 2479 integer(kind=c_int), value :: field_id 2480 real(kind=c_double), dimension(*), intent(in) :: hbnd 2481 end subroutine cs_ic_field_set_exchcoeff 2482 2483 !--------------------------------------------------------------------------- 2484 2485 ! Binding to cs_f_ic_field_coupled_faces 2486 2487 subroutine cs_f_ic_field_coupled_faces(f_id, c_p) & 2488 bind(C, name='cs_f_ic_field_coupled_faces') 2489 use, intrinsic :: iso_c_binding 2490 implicit none 2491 integer(kind=c_int), value :: f_id 2492 type(c_ptr), intent(out) :: c_p 2493 end subroutine cs_f_ic_field_coupled_faces 2494 2495 !--------------------------------------------------------------------------- 2496 2497 !> \brief Binding to cs_ic_field_dist_data_by_face_id 2498 2499 !> \param[in] field_id field id 2500 !> \param[in] stride number of values (interlaced) by entity 2501 !> \param[in] tab_distant exchanged data by face id 2502 !> \param[out] tab_local local data by face id 2503 2504 subroutine cs_ic_field_dist_data_by_face_id(field_id, & 2505 stride, & 2506 tab_distant, & 2507 tab_local) & 2508 bind(C, name='cs_ic_field_dist_data_by_face_id') 2509 use, intrinsic :: iso_c_binding 2510 implicit none 2511 integer(kind=c_int), value :: field_id, stride 2512 real(kind=c_double), dimension(*), intent(in) :: tab_distant 2513 real(kind=c_double), dimension(*), intent(out) :: tab_local 2514 end subroutine cs_ic_field_dist_data_by_face_id 2515 2516 !--------------------------------------------------------------------------- 2517 2518 !> \brief Binding to cs_internal_coupling_dump 2519 2520 subroutine cs_internal_coupling_dump() & 2521 bind(C, name='cs_internal_coupling_dump') 2522 use, intrinsic :: iso_c_binding 2523 implicit none 2524 end subroutine cs_internal_coupling_dump 2525 2526 !--------------------------------------------------------------------------- 2527 2528 ! Interface to C function handling BCs for internal coupling 2529 2530 subroutine cs_internal_coupling_bcs(bc_type) & 2531 bind(C, name='cs_internal_coupling_bcs') 2532 use, intrinsic :: iso_c_binding 2533 implicit none 2534 integer(kind=c_int), dimension(*) :: bc_type 2535 end subroutine cs_internal_coupling_bcs 2536 2537 !--------------------------------------------------------------------------- 2538 2539 !> \brief Check calculation parameters. 2540 2541 subroutine parameters_check() & 2542 bind(C, name='cs_parameters_check') 2543 use, intrinsic :: iso_c_binding 2544 implicit none 2545 end subroutine parameters_check 2546 2547 !--------------------------------------------------------------------------- 2548 2549 !> \brief Initialize aerosol external code (shared library) 2550 2551 subroutine cs_atmo_aerosol_initialize() & 2552 bind(C, name='cs_atmo_aerosol_initialize') 2553 use, intrinsic :: iso_c_binding 2554 implicit none 2555 end subroutine cs_atmo_aerosol_initialize 2556 2557 !--------------------------------------------------------------------------- 2558 2559 !> \brief Compute gas chemistry + aerosol dynamic with external code 2560 2561 subroutine cs_atmo_aerosol_time_advance() & 2562 bind(C, name='cs_atmo_aerosol_time_advance') 2563 use, intrinsic :: iso_c_binding 2564 implicit none 2565 end subroutine cs_atmo_aerosol_time_advance 2566 2567 !--------------------------------------------------------------------------- 2568 2569 !> \brief Get the aerosols concentrations and numbers from aerosol code 2570 2571 subroutine cs_atmo_aerosol_get_aero(array) & 2572 bind(C, name='cs_atmo_aerosol_get_aero') 2573 use, intrinsic :: iso_c_binding 2574 implicit none 2575 real(kind=c_double), dimension(*), intent(out) :: array 2576 end subroutine cs_atmo_aerosol_get_aero 2577 2578 !--------------------------------------------------------------------------- 2579 2580 !> \brief Get the gas concentrations from aerosol code 2581 2582 subroutine cs_atmo_aerosol_get_gas(array) & 2583 bind(C, name='cs_atmo_aerosol_get_gas') 2584 use, intrinsic :: iso_c_binding 2585 implicit none 2586 real(kind=c_double), dimension(*), intent(out) :: array 2587 end subroutine cs_atmo_aerosol_get_gas 2588 2589 !--------------------------------------------------------------------------- 2590 2591 !> \brief Compute the relative ground elevation (mainly for the atmospheric 2592 !> module). 2593 2594 subroutine cs_atmo_z_ground_compute() & 2595 bind(C, name='cs_atmo_z_ground_compute') 2596 use, intrinsic :: iso_c_binding 2597 implicit none 2598 end subroutine cs_atmo_z_ground_compute 2599 2600 !--------------------------------------------------------------------------- 2601 2602 !> \brief Return pointers to atmo chemistry arrays 2603 2604 subroutine cs_f_atmo_chem_arrays_get_pointers(isca_chem, dmmk, & 2605 chempoint) & 2606 bind(C, name='cs_f_atmo_chem_arrays_get_pointers') 2607 use, intrinsic :: iso_c_binding 2608 implicit none 2609 type(c_ptr), intent(out) :: isca_chem, dmmk, chempoint 2610 end subroutine cs_f_atmo_chem_arrays_get_pointers 2611 2612 !--------------------------------------------------------------------------- 2613 2614 !> \brief Return pointers to atmo arrays 2615 2616 subroutine cs_f_atmo_arrays_get_pointers(p_ztmet, p_tmmet, & 2617 p_phmet, dim_phmet) & 2618 bind(C, name='cs_f_atmo_arrays_get_pointers') 2619 use, intrinsic :: iso_c_binding 2620 implicit none 2621 integer(c_int), dimension(2) :: dim_phmet 2622 type(c_ptr), intent(out) :: p_ztmet, p_tmmet, p_phmet 2623 end subroutine cs_f_atmo_arrays_get_pointers 2624 2625 !--------------------------------------------------------------------------- 2626 2627 !> \brief Deallocate arrays for atmo chemistry 2628 2629 subroutine cs_f_atmo_chem_finalize() & 2630 bind(C, name='cs_f_atmo_chem_finalize') 2631 use, intrinsic :: iso_c_binding 2632 implicit none 2633 end subroutine cs_f_atmo_chem_finalize 2634 2635 !--------------------------------------------------------------------------- 2636 2637 !> \brief Sets the meteo file name 2638 2639 subroutine cs_atmo_set_meteo_file_name(name) & 2640 bind(C, name='cs_atmo_set_meteo_file_name') 2641 use, intrinsic :: iso_c_binding 2642 implicit none 2643 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2644 end subroutine cs_atmo_set_meteo_file_name 2645 2646 !--------------------------------------------------------------------------- 2647 2648 !> \brief Sets the chemistry concentration file name 2649 2650 subroutine cs_atmo_set_chem_conc_file_name(name) & 2651 bind(C, name='cs_atmo_set_chem_conc_file_name') 2652 use, intrinsic :: iso_c_binding 2653 implicit none 2654 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2655 end subroutine cs_atmo_set_chem_conc_file_name 2656 2657 !--------------------------------------------------------------------------- 2658 2659 !> \brief Sets the aerosol concentration file name 2660 2661 subroutine cs_atmo_set_aero_conc_file_name(name) & 2662 bind(C, name='cs_atmo_set_aero_conc_file_name') 2663 use, intrinsic :: iso_c_binding 2664 implicit none 2665 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2666 end subroutine cs_atmo_set_aero_conc_file_name 2667 2668 !--------------------------------------------------------------------------- 2669 2670 !> \brief Sets the file name used to initialize SPACK 2671 2672 subroutine cs_atmo_chemistry_set_spack_file_name(name) & 2673 bind(C, name='cs_atmo_chemistry_set_spack_file_name') 2674 use, intrinsic :: iso_c_binding 2675 implicit none 2676 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2677 end subroutine cs_atmo_chemistry_set_spack_file_name 2678 2679 !--------------------------------------------------------------------------- 2680 2681 !> \brief Sets the file name used to initialize the aerosol shared library 2682 2683 subroutine cs_atmo_chemistry_set_aerosol_file_name(name) & 2684 bind(C, name='cs_atmo_chemistry_set_aerosol_file_name') 2685 use, intrinsic :: iso_c_binding 2686 implicit none 2687 character(kind=c_char, len=1), dimension(*), intent(in) :: name 2688 end subroutine cs_atmo_chemistry_set_aerosol_file_name 2689 2690 !--------------------------------------------------------------------------- 2691 2692 !> \brief Declare chemistry variables from SPACK 2693 2694 subroutine cs_atmo_declare_chem_from_spack() & 2695 bind(C, name='cs_atmo_declare_chem_from_spack') 2696 use, intrinsic :: iso_c_binding 2697 implicit none 2698 end subroutine cs_atmo_declare_chem_from_spack 2699 2700 !--------------------------------------------------------------------------- 2701 2702 ! Interface to C function for atmo 2703 2704 subroutine raysze(xlat, xlong, jour, heurtu, imer, albe, muzero, omega, fo) & 2705 bind(C, name='cs_atmo_compute_solar_angles') 2706 use, intrinsic :: iso_c_binding 2707 implicit none 2708 real(kind=c_double), value :: xlat, xlong, jour, heurtu 2709 integer(kind=c_int), value :: imer 2710 real(kind=c_double), intent(inout) :: albe, muzero, omega, fo 2711 end subroutine raysze 2712 2713 !--------------------------------------------------------------------------- 2714 2715 !> \brief Initialize C chemistry structure from Fortran 2716 2717 subroutine cs_f_atmo_chem_initialize_species_to_fid(species_fid) & 2718 bind(C, name='cs_f_atmo_chem_initialize_species_to_fid') 2719 use, intrinsic :: iso_c_binding 2720 implicit none 2721 integer(c_int), dimension(*), intent(in) :: species_fid 2722 end subroutine cs_f_atmo_chem_initialize_species_to_fid 2723 2724 !--------------------------------------------------------------------------- 2725 2726 ! Interface to C user function for cooling tower 2727 2728 subroutine cs_ctwr_field_pointer_map() & 2729 bind(C, name='cs_ctwr_field_pointer_map') 2730 use, intrinsic :: iso_c_binding 2731 implicit none 2732 end subroutine cs_ctwr_field_pointer_map 2733 2734 !--------------------------------------------------------------------------- 2735 2736 ! Interface to C function for cooling towers 2737 2738 subroutine cs_ctwr_init_field_vars(rho0, t0, p0, molmassrat) & 2739 bind(C, name='cs_ctwr_init_field_vars') 2740 use, intrinsic :: iso_c_binding 2741 implicit none 2742 real(kind=c_double), value :: rho0, t0, p0, molmassrat 2743 end subroutine cs_ctwr_init_field_vars 2744 2745 !--------------------------------------------------------------------------- 2746 2747 ! Interface to C function for cooling towers 2748 2749 subroutine cs_ctwr_restart_field_vars(rho0, t0, p0, humidity0, molmassrat) & 2750 bind(C, name='cs_ctwr_restart_field_vars') 2751 use, intrinsic :: iso_c_binding 2752 implicit none 2753 real(kind=c_double), value :: rho0, t0, p0, humidity0, molmassrat 2754 end subroutine cs_ctwr_restart_field_vars 2755 2756 !--------------------------------------------------------------------------- 2757 2758 ! Interface to C function for cooling towers 2759 2760 subroutine cs_ctwr_phyvar_update(rho0, t0, p0, molmassrat) & 2761 bind(C, name='cs_ctwr_phyvar_update') 2762 use, intrinsic :: iso_c_binding 2763 implicit none 2764 real(kind=c_double), value :: rho0, t0, p0, molmassrat 2765 end subroutine cs_ctwr_phyvar_update 2766 2767 !--------------------------------------------------------------------------- 2768 2769 ! Interface to C function for cooling towers 2770 2771 subroutine cs_ctwr_init_flow_vars(liq_mass_flow) & 2772 bind(C, name='cs_ctwr_init_flow_vars') 2773 use, intrinsic :: iso_c_binding 2774 implicit none 2775 real(kind=c_double), dimension(*), intent(inout) :: liq_mass_flow 2776 end subroutine cs_ctwr_init_flow_vars 2777 2778 !--------------------------------------------------------------------------- 2779 2780 ! Interface to C function for cooling towers 2781 2782 subroutine cs_ctwr_bulk_mass_source_term(p0, molmassrat, & 2783 mass_source) & 2784 bind(C, name='cs_ctwr_bulk_mass_source_term') 2785 use, intrinsic :: iso_c_binding 2786 implicit none 2787 real(kind=c_double), value :: p0, molmassrat 2788 real(kind=c_double), dimension(*), intent(inout) :: mass_source 2789 end subroutine cs_ctwr_bulk_mass_source_term 2790 2791 !--------------------------------------------------------------------------- 2792 2793 ! Interface to C function for cooling towers 2794 2795 subroutine cs_ctwr_source_term(f_id, p0, molmassrat, & 2796 exp_st, imp_st) & 2797 bind(C, name='cs_ctwr_source_term') 2798 use, intrinsic :: iso_c_binding 2799 implicit none 2800 integer(c_int), value :: f_id 2801 real(kind=c_double), value :: p0, molmassrat 2802 real(kind=c_double), dimension(*), intent(inout) :: exp_st 2803 real(kind=c_double), dimension(*), intent(inout) :: imp_st 2804 end subroutine cs_ctwr_source_term 2805 2806 !--------------------------------------------------------------------------- 2807 2808 ! Interface to C function for head losses 2809 2810 subroutine cs_head_losses_compute(ckupdc) & 2811 bind(C, name='cs_head_losses_compute') 2812 use, intrinsic :: iso_c_binding 2813 implicit none 2814 real(kind=c_double), dimension(*) :: ckupdc 2815 end subroutine cs_head_losses_compute 2816 2817 !--------------------------------------------------------------------------- 2818 2819 ! Interface to C function cs_f_math_sym_33_inv_cramer 2820 2821 subroutine symmetric_matrix_inverse(s, sout) & 2822 bind(C, name='cs_f_math_sym_33_inv_cramer') 2823 use, intrinsic :: iso_c_binding 2824 implicit none 2825 real(kind=c_double), dimension(*), intent(in) :: s 2826 real(kind=c_double), dimension(*), intent(out) :: sout 2827 end subroutine symmetric_matrix_inverse 2828 2829 !--------------------------------------------------------------------------- 2830 2831 ! Interface to C function cs_f_math_sym_33_product 2832 2833 subroutine symmetric_matrix_product(s1, s2, sout) & 2834 bind(C, name='cs_f_math_sym_33_product') 2835 use, intrinsic :: iso_c_binding 2836 implicit none 2837 real(kind=c_double), dimension(*), intent(in) :: s1, s2 2838 real(kind=c_double), dimension(*), intent(out) :: sout 2839 end subroutine symmetric_matrix_product 2840 2841 !--------------------------------------------------------------------------- 2842 2843 ! Interface to C function cs_f_math_reduce_symprod33_to_66 2844 2845 subroutine reduce_symprod33_to_66(s, sout) & 2846 bind(C, name='cs_f_math_reduce_sym_prod_33_to_66') 2847 use, intrinsic :: iso_c_binding 2848 implicit none 2849 real(kind=c_double), dimension(*), intent(in) :: s 2850 real(kind=c_double), dimension(*), intent(out) :: sout 2851 end subroutine reduce_symprod33_to_66 2852 2853 !--------------------------------------------------------------------------- 2854 2855 ! Interface to C function cs_math_sym_33_eigen 2856 2857 subroutine calc_symtens_eigvals(m, eig_vals) & 2858 bind(C, name='cs_math_sym_33_eigen') 2859 use, intrinsic :: iso_c_binding 2860 implicit none 2861 real(kind=c_double), dimension(*), intent(in) :: m 2862 real(kind=c_double), dimension(*), intent(out) :: eig_vals 2863 end subroutine calc_symtens_eigvals 2864 2865 !--------------------------------------------------------------------------- 2866 2867 2868 ! Interface to C function cs_math_3_normalize 2869 2870 subroutine vector_normalize(vin, vout) & 2871 bind(C, name='cs_f_math_3_normalize') 2872 use, intrinsic :: iso_c_binding 2873 implicit none 2874 real(kind=c_double), dimension(*), intent(in) :: vin 2875 real(kind=c_double), dimension(*), intent(out) :: vout 2876 end subroutine vector_normalize 2877 2878 !--------------------------------------------------------------------------- 2879 2880 ! Interface to C function for data assimilation (atmospheric module) 2881 2882 subroutine cs_at_data_assim_initialize() & 2883 bind(C, name='cs_at_data_assim_initialize') 2884 use, intrinsic :: iso_c_binding 2885 implicit none 2886 end subroutine cs_at_data_assim_initialize 2887 2888 !--------------------------------------------------------------------------- 2889 2890 ! Interface to C function for data assimilation (atmospheric module) 2891 2892 subroutine cs_at_data_assim_build_ops() & 2893 bind(C, name='cs_at_data_assim_build_ops') 2894 use, intrinsic :: iso_c_binding 2895 implicit none 2896 end subroutine cs_at_data_assim_build_ops 2897 2898 !--------------------------------------------------------------------------- 2899 2900 ! Interface to C function for data assimilation (atmospheric module) 2901 2902 function cs_at_opt_interp_is_p1_proj_needed() result (ineeded) & 2903 bind(C, name='cs_at_opt_interp_is_p1_proj_needed') 2904 use, intrinsic :: iso_c_binding 2905 implicit none 2906 integer(c_int) :: ineeded 2907 end function cs_at_opt_interp_is_p1_proj_needed 2908 2909 !--------------------------------------------------------------------------- 2910 2911 ! Interface to C function for data assimilation (atmospheric module) 2912 2913 subroutine cs_at_data_assim_finalize() & 2914 bind(C, name='cs_at_data_assim_finalize') 2915 use, intrinsic :: iso_c_binding 2916 implicit none 2917 end subroutine cs_at_data_assim_finalize 2918 2919 !--------------------------------------------------------------------------- 2920 2921 ! Interface to C function for data assimilation (atmospheric module). 2922 2923 subroutine cs_at_data_assim_source_term(f_id, exp_st, imp_st) & 2924 bind(C, name='cs_at_data_assim_source_term') 2925 use, intrinsic :: iso_c_binding 2926 implicit none 2927 integer(c_int), value :: f_id 2928 real(kind=c_double), dimension(*), intent(inout) :: exp_st 2929 real(kind=c_double), dimension(*), intent(inout) :: imp_st 2930 end subroutine cs_at_data_assim_source_term 2931 2932 !--------------------------------------------------------------------------- 2933 2934 ! Binding to cs_ic_set_temp 2935 2936 subroutine cs_ic_set_temp(field_id, theipb, & 2937 temp_neig) & 2938 bind(C, name='cs_ic_set_temp') 2939 use, intrinsic :: iso_c_binding 2940 implicit none 2941 integer(kind=c_int), value :: field_id 2942 real(kind=c_double), dimension(*), intent(in) :: theipb, temp_neig 2943 end subroutine cs_ic_set_temp 2944 2945 !--------------------------------------------------------------------------- 2946 2947 ! Init fluid mesh quantities 2948 2949 subroutine cs_porous_model_init_fluid_quantities() & 2950 bind(C, name='cs_porous_model_init_fluid_quantities') 2951 use, intrinsic :: iso_c_binding 2952 implicit none 2953 end subroutine cs_porous_model_init_fluid_quantities 2954 2955 !--------------------------------------------------------------------------- 2956 2957 ! Initialize has_disable_flag 2958 2959 subroutine cs_porous_model_init_disable_flag() & 2960 bind(C, name='cs_porous_model_init_disable_flag') 2961 use, intrinsic :: iso_c_binding 2962 implicit none 2963 end subroutine cs_porous_model_init_disable_flag 2964 2965 !--------------------------------------------------------------------------- 2966 2967 ! Set has_disable_flag 2968 2969 subroutine cs_porous_model_set_has_disable_flag(flag) & 2970 bind(C, name='cs_porous_model_set_has_disable_flag') 2971 use, intrinsic :: iso_c_binding 2972 implicit none 2973 integer(kind=c_int), value :: flag 2974 end subroutine cs_porous_model_set_has_disable_flag 2975 2976 !--------------------------------------------------------------------------- 2977 2978 ! Set porosity model. 2979 2980 subroutine cs_porous_model_set_model(iporos) & 2981 bind(C, name='cs_porous_model_set_model') 2982 use, intrinsic :: iso_c_binding 2983 implicit none 2984 integer(kind=c_int), value :: iporos 2985 end subroutine cs_porous_model_set_model 2986 2987 !--------------------------------------------------------------------------- 2988 2989 !> \brief Compute the porosity from scan 2990 !> module). 2991 2992 subroutine cs_compute_porosity_from_scan() & 2993 bind(C, name='cs_compute_porosity_from_scan') 2994 use, intrinsic :: iso_c_binding 2995 implicit none 2996 end subroutine cs_compute_porosity_from_scan 2997 2998 !--------------------------------------------------------------------------- 2999 3000 !> \brief Return pointers 3001 3002 !> \param[out] compute_porosity_from_scan Pointer to 3003 !> compute_porosity_from_scan 3004 3005 subroutine cs_f_porosity_from_scan_get_pointer(compute_porosity_from_scan) & 3006 bind(C, name='cs_f_porosity_from_scan_get_pointer') 3007 use, intrinsic :: iso_c_binding 3008 implicit none 3009 type(c_ptr), intent(out) :: compute_porosity_from_scan 3010 end subroutine cs_f_porosity_from_scan_get_pointer 3011 3012 !--------------------------------------------------------------------------- 3013 3014 ! Read turbomachinery metadata from restart file. 3015 3016 subroutine turbomachinery_restart_read(r) & 3017 bind(C, name='cs_turbomachinery_restart_read') 3018 use, intrinsic :: iso_c_binding 3019 implicit none 3020 type(c_ptr), value :: r 3021 end subroutine turbomachinery_restart_read 3022 3023 !--------------------------------------------------------------------------- 3024 3025 ! Write turbomachinery metadata from restart file. 3026 3027 subroutine turbomachinery_restart_write(r) & 3028 bind(C, name='cs_turbomachinery_restart_write') 3029 use, intrinsic :: iso_c_binding 3030 implicit none 3031 type(c_ptr), value :: r 3032 end subroutine turbomachinery_restart_write 3033 3034 !--------------------------------------------------------------------------- 3035 3036 ! Interface to C function for sorbed concentration update. 3037 3038 subroutine cs_gwf_sorbed_concentration_update(f_id) & 3039 bind(C, name='cs_gwf_sorbed_concentration_update') 3040 use, intrinsic :: iso_c_binding 3041 implicit none 3042 integer(c_int), value :: f_id 3043 end subroutine cs_gwf_sorbed_concentration_update 3044 3045 !--------------------------------------------------------------------------- 3046 3047 ! Interface to C function for precipitation treatment. 3048 3049 subroutine cs_gwf_precipitation(f_id) & 3050 bind(C, name='cs_gwf_precipitation') 3051 use, intrinsic :: iso_c_binding 3052 implicit none 3053 integer(c_int), value :: f_id 3054 end subroutine cs_gwf_precipitation 3055 3056 !--------------------------------------------------------------------------- 3057 3058 ! Interface to C function for decay treatment. 3059 3060 subroutine cs_gwf_decay_rate(f_id, ts_imp) & 3061 bind(C, name='cs_gwf_decay_rate') 3062 use, intrinsic :: iso_c_binding 3063 implicit none 3064 integer(c_int), value :: f_id 3065 real(kind=c_double), dimension(*), intent(inout) :: ts_imp 3066 end subroutine cs_gwf_decay_rate 3067 3068 !--------------------------------------------------------------------------- 3069 3070 ! Interface to C function for kinetic reaction. 3071 3072 subroutine cs_gwf_kinetic_reaction(f_id, ts_imp, ts_exp) & 3073 bind(C, name='cs_gwf_kinetic_reaction') 3074 use, intrinsic :: iso_c_binding 3075 implicit none 3076 integer(c_int), value :: f_id 3077 real(kind=c_double), dimension(*), intent(inout) :: ts_imp 3078 real(kind=c_double), dimension(*), intent(inout) :: ts_exp 3079 end subroutine cs_gwf_kinetic_reaction 3080 3081 !--------------------------------------------------------------------------- 3082 3083 ! Interface to C function to count number of buoyant scalars. 3084 3085 subroutine cs_velocity_pressure_set_n_buoyant_scalars() & 3086 bind(C, name='cs_velocity_pressure_set_n_buoyant_scalars') 3087 use, intrinsic :: iso_c_binding 3088 implicit none 3089 end subroutine cs_velocity_pressure_set_n_buoyant_scalars 3090 3091 !--------------------------------------------------------------------------- 3092 3093 ! Interface to C function updating mesh quantities in the ALE framework. 3094 3095 subroutine cs_ale_update_mesh_quantities(min_vol, max_vol, tot_vol) & 3096 bind(C, name='cs_ale_update_mesh_quantities') 3097 use, intrinsic :: iso_c_binding 3098 implicit none 3099 real(kind=c_double), intent(inout) :: min_vol, max_vol, tot_vol 3100 end subroutine cs_ale_update_mesh_quantities 3101 3102 !--------------------------------------------------------------------------- 3103 3104 ! Interface to C function updating the mesh in the ALE framework. 3105 3106 subroutine cs_ale_update_mesh(itrale) & 3107 bind(C, name='cs_ale_update_mesh') 3108 use, intrinsic :: iso_c_binding 3109 implicit none 3110 integer(c_int), value :: itrale 3111 end subroutine cs_ale_update_mesh 3112 3113 !--------------------------------------------------------------------------- 3114 3115 ! Interface to C function updating BCs in ALE framework. 3116 3117 subroutine cs_ale_update_bcs(ialtyb, b_fluid_vel) & 3118 bind(C, name='cs_ale_update_bcs') 3119 use, intrinsic :: iso_c_binding 3120 implicit none 3121 integer(c_int), dimension(*), intent(in) :: ialtyb 3122 real(kind=c_double), dimension(*), intent(in) :: b_fluid_vel 3123 end subroutine cs_ale_update_bcs 3124 3125 !--------------------------------------------------------------------------- 3126 3127 ! Interface to C function solving mesh velocity in ALE framework. 3128 3129 subroutine cs_ale_solve_mesh_velocity(iterns, impale, ialtyb) & 3130 bind(C, name='cs_ale_solve_mesh_velocity') 3131 use, intrinsic :: iso_c_binding 3132 implicit none 3133 integer(c_int), value :: iterns 3134 integer(c_int), dimension(*), intent(in) :: impale, ialtyb 3135 end subroutine cs_ale_solve_mesh_velocity 3136 3137 !--------------------------------------------------------------------------- 3138 3139 !> \brief Binding to cs_ale_activate 3140 3141 subroutine cs_ale_activate() & 3142 bind(C, name='cs_ale_activate') 3143 use, intrinsic :: iso_c_binding 3144 implicit none 3145 end subroutine cs_ale_activate 3146 3147 !--------------------------------------------------------------------------- 3148 3149 ! Interface to C function to get the cs_glob_ale option 3150 3151 subroutine cs_f_ale_get_pointers(iale) & 3152 bind(C, name='cs_f_ale_get_pointers') 3153 use, intrinsic :: iso_c_binding 3154 implicit none 3155 type(c_ptr), intent(out) :: iale 3156 end subroutine cs_f_ale_get_pointers 3157 3158 !--------------------------------------------------------------------------- 3159 3160 ! Interface to C function for scalar gradient 3161 3162 subroutine cs_f_gradient_s(f_id, imrgra, inc, iccocg, n_r_sweeps, & 3163 iwarnp, imligp, epsrgp, climgp, & 3164 coefap, coefbp, pvar, grad) & 3165 bind(C, name='cs_f_gradient_s') 3166 use, intrinsic :: iso_c_binding 3167 implicit none 3168 integer(c_int), value :: f_id, imrgra, inc, iccocg, n_r_sweeps 3169 integer(c_int), value :: iwarnp, imligp 3170 real(kind=c_double), value :: epsrgp, climgp 3171 real(kind=c_double), dimension(*), intent(in) :: coefap, coefbp 3172 real(kind=c_double), dimension(*), intent(inout) :: pvar 3173 real(kind=c_double), dimension(*), intent(inout) :: grad 3174 end subroutine cs_f_gradient_s 3175 3176 !--------------------------------------------------------------------------- 3177 3178 ! Interface to C function for scalar potential gradient 3179 3180 subroutine cs_f_gradient_potential(f_id, imrgra, inc, iccocg, n_r_sweeps, & 3181 iphydp, iwarnp, imligp, & 3182 epsrgp, climgp, & 3183 f_ext, coefap, coefbp, pvar, grad) & 3184 bind(C, name='cs_f_gradient_potential') 3185 use, intrinsic :: iso_c_binding 3186 implicit none 3187 integer(c_int), value :: f_id, imrgra, inc, iccocg, n_r_sweeps 3188 integer(c_int), value :: iphydp, iwarnp, imligp 3189 real(kind=c_double), value :: epsrgp, climgp 3190 real(kind=c_double), dimension(*), intent(in) :: coefap, coefbp 3191 real(kind=c_double), dimension(*), intent(inout) :: f_ext, pvar 3192 real(kind=c_double), dimension(*), intent(inout) :: grad 3193 end subroutine cs_f_gradient_potential 3194 3195 !--------------------------------------------------------------------------- 3196 3197 ! Interface to C function for scalar gradient with weighting 3198 3199 subroutine cs_f_gradient_weighted_s(f_id, imrgra, inc, iccocg, n_r_sweeps, & 3200 iphydp, iwarnp, imligp, & 3201 epsrgp, climgp, & 3202 f_ext, coefap, coefbp, pvar, c_weight, & 3203 grad) & 3204 bind(C, name='cs_f_gradient_weighted_s') 3205 use, intrinsic :: iso_c_binding 3206 implicit none 3207 integer(c_int), value :: f_id, imrgra, inc, iccocg, n_r_sweeps 3208 integer(c_int), value :: iphydp, iwarnp, imligp 3209 real(kind=c_double), value :: epsrgp, climgp 3210 real(kind=c_double), dimension(*), intent(in) :: coefap, coefbp 3211 real(kind=c_double), dimension(*), intent(inout) :: f_ext, pvar 3212 real(kind=c_double), dimension(*), intent(inout) :: c_weight, grad 3213 end subroutine cs_f_gradient_weighted_s 3214 3215 !--------------------------------------------------------------------------- 3216 3217 ! Interface to C function computing total, min, and max cell fluid volumes 3218 3219 subroutine cs_f_mesh_quantities_fluid_vol_reductions() & 3220 bind(C, name='cs_f_mesh_quantities_fluid_vol_reductions') 3221 use, intrinsic :: iso_c_binding 3222 implicit none 3223 end subroutine cs_f_mesh_quantities_fluid_vol_reductions 3224 3225 !--------------------------------------------------------------------------- 3226 3227 ! Interface to C function to get notebook parameter value 3228 3229 function cs_f_notebook_parameter_value_by_name(name) result(val) & 3230 bind(C, name='cs_notebook_parameter_value_by_name') 3231 use, intrinsic :: iso_c_binding 3232 implicit none 3233 character(kind=c_char, len=1), dimension(*), intent(in) :: name 3234 real(kind=c_double) :: val 3235 end function cs_f_notebook_parameter_value_by_name 3236 3237 !--------------------------------------------------------------------------- 3238 3239 ! Interface to C function returning 1 for active cells 3240 3241 function cs_f_porous_model_cell_is_active(cell_id) result(is_active) & 3242 bind(C, name='cs_f_porous_model_cell_is_active') 3243 use, intrinsic :: iso_c_binding 3244 implicit none 3245 integer(c_int), value :: cell_id 3246 integer(kind=c_int) :: is_active 3247 end function cs_f_porous_model_cell_is_active 3248 3249 !--------------------------------------------------------------------------- 3250 3251 ! Interface to C function for enthalpy-temperature conversion at cells 3252 3253 subroutine cs_ht_convert_h_to_t_cells(h, t) & 3254 bind(C, name='cs_ht_convert_h_to_t_cells') 3255 use, intrinsic :: iso_c_binding 3256 implicit none 3257 real(kind=c_double), dimension(*), intent(in) :: h 3258 real(kind=c_double), dimension(*), intent(inout) :: t 3259 end subroutine cs_ht_convert_h_to_t_cells 3260 3261 !--------------------------------------------------------------------------- 3262 3263 ! Interface to C function for enthalpy-temperature conversion at faces 3264 3265 subroutine cs_ht_convert_h_to_t_faces(h, t) & 3266 bind(C, name='cs_ht_convert_h_to_t_faces') 3267 use, intrinsic :: iso_c_binding 3268 implicit none 3269 real(kind=c_double), dimension(*), intent(in) :: h 3270 real(kind=c_double), dimension(*), intent(inout) :: t 3271 end subroutine cs_ht_convert_h_to_t_faces 3272 3273 !--------------------------------------------------------------------------- 3274 3275 ! Interface to C function for temperature-enthalpy conversion at 3276 ! selected faces 3277 3278 subroutine cs_ht_convert_t_to_h_faces_l(n_faces, face_ids, t, h) & 3279 bind(C, name='cs_ht_convert_t_to_h_faces_l') 3280 use, intrinsic :: iso_c_binding 3281 implicit none 3282 integer(c_int), intent(in), value :: n_faces 3283 integer(c_int), dimension(*), intent(in) :: face_ids 3284 real(kind=c_double), dimension(*), intent(in) :: t 3285 real(kind=c_double), dimension(*), intent(inout) :: h 3286 end subroutine cs_ht_convert_t_to_h_faces_l 3287 3288 !--------------------------------------------------------------------------- 3289 3290 ! Interface to C function computing standard atmospheric profile 3291 3292 subroutine atmstd(z, p, t, r) & 3293 bind(C, name='cs_atmo_profile_std') 3294 use, intrinsic :: iso_c_binding 3295 implicit none 3296 real(kind=c_double), intent(in), value :: z 3297 real(kind=c_double), intent(out) :: p, t, r 3298 end subroutine atmstd 3299 3300 !--------------------------------------------------------------------------- 3301 3302 ! Interface to C function computing etheta and eq variable 3303 ! knowing the saturation. 3304 3305 subroutine atprke(tinstk, smbrk, smbre) & 3306 bind(C, name='cs_atprke') 3307 use, intrinsic :: iso_c_binding 3308 implicit none 3309 real(kind=c_double), dimension(*), intent(inout) :: tinstk, smbrk, smbre 3310 end subroutine atprke 3311 3312 !--------------------------------------------------------------------------- 3313 3314 ! Interface to C function to implicit and explicit sources terms 3315 ! from sources mass computation. 3316 3317 subroutine catsma(ncesmp, iterns, icetsm, itpsmp, & 3318 volume, pvara, smcelp, gamma, & 3319 tsexp, tsimp, gapinj) & 3320 bind(C, name='cs_f_mass_source_terms_s') 3321 use, intrinsic :: iso_c_binding 3322 implicit none 3323 integer(c_int), intent(in), value :: ncesmp, iterns 3324 integer(kind=c_int), dimension(*), intent(in) :: icetsm, itpsmp 3325 real(kind=c_double), dimension(*), intent(in) :: volume 3326 real(kind=c_double), dimension(*), intent(in) :: pvara 3327 real(kind=c_double), dimension(*), intent(in) :: gamma, smcelp 3328 real(kind=c_double), dimension(*), intent(inout) :: tsexp, tsimp 3329 real(kind=c_double), dimension(*), intent(out) :: gapinj 3330 end subroutine catsma 3331 3332 !--------------------------------------------------------------------------- 3333 3334 ! Interface to C function to implicit and explicit sources terms 3335 ! from sources mass computation. 3336 3337 subroutine catsmv(ncesmp, iterns, icetsm, itpsmp, & 3338 volume, pvara, smcelp, gamma, & 3339 tsexp, tsimp, gapinj) & 3340 bind(C, name='cs_f_mass_source_terms_v') 3341 use, intrinsic :: iso_c_binding 3342 implicit none 3343 integer(c_int), intent(in), value :: ncesmp, iterns 3344 integer(kind=c_int), dimension(*), intent(in) :: icetsm, itpsmp 3345 real(kind=c_double), dimension(*), intent(in) :: volume 3346 real(kind=c_double), dimension(*), intent(in) :: pvara 3347 real(kind=c_double), dimension(*), intent(in) :: gamma, smcelp 3348 real(kind=c_double), dimension(*), intent(inout) :: tsexp, tsimp 3349 real(kind=c_double), dimension(*), intent(out) :: gapinj 3350 end subroutine catsmv 3351 3352 !--------------------------------------------------------------------------- 3353 3354 ! Interface to C function to implicit and explicit sources terms 3355 ! from sources mass computation. 3356 3357 subroutine catsmt(ncesmp, iterns, icetsm, itpsmp, & 3358 volume, pvara, smcelp, gamma, & 3359 tsexp, tsimp, gapinj) & 3360 bind(C, name='cs_f_mass_source_terms_t') 3361 use, intrinsic :: iso_c_binding 3362 implicit none 3363 integer(c_int), intent(in), value :: ncesmp, iterns 3364 integer(kind=c_int), dimension(*), intent(in) :: icetsm, itpsmp 3365 real(kind=c_double), dimension(*), intent(in) :: volume 3366 real(kind=c_double), dimension(*), intent(in) :: pvara 3367 real(kind=c_double), dimension(*), intent(in) :: gamma, smcelp 3368 real(kind=c_double), dimension(*), intent(inout) :: tsexp, tsimp 3369 real(kind=c_double), dimension(*), intent(out) :: gapinj 3370 end subroutine catsmt 3371 3372 !--------------------------------------------------------------------------- 3373 3374 ! Interface to C function clipping of the turbulent kinetic energy 3375 ! and the turbulent dissipation. 3376 3377 subroutine clipke(ncel, iclip) & 3378 bind(C, name='cs_clip_ke') 3379 use, intrinsic :: iso_c_binding 3380 implicit none 3381 integer(c_int), intent(in), value :: ncel, iclip 3382 end subroutine clipke 3383 3384 !--------------------------------------------------------------------------- 3385 3386 !> (DOXYGEN_SHOULD_SKIP_THIS) \endcond 3387 3388 !--------------------------------------------------------------------------- 3389 3390 end interface 3391 3392 !============================================================================= 3393 3394contains 3395 3396 !============================================================================= 3397 3398 !> \brief Compute balance on a given zone for a given scalar 3399 3400 !> param[in] sel_crit selection criteria of a volume zone 3401 !> param[in] name scalar name 3402 3403 subroutine balance_by_zone(sel_crit, name) 3404 use, intrinsic :: iso_c_binding 3405 implicit none 3406 3407 ! Arguments 3408 3409 character(len=*), intent(in) :: sel_crit, name 3410 3411 ! Local variables 3412 3413 character(len=len_trim(sel_crit)+1, kind=c_char) :: c_sel_crit 3414 character(len=len_trim(name)+1, kind=c_char) :: c_name 3415 3416 c_sel_crit = trim(sel_crit)//c_null_char 3417 c_name = trim(name)//c_null_char 3418 3419 call cs_balance_by_zone(c_sel_crit, c_name) 3420 3421 return 3422 3423 end subroutine balance_by_zone 3424 3425 !============================================================================= 3426 3427 !> \brief Temporal and z-axis interpolation for meteorological profiles 3428 3429 !> An optimized linear interpolation is used. 3430 3431 subroutine intprf(nprofz, nproft, profz, proft, & 3432 profv, xz, temps, var) 3433 use, intrinsic :: iso_c_binding 3434 implicit none 3435 3436 integer(c_int), intent(in), value :: nprofz, nproft 3437 real(kind=c_double), dimension(nprofz), intent(in) :: profz 3438 real(kind=c_double), dimension(nproft), intent(in) :: proft 3439 real(kind=c_double), dimension(nprofz, nproft), intent(in) :: profv 3440 real(kind=c_double), intent(in), value :: xz, temps 3441 real(kind=c_double), intent(out) :: var 3442 3443 var = cs_intprf(nprofz, nproft, profz, proft, profv, xz, temps) 3444 3445 end subroutine intprf 3446 3447 !============================================================================= 3448 3449 !> \brief z-axis interpolation for meteorological profiles 3450 3451 !> An optimized linear interpolation is used. 3452 3453 subroutine intprz(nprofz, profz, profv, xz, iz1, iz2, var) 3454 use, intrinsic :: iso_c_binding 3455 implicit none 3456 3457 integer(c_int), intent(in), value :: nprofz 3458 real(kind=c_double), dimension(nprofz), intent(in) :: profz, profv 3459 real(kind=c_double), intent(in), value :: xz 3460 integer(c_int), intent(out) :: iz1, iz2 3461 real(kind=c_double), intent(out) :: var 3462 3463 integer(c_int), dimension(2) :: z_lv 3464 3465 call cs_intprz(nprofz, profz, profv, xz, z_lv, var) 3466 iz1 = z_lv(1) + 1 3467 iz2 = z_lv(2) + 1 3468 3469 end subroutine intprz 3470 3471 !============================================================================= 3472 3473 !> \brief Compute pressure drop for a given zone 3474 3475 !> param[in] sel_crit selection criteria of a volume zone 3476 3477 subroutine pressure_drop_by_zone(sel_crit) 3478 use, intrinsic :: iso_c_binding 3479 implicit none 3480 3481 ! Arguments 3482 3483 character(len=*), intent(in) :: sel_crit 3484 3485 ! Local variables 3486 3487 character(len=len_trim(sel_crit)+1, kind=c_char) :: c_sel_crit 3488 3489 c_sel_crit = trim(sel_crit)//c_null_char 3490 3491 call cs_pressure_drop_by_zone(c_sel_crit) 3492 3493 return 3494 3495 end subroutine pressure_drop_by_zone 3496 3497 !============================================================================= 3498 3499 ! Interface to C function returning the product of a matrix (native format) 3500 ! by a vector 3501 3502 subroutine promav(isym, ibsize, iesize, f_id, dam, xam, vx, vy) 3503 use, intrinsic :: iso_c_binding 3504 implicit none 3505 3506 ! Arguments 3507 3508 integer, value :: isym, ibsize, iesize, f_id 3509 real(kind=c_double), dimension(*), intent(in) :: dam, xam, vx 3510 real(kind=c_double), dimension(*), intent(out) :: vy 3511 3512 ! Local variables 3513 3514 integer(c_int), dimension(4) :: c_db_size, c_eb_size 3515 logical(c_bool) :: c_symmetric 3516 3517 if (isym.eq.1) then 3518 c_symmetric = .true. 3519 else 3520 c_symmetric = .false. 3521 endif 3522 3523 c_db_size(0+1) = ibsize; 3524 c_db_size(1+1) = ibsize; 3525 c_db_size(2+1) = ibsize; 3526 c_db_size(3+1) = ibsize*ibsize; 3527 3528 c_eb_size(0+1) = iesize; 3529 c_eb_size(1+1) = iesize; 3530 c_eb_size(2+1) = iesize; 3531 c_eb_size(3+1) = iesize*iesize; 3532 3533 call cs_matrix_vector_native_multiply(c_symmetric, c_db_size, c_eb_size, & 3534 f_id, dam, xam, vx, vy) 3535 3536 return 3537 3538 end subroutine promav 3539 3540 !============================================================================= 3541 3542 !> \brief Compute surface scalar balance for a given surface area 3543 3544 !> param[in] sel_crit selection criteria of a volume zone 3545 3546 subroutine surface_balance(sel_crit, name, normal) 3547 use, intrinsic :: iso_c_binding 3548 implicit none 3549 3550 ! Arguments 3551 3552 character(len=*), intent(in) :: sel_crit, name 3553 real(kind=c_double), dimension(3), intent(in) :: normal 3554 3555 ! Local variables 3556 3557 character(len=len_trim(sel_crit)+1, kind=c_char) :: c_sel_crit 3558 character(len=len_trim(name)+1, kind=c_char) :: c_name 3559 3560 c_sel_crit = trim(sel_crit)//c_null_char 3561 c_name = trim(name)//c_null_char 3562 3563 call cs_surface_balance(c_sel_crit, c_name, normal) 3564 3565 return 3566 3567 end subroutine surface_balance 3568 3569 !============================================================================= 3570 3571 !> \brief Handle boundary condition definition errors and associated output. 3572 3573 !> For each boundary face, bc_type defines the boundary condition type. 3574 !> As a convention here, zero values correspond to undefined types, 3575 !> positive values to defined types (with no error), and negative values 3576 !> to defined types with inconsistent or incompatible values, the 3577 !> absolute value indicating the original boundary condition type. 3578 3579 !> param[in] bc_type array og BC type ids 3580 3581 subroutine boundary_conditions_error(bc_type) 3582 use, intrinsic :: iso_c_binding 3583 implicit none 3584 3585 ! Arguments 3586 3587 integer(c_int), dimension(*), intent(in) :: bc_type 3588 3589 ! Call C function with default name 3590 3591 call cs_boundary_conditions_error(bc_type, c_null_ptr) 3592 3593 end subroutine boundary_conditions_error 3594 3595 !============================================================================= 3596 3597 !> \brief Locate shifted boundary face coordinates on possibly filtered 3598 !> cells or boundary faces for later interpolation. 3599 3600 !> param[in] location_type matching values location (CS_MESH_LOCATION_CELLS 3601 !> or CS_MESH_LOCATION_BOUNDARY_FACES) 3602 !> param[in] n_location_elts number of selected location elements 3603 !> param[in] n_faces number of selected boundary faces 3604 !> param[in] location_elts list of selected location elements (1 to n), 3605 !> or NULL if no indirection is needed 3606 !> param[in] faces list of selected boundary faces (1 to n), 3607 !> or NULL if no indirection is needed 3608 !> param[in] coord_shift array of coordinates shift relative to selected 3609 !> boundary faces 3610 !> param[in] coord_stride access stride in coord_shift: 0 for uniform 3611 !> shift, 1 for "per face" shift. 3612 !> param[in] tolerance relative tolerance for point location. 3613 3614 !> return associated locator structure 3615 3616 function boundary_conditions_map(location_type, n_location_elts, & 3617 n_faces, location_elts, faces, & 3618 coord_shift, coord_stride, & 3619 tolerance) result(l) 3620 use, intrinsic :: iso_c_binding 3621 implicit none 3622 3623 ! Arguments 3624 3625 integer, intent(in) :: location_type, n_location_elts, n_faces 3626 integer, dimension(*), intent(in) :: location_elts, faces 3627 real(kind=c_double), dimension(*) :: coord_shift 3628 integer, intent(in) :: coord_stride 3629 double precision, intent(in) :: tolerance 3630 type(c_ptr) :: l 3631 3632 ! Local variables 3633 3634 integer iel, ifac 3635 integer(c_int) :: c_loc_type, c_n_elts, c_n_faces, c_coord_stride 3636 integer(c_int), dimension(:), allocatable :: c_loc_elts, c_faces 3637 real(kind=c_double) :: c_tolerance 3638 3639 c_loc_type = location_type 3640 c_n_elts = n_location_elts 3641 c_n_faces = n_faces 3642 c_coord_stride = coord_stride 3643 c_tolerance = tolerance 3644 3645 allocate(c_loc_elts(n_location_elts)) 3646 allocate(c_faces(n_faces)) 3647 3648 do iel = 1, n_location_elts 3649 c_loc_elts(iel) = location_elts(iel) - 1 3650 enddo 3651 do ifac = 1, n_faces 3652 c_faces(ifac) = faces(ifac) - 1 3653 enddo 3654 3655 l = cs_boundary_conditions_map(c_loc_type, c_n_elts, c_n_faces, & 3656 c_loc_elts, c_faces, & 3657 coord_shift, c_coord_stride, c_tolerance) 3658 3659 deallocate(c_faces) 3660 deallocate(c_loc_elts) 3661 3662 end function boundary_conditions_map 3663 3664 !============================================================================= 3665 3666 !> \brief Assign a var_cal_opt for a cs_var_cal_opt_t key to a field. 3667 3668 !> If the field category is not compatible, a fatal error is provoked. 3669 3670 !> \param[in] f_id field id 3671 !> \param[in] k_value structure associated with key 3672 3673 subroutine field_set_key_struct_var_cal_opt(f_id, k_value) 3674 3675 use, intrinsic :: iso_c_binding 3676 implicit none 3677 3678 ! Arguments 3679 3680 integer, intent(in) :: f_id 3681 type(var_cal_opt), intent(in), target :: k_value 3682 3683 ! Local variables 3684 3685 integer(c_int) :: c_f_id 3686 type(var_cal_opt),pointer :: p_k_value 3687 type(c_ptr) :: c_k_value 3688 character(len=11+1, kind=c_char) :: c_name 3689 3690 integer(c_int), save :: c_k_id = -1 3691 3692 if (c_k_id .eq. -1) then 3693 c_name = "var_cal_opt"//c_null_char 3694 c_k_id = cs_f_field_key_id(c_name) 3695 endif 3696 3697 c_f_id = f_id 3698 3699 p_k_value => k_value 3700 c_k_value = c_loc(p_k_value) 3701 3702 call cs_f_field_set_key_struct_var_cal_opt(c_f_id, c_k_value) 3703 3704 return 3705 3706 end subroutine field_set_key_struct_var_cal_opt 3707 3708 !============================================================================= 3709 3710 !> \brief Assign a solving_info for a cs_solving_info_t key to a field. 3711 3712 !> If the field category is not compatible, a fatal error is provoked. 3713 3714 !> \param[in] f_id field id 3715 !> \param[in] k_value structure associated with key 3716 3717 subroutine field_set_key_struct_solving_info (f_id, k_value) 3718 3719 use, intrinsic :: iso_c_binding 3720 implicit none 3721 3722 ! Arguments 3723 3724 integer, intent(in) :: f_id 3725 type(solving_info), intent(in), target :: k_value 3726 3727 ! Local variables 3728 3729 integer(c_int) :: c_f_id 3730 type(solving_info), pointer :: p_k_value 3731 type(c_ptr) :: c_k_value 3732 character(len=12+1, kind=c_char) :: c_name 3733 3734 integer(c_int), save :: c_k_id = -1 3735 3736 if (c_k_id .eq. -1) then 3737 c_name = "solving_info"//c_null_char 3738 c_k_id = cs_f_field_key_id(c_name) 3739 endif 3740 3741 c_f_id = f_id 3742 3743 p_k_value => k_value 3744 c_k_value = c_loc(p_k_value) 3745 3746 call cs_f_field_set_key_struct(c_f_id, c_k_id, c_k_value) 3747 3748 return 3749 3750 end subroutine field_set_key_struct_solving_info 3751 3752 !============================================================================= 3753 3754 !> \brief Assign a gwf_soilwater_partition for a cs_gwf_soilwater_partition_t 3755 !> key to a field. 3756 3757 !> If the field category is not compatible, a fatal error is provoked. 3758 3759 !> \param[in] f_id field id 3760 !> \param[in] k_value structure associated with key 3761 3762 subroutine field_set_key_struct_gwf_soilwater_partition(f_id, k_value) 3763 3764 use, intrinsic :: iso_c_binding 3765 implicit none 3766 3767 ! Arguments 3768 3769 integer, intent(in) :: f_id 3770 type(gwf_soilwater_partition), intent(in), target :: k_value 3771 3772 ! Local variables 3773 3774 integer(c_int) :: c_f_id 3775 type(gwf_soilwater_partition),pointer :: p_k_value 3776 type(c_ptr) :: c_k_value 3777 character(len=34+1, kind=c_char) :: c_name 3778 3779 integer(c_int), save :: c_k_id = -1 3780 3781 if (c_k_id .eq. -1) then 3782 c_name = "gwf_soilwater_partition"//c_null_char 3783 c_k_id = cs_f_field_key_id(c_name) 3784 endif 3785 3786 c_f_id = f_id 3787 3788 p_k_value => k_value 3789 c_k_value = c_loc(p_k_value) 3790 3791 call cs_f_field_set_key_struct(c_f_id, c_k_id, c_k_value) 3792 3793 return 3794 3795 end subroutine field_set_key_struct_gwf_soilwater_partition 3796 3797 !============================================================================= 3798 3799 !> \brief Assign a gas_mix_species_prop for a cs_gas_mix_species_prop_t 3800 !> key to a field. 3801 3802 !> If the field category is not compatible, a fatal error is provoked. 3803 3804 !> \param[in] f_id field id 3805 !> \param[in] k_value structure associated with key 3806 3807 subroutine field_set_key_struct_gas_mix_species_prop(f_id, k_value) 3808 3809 use, intrinsic :: iso_c_binding 3810 implicit none 3811 3812 ! Arguments 3813 3814 integer, intent(in) :: f_id 3815 type(gas_mix_species_prop), intent(in), target :: k_value 3816 3817 ! Local variables 3818 3819 integer(c_int) :: c_f_id 3820 type(gas_mix_species_prop),pointer :: p_k_value 3821 type(c_ptr) :: c_k_value 3822 character(len=23+1, kind=c_char) :: c_name 3823 3824 integer(c_int), save :: c_k_id = -1 3825 3826 if (c_k_id .eq. -1) then 3827 c_name = "gas_mix_species_prop"//c_null_char 3828 c_k_id = cs_f_field_key_id(c_name) 3829 endif 3830 3831 c_f_id = f_id 3832 3833 p_k_value => k_value 3834 c_k_value = c_loc(p_k_value) 3835 3836 call cs_f_field_set_key_struct(c_f_id, c_k_id, c_k_value) 3837 3838 return 3839 3840 end subroutine field_set_key_struct_gas_mix_species_prop 3841 3842 !============================================================================= 3843 3844 !> \brief Return a pointer to the var_cal_opt structure for cs_var_cal_opt key 3845 !> associated with a field. 3846 3847 !> If the field category is not compatible, a fatal error is provoked. 3848 3849 !> \param[in] f_id field id 3850 !> \param[out] k_value integer value associated with key id for this field 3851 3852 subroutine field_get_key_struct_var_cal_opt(f_id, k_value) 3853 3854 use, intrinsic :: iso_c_binding 3855 implicit none 3856 3857 ! Arguments 3858 3859 integer, intent(in) :: f_id 3860 type(var_cal_opt), intent(out), target :: k_value 3861 3862 ! Local variables 3863 3864 integer(c_int) :: c_f_id 3865 type(var_cal_opt),pointer :: p_k_value 3866 type(c_ptr) :: c_k_value 3867 3868 c_f_id = f_id 3869 3870 p_k_value => k_value 3871 c_k_value = c_loc(p_k_value) 3872 3873 call cs_f_field_get_key_struct_var_cal_opt(c_f_id, c_k_value) 3874 3875 return 3876 3877 end subroutine field_get_key_struct_var_cal_opt 3878 3879 !============================================================================= 3880 3881 !> \brief Return a pointer to the solving_info structure for 3882 !> cs_solving_info_t key associated with a field. 3883 3884 !> If the field category is not compatible, a fatal error is provoked. 3885 3886 !> \param[in] f_id field id 3887 !> \param[out] k_value integer value associated with key id for this field 3888 3889 subroutine field_get_key_struct_solving_info(f_id, k_value) 3890 3891 use, intrinsic :: iso_c_binding 3892 implicit none 3893 3894 ! Arguments 3895 3896 integer, intent(in) :: f_id 3897 type(solving_info), intent(inout), target :: k_value 3898 3899 ! Local variables 3900 3901 integer(c_int) :: c_f_id, c_k_id 3902 type(solving_info), pointer :: p_k_value 3903 type(c_ptr) :: c_k_value 3904 character(len=12+1, kind=c_char) :: c_name 3905 3906 c_name = "solving_info"//c_null_char 3907 c_k_id = cs_f_field_key_id(c_name) 3908 3909 c_f_id = f_id 3910 3911 p_k_value => k_value 3912 c_k_value = c_loc(p_k_value) 3913 3914 call cs_f_field_get_key_struct(c_f_id, c_k_id, c_k_value) 3915 3916 return 3917 3918 end subroutine field_get_key_struct_solving_info 3919 3920 !============================================================================= 3921 3922 !> \brief Return a pointer to the gwf_soilwater_partition structure for 3923 !> cs_gwf_soilwater_partition_t key associated with a field. 3924 3925 !> If the field category is not compatible, a fatal error is provoked. 3926 3927 !> \param[in] f_id field id 3928 !> \param[out] k_value integer value associated with key id for this field 3929 3930 subroutine field_get_key_struct_gwf_soilwater_partition(f_id, k_value) 3931 3932 use, intrinsic :: iso_c_binding 3933 implicit none 3934 3935 ! Arguments 3936 3937 integer, intent(in) :: f_id 3938 type(gwf_soilwater_partition), intent(inout), target :: k_value 3939 3940 ! Local variables 3941 3942 integer(c_int) :: c_f_id, c_k_id 3943 type(gwf_soilwater_partition),pointer :: p_k_value 3944 type(c_ptr) :: c_k_value 3945 character(len=34+1, kind=c_char) :: c_name 3946 3947 c_name = "gwf_soilwater_partition"//c_null_char 3948 3949 c_k_id = cs_f_field_key_id(c_name) 3950 c_f_id = f_id 3951 3952 p_k_value => k_value 3953 c_k_value = c_loc(p_k_value) 3954 3955 call cs_f_field_get_key_struct(c_f_id, c_k_id, c_k_value) 3956 3957 return 3958 3959 end subroutine field_get_key_struct_gwf_soilwater_partition 3960 3961 !============================================================================= 3962 3963 !> \brief Return a pointer to the gas_mix_species_prop structure for 3964 !> cs_gas_mix_species_prop_t key associated with a field. 3965 3966 !> If the field category is not compatible, a fatal error is provoked. 3967 3968 !> \param[in] f_id field id 3969 !> \param[out] k_value integer value associated with key id for this field 3970 3971 subroutine field_get_key_struct_gas_mix_species_prop (f_id, k_value) 3972 3973 use, intrinsic :: iso_c_binding 3974 implicit none 3975 3976 ! Arguments 3977 3978 integer, intent(in) :: f_id 3979 type(gas_mix_species_prop), intent(inout), target :: k_value 3980 3981 ! Local variables 3982 3983 integer(c_int) :: c_f_id, c_k_id 3984 type(gas_mix_species_prop),pointer :: p_k_value 3985 type(c_ptr) :: c_k_value 3986 character(len=23+1, kind=c_char) :: c_name 3987 3988 c_name = "gas_mix_species_prop"//c_null_char 3989 c_k_id = cs_f_field_key_id(c_name) 3990 3991 c_f_id = f_id 3992 3993 p_k_value => k_value 3994 c_k_value = c_loc(p_k_value) 3995 3996 call cs_f_field_get_key_struct(c_f_id, c_k_id, c_k_value) 3997 3998 return 3999 4000 end subroutine field_get_key_struct_gas_mix_species_prop 4001 4002 !============================================================================= 4003 4004 !> \brief Compute cell gradient 4005 4006 !> \param[in] f_id field id, or -1 4007 !> \param[in] imrgra gradient computation mode 4008 !> \param[in] inc 0: increment; 1: do not increment 4009 !> \param[in] recompute_cocg 1 or 0: recompute COCG or not 4010 !> \param[in] nswrgp number of sweeps for reconstruction 4011 !> \param[in] imligp gradient limitation method: 4012 !> < 0 no limitation 4013 !> = 0 based on neighboring gradients 4014 !> = 1 based on mean gradient 4015 !> \param[in] iwarnp verbosity 4016 !> \param[in] epsrgp relative precision for reconstruction 4017 !> \param[in] climgp limiter coefficient for imligp 4018 !> \param[in, out] pvar cell values whose gradient is computed 4019 !> \param[in] coefap boundary coefap coefficients 4020 !> \param[in] coefbp boundary coefap coefficients 4021 !> \param[out] grad resulting gradient 4022 4023 subroutine gradient_s(f_id, imrgra, inc, recompute_cocg, nswrgp, & 4024 imligp, iwarnp, epsrgp, climgp, & 4025 pvar, coefap, coefbp, grad) 4026 4027 use, intrinsic :: iso_c_binding 4028 use paramx 4029 use mesh 4030 use field 4031 use period 4032 4033 implicit none 4034 4035 ! Arguments 4036 4037 integer, intent(in) :: f_id, imrgra, inc, recompute_cocg , nswrgp 4038 integer, intent(in) :: imligp, iwarnp 4039 double precision, intent(in) :: epsrgp, climgp 4040 real(kind=c_double), dimension(nfabor), intent(in) :: coefap, coefbp 4041 real(kind=c_double), dimension(ncelet), intent(inout) :: pvar 4042 real(kind=c_double), dimension(3, ncelet), intent(out) :: grad 4043 4044 ! The gradient of a potential (pressure, ...) is a vector 4045 4046 call cs_f_gradient_s(f_id, imrgra, inc, recompute_cocg, nswrgp, & 4047 iwarnp, imligp, & 4048 epsrgp, climgp, coefap, coefbp, pvar, grad) 4049 4050 end subroutine gradient_s 4051 4052 !============================================================================= 4053 4054 !> \brief Compute cell gradient of a scalar with weighting 4055 4056 !> \param[in] f_id field id, or -1 4057 !> \param[in] imrgra gradient computation mode 4058 !> \param[in] inc 0: increment; 1: do not increment 4059 !> \param[in] recompute_cocg 1 or 0: recompute COCG or not 4060 !> \param[in] nswrgp number of sweeps for reconstruction 4061 !> \param[in] imligp gradient limitation method: 4062 !> < 0 no limitation 4063 !> = 0 based on neighboring gradients 4064 !> = 1 based on mean gradient 4065 !> \param[in] hyd_p_flag flag for hydrostatic pressure 4066 !> \param[in] iwarnp verbosity 4067 !> \param[in] epsrgp relative precision for reconstruction 4068 !> \param[in] climgp limiter coefficient for imligp 4069 !> \param[in] f_ext exterior force generating 4070 !> the hydrostatic pressure 4071 !> \param[in, out] pvar cell values whose gradient is computed 4072 !> \param[in, out] c_weight cell weighting coefficient 4073 !> \param[in] coefap boundary coefap coefficients 4074 !> \param[in] coefbp boundary coefap coefficients 4075 !> \param[out] grad resulting gradient 4076 4077 subroutine gradient_weighted_s(f_id, imrgra, inc, recompute_cocg, nswrgp, & 4078 imligp, hyd_p_flag, iwarnp, epsrgp, climgp, & 4079 f_ext, pvar, c_weight, coefap, & 4080 coefbp, grad) 4081 4082 use, intrinsic :: iso_c_binding 4083 use paramx 4084 use mesh 4085 use field 4086 4087 implicit none 4088 4089 ! Arguments 4090 4091 integer, intent(in) :: f_id, imrgra, inc, recompute_cocg , nswrgp 4092 integer, intent(in) :: imligp, hyd_p_flag, iwarnp 4093 double precision, intent(in) :: epsrgp, climgp 4094 real(kind=c_double), dimension(nfabor), intent(in) :: coefap, coefbp 4095 real(kind=c_double), dimension(ncelet), intent(inout) :: pvar 4096 real(kind=c_double), dimension(:), intent(inout) :: c_weight 4097 real(kind=c_double), dimension(:,:), pointer, intent(in) :: f_ext 4098 real(kind=c_double), dimension(3, ncelet), intent(out) :: grad 4099 4100 call cs_f_gradient_weighted_s(f_id, imrgra, inc, recompute_cocg, nswrgp, & 4101 hyd_p_flag, iwarnp, imligp, epsrgp, & 4102 climgp, f_ext, coefap, coefbp, & 4103 pvar, c_weight, grad) 4104 4105 end subroutine gradient_weighted_s 4106 4107 !============================================================================= 4108 4109 !> \brief Destruction of a locator structure. 4110 4111 !> \param[in, out] this_locator 4112 4113 subroutine locator_destroy(this_locator) 4114 4115 use, intrinsic :: iso_c_binding 4116 implicit none 4117 4118 ! Arguments 4119 4120 type(c_ptr) :: this_locator 4121 4122 ! Local variables 4123 4124 this_locator = ple_locator_destroy(this_locator) 4125 4126 end subroutine locator_destroy 4127 4128 !============================================================================= 4129 4130 ! Interface to C function adding an array not saved as a permanent field 4131 ! to logging of fields 4132 4133 !> \brief Add array not saved as permanent field to logging of fields. 4134 4135 !> \param[in] name array name 4136 !> \param[in] category category name 4137 !> \param[in] location associated mesh location 4138 !> \param[in] is_intensive associated mesh location 4139 !> \param[in] dim associated dimension (interleaved) 4140 !> \param[in] val associated values 4141 4142 subroutine log_iteration_add_array(name, category, location, is_intensive, & 4143 dim, val) 4144 4145 use, intrinsic :: iso_c_binding 4146 implicit none 4147 4148 ! Arguments 4149 4150 character(len=*), intent(in) :: name, category 4151 integer, intent(in) :: location, dim 4152 logical, intent(in) :: is_intensive 4153 real(kind=c_double), dimension(*) :: val 4154 4155 ! Local variables 4156 4157 character(len=len_trim(name)+1, kind=c_char) :: c_name 4158 character(len=len_trim(category)+1, kind=c_char) :: c_cat 4159 integer(c_int) :: c_ml, c_dim 4160 logical(c_bool) :: c_inten 4161 4162 c_name = trim(name)//c_null_char 4163 c_cat = trim(category)//c_null_char 4164 c_ml = location 4165 if (is_intensive .eqv. .true.) then 4166 c_inten = .true. 4167 else 4168 c_inten = .false. 4169 endif 4170 c_dim = dim 4171 4172 call cs_log_iteration_add_array(c_name, c_cat, c_ml, c_inten, c_dim, val) 4173 4174 return 4175 4176 end subroutine log_iteration_add_array 4177 4178 !============================================================================= 4179 4180 ! Interface to C function adding an array not saved as a permanent field 4181 ! to logging of fields 4182 4183 !> \brief Add array not saved as permanent field to logging of fields. 4184 4185 !> \param[in] name array name 4186 !> \param[in] dim associated dimension (interleaved) 4187 !> \param[in] n_clip_min local number of clipped to min values 4188 !> \param[in] n_clip_max local number of clipped to max values 4189 !> \param[in] min_pre_clip min local value prior to clip 4190 !> \param[in] max_pre_clip max local value prior to clip 4191 4192 subroutine log_iteration_clipping(name, dim, n_clip_min, n_clip_max, & 4193 min_pre_clip, max_pre_clip) 4194 4195 use, intrinsic :: iso_c_binding 4196 implicit none 4197 4198 ! Arguments 4199 4200 character(len=*), intent(in) :: name 4201 integer, intent(in) :: dim, n_clip_min, n_clip_max 4202 real(kind=c_double), dimension(*) :: min_pre_clip, max_pre_clip 4203 4204 ! Local variables 4205 4206 character(len=len_trim(name)+1, kind=c_char) :: c_name 4207 integer(c_int) :: c_dim, c_clip_min, c_clip_max 4208 4209 c_name = trim(name)//c_null_char 4210 c_dim = dim 4211 c_clip_min = n_clip_min 4212 c_clip_max = n_clip_max 4213 4214 call cs_log_iteration_clipping(c_name, c_dim, c_clip_min, c_clip_max, & 4215 min_pre_clip, max_pre_clip) 4216 4217 return 4218 4219 end subroutine log_iteration_clipping 4220 4221 !============================================================================= 4222 4223 ! Interface to C function adding an array not saved as a permanent field 4224 ! to logging of fields 4225 4226 !> \brief Add array not saved as permanent field to logging of fields. 4227 4228 !> \param[in] f_id associated dimension (interleaved) 4229 !> \param[in] n_clip_min local number of clipped to min values 4230 !> \param[in] n_clip_max local number of clipped to max values 4231 !> \param[in] min_pre_clip min local value prior to clip 4232 !> \param[in] max_pre_clip max local value prior to clip 4233 !> \param[in] n_clip_min_comp number of clip min by component 4234 !> \param[in] n_clip_max_comp number of clip max by component 4235 4236 subroutine log_iteration_clipping_field(f_id, n_clip_min, n_clip_max, & 4237 min_pre_clip, max_pre_clip, & 4238 n_clip_min_comp, n_clip_max_comp) 4239 4240 use, intrinsic :: iso_c_binding 4241 implicit none 4242 4243 ! Arguments 4244 4245 integer, intent(in) :: f_id, n_clip_min, n_clip_max 4246 real(kind=c_double), dimension(*) :: min_pre_clip, max_pre_clip 4247 integer(c_int), dimension(*), intent(in) :: n_clip_min_comp, n_clip_max_comp 4248 ! Local variables 4249 4250 integer(c_int) :: c_f_id, c_clip_min, c_clip_max 4251 4252 c_f_id = f_id 4253 c_clip_min = n_clip_min 4254 c_clip_max = n_clip_max 4255 4256 call cs_log_iteration_clipping_field(c_f_id, c_clip_min, c_clip_max, & 4257 min_pre_clip, max_pre_clip, & 4258 n_clip_min_comp, n_clip_max_comp) 4259 4260 return 4261 4262 end subroutine log_iteration_clipping_field 4263 4264 !============================================================================= 4265 4266 !> \brief Initialize a restart file 4267 4268 !> \param[in] name file name 4269 !> \param[in] path optional directory name for output 4270 !> (automatically created if necessary) 4271 !> \param[in] mode read (0) or write (1) 4272 !> \param[out] r pointer to restart structure 4273 4274 subroutine restart_create(name, path, mode, r) 4275 use, intrinsic :: iso_c_binding 4276 implicit none 4277 4278 ! Arguments 4279 4280 character(len=*), intent(in) :: name, path 4281 integer, intent(in) :: mode 4282 type(c_ptr), intent(out) :: r 4283 4284 ! Local variables 4285 4286 character(len=len_trim(name)+1, kind=c_char) :: c_name 4287 character(len=len_trim(path)+1, kind=c_char) :: c_path 4288 integer(c_int) :: c_mode 4289 4290 c_name = trim(name)//c_null_char 4291 c_path = trim(path)//c_null_char 4292 c_mode = mode 4293 4294 r = cs_restart_create(c_name, c_path, c_mode) 4295 4296 end subroutine restart_create 4297 4298 !--------------------------------------------------------------------------- 4299 4300 !> \brief Read variables from checkpoint. 4301 4302 !> \param[in] r pointer to restart structure 4303 !> \param[in] old_field_map old field map pointer 4304 !> \param[in] t_id_flag -1: all time values; 0: current values; 4305 !> > 0: previous values 4306 4307 subroutine restart_read_variables(r, old_field_map, t_id_flag) 4308 use, intrinsic :: iso_c_binding 4309 implicit none 4310 4311 ! Arguments 4312 4313 type(c_ptr), intent(in) :: r 4314 integer, intent(in) :: t_id_flag 4315 type(c_ptr), intent(in) :: old_field_map 4316 4317 ! Local variables 4318 4319 integer(c_int) :: c_t_id_flag 4320 4321 c_t_id_flag = t_id_flag 4322 4323 call cs_restart_read_variables(r, old_field_map, c_t_id_flag, c_null_ptr) 4324 4325 end subroutine restart_read_variables 4326 4327 !----------------------------------------------------------------------------- 4328 4329 !> \brief Write variables to checkpoint 4330 4331 !> \param[in] r pointer to restart structure 4332 !> \param[in] t_id_flag -1: all time values; 0: current values; 4333 !> > 0: previous values 4334 4335 subroutine restart_write_variables(r, t_id_flag) 4336 use, intrinsic :: iso_c_binding 4337 implicit none 4338 4339 ! Arguments 4340 4341 type(c_ptr), intent(in) :: r 4342 integer, intent(in) :: t_id_flag 4343 4344 ! Local variables 4345 4346 integer(c_int) :: c_t_id_flag 4347 4348 c_t_id_flag = t_id_flag 4349 4350 call cs_restart_write_variables(r, c_t_id_flag, c_null_ptr) 4351 4352 end subroutine restart_write_variables 4353 4354 !--------------------------------------------------------------------------- 4355 4356 !> \brief Read a section of integers from a restart file. 4357 4358 !> \param[in] r pointer to restart structure 4359 !> \param[in] sec_name name of section 4360 !> \param[in] location_id id of associated mesh location 4361 !> \param[in] n_loc_vals number of values per location 4362 !> \param[out] val values array 4363 !> \param[out] ierror 0: success, < 0: error code 4364 4365 subroutine restart_read_section_int_t(r, sec_name, & 4366 location_id, n_loc_vals, val, & 4367 ierror) 4368 4369 use, intrinsic :: iso_c_binding 4370 implicit none 4371 4372 ! Arguments 4373 4374 type(c_ptr), intent(in) :: r 4375 character(len=*), intent(in) :: sec_name 4376 integer, intent(in) :: location_id, n_loc_vals 4377 integer, dimension(*), target :: val 4378 integer, intent(out) :: ierror 4379 4380 ! Local variables 4381 4382 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4383 integer(c_int) :: c_loc_id, c_n_l_vals, c_val_type, c_ierror 4384 type(c_ptr) :: c_val 4385 4386 c_s_n = trim(sec_name)//c_null_char 4387 c_loc_id = location_id 4388 c_n_l_vals = n_loc_vals 4389 c_val_type = RESTART_VAL_TYPE_INT_T 4390 c_val = c_loc(val) 4391 4392 c_ierror = cs_restart_read_section(r, c_s_n, c_loc_id, & 4393 c_n_l_vals, c_val_type, & 4394 c_val) 4395 4396 ierror = c_ierror 4397 4398 end subroutine restart_read_section_int_t 4399 4400 !--------------------------------------------------------------------------- 4401 4402 !> \brief Read a section of integers from a restart file, 4403 !> when that section may have used a different name in a previous version. 4404 4405 !> \param[in] r pointer to restart structure 4406 !> \param[in] sec_name name of section 4407 !> \param[in] old_name old name of section 4408 !> \param[in] location_id id of associated mesh location 4409 !> \param[in] n_loc_vals number of values per location 4410 !> \param[out] val values array 4411 !> \param[out] ierror 0: success, < 0: error code 4412 4413 subroutine restart_read_int_t_compat(r, sec_name, old_name, & 4414 location_id, n_loc_vals, val, & 4415 ierror) 4416 4417 use, intrinsic :: iso_c_binding 4418 implicit none 4419 4420 ! Arguments 4421 4422 type(c_ptr), intent(in) :: r 4423 character(len=*), intent(in) :: sec_name 4424 character(len=*), intent(in) :: old_name 4425 integer, intent(in) :: location_id, n_loc_vals 4426 integer, dimension(*), target :: val 4427 integer, intent(out) :: ierror 4428 4429 ! Local variables 4430 4431 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4432 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_o 4433 integer(c_int) :: c_loc_id, c_n_l_vals, c_val_type, c_ierror 4434 type(c_ptr) :: c_val 4435 4436 c_s_n = trim(sec_name)//c_null_char 4437 c_s_o = trim(old_name)//c_null_char 4438 c_loc_id = location_id 4439 c_n_l_vals = n_loc_vals 4440 c_val_type = RESTART_VAL_TYPE_INT_T 4441 c_val = c_loc(val) 4442 4443 c_ierror = cs_restart_read_section_compat(r, c_s_n, c_s_o, & 4444 c_loc_id, c_n_l_vals, & 4445 c_val_type, c_val) 4446 4447 ierror = c_ierror 4448 4449 end subroutine restart_read_int_t_compat 4450 4451 !--------------------------------------------------------------------------- 4452 4453 !> \brief Write a section of integers to a checkpoint file. 4454 4455 !> \param[in] r pointer to restart structure 4456 !> \param[in] sec_name name of section 4457 !> \param[in] location_id id of associated mesh location 4458 !> \param[in] n_loc_vals number of values per location 4459 !> \param[in] val values array 4460 4461 subroutine restart_write_section_int_t(r, sec_name, & 4462 location_id, n_loc_vals, val) 4463 4464 use, intrinsic :: iso_c_binding 4465 implicit none 4466 4467 ! Arguments 4468 4469 type(c_ptr), intent(in) :: r 4470 character(len=*), intent(in) :: sec_name 4471 integer, intent(in) :: location_id, n_loc_vals 4472 integer, dimension(*), intent(in), target :: val 4473 4474 ! Local variables 4475 4476 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4477 integer(c_int) :: c_loc_id, c_n_l_vals, c_val_type 4478 type(c_ptr) :: c_val 4479 4480 c_s_n = trim(sec_name)//c_null_char 4481 c_loc_id = location_id 4482 c_n_l_vals = n_loc_vals 4483 c_val_type = RESTART_VAL_TYPE_INT_T 4484 c_val = c_loc(val) 4485 4486 call cs_restart_write_section(r, c_s_n, c_loc_id, & 4487 c_n_l_vals, c_val_type, & 4488 c_val) 4489 4490 end subroutine restart_write_section_int_t 4491 4492 !--------------------------------------------------------------------------- 4493 4494 !> \brief Read a section of doubles from a restart file. 4495 4496 !> \param[in] r pointer to restart structure 4497 !> \param[in] sec_name name of section 4498 !> \param[in] location_id id of associated mesh location 4499 !> \param[in] n_loc_vals number of values per location 4500 !> \param[out] val values array 4501 !> \param[out] ierror 0: success, < 0: error code 4502 4503 subroutine restart_read_section_real_t(r, sec_name, & 4504 location_id, n_loc_vals, val, & 4505 ierror) 4506 4507 use, intrinsic :: iso_c_binding 4508 implicit none 4509 4510 ! Arguments 4511 4512 type(c_ptr), intent(in) :: r 4513 character(len=*), intent(in) :: sec_name 4514 integer, intent(in) :: location_id, n_loc_vals 4515 real(kind=c_double), dimension(*), target :: val 4516 integer, intent(out) :: ierror 4517 4518 ! Local variables 4519 4520 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4521 integer(c_int) :: c_loc_id, c_n_l_vals, c_val_type, c_ierror 4522 type(c_ptr) :: c_val 4523 4524 c_s_n = trim(sec_name)//c_null_char 4525 c_loc_id = location_id 4526 c_n_l_vals = n_loc_vals 4527 c_val_type = RESTART_VAL_TYPE_REAL_T 4528 c_val = c_loc(val) 4529 4530 c_ierror = cs_restart_read_section(r, c_s_n, c_loc_id, & 4531 c_n_l_vals, c_val_type, & 4532 c_val) 4533 4534 ierror = c_ierror 4535 4536 end subroutine restart_read_section_real_t 4537 4538 !--------------------------------------------------------------------------- 4539 4540 !> \brief Read a section of double precision reals from a restart file, 4541 !> when that section may have used a different name in a previous version. 4542 4543 !> \param[in] r pointer to restart structure 4544 !> \param[in] sec_name name of section 4545 !> \param[in] old_name old name of section 4546 !> \param[in] location_id id of associated mesh location 4547 !> \param[in] n_loc_vals number of values per location 4548 !> \param[out] val values array 4549 !> \param[out] ierror 0: success, < 0: error code 4550 4551 subroutine restart_read_real_t_compat(r, sec_name, old_name, & 4552 location_id, n_loc_vals, val, & 4553 ierror) 4554 4555 use, intrinsic :: iso_c_binding 4556 implicit none 4557 4558 ! Arguments 4559 4560 type(c_ptr), intent(in) :: r 4561 character(len=*), intent(in) :: sec_name 4562 character(len=*), intent(in) :: old_name 4563 integer, intent(in) :: location_id, n_loc_vals 4564 real(kind=c_double), dimension(*), target :: val 4565 integer, intent(out) :: ierror 4566 4567 ! Local variables 4568 4569 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4570 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_o 4571 integer(c_int) :: c_loc_id, c_n_l_vals, c_val_type, c_ierror 4572 type(c_ptr) :: c_val 4573 4574 c_s_n = trim(sec_name)//c_null_char 4575 c_s_o = trim(old_name)//c_null_char 4576 c_loc_id = location_id 4577 c_n_l_vals = n_loc_vals 4578 c_val_type = RESTART_VAL_TYPE_REAL_T 4579 c_val = c_loc(val) 4580 4581 c_ierror = cs_restart_read_section_compat(r, c_s_n, c_s_o, & 4582 c_loc_id, c_n_l_vals, & 4583 c_val_type, c_val) 4584 4585 ierror = c_ierror 4586 4587 end subroutine restart_read_real_t_compat 4588 4589 !--------------------------------------------------------------------------- 4590 4591 !> \brief Read a vector of double precision reals of dimension (3,*) from a 4592 !> restart file, when that section may have used a different name and 4593 !> been non-interleaved in a previous version. 4594 4595 !> \param[in] r pointer to restart structure 4596 !> \param[in] sec_name name of section 4597 !> \param[in] old_name_x old name of component x of section 4598 !> \param[in] old_name_y old name of component y of section 4599 !> \param[in] old_name_z old name of component z of section 4600 !> \param[in] location_id id of associated mesh location 4601 !> \param[out] val values array 4602 !> \param[out] ierror 0: success, < 0: error code 4603 4604 subroutine restart_read_real_3_t_compat(r, sec_name, & 4605 old_name_x, old_name_y, old_name_z, & 4606 location_id, val, ierror) 4607 4608 use, intrinsic :: iso_c_binding 4609 implicit none 4610 4611 ! Arguments 4612 4613 type(c_ptr), intent(in) :: r 4614 character(len=*), intent(in) :: sec_name 4615 character(len=*), intent(in) :: old_name_x, old_name_y, old_name_z 4616 integer, intent(in) :: location_id 4617 real(kind=c_double), dimension(*) :: val 4618 integer, intent(out) :: ierror 4619 4620 ! Local variables 4621 4622 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4623 character(len=len_trim(old_name_x)+1, kind=c_char) :: c_o_n_x 4624 character(len=len_trim(old_name_y)+1, kind=c_char) :: c_o_n_y 4625 character(len=len_trim(old_name_z)+1, kind=c_char) :: c_o_n_z 4626 integer(c_int) :: c_loc_id, c_ierror 4627 4628 c_s_n = trim(sec_name)//c_null_char 4629 c_o_n_x = trim(old_name_x)//c_null_char 4630 c_o_n_y = trim(old_name_y)//c_null_char 4631 c_o_n_z = trim(old_name_z)//c_null_char 4632 c_loc_id = location_id 4633 4634 c_ierror = cs_restart_read_real_3_t_compat(r, c_s_n, c_o_n_x, c_o_n_y, & 4635 c_o_n_z, c_loc_id, val) 4636 4637 ierror = c_ierror 4638 4639 end subroutine restart_read_real_3_t_compat 4640 4641 !--------------------------------------------------------------------------- 4642 4643 !> \brief write a section of doubles to a checkpoint file. 4644 4645 !> \param[in] r pointer to restart structure 4646 !> \param[in] sec_name name of section 4647 !> \param[in] location_id id of associated mesh location 4648 !> \param[in] n_loc_vals number of values per location 4649 !> \param[in] val values array 4650 4651 subroutine restart_write_section_real_t(r, sec_name, & 4652 location_id, n_loc_vals, val) 4653 4654 use, intrinsic :: iso_c_binding 4655 implicit none 4656 4657 ! Arguments 4658 4659 type(c_ptr), intent(in) :: r 4660 character(len=*), intent(in) :: sec_name 4661 integer, intent(in) :: location_id, n_loc_vals 4662 real(kind=c_double), dimension(*), target, intent(in) :: val 4663 4664 ! Local variables 4665 4666 character(len=len_trim(sec_name)+1, kind=c_char) :: c_s_n 4667 integer(c_int) :: c_loc_id, c_n_l_vals, c_val_type 4668 type(c_ptr) :: c_val 4669 4670 c_s_n = trim(sec_name)//c_null_char 4671 c_loc_id = location_id 4672 c_n_l_vals = n_loc_vals 4673 c_val_type = RESTART_VAL_TYPE_REAL_T 4674 c_val = c_loc(val) 4675 4676 call cs_restart_write_section(r, c_s_n, c_loc_id, & 4677 c_n_l_vals, c_val_type, & 4678 c_val) 4679 4680 end subroutine restart_write_section_real_t 4681 4682 !--------------------------------------------------------------------------- 4683 4684 !> \brief Read field values from checkpoint. 4685 4686 !> If the values are not found using the default rules based on the 4687 !> field's name, its name itself, or a "restart_rename" keyed string value, 4688 !> an old name may be used for compatibility with older files. 4689 !> For cell-based fields, the old name base is appended automatically with 4690 !> "_ce_phase01", except for scalars, where the name uses a different scheme, 4691 !> based on "scalaire_ce_%04" % s_num; 4692 4693 !> \param[in] r pointer to restart structure 4694 !> \param[in] f_id field id 4695 !> \param[in] t_id time id (0 for current, 1 for previous, ...) 4696 !> \param[out] ierror return code 4697 4698 subroutine restart_read_field_vals(r, f_id, t_id, ierror) 4699 use, intrinsic :: iso_c_binding 4700 implicit none 4701 4702 ! Arguments 4703 4704 type(c_ptr), intent(in) :: r 4705 integer, intent(in) :: f_id, t_id 4706 integer, intent(out) :: ierror 4707 4708 ! Local variables 4709 4710 integer(c_int) :: c_f_id, c_t_id, c_retcode 4711 c_f_id = f_id 4712 c_t_id = t_id 4713 4714 c_retcode = cs_restart_read_field_vals(r, c_f_id, c_t_id) 4715 ierror = c_retcode 4716 4717 end subroutine restart_read_field_vals 4718 4719 !--------------------------------------------------------------------------- 4720 4721 !> \brief Write field values to checkpoint. 4722 4723 !> \param[in] r pointer to restart structure 4724 !> \param[in] f_id field id 4725 !> \param[in] t_id time id (0 for current, 1 for previous, ...) 4726 4727 subroutine restart_write_field_vals(r, f_id, t_id) 4728 use, intrinsic :: iso_c_binding 4729 implicit none 4730 4731 ! Arguments 4732 4733 type(c_ptr), intent(in) :: r 4734 integer, intent(in) :: f_id, t_id 4735 4736 ! Local variables 4737 4738 integer(c_int) :: c_f_id, c_t_id 4739 c_f_id = f_id 4740 c_t_id = t_id 4741 4742 call cs_restart_write_field_vals(r, c_f_id, c_t_id) 4743 4744 end subroutine restart_write_field_vals 4745 4746 !--------------------------------------------------------------------------- 4747 4748 !> \brief Read fields depending on others from checkpoint. 4749 4750 !> \param[in] r pointer to restart structure 4751 !> \param[in] old_field_map pointer to old field map 4752 !> \param[in] key key for field association 4753 !> \param[out] n_w number of fields read 4754 4755 ! Interface to C function writing 4756 4757 subroutine restart_read_linked_fields(r, old_field_map, key, n_w) 4758 use, intrinsic :: iso_c_binding 4759 implicit none 4760 4761 ! Arguments 4762 4763 type(c_ptr), intent(in) :: r 4764 type(c_ptr), intent(in) :: old_field_map 4765 character(len=*), intent(in) :: key 4766 integer, intent(out) :: n_w 4767 4768 ! Local variables 4769 4770 integer(c_int) :: c_n_w 4771 character(len=len_trim(key)+1, kind=c_char) :: c_key 4772 4773 c_key = trim(key)//c_null_char 4774 4775 c_n_w = cs_restart_read_linked_fields(r, old_field_map, c_key, c_null_ptr) 4776 4777 n_w = c_n_w 4778 4779 end subroutine restart_read_linked_fields 4780 4781 !--------------------------------------------------------------------------- 4782 4783 !> \brief Write fields depending on others to checkpoint. 4784 4785 !> \param[in] r pointer to restart structure 4786 !> \param[in] key key for field association 4787 !> \param[out] n_w number of fields written 4788 4789 ! Interface to C function writing 4790 4791 subroutine restart_write_linked_fields(r, key, n_w) 4792 use, intrinsic :: iso_c_binding 4793 implicit none 4794 4795 ! Arguments 4796 4797 type(c_ptr), intent(in) :: r 4798 character(len=*), intent(in) :: key 4799 integer, intent(out) :: n_w 4800 4801 ! Local variables 4802 4803 integer(c_int) :: c_n_w 4804 character(len=len_trim(key)+1, kind=c_char) :: c_key 4805 4806 c_key = trim(key)//c_null_char 4807 4808 c_n_w = cs_restart_write_linked_fields(r, c_key, c_null_ptr) 4809 4810 n_w = c_n_w 4811 4812 end subroutine restart_write_linked_fields 4813 4814 !============================================================================= 4815 4816 !> \brief Call sparse linear equation solver using native matrix arrays. 4817 4818 !> param[in] f_id associated field id, or < 0 4819 !> param[in] name associated name if f_id < 0, or ignored 4820 !> param[in] isym symmetry indicator: 1 symmetric, 2: not symmetric 4821 !> param[in] ibsize block sizes for diagonal 4822 !> param[in] iesize block sizes for extra diagonal 4823 !> param[in] dam matrix diagonal 4824 !> param[in] xam matrix extra-diagonal terms 4825 !> param[in] epsilp precision for iterative resolution 4826 !> param[in] rnorm residue normalization 4827 !> param[out] niter number of "equivalent" iterations 4828 !> param[out] residue residue 4829 !> param[in] rhs right hand side 4830 !> param[in, out] vx system solution 4831 4832 subroutine sles_solve_native(f_id, name, isym, ibsize, iesize, dam, xam, & 4833 epsilp, rnorm, niter, residue, rhs, vx) 4834 use, intrinsic :: iso_c_binding 4835 implicit none 4836 4837 ! Arguments 4838 4839 character(len=*), intent(in) :: name 4840 integer, intent(in) :: f_id, isym, ibsize, iesize 4841 double precision, intent(in) :: rnorm, epsilp 4842 integer, intent(out) :: niter 4843 double precision, intent(out) :: residue 4844 real(kind=c_double), dimension(*), intent(in) :: dam, xam, rhs 4845 real(kind=c_double), dimension(*), intent(inout) :: vx 4846 4847 ! Local variables 4848 4849 character(len=len_trim(name)+1, kind=c_char) :: c_name 4850 integer(c_int) :: cvg 4851 integer(c_int), dimension(4) :: db_size, eb_size 4852 logical(kind=c_bool) :: c_sym 4853 4854 c_name = trim(name)//c_null_char 4855 4856 if (isym.eq.1) then 4857 c_sym = .true. 4858 else 4859 c_sym = .false. 4860 endif 4861 4862 db_size(1) = ibsize 4863 db_size(2) = ibsize 4864 db_size(3) = ibsize 4865 db_size(4) = ibsize*ibsize 4866 4867 eb_size(1) = iesize 4868 eb_size(2) = iesize 4869 eb_size(3) = iesize 4870 eb_size(4) = iesize*iesize 4871 4872 cvg = cs_sles_solve_native(f_id, c_name, c_sym, db_size, eb_size, & 4873 dam, xam, epsilp, rnorm, & 4874 niter, residue, rhs, vx) 4875 4876 return 4877 4878 end subroutine sles_solve_native 4879 4880 !============================================================================= 4881 4882 !> \brief Free sparse linear equation solver setup using native matrix arrays. 4883 4884 !> param[in] f_id associated field id, or < 0 4885 !> param[in] name associated name if f_id < 0, or ignored 4886 4887 subroutine sles_free_native(f_id, name) 4888 use, intrinsic :: iso_c_binding 4889 implicit none 4890 4891 ! Arguments 4892 4893 character(len=*), intent(in) :: name 4894 integer, intent(in) :: f_id 4895 4896 ! Local variables 4897 4898 character(len=len_trim(name)+1, kind=c_char) :: c_name 4899 4900 c_name = trim(name)//c_null_char 4901 4902 call cs_sles_free_native(f_id, c_name) 4903 4904 return 4905 4906 end subroutine sles_free_native 4907 4908 !============================================================================= 4909 4910 !> \brief Temporarily replace field id with name for matching calls 4911 !> to \ref sles_solve_native 4912 4913 !> param[in] f_id associated field id, or < 0 4914 !> param[in] name associated name if f_id < 0, or ignored 4915 4916 subroutine sles_push(f_id, name) 4917 use, intrinsic :: iso_c_binding 4918 implicit none 4919 4920 ! Arguments 4921 4922 character(len=*), intent(in) :: name 4923 integer, intent(in) :: f_id 4924 4925 ! Local variables 4926 4927 character(len=len_trim(name)+1, kind=c_char) :: c_name 4928 4929 c_name = trim(name)//c_null_char 4930 4931 call cs_sles_push(f_id, c_name) 4932 4933 return 4934 4935 end subroutine sles_push 4936 4937 !============================================================================= 4938 4939 !> \brief Revert to normal behavior of field id for matching calls 4940 !> to \ref sles_solve_native 4941 4942 !> param[in] f_id associated field id, or < 0 4943 4944 subroutine sles_pop(f_id) 4945 use, intrinsic :: iso_c_binding 4946 implicit none 4947 4948 ! Arguments 4949 4950 integer, intent(in) :: f_id 4951 4952 ! Local variables 4953 4954 call cs_sles_pop(f_id) 4955 4956 return 4957 4958 end subroutine sles_pop 4959 4960 !============================================================================= 4961 4962 !> \brief Create a timer statistics structure. 4963 4964 !> If no timer with the given name exists, -1 is returned. 4965 4966 !> \param[in] parent_name name of parent statistic (may be empty) 4967 !> \param[in] name associated canonical name 4968 !> \param[in] label associated label (may be empty) 4969 4970 function timer_stats_create (parent_name, name, label) result(id) 4971 4972 use, intrinsic :: iso_c_binding 4973 implicit none 4974 4975 ! Arguments 4976 4977 character(len=*), intent(in) :: parent_name, name, label 4978 integer :: id 4979 4980 ! Local variables 4981 4982 character(len=len_trim(parent_name)+1, kind=c_char) :: c_p_name 4983 character(len=len_trim(name)+1, kind=c_char) :: c_name 4984 character(len=len_trim(label)+1, kind=c_char) :: c_label 4985 integer(c_int) :: c_id 4986 4987 c_p_name = trim(parent_name)//c_null_char 4988 c_name = trim(name)//c_null_char 4989 c_label = trim(label)//c_null_char 4990 4991 c_id = cs_timer_stats_create(c_p_name, c_name, c_label) 4992 id = c_id 4993 4994 end function timer_stats_create 4995 4996 !============================================================================= 4997 4998 !> \brief Return the id of a defined statistic based on its name. 4999 5000 !> If no timer with the given name exists, -1 is returned. 5001 5002 !> \param[in] name statistic name 5003 5004 function timer_stats_id_by_name(name) result(id) 5005 5006 use, intrinsic :: iso_c_binding 5007 implicit none 5008 5009 ! Arguments 5010 5011 character(len=*), intent(in) :: name 5012 integer :: id 5013 5014 ! Local variables 5015 5016 character(len=len_trim(name)+1, kind=c_char) :: c_name 5017 integer(c_int) :: c_id 5018 5019 c_name = trim(name)//c_null_char 5020 5021 c_id = cs_timer_stats_id_by_name(c_name) 5022 id = c_id 5023 5024 end function timer_stats_id_by_name 5025 5026 !============================================================================= 5027 5028 !> \brief Add field defining a general solved variable, with default options. 5029 5030 !> \param[in] name field name 5031 !> \param[in] label field default label, or empty 5032 !> \param[in] location_id field location type: 5033 !> 0: none 5034 !> 1: cells 5035 !> 2: interior faces 5036 !> 3: interior faces 5037 !> 4: vertices 5038 !> \param[in] dim field dimension 5039 !> \param[out] id id of defined field 5040 5041 subroutine variable_field_create(name, label, location_id, dim, id) 5042 5043 use, intrinsic :: iso_c_binding 5044 implicit none 5045 5046 ! Arguments 5047 5048 character(len=*), intent(in) :: name, label 5049 integer, intent(in) :: location_id, dim 5050 integer, intent(out) :: id 5051 5052 ! Local variables 5053 5054 character(len=len_trim(name)+1, kind=c_char) :: c_name 5055 character(len=len_trim(label)+1, kind=c_char) :: c_label 5056 integer(c_int) :: c_location_id, c_dim, c_id 5057 5058 c_name = trim(name)//c_null_char 5059 c_label = trim(label)//c_null_char 5060 c_location_id = location_id 5061 c_dim = dim 5062 5063 c_id = cs_variable_field_create(c_name, c_label, c_location_id, c_dim) 5064 5065 id = c_id 5066 5067 return 5068 5069 end subroutine variable_field_create 5070 5071 !============================================================================= 5072 5073 !> \brief Add a CDO field defining a general solved variable, with default 5074 !> options. 5075 5076 !> \param[in] name field name 5077 !> \param[in] label field default label, or empty 5078 !> \param[in] location_id field location type: 5079 !> 0: none 5080 !> 1: cells 5081 !> 2: interior faces 5082 !> 3: interior faces 5083 !> 4: vertices 5084 !> \param[in] dim field dimension 5085 !> \param[in] has_previous if greater than 1 then store previous state 5086 !> \param[out] id id of defined field 5087 5088 subroutine variable_cdo_field_create(name, label, location_id, dim, & 5089 has_previous, id) 5090 5091 use, intrinsic :: iso_c_binding 5092 implicit none 5093 5094 ! Arguments 5095 5096 character(len=*), intent(in) :: name, label 5097 integer, intent(in) :: location_id, dim, has_previous 5098 integer, intent(out) :: id 5099 5100 ! Local variables 5101 5102 character(len=len_trim(name)+1, kind=c_char) :: c_name 5103 character(len=len_trim(label)+1, kind=c_char) :: c_label 5104 integer(c_int) :: c_location_id, c_dim, c_has_previous, c_id 5105 5106 c_name = trim(name)//c_null_char 5107 c_label = trim(label)//c_null_char 5108 c_location_id = location_id 5109 c_dim = dim 5110 c_has_previous = has_previous; 5111 5112 c_id = cs_variable_cdo_field_create(c_name, c_label, c_location_id, & 5113 c_dim, c_has_previous) 5114 5115 id = c_id 5116 5117 return 5118 5119 end subroutine variable_cdo_field_create 5120 5121 !============================================================================= 5122 5123 !> \brief Return the number of volume zones associated with a given type flag. 5124 5125 !> \param[in] type_flag type flag queried 5126 5127 function volume_zone_n_type_zones(type_flag) result(n) 5128 5129 use, intrinsic :: iso_c_binding 5130 implicit none 5131 5132 ! Arguments 5133 5134 integer :: type_flag, n 5135 5136 ! Local variables 5137 5138 integer(c_int) :: c_type_flag, c_count 5139 5140 c_type_flag = type_flag 5141 c_count = cs_volume_zone_n_type_zones(c_type_flag) 5142 n = c_count 5143 5144 end function volume_zone_n_type_zones 5145 5146 !============================================================================= 5147 5148 !> \brief Return the number of volume zone cells associated with a given 5149 !> type flag. 5150 5151 !> \param[in] type_flag type flag queried 5152 5153 function volume_zone_n_type_cells(type_flag) result(n) 5154 5155 use, intrinsic :: iso_c_binding 5156 implicit none 5157 5158 ! Arguments 5159 5160 integer :: type_flag, n 5161 5162 ! Local variables 5163 5164 integer(c_int) :: c_type_flag, c_count 5165 5166 c_type_flag = type_flag 5167 c_count = cs_volume_zone_n_type_cells(c_type_flag) 5168 n = c_count 5169 5170 end function volume_zone_n_type_cells 5171 5172 !============================================================================= 5173 5174 !> \brief Return the list of volume zone cells associated with a given 5175 !> type flag. 5176 5177 !> \param[in] type_flag type flag queried 5178 !> \param[out] cell_list list of cells 5179 5180 subroutine volume_zone_select_type_cells(type_flag, cell_list) 5181 5182 use, intrinsic :: iso_c_binding 5183 implicit none 5184 5185 ! Arguments 5186 5187 integer :: type_flag 5188 integer, dimension(*), intent(out), target :: cell_list 5189 5190 ! Local variables 5191 5192 integer(c_int) :: c_type_flag, c_count, i 5193 type(c_ptr) :: c_cell_list 5194 5195 c_type_flag = type_flag 5196 c_cell_list = c_loc(cell_list) 5197 c_count = volume_zone_n_type_cells(c_type_flag) 5198 call cs_volume_zone_select_type_cells(c_type_flag, c_cell_list) 5199 do i = 1, c_count 5200 cell_list(i) = cell_list(i) + 1 5201 enddo 5202 5203 end subroutine volume_zone_select_type_cells 5204 5205 !============================================================================= 5206 5207 !> \brief Return pointer to coupling face indicator for a field 5208 5209 !> \param[in] f_id id of given field 5210 !> \param[out] cpl_faces pointer to coupling face indicator 5211 5212 subroutine field_get_coupled_faces(f_id, cpl_faces) 5213 5214 use, intrinsic :: iso_c_binding 5215 use mesh, only:nfabor 5216 5217 implicit none 5218 5219 ! Arguments 5220 5221 integer, intent(in) :: f_id 5222 logical(kind=c_bool), dimension(:), pointer, intent(inout) :: cpl_faces 5223 5224 ! Local variables 5225 type(c_ptr) :: c_p 5226 5227 call cs_f_ic_field_coupled_faces(f_id, c_p) 5228 call c_f_pointer(c_p, cpl_faces, [nfabor]) 5229 5230 return 5231 5232 end subroutine field_get_coupled_faces 5233 5234 !============================================================================= 5235 5236 !> \brief Return notebook parameter value 5237 5238 !> \param[in] name name of the notebook parameter 5239 !> \result val 5240 5241 function notebook_parameter_value_by_name(name) result(val) 5242 5243 use, intrinsic :: iso_c_binding 5244 implicit none 5245 5246 ! Arguments 5247 5248 character(len=*), intent(in) :: name 5249 double precision :: val 5250 5251 ! Local variables 5252 5253 character(len=len_trim(name)+1, kind=c_char) :: c_name 5254 real(kind=c_double) :: c_val 5255 5256 c_name = trim(name)//c_null_char 5257 5258 c_val = cs_f_notebook_parameter_value_by_name(c_name) 5259 val = c_val 5260 5261 end function notebook_parameter_value_by_name 5262 5263 !============================================================================= 5264 5265 !> \brief Indicate of a cell is active fo the current variable 5266 5267 !> \param[in] iel cell number (cell_id + 1) 5268 !> \result is_active 5269 5270 function cell_is_active(iel) result(is_active) 5271 5272 use, intrinsic :: iso_c_binding 5273 implicit none 5274 5275 ! Arguments 5276 5277 integer :: iel 5278 integer :: is_active 5279 5280 ! Local variables 5281 5282 integer(kind=c_int) :: c_cell_id 5283 integer(kind=c_int) :: c_is_active 5284 5285 5286 c_cell_id = iel - 1 5287 c_is_active = cs_f_porous_model_cell_is_active(c_cell_id) 5288 is_active = c_is_active 5289 5290 end function cell_is_active 5291 5292 !============================================================================= 5293 5294 !> \brief Sets the meteo file name 5295 5296 !> \param[in] name name of the file 5297 5298 subroutine atmo_set_meteo_file_name(name) 5299 5300 use, intrinsic :: iso_c_binding 5301 implicit none 5302 5303 ! Arguments 5304 5305 character(len=*), intent(in) :: name 5306 5307 ! Local variables 5308 5309 character(len=len_trim(name)+1, kind=c_char) :: c_name 5310 5311 c_name = trim(name)//c_null_char 5312 call cs_atmo_set_meteo_file_name(c_name) 5313 5314 end subroutine atmo_set_meteo_file_name 5315 5316 !============================================================================= 5317 5318 !> \brief Sets the chemistry concentration file name 5319 5320 !> \param[in] name name of the file 5321 5322 subroutine atmo_set_chem_conc_file_name(name) 5323 5324 use, intrinsic :: iso_c_binding 5325 implicit none 5326 5327 ! Arguments 5328 5329 character(len=*), intent(in) :: name 5330 5331 ! Local variables 5332 5333 character(len=len_trim(name)+1, kind=c_char) :: c_name 5334 5335 c_name = trim(name)//c_null_char 5336 call cs_atmo_set_chem_conc_file_name(c_name) 5337 5338 end subroutine atmo_set_chem_conc_file_name 5339 5340 !============================================================================= 5341 5342 !> \brief Sets the aerosol concentration file name 5343 5344 !> \param[in] name name of the file 5345 5346 subroutine atmo_set_aero_conc_file_name(name) 5347 5348 use, intrinsic :: iso_c_binding 5349 implicit none 5350 5351 ! Arguments 5352 5353 character(len=*), intent(in) :: name 5354 5355 ! Local variables 5356 5357 character(len=len_trim(name)+1, kind=c_char) :: c_name 5358 5359 c_name = trim(name)//c_null_char 5360 call cs_atmo_set_aero_conc_file_name(c_name) 5361 5362 end subroutine atmo_set_aero_conc_file_name 5363 5364 !============================================================================= 5365 5366 !> \brief Sets the file name used to initialize SPACK 5367 5368 !> \param[in] name name of the file 5369 5370 subroutine atmo_chemistry_set_spack_file_name(name) 5371 5372 use, intrinsic :: iso_c_binding 5373 implicit none 5374 5375 ! Arguments 5376 5377 character(len=*), intent(in) :: name 5378 5379 ! Local variables 5380 5381 character(len=len_trim(name)+1, kind=c_char) :: c_name 5382 5383 c_name = trim(name)//c_null_char 5384 call cs_atmo_chemistry_set_spack_file_name(c_name) 5385 5386 end subroutine atmo_chemistry_set_spack_file_name 5387 5388 !============================================================================= 5389 5390 !> \brief Sets the file name used to initialize the aerosol shared library 5391 5392 !> \param[in] name name of the file 5393 5394 subroutine atmo_chemistry_set_aerosol_file_name(name) 5395 5396 use, intrinsic :: iso_c_binding 5397 implicit none 5398 5399 ! Arguments 5400 5401 character(len=*), intent(in) :: name 5402 5403 ! Local variables 5404 5405 character(len=len_trim(name)+1, kind=c_char) :: c_name 5406 5407 c_name = trim(name)//c_null_char 5408 call cs_atmo_chemistry_set_aerosol_file_name(c_name) 5409 5410 end subroutine atmo_chemistry_set_aerosol_file_name 5411 5412 !============================================================================= 5413 5414 end module cs_c_bindings 5415