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