kim-api  2.1.4-git+v2.1.3-git-1-g7847914a.GNU
An Application Programming Interface (API) for the Knowledgebase of Interatomic Models (KIM).
simulator-model-example-fortran.f90
Go to the documentation of this file.
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) 2013--2019, Regents of the University of Minnesota.
23 ! All rights reserved.
24 !
25 ! Contributors:
26 ! Ryan S. Elliott
27 !
28 
29 module error
30  use, intrinsic :: iso_c_binding
31  implicit none
32 
33  public
34 
35 contains
36  recursive subroutine my_error(message)
37  implicit none
38  character(len=*, kind=c_char), intent(in) :: message
39 
40  print *,"* Error : ", trim(message)
41  stop 1
42  end subroutine my_error
43 
44  recursive subroutine my_warning(message)
45  implicit none
46  character(len=*, kind=c_char), intent(in) :: message
47 
48  print *,"* Warning : ", trim(message)
49  end subroutine my_warning
50 end module error
51 
52 !-------------------------------------------------------------------------------
53 !
54 ! Main program
55 !
56 !-------------------------------------------------------------------------------
58  use, intrinsic :: iso_c_binding
59  use error
61  implicit none
62  interface
63  integer(c_int) function c_system(cmd) bind(c,name="system")
64  use, intrinsic :: iso_c_binding
65  character(c_char), intent(in) :: cmd(*)
66  end function c_system
67  end interface
68 
69  integer(c_int) :: ierr
70  integer(c_int) :: extent
71  integer(c_int) :: no_fields
72  integer(c_int) :: i
73  integer(c_int) :: j
74  type(kim_simulator_model_handle_type) :: sm
75 
76  character(len=2048, kind=c_char) s_name
77  character(len=2048, kind=c_char) s_ver
78  character(len=2048, kind=c_char) species
79  character(len=2048, kind=c_char) field_name
80  character(len=2048, kind=c_char) line
81  character(len=2048, kind=c_char) dir_name
82  character(len=2048, kind=c_char) spec_name
83  character(len=2048, kind=c_char) param_name
84 
85 
86  call kim_simulator_model_create( &
87  "Sim_LAMMPS_LJcut_AkersonElliott_Alchemy_PbAu", sm, ierr)
88 
89  if (ierr /= 0) then
90  call my_error("Can't create SM.")
91  end if
92 
93  call kim_get_simulator_name_and_version(sm, s_name, s_ver)
94  print *, "Simulator name : ", trim(s_name)
95  print *, "Simulator version : ", trim(s_ver)
96  print *, ""
97 
98  call kim_get_number_of_supported_species(sm, extent)
99  print *, "SM supports", extent, " species:"
100  do i=1,extent
101  call kim_get_supported_species(sm, i, species, ierr)
102  if (ierr /= 0) then
103  call my_error("Unable to get species.")
104  else
105  print '(A,I2," ",A)', achar(9), i, trim(species)
106  end if
107  end do
108  print *, ""
109 
110  call kim_add_template_map(sm, "atom-type-sym-list", "Pb Pb Au Pb", ierr)
111  if (ierr /= 0) then
112  call my_error("Unable to add template map.")
113  end if
114  call kim_close_template_map(sm)
115  call kim_get_number_of_simulator_fields(sm, no_fields)
116  print '("SM has ",I2," fields :")', no_fields
117  do i=1,no_fields
118  call kim_get_simulator_field_metadata(sm, i, extent, field_name, ierr)
119  print '(" Field",I2," is ",A," and has ",I2," lines:")', &
120  i, trim(field_name), extent
121 
122  do j=1,extent
123  call kim_get_simulator_field_line(sm, i, j, line, ierr)
124  if (ierr /= 0) then
125  call my_error("Unable to get field line.")
126  else
127  print '(A,A)', achar(9), trim(line)
128  end if
129  end do
130  end do
131  print *,""
132 
133  call kim_get_parameter_file_directory_name(sm, dir_name)
134  print '("SM param dir name is ",A)', trim(dir_name)
135 
136  call kim_get_specification_file_name(sm, spec_name)
137  print '("SM spec file name is ",A)', trim(spec_name)
138  ierr = c_system("cat "//trim(dir_name)//"/"//trim(spec_name)//c_null_char)
139 
140  call kim_get_number_of_parameter_files(sm, extent)
141  print '("SM has ",I1," parameter files:")', extent
142  do i=1,extent
143  call kim_get_parameter_file_name(sm, i, param_name, ierr)
144  if (ierr /= 0) then
145  call my_error("Unable to get parameter file name.")
146  else
147  print '("Parameter file ",I2," has name ",A)', i, trim(param_name)
148  ierr = c_system( &
149  "cat "//trim(dir_name)//"/"//trim(param_name)//c_null_char)
150  print *,""
151  end if
152  end do
153 
154  call kim_simulator_model_destroy(sm)
155 
156 end program collections_example_fortran
recursive subroutine my_warning(message)
recursive subroutine my_error(message)
program collections_example_fortran