1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
!
! KIM-API: An API for interatomic models
! Copyright (c) 2013--2022, Regents of the University of Minnesota.
! All rights reserved.
!
! Contributors:
! Ryan S. Elliott
!
! SPDX-License-Identifier: LGPL-2.1-or-later
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Lesser General Public
! License as published by the Free Software Foundation; either
! version 2.1 of the License, or (at your option) any later version.
!
! This library is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
! Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with this library; if not, write to the Free Software Foundation,
! Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
!
module error
use, intrinsic :: iso_c_binding
implicit none
public
contains
recursive subroutine my_error(message)
implicit none
character(len=*, kind=c_char), intent(in) :: message
print *, "* Error : ", trim(message)
stop 1
end subroutine my_error
recursive subroutine my_warning(message)
implicit none
character(len=*, kind=c_char), intent(in) :: message
print *, "* Warning : ", trim(message)
end subroutine my_warning
end module error
!-------------------------------------------------------------------------------
!
! Main program
!
!-------------------------------------------------------------------------------
program collections_example_fortran
use, intrinsic :: iso_c_binding
use error
use kim_simulator_headers_module
implicit none
interface
integer(c_int) function c_system(cmd) bind(c, name="system")
use, intrinsic :: iso_c_binding
character(c_char), intent(in) :: cmd(*)
end function c_system
end interface
integer(c_int) :: ierr
integer(c_int) :: extent
integer(c_int) :: no_fields
integer(c_int) :: i
integer(c_int) :: j
type(kim_simulator_model_handle_type) :: sm
character(len=2048, kind=c_char) s_name
character(len=2048, kind=c_char) s_ver
character(len=2048, kind=c_char) species
character(len=2048, kind=c_char) field_name
character(len=2048, kind=c_char) line
character(len=2048, kind=c_char) dir_name
character(len=2048, kind=c_char) spec_name
character(len=2048, kind=c_char) param_basename
call kim_simulator_model_create( &
"Sim_LAMMPS_LJcut_AkersonElliott_Alchemy_PbAu", sm, ierr)
if (ierr /= 0) then
call my_error("Can't create SM.")
end if
call kim_get_simulator_name_and_version(sm, s_name, s_ver)
print *, "Simulator name : ", trim(s_name)
print *, "Simulator version : ", trim(s_ver)
print *, ""
call kim_get_number_of_supported_species(sm, extent)
print *, "SM supports", extent, " species:"
do i = 1, extent
call kim_get_supported_species(sm, i, species, ierr)
if (ierr /= 0) then
call my_error("Unable to get species.")
else
print '(A,I2," ",A)', achar(9), i, trim(species)
end if
end do
print *, ""
call kim_add_template_map(sm, "atom-type-sym-list", "Pb Pb Au Pb", ierr)
if (ierr /= 0) then
call my_error("Unable to add template map.")
end if
call kim_close_template_map(sm)
call kim_get_number_of_simulator_fields(sm, no_fields)
print '("SM has ",I2," fields :")', no_fields
do i = 1, no_fields
call kim_get_simulator_field_metadata(sm, i, extent, field_name, ierr)
print '(" Field",I2," is ",A," and has ",I2," lines:")', &
i, trim(field_name), extent
do j = 1, extent
call kim_get_simulator_field_line(sm, i, j, line, ierr)
if (ierr /= 0) then
call my_error("Unable to get field line.")
else
print '(A,A)', achar(9), trim(line)
end if
end do
end do
print *, ""
call kim_get_parameter_file_directory_name(sm, dir_name)
print '("SM param dir name is ",A)', trim(dir_name)
call kim_get_specification_file_name(sm, spec_name)
print '("SM spec file name is ",A)', trim(spec_name)
ierr = c_system("cat "//trim(dir_name)//"/"//trim(spec_name)//c_null_char)
call kim_get_number_of_parameter_files(sm, extent)
print '("SM has ",I1," parameter files:")', extent
do i = 1, extent
call kim_get_parameter_file_basename(sm, i, param_basename, ierr)
if (ierr /= 0) then
call my_error("Unable to get parameter file basename.")
else
print '("Parameter file ",I2," has basename ",A)', i, trim(param_basename)
ierr = c_system( &
"cat "//trim(dir_name)//"/"//trim(param_basename)//c_null_char)
print *, ""
end if
end do
call kim_simulator_model_destroy(sm)
end program collections_example_fortran
|
