1! 2! CDDL HEADER START 3! 4! The contents of this file are subject to the terms of the Common Development 5! and Distribution License Version 1.0 (the "License"). 6! 7! You can obtain a copy of the license at 8! http://www.opensource.org/licenses/CDDL-1.0. See the License for the 9! specific language governing permissions and limitations under the License. 10! 11! When distributing Covered Code, include this CDDL HEADER in each file and 12! include the License file in a prominent location with the name LICENSE.CDDL. 13! If applicable, add the following below this CDDL HEADER, with the fields 14! enclosed by brackets "[]" replaced with your own identifying information: 15! 16! Portions Copyright (c) [yyyy] [name of copyright owner]. All rights reserved. 17! 18! CDDL HEADER END 19! 20 21! 22! Copyright (c) 2016--2020, Regents of the University of Minnesota. 23! All rights reserved. 24! 25! Contributors: 26! Ryan S. Elliott 27! 28 29! 30! Release: This file is part of the kim-api-2.2.1 package. 31! 32 33!> \brief \copybrief KIM::ModelComputeArguments 34!! 35!! \sa KIM::ModelComputeArguments, KIM_ModelComputeArguments 36!! 37!! \since 2.0 38module kim_model_compute_arguments_module 39 use, intrinsic :: iso_c_binding 40 implicit none 41 private 42 43 public & 44 ! Derived types 45 kim_model_compute_arguments_handle_type, & 46 ! Constants 47 KIM_MODEL_COMPUTE_ARGUMENTS_NULL_HANDLE, & 48 ! Routines 49 operator(.eq.), & 50 operator(.ne.), & 51 kim_get_neighbor_list, & 52 kim_process_dedr_term, & 53 kim_process_d2edr2_term, & 54 kim_get_argument_pointer, & 55 kim_is_callback_present, & 56 kim_set_model_buffer_pointer, & 57 kim_get_model_buffer_pointer, & 58 kim_log_entry, & 59 kim_to_string 60 61 !> \brief \copybrief KIM::ModelComputeArguments 62 !! 63 !! \sa KIM::ModelComputeArguments, KIM_ModelComputeArguments 64 !! 65 !! \since 2.0 66 type, bind(c) :: kim_model_compute_arguments_handle_type 67 type(c_ptr) :: p = c_null_ptr 68 end type kim_model_compute_arguments_handle_type 69 70 !> \brief NULL handle for use in comparisons. 71 !! 72 !! \since 2.0 73 type(kim_model_compute_arguments_handle_type), protected, save & 74 :: KIM_MODEL_COMPUTE_ARGUMENTS_NULL_HANDLE 75 76 !> \brief Compares kim_model_compute_arguments_handle_type's for 77 !! equality. 78 !! 79 !! \since 2.0 80 interface operator(.eq.) 81 module procedure kim_model_compute_arguments_handle_equal 82 end interface operator(.eq.) 83 84 !> \brief Compares kim_model_compute_arguments_handle_type's for 85 !! inequality. 86 !! 87 !! \since 2.0 88 interface operator(.ne.) 89 module procedure kim_model_compute_arguments_handle_not_equal 90 end interface operator(.ne.) 91 92 !> \brief \copybrief KIM::ModelComputeArguments::GetNeighborList 93 !! 94 !! \sa KIM::ModelComputeArguments::GetNeighborList, 95 !! KIM_ModelComputeArguments_GetNeighborList 96 !! 97 !! \since 2.0 98 interface kim_get_neighbor_list 99 module procedure kim_model_compute_arguments_get_neighbor_list 100 end interface kim_get_neighbor_list 101 102 !> \brief \copybrief KIM::ModelComputeArguments::ProcessDEDrTerm 103 !! 104 !! \sa KIM::ModelComputeArguments::ProcessDEDrTerm, 105 !! KIM_ModelComputeArguments_ProcessDEDrTerm 106 !! 107 !! \since 2.0 108 interface kim_process_dedr_term 109 module procedure kim_model_compute_arguments_process_dedr_term 110 end interface kim_process_dedr_term 111 112 !> \brief \copybrief KIM::ModelComputeArguments::ProcessD2EDr2Term 113 !! 114 !! \sa KIM::ModelComputeArguments::ProcessD2EDr2Term, 115 !! KIM_ModelComputeArguments_ProcessD2EDr2Term 116 !! 117 !! \since 2.0 118 interface kim_process_d2edr2_term 119 module procedure kim_model_compute_arguments_process_d2edr2_term 120 end interface kim_process_d2edr2_term 121 122 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 123 !! 124 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 125 !! KIM_ModelComputeArguments_GetArgumentPointerInteger, 126 !! KIM_ModelComputeArguments_GetArgumentPointerDouble 127 !! 128 !! \since 2.0 129 interface kim_get_argument_pointer 130 module procedure kim_model_compute_arguments_get_argument_pointer_int0 131 module procedure kim_model_compute_arguments_get_argument_pointer_int1 132 module procedure kim_model_compute_arguments_get_argument_pointer_int2 133 module procedure kim_model_compute_arguments_get_argument_pointer_double0 134 module procedure kim_model_compute_arguments_get_argument_pointer_double1 135 module procedure kim_model_compute_arguments_get_argument_pointer_double2 136 end interface kim_get_argument_pointer 137 138 !> \brief \copybrief KIM::ModelComputeArguments::IsCallbackPresent 139 !! 140 !! \sa KIM::ModelComputeArguments::IsCallbackPresent, 141 !! KIM_ModelComputeArguments_IsCallbackPresent 142 !! 143 !! \since 2.0 144 interface kim_is_callback_present 145 module procedure kim_model_compute_arguments_is_callback_present 146 end interface kim_is_callback_present 147 148 !> \brief \copybrief KIM::ModelComputeArguments::SetModelBufferPointer 149 !! 150 !! \sa KIM::ModelComputeArguments::SetModelBufferPointer, 151 !! KIM_ModelComputeArguments_SetModelBufferPointer 152 !! 153 !! \since 2.0 154 interface kim_set_model_buffer_pointer 155 module procedure kim_model_compute_arguments_set_model_buffer_pointer 156 end interface kim_set_model_buffer_pointer 157 158 !> \brief \copybrief KIM::ModelComputeArguments::GetModelBufferPointer 159 !! 160 !! \sa KIM::ModelComputeArguments::GetModelBufferPointer, 161 !! KIM_ModelComputeArguments_GetModelBufferPointer 162 !! 163 !! \since 2.0 164 interface kim_get_model_buffer_pointer 165 module procedure kim_model_compute_arguments_get_model_buffer_pointer 166 end interface kim_get_model_buffer_pointer 167 168 !> \brief \copybrief KIM::ModelComputeArguments::LogEntry 169 !! 170 !! \sa KIM::ModelComputeArguments::LogEntry, 171 !! KIM_ModelComputeArguments_LogEntry 172 !! 173 !! \since 2.0 174 interface kim_log_entry 175 module procedure kim_model_compute_arguments_log_entry 176 end interface kim_log_entry 177 178 !> \brief \copybrief KIM::ModelComputeArguments::ToString 179 !! 180 !! \sa KIM::ModelComputeArguments::ToString, 181 !! KIM_ModelComputeArguments_ToString 182 !! 183 !! \since 2.0 184 interface kim_to_string 185 module procedure kim_model_compute_arguments_to_string 186 end interface kim_to_string 187 188contains 189 !> \brief Compares kim_model_compute_arguments_handle_type's for 190 !! equality. 191 !! 192 !! \since 2.0 193 logical recursive function kim_model_compute_arguments_handle_equal(lhs, rhs) 194 implicit none 195 type(kim_model_compute_arguments_handle_type), intent(in) :: lhs 196 type(kim_model_compute_arguments_handle_type), intent(in) :: rhs 197 198 if ((.not. c_associated(lhs%p)) .and. (.not. c_associated(rhs%p))) then 199 kim_model_compute_arguments_handle_equal = .true. 200 else 201 kim_model_compute_arguments_handle_equal = c_associated(lhs%p, rhs%p) 202 end if 203 end function kim_model_compute_arguments_handle_equal 204 205 !> \brief Compares kim_model_compute_arguments_handle_type's for 206 !! inequality. 207 !! 208 !! \since 2.0 209 logical recursive function kim_model_compute_arguments_handle_not_equal(lhs, & 210 rhs) 211 implicit none 212 type(kim_model_compute_arguments_handle_type), intent(in) :: lhs 213 type(kim_model_compute_arguments_handle_type), intent(in) :: rhs 214 215 kim_model_compute_arguments_handle_not_equal = .not. (lhs == rhs) 216 end function kim_model_compute_arguments_handle_not_equal 217 218 !> \brief \copybrief KIM::ModelComputeArguments::GetNeighborList 219 !! 220 !! A Fortran PM must provide a KIM::MODEL_ROUTINE_NAME::GetNeighbotList 221 !! routine. The interface for this is given here (see also 222 !! KIM::GetNeighborListFunction, \ref KIM_GetNeighborListFunction). 223 !! 224 !! \code{.f90} 225 !! interface 226 !! recursive subroutine get_neighbor_list(data_object, & 227 !! number_of_neighbor_lists, cutoffs, neighbor_list_index, & 228 !! particle_number, number_of_neighbors, neighbors_of_particle, ierr) & 229 !! bind(c) 230 !! use, intrinsic :: iso_c_binding 231 !! implicit none 232 !! type(c_ptr), intent(in), value :: data_object 233 !! integer(c_int), intent(in), value :: number_of_neighbor_lists 234 !! real(c_double), intent(in) :: cutoffs(*) 235 !! integer(c_int), intent(in), value :: neighbor_list_index 236 !! integer(c_int), intent(in), value :: particle_number 237 !! integer(c_int), intent(out) :: number_of_neighbors 238 !! type(c_ptr), intent(out) :: neighbors_of_particle 239 !! integer(c_int), intent(out) :: ierr 240 !! end subroutine get_neighbor_ilst 241 !! end interface 242 !! \endcode 243 !! 244 !! \note The use of the "assumed size" type for `cutoffs` above is necessary 245 !! for strict conformance to the Fortran/C interoperability standard. The 246 !! cutoffs array is expected to be of shape \c [number_of_neighbor_lists]. 247 !! 248 !! \sa KIM::ModelComputeArguments::GetNeighborList, 249 !! KIM_ModelComputeArguments_GetNeighborList 250 !! 251 !! \since 2.0 252 recursive subroutine kim_model_compute_arguments_get_neighbor_list( & 253 model_compute_arguments_handle, neighbor_list_index, particle_number, & 254 number_of_neighbors, neighbors_of_particle, ierr) 255 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 256 implicit none 257 interface 258 integer(c_int) recursive function get_neighbor_list( & 259 model_compute_arguments, neighbor_list_index, particle_number, & 260 number_of_neighbors, neighbors_of_particle) & 261 bind(c, name="KIM_ModelComputeArguments_GetNeighborList") 262 use, intrinsic :: iso_c_binding 263 use kim_interoperable_types_module, only: & 264 kim_model_compute_arguments_type 265 implicit none 266 type(kim_model_compute_arguments_type), intent(in) :: & 267 model_compute_arguments 268 integer(c_int), intent(in), value :: neighbor_list_index 269 integer(c_int), intent(in), value :: particle_number 270 integer(c_int), intent(out) :: number_of_neighbors 271 type(c_ptr), intent(out) :: neighbors_of_particle 272 end function get_neighbor_list 273 end interface 274 type(kim_model_compute_arguments_handle_type), intent(in) :: & 275 model_compute_arguments_handle 276 integer(c_int), intent(in) :: neighbor_list_index 277 integer(c_int), intent(in) :: particle_number 278 integer(c_int), intent(out) :: number_of_neighbors 279 integer(c_int), intent(out), pointer :: neighbors_of_particle(:) 280 integer(c_int), intent(out) :: ierr 281 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 282 283 type(c_ptr) p 284 285 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 286 ierr = get_neighbor_list(model_compute_arguments, neighbor_list_index - 1, & 287 particle_number, number_of_neighbors, p) 288 if (c_associated(p)) then 289 call c_f_pointer(p, neighbors_of_particle, [number_of_neighbors]) 290 else 291 nullify (neighbors_of_particle) 292 end if 293 end subroutine kim_model_compute_arguments_get_neighbor_list 294 295 !> \brief \copybrief KIM::ModelComputeArguments::ProcessDEDrTerm 296 !! 297 !! A Fortran PM may provide a KIM::MODEL_ROUTINE_NAME::ProcessDEDrTerm 298 !! routine. The interface for this is given here (see also 299 !! KIM::ProcessDEDrTermFunction, \ref KIM_ProcessDEDrTermFunction). 300 !! 301 !! \code{.f90} 302 !! interface 303 !! recursive subroutine process_dedr_term(data_object, de, r, dx, i, j, & 304 !! ierr) bind(c) 305 !! use, intrinsic :: iso_c_binding 306 !! implicit none 307 !! type(c_ptr), intent(in), value :: data_object 308 !! real(c_double), intent(in), value :: de 309 !! real(c_double), intent(in), value :: r 310 !! real(c_double), intent(in) :: dx(3) 311 !! integer(c_int), intent(in), value :: i 312 !! integer(c_int), intent(in), value :: j 313 !! integer(c_int), intent(out) :: ierr 314 !! end subroutine process_dedr_term 315 !! end interface 316 !! \endcode 317 !! 318 !! \sa KIM::ModelComputeArguments::ProcessDEDrTerm, 319 !! KIM_ModelComputeArguments_ProcessDEDrTerm 320 !! 321 !! \since 2.0 322 recursive subroutine kim_model_compute_arguments_process_dedr_term( & 323 model_compute_arguments_handle, de, r, dx, i, j, ierr) 324 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 325 implicit none 326 interface 327 integer(c_int) recursive function process_dedr_term( & 328 model_compute_arguments, de, r, dx, i, j) & 329 bind(c, name="KIM_ModelComputeArguments_ProcessDEDrTerm") 330 use, intrinsic :: iso_c_binding 331 use kim_interoperable_types_module, only: & 332 kim_model_compute_arguments_type 333 implicit none 334 type(kim_model_compute_arguments_type), intent(in) :: & 335 model_compute_arguments 336 real(c_double), intent(in), value :: de 337 real(c_double), intent(in), value :: r 338 real(c_double), intent(in) :: dx 339 integer(c_int), intent(in), value :: i 340 integer(c_int), intent(in), value :: j 341 end function process_dedr_term 342 end interface 343 type(kim_model_compute_arguments_handle_type), intent(in) :: & 344 model_compute_arguments_handle 345 real(c_double), intent(in) :: de 346 real(c_double), intent(in) :: r 347 real(c_double), intent(in) :: dx(:) 348 integer(c_int), intent(in) :: i 349 integer(c_int), intent(in) :: j 350 integer(c_int), intent(out) :: ierr 351 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 352 353 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 354 ierr = process_dedr_term(model_compute_arguments, de, r, dx(1), i, j) 355 end subroutine kim_model_compute_arguments_process_dedr_term 356 357 !> \brief \copybrief KIM::ModelComputeArguments::ProcessD2EDr2Term 358 !! 359 !! A Fortran PM may provide a KIM::MODEL_ROUTINE_NAME::ProcessD2EDr2Term 360 !! routine. The interface for this is given here (see also 361 !! KIM::ProcessD2EDr2TermFunction, \ref KIM_ProcessD2EDr2TermFunction). 362 !! 363 !! \code{.f90} 364 !! interface 365 !! recursive subroutine process_d2edr2_term(data_object, de, r, dx, i, j, & 366 !! ierr) bind(c) 367 !! use, intrinsic :: iso_c_binding 368 !! implicit none 369 !! type(c_ptr), intent(in), value :: data_object 370 !! real(c_double), intent(in), value :: de 371 !! real(c_double), intent(in) :: r(2) 372 !! real(c_double), intent(in) :: dx(3,2) 373 !! integer(c_int), intent(in) :: i(2) 374 !! integer(c_int), intent(in) :: j(2) 375 !! integer(c_int), intent(out) :: ierr 376 !! end subroutine process_d2edr2_term 377 !! end interface 378 !! \endcode 379 !! 380 !! \sa KIM::ModelComputeArguments::ProcessD2EDr2Term, 381 !! KIM_ModelComputeArguments_ProcessD2EDr2Term 382 !! 383 !! \since 2.0 384 recursive subroutine kim_model_compute_arguments_process_d2edr2_term( & 385 model_compute_arguments_handle, de, r, dx, i, j, ierr) 386 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 387 implicit none 388 interface 389 integer(c_int) recursive function process_d2edr2_term( & 390 model_compute_arguments, de, r, dx, i, j) & 391 bind(c, name="KIM_ModelComputeArguments_ProcessD2EDr2Term") 392 use, intrinsic :: iso_c_binding 393 use kim_interoperable_types_module, only: & 394 kim_model_compute_arguments_type 395 implicit none 396 type(kim_model_compute_arguments_type), intent(in) :: & 397 model_compute_arguments 398 real(c_double), intent(in), value :: de 399 real(c_double), intent(in) :: r 400 real(c_double), intent(in) :: dx 401 integer(c_int), intent(in) :: i 402 integer(c_int), intent(in) :: j 403 end function process_d2edr2_term 404 end interface 405 type(kim_model_compute_arguments_handle_type), intent(in) :: & 406 model_compute_arguments_handle 407 real(c_double), intent(in) :: de 408 real(c_double), intent(in) :: r(:) 409 real(c_double), intent(in) :: dx(:, :) 410 integer(c_int), intent(in) :: i(:) 411 integer(c_int), intent(in) :: j(:) 412 integer(c_int), intent(out) :: ierr 413 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 414 415 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 416 ierr = process_d2edr2_term(model_compute_arguments, & 417 de, r(1), dx(1, 1), i(1), j(1)) 418 end subroutine kim_model_compute_arguments_process_d2edr2_term 419 420 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 421 !! 422 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 423 !! KIM_ModelComputeArguments_GetArgumentPointerInteger 424 !! 425 !! \since 2.0 426 recursive subroutine kim_model_compute_arguments_get_argument_pointer_int0( & 427 model_compute_arguments_handle, compute_argument_name, int0, ierr) 428 use kim_compute_argument_name_module, only: kim_compute_argument_name_type 429 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 430 implicit none 431 interface 432 integer(c_int) recursive function get_argument_pointer_integer( & 433 model_compute_arguments, compute_argument_name, ptr) & 434 bind(c, name="KIM_ModelComputeArguments_GetArgumentPointerInteger") 435 use, intrinsic :: iso_c_binding 436 use kim_compute_argument_name_module, only: & 437 kim_compute_argument_name_type 438 use kim_interoperable_types_module, only: & 439 kim_model_compute_arguments_type 440 implicit none 441 type(kim_model_compute_arguments_type), intent(in) :: & 442 model_compute_arguments 443 type(kim_compute_argument_name_type), intent(in), value :: & 444 compute_argument_name 445 type(c_ptr), intent(out) :: ptr 446 end function get_argument_pointer_integer 447 end interface 448 type(kim_model_compute_arguments_handle_type), intent(in) :: & 449 model_compute_arguments_handle 450 type(kim_compute_argument_name_type), intent(in) :: & 451 compute_argument_name 452 integer(c_int), intent(out), pointer :: int0 453 integer(c_int), intent(out) :: ierr 454 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 455 456 type(c_ptr) p 457 458 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 459 ierr = get_argument_pointer_integer(model_compute_arguments, & 460 compute_argument_name, p) 461 if (c_associated(p)) then 462 call c_f_pointer(p, int0) 463 else 464 nullify (int0) 465 end if 466 end subroutine kim_model_compute_arguments_get_argument_pointer_int0 467 468 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 469 !! 470 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 471 !! KIM_ModelComputeArguments_GetArgumentPointerInteger 472 !! 473 !! \since 2.0 474 recursive subroutine kim_model_compute_arguments_get_argument_pointer_int1( & 475 model_compute_arguments_handle, compute_argument_name, extent1, int1, ierr) 476 use kim_compute_argument_name_module, only: kim_compute_argument_name_type 477 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 478 implicit none 479 interface 480 integer(c_int) recursive function get_argument_pointer_integer( & 481 model_compute_arguments, compute_argument_name, ptr) & 482 bind(c, name="KIM_ModelComputeArguments_GetArgumentPointerInteger") 483 use, intrinsic :: iso_c_binding 484 use kim_compute_argument_name_module, only: & 485 kim_compute_argument_name_type 486 use kim_interoperable_types_module, only: & 487 kim_model_compute_arguments_type 488 implicit none 489 type(kim_model_compute_arguments_type), intent(in) :: & 490 model_compute_arguments 491 type(kim_compute_argument_name_type), intent(in), value :: & 492 compute_argument_name 493 type(c_ptr), intent(out) :: ptr 494 end function get_argument_pointer_integer 495 end interface 496 type(kim_model_compute_arguments_handle_type), intent(in) :: & 497 model_compute_arguments_handle 498 type(kim_compute_argument_name_type), intent(in) :: & 499 compute_argument_name 500 integer(c_int), intent(in) :: extent1 501 integer(c_int), intent(out), pointer :: int1(:) 502 integer(c_int), intent(out) :: ierr 503 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 504 505 type(c_ptr) p 506 507 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 508 ierr = get_argument_pointer_integer(model_compute_arguments, & 509 compute_argument_name, p) 510 if (c_associated(p)) then 511 call c_f_pointer(p, int1, [extent1]) 512 else 513 nullify (int1) 514 end if 515 516 end subroutine kim_model_compute_arguments_get_argument_pointer_int1 517 518 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 519 !! 520 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 521 !! KIM_ModelComputeArguments_GetArgumentPointerInteger 522 !! 523 !! \since 2.0 524 recursive subroutine kim_model_compute_arguments_get_argument_pointer_int2( & 525 model_compute_arguments_handle, compute_argument_name, extent1, extent2, & 526 int2, ierr) 527 use kim_compute_argument_name_module, only: kim_compute_argument_name_type 528 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 529 implicit none 530 interface 531 integer(c_int) recursive function get_argument_pointer_integer( & 532 model_compute_arguments, compute_argument_name, ptr) & 533 bind(c, name="KIM_ModelComputeArguments_GetArgumentPointerInteger") 534 use, intrinsic :: iso_c_binding 535 use kim_compute_argument_name_module, only: & 536 kim_compute_argument_name_type 537 use kim_interoperable_types_module, only: & 538 kim_model_compute_arguments_type 539 implicit none 540 type(kim_model_compute_arguments_type), intent(in) :: & 541 model_compute_arguments 542 type(kim_compute_argument_name_type), intent(in), value :: & 543 compute_argument_name 544 type(c_ptr), intent(out) :: ptr 545 end function get_argument_pointer_integer 546 end interface 547 type(kim_model_compute_arguments_handle_type), intent(in) :: & 548 model_compute_arguments_handle 549 type(kim_compute_argument_name_type), intent(in) :: & 550 compute_argument_name 551 integer(c_int), intent(in) :: extent1 552 integer(c_int), intent(in) :: extent2 553 integer(c_int), intent(out), pointer :: int2(:, :) 554 integer(c_int), intent(out) :: ierr 555 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 556 557 type(c_ptr) p 558 559 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 560 ierr = get_argument_pointer_integer(model_compute_arguments, & 561 compute_argument_name, p) 562 if (c_associated(p)) then 563 call c_f_pointer(p, int2, [extent1, extent2]) 564 else 565 nullify (int2) 566 end if 567 end subroutine kim_model_compute_arguments_get_argument_pointer_int2 568 569 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 570 !! 571 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 572 !! KIM_ModelComputeArguments_GetArgumentPointerDouble 573 !! 574 !! \since 2.0 575 recursive subroutine & 576 kim_model_compute_arguments_get_argument_pointer_double0( & 577 model_compute_arguments_handle, compute_argument_name, double0, ierr) 578 use kim_compute_argument_name_module, only: kim_compute_argument_name_type 579 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 580 implicit none 581 interface 582 integer(c_int) recursive function get_argument_pointer_double( & 583 model_compute_arguments, compute_argument_name, ptr) & 584 bind(c, name="KIM_ModelComputeArguments_GetArgumentPointerDouble") 585 use, intrinsic :: iso_c_binding 586 use kim_compute_argument_name_module, only: & 587 kim_compute_argument_name_type 588 use kim_interoperable_types_module, only: & 589 kim_model_compute_arguments_type 590 implicit none 591 type(kim_model_compute_arguments_type), intent(in) :: & 592 model_compute_arguments 593 type(kim_compute_argument_name_type), intent(in), value :: & 594 compute_argument_name 595 type(c_ptr), intent(out) :: ptr 596 end function get_argument_pointer_double 597 end interface 598 type(kim_model_compute_arguments_handle_type), intent(in) :: & 599 model_compute_arguments_handle 600 type(kim_compute_argument_name_type), intent(in) :: & 601 compute_argument_name 602 real(c_double), intent(out), pointer :: double0 603 integer(c_int), intent(out) :: ierr 604 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 605 606 type(c_ptr) p 607 608 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 609 ierr = get_argument_pointer_double(model_compute_arguments, & 610 compute_argument_name, p) 611 if (c_associated(p)) then 612 call c_f_pointer(p, double0) 613 else 614 nullify (double0) 615 end if 616 end subroutine kim_model_compute_arguments_get_argument_pointer_double0 617 618 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 619 !! 620 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 621 !! KIM_ModelComputeArguments_GetArgumentPointerDouble 622 !! 623 !! \since 2.0 624 recursive subroutine & 625 kim_model_compute_arguments_get_argument_pointer_double1( & 626 model_compute_arguments_handle, compute_argument_name, extent1, double1, & 627 ierr) 628 use kim_compute_argument_name_module, only: kim_compute_argument_name_type 629 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 630 implicit none 631 interface 632 integer(c_int) recursive function get_argument_pointer_double( & 633 model_compute_arguments, compute_argument_name, ptr) & 634 bind(c, name="KIM_ModelComputeArguments_GetArgumentPointerDouble") 635 use, intrinsic :: iso_c_binding 636 use kim_compute_argument_name_module, only: & 637 kim_compute_argument_name_type 638 use kim_interoperable_types_module, only: & 639 kim_model_compute_arguments_type 640 implicit none 641 type(kim_model_compute_arguments_type), intent(in) :: & 642 model_compute_arguments 643 type(kim_compute_argument_name_type), intent(in), value :: & 644 compute_argument_name 645 type(c_ptr), intent(out) :: ptr 646 end function get_argument_pointer_double 647 end interface 648 type(kim_model_compute_arguments_handle_type), intent(in) :: & 649 model_compute_arguments_handle 650 type(kim_compute_argument_name_type), intent(in) :: & 651 compute_argument_name 652 integer(c_int), intent(in) :: extent1 653 real(c_double), intent(out), pointer :: double1(:) 654 integer(c_int), intent(out) :: ierr 655 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 656 657 type(c_ptr) p 658 659 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 660 ierr = get_argument_pointer_double(model_compute_arguments, & 661 compute_argument_name, p) 662 if (c_associated(p)) then 663 call c_f_pointer(p, double1, [extent1]) 664 else 665 nullify (double1) 666 end if 667 end subroutine kim_model_compute_arguments_get_argument_pointer_double1 668 669 !> \brief \copybrief KIM::ModelComputeArguments::GetArgumentPointer 670 !! 671 !! \sa KIM::ModelComputeArguments::GetArgumentPointer, 672 !! KIM_ModelComputeArguments_GetArgumentPointerDouble 673 !! 674 !! \since 2.0 675 recursive subroutine & 676 kim_model_compute_arguments_get_argument_pointer_double2( & 677 model_compute_arguments_handle, compute_argument_name, extent1, extent2, & 678 double2, ierr) 679 use kim_compute_argument_name_module, only: kim_compute_argument_name_type 680 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 681 implicit none 682 interface 683 integer(c_int) recursive function get_argument_pointer_double( & 684 model_compute_arguments, compute_argument_name, ptr) & 685 bind(c, name="KIM_ModelComputeArguments_GetArgumentPointerDouble") 686 use, intrinsic :: iso_c_binding 687 use kim_compute_argument_name_module, only: & 688 kim_compute_argument_name_type 689 use kim_interoperable_types_module, only: & 690 kim_model_compute_arguments_type 691 implicit none 692 type(kim_model_compute_arguments_type), intent(in) :: & 693 model_compute_arguments 694 type(kim_compute_argument_name_type), intent(in), value :: & 695 compute_argument_name 696 type(c_ptr), intent(out) :: ptr 697 end function get_argument_pointer_double 698 end interface 699 type(kim_model_compute_arguments_handle_type), intent(in) :: & 700 model_compute_arguments_handle 701 type(kim_compute_argument_name_type), intent(in) :: & 702 compute_argument_name 703 integer(c_int), intent(in) :: extent1 704 integer(c_int), intent(in) :: extent2 705 real(c_double), intent(out), pointer :: double2(:, :) 706 integer(c_int), intent(out) :: ierr 707 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 708 709 type(c_ptr) p 710 711 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 712 ierr = get_argument_pointer_double(model_compute_arguments, & 713 compute_argument_name, p) 714 if (c_associated(p)) then 715 call c_f_pointer(p, double2, [extent1, extent2]) 716 else 717 nullify (double2) 718 end if 719 end subroutine kim_model_compute_arguments_get_argument_pointer_double2 720 721 !> \brief \copybrief KIM::ModelComputeArguments::IsCallbackPresent 722 !! 723 !! \sa KIM::ModelComputeArguments::IsCallbackPresent, 724 !! KIM_ModelComputeArguments_IsCallbackPresent 725 !! 726 !! \since 2.0 727 recursive subroutine kim_model_compute_arguments_is_callback_present( & 728 model_compute_arguments_handle, compute_callback_name, present, ierr) 729 use kim_compute_callback_name_module, only: kim_compute_callback_name_type 730 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 731 implicit none 732 interface 733 integer(c_int) recursive function is_callback_present( & 734 model_compute_arguments, compute_callback_name, present) & 735 bind(c, name="KIM_ModelComputeArguments_IsCallbackPresent") 736 use, intrinsic :: iso_c_binding 737 use kim_compute_callback_name_module, only: & 738 kim_compute_callback_name_type 739 use kim_interoperable_types_module, only: & 740 kim_model_compute_arguments_type 741 implicit none 742 type(kim_model_compute_arguments_type), intent(in) :: & 743 model_compute_arguments 744 type(kim_compute_callback_name_type), intent(in), value :: & 745 compute_callback_name 746 integer(c_int), intent(out) :: present 747 end function is_callback_present 748 end interface 749 type(kim_model_compute_arguments_handle_type), intent(in) :: & 750 model_compute_arguments_handle 751 type(kim_compute_callback_name_type), intent(in) :: & 752 compute_callback_name 753 integer(c_int), intent(out) :: present 754 integer(c_int), intent(out) :: ierr 755 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 756 757 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 758 ierr = is_callback_present(model_compute_arguments, compute_callback_name, & 759 present) 760 end subroutine kim_model_compute_arguments_is_callback_present 761 762 !> \brief \copybrief KIM::ModelComputeArguments::SetModelBufferPointer 763 !! 764 !! \sa KIM::ModelComputeArguments::SetModelBufferPointer, 765 !! KIM_ModelComputeArguments_SetModelBufferPointer 766 !! 767 !! \since 2.0 768 recursive subroutine kim_model_compute_arguments_set_model_buffer_pointer( & 769 model_compute_arguments_handle, ptr) 770 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 771 implicit none 772 interface 773 recursive subroutine set_model_buffer_pointer( & 774 model_compute_arguments, ptr) & 775 bind(c, name="KIM_ModelComputeArguments_SetModelBufferPointer") 776 use, intrinsic :: iso_c_binding 777 use kim_interoperable_types_module, only: & 778 kim_model_compute_arguments_type 779 implicit none 780 type(kim_model_compute_arguments_type), intent(in) :: & 781 model_compute_arguments 782 type(c_ptr), intent(in), value :: ptr 783 end subroutine set_model_buffer_pointer 784 end interface 785 type(kim_model_compute_arguments_handle_type), intent(in) :: & 786 model_compute_arguments_handle 787 type(c_ptr), intent(in) :: ptr 788 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 789 790 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 791 call set_model_buffer_pointer(model_compute_arguments, ptr) 792 end subroutine kim_model_compute_arguments_set_model_buffer_pointer 793 794 !> \brief \copybrief KIM::ModelComputeArguments::GetModelBufferPointer 795 !! 796 !! \sa KIM::ModelComputeArguments::GetModelBufferPointer, 797 !! KIM_ModelComputeArguments_GetModelBufferPointer 798 !! 799 !! \since 2.0 800 recursive subroutine kim_model_compute_arguments_get_model_buffer_pointer( & 801 model_compute_arguments_handle, ptr) 802 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 803 implicit none 804 interface 805 recursive subroutine get_model_buffer_pointer( & 806 model_compute_arguments, ptr) & 807 bind(c, name="KIM_ModelComputeArguments_GetModelBufferPointer") 808 use, intrinsic :: iso_c_binding 809 use kim_interoperable_types_module, only: & 810 kim_model_compute_arguments_type 811 implicit none 812 type(kim_model_compute_arguments_type), intent(in) :: & 813 model_compute_arguments 814 type(c_ptr), intent(out) :: ptr 815 end subroutine get_model_buffer_pointer 816 end interface 817 type(kim_model_compute_arguments_handle_type), intent(in) :: & 818 model_compute_arguments_handle 819 type(c_ptr), intent(out) :: ptr 820 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 821 822 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 823 call get_model_buffer_pointer(model_compute_arguments, ptr) 824 end subroutine kim_model_compute_arguments_get_model_buffer_pointer 825 826 !> \brief \copybrief KIM::ModelComputeArguments::LogEntry 827 !! 828 !! \sa KIM::ModelComputeArguments::LogEntry, 829 !! KIM_ModelComputeArguments_LogEntry 830 !! 831 !! \since 2.0 832 recursive subroutine kim_model_compute_arguments_log_entry( & 833 model_compute_arguments_handle, log_verbosity, message) 834 use kim_log_verbosity_module, only: kim_log_verbosity_type 835 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 836 implicit none 837 interface 838 recursive subroutine log_entry(model_compute_arguments, log_verbosity, & 839 message, line_number, file_name) & 840 bind(c, name="KIM_ModelComputeArguments_LogEntry") 841 use, intrinsic :: iso_c_binding 842 use kim_log_verbosity_module, only: kim_log_verbosity_type 843 use kim_interoperable_types_module, only: & 844 kim_model_compute_arguments_type 845 implicit none 846 type(kim_model_compute_arguments_type), intent(in) :: & 847 model_compute_arguments 848 type(kim_log_verbosity_type), intent(in), value :: log_verbosity 849 character(c_char), intent(in) :: message(*) 850 integer(c_int), intent(in), value :: line_number 851 character(c_char), intent(in) :: file_name(*) 852 end subroutine log_entry 853 end interface 854 type(kim_model_compute_arguments_handle_type), intent(in) :: & 855 model_compute_arguments_handle 856 type(kim_log_verbosity_type), intent(in) :: log_verbosity 857 character(len=*, kind=c_char), intent(in) :: message 858 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 859 860 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 861 call log_entry(model_compute_arguments, log_verbosity, & 862 trim(message)//c_null_char, 0, ""//c_null_char) 863 end subroutine kim_model_compute_arguments_log_entry 864 865 !> \brief \copybrief KIM::ModelComputeArguments::ToString 866 !! 867 !! \sa KIM::ModelComputeArguments::ToString, 868 !! KIM_ModelComputeArguments_ToString 869 !! 870 !! \since 2.0 871 recursive subroutine kim_model_compute_arguments_to_string( & 872 model_compute_arguments_handle, string) 873 use kim_convert_string_module, only: kim_convert_c_char_ptr_to_string 874 use kim_interoperable_types_module, only: kim_model_compute_arguments_type 875 implicit none 876 interface 877 type(c_ptr) recursive function model_compute_string( & 878 model_compute_arguments) & 879 bind(c, name="KIM_ModelComputeArguments_ToString") 880 use, intrinsic :: iso_c_binding 881 use kim_interoperable_types_module, only: & 882 kim_model_compute_arguments_type 883 implicit none 884 type(kim_model_compute_arguments_type), intent(in) :: & 885 model_compute_arguments 886 end function model_compute_string 887 end interface 888 type(kim_model_compute_arguments_handle_type), intent(in) :: & 889 model_compute_arguments_handle 890 character(len=*, kind=c_char), intent(out) :: string 891 type(kim_model_compute_arguments_type), pointer :: model_compute_arguments 892 893 type(c_ptr) :: p 894 895 call c_f_pointer(model_compute_arguments_handle%p, model_compute_arguments) 896 p = model_compute_string(model_compute_arguments) 897 call kim_convert_c_char_ptr_to_string(p, string) 898 end subroutine kim_model_compute_arguments_to_string 899end module kim_model_compute_arguments_module 900