1! ------------------------------------------------------------------------- 2! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator 3! https://www.lammps.org/ Sandia National Laboratories 4! Steve Plimpton, sjplimp@sandia.gov 5! 6! Copyright (2003) Sandia Corporation. Under the terms of Contract 7! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains 8! certain rights in this software. This software is distributed under 9! the GNU General Public License. 10! 11! See the README file in the top-level LAMMPS directory. 12! ------------------------------------------------------------------------- 13! 14! Fortran interface to the LAMMPS library implemented as a Fortran 2003 15! style module that wraps the C-style library interface in library.cpp 16! and library.h using the ISO_C_BINDING module of the Fortran compiler. 17! 18! Based on the LAMMPS Fortran 2003 module contributed by: 19! Karl D. Hammond <hammondkd@missouri.edu> 20! University of Missouri, 2012-2020 21! 22! The Fortran module tries to follow the API of the C-library interface 23! closely, but like the Python wrapper it employs an object oriented 24! approach. To accommodate the object oriented approach, all exported 25! subroutine and functions have to be implemented in Fortran to then 26! call the interfaced C style functions with adapted calling conventions 27! as needed. The C-library interfaced functions retain their names 28! starting with "lammps_" while the Fortran versions start with "lmp_". 29! 30MODULE LIBLAMMPS 31 32 USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_ptr, c_null_ptr, c_loc, & 33 c_int, c_char, c_null_char, c_double, c_size_t, c_f_pointer 34 35 IMPLICIT NONE 36 PRIVATE 37 PUBLIC :: lammps 38 39 TYPE lammps 40 TYPE(c_ptr) :: handle 41 CONTAINS 42 PROCEDURE :: close => lmp_close 43 PROCEDURE :: file => lmp_file 44 PROCEDURE :: command => lmp_command 45 PROCEDURE :: commands_list => lmp_commands_list 46 PROCEDURE :: commands_string => lmp_commands_string 47 PROCEDURE :: version => lmp_version 48 PROCEDURE :: get_natoms => lmp_get_natoms 49 END TYPE lammps 50 51 INTERFACE lammps 52 MODULE PROCEDURE lmp_open 53 END INTERFACE lammps 54 55 ! interface definitions for calling functions in library.cpp 56 INTERFACE 57 FUNCTION lammps_open(argc,argv,comm) & 58 BIND(C, name='lammps_open_fortran') 59 IMPORT :: c_ptr, c_int 60 INTEGER(c_int), VALUE, INTENT(in) :: argc, comm 61 TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv 62 TYPE(c_ptr) :: lammps_open 63 END FUNCTION lammps_open 64 65 FUNCTION lammps_open_no_mpi(argc,argv,handle) & 66 BIND(C, name='lammps_open_no_mpi') 67 IMPORT :: c_ptr, c_int 68 INTEGER(c_int), VALUE, INTENT(in) :: argc 69 TYPE(c_ptr), DIMENSION(*), INTENT(in) :: argv 70 TYPE(c_ptr), INTENT(out) :: handle 71 TYPE(c_ptr) :: lammps_open_no_mpi 72 END FUNCTION lammps_open_no_mpi 73 74 SUBROUTINE lammps_close(handle) BIND(C, name='lammps_close') 75 IMPORT :: c_ptr 76 TYPE(c_ptr), VALUE :: handle 77 END SUBROUTINE lammps_close 78 79 SUBROUTINE lammps_mpi_init() BIND(C, name='lammps_mpi_init') 80 END SUBROUTINE lammps_mpi_init 81 82 SUBROUTINE lammps_mpi_finalize() BIND(C, name='lammps_mpi_finalize') 83 END SUBROUTINE lammps_mpi_finalize 84 85 SUBROUTINE lammps_kokkos_finalize() BIND(C, name='lammps_kokkos_finalize') 86 END SUBROUTINE lammps_kokkos_finalize 87 88 SUBROUTINE lammps_file(handle,filename) BIND(C, name='lammps_file') 89 IMPORT :: c_ptr 90 TYPE(c_ptr), VALUE :: handle 91 TYPE(c_ptr), VALUE :: filename 92 END SUBROUTINE lammps_file 93 94 SUBROUTINE lammps_command(handle,cmd) BIND(C, name='lammps_command') 95 IMPORT :: c_ptr 96 TYPE(c_ptr), VALUE :: handle 97 TYPE(c_ptr), VALUE :: cmd 98 END SUBROUTINE lammps_command 99 100 SUBROUTINE lammps_commands_list(handle,ncmd,cmds) & 101 BIND(C, name='lammps_commands_list') 102 IMPORT :: c_ptr, c_int 103 TYPE(c_ptr), VALUE :: handle 104 INTEGER(c_int), VALUE, INTENT(in) :: ncmd 105 TYPE(c_ptr), DIMENSION(*), INTENT(in) :: cmds 106 END SUBROUTINE lammps_commands_list 107 108 SUBROUTINE lammps_commands_string(handle,str) & 109 BIND(C, name='lammps_commands_string') 110 IMPORT :: c_ptr 111 TYPE(c_ptr), VALUE :: handle 112 TYPE(c_ptr), VALUE :: str 113 END SUBROUTINE lammps_commands_string 114 115 FUNCTION lammps_malloc(size) BIND(C, name='malloc') 116 IMPORT :: c_ptr, c_size_t 117 INTEGER(c_size_t), value :: size 118 TYPE(c_ptr) :: lammps_malloc 119 END FUNCTION lammps_malloc 120 121 SUBROUTINE lammps_free(ptr) BIND(C, name='lammps_free') 122 IMPORT :: c_ptr 123 TYPE(c_ptr), VALUE :: ptr 124 END SUBROUTINE lammps_free 125 126 FUNCTION lammps_version(handle) BIND(C, name='lammps_version') 127 IMPORT :: c_ptr, c_int 128 TYPE(c_ptr), VALUE :: handle 129 INTEGER(c_int) :: lammps_version 130 END FUNCTION lammps_version 131 132 FUNCTION lammps_get_natoms(handle) BIND(C, name='lammps_get_natoms') 133 IMPORT :: c_ptr, c_double 134 TYPE(c_ptr), VALUE :: handle 135 REAL(c_double) :: lammps_get_natoms 136 END FUNCTION lammps_get_natoms 137 END INTERFACE 138 139CONTAINS 140 141 ! Fortran wrappers and helper functions. 142 143 ! Constructor for the LAMMPS class. 144 ! Combined wrapper around lammps_open_fortran() and lammps_open_no_mpi() 145 TYPE(lammps) FUNCTION lmp_open(args,comm) 146 IMPLICIT NONE 147 INTEGER,INTENT(in), OPTIONAL :: comm 148 CHARACTER(len=*), INTENT(in), OPTIONAL :: args(:) 149 TYPE(c_ptr), ALLOCATABLE :: argv(:) 150 TYPE(c_ptr) :: dummy=c_null_ptr 151 INTEGER :: i,argc 152 153 IF (PRESENT(args)) THEN 154 ! convert argument list to c style 155 argc = SIZE(args) 156 ALLOCATE(argv(argc)) 157 DO i=1,argc 158 argv(i) = f2c_string(args(i)) 159 END DO 160 ELSE 161 argc = 1 162 ALLOCATE(argv(1)) 163 argv(1) = f2c_string("liblammps") 164 ENDIF 165 166 IF (PRESENT(comm)) THEN 167 lmp_open%handle = lammps_open(argc,argv,comm) 168 ELSE 169 lmp_open%handle = lammps_open_no_mpi(argc,argv,dummy) 170 END IF 171 172 ! Clean up allocated memory 173 DO i=1,argc 174 CALL lammps_free(argv(i)) 175 END DO 176 DEALLOCATE(argv) 177 END FUNCTION lmp_open 178 179 ! Combined Fortran wrapper around lammps_close() and lammps_mpi_finalize() 180 SUBROUTINE lmp_close(self,finalize) 181 IMPLICIT NONE 182 CLASS(lammps) :: self 183 LOGICAL,INTENT(in),OPTIONAL :: finalize 184 185 CALL lammps_close(self%handle) 186 187 IF (PRESENT(finalize)) THEN 188 IF (finalize) THEN 189 CALL lammps_kokkos_finalize() 190 CALL lammps_mpi_finalize() 191 END IF 192 END IF 193 END SUBROUTINE lmp_close 194 195 INTEGER FUNCTION lmp_version(self) 196 IMPLICIT NONE 197 CLASS(lammps) :: self 198 199 lmp_version = lammps_version(self%handle) 200 END FUNCTION lmp_version 201 202 DOUBLE PRECISION FUNCTION lmp_get_natoms(self) 203 IMPLICIT NONE 204 CLASS(lammps) :: self 205 206 lmp_get_natoms = lammps_get_natoms(self%handle) 207 END FUNCTION lmp_get_natoms 208 209 SUBROUTINE lmp_file(self,filename) 210 IMPLICIT NONE 211 CLASS(lammps) :: self 212 CHARACTER(len=*) :: filename 213 TYPE(c_ptr) :: str 214 215 str = f2c_string(filename) 216 CALL lammps_file(self%handle,str) 217 CALL lammps_free(str) 218 END SUBROUTINE lmp_file 219 220 ! equivalent function to lammps_command() 221 SUBROUTINE lmp_command(self,cmd) 222 IMPLICIT NONE 223 CLASS(lammps) :: self 224 CHARACTER(len=*) :: cmd 225 TYPE(c_ptr) :: str 226 227 str = f2c_string(cmd) 228 CALL lammps_command(self%handle,str) 229 CALL lammps_free(str) 230 END SUBROUTINE lmp_command 231 232 ! equivalent function to lammps_commands_list() 233 SUBROUTINE lmp_commands_list(self,cmds) 234 IMPLICIT NONE 235 CLASS(lammps) :: self 236 CHARACTER(len=*), INTENT(in), OPTIONAL :: cmds(:) 237 TYPE(c_ptr), ALLOCATABLE :: cmdv(:) 238 INTEGER :: i,ncmd 239 240 ! convert command list to c style 241 ncmd = SIZE(cmds) 242 ALLOCATE(cmdv(ncmd)) 243 DO i=1,ncmd 244 cmdv(i) = f2c_string(cmds(i)) 245 END DO 246 247 CALL lammps_commands_list(self%handle,ncmd,cmdv) 248 249 ! Clean up allocated memory 250 DO i=1,ncmd 251 CALL lammps_free(cmdv(i)) 252 END DO 253 DEALLOCATE(cmdv) 254 END SUBROUTINE lmp_commands_list 255 256 ! equivalent function to lammps_commands_string() 257 SUBROUTINE lmp_commands_string(self,str) 258 IMPLICIT NONE 259 CLASS(lammps) :: self 260 CHARACTER(len=*) :: str 261 TYPE(c_ptr) :: tmp 262 263 tmp = f2c_string(str) 264 CALL lammps_commands_string(self%handle,tmp) 265 CALL lammps_free(tmp) 266 END SUBROUTINE lmp_commands_string 267 268 ! ---------------------------------------------------------------------- 269 ! local helper functions 270 ! copy fortran string to zero terminated c string 271 FUNCTION f2c_string(f_string) RESULT(ptr) 272 CHARACTER (len=*), INTENT(in) :: f_string 273 CHARACTER (len=1, kind=c_char), POINTER :: c_string(:) 274 TYPE(c_ptr) :: ptr 275 INTEGER(c_size_t) :: i, n 276 277 n = LEN_TRIM(f_string) 278 ptr = lammps_malloc(n+1) 279 CALL C_F_POINTER(ptr,c_string,[1]) 280 DO i=1,n 281 c_string(i) = f_string(i:i) 282 END DO 283 c_string(n+1) = c_null_char 284 END FUNCTION f2c_string 285END MODULE LIBLAMMPS 286