36 subroutine my_error(message, line, file)
38 character(len=*, kind=c_char),
intent(in) :: message
39 integer,
intent(in) :: line
40 character(len=*, kind=c_char),
intent(in) :: file
42 print *,
"* Error : '", trim(message),
"' ", line,
":", &
49 character(len=*, kind=c_char),
intent(in) :: message
50 integer,
intent(in) :: line
51 character(len=*, kind=c_char),
intent(in) :: file
53 print *,
"* Error : '", trim(message),
"' ", line,
":", &
69 use,
intrinsic :: iso_c_binding
74 real(c_double) :: cutoff
75 integer(c_int) :: number_of_particles
76 integer(c_int),
pointer :: neighborList(:,:)
87 subroutine get_neigh(data_object, number_of_cutoffs, cutoffs, &
88 neighbor_list_index, request, numnei, pnei1part, ierr) bind(c)
93 type(c_ptr),
value,
intent(in) :: data_object
94 integer(c_int),
value,
intent(in) :: number_of_cutoffs
95 real(c_double),
intent(in) :: cutoffs(number_of_cutoffs)
96 integer(c_int),
value,
intent(in) :: neighbor_list_index
97 integer(c_int),
value,
intent(in) :: request
98 integer(c_int),
intent(out) :: numnei
99 type(c_ptr),
intent(out) :: pnei1part
100 integer(c_int),
intent(out) :: ierr
103 integer(c_int),
parameter :: DIM = 3
104 integer(c_int) numberOfParticles
105 type(neighObject_type),
pointer :: neighObject
107 call c_f_pointer(data_object, neighobject)
109 if (number_of_cutoffs /= 1)
then 110 call my_warning(
"invalid number of cutoffs", __line__, __file__)
115 if (cutoffs(1) > neighobject%cutoff)
then 116 call my_warning(
"neighbor list cutoff too small for model cutoff", &
122 if (neighbor_list_index /= 1)
then 123 call my_warning(
"wrong list index", __line__, __file__)
128 numberofparticles = neighobject%number_of_particles
130 if ( (request.gt.numberofparticles) .or. (request.lt.1))
then 132 call my_warning(
"Invalid part ID in get_neigh", &
139 numnei = neighobject%neighborList(1,request)
142 pnei1part = c_loc(neighobject%neighborList(2,request))
164 use,
intrinsic :: iso_c_binding
169 logical,
intent(in) :: half
170 integer(c_int),
intent(in) :: numberOfParticles
171 real(c_double),
dimension(3,numberOfParticles), &
173 real(c_double),
intent(in) :: cutoff
174 type(neighObject_type),
intent(inout) :: neighObject
177 integer(c_int) i, j, a
180 real(c_double) cutoff2
182 neighobject%cutoff = cutoff
186 do i=1,numberofparticles
188 do j=1,numberofparticles
189 dx(:) = coords(:, j) - coords(:, i)
190 r2 = dot_product(dx, dx)
191 if (r2.le.cutoff2)
then 193 if ( (j .gt. i) .OR. ((.not. half) .AND. (i.ne.j)) )
then 195 neighobject%neighborList(a,i) = j
200 neighobject%neighborList(1,i) = a-1
225 coords, MiddlePartId)
226 use,
intrinsic :: iso_c_binding
228 integer(c_int),
parameter :: cd = c_double
231 real(c_double),
intent(in) :: FCCspacing
232 integer(c_int),
intent(in) :: nCellsPerSide
233 logical,
intent(in) :: periodic
234 real(c_double),
intent(out) :: coords(3,*)
235 integer(c_int),
intent(out) :: MiddlePartId
239 real(c_double) FCCshifts(3,4)
240 real(c_double) latVec(3)
241 integer(c_int) a, i, j, k, m
245 fccshifts(1,1) = 0.0_cd
246 fccshifts(2,1) = 0.0_cd
247 fccshifts(3,1) = 0.0_cd
248 fccshifts(1,2) = 0.5_cd*fccspacing
249 fccshifts(2,2) = 0.5_cd*fccspacing
250 fccshifts(3,2) = 0.0_cd
251 fccshifts(1,3) = 0.5_cd*fccspacing
252 fccshifts(2,3) = 0.0_cd
253 fccshifts(3,3) = 0.5_cd*fccspacing
254 fccshifts(1,4) = 0.0_cd
255 fccshifts(2,4) = 0.5_cd*fccspacing
256 fccshifts(3,4) = 0.5_cd*fccspacing
261 latvec(1) = (i-1)*fccspacing
263 latvec(2) = (j-1)*fccspacing
265 latvec(3) = (k-1)*fccspacing
268 coords(:,a) = latvec + fccshifts(:,m)
269 if ((i.eq.ncellsperside/2+1).and.(j.eq.ncellsperside/2+1) .and. &
270 (k.eq.ncellsperside/2+1) .and. (m.eq.1))
then 271 coords(:,1) = latvec + fccshifts(:,m)
276 if (.not. periodic)
then 279 latvec(1) = ncellsperside*fccspacing
280 latvec(2) = (i-1)*fccspacing
281 latvec(3) = (j-1)*fccspacing
282 a = a+1; coords(:,a) = latvec
283 a = a+1; coords(:,a) = latvec + fccshifts(:,4)
285 latvec(1) = (i-1)*fccspacing
286 latvec(2) = ncellsperside*fccspacing
287 latvec(3) = (j-1)*fccspacing
288 a = a+1; coords(:,a) = latvec
289 a = a+1; coords(:,a) = latvec + fccshifts(:,3)
291 latvec(1) = (i-1)*fccspacing
292 latvec(2) = (j-1)*fccspacing
293 latvec(3) = ncellsperside*fccspacing
294 a = a+1; coords(:,a) = latvec
295 a = a+1; coords(:,a) = latvec + fccshifts(:,2)
298 if (.not. periodic)
then 300 latvec(1) = (i-1)*fccspacing
301 latvec(2) = ncellsperside*fccspacing
302 latvec(3) = ncellsperside*fccspacing
303 a = a+1; coords(:,a) = latvec
304 latvec(1) = ncellsperside*fccspacing
305 latvec(2) = (i-1)*fccspacing
306 latvec(3) = ncellsperside*fccspacing
307 a = a+1; coords(:,a) = latvec
308 latvec(1) = ncellsperside*fccspacing
309 latvec(2) = ncellsperside*fccspacing
310 latvec(3) = (i-1)*fccspacing
311 a = a+1; coords(:,a) = latvec
314 if (.not. periodic)
then 316 a = a+1; coords(:,a) = ncellsperside*fccspacing
339 use,
intrinsic :: iso_c_binding
345 integer(c_int),
parameter :: cd = c_double
347 integer(c_int),
parameter :: ncellsperside = 2
348 integer(c_int),
parameter :: dim = 3
349 integer(c_int),
parameter :: aspecies = 1
351 real(c_double),
parameter :: cutpad = 0.75_cd
352 real(c_double),
parameter :: fccspacing = 5.260_cd
353 real(c_double),
parameter :: min_spacing = 0.8*fccspacing
354 real(c_double),
parameter :: max_spacing = 1.2*fccspacing
355 real(c_double),
parameter :: spacing_incr = 0.025*fccspacing
356 real(c_double) :: current_spacing
357 real(c_double) :: force_norm
359 character(len=256, kind=c_char) :: modelname
361 integer(c_int),
parameter :: &
362 n = 4*(ncellsperside)**3 + 6*(ncellsperside)**2 + 3*(ncellsperside) + 1
363 integer(c_int),
parameter :: sizeone = 1
367 type(kim_model_handle_type) :: model_handle
368 type(kim_compute_arguments_handle_type) :: compute_arguments_handle
369 real(c_double) :: influence_distance
370 integer(c_int) :: number_of_cutoffs
371 real(c_double) :: cutoff
372 real(c_double) :: cutoffs(1)
373 integer(c_int),
target :: particle_species_codes(n)
374 integer(c_int),
target :: particle_contributing(n)
375 real(c_double),
target :: energy
376 real(c_double),
target :: coords(dim, n)
377 real(c_double),
target :: forces(dim, n)
378 integer(c_int) i, j, ierr, ierr2
380 integer(c_int) species_is_supported
381 integer(c_int) species_code
382 integer(c_int) requested_units_accepted
390 print
'("Please enter a valid KIM model name: ")' 396 print *,
'This is Test : ex_test_Ar_fcc_cluster_fortran' 399 print
'("Results for KIM Model : ",A)', trim(modelname)
403 call kim_model_create(kim_numbering_one_based, &
405 kim_energy_unit_ev, &
407 kim_temperature_unit_k, &
410 requested_units_accepted, &
413 call my_error(
"kim_api_create", __line__, __file__)
417 if (requested_units_accepted == 0)
then 418 call my_error(
"Must adapt to model units", __line__, __file__)
423 call kim_model_get_species_support_and_code(model_handle, &
424 kim_species_name_ar, species_is_supported, species_code, ierr)
425 if ((ierr /= 0) .or. (species_is_supported /= 1))
then 426 call my_error(
"Model does not support Ar", __line__, __file__)
434 allocate(neighobject%neighborList(n+1,n))
435 neighobject%number_of_particles = n
439 ierr = kim_api_set_data(pkim,
"neighObject", sizeone, c_loc(neighobject))
440 if (ierr.lt.kim_status_ok)
then 441 call my_error(
"kim_api_set_data", __line__, __file__)
445 ierr = kim_api_set_method(pkim,
"get_neigh", sizeone, c_funloc(
get_neigh))
446 if (ierr.lt.kim_status_ok)
then 447 call my_error(
"kim_api_set_method", __line__, __file__)
454 call kim_api_getm_data(pkim, ierr, &
455 "numberOfParticles", pnparts, 1, &
456 "numberOfSpecies", pnofspecies, 1, &
457 "particleSpecies", pparticlespecies, 1, &
458 "coordinates", pcoor, 1, &
459 "cutoff", pcutoff, 1, &
460 "energy", penergy, 1, &
461 "forces", pforces, 1)
462 if (ierr.lt.kim_status_ok)
then 463 call my_error(
"kim_api_getm_data", __line__, __file__)
466 call c_f_pointer(pnparts, numberofparticles)
467 call c_f_pointer(pnofspecies, numberofspecies)
468 call c_f_pointer(pparticlespecies, particlespecies, [n])
469 call c_f_pointer(pcoor, coords, [dim,n])
470 call c_f_pointer(pcutoff, cutoff)
471 call c_f_pointer(penergy, energy)
472 call c_f_pointer(pforces, forces, [dim,n])
476 numberofparticles = n
477 numberofspecies = aspecies
478 particlespecies(:) = kim_api_get_species_code(pkim,
"Ar", ierr)
479 if (ierr.lt.kim_status_ok)
then 480 call my_error(
"kim_api_get_species_code", __line__, __file__)
485 print
'(3A20)',
"Energy",
"Force Norm",
"Lattice Spacing" 487 current_spacing = min_spacing
488 do while (current_spacing < max_spacing)
497 ierr = kim_api_model_compute(pkim)
498 if (ierr.lt.kim_status_ok)
then 499 call my_error(
"kim_api_model_compute", __line__, __file__)
507 force_norm = force_norm + forces(j,i)*forces(j,i)
510 force_norm = sqrt(force_norm)
514 print
'(3ES20.10)', energy, force_norm, current_spacing
516 current_spacing = current_spacing + spacing_incr
520 deallocate( neighobject%neighborList )
522 ierr = kim_api_model_destroy(pkim)
523 if (ierr.lt.kim_status_ok)
then 524 call my_error(
"kim_api_model_destroy", __line__, __file__)
527 call kim_api_free(pkim, ierr)
528 if (ierr.lt.kim_status_ok)
then 529 call my_error(
"kim_api_free", __line__, __file__)
subroutine my_error(message, line, file)
subroutine neigh_pure_cluster_neighborlist(half, numberOfParticles, coords, cutoff, neighObject)
subroutine create_fcc_configuration(FCCspacing, nCellsPerSide, periodic, coords, MiddlePartId)
program ex_test_ar_fcc_cluster_fortran
subroutine my_warning(message, line, file)
integer(c_int) function, public get_neigh(pkim, mode, request, part, numnei, pnei1part, pRij)