36 subroutine my_error(message, line, file)
38 character(len=*),
intent(in) :: message
39 integer,
intent(in) :: line
40 character(len=*),
intent(in) :: file
42 print *,
"* Error : '", trim(message),
"' ", line,
":", &
49 character(len=*),
intent(in) :: message
50 integer,
intent(in) :: line
51 character(len=*),
intent(in) :: file
53 print *,
"* Error : '", trim(message),
"' ", line,
":", &
69 use,
intrinsic :: iso_c_binding
74 integer(c_int) :: number_of_particles
75 integer(c_int),
pointer :: neighborlist(:,:)
76 real(c_double),
pointer :: rijlist(:,:,:)
87 subroutine get_neigh(data_object, neighbor_list_index, request, numnei, &
88 pnei1part, ierr) bind(c)
93 type(c_ptr),
value,
intent(in) :: data_object
94 integer(c_int),
value,
intent(in) :: neighbor_list_index
95 integer(c_int),
value,
intent(in) :: request
96 integer(c_int),
intent(out) :: numnei
97 type(c_ptr),
intent(out) :: pnei1part
98 integer(c_int),
intent(out) :: ierr
101 integer(c_int),
parameter :: dim = 3
102 integer(c_int) numberofparticles
105 if (neighbor_list_index /= 1)
then 106 call my_warning(
"wrong list index", __line__, __file__)
111 call c_f_pointer(data_object, neighobject)
113 numberofparticles = neighobject%number_of_particles
115 if ( (request.gt.numberofparticles) .or. (request.lt.1))
then 116 call my_warning(
"Invalid part ID in get_neigh", &
123 numnei = neighobject%neighborList(1,request)
126 pnei1part = c_loc(neighobject%neighborList(2,request))
141 use,
intrinsic :: iso_c_binding
146 logical,
intent(in) :: half
147 integer(c_int),
intent(in) :: numberOfParticles
148 real(c_double),
dimension(3,numberOfParticles), &
150 real(c_double),
intent(in) :: cutoff
151 type(neighObject_type),
intent(inout) :: neighObject
154 integer(c_int) i, j, a
157 real(c_double) cutoff2
161 do i=1,numberofparticles
163 do j=1,numberofparticles
164 dx(:) = coords(:, j) - coords(:, i)
165 r2 = dot_product(dx, dx)
166 if (r2.le.cutoff2)
then 168 if ( (j .gt. i) .OR. ((.not. half) .AND. (i.ne.j)) )
then 170 neighobject%neighborList(a,i) = j
175 neighobject%neighborList(1,i) = a-1
201 coords, MiddlePartId)
202 use,
intrinsic :: iso_c_binding
204 integer(c_int),
parameter :: cd = c_double
207 real(c_double),
intent(in) :: FCCspacing
208 integer(c_int),
intent(in) :: nCellsPerSide
209 logical,
intent(in) :: periodic
210 real(c_double),
intent(out) :: coords(3,*)
211 integer(c_int),
intent(out) :: MiddlePartId
215 real(c_double) FCCshifts(3,4)
216 real(c_double) latVec(3)
217 integer(c_int) a, i, j, k, m
221 fccshifts(1,1) = 0.0_cd
222 fccshifts(2,1) = 0.0_cd
223 fccshifts(3,1) = 0.0_cd
224 fccshifts(1,2) = 0.5_cd*fccspacing
225 fccshifts(2,2) = 0.5_cd*fccspacing
226 fccshifts(3,2) = 0.0_cd
227 fccshifts(1,3) = 0.5_cd*fccspacing
228 fccshifts(2,3) = 0.0_cd
229 fccshifts(3,3) = 0.5_cd*fccspacing
230 fccshifts(1,4) = 0.0_cd
231 fccshifts(2,4) = 0.5_cd*fccspacing
232 fccshifts(3,4) = 0.5_cd*fccspacing
237 latvec(1) = (i-1)*fccspacing
239 latvec(2) = (j-1)*fccspacing
241 latvec(3) = (k-1)*fccspacing
244 coords(:,a) = latvec + fccshifts(:,m)
245 if ((i.eq.ncellsperside/2+1).and.(j.eq.ncellsperside/2+1) .and. &
246 (k.eq.ncellsperside/2+1) .and. (m.eq.1))
then 247 coords(:,1) = latvec + fccshifts(:,m)
252 if (.not. periodic)
then 255 latvec(1) = ncellsperside*fccspacing
256 latvec(2) = (i-1)*fccspacing
257 latvec(3) = (j-1)*fccspacing
258 a = a+1; coords(:,a) = latvec
259 a = a+1; coords(:,a) = latvec + fccshifts(:,4)
261 latvec(1) = (i-1)*fccspacing
262 latvec(2) = ncellsperside*fccspacing
263 latvec(3) = (j-1)*fccspacing
264 a = a+1; coords(:,a) = latvec
265 a = a+1; coords(:,a) = latvec + fccshifts(:,3)
267 latvec(1) = (i-1)*fccspacing
268 latvec(2) = (j-1)*fccspacing
269 latvec(3) = ncellsperside*fccspacing
270 a = a+1; coords(:,a) = latvec
271 a = a+1; coords(:,a) = latvec + fccshifts(:,2)
274 if (.not. periodic)
then 276 latvec(1) = (i-1)*fccspacing
277 latvec(2) = ncellsperside*fccspacing
278 latvec(3) = ncellsperside*fccspacing
279 a = a+1; coords(:,a) = latvec
280 latvec(1) = ncellsperside*fccspacing
281 latvec(2) = (i-1)*fccspacing
282 latvec(3) = ncellsperside*fccspacing
283 a = a+1; coords(:,a) = latvec
284 latvec(1) = ncellsperside*fccspacing
285 latvec(2) = ncellsperside*fccspacing
286 latvec(3) = (i-1)*fccspacing
287 a = a+1; coords(:,a) = latvec
290 if (.not. periodic)
then 292 a = a+1; coords(:,a) = ncellsperside*fccspacing
315 use,
intrinsic :: iso_c_binding
326 integer(c_int),
parameter :: cd = c_double
328 integer(c_int),
parameter :: ncellsperside = 2
329 integer(c_int),
parameter :: dim = 3
331 real(c_double),
parameter :: cutpad = 0.75_cd
332 real(c_double),
parameter :: fccspacing = 5.260_cd
333 real(c_double),
parameter :: min_spacing = 0.8*fccspacing
334 real(c_double),
parameter :: max_spacing = 1.2*fccspacing
335 real(c_double),
parameter :: spacing_incr = 0.025*fccspacing
336 real(c_double) :: current_spacing
338 character(len=256) :: modelname
340 integer(c_int),
parameter :: &
341 n = 4*(ncellsperside)**3 + 6*(ncellsperside)**2 + 3*(ncellsperside) + 1
345 type(kim_model_handle_type) :: model_handle
346 real(c_double) :: influence_distance
347 integer(c_int) :: number_of_cutoffs
348 real(c_double) :: cutoff
349 real(c_double) :: cutoffs(1)
350 integer(c_int),
target :: particle_species_codes(n)
351 integer(c_int),
target :: particle_contributing(n)
352 real(c_double),
target :: energy
353 real(c_double),
target :: coords(dim, n)
354 integer(c_int) i, ierr, ierr2
356 integer(c_int) species_is_supported
357 integer(c_int) species_code
358 integer(c_int) requested_units_accepted
359 real(c_double),
pointer :: null_pointer
363 nullify(null_pointer)
369 print
'("Please enter a valid KIM model name: ")' 375 print *,
'This is Test : ex_test_Ar_fcc_cluster.' 378 print
'("Results for KIM Model : ",A)', trim(modelname)
384 kim_energy_unit_ev, &
386 kim_temperature_unit_k, &
389 requested_units_accepted, &
392 call my_error(
"kim_api_create", __line__, __file__)
396 if (requested_units_accepted == 0)
then 397 call my_error(
"Must adapt to model units", __line__, __file__)
402 call kim_model_get_species_support_and_code(model_handle, &
404 if ((ierr /= 0) .or. (species_is_supported /= 1))
then 405 call my_error(
"Model does not support Ar", __line__, __file__)
413 call kim_model_set_argument_pointer(model_handle, &
416 call kim_model_set_argument_pointer(model_handle, &
419 call kim_model_set_argument_pointer(model_handle, &
422 call kim_model_set_argument_pointer(model_handle, &
425 call kim_model_set_argument_pointer(model_handle, &
429 call my_error(
"set_argument_pointer", __line__, __file__)
436 c_funloc(
get_neigh), c_loc(neighobject), ierr)
438 call my_error(
"set_callback_pointer", __line__, __file__)
441 call kim_model_get_influence_distance(model_handle, influence_distance)
442 call kim_model_get_number_of_neighbor_list_cutoffs(model_handle, &
444 if (number_of_cutoffs /= 1)
then 445 call my_error(
"too many cutoffs", __line__, __file__)
447 call kim_model_get_neighbor_list_cutoffs(model_handle, cutoffs, ierr)
449 call my_error(
"get_cutoffs", __line__, __file__)
456 particle_species_codes(i) = species_code
461 particle_contributing(i) = 1
467 allocate(neighobject%neighborList(n+1,n))
468 neighobject%number_of_particles = n
471 current_spacing = min_spacing
472 do while (current_spacing < max_spacing)
481 call my_error(
"update_neighborlist", __line__, __file__)
488 call my_error(
"kim_api_model_compute", __line__, __file__)
493 print
'(2ES20.10)', energy, current_spacing
495 current_spacing = current_spacing + spacing_incr
type(kim_numbering_type), public, protected kim_numbering_one_based
type(kim_argument_name_type), public, protected kim_argument_name_number_of_particles
type(kim_language_name_type), public, protected kim_language_name_fortran
program ex_test_ar_fcc_cluster
subroutine my_error(message, line, file)
type(kim_argument_name_type), public, protected kim_argument_name_particle_contributing
type(kim_callback_name_type), public, protected kim_callback_name_get_neighbor_list
type(kim_argument_name_type), public, protected kim_argument_name_particle_species_codes
subroutine neigh_pure_cluster_neighborlist(half, numberOfParticles, coords, cutoff, neighObject)
type(kim_argument_name_type), public, protected kim_argument_name_partial_energy
subroutine my_warning(message, line, file)
type(kim_argument_name_type), public, protected kim_argument_name_coordinates
subroutine, public get_neigh(data_object, neighbor_list_index, request, numnei, pnei1part, ierr)
subroutine create_fcc_configuration(FCCspacing, nCellsPerSide, periodic, coords, MiddlePartId)
type(kim_species_name_type), public, protected kim_species_name_ar