diff --git a/doc/src/Fortran.rst b/doc/src/Fortran.rst index 7e9f16fa70..3b9ad9d1ff 100644 --- a/doc/src/Fortran.rst +++ b/doc/src/Fortran.rst @@ -56,17 +56,6 @@ C++ in the ``examples/COUPLE/simple`` folder of the LAMMPS distribution. and Ubuntu 18.04 LTS and not compatible. Either newer compilers need to be installed or the Linux updated. -.. versionchanged:: 8Feb2023 - -.. note:: - - A contributed Fortran interface is available in the - ``examples/COUPLE/fortran2`` folder. However, since the completion - of the :f:mod:`LIBLAMMPS` module, this interface is now deprecated, - no longer actively maintained and will likely be removed in the - future. Please see the ``README`` file in that folder for more - information about it and how to contact its author and maintainer. - ---------- Creating or deleting a LAMMPS object diff --git a/examples/COUPLE/README b/examples/COUPLE/README index adf46d027d..13e593d55d 100644 --- a/examples/COUPLE/README +++ b/examples/COUPLE/README @@ -19,12 +19,12 @@ See these sections of the LAMMPS manual for details: Build LAMMPS as a library (doc/html/Build_basics.html) Link LAMMPS as a library to another code (doc/html/Build_link.html) Coupling LAMMPS to other codes (doc/html/Howto_couple.html) -Using LAMMPS in client/server mode (doc/html/Howto_client_server.html) Library interface to LAMMPS (doc/html/Howto_library.html) +Detailed documentation of the LAMMPS interfaces (doc/html/Library.html) -The library interface to LAMMPS is in src/library.cpp. Routines can -be easily added to this file so an external program can perform the -LAMMPS tasks desired. +The core library interface to LAMMPS is in src/library.cpp. Routines +can be easily added to this file so an external program can perform +the LAMMPS tasks desired. ------------------------------------------------------------------- @@ -36,10 +36,5 @@ plugin example for loading LAMMPS at runtime from a shared library lammps_spparks grain-growth Monte Carlo with strain via MD, coupling to SPPARKS kinetic MC code library collection of useful inter-code communication routines -fortran2 a more sophisticated wrapper on the LAMMPS library API that - can be called from Fortran -fortran_dftb wrapper written by Nir Goldman (LLNL), as an - extension to fortran2, used for calling LAMMPS - from Fortran DFTB+ tight-binding code Each sub-directory has its own README with more details. diff --git a/examples/COUPLE/fortran2/.gitignore b/examples/COUPLE/fortran2/.gitignore deleted file mode 100644 index 63a7748cf4..0000000000 --- a/examples/COUPLE/fortran2/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.mod diff --git a/examples/COUPLE/fortran2/LAMMPS-wrapper.cpp b/examples/COUPLE/fortran2/LAMMPS-wrapper.cpp deleted file mode 100644 index 4774cb6b49..0000000000 --- a/examples/COUPLE/fortran2/LAMMPS-wrapper.cpp +++ /dev/null @@ -1,96 +0,0 @@ -/* ----------------------------------------------------------------------- - LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator - https://www.lammps.org/, Sandia National Laboratories - LAMMPS development team: developers@lammps.org - - Copyright (2003) Sandia Corporation. Under the terms of Contract - DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains - certain rights in this software. This software is distributed under - the GNU General Public License. - - See the README file in the top-level LAMMPS directory. -------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------ - Contributing author: Karl D. Hammond - University of Missouri (USA), 2012 -------------------------------------------------------------------------- */ - -/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself - provides a (I hope) robust Fortran interface to library.cpp and - library.h. All functions herein COULD be added to library.cpp instead of - including this as a separate file. See the README for instructions. */ - -#include -#include "LAMMPS-wrapper.h" -#define LAMMPS_LIB_MPI 1 -#include -#include -#include -#include -#include -#include -#include -#include - -using namespace LAMMPS_NS; - -void lammps_open_fortran_wrapper (int argc, char **argv, - MPI_Fint communicator, void **ptr) -{ - MPI_Comm C_communicator = MPI_Comm_f2c (communicator); - lammps_open (argc, argv, C_communicator, ptr); -} - -int lammps_get_ntypes (void *ptr) -{ - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ntypes = lmp->atom->ntypes; - return ntypes; -} - -void lammps_error_all (void *ptr, const char *file, int line, const char *str) -{ - class LAMMPS *lmp = (class LAMMPS *) ptr; - lmp->error->all (file, line, str); -} - -int lammps_extract_compute_vectorsize (void *ptr, char *id, int style) -{ - int *size; - size = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_VECTOR); - if (size) return *size; - return 0; -} - -void lammps_extract_compute_arraysize (void *ptr, char *id, int style, - int *nrows, int *ncols) -{ - int *tmp; - tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_ROWS); - if (tmp) *nrows = *tmp; - tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_COLS); - if (tmp) *ncols = *tmp; - return; -} - -int lammps_extract_fix_vectorsize (void *ptr, char *id, int style) -{ - int *size; - size = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_VECTOR, 0, 0); - if (size) return *size; - return 0; -} - -void lammps_extract_fix_arraysize (void *ptr, char *id, int style, - int *nrows, int *ncols) -{ - int *tmp; - tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_ROWS, 0, 0); - if (tmp) *nrows = *tmp; - tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_COLS, 0, 0); - if (tmp) *ncols = *tmp; - return; -} - -/* vim: set ts=3 sts=3 expandtab: */ diff --git a/examples/COUPLE/fortran2/LAMMPS-wrapper.h b/examples/COUPLE/fortran2/LAMMPS-wrapper.h deleted file mode 100644 index 02e1a651a9..0000000000 --- a/examples/COUPLE/fortran2/LAMMPS-wrapper.h +++ /dev/null @@ -1,41 +0,0 @@ -/* ----------------------------------------------------------------------- - LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator - https://www.lammps.org/, Sandia National Laboratories - LAMMPS development team: developers@lammps.org - - Copyright (2003) Sandia Corporation. Under the terms of Contract - DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains - certain rights in this software. This software is distributed under - the GNU General Public License. - - See the README file in the top-level LAMMPS directory. -------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------ - Contributing author: Karl D. Hammond - University of Missouri (USA), 2012 -------------------------------------------------------------------------- */ - -/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself - provides a (I hope) robust Fortran interface to library.cpp and - library.h. All prototypes herein COULD be added to library.h instead of - including this as a separate file. See the README for instructions. */ - -#ifdef __cplusplus -extern "C" { -#endif - -/* Prototypes for auxiliary functions */ -void lammps_open_fortran_wrapper (int, char**, MPI_Fint, void**); -int lammps_get_ntypes (void*); -int lammps_extract_compute_vectorsize (void*, char*, int); -void lammps_extract_compute_arraysize (void*, char*, int, int*, int*); -int lammps_extract_fix_vectorsize (void*, char*, int); -void lammps_extract_fix_arraysize (void*, char*, int, int*, int*); -void lammps_error_all (void*, const char*, int, const char*); - -#ifdef __cplusplus -} -#endif - -/* vim: set ts=3 sts=3 expandtab: */ diff --git a/examples/COUPLE/fortran2/LAMMPS.F90 b/examples/COUPLE/fortran2/LAMMPS.F90 deleted file mode 100644 index 2f4ae2c95e..0000000000 --- a/examples/COUPLE/fortran2/LAMMPS.F90 +++ /dev/null @@ -1,1788 +0,0 @@ -!! ----------------------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! https://www.lammps.org/ Sandia National Laboratories -! LAMMPS Development team: developers@lammps.org -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -!-------------------------------------------------------------------------- - -!! ------------------------------------------------------------------------ -! Contributing author: Karl D. Hammond -! University of Tennessee, Knoxville (USA), 2012 -! Updated October 2020 by the author (now at the University of Missouri). -!-------------------------------------------------------------------------- - -!! NOTE ------------------------------------------------------------------- -! This interface is obsolete and may be removed in a future release of -! LAMMPS. The interface in fortran/lammps.f90 replaces this one. That API -! is maintained by the LAMMPS developers and has documentation written for -! it; it is based loosely on this one, but binds all procedures to a lammps -! derived type. That interface was written in large -! part by the same author, but is also supported by other developers. -!-------------------------------------------------------------------------- - -!! LAMMPS, a Fortran 2003 module containing an interface between Fortran -!! programs and the C-style functions in library.cpp that ship with LAMMPS. -!! This file should be accompanied by LAMMPS-wrapper.cpp and LAMMPS-wrapper.h, -!! which define wrapper functions that ease portability and enforce array -!! dimensions. -!! -!! Everything in this module should be 100% portable by way of Fortran 2003's -!! ISO_C_BINDING intrinsic module. See the README for instructions for -!! compilation and use. -!! -!! Here are the PUBLIC functions and subroutines included in this module. -!! subroutine lammps_open (command_line, communicator, ptr) -!! subroutine lammps_open_no_mpi (command_line, ptr) -!! subroutine lammps_close (ptr) -!! integer (kind=C_int) lammps_version (ptr) -!! subroutine lammps_file (ptr, str) -!! subroutine lammps_command (ptr, str) -!! subroutine lammps_commands_list (ptr, cmds) -!! subroutine lammps_commands_string (ptr, str) -!! subroutine lammps_free (ptr) -!! integer function lammps_extract_setting (ptr, name) -!! subroutine lammps_extract_global (global, ptr, name) -!! subroutine lammps_extract_box (ptr, boxlo, boxhi, xy, yz, xz, & -!! periodicity, box_change) -!! subroutine lammps_extract_atom (atom, ptr, name) -!! subroutine lammps_extract_compute (compute, ptr, id, style, type) -!! subroutine lammps_extract_fix (fix, ptr, id, style, type, i, j) -!! subroutine lammps_extract_variable (variable, ptr, name, group) -!! double precision function lammps_get_thermo (ptr, name) -!! double precision function lammps_get_natoms (ptr) -!! subroutine lammps_set_variable (ptr, name, str, [err]) -!! subroutine lammps_reset_box (ptr, boxlo, boxhi, xy, yz, xz) -!! subroutine lammps_gather_atoms (ptr, name, count, data) -!! subroutine lammps_gather_atoms_concat (ptr, name, count, data) -!! subroutine lammps_gather_atoms_subset (ptr, name, count, ids, data) -!! subroutine lammps_scatter_atoms (ptr, name, data) -!! subroutine lammps_scatter_atoms_subset (ptr, name, ids, data) -!! logical function lammps_config_has_package (package_name) -!! integer function lammps_config_package_count () -!! logical function lammps_config_package_name (index, buffer) -!! logical function lammps_config_has_gzip_support () -!! logical function lammps_config_has_png_support () -!! logical function lammps_config_has_jpeg_support () -!! logical function lammps_config_has_ffmpeg_support () -!! logical function lammps_config_has_exceptions () -!! integer function lammps_find_pair_neighlist (ptr, style, exact, nsub, -!! request) -!! integer function lammps_find_fix_neighlist (ptr, id, request) -!! integer function lammps_find_compute_neighlist (ptr, id, request) -!! integer function lammps_neighlist_num_elements (ptr, idx) -!! subroutine lammps_neighlist_element_neighbors (ptr, idx, element, iatom, -!! numneigh, neighbors) -!! subroutine lammps_create_atoms (ptr, n, id, type, x, v, image, -!1 shrinkexceed) -!! -!! The following are also available if compiled with -DLAMMPS_EXCEPTIONS -!! function lammps_has_error (ptr) -!! function lammps_get_last_error_message (ptr, buffer) -!! -!! Note that the following function is not implemented from this interface: -!! lammps_set_fix_external_callback - -#define FLERR __FILE__,__LINE__ -! The above line allows for similar error checking as is done with standard -! LAMMPS files. - -! This should (?) allow this module to work with settings in lmptype.h -#if !defined(LAMMPS_SMALLSMALL) && !defined(LAMMPS_BIGBIG) && !defined(LAMMPS_SMALLBIG) -#define LAMMPS_SMALLBIG -#endif - -#ifdef LAMMPS_SMALLBIG -#define C_smallint C_int -#define C_imageint C_int -#define C_tagint C_int -#define C_bigint C_int64_t -#endif - -#ifdef LAMMPS_BIGBIG -#define C_smallint C_int -#define C_imageint C_int64_t -#define C_tagint C_int64_t -#define C_bigint C_int64_t -#endif - -#ifdef LAMMPS_SMALLSMALL -#define C_smallint C_int -#define C_imageint C_int -#define C_tagint C_int -#define C_bigint C_int -#endif - -module LAMMPS - - use, intrinsic :: ISO_C_binding, only : C_double, C_int, C_ptr, C_char, & - C_NULL_CHAR, C_NULL_PTR, C_loc, C_F_pointer, C_int64_t, & - lammps_instance => C_ptr - implicit none - private - - ! We inherit some ISO_C_BINDING entities for ease of use - public :: lammps_instance, C_ptr, C_double, C_int - ! Only the following functions may be called by the user: - public :: lammps_open, lammps_open_no_mpi, lammps_close, & - lammps_version, lammps_file, lammps_command, lammps_commands_list, & - lammps_commands_string, lammps_free, lammps_extract_setting, & - lammps_extract_global, lammps_extract_box, lammps_extract_atom, & - lammps_extract_compute, lammps_extract_fix, lammps_extract_variable, & - lammps_get_thermo, lammps_get_natoms, lammps_set_variable, & - lammps_reset_box, lammps_gather_atoms, lammps_gather_atoms_concat, & - lammps_gather_atoms_subset, lammps_scatter_atoms, & - lammps_scatter_atoms_subset, lammps_config_has_package, & - lammps_config_package_count, lammps_config_package_name, & - lammps_config_has_gzip_support, lammps_config_has_png_support, & - lammps_config_has_jpeg_support, lammps_config_has_ffmpeg_support, & - lammps_config_has_exceptions, lammps_find_pair_neighlist, & - lammps_find_fix_neighlist, lammps_find_compute_neighlist, & - lammps_neighlist_num_elements, lammps_neighlist_element_neighbors, & - lammps_create_atoms - -#ifdef LAMMPS_EXCEPTIONS - public :: lammps_has_error, lammps_get_last_error_message -#endif - - !! constants for extracting data from computes and fixes - !! and data types - - INTEGER, PARAMETER :: LMP_STYLE_GLOBAL = 0, LMP_STYLE_ATOM = 1, & - LMP_STYLE_LOCAL = 2, LMP_TYPE_SCALAR = 0, LMP_TYPE_VECTOR = 1, & - LMP_TYPE_ARRAY = 2, LMP_SIZE_VECTOR = 3, LMP_SIZE_ROWS = 4, & - LMP_SIZE_COLS = 5, LAMMPS_INT = 0, LAMMPS_INT_2D = 1, & - LAMMPS_DOUBLE = 2, LAMMPS_DOUBLE_2D = 3, LAMMPS_INT64 = 4, & - LAMMPS_INT64_2D = 5, LAMMPS_STRING = 6 - - PUBLIC :: LMP_STYLE_GLOBAL, LMP_STYLE_ATOM, LMP_STYLE_LOCAL, & - LMP_TYPE_SCALAR, LMP_TYPE_VECTOR, LMP_TYPE_ARRAY, & - LMP_SIZE_VECTOR, LMP_SIZE_ROWS, LMP_SIZE_COLS, LAMMPS_INT, & - LAMMPS_INT_2D, LAMMPS_DOUBLE, LAMMPS_DOUBLE_2D, LAMMPS_INT64, & - LAMMPS_INT64_2D, LAMMPS_STRING - - !! Functions supplemental to the prototypes in library.h. {{{1 - !! The function definitions (in C++) are contained in LAMMPS-wrapper.cpp. - !! I would have written the first in Fortran, but the MPI libraries (which - !! were written in C) have C-based functions to convert from Fortran MPI - !! handles to C MPI handles, and there is no Fortran equivalent for those - !! functions. - interface - subroutine lammps_open_wrapper (argc, argv, communicator, ptr) & - bind (C, name='lammps_open_fortran_wrapper') - import :: C_int, C_ptr - integer (C_int), value :: argc - type (C_ptr), dimension(*) :: argv - integer, value :: communicator - type (C_ptr) :: ptr - end subroutine lammps_open_wrapper - subroutine lammps_actual_error_all (ptr, file, line, str) & - bind (C, name='lammps_error_all') - import :: C_int, C_char, C_ptr - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: file, str - integer (C_int), value :: line - end subroutine lammps_actual_error_all - function lammps_get_ntypes (ptr) result (ntypes) & - bind (C, name='lammps_get_ntypes') - import :: C_int, C_ptr - type (C_ptr), value :: ptr - integer (C_int) :: ntypes - end function lammps_get_ntypes - function lammps_actual_extract_compute_vectorsize (ptr, id, style) & - result (vectorsize) bind (C, name='lammps_extract_compute_vectorsize') - import :: C_int, C_char, C_ptr - integer (C_int) :: vectorsize - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - end function lammps_actual_extract_compute_vectorsize - subroutine lammps_actual_extract_compute_arraysize (ptr, id, style, & - nrows, ncols) bind (C, name='lammps_extract_compute_arraysize') - import :: C_int, C_char, C_ptr - integer (C_int) :: arraysize - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - integer (C_int) :: nrows, ncols - end subroutine lammps_actual_extract_compute_arraysize - function lammps_actual_extract_fix_vectorsize (ptr, id, style) & - result (vectorsize) bind (C, name='lammps_extract_fix_vectorsize') - import :: C_int, C_char, C_ptr - integer (C_int) :: vectorsize - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - end function lammps_actual_extract_fix_vectorsize - subroutine lammps_actual_extract_fix_arraysize (ptr, id, style, & - nrows, ncols) bind (C, name='lammps_extract_fix_arraysize') - import :: C_int, C_char, C_ptr - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - integer (C_int) :: nrows, ncols - end subroutine lammps_actual_extract_fix_arraysize - end interface - - !! Functions/subroutines defined in library.h and library.cpp {{{1 - interface - subroutine lammps_actual_open_no_mpi (argc, argv, ptr) & - bind (C, name='lammps_open_no_mpi') - import :: C_int, C_ptr - integer (C_int), value :: argc - type (C_ptr), dimension(*) :: argv - type (C_ptr) :: ptr - end subroutine lammps_actual_open_no_mpi - - subroutine lammps_close (ptr) bind (C, name='lammps_close') - import :: C_ptr - type (C_ptr), value :: ptr - end subroutine lammps_close - - function lammps_version (ptr) result (version) & - bind (C, name='lammps_version') - import :: C_ptr, C_int - type (C_ptr), value :: ptr - integer (kind=C_int) :: version - end function lammps_version - - subroutine lammps_actual_file (ptr, str) bind (C, name='lammps_file') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: str - end subroutine lammps_actual_file - - function lammps_actual_command (ptr, str) result (command) & - bind (C, name='lammps_command') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: str - type (C_ptr) :: command - end function lammps_actual_command - - subroutine lammps_actual_commands_list (ptr, ncmd, cmds) & - bind (C, name='lammps_commands_list') - import :: C_ptr, C_int - type (C_ptr), value :: ptr - type (C_ptr), dimension(*) :: cmds - integer (C_int), value :: ncmd - end subroutine lammps_actual_commands_list - - subroutine lammps_actual_commands_string (ptr, str) & - bind (C, name='lammps_commands_string') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: str - end subroutine lammps_actual_commands_string - - subroutine lammps_free (ptr) bind (C, name='lammps_free') - import :: C_ptr - type (C_ptr), value :: ptr - end subroutine lammps_free - - function lammps_actual_extract_setting (ptr, name) result (setting) & - bind(C, name='lammps_extract_setting') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name - integer (kind=C_int) :: setting - end function lammps_actual_extract_setting - - function lammps_actual_extract_global (ptr, name) & - bind (C, name='lammps_extract_global') result (global) - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name - type (C_ptr) :: global - end function lammps_actual_extract_global - - subroutine lammps_actual_extract_box (ptr, boxlo, boxhi, xy, yz, & - xz, periodicity, box_change) bind (C, name='lammps_extract_box') - import :: C_ptr, C_double, C_int - type (C_ptr), value :: ptr - real (C_double) :: boxlo(3), boxhi(3), xy, yz, xz - integer (C_int) :: periodicity(3), box_change - end subroutine lammps_actual_extract_box - - function lammps_actual_extract_atom (ptr, name) & - bind (C, name='lammps_extract_atom') result (atom) - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name - type (C_ptr) :: atom - end function lammps_actual_extract_atom - - function lammps_actual_extract_compute (ptr, id, style, type) & - result (compute) bind (C, name='lammps_extract_compute') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style, type - type (C_ptr) :: compute - end function lammps_actual_extract_compute - - function lammps_actual_extract_fix (ptr, id, style, type, i, j) & - result (fix) bind (C, name='lammps_extract_fix') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style, type, i, j - type (C_ptr) :: fix - end function lammps_actual_extract_fix - - function lammps_actual_extract_variable (ptr, name, group) & - result (variable) bind (C, name='lammps_extract_variable') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name, group - type (C_ptr) :: variable - end function lammps_actual_extract_variable - - function lammps_actual_get_thermo (ptr, name) result (dval) & - bind (C, name='lammps_get_thermo') - import :: C_ptr, C_char, C_double - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name - real (C_double) :: dval - end function lammps_actual_get_thermo - - function lammps_get_natoms (ptr) result (natoms) & - bind (C, name='lammps_get_natoms') - import :: C_ptr, C_double - type (C_ptr), value :: ptr - real (C_double) :: natoms - end function lammps_get_natoms - - function lammps_actual_set_variable (ptr, name, str) result (err) & - bind (C, name='lammps_set_variable') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name, str - integer (C_int) :: err - end function lammps_actual_set_variable - - subroutine lammps_actual_reset_box (ptr, boxlo, boxhi, xy, yz, xz) & - bind (C, name='lammps_reset_box') - import :: C_ptr, C_double, C_int - type (C_ptr), value :: ptr - real (C_double) :: boxlo(3), boxhi(3), xy, yz, xz - end subroutine lammps_actual_reset_box - - subroutine lammps_actual_gather_atoms (ptr, name, type, count, data) & - bind (C, name='lammps_gather_atoms') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count - end subroutine lammps_actual_gather_atoms - - subroutine lammps_actual_gather_atoms_concat (ptr, name, type, count, & - data) bind (C, name='lammps_gather_atoms_concat') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count - end subroutine lammps_actual_gather_atoms_concat - - subroutine lammps_actual_gather_atoms_subset (ptr, name, type, count, & - ndata, ids, data) bind (C, name='lammps_gather_atoms_subset') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count, ndata - integer (C_int) :: ids(:) - end subroutine lammps_actual_gather_atoms_subset - - subroutine lammps_actual_scatter_atoms (ptr, name, type, count, data) & - bind (C, name='lammps_scatter_atoms') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count - end subroutine lammps_actual_scatter_atoms - - subroutine lammps_actual_scatter_atoms_subset (ptr, name, type, count, & - ndata, ids, data) bind (C, name='lammps_scatter_atoms_subset') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count, ndata - integer (C_int), dimension(*) :: ids - end subroutine lammps_actual_scatter_atoms_subset - - function lammps_actual_config_has_package (package_name) & - result (has_it) bind (C, name='lammps_config_has_package') - import :: C_char, C_int - character (len=1, kind=C_char), dimension(*) :: package_name - integer (C_int) :: has_it - end function lammps_actual_config_has_package - - function lammps_config_package_count () result (count) & - bind (C, name='lammps_config_package_count') - import :: C_int - integer (C_int) :: count - end function lammps_config_package_count - - function lammps_actual_config_package_name (index, buffer, max_size) & - result (num) bind (C, name='lammps_config_package_name') - import :: C_int, C_char - integer (C_int), value :: index, max_size - character (len=1, kind=C_char), dimension(*) :: buffer - integer (C_int) :: num - end function lammps_actual_config_package_name - - function lammps_actual_config_has_gzip_support () result (C_has_it) & - bind (C, name='lammps_config_has_gzip_support') - import :: C_int - integer (C_int) :: C_has_it - end function lammps_actual_config_has_gzip_support - - function lammps_actual_config_has_png_support () result (C_has_it) & - bind (C, name='lammps_config_has_png_support') - import :: C_int - integer (C_int) :: C_has_it - end function lammps_actual_config_has_png_support - - function lammps_actual_config_has_jpeg_support () result (C_has_it) & - bind (C, name='lammps_config_has_jpeg_support') - import :: C_int - integer (C_int) :: C_has_it - end function lammps_actual_config_has_jpeg_support - - function lammps_actual_config_has_ffmpeg_support () result (C_has_it) & - bind (C, name='lammps_config_has_ffmpeg_support') - import :: C_int - integer (C_int) :: C_has_it - end function lammps_actual_config_has_ffmpeg_support - - function lammps_actual_config_has_exceptions () result (C_has_it) & - bind (C, name='lammps_config_has_exceptions') - import :: C_int - integer (C_int) :: C_has_it - end function lammps_actual_config_has_exceptions - - function lammps_actual_find_pair_neighlist (ptr, style, exact, nsub, & - request) result (C_neighlist) & - bind (C, name='lammps_find_pair_neighlist') - import :: C_ptr, C_int, C_char - integer (C_int) :: C_neighlist - type (C_ptr), value :: ptr - character (len=1, kind=C_char), dimension(*) :: style - integer (C_int), value :: exact, nsub, request - end function lammps_actual_find_pair_neighlist - - function lammps_actual_find_fix_neighlist (ptr, id, request) & - result (C_neighlist) bind (C, name='lammps_find_fix_neighlist') - import :: C_ptr, C_int, C_char - integer (C_int) :: C_neighlist - type (C_ptr), value :: ptr - character (len=1, kind=C_char), dimension(*) :: id - integer (C_int), value :: request - end function lammps_actual_find_fix_neighlist - - function lammps_actual_find_compute_neighlist (ptr, id, request) & - result (C_neighlist) bind (C, name='lammps_find_compute_neighlist') - import :: C_ptr, C_int, C_char - integer (C_int) :: C_neighlist - type (C_ptr), value :: ptr - character (len=1, kind=C_char), dimension(*) :: id - integer (C_int), value :: request - end function lammps_actual_find_compute_neighlist - - function lammps_actual_neighlist_num_elements (ptr, idx) & - result (nelements) bind (C, name='lammps_neighlist_num_elements') - import :: C_ptr, C_int - integer (C_int) :: nelements - type (C_ptr), value :: ptr - integer (C_int), value :: idx - end function lammps_actual_neighlist_num_elements - - subroutine lammps_actual_neighlist_element_neighbors (ptr, idx, & - element, iatom, numneigh, neighbors) & - bind (C, name='lammps_neighlist_element_neighbors') - import :: C_ptr, C_int - type (C_ptr), value :: ptr - integer (C_int), value :: idx, element - integer (C_int) :: iatom, numneigh - type (C_ptr) :: neighbors - end subroutine lammps_actual_neighlist_element_neighbors - - subroutine lammps_actual_create_atoms (ptr, n, id, type, x, v, image, & - shrinkexceed) bind (C, name='lammps_create_atoms') - import :: C_ptr, C_int64_t, C_double, C_int - type (C_ptr), value :: ptr - integer (C_int), value :: n - integer (C_tagint) :: id - integer (C_int) :: type - real (C_double), dimension(*) :: x, v - integer (C_imageint), dimension(*) :: image - integer (C_int), value :: shrinkexceed - end subroutine lammps_actual_create_atoms - -#ifdef LAMMPS_EXCEPTIONS - - function lammps_actual_has_error (ptr) result (C_has_it) & - bind (C, name='lammps_has_error') - import :: C_int, C_ptr - type (C_ptr), value :: ptr - integer (C_int) :: C_has_it - end function lammps_actual_has_error - - function lammps_actual_get_last_error_message (ptr, buffer, & - buffer_size) result (error_type) & - bind (C, name='lammps_get_last_error_message') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - integer (C_int), value :: buffer_size - character (len=1, kind=C_char), dimension(*) :: buffer - integer (C_int) :: error_type - end function lammps_actual_get_last_error_message - -#endif - - end interface - - ! Generic functions for the wrappers below {{{1 - - interface lammps_extract_global - module procedure lammps_extract_global_i, & - lammps_extract_global_dp - end interface lammps_extract_global - - interface lammps_extract_atom - module procedure lammps_extract_atom_ia, & - lammps_extract_atom_dpa, & - lammps_extract_atom_dp2a - end interface lammps_extract_atom - - interface lammps_extract_compute - module procedure lammps_extract_compute_dp, & - lammps_extract_compute_dpa, & - lammps_extract_compute_dp2a - end interface lammps_extract_compute - - interface lammps_extract_fix - module procedure lammps_extract_fix_dp, & - lammps_extract_fix_dpa, & - lammps_extract_fix_dp2a - end interface lammps_extract_fix - - interface lammps_extract_variable - module procedure lammps_extract_variable_dp, & - lammps_extract_variable_dpa - end interface lammps_extract_variable - - interface lammps_gather_atoms - module procedure lammps_gather_atoms_ia, lammps_gather_atoms_dpa - end interface lammps_gather_atoms - - interface lammps_gather_atoms_concat - module procedure lammps_gather_atoms_concat_ia, & - lammps_gather_atoms_concat_dpa - end interface lammps_gather_atoms_concat - - interface lammps_gather_atoms_subset - module procedure lammps_gather_atoms_subset_ia, & - lammps_gather_atoms_subset_dpa - end interface lammps_gather_atoms_subset - - interface lammps_scatter_atoms - module procedure lammps_scatter_atoms_ia, lammps_scatter_atoms_dpa - end interface lammps_scatter_atoms - - interface lammps_scatter_atoms_subset - module procedure lammps_scatter_atoms_subset_ia, & - lammps_scatter_atoms_subset_dpa - end interface lammps_scatter_atoms_subset - -contains !! Wrapper functions local to this module {{{1 - - subroutine lammps_open (command_line, communicator, ptr) - character (len=*), intent(in) :: command_line - integer, intent(in) :: communicator - type (C_ptr) :: ptr - integer (C_int) :: argc - type (C_ptr), dimension(:), allocatable :: argv - character (kind=C_char), dimension(len_trim(command_line)+1), target :: & - c_command_line - c_command_line = string2Cstring (command_line) - call Cstring2argcargv (c_command_line, argc, argv) - call lammps_open_wrapper (argc, argv, communicator, ptr) - deallocate (argv) - end subroutine lammps_open - -!----------------------------------------------------------------------------- - - subroutine lammps_open_no_mpi (command_line, ptr) - character (len=*), intent(in) :: command_line - type (C_ptr) :: ptr - integer (C_int) :: argc - type (C_ptr), dimension(:), allocatable :: argv - character (kind=C_char), dimension(len_trim(command_line)+1), target :: & - c_command_line - c_command_line = string2Cstring (command_line) - call Cstring2argcargv (c_command_line, argc, argv) - call lammps_actual_open_no_mpi (argc, argv, ptr) - deallocate (argv) - end subroutine lammps_open_no_mpi - -!----------------------------------------------------------------------------- - - subroutine lammps_file (ptr, str) - type (C_ptr) :: ptr - character (len=*) :: str - character (kind=C_char), dimension(len_trim(str)+1) :: Cstr - Cstr = string2Cstring (str) - call lammps_actual_file (ptr, Cstr) - end subroutine lammps_file - -!----------------------------------------------------------------------------- - - subroutine lammps_command (ptr, str) - type (C_ptr) :: ptr - character (len=*) :: str - character (kind=C_char), dimension(len_trim(str)+1) :: Cstr - type (C_ptr) :: dummy - Cstr = string2Cstring (str) - dummy = lammps_actual_command (ptr, Cstr) - end subroutine lammps_command - -!----------------------------------------------------------------------------- - - subroutine lammps_commands_list (ptr, cmds) - type (C_ptr), intent(in) :: ptr - character (len=*), dimension(:) :: cmds - integer (C_int) :: ncmd -! character (kind=C_char,len=1), dimension(size(cmds)) :: C_cmds - type (C_ptr), dimension(:), allocatable :: C_cmds - character (len=1, kind=C_char), allocatable, target :: C_strings(:,:) - integer :: i, max_len - ncmd = size(cmds) - allocate (C_cmds(ncmd)) - max_len = 0 - do i=1, size(cmds) - if ( len(cmds(i)) > max_len ) max_len = len(cmds(i)) - end do - allocate (C_strings(max_len + 1, ncmd)) - do i=1, size(cmds) - C_strings(:,i) = string2Cstring(cmds(i)) - C_cmds(i) = C_loc(C_strings(1,i)) - end do - call lammps_actual_commands_list (ptr, ncmd, C_cmds) - deallocate (C_strings) - deallocate (C_cmds) - end subroutine lammps_commands_list - -!----------------------------------------------------------------------------- - - subroutine lammps_commands_string (ptr, str) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: str - character (kind=C_char), dimension(len_trim(str)+1) :: C_str - C_str = string2Cstring (str) - call lammps_actual_commands_string (ptr, C_str) - end subroutine lammps_commands_string - -!----------------------------------------------------------------------------- - - function lammps_extract_setting (ptr, name) result (setting) - integer :: setting - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (kind=C_char), dimension(len_trim(name)+1) :: C_name - C_name = string2Cstring (name) - setting = lammps_actual_extract_setting (ptr, C_name) - end function lammps_extract_setting - -!----------------------------------------------------------------------------- - -! lammps_extract_global {{{2 - function lammps_extract_global_Cptr (ptr, name) result (global) - type (C_ptr) :: global - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - Cname = string2Cstring (name) - global = lammps_actual_extract_global (ptr, Cname) - end function lammps_extract_global_Cptr - subroutine lammps_extract_global_i (global, ptr, name) - integer (C_int), pointer, intent(out) :: global - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - Cptr = lammps_extract_global_Cptr (ptr, name) - call C_F_pointer (Cptr, global) - end subroutine lammps_extract_global_i - subroutine lammps_extract_global_dp (global, ptr, name) - real (C_double), pointer, intent(out) :: global - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - Cptr = lammps_extract_global_Cptr (ptr, name) - call C_F_pointer (Cptr, global) - end subroutine lammps_extract_global_dp - -!----------------------------------------------------------------------------- - -! lammps_extract_box {{{2 - subroutine lammps_extract_box (ptr, boxlo, boxhi, xy, yz, xz, & - periodicity, box_change) - type (C_ptr), intent(in) :: ptr - double precision, dimension(3), intent(out) :: boxlo, boxhi - double precision, intent(out) :: xy, yz, xz - logical, intent(out) :: periodicity(3), box_change - integer (kind=C_int) :: C_periodicity(3), C_box_change - real (C_double) :: C_boxlo(3), C_boxhi(3), C_xy, C_yz, C_xz - call lammps_actual_extract_box (ptr, C_boxlo, C_boxhi, C_xy, C_yz, & - C_xz, C_periodicity, C_box_change) - boxlo = C_boxlo - boxhi = C_boxhi - xy = C_xy - yz = C_yz - xz = C_xz - periodicity = (C_periodicity == 1) - box_change = (C_box_change == 1) - end subroutine - -!----------------------------------------------------------------------------- - -! lammps_extract_atom {{{2 - function lammps_extract_atom_Cptr (ptr, name) result (atom) - type (C_ptr) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - Cname = string2Cstring (name) - atom = lammps_actual_extract_atom (ptr, Cname) - end function lammps_extract_atom_Cptr - subroutine lammps_extract_atom_ia (atom, ptr, name) - integer (C_int), dimension(:), pointer, intent(out) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - integer (C_int), pointer :: nelements - call lammps_extract_global_i (nelements, ptr, 'nlocal') - Cptr = lammps_extract_atom_Cptr (ptr, name) - call C_F_pointer (Cptr, atom, (/nelements/)) - end subroutine lammps_extract_atom_ia - subroutine lammps_extract_atom_dpa (atom, ptr, name) - real (C_double), dimension(:), pointer, intent(out) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - integer (C_int), pointer :: nlocal - integer :: nelements - real (C_double), dimension(:), pointer :: Fptr - if ( name == 'mass' ) then - nelements = lammps_get_ntypes (ptr) + 1 - else if ( name == 'x' .or. name == 'v' .or. name == 'f' .or. & - name == 'mu' .or. name == 'omega' .or. name == 'torque' .or. & - name == 'angmom' ) then - ! We should not be getting a rank-2 array here! - call lammps_error_all (ptr, FLERR, 'You cannot extract those atom& - & data (' // trim(name) // ') into a rank 1 array.') - return - else - ! Everything else we can get is probably nlocal units long - call lammps_extract_global_i (nlocal, ptr, 'nlocal') - nelements = nlocal - end if - Cptr = lammps_extract_atom_Cptr (ptr, name) - call C_F_pointer (Cptr, Fptr, (/nelements/)) - if ( name == 'mass' ) then - atom(0:) => Fptr - else - atom => Fptr - end if - end subroutine lammps_extract_atom_dpa - subroutine lammps_extract_atom_dp2a (atom, ptr, name) - real (C_double), dimension(:,:), pointer, intent(out) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Catom - integer (C_int), pointer :: nelements - if ( name /= 'x' .and. name /= 'v' .and. name /= 'f' .and. & - name /= 'mu' .and. name /= 'omega' .and. name /= 'tandque' .and. & - name /= 'angmom' ) then - ! We should not be getting a rank-2 array here! - call lammps_error_all (ptr, FLERR, 'You cannot extract those atom& - & data (' // trim(name) // ') into a rank 2 array.') - return - end if - Cptr = lammps_extract_atom_Cptr (ptr, name) - call lammps_extract_global_i (nelements, ptr, 'nlocal') - ! Catom will now be the array of void* pointers that the void** pointer - ! pointed to. Catom(1) is now the pointer to the first element. - call C_F_pointer (Cptr, Catom, (/nelements/)) - ! Now get the actual array, which has its shape transposed from what we - ! might think of it in C - call C_F_pointer (Catom(1), atom, (/3, nelements/)) - end subroutine lammps_extract_atom_dp2a - -!----------------------------------------------------------------------------- - -! lammps_extract_compute {{{2 - function lammps_extract_compute_Cptr (ptr, id, style, type) result (compute) - type (C_ptr) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - integer (kind=C_int) :: Cstyle, Ctype - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = style - Ctype = type - compute = lammps_actual_extract_compute (ptr, Cid, Cstyle, Ctype) - end function lammps_extract_compute_Cptr - subroutine lammps_extract_compute_dp (compute, ptr, id, style, type) - real (C_double), pointer, intent(out) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - type (C_ptr) :: Cptr - ! The only valid values of (style,type) are (0,0) for scalar 'compute' - if ( style /= 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot pack per-atom/local& - & data into a scalar.') - return - end if - if ( type == 1 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & vector (rank 1) into a scalar.') - return - else if ( type == 2 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & array (rank 2) into a scalar.') - return - end if - Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) - call C_F_pointer (Cptr, compute) - end subroutine lammps_extract_compute_dp - subroutine lammps_extract_compute_dpa (compute, ptr, id, style, type) - real (C_double), dimension(:), pointer, intent(out) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - type (C_ptr) :: Cptr - integer :: nelements - ! Check for the correct dimensionality - if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & scalar (rank 0) into a rank 1 variable.') - return - else if ( type == 2 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & array (rank 2) into a rank 1 variable.') - return - end if - nelements = lammps_extract_compute_vectorsize (ptr, id, style) - Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) - call C_F_pointer (Cptr, compute, (/nelements/)) - end subroutine lammps_extract_compute_dpa - subroutine lammps_extract_compute_dp2a (compute, ptr, id, style, type) - real (C_double), dimension(:,:), pointer, intent(out) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Ccompute - integer :: nr, nc - ! Check for the correct dimensionality - if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & scalar (rank 0) into a rank 2 variable.') - return - else if ( type == 1 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & array (rank 1) into a rank 2 variable.') - return - end if - call lammps_extract_compute_arraysize (ptr, id, style, nr, nc) - Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) - call C_F_pointer (Cptr, Ccompute, (/nr/)) - ! Note that the matrix is transposed, from Fortran's perspective - call C_F_pointer (Ccompute(1), compute, (/nc, nr/)) - end subroutine lammps_extract_compute_dp2a - -!----------------------------------------------------------------------------- - -! lammps_extract_fix {{{2 - function lammps_extract_fix_Cptr (ptr, id, style, type, i, j) & - result (fix) - type (C_ptr) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - integer (kind=C_int) :: Cstyle, Ctype, Ci, Cj - Cid = string2Cstring (id) - Cstyle = style - Ctype = type - Ci = i - 1 ! This is for consistency with the values from f_ID[i], - Cj = j - 1 ! which is different from what library.cpp uses! - if ( (type >= 1 .and. Ci < 0) .or. & - (type == 2 .and. (Ci < 0 .or. Cj < 0) ) ) then - call lammps_error_all (ptr, FLERR, 'Index out of range in& - & lammps_extract_fix') - end if - fix = lammps_actual_extract_fix (ptr, Cid, Cstyle, Ctype, Ci, Cj) - end function lammps_extract_fix_Cptr - subroutine lammps_extract_fix_dp (fix, ptr, id, style, type, i, j) - real (C_double), intent(out) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - type (C_ptr) :: Cptr - real (C_double), pointer :: Fptr - ! Check for the correct dimensionality - if ( style /= 0 ) then - select case (type) - case (0) - call lammps_error_all (ptr, FLERR, 'There is no per-atom or local& - & scalar data available from fixes.') - case (1) - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix''s & - &per-atom/local vector (rank 1) into a scalar.') - case (2) - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix''s & - &per-atom/local array (rank 2) into a scalar.') - case default - call lammps_error_all (ptr, FLERR, 'Invalid extract_fix style/& - &type combination.') - end select - return - end if - Cptr = lammps_extract_fix_Cptr (ptr, id, style, type, i, j) - call C_F_pointer (Cptr, Fptr) - fix = Fptr - nullify (Fptr) - ! Memory is only allocated for "global" fix variables - if ( style == 0 ) call lammps_free (Cptr) - end subroutine lammps_extract_fix_dp - subroutine lammps_extract_fix_dpa (fix, ptr, id, style, type, i, j) - real (C_double), dimension(:), pointer, intent(out) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - type (C_ptr) :: Cptr - integer :: fix_len - ! Check for the correct dimensionality - if ( style == 0 ) then - call lammps_error_all (ptr, FLERR, 'You can''t extract the& - & whole vector from global fix data') - return - else if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You can''t extract a fix& - & scalar into a rank 1 variable') - return - else if ( type == 2 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix& - & array into a rank 1 variable.') - return - else if ( type /= 1 ) then - call lammps_error_all (ptr, FLERR, 'Invalid type for fix extraction.') - return - end if - fix_len = lammps_extract_fix_vectorsize (ptr, id, style) - call C_F_pointer (Cptr, fix, (/fix_len/)) - ! Memory is only allocated for "global" fix variables, which we should - ! never get here, so no need to call lammps_free! - end subroutine lammps_extract_fix_dpa - subroutine lammps_extract_fix_dp2a (fix, ptr, id, style, type, i, j) - real (C_double), dimension(:,:), pointer, intent(out) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Cfix - integer :: nr, nc - ! Check for the correct dimensionality - if ( style == 0 ) then - call lammps_error_all (ptr, FLERR, 'It is not possible to extract the& - & entire array from global fix data.') - return - else if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix& - & scalar (rank 0) into a rank 2 variable.') - return - else if ( type == 1 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix& - & vector (rank 1) into a rank 2 variable.') - return - end if - call lammps_extract_fix_arraysize (ptr, id, style, nr, nc) - ! Extract pointer to first element as Cfix(1) - call C_F_pointer (Cptr, Cfix, (/nr/)) - ! Now extract the array, which is transposed - call C_F_pointer (Cfix(1), fix, (/nc, nr/)) - end subroutine lammps_extract_fix_dp2a - -!----------------------------------------------------------------------------- - -! lammps_extract_variable {{{2 - function lammps_extract_variable_Cptr (ptr, name, group) result (variable) - type (C_ptr) :: ptr, variable - character (len=*) :: name - character (len=*), optional :: group - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - character (kind=C_char), dimension(:), allocatable :: Cgroup - Cname = string2Cstring (name) - if ( present(group) ) then - allocate (Cgroup(len_trim(group)+1)) - Cgroup = string2Cstring (group) - else - allocate (Cgroup(1)) - Cgroup(1) = C_NULL_CHAR - end if - variable = lammps_actual_extract_variable (ptr, Cname, Cgroup) - deallocate (Cgroup) - end function lammps_extract_variable_Cptr - subroutine lammps_extract_variable_dp (variable, ptr, name, group) - real (C_double), intent(out) :: variable - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (len=*), intent(in), optional :: group - type (C_ptr) :: Cptr - real (C_double), pointer :: Fptr - if ( present(group) ) then - Cptr = lammps_extract_variable_Cptr (ptr, name, group) - else - Cptr = lammps_extract_variable_Cptr (ptr, name) - end if - call C_F_pointer (Cptr, Fptr) - variable = Fptr - nullify (Fptr) - call lammps_free (Cptr) - end subroutine lammps_extract_variable_dp - subroutine lammps_extract_variable_dpa (variable, ptr, name, group) - real (C_double), dimension(:), allocatable, intent(out) :: variable - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (len=*), intent(in), optional :: group - type (C_ptr) :: Cptr - real (C_double), dimension(:), pointer :: Fptr - integer :: natoms - if ( present(group) ) then - Cptr = lammps_extract_variable_Cptr (ptr, name, group) - else - Cptr = lammps_extract_variable_Cptr (ptr, name) - end if - natoms = lammps_get_natoms (ptr) - allocate (variable(natoms)) - call C_F_pointer (Cptr, Fptr, (/natoms/)) - variable = Fptr - nullify (Fptr) - call lammps_free (Cptr) - end subroutine lammps_extract_variable_dpa - -!-------------------------------------------------------------------------2}}} - - function lammps_get_thermo (ptr, name) result (dval) - double precision :: dval - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - Cname = string2Cstring (name) - dval = lammps_actual_get_thermo (ptr, Cname) - end function lammps_get_thermo - - subroutine lammps_set_variable (ptr, name, str, err) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name, str - integer, optional :: err - integer (C_int) :: Cerr - character (kind=C_char) :: Cname(len_trim(name)+1), Cstr(len_trim(str)+1) - Cname = string2Cstring (name) - Cstr = string2Cstring (str) - Cerr = lammps_actual_set_variable (ptr, Cname, Cstr) - if ( present(err) ) err = Cerr - end subroutine lammps_set_variable - - subroutine lammps_reset_box (ptr, boxlo, boxhi, xy, yz, xz) - type (C_ptr), intent(in) :: ptr - double precision, dimension(3), intent(in) :: boxlo, boxhi - double precision, intent(in) :: xy, yz, xz - real (C_double) :: C_boxlo(3), C_boxhi(3), C_xy, C_yz, C_xz - C_boxlo = boxlo - C_boxhi = boxhi - C_xy = xy - C_xz = xz - C_yz = yz - call lammps_actual_reset_box (ptr, C_boxlo, C_boxhi, C_xy, C_yz, C_xz) - end subroutine lammps_reset_box - -! lammps_gather_atoms {{{2 - subroutine lammps_gather_atoms_ia (ptr, name, count, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count - integer, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - integer (C_int), dimension(:), pointer :: Fdata - integer (C_int) :: natoms - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 0_C_int - integer (C_int) :: Ccount - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*natoms) ) - allocate ( data(count*natoms) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms (ptr, Cname, Ctype, Ccount, Cdata) - data = Fdata - deallocate (Fdata) - end subroutine lammps_gather_atoms_ia - subroutine lammps_gather_atoms_dpa (ptr, name, count, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count - double precision, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - real (C_double), dimension(:), pointer :: Fdata - integer (C_int) :: natoms - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 1_C_int - integer (C_int) :: Ccount - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*natoms) ) - allocate ( data(count*natoms) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms (ptr, Cname, Ctype, Ccount, Cdata) - data = Fdata(:) - deallocate (Fdata) - end subroutine lammps_gather_atoms_dpa - -! lammps_gather_atoms_concat {{{2 - subroutine lammps_gather_atoms_concat_ia (ptr, name, count, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count - integer, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - integer (C_int), dimension(:), pointer :: Fdata - integer (C_int) :: natoms - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 0_C_int - integer (C_int) :: Ccount - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*natoms) ) - allocate ( data(count*natoms) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms_concat (ptr, Cname, Ctype, Ccount, Cdata) - data = Fdata - deallocate (Fdata) - end subroutine lammps_gather_atoms_concat_ia - subroutine lammps_gather_atoms_concat_dpa (ptr, name, count, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count - double precision, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - real (C_double), dimension(:), pointer :: Fdata - integer (C_int) :: natoms - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 1_C_int - integer (C_int) :: Ccount - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms_concat& - & requires count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*natoms) ) - allocate ( data(count*natoms) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms_concat (ptr, Cname, Ctype, Ccount, Cdata) - data = Fdata(:) - deallocate (Fdata) - end subroutine lammps_gather_atoms_concat_dpa - -!----------------------------------------------------------------------------- - -! lammps_gather_atoms_subset {{{2 - subroutine lammps_gather_atoms_subset_ia (ptr,name,count,ids,data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count, ids(:) - integer, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - integer (C_int), dimension(:), pointer :: Fdata - integer (C_int) :: ndata, Cids(size(ids)) - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 0_C_int - integer (C_int) :: Ccount - ndata = size(ids) - Cname = string2Cstring (name) - Cids = ids - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms_subset& - & requires count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*ndata) ) - allocate ( data(count*ndata) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms_subset (ptr, Cname, Ctype, Ccount, & - ndata, Cids, Cdata) - data = Fdata - deallocate (Fdata) - end subroutine lammps_gather_atoms_subset_ia - subroutine lammps_gather_atoms_subset_dpa (ptr,name,count,ids,data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count, ids(:) - double precision, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - real (C_double), dimension(:), pointer :: Fdata - integer (C_int) :: ndata, Cids(size(ids)) - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 1_C_int - integer (C_int) :: Ccount - ndata = size(ids) - Cname = string2Cstring (name) - Cids = ids - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*ndata) ) - allocate ( data(count*ndata) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms_subset (ptr, Cname, Ctype, Ccount, & - ndata, Cids, Cdata) - data = Fdata - deallocate (Fdata) - end subroutine lammps_gather_atoms_subset_dpa - -!----------------------------------------------------------------------------- - -! lammps_scatter_atoms {{{2 - subroutine lammps_scatter_atoms_ia (ptr, name, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, dimension(:), intent(in) :: data - integer (kind=C_int) :: natoms, Ccount - integer (kind=C_int), parameter :: Ctype = 0_C_int - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), dimension(size(data)), target :: Fdata - type (C_ptr) :: Cdata - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - Ccount = size(data) / natoms - if ( Ccount /= 1 .and. Ccount /= 3 ) & - call lammps_error_all (ptr, FLERR, 'lammps_scatter_atoms requires& - & count to be either 1 or 3') - Fdata = data - Cdata = C_loc (Fdata(1)) - call lammps_actual_scatter_atoms (ptr, Cname, Ctype, Ccount, Cdata) - end subroutine lammps_scatter_atoms_ia - subroutine lammps_scatter_atoms_dpa (ptr, name, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - double precision, dimension(:), intent(in) :: data - integer (kind=C_int) :: natoms, Ccount - integer (kind=C_int), parameter :: Ctype = 1_C_int - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - real (C_double), dimension(size(data)), target :: Fdata - type (C_ptr) :: Cdata - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - Ccount = size(data) / natoms - if ( Ccount /= 1 .and. Ccount /= 3 ) & - call lammps_error_all (ptr, FLERR, 'lammps_scatter_atoms requires& - & count to be either 1 or 3') - Fdata = data - Cdata = C_loc (Fdata(1)) - call lammps_actual_scatter_atoms (ptr, Cname, Ctype, Ccount, Cdata) - end subroutine lammps_scatter_atoms_dpa - -!----------------------------------------------------------------------------- - -! lammps_scatter_atoms_subset {{{2 - subroutine lammps_scatter_atoms_subset_ia (ptr, name, ids, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, dimension(:), intent(in) :: data, ids - integer (kind=C_int) :: ndata, Ccount, Cids(size(ids)) - integer (kind=C_int), parameter :: Ctype = 0_C_int - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), dimension(size(data)), target :: Fdata - type (C_ptr) :: Cdata - ndata = size(ids) - Cname = string2Cstring (name) - Ccount = size(data) / ndata - if ( Ccount /= 1 .and. Ccount /= 3 ) & - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - Fdata = data - Cdata = C_loc (Fdata(1)) - Cids = ids - call lammps_actual_scatter_atoms_subset (ptr, Cname, Ctype, Ccount, & - ndata, Cids, Cdata) - end subroutine lammps_scatter_atoms_subset_ia - subroutine lammps_scatter_atoms_subset_dpa (ptr, name, ids, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - double precision, dimension(:), intent(in) :: data, ids - integer (kind=C_int) :: ndata, Ccount, Cids(size(ids)) - integer (kind=C_int), parameter :: Ctype = 1_C_int - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - real (C_double), dimension(size(data)), target :: Fdata - type (C_ptr) :: Cdata - ndata = size(ids) - Cname = string2Cstring (name) - Ccount = size(data) / ndata - if ( Ccount /= 1 .and. Ccount /= 3 ) & - call lammps_error_all (ptr, FLERR, 'lammps_scatter_atoms requires& - & count to be either 1 or 3') - Fdata = data - Cdata = C_loc (Fdata(1)) - call lammps_actual_scatter_atoms_subset (ptr, Cname, Ctype, Ccount, & - ndata, Cids, Cdata) - end subroutine lammps_scatter_atoms_subset_dpa - -!----------------------------------------------------------------------------- - - subroutine lammps_create_atoms (ptr, id, type, x, v, image, shrinkexceed) - type (C_ptr), intent(in) :: ptr - integer (kind=C_tagint), dimension(:), optional :: id - integer, dimension(:) :: type - double precision, dimension(:,:) :: x - double precision, dimension(:,:), optional :: v - integer (kind=C_imageint), dimension(:), target, optional :: image - logical, optional :: shrinkexceed - real (C_double), dimension(size(x)) :: C_x, C_v - integer (C_int) :: C_shrinkexceed, n - integer (kind=C_tagint) :: C_id - integer (C_imageint), dimension(size(x)/3) :: C_image - integer (C_int) :: C_type - if (shrinkexceed) then - C_shrinkexceed = 1_C_int - else - C_shrinkexceed = 0_C_int - end if - C_x = reshape(transpose(x), shape(C_x)) - if ( present(v) ) then - C_v = reshape(transpose(v), shape(C_v)) - else - C_v = 0.0_C_double - end if - if ( present(image) ) then - C_image = image - else - C_image = int(0,kind=C_imageint) - end if - n = size(type) - call lammps_actual_create_atoms (ptr, n, C_id, C_type, C_x, C_v, & - C_image, C_shrinkexceed) - end subroutine lammps_create_atoms - -!----------------------------------------------------------------------------- - - function lammps_config_has_package (package_name) result (has_it) - character (len=*), intent(in) :: package_name - character (len=1, kind=C_char), dimension(len_trim(package_name)+1) :: & - C_package_name - logical :: has_it - integer (C_int) :: C_has_it - C_package_name = string2Cstring (package_name) - C_has_it = lammps_actual_config_has_package (C_package_name) - has_it = (C_has_it == 1) - end function lammps_config_has_package - -!----------------------------------------------------------------------------- - - function lammps_config_package_name (index, buffer) result (installed) - character (len=*), intent(inout) :: buffer - integer, intent(in) :: index - logical :: installed - integer (kind=C_int) :: C_installed, C_index, max_size - character (len=1, kind=C_char), dimension(len_trim(buffer)+1) :: C_buffer - C_buffer = string2Cstring (buffer) - max_size = len(buffer) - C_index = index - C_installed = lammps_actual_config_package_name (C_index, C_buffer, & - max_size) - installed = (C_installed == 1_C_int) - buffer = Cstring2string (C_buffer) - end function lammps_config_package_name - -!----------------------------------------------------------------------------- - - logical function lammps_config_has_gzip_support () result (has_it) - integer (C_int) :: C_has_it - C_has_it = lammps_actual_config_has_gzip_support () - has_it = (C_has_it == 1_C_int) - end function lammps_config_has_gzip_support - -!----------------------------------------------------------------------------- - - logical function lammps_config_has_png_support () result (has_it) - integer (C_int) :: C_has_it - C_has_it = lammps_actual_config_has_png_support () - has_it = (C_has_it == 1_C_int) - end function lammps_config_has_png_support - -!----------------------------------------------------------------------------- - - logical function lammps_config_has_jpeg_support () result (has_it) - integer (C_int) :: C_has_it - C_has_it = lammps_actual_config_has_jpeg_support () - has_it = (C_has_it == 1_C_int) - end function lammps_config_has_jpeg_support - -!----------------------------------------------------------------------------- - - logical function lammps_config_has_ffmpeg_support () result (has_it) - integer (C_int) :: C_has_it - C_has_it = lammps_actual_config_has_ffmpeg_support () - has_it = (C_has_it == 1_C_int) - end function lammps_config_has_ffmpeg_support - -!----------------------------------------------------------------------------- - - logical function lammps_config_has_exceptions () result (has_it) - integer (C_int) :: C_has_it - C_has_it = lammps_actual_config_has_exceptions () - has_it = (C_has_it == 1_C_int) - end function lammps_config_has_exceptions - -!----------------------------------------------------------------------------- - - function lammps_find_pair_neighlist (ptr, style, exact, nsub, request) & - result (neighlist) - integer :: neighlist - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: style - logical, intent(in) :: exact - integer, intent(in) :: nsub, request - integer (C_int) :: C_exact, C_nsub, C_neighlist, C_request - character (kind=C_char), dimension(len_trim(style)+1) :: C_style - if (exact) then - C_exact = 1_C_int - else - C_exact = 0_C_int - end if - C_nsub = nsub - C_request = request - C_style = string2Cstring (style) - C_neighlist = lammps_actual_find_pair_neighlist (ptr, C_style, C_exact, & - C_nsub, C_request) - neighlist = C_neighlist - end function lammps_find_pair_neighlist - -!----------------------------------------------------------------------------- - - function lammps_find_fix_neighlist (ptr, id, request) result (neighlist) - integer :: neighlist - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: request - integer (C_int) :: C_request, C_neighlist - character (kind=C_char), dimension(len_trim(id)+1) :: C_id - C_id = string2Cstring(id) - C_request = request - C_neighlist = lammps_actual_find_fix_neighlist (ptr, C_id, C_request) - neighlist = C_neighlist - end function lammps_find_fix_neighlist - -!----------------------------------------------------------------------------- - - function lammps_find_compute_neighlist (ptr, id, request) result (neighlist) - integer :: neighlist - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: request - integer (C_int) :: C_request - character (kind=C_char), dimension(len_trim(id)+1) :: C_id - C_id = string2Cstring(id) - C_request = request - neighlist = lammps_actual_find_compute_neighlist (ptr, C_id, C_request) - end function lammps_find_compute_neighlist - -!----------------------------------------------------------------------------- - - function lammps_neighlist_num_elements (ptr, idx) result (nelements) - integer :: nelements - type (C_ptr), intent(in) :: ptr - integer, intent(in) :: idx - integer (C_int) :: C_idx - C_idx = idx - nelements = lammps_actual_neighlist_num_elements (ptr, C_idx) - end function lammps_neighlist_num_elements - -!----------------------------------------------------------------------------- - - subroutine lammps_neighlist_element_neighbors (ptr, idx, element, iatom, & - numneigh, neighbors) - type (C_ptr), intent(in) :: ptr - integer, intent(in) :: idx, element - integer, intent(out) :: iatom, numneigh - integer (C_int), dimension(:), pointer, intent(out) :: neighbors - integer (C_int) :: C_idx, C_element, C_iatom, C_numneigh - type (C_ptr) :: C_neighbors - C_idx = idx - C_element = element - call lammps_actual_neighlist_element_neighbors (ptr, C_idx, C_element, & - C_iatom, C_numneigh, C_neighbors) - iatom = C_iatom - numneigh = C_numneigh - call C_F_pointer (C_neighbors, neighbors, [numneigh]) - end subroutine lammps_neighlist_element_neighbors - -!----------------------------------------------------------------------------- - -! These are only defined if -DLAMMPS_EXCEPTIONS was issued -#ifdef LAMMPS_EXCEPTIONS - logical function lammps_has_error (ptr) result (has_it) - type (C_ptr), intent(in) :: ptr - integer (kind=C_int) :: C_has_it - C_has_it = lammps_actual_has_error (ptr) - has_it = (C_has_it == 1_C_int) - end function lammps_has_error - -!----------------------------------------------------------------------------- - - function lammps_get_last_error_message (ptr, buffer) result (error_type) - integer (C_int) :: error_type - type (C_ptr), intent(in) :: ptr - character (len=*), intent(out) :: buffer - integer (C_int) :: buffer_size - character (len=1, kind=C_char), dimension(len(buffer)+1) :: C_buffer - buffer_size = len(buffer) - error_type = lammps_actual_get_last_error_message (ptr, C_buffer, & - buffer_size) - buffer = Cstring2string (C_buffer) - end function lammps_get_last_error_message -#endif -!-------------------------------------------------------------------------2}}} - - function lammps_extract_compute_vectorsize (ptr, id, style) & - result (vectorsize) - integer :: vectorsize - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer (C_int) :: Cvectorsize, Cstyle - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int(style, C_int) - Cvectorsize = lammps_actual_extract_compute_vectorsize (ptr, Cid, Cstyle) - vectorsize = int(Cvectorsize, kind(vectorsize)) - end function lammps_extract_compute_vectorsize - -!----------------------------------------------------------------------------- - - function lammps_extract_fix_vectorsize (ptr, id, style) & - result (vectorsize) - integer :: vectorsize - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer (C_int) :: Cvectorsize, Cstyle - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int(style, C_int) - Cvectorsize = lammps_actual_extract_fix_vectorsize (ptr, Cid, Cstyle) - vectorsize = int(Cvectorsize, kind(vectorsize)) - end function lammps_extract_fix_vectorsize - -!----------------------------------------------------------------------------- - - subroutine lammps_extract_compute_arraysize (ptr, id, style, nrows, ncols) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer, intent(out) :: nrows, ncols - integer (C_int) :: Cstyle, Cnrows, Cncols - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int (style, C_int) - call lammps_actual_extract_compute_arraysize (ptr, Cid, Cstyle, & - Cnrows, Cncols) - nrows = int (Cnrows, kind(nrows)) - ncols = int (Cncols, kind(ncols)) - end subroutine lammps_extract_compute_arraysize - -!----------------------------------------------------------------------------- - - subroutine lammps_extract_fix_arraysize (ptr, id, style, nrows, ncols) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer, intent(out) :: nrows, ncols - integer (C_int) :: Cstyle, Cnrows, Cncols - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int (style, kind(Cstyle)) - call lammps_actual_extract_fix_arraysize (ptr, Cid, Cstyle, & - Cnrows, Cncols) - nrows = int (Cnrows, kind(nrows)) - ncols = int (Cncols, kind(ncols)) - end subroutine lammps_extract_fix_arraysize - -!----------------------------------------------------------------------------- - - subroutine lammps_error_all (ptr, file, line, str) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: file, str - integer, intent(in) :: line - character (kind=C_char), dimension(len_trim(file)+1) :: Cfile - character (kind=C_char), dimension(len_trim(str)+1) :: Cstr - integer (C_int) :: Cline - Cline = int(line, kind(Cline)) - Cfile = string2Cstring (file) - Cstr = string2Cstring (str) - call lammps_actual_error_all (ptr, Cfile, Cline, Cstr) - end subroutine lammps_error_all - -!----------------------------------------------------------------------------- - -! Locally defined helper functions {{{1 - - pure function string2Cstring (string) result (C_string) - use, intrinsic :: ISO_C_binding, only : C_char, C_NULL_CHAR - character (len=*), intent(in) :: string - character (len=1, kind=C_char) :: C_string (len_trim(string)+1) - integer :: i, n - n = len_trim (string) - forall (i = 1:n) - C_string(i) = string(i:i) - end forall - C_string(n+1) = C_NULL_CHAR - end function string2Cstring - -!----------------------------------------------------------------------------- - - pure function Cstrlen (Cstring) result (n) - character (len=1, kind=C_char), dimension(:), intent(in) :: Cstring - integer :: n, i - n = size(Cstring) - do i = 1, size(Cstring) - if ( Cstring(i) == C_NULL_CHAR ) then - n = i - 1 - return - end if - end do - end function Cstrlen - -!----------------------------------------------------------------------------- - - pure function Cstring2string (Cstring) result (string) - !use, intrinsic :: ISO_C_binding, only : C_char, C_NULL_CHAR - character (len=1, kind=C_char), intent(in) :: Cstring (:) - character (len=Cstrlen(Cstring)) :: string - integer :: i, n - n = Cstrlen(Cstring) - string = '' - forall (i = 1:n) - string(i:i) = Cstring(i) - end forall - end function Cstring2string - -!----------------------------------------------------------------------------- - - subroutine Cstring2argcargv (Cstring, argc, argv) - !! Converts a C-style string to argc and argv, that is, words in Cstring - !! become C-style strings in argv. IMPORTANT: Cstring is modified by - !! this routine! I would make Cstring local TO this routine and accept - !! a Fortran-style string instead, but we run into scoping and - !! allocation problems that way. This routine assumes the string is - !! null-terminated, as all C-style strings must be. - - character (kind=C_char), dimension(*), target, intent(inout) :: Cstring - integer (C_int), intent(out) :: argc - type (C_ptr), dimension(:), allocatable, intent(out) :: argv - - integer :: StringStart, SpaceIndex, strlen, argnum - - argc = 1_C_int - - ! Find the length of the string - strlen = 1 - do while ( Cstring(strlen) /= C_NULL_CHAR ) - strlen = strlen + 1 - end do - - ! Find the number of non-escaped spaces - SpaceIndex = 2 - do while ( SpaceIndex < strlen ) - if ( Cstring(SpaceIndex) == ' ' .and. & - Cstring(SpaceIndex-1) /= '\' ) then - argc = argc + 1_C_int - ! Find the next non-space character - do while ( Cstring(SpaceIndex+1) == ' ') - SpaceIndex = SpaceIndex + 1 - end do - end if - SpaceIndex = SpaceIndex + 1 - end do - - ! Now allocate memory for argv - allocate (argv(argc)) - - ! Now find the string starting and ending locations - StringStart = 1 - SpaceIndex = 2 - argnum = 1 - do while ( SpaceIndex < strlen ) - if ( Cstring(SpaceIndex) == ' ' .and. & - Cstring(SpaceIndex-1) /= '\' ) then - ! Found a real space => split strings and store this one - Cstring(Spaceindex) = C_NULL_CHAR ! Replaces space with NULL - argv(argnum) = C_loc(Cstring(StringStart)) - argnum = argnum + 1 - ! Find the next non-space character - do while ( Cstring(SpaceIndex+1) == ' ') - SpaceIndex = SpaceIndex + 1 - end do - StringStart = SpaceIndex + 1 - else if ( Cstring(SpaceIndex) == ' ' .and. & - Cstring(SpaceIndex-1) == '\' ) then - ! Escaped space => remove backslash and move rest of array - Cstring(SpaceIndex-1:strlen-1) = Cstring(SpaceIndex:strlen) - strlen = strlen - 1 ! Last character is still C_NULL_CHAR - end if - SpaceIndex = SpaceIndex + 1 - end do - ! Now handle the last argument - argv(argnum) = C_loc(Cstring(StringStart)) - - end subroutine Cstring2argcargv - -! 1}}} - -end module LAMMPS - -! vim: foldmethod=marker tabstop=3 softtabstop=3 shiftwidth=3 expandtab diff --git a/examples/COUPLE/fortran2/Makefile b/examples/COUPLE/fortran2/Makefile deleted file mode 100644 index 8ac957a4c1..0000000000 --- a/examples/COUPLE/fortran2/Makefile +++ /dev/null @@ -1,41 +0,0 @@ -SHELL = /bin/sh - -# Path to LAMMPS extraction directory -LAMMPS_ROOT = ../../.. -LAMMPS_SRC = $(LAMMPS_ROOT)/src - -# Uncomment the line below if using the MPI stubs library -MPI_STUBS = #-I$(LAMMPS_SRC)/STUBS - -FC = mpifort # replace with your Fortran compiler -CXX = mpicxx # replace with your C++ compiler -CXXLIB = -lstdc++ # replace with your C++ runtime libs - -# Flags for Fortran compiler, C++ compiler, and C preprocessor, respectively -FFLAGS = -O2 -fPIC -CXXFLAGS = -O2 -fPIC -CPPFLAGS = -DOMPI_SKIP_MPICXX=1 -DMPICH_SKIP_MPICXX - -all : liblammps_fortran.a liblammps_fortran.so - @echo "WARNING: this Fortran interface is obsolete and is no longer -maintained. See $(LAMMPS_ROOT)/fortran for the new, maintained interface -(largely written by the same author). You may continue to use this interface if -desired, but it may eventually be removed from LAMMPS." - -liblammps_fortran.so : LAMMPS.o LAMMPS-wrapper.o - $(FC) $(FFLAGS) -shared -o $@ $^ $(CXXLIB) - -liblammps_fortran.a : LAMMPS.o LAMMPS-wrapper.o - $(AR) rs $@ $^ - -LAMMPS.o lammps.mod : LAMMPS.F90 - $(FC) $(CPPFLAGS) $(FFLAGS) -c $< - -LAMMPS-wrapper.o : LAMMPS-wrapper.cpp LAMMPS-wrapper.h - $(CXX) $(CPPFLAGS) $(CXXFLAGS) -c $< -I$(LAMMPS_SRC) $(MPI_STUBS) - -clean : - $(RM) *.o *.mod liblammps_fortran.a liblammps_fortran.so - -dist : - tar -czf Fortran-interface.tar.gz LAMMPS-wrapper.h LAMMPS-wrapper.cpp LAMMPS.F90 makefile README diff --git a/examples/COUPLE/fortran2/README b/examples/COUPLE/fortran2/README deleted file mode 100644 index b36cb43746..0000000000 --- a/examples/COUPLE/fortran2/README +++ /dev/null @@ -1,273 +0,0 @@ -!! NOTE ------------------------------------------------------------------- -! This interface is obsolete and may be removed in a future release of -! LAMMPS. The interface in fortran/lammps.f90 replaces this one. That API -! is maintained by the LAMMPS developers and has documentation written for -! it; it is based loosely on this one, but binds all procedures to a lammps -! derived type. That interface was written in large -! part by the same author, but is also supported by other developers. -!-------------------------------------------------------------------------- - -LAMMPS.F90 defines a Fortran 2003 module, LAMMPS, which wraps all functions in -src/library.h so they can be used directly from Fortran-encoded programs. - -All functions in src/library.h that use and/or return C-style pointers have -Fortran wrapper functions that use Fortran-style arrays, pointers, and -strings; all C-style memory management is handled internally with no user -intervention. See --USE-- for notes on how this interface differs from the -C interface (and the Python interface). - -This interface was created by Karl Hammond who you can contact with -questions: - -Karl D. Hammond -University of Missouri -hammondkd at missouri.edu - -------------------------------------- - ---COMPILATION-- - -First, be advised that mixed-language programming is not trivial. It requires -you to link in the required libraries of all languages you use (in this case, -those for Fortran, C, and C++), as well as any other libraries required. -You are also advised to read the --USE-- section below before trying to -compile. - -The following steps will work to compile this module (replace ${LAMMPS_SRC} -with the path to your LAMMPS source directory). - -Steps 3-5 are accomplished, possibly after some modifications to -the makefile, by make using the attached makefile. Said makefile also builds -the dynamically-linkable library (liblammps_fortran.so). - -** STATIC LIBRARY INSTRUCTIONS ** - (1) Compile LAMMPS as a static library. - Call the resulting file ${LAMMPS_LIB}, which will have an actual name - like liblmp_openmpi.a. If compiling using the MPI stubs in - ${LAMMPS_SRC}/STUBS, you will need to know where libmpi_stubs.a - is as well (I'll call it ${MPI_STUBS} hereafter) - (2) Copy said library to your Fortran program's source directory or replace - ${LAMMPS_LIB} with its full path in the instructions below. - (3) Compile (but don't link!) LAMMPS.F90. Example: - mpifort -c LAMMPS.f90 - OR - gfortran -c LAMMPS.F90 - NOTE: you may get a warning such as, - subroutine lammps_open_wrapper (argc, argv, communicator, ptr) & - Variable 'communicator' at (1) is a parameter to the BIND(C) - procedure 'lammps_open_wrapper' but may not be C interoperable - This is normal (see --IMPLEMENTATION NOTES--). - - (4) Compile (but don't link) LAMMPS-wrapper.cpp. You will need its header - file as well. You will have to provide the locations of LAMMPS's - header files. For example, - mpicxx -c -I${LAMMPS_SRC} LAMMPS-wrapper.cpp - OR - g++ -c -I${LAMMPS_SRC} -I${LAMMPS_SRC}/STUBS LAMMPS-wrapper.cpp - OR - icpc -c -I${LAMMPS_SRC} -I${LAMMPS_SRC}/STUBS LAMMPS-wrapper.cpp - (5) OPTIONAL: Make a library from the object files so you can carry around - two files instead of three. Example: - ar rs liblammps_fortran.a LAMMPS.o LAMMPS-wrapper.o - This will create the file liblammps_fortran.a that you can use in place - of "LAMMPS.o LAMMPS-wrapper.o" later. Note that you will still - need to have the .mod file from part (3). - - It is also possible to add LAMMPS.o and LAMMPS-wrapper.o into the - LAMMPS library (e.g., liblmp_openmpi.a) instead of creating a separate - library, like so: - ar rs ${LAMMPS_LIB} LAMMPS.o LAMMPS-wrapper.o - In this case, you can now use the Fortran wrapper functions as if they - were part of the usual LAMMPS library interface (if you have the module - file visible to the compiler, that is). - (6) Compile (but don't link) your Fortran program. Example: - mpifort -c myfreeformatfile.f90 - mpifort -c myfixedformatfile.f - OR - gfortran -c myfreeformatfile.f90 - gfortran -c myfixedformatfile.f - The object files generated by these steps are collectively referred to - as ${my_object_files} in the next step(s). - - IMPORTANT: If the Fortran module from part (3) is not in the current - directory or in one searched by the compiler for module files, you will - need to include that location via the -I flag to the compiler, like so: - mpifort -I${LAMMPS_SRC}/examples/COUPLE/fortran2 -c myfreeformatfile.f90 - - (7) Link everything together, including any libraries needed by LAMMPS (such - as the C++ standard library, the C math library, the JPEG library, fftw, - etc.) For example, - mpifort LAMMPS.o LAMMPS-wrapper.o ${my_object_files} \ - ${LAMMPS_LIB} -lmpi_cxx -lstdc++ -lm - OR - gfortran LAMMPS.o LAMMPS-wrapper.o ${my_object_files} \ - ${LAMMPS_LIB} ${MPI_STUBS} -lstdc++ -lm - OR - ifort LAMMPS.o LAMMPS-wrapper.o ${my_object_files} \ - ${LAMMPS_LIB} ${MPI_STUBS} -cxxlib -lm - Any other required libraries (e.g. -ljpeg, -lfftw) should be added to - the end of this line. - -You should now have a working executable. - -** DYNAMIC LIBRARY INSTRUCTIONS ** - (1) Compile LAMMPS as a dynamic library - (make makeshlib && make -f Makefile.shlib [targetname]). - (2) Compile, but don't link, LAMMPS.F90 using the -fPIC flag, such as - mpifort -fPIC -c LAMMPS.f90 - (3) Compile, but don't link, LAMMPS-wrapper.cpp in the same manner, e.g. - mpicxx -fPIC -c LAMMPS-wrapper.cpp - (4) Make the dynamic library, like so: - mpifort -fPIC -shared -o liblammps_fortran.so LAMMPS.o LAMMPS-wrapper.o - (5) Compile your program, such as, - mpifort -I${LAMMPS_SRC}/examples/COUPLE/fortran2 -c myfreeformatfile.f90 - where ${LAMMPS_SRC}/examples/COUPLE/fortran2 contains the .mod file from - step (3) - (6) Link everything together, such as - mpifort ${my_object_files} -L${LAMMPS_SRC} \ - -L${LAMMPS_SRC}/examples/COUPLE/fortran2 -llammps_fortran \ - -llammps_openmpi -lmpi_cxx -lstdc++ -lm - -If you wish to avoid the -L flags, add the directories containing your -shared libraries to the LIBRARY_PATH environment variable. At run time, you -will have to add these directories to LD_LIBRARY_PATH as well; otherwise, -your executable will not find the libraries it needs. - -------------------------------------- - ---USAGE-- - -To use this API, your program unit (PROGRAM/SUBROUTINE/FUNCTION/MODULE/etc.) -should look something like this: - program call_lammps - use LAMMPS - ! Other modules, etc. - implicit none - type (lammps_instance) :: lmp ! This is a pointer to your LAMMPS instance - real (C_double) :: fix - real (C_double), dimension(:), pointer :: fix2 - ! Rest of declarations - call lammps_open_no_mpi ('lmp -in /dev/null -screen out.lammps',lmp) - ! Set up rest of program here - call lammps_file (lmp, 'in.example') - call lammps_extract_fix (fix, lmp, '2', 0, 1, 1, 1) - call lammps_extract_fix (fix2, lmp, '4', 0, 2, 1, 1) - call lammps_close (lmp) - end program call_lammps - -Important notes: - * Though I dislike the use of pointers, they are necessary when communicating - with C and C++, which do not support Fortran's ALLOCATABLE attribute. - * There is no need to deallocate C-allocated memory; this is done for you in - the cases when it is done (which are all cases when pointers are not - accepted, such as global fix data) - * All arguments which are char* variables in library.cpp are character (len=*) - variables here. For example, - call lammps_command (lmp, 'units metal') - will work as expected. - * The public functions (the only ones you can use) have interfaces as - described in the comments at the top of LAMMPS.F90. They are not always - the same as those in library.h, since C strings are replaced by Fortran - strings and the like. - * The module attempts to check whether you have done something stupid (such - as assign a 2D array to a scalar), but it's not perfect. For example, the - command - call lammps_extract_global (nlocal, ptr, 'nlocal') - will give nlocal correctly if nlocal is a pointer to type INTEGER, but it - will give the wrong answer if nlocal is a pointer to type REAL. This is a - feature of the (void*) type cast in library.cpp. There is no way I can - check this for you! It WILL catch you if you pass it an allocatable or - fixed-size array when it expects a pointer. - * Arrays constructed from temporary data from LAMMPS are ALLOCATABLE, and - represent COPIES of data, not the originals. Functions like - lammps_extract_atom, which return actual LAMMPS data, are pointers. - * IMPORTANT: Due to the differences between C and Fortran arrays (C uses - row-major vectors, Fortran uses column-major vectors), all arrays returned - from LAMMPS have their indices swapped. - * An example of a complete program, simple.f90, is included with this - package. - -------------------------------------- - ---TROUBLESHOOTING-- - -Compile-time errors (when compiling LAMMPS.F90, that is) probably indicate -that your compiler is not new enough to support Fortran 2003 features. For -example, GCC 4.1.2 will not compile this module, but GCC 4.4.0 will. - -If your compiler balks at 'use, intrinsic :: ISO_C_binding,' try removing the -intrinsic part so it looks like an ordinary module. However, it is likely -that such a compiler will also have problems with everything else in the -file as well. - -If you get a segfault as soon as the lammps_open call is made, check that you -compiled your program AND LAMMPS-wrapper.cpp using the same MPI headers. Using -the stubs for one and the actual MPI library for the other will cause Bad -Things to happen. - -If you find run-time errors, please pass them along via the LAMMPS Users -mailing list (please CC me as well; address above). Please provide a minimal -working example along with the names and versions of the compilers you are -using. Please make sure the error is repeatable and is in MY code, not yours -(generating a minimal working example will usually ensure this anyway). - -------------------------------------- - ---IMPLEMENTATION NOTES-- - -The Fortran procedures have the same names as the C procedures, and -their purpose is the same, but they may take different arguments. Here are -some of the important differences: - * lammps_open and lammps_open_no_mpi take a string instead of argc and - argv. This is necessary because C and C++ have a very different way - of treating strings than Fortran. If you want the command line to be - passed to lammps_open (as it often would be from C/C++), use the - GET_COMMAND intrinsic to obtain it. - * All C++ functions that accept char* pointers now accept Fortran-style - strings within this interface instead. - * All of the lammps_extract_[something] functions, which return void* - C-style pointers, have been replaced by generic subroutines that return - Fortran variables (which may be arrays). The first argument houses the - variable/pointer to be returned (pretend it's on the left-hand side); all - other arguments are identical except as stipulated above. - Note that it is not possible to declare generic functions that are selected - based solely on the type/kind/rank (TKR) signature of the return value, - only based on the TKR of the arguments. - * The SHAPE of the first argument to lammps_extract_[something] is checked - against the "shape" of the C array (e.g., double vs. double* vs. double**). - Calling a subroutine with arguments of inappropriate rank will result in an - error at run time. - * The indices i and j in lammps_extract_fix are used the same way they - are in f_ID[i][j] references in LAMMPS (i.e., starting from 1). This is - different than the way library.cpp uses these numbers, but is more - consistent with the way arrays are accessed in LAMMPS and in Fortran. - * The char* pointer normally returned by lammps_command is thrown away - in this version; note also that lammps_command is now a subroutine - instead of a function. - * The pointer to LAMMPS itself is of type(lammps_instance), which is itself - a synonym for type(C_ptr), part of ISO_C_BINDING. Type (C_ptr) is - C's void* data type. - * This module will almost certainly generate a compile-time warning, - such as, - subroutine lammps_open_wrapper (argc, argv, communicator, ptr) & - Variable 'communicator' at (1) is a parameter to the BIND(C) - procedure 'lammps_open_wrapper' but may not be C interoperable - This happens because lammps_open_wrapper actually takes a Fortran - INTEGER argument, whose type is defined by the MPI library itself. The - Fortran integer is converted to a C integer by the MPI library (if such - conversion is actually necessary). - * lammps_extract_global returns COPIES of the (scalar) data, as does the - C version. - * lammps_extract_atom, lammps_extract_compute, and lammps_extract_fix - have a first argument that will be associated with ACTUAL LAMMPS DATA. - This means the first argument must be: - * The right rank (via the DIMENSION modifier) - * A C-interoperable POINTER type (i.e., INTEGER (C_int) or - REAL (C_double)). - * lammps_extract_variable returns COPIES of the data, as the C library - interface does. There is no need to deallocate using lammps_free. - * The 'data' argument to lammps_gather_atoms and lammps_scatter atoms must - be ALLOCATABLE. It should be of type INTEGER or DOUBLE PRECISION. It - does NOT need to be C inter-operable (and indeed should not be). - * The 'count' argument of lammps_scatter_atoms is unnecessary; the shape of - the array determines the number of elements LAMMPS will read. diff --git a/examples/COUPLE/fortran2/in.simple b/examples/COUPLE/fortran2/in.simple deleted file mode 100644 index 5982cbaac1..0000000000 --- a/examples/COUPLE/fortran2/in.simple +++ /dev/null @@ -1,16 +0,0 @@ -units lj -atom_modify map array -lattice bcc 1.0 -region simbox block 0 10 0 10 0 10 -create_box 2 simbox -create_atoms 1 region simbox -pair_style lj/cut 2.5 -pair_coeff * * 1.0 1.0 -mass 1 58.2 # These are made-up numbers -mass 2 28.3 -velocity all create 1200.0 7474848 dist gaussian -fix 1 all nve -fix 2 all dt/reset 1 1E-5 1E-3 0.01 units box -fix 4 all ave/histo 10 5 100 0.5 1.5 50 f_2 file temp.histo ave running -thermo_style custom step dt temp press etotal f_4[1][1] -thermo 100 diff --git a/examples/COUPLE/fortran2/simple.f90 b/examples/COUPLE/fortran2/simple.f90 deleted file mode 100644 index 0b84a1ecc1..0000000000 --- a/examples/COUPLE/fortran2/simple.f90 +++ /dev/null @@ -1,112 +0,0 @@ -program simple - - use MPI - use LAMMPS - - ! The following line is unnecessary, as I have included these three entities - ! with the LAMMPS module, but I leave them in anyway to remind people where - ! they came from - use, intrinsic :: ISO_C_binding, only : C_double, C_ptr, C_int - - implicit none - - ! Notes: - ! * If LAMMPS returns a scalar that is allocated by the library interface - ! (see library.cpp), then that memory is deallocated automatically and - ! the argument to lammps_extract_fix must be a SCALAR. - ! * If LAMMPS returns a pointer to an array, consisting of internal LAMMPS - ! data, then the argument must be an interoperable Fortran pointer. - ! Interoperable means it is of type INTEGER (C_INT) or of type - ! REAL (C_DOUBLE) in this context. - ! * Pointers should NEVER be deallocated, as that would deallocate internal - ! LAMMPS data! - ! * Note that just because you can read the values of, say, a compute at - ! any time does not mean those values represent the "correct" values. - ! LAMMPS will abort you if you try to grab a pointer to a non-current - ! entity, but once it's bound, it's your responsibility to check that - ! it's current before evaluating. - ! * IMPORTANT: Two-dimensional arrays (such as 'x' from extract_atom) - ! will be transposed from what they might look like in C++. This is - ! because of different bookkeeping conventions between Fortran and C - ! that date back to about 1970 or so (when C was written). - ! * Arrays start from 1, EXCEPT for mass from extract_atom, which - ! starts from 0. This is because the C array actually has a blank - ! first element (and thus mass[1] corresponds to the mass of type 1) - - type (C_ptr) :: lmp - real (C_double), pointer :: compute => NULL() - real (C_double) :: fix, fix2 - real (C_double), dimension(:), pointer :: compute_v => NULL() - real (C_double), dimension(:,:), pointer :: x => NULL() - real (C_double), dimension(:), pointer :: mass => NULL() - integer, dimension(:), allocatable :: types - double precision, dimension(:), allocatable :: r - integer :: error, narg, me, nprocs - character (len=1024) :: command_line - - call MPI_Init (error) - call MPI_Comm_rank (MPI_COMM_WORLD, me, error) - call MPI_Comm_size (MPI_COMM_WORLD, nprocs, error) - - ! You are free to pass any string you like to lammps_open or - ! lammps_open_no_mpi; here is how you pass it the command line - !call get_command (command_line) - !call lammps_open (command_line, MPI_COMM_WORLD, lmp) - - ! And here's how to to it with a string constant of your choice - call lammps_open_no_mpi ('lmp -log log.simple', lmp) - - call lammps_file (lmp, 'in.simple') - call lammps_command (lmp, 'run 500') - - ! This extracts f_2 as a scalar (the last two arguments can be arbitrary) - call lammps_extract_fix (fix, lmp, '2', LMP_STYLE_GLOBAL, LMP_TYPE_SCALAR, 1, 1) - print *, 'Fix is ', fix - - ! This extracts f_4[1][1] as a scalar - call lammps_extract_fix (fix2, lmp, '4', LMP_STYLE_GLOBAL, LMP_TYPE_ARRAY, 1, 1) - print *, 'Fix 2 is ', fix2 - - ! This extracts the scalar compute of compute thermo_temp - call lammps_extract_compute (compute, lmp, 'thermo_temp', LMP_STYLE_GLOBAL, LMP_TYPE_SCALAR) - print *, 'Compute is ', compute - - ! This extracts the vector compute of compute thermo_temp - call lammps_extract_compute (compute_v, lmp, 'thermo_temp', LMP_STYLE_GLOBAL, LMP_TYPE_VECTOR) - print *, 'Vector is ', compute_v - - ! This extracts the masses - call lammps_extract_atom (mass, lmp, 'mass') - print *, 'Mass is ', mass(1:) - - ! Extracts a pointer to the arrays of positions for all atoms - call lammps_extract_atom (x, lmp, 'x') - if ( .not. associated (x) ) print *, 'x is not associated' - print *, 'x is ', x(:,1) ! Prints x, y, z for atom 1 - - ! Extracts pointer to atom types - call lammps_gather_atoms (lmp, 'type', 1, types) - print *, 'types is ', types(1:3) - - ! Allocates an array and assigns all positions to it - call lammps_gather_atoms (lmp, 'x', 3, r) - print *, 'natoms = ', int(lammps_get_natoms(lmp)) - print *, 'size(r) = ', size(r) - print *, 'r is ', r(1:6) - - ! Puts those position data back - call lammps_scatter_atoms (lmp, 'x', r) - - call lammps_command (lmp, 'run 1') - print *, 'x is ', x(:,1) ! Note that the position updates! - print *, 'Compute is ', compute ! This did only because "temp" is part of - ! the thermo output; the vector part did - ! not, and won't until we give LAMMPS a - ! thermo output or other command that - ! requires its value - - call lammps_close (lmp) - - call MPI_Finalize (error) - -end program simple diff --git a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper.cpp b/examples/COUPLE/fortran_dftb/LAMMPS-wrapper.cpp deleted file mode 100644 index 4774cb6b49..0000000000 --- a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper.cpp +++ /dev/null @@ -1,96 +0,0 @@ -/* ----------------------------------------------------------------------- - LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator - https://www.lammps.org/, Sandia National Laboratories - LAMMPS development team: developers@lammps.org - - Copyright (2003) Sandia Corporation. Under the terms of Contract - DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains - certain rights in this software. This software is distributed under - the GNU General Public License. - - See the README file in the top-level LAMMPS directory. -------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------ - Contributing author: Karl D. Hammond - University of Missouri (USA), 2012 -------------------------------------------------------------------------- */ - -/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself - provides a (I hope) robust Fortran interface to library.cpp and - library.h. All functions herein COULD be added to library.cpp instead of - including this as a separate file. See the README for instructions. */ - -#include -#include "LAMMPS-wrapper.h" -#define LAMMPS_LIB_MPI 1 -#include -#include -#include -#include -#include -#include -#include -#include - -using namespace LAMMPS_NS; - -void lammps_open_fortran_wrapper (int argc, char **argv, - MPI_Fint communicator, void **ptr) -{ - MPI_Comm C_communicator = MPI_Comm_f2c (communicator); - lammps_open (argc, argv, C_communicator, ptr); -} - -int lammps_get_ntypes (void *ptr) -{ - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ntypes = lmp->atom->ntypes; - return ntypes; -} - -void lammps_error_all (void *ptr, const char *file, int line, const char *str) -{ - class LAMMPS *lmp = (class LAMMPS *) ptr; - lmp->error->all (file, line, str); -} - -int lammps_extract_compute_vectorsize (void *ptr, char *id, int style) -{ - int *size; - size = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_VECTOR); - if (size) return *size; - return 0; -} - -void lammps_extract_compute_arraysize (void *ptr, char *id, int style, - int *nrows, int *ncols) -{ - int *tmp; - tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_ROWS); - if (tmp) *nrows = *tmp; - tmp = (int *) lammps_extract_compute(ptr, id, style, LMP_SIZE_COLS); - if (tmp) *ncols = *tmp; - return; -} - -int lammps_extract_fix_vectorsize (void *ptr, char *id, int style) -{ - int *size; - size = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_VECTOR, 0, 0); - if (size) return *size; - return 0; -} - -void lammps_extract_fix_arraysize (void *ptr, char *id, int style, - int *nrows, int *ncols) -{ - int *tmp; - tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_ROWS, 0, 0); - if (tmp) *nrows = *tmp; - tmp = (int *) lammps_extract_fix(ptr, id, style, LMP_SIZE_COLS, 0, 0); - if (tmp) *ncols = *tmp; - return; -} - -/* vim: set ts=3 sts=3 expandtab: */ diff --git a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper.h b/examples/COUPLE/fortran_dftb/LAMMPS-wrapper.h deleted file mode 100644 index e1eec9fc72..0000000000 --- a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper.h +++ /dev/null @@ -1,40 +0,0 @@ -/* ----------------------------------------------------------------------- - LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator - https://www.lammps.org/, Sandia National Laboratories - LAMMPS development team: developers@lammps.org - - Copyright (2003) Sandia Corporation. Under the terms of Contract - DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains - certain rights in this software. This software is distributed under - the GNU General Public License. - - See the README file in the top-level LAMMPS directory. -------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------ - Contributing author: Karl D. Hammond - University of Missouri (USA), 2012 -------------------------------------------------------------------------- */ - -/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself - provides a (I hope) robust Fortran interface to library.cpp and - library.h. All prototypes herein COULD be added to library.h instead of - including this as a separate file. See the README for instructions. */ -#ifdef __cplusplus -extern "C" { -#endif - -/* Prototypes for auxiliary functions */ -void lammps_open_fortran_wrapper (int, char**, MPI_Fint, void**); -int lammps_get_ntypes (void*); -int lammps_extract_compute_vectorsize (void*, char*, int); -void lammps_extract_compute_arraysize (void*, char*, int, int*, int*); -int lammps_extract_fix_vectorsize (void*, char*, int); -void lammps_extract_fix_arraysize (void*, char*, int, int*, int*); -void lammps_error_all (void*, const char*, int, const char*); - -#ifdef __cplusplus -} -#endif - -/* vim: set ts=3 sts=3 expandtab: */ diff --git a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.cpp b/examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.cpp deleted file mode 100644 index 83d594df60..0000000000 --- a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.cpp +++ /dev/null @@ -1,80 +0,0 @@ -/* ----------------------------------------------------------------------- - LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator - https://www.lammps.org/, Sandia National Laboratories - LAMMPS development team: developers@lammps.org - - Copyright (2003) Sandia Corporation. Under the terms of Contract - DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains - certain rights in this software. This software is distributed under - the GNU General Public License. - - See the README file in the top-level LAMMPS directory. -------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------ - Contributing author: Nir Goldman, LLNL , 2016 -------------------------------------------------------------------------- */ - -/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself - provides a (I hope) robust Fortran interface to library.cpp and - library.h. All functions herein COULD be added to library.cpp instead of - including this as a separate file. See the README for instructions. */ - -#include -#include "LAMMPS-wrapper2.h" -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -using namespace LAMMPS_NS; - -extern "C" void f_callback(void *, bigint, int, tagint *, double **, double **); - -void lammps_set_callback (void *ptr) { - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ifix = lmp->modify->find_fix_by_style("external"); - FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix]; - fix->set_callback(f_callback, ptr); - return; -} - -void lammps_set_external_vector_length (void *ptr, int n) { - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ifix = lmp->modify->find_fix_by_style("external"); - FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix]; - fix->set_vector_length(n); - return; -} - -void lammps_set_external_vector (void *ptr, int n, double val) { - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ifix = lmp->modify->find_fix_by_style("external"); - FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix]; - fix->set_vector (n, val); - return; -} - -void lammps_set_user_energy (void *ptr, double energy) { - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ifix = lmp->modify->find_fix_by_style("external"); - FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix]; - fix->set_energy_global(energy); - return; -} - -void lammps_set_user_virial (void *ptr, double *virial) { - class LAMMPS *lmp = (class LAMMPS *) ptr; - int ifix = lmp->modify->find_fix_by_style("external"); - FixExternal *fix = (FixExternal *) lmp->modify->fix[ifix]; - fix->set_virial_global(virial); - return; -} - diff --git a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.h b/examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.h deleted file mode 100644 index 45c41b569a..0000000000 --- a/examples/COUPLE/fortran_dftb/LAMMPS-wrapper2.h +++ /dev/null @@ -1,37 +0,0 @@ -/* ----------------------------------------------------------------------- - LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator - https://www.lammps.org/, Sandia National Laboratories - LAMMPS development team: developers@lammps.org - - Copyright (2003) Sandia Corporation. Under the terms of Contract - DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains - certain rights in this software. This software is distributed under - the GNU General Public License. - - See the README file in the top-level LAMMPS directory. -------------------------------------------------------------------------- */ - -/* ------------------------------------------------------------------------ - Contributing author: Nir Goldman, LLNL , 2016 -------------------------------------------------------------------------- */ - -/* This is set of "wrapper" functions to assist LAMMPS.F90, which itself - provides a (I hope) robust Fortran interface to library.cpp and - library.h. All prototypes herein COULD be added to library.h instead of - including this as a separate file. See the README for instructions. */ -#ifdef __cplusplus -extern "C" { -#endif - -/* Prototypes for auxiliary functions */ -void lammps_set_callback (void *); -void lammps_set_user_energy (void*, double); -void lammps_set_user_virial (void*, double*); -void lammps_set_external_vector_length (void*, int); -void lammps_set_external_vector (void*, int, double); - -#ifdef __cplusplus -} -#endif - -/* vim: set ts=3 sts=3 expandtab: */ diff --git a/examples/COUPLE/fortran_dftb/LAMMPS.F90 b/examples/COUPLE/fortran_dftb/LAMMPS.F90 deleted file mode 100644 index 188fff9d60..0000000000 --- a/examples/COUPLE/fortran_dftb/LAMMPS.F90 +++ /dev/null @@ -1,982 +0,0 @@ -!! ----------------------------------------------------------------------- -! LAMMPS - Large-scale Atomic/Molecular Massively Parallel Simulator -! www.cs.sandia.gov/~sjplimp/lammps.html -! Steve Plimpton, sjplimp@sandia.gov, Sandia National Laboratories -! -! Copyright (2003) Sandia Corporation. Under the terms of Contract -! DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government retains -! certain rights in this software. This software is distributed under -! the GNU General Public License. -! -! See the README file in the top-level LAMMPS directory. -!-------------------------------------------------------------------------- - -!! ------------------------------------------------------------------------ -! Contributing author: Karl D. Hammond -! University of Missouri (USA), 2012 -!-------------------------------------------------------------------------- - -!! LAMMPS, a Fortran 2003 module containing an interface between Fortran -!! programs and the C-style functions in library.cpp that ship with LAMMPS. -!! This file should be accompanied by LAMMPS-wrapper.cpp and LAMMPS-wrapper.h, -!! which define wrapper functions that ease portability and enforce array -!! dimensions. -!! -!! Everything in this module should be 100% portable by way of Fortran 2003's -!! ISO_C_BINDING intrinsic module. See the README for instructions for -!! compilation and use. -!! -!! Here are the PUBLIC functions and subroutines included in this module. -!! subroutine lammps_open (command_line, communicator, ptr) -!! subroutine lammps_open_no_mpi (command_line, ptr) -!! subroutine lammps_close (ptr) -!! subroutine lammps_file (ptr, str) -!! subroutine lammps_command (ptr, str) -!! subroutine lammps_free (ptr) -!! subroutine lammps_extract_global (global, ptr, name) -!! subroutine lammps_extract_atom (atom, ptr, name) -!! subroutine lammps_extract_fix (fix, ptr, id, style, type, i, j) -!! subroutine lammps_extract_compute (compute, ptr, id, style, type) -!! subroutine lammps_extract_variable (variable, ptr, name, group) -!! function lammps_get_natoms (ptr) -!! subroutine lammps_gather_atoms (ptr, name, count, data) -!! subroutine lammps_scatter_atoms (ptr, name, data) - -#define FLERR __FILE__,__LINE__ -! The above line allows for similar error checking as is done with standard -! LAMMPS files. - -module LAMMPS - - use, intrinsic :: ISO_C_binding, only : C_double, C_int, C_ptr, C_char, & - C_NULL_CHAR, C_loc, C_F_pointer, lammps_instance => C_ptr - implicit none - private - public :: lammps_set_user_virial - public :: lammps_set_external_vector_length - public :: lammps_set_external_vector - public :: lammps_set_user_energy - public :: lammps_open, lammps_open_no_mpi, lammps_close, lammps_file, & - lammps_command, lammps_free, lammps_extract_global, & - lammps_extract_atom, lammps_extract_compute, lammps_extract_fix, & - lammps_extract_variable, lammps_get_natoms, lammps_gather_atoms, & - lammps_set_callback - public :: lammps_scatter_atoms, lammps_instance, C_ptr, C_double, C_int - - !! Functions supplemental to the prototypes in library.h. {{{1 - !! The function definitions (in C++) are contained in LAMMPS-wrapper.cpp. - !! I would have written the first in Fortran, but the MPI libraries (which - !! were written in C) have C-based functions to convert from Fortran MPI - !! handles to C MPI handles, and there is no Fortran equivalent for those - !! functions. - interface - subroutine lammps_open_wrapper (argc, argv, communicator, ptr) & - bind (C, name='lammps_open_fortran_wrapper') - import :: C_int, C_ptr - integer (C_int), value :: argc - type (C_ptr), dimension(*) :: argv - integer, value :: communicator - type (C_ptr) :: ptr - end subroutine lammps_open_wrapper - subroutine lammps_actual_error_all (ptr, file, line, str) & - bind (C, name='lammps_error_all') - import :: C_int, C_char, C_ptr - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*), intent(in) :: file, str - integer (C_int), value :: line - end subroutine lammps_actual_error_all - function lammps_get_ntypes (ptr) result (ntypes) & - bind (C, name='lammps_get_ntypes') - import :: C_int, C_ptr - type (C_ptr), value :: ptr - integer (C_int) :: ntypes - end function lammps_get_ntypes - function lammps_actual_extract_compute_vectorsize (ptr, id, style) & - result (vectorsize) bind (C, name='lammps_extract_compute_vectorsize') - import :: C_int, C_char, C_ptr - integer (C_int) :: vectorsize - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - end function lammps_actual_extract_compute_vectorsize - subroutine lammps_actual_extract_compute_arraysize (ptr, id, style, & - nrows, ncols) bind (C, name='lammps_extract_compute_arraysize') - import :: C_int, C_char, C_ptr - integer (C_int) :: arraysize - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - integer (C_int) :: nrows, ncols - end subroutine lammps_actual_extract_compute_arraysize - function lammps_actual_extract_fix_vectorsize (ptr, id, style) & - result (vectorsize) bind (C, name='lammps_extract_fix_vectorsize') - import :: C_int, C_char, C_ptr - integer (C_int) :: vectorsize - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - end function lammps_actual_extract_fix_vectorsize - subroutine lammps_actual_extract_fix_arraysize (ptr, id, style, & - nrows, ncols) bind (C, name='lammps_extract_fix_arraysize') - import :: C_int, C_char, C_ptr - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style - integer (C_int) :: nrows, ncols - end subroutine lammps_actual_extract_fix_arraysize - end interface - - !! Functions/subroutines defined in library.h and library.cpp {{{1 - interface - subroutine lammps_actual_open_no_mpi (argc, argv, ptr) & - bind (C, name='lammps_open_no_mpi') - import :: C_int, C_ptr - integer (C_int), value :: argc - type (C_ptr), dimension(*) :: argv - type (C_ptr) :: ptr - end subroutine lammps_actual_open_no_mpi - - subroutine lammps_close (ptr) bind (C, name='lammps_close') - import :: C_ptr - type (C_ptr), value :: ptr - end subroutine lammps_close - - subroutine lammps_actual_file (ptr, str) bind (C, name='lammps_file') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: str - end subroutine lammps_actual_file - - function lammps_actual_command (ptr, str) result (command) & - bind (C, name='lammps_command') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: str - type (C_ptr) :: command - end function lammps_actual_command - - subroutine lammps_free (ptr) bind (C, name='lammps_free') - import :: C_ptr - type (C_ptr), value :: ptr - end subroutine lammps_free - - function lammps_actual_extract_global (ptr, name) & - bind (C, name='lammps_extract_global') result (global) - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name - type (C_ptr) :: global - end function lammps_actual_extract_global - - function lammps_actual_extract_atom (ptr, name) & - bind (C, name='lammps_extract_atom') result (atom) - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name - type (C_ptr) :: atom - end function lammps_actual_extract_atom - - function lammps_actual_extract_compute (ptr, id, style, type) & - result (compute) bind (C, name='lammps_extract_compute') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style, type - type (C_ptr) :: compute - end function lammps_actual_extract_compute - - function lammps_actual_extract_fix (ptr, id, style, type, i, j) & - result (fix) bind (C, name='lammps_extract_fix') - import :: C_ptr, C_char, C_int - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: id - integer (C_int), value :: style, type, i, j - type (C_ptr) :: fix - end function lammps_actual_extract_fix - - function lammps_actual_extract_variable (ptr, name, group) & - result (variable) bind (C, name='lammps_extract_variable') - import :: C_ptr, C_char - type (C_ptr), value :: ptr - character (kind=C_char), dimension(*) :: name, group - type (C_ptr) :: variable - end function lammps_actual_extract_variable - - function lammps_get_natoms (ptr) result (natoms) & - bind (C, name='lammps_get_natoms') - import :: C_ptr, C_int - type (C_ptr), value :: ptr - integer (C_int) :: natoms - end function lammps_get_natoms - - subroutine lammps_set_callback (ptr) & - bind (C, name='lammps_set_callback') - import :: C_ptr - type (C_ptr), value :: ptr - end subroutine lammps_set_callback - - subroutine lammps_set_user_energy (ptr, energy) & - bind (C, name='lammps_set_user_energy') - import :: C_ptr, C_double - type (C_ptr), value :: ptr - real(C_double), value :: energy - end subroutine lammps_set_user_energy - - subroutine lammps_set_user_virial (ptr, virial) & - bind (C, name='lammps_set_user_virial') - import :: C_ptr, C_double - type (C_ptr), value :: ptr - real(C_double) :: virial(6) - end subroutine lammps_set_user_virial - - subroutine lammps_set_external_vector_length (ptr, n) & - bind (C, name='lammps_set_external_vector_length') - import :: C_ptr, C_double, C_int - type(C_ptr), value :: ptr - integer (C_int), value :: n - end subroutine lammps_set_external_vector_length - - subroutine lammps_set_external_vector (ptr, n, val) & - bind (C, name='lammps_set_external_vector') - import :: C_ptr, C_int, C_double - type (C_ptr), value :: ptr - integer (C_int), value :: n - real(C_double), value :: val - end subroutine lammps_set_external_vector - - subroutine lammps_actual_gather_atoms (ptr, name, type, count, data) & - bind (C, name='lammps_gather_atoms') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count - end subroutine lammps_actual_gather_atoms - - subroutine lammps_actual_scatter_atoms (ptr, name, type, count, data) & - bind (C, name='lammps_scatter_atoms') - import :: C_ptr, C_int, C_char - type (C_ptr), value :: ptr, data - character (kind=C_char), dimension(*) :: name - integer (C_int), value :: type, count - end subroutine lammps_actual_scatter_atoms - end interface - - ! Generic functions for the wrappers below {{{1 - - interface lammps_extract_global - module procedure lammps_extract_global_i, & - lammps_extract_global_dp - end interface lammps_extract_global - - interface lammps_extract_atom - module procedure lammps_extract_atom_ia, & - lammps_extract_atom_dpa, & - lammps_extract_atom_dp2a - end interface lammps_extract_atom - - interface lammps_extract_compute - module procedure lammps_extract_compute_dp, & - lammps_extract_compute_dpa, & - lammps_extract_compute_dp2a - end interface lammps_extract_compute - - interface lammps_extract_fix - module procedure lammps_extract_fix_dp, & - lammps_extract_fix_dpa, & - lammps_extract_fix_dp2a - end interface lammps_extract_fix - - interface lammps_extract_variable - module procedure lammps_extract_variable_dp, & - lammps_extract_variable_dpa - end interface lammps_extract_variable - - interface lammps_gather_atoms - module procedure lammps_gather_atoms_ia, lammps_gather_atoms_dpa - end interface lammps_gather_atoms - - interface lammps_scatter_atoms - module procedure lammps_scatter_atoms_ia, lammps_scatter_atoms_dpa - end interface lammps_scatter_atoms - -contains !! Wrapper functions local to this module {{{1 - - subroutine lammps_open (command_line, communicator, ptr) - character (len=*), intent(in) :: command_line - integer, intent(in) :: communicator - type (C_ptr) :: ptr - integer (C_int) :: argc - type (C_ptr), dimension(:), allocatable :: argv - character (kind=C_char), dimension(len_trim(command_line)+1), target :: & - c_command_line - c_command_line = string2Cstring (command_line) - call Cstring2argcargv (c_command_line, argc, argv) - call lammps_open_wrapper (argc, argv, communicator, ptr) - deallocate (argv) - end subroutine lammps_open - -!----------------------------------------------------------------------------- - - subroutine lammps_open_no_mpi (command_line, ptr) - character (len=*), intent(in) :: command_line - type (C_ptr) :: ptr - integer (C_int) :: argc - type (C_ptr), dimension(:), allocatable :: argv - character (kind=C_char), dimension(len_trim(command_line)+1), target :: & - c_command_line - c_command_line = string2Cstring (command_line) - call Cstring2argcargv (c_command_line, argc, argv) - call lammps_actual_open_no_mpi (argc, argv, ptr) - deallocate (argv) - end subroutine lammps_open_no_mpi - -!----------------------------------------------------------------------------- - - subroutine lammps_file (ptr, str) - type (C_ptr) :: ptr - character (len=*) :: str - character (kind=C_char), dimension(len_trim(str)+1) :: Cstr - Cstr = string2Cstring (str) - call lammps_actual_file (ptr, Cstr) - end subroutine lammps_file - -!----------------------------------------------------------------------------- - - subroutine lammps_command (ptr, str) - type (C_ptr) :: ptr - character (len=*) :: str - character (kind=C_char), dimension(len_trim(str)+1) :: Cstr - type (C_ptr) :: dummy - Cstr = string2Cstring (str) - dummy = lammps_actual_command (ptr, Cstr) - end subroutine lammps_command - -!----------------------------------------------------------------------------- - -! lammps_extract_global {{{2 - function lammps_extract_global_Cptr (ptr, name) result (global) - type (C_ptr) :: global - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - Cname = string2Cstring (name) - global = lammps_actual_extract_global (ptr, Cname) - end function lammps_extract_global_Cptr - subroutine lammps_extract_global_i (global, ptr, name) - integer (C_int), pointer, intent(out) :: global - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - Cptr = lammps_extract_global_Cptr (ptr, name) - call C_F_pointer (Cptr, global) - end subroutine lammps_extract_global_i - subroutine lammps_extract_global_dp (global, ptr, name) - real (C_double), pointer, intent(out) :: global - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - Cptr = lammps_extract_global_Cptr (ptr, name) - call C_F_pointer (Cptr, global) - end subroutine lammps_extract_global_dp - -!----------------------------------------------------------------------------- - -! lammps_extract_atom {{{2 - function lammps_extract_atom_Cptr (ptr, name) result (atom) - type (C_ptr) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - Cname = string2Cstring (name) - atom = lammps_actual_extract_atom (ptr, Cname) - end function lammps_extract_atom_Cptr - subroutine lammps_extract_atom_ia (atom, ptr, name) - integer (C_int), dimension(:), pointer, intent(out) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - integer (C_int), pointer :: nelements - call lammps_extract_global_i (nelements, ptr, 'nlocal') - Cptr = lammps_extract_atom_Cptr (ptr, name) - call C_F_pointer (Cptr, atom, (/nelements/)) - end subroutine lammps_extract_atom_ia - subroutine lammps_extract_atom_dpa (atom, ptr, name) - real (C_double), dimension(:), pointer, intent(out) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - integer (C_int), pointer :: nlocal - integer :: nelements - real (C_double), dimension(:), pointer :: Fptr - if ( name == 'mass' ) then - nelements = lammps_get_ntypes (ptr) + 1 - else if ( name == 'x' .or. name == 'v' .or. name == 'f' .or. & - name == 'mu' .or. name == 'omega' .or. name == 'torque' .or. & - name == 'angmom' ) then - ! We should not be getting a rank-2 array here! - call lammps_error_all (ptr, FLERR, 'You cannot extract those atom& - & data (' // trim(name) // ') into a rank 1 array.') - return - else - ! Everything else we can get is probably nlocal units long - call lammps_extract_global_i (nlocal, ptr, 'nlocal') - nelements = nlocal - end if - Cptr = lammps_extract_atom_Cptr (ptr, name) - call C_F_pointer (Cptr, Fptr, (/nelements/)) - if ( name == 'mass' ) then - !atom(0:) => Fptr - atom => Fptr - else - atom => Fptr - end if - end subroutine lammps_extract_atom_dpa - subroutine lammps_extract_atom_dp2a (atom, ptr, name) - real (C_double), dimension(:,:), pointer, intent(out) :: atom - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Catom - integer (C_int), pointer :: nelements - if ( name /= 'x' .and. name /= 'v' .and. name /= 'f' .and. & - name /= 'mu' .and. name /= 'omega' .and. name /= 'tandque' .and. & - name /= 'angmom' .and. name /= 'fexternal' ) then - ! We should not be getting a rank-2 array here! - call lammps_error_all (ptr, FLERR, 'You cannot extract those atom& - & data (' // trim(name) // ') into a rank 2 array.') - return - end if - Cptr = lammps_extract_atom_Cptr (ptr, name) - call lammps_extract_global_i (nelements, ptr, 'nlocal') - ! Catom will now be the array of void* pointers that the void** pointer - ! pointed to. Catom(1) is now the pointer to the first element. - call C_F_pointer (Cptr, Catom, (/nelements/)) - ! Now get the actual array, which has its shape transposed from what we - ! might think of it in C - call C_F_pointer (Catom(1), atom, (/3, nelements/)) - end subroutine lammps_extract_atom_dp2a - -!----------------------------------------------------------------------------- - -! lammps_extract_compute {{{2 - function lammps_extract_compute_Cptr (ptr, id, style, type) result (compute) - type (C_ptr) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - integer (kind=C_int) :: Cstyle, Ctype - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = style - Ctype = type - compute = lammps_actual_extract_compute (ptr, Cid, Cstyle, Ctype) - end function lammps_extract_compute_Cptr - subroutine lammps_extract_compute_dp (compute, ptr, id, style, type) - real (C_double), pointer, intent(out) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - type (C_ptr) :: Cptr - ! The only valid values of (style,type) are (0,0) for scalar 'compute' - if ( style /= 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot pack per-atom/local& - & data into a scalar.') - return - end if - if ( type == 1 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & vector (rank 1) into a scalar.') - return - else if ( type == 2 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & array (rank 2) into a scalar.') - return - end if - Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) - call C_F_pointer (Cptr, compute) - end subroutine lammps_extract_compute_dp - subroutine lammps_extract_compute_dpa (compute, ptr, id, style, type) - real (C_double), dimension(:), pointer, intent(out) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - type (C_ptr) :: Cptr - integer :: nelements - ! Check for the correct dimensionality - if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & scalar (rank 0) into a rank 1 variable.') - return - else if ( type == 2 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & array (rank 2) into a rank 1 variable.') - return - end if - nelements = lammps_extract_compute_vectorsize (ptr, id, style) - Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) - call C_F_pointer (Cptr, compute, (/nelements/)) - end subroutine lammps_extract_compute_dpa - subroutine lammps_extract_compute_dp2a (compute, ptr, id, style, type) - real (C_double), dimension(:,:), pointer, intent(out) :: compute - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Ccompute - integer :: nr, nc - ! Check for the correct dimensionality - if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & scalar (rank 0) into a rank 2 variable.') - return - else if ( type == 1 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a compute& - & array (rank 1) into a rank 2 variable.') - return - end if - call lammps_extract_compute_arraysize (ptr, id, style, nr, nc) - Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) - call C_F_pointer (Cptr, Ccompute, (/nr/)) - ! Note that the matrix is transposed, from Fortran's perspective - call C_F_pointer (Ccompute(1), compute, (/nc, nr/)) - end subroutine lammps_extract_compute_dp2a - -!----------------------------------------------------------------------------- - -! lammps_extract_fix {{{2 - function lammps_extract_fix_Cptr (ptr, id, style, type, i, j) & - result (fix) - type (C_ptr) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - integer (kind=C_int) :: Cstyle, Ctype, Ci, Cj - Cid = string2Cstring (id) - Cstyle = style - Ctype = type - Ci = i - 1 ! This is for consistency with the values from f_ID[i], - Cj = j - 1 ! which is different from what library.cpp uses! - if ( (type >= 1 .and. Ci < 0) .or. & - (type == 2 .and. (Ci < 0 .or. Cj < 0) ) ) then - call lammps_error_all (ptr, FLERR, 'Index out of range in& - & lammps_extract_fix') - end if - fix = lammps_actual_extract_fix (ptr, Cid, Cstyle, Ctype, Ci, Cj) - end function lammps_extract_fix_Cptr - subroutine lammps_extract_fix_dp (fix, ptr, id, style, type, i, j) - real (C_double), intent(out) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - type (C_ptr) :: Cptr - real (C_double), pointer :: Fptr - ! Check for the correct dimensionality - if ( style /= 0 ) then - select case (type) - case (0) - call lammps_error_all (ptr, FLERR, 'There is no per-atom or local& - & scalar data available from fixes.') - case (1) - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix''s & - &per-atom/local vector (rank 1) into a scalar.') - case (2) - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix''s & - &per-atom/local array (rank 2) into a scalar.') - case default - call lammps_error_all (ptr, FLERR, 'Invalid extract_fix style/& - &type combination.') - end select - return - end if - Cptr = lammps_extract_fix_Cptr (ptr, id, style, type, i, j) - call C_F_pointer (Cptr, Fptr) - fix = Fptr - nullify (Fptr) - ! Memory is only allocated for "global" fix variables - if ( style == 0 ) call lammps_free (Cptr) - end subroutine lammps_extract_fix_dp - subroutine lammps_extract_fix_dpa (fix, ptr, id, style, type, i, j) - real (C_double), dimension(:), pointer, intent(out) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - type (C_ptr) :: Cptr - integer :: fix_len - ! Check for the correct dimensionality - if ( style == 0 ) then - call lammps_error_all (ptr, FLERR, 'You can''t extract the& - & whole vector from global fix data') - return - else if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You can''t extract a fix& - & scalar into a rank 1 variable') - return - else if ( type == 2 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix& - & array into a rank 1 variable.') - return - else if ( type /= 1 ) then - call lammps_error_all (ptr, FLERR, 'Invalid type for fix extraction.') - return - end if - fix_len = lammps_extract_fix_vectorsize (ptr, id, style) - call C_F_pointer (Cptr, fix, (/fix_len/)) - ! Memory is only allocated for "global" fix variables, which we should - ! never get here, so no need to call lammps_free! - end subroutine lammps_extract_fix_dpa - subroutine lammps_extract_fix_dp2a (fix, ptr, id, style, type, i, j) - real (C_double), dimension(:,:), pointer, intent(out) :: fix - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style, type, i, j - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Cfix - integer :: nr, nc - ! Check for the correct dimensionality - if ( style == 0 ) then - call lammps_error_all (ptr, FLERR, 'It is not possible to extract the& - & entire array from global fix data.') - return - else if ( type == 0 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix& - & scalar (rank 0) into a rank 2 variable.') - return - else if ( type == 1 ) then - call lammps_error_all (ptr, FLERR, 'You cannot extract a fix& - & vector (rank 1) into a rank 2 variable.') - return - end if - call lammps_extract_fix_arraysize (ptr, id, style, nr, nc) - ! Extract pointer to first element as Cfix(1) - call C_F_pointer (Cptr, Cfix, (/nr/)) - ! Now extract the array, which is transposed - call C_F_pointer (Cfix(1), fix, (/nc, nr/)) - end subroutine lammps_extract_fix_dp2a - -!----------------------------------------------------------------------------- - -! lammps_extract_variable {{{2 - function lammps_extract_variable_Cptr (ptr, name, group) result (variable) - type (C_ptr) :: ptr, variable - character (len=*) :: name - character (len=*), optional :: group - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - character (kind=C_char), dimension(:), allocatable :: Cgroup - Cname = string2Cstring (name) - if ( present(group) ) then - allocate (Cgroup(len_trim(group)+1)) - Cgroup = string2Cstring (group) - else - allocate (Cgroup(1)) - Cgroup(1) = C_NULL_CHAR - end if - variable = lammps_actual_extract_variable (ptr, Cname, Cgroup) - deallocate (Cgroup) - end function lammps_extract_variable_Cptr - subroutine lammps_extract_variable_dp (variable, ptr, name, group) - real (C_double), intent(out) :: variable - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (len=*), intent(in), optional :: group - type (C_ptr) :: Cptr - real (C_double), pointer :: Fptr - if ( present(group) ) then - Cptr = lammps_extract_variable_Cptr (ptr, name, group) - else - Cptr = lammps_extract_variable_Cptr (ptr, name) - end if - call C_F_pointer (Cptr, Fptr) - variable = Fptr - nullify (Fptr) - call lammps_free (Cptr) - end subroutine lammps_extract_variable_dp - subroutine lammps_extract_variable_dpa (variable, ptr, name, group) - real (C_double), dimension(:), allocatable, intent(out) :: variable - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - character (len=*), intent(in), optional :: group - type (C_ptr) :: Cptr - real (C_double), dimension(:), pointer :: Fptr - integer :: natoms - if ( present(group) ) then - Cptr = lammps_extract_variable_Cptr (ptr, name, group) - else - Cptr = lammps_extract_variable_Cptr (ptr, name) - end if - natoms = lammps_get_natoms (ptr) - allocate (variable(natoms)) - call C_F_pointer (Cptr, Fptr, (/natoms/)) - variable = Fptr - nullify (Fptr) - call lammps_free (Cptr) - end subroutine lammps_extract_variable_dpa - -!-------------------------------------------------------------------------2}}} - - subroutine lammps_gather_atoms_ia (ptr, name, count, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count - integer, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - integer (C_int), dimension(:), pointer :: Fdata - integer (C_int) :: natoms - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 0_C_int - integer (C_int) :: Ccount - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*natoms) ) - allocate ( data(count*natoms) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms (ptr, Cname, Ctype, Ccount, Cdata) - data = Fdata - deallocate (Fdata) - end subroutine lammps_gather_atoms_ia - subroutine lammps_gather_atoms_dpa (ptr, name, count, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, intent(in) :: count - double precision, dimension(:), allocatable, intent(out) :: data - type (C_ptr) :: Cdata - real (C_double), dimension(:), pointer :: Fdata - integer (C_int) :: natoms - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), parameter :: Ctype = 1_C_int - integer (C_int) :: Ccount - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - if ( count /= 1 .and. count /= 3 ) then - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - else - Ccount = count - end if - allocate ( Fdata(count*natoms) ) - allocate ( data(count*natoms) ) - Cdata = C_loc (Fdata(1)) - call lammps_actual_gather_atoms (ptr, Cname, Ctype, Ccount, Cdata) - data = Fdata(:) - deallocate (Fdata) - end subroutine lammps_gather_atoms_dpa - -!----------------------------------------------------------------------------- - - subroutine lammps_scatter_atoms_ia (ptr, name, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - integer, dimension(:), intent(in) :: data - integer (kind=C_int) :: natoms, Ccount - integer (kind=C_int), parameter :: Ctype = 0_C_int - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - integer (C_int), dimension(size(data)), target :: Fdata - type (C_ptr) :: Cdata - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - Ccount = size(data) / natoms - if ( Ccount /= 1 .and. Ccount /= 3 ) & - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - Fdata = data - Cdata = C_loc (Fdata(1)) - call lammps_actual_scatter_atoms (ptr, Cname, Ctype, Ccount, Cdata) - end subroutine lammps_scatter_atoms_ia - subroutine lammps_scatter_atoms_dpa (ptr, name, data) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: name - double precision, dimension(:), intent(in) :: data - integer (kind=C_int) :: natoms, Ccount - integer (kind=C_int), parameter :: Ctype = 1_C_int - character (kind=C_char), dimension(len_trim(name)+1) :: Cname - real (C_double), dimension(size(data)), target :: Fdata - type (C_ptr) :: Cdata - natoms = lammps_get_natoms (ptr) - Cname = string2Cstring (name) - Ccount = size(data) / natoms - if ( Ccount /= 1 .and. Ccount /= 3 ) & - call lammps_error_all (ptr, FLERR, 'lammps_gather_atoms requires& - & count to be either 1 or 3') - Fdata = data - Cdata = C_loc (Fdata(1)) - call lammps_actual_scatter_atoms (ptr, Cname, Ctype, Ccount, Cdata) - end subroutine lammps_scatter_atoms_dpa - -!----------------------------------------------------------------------------- - - function lammps_extract_compute_vectorsize (ptr, id, style) & - result (vectorsize) - integer :: vectorsize - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer (C_int) :: Cvectorsize, Cstyle - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int(style, C_int) - Cvectorsize = lammps_actual_extract_compute_vectorsize (ptr, Cid, Cstyle) - vectorsize = int(Cvectorsize, kind(vectorsize)) - end function lammps_extract_compute_vectorsize - -!----------------------------------------------------------------------------- - - function lammps_extract_fix_vectorsize (ptr, id, style) & - result (vectorsize) - integer :: vectorsize - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer (C_int) :: Cvectorsize, Cstyle - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int(style, C_int) - Cvectorsize = lammps_actual_extract_fix_vectorsize (ptr, Cid, Cstyle) - vectorsize = int(Cvectorsize, kind(vectorsize)) - end function lammps_extract_fix_vectorsize - -!----------------------------------------------------------------------------- - - subroutine lammps_extract_compute_arraysize (ptr, id, style, nrows, ncols) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer, intent(out) :: nrows, ncols - integer (C_int) :: Cstyle, Cnrows, Cncols - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int (style, C_int) - call lammps_actual_extract_compute_arraysize (ptr, Cid, Cstyle, & - Cnrows, Cncols) - nrows = int (Cnrows, kind(nrows)) - ncols = int (Cncols, kind(ncols)) - end subroutine lammps_extract_compute_arraysize - -!----------------------------------------------------------------------------- - - subroutine lammps_extract_fix_arraysize (ptr, id, style, nrows, ncols) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: id - integer, intent(in) :: style - integer, intent(out) :: nrows, ncols - integer (C_int) :: Cstyle, Cnrows, Cncols - character (kind=C_char), dimension(len_trim(id)+1) :: Cid - Cid = string2Cstring (id) - Cstyle = int (style, kind(Cstyle)) - call lammps_actual_extract_fix_arraysize (ptr, Cid, Cstyle, & - Cnrows, Cncols) - nrows = int (Cnrows, kind(nrows)) - ncols = int (Cncols, kind(ncols)) - end subroutine lammps_extract_fix_arraysize - -!----------------------------------------------------------------------------- - - subroutine lammps_error_all (ptr, file, line, str) - type (C_ptr), intent(in) :: ptr - character (len=*), intent(in) :: file, str - integer, intent(in) :: line - character (kind=C_char), dimension(len_trim(file)+1) :: Cfile - character (kind=C_char), dimension(len_trim(str)+1) :: Cstr - integer (C_int) :: Cline - Cline = int(line, kind(Cline)) - Cfile = string2Cstring (file) - Cstr = string2Cstring (str) - call lammps_actual_error_all (ptr, Cfile, Cline, Cstr) - end subroutine lammps_error_all - -!----------------------------------------------------------------------------- - -! Locally defined helper functions {{{1 - - pure function string2Cstring (string) result (C_string) - use, intrinsic :: ISO_C_binding, only : C_char, C_NULL_CHAR - character (len=*), intent(in) :: string - character (len=1, kind=C_char) :: C_string (len_trim(string)+1) - integer :: i, n - n = len_trim (string) - forall (i = 1:n) - C_string(i) = string(i:i) - end forall - C_string(n+1) = C_NULL_CHAR - end function string2Cstring - -!----------------------------------------------------------------------------- - - subroutine Cstring2argcargv (Cstring, argc, argv) - !! Converts a C-style string to argc and argv, that is, words in Cstring - !! become C-style strings in argv. IMPORTANT: Cstring is modified by - !! this routine! I would make Cstring local TO this routine and accept - !! a Fortran-style string instead, but we run into scoping and - !! allocation problems that way. This routine assumes the string is - !! null-terminated, as all C-style strings must be. - - character (kind=C_char), dimension(*), target, intent(inout) :: Cstring - integer (C_int), intent(out) :: argc - type (C_ptr), dimension(:), allocatable, intent(out) :: argv - - integer :: StringStart, SpaceIndex, strlen, argnum - - argc = 1_C_int - - ! Find the length of the string - strlen = 1 - do while ( Cstring(strlen) /= C_NULL_CHAR ) - strlen = strlen + 1 - end do - - ! Find the number of non-escaped spaces - SpaceIndex = 2 - do while ( SpaceIndex < strlen ) - if ( Cstring(SpaceIndex) == ' ' .and. & - Cstring(SpaceIndex-1) /= '\' ) then - argc = argc + 1_C_int - ! Find the next non-space character - do while ( Cstring(SpaceIndex+1) == ' ') - SpaceIndex = SpaceIndex + 1 - end do - end if - SpaceIndex = SpaceIndex + 1 - end do - - ! Now allocate memory for argv - allocate (argv(argc)) - - ! Now find the string starting and ending locations - StringStart = 1 - SpaceIndex = 2 - argnum = 1 - do while ( SpaceIndex < strlen ) - if ( Cstring(SpaceIndex) == ' ' .and. & - Cstring(SpaceIndex-1) /= '\' ) then - ! Found a real space => split strings and store this one - Cstring(Spaceindex) = C_NULL_CHAR ! Replaces space with NULL - argv(argnum) = C_loc(Cstring(StringStart)) - argnum = argnum + 1 - ! Find the next non-space character - do while ( Cstring(SpaceIndex+1) == ' ') - SpaceIndex = SpaceIndex + 1 - end do - StringStart = SpaceIndex + 1 - else if ( Cstring(SpaceIndex) == ' ' .and. & - Cstring(SpaceIndex-1) == '\' ) then - ! Escaped space => remove backslash and move rest of array - Cstring(SpaceIndex-1:strlen-1) = Cstring(SpaceIndex:strlen) - strlen = strlen - 1 ! Last character is still C_NULL_CHAR - end if - SpaceIndex = SpaceIndex + 1 - end do - ! Now handle the last argument - argv(argnum) = C_loc(Cstring(StringStart)) - - end subroutine Cstring2argcargv - -! 1}}} - -end module LAMMPS - -! vim: foldmethod=marker tabstop=3 softtabstop=3 shiftwidth=3 expandtab diff --git a/examples/COUPLE/fortran_dftb/README b/examples/COUPLE/fortran_dftb/README deleted file mode 100644 index 39a2f18169..0000000000 --- a/examples/COUPLE/fortran_dftb/README +++ /dev/null @@ -1,37 +0,0 @@ -This directory has an example of using a callback function to obtain -forces from a fortran code for a LAMMPS simulation. The reader should -refer to the README file in COUPLE/fortran2 before proceeding. Here, -the LAMMPS.F90 file has been modified slightly and additional files -named LAMMPS-wrapper2.h and LAMMPS-wrapper2.cpp have been included in -order to supply wrapper functions to set the LAMMPS callback function, -total energy, virial, and electronic entropy contribution (needed for -MSST simulations with a quantum code). - -In this example, the callback function is set to run the -semi-empirical quantum code DFTB+ in serial and then read in the total -energy, forces, and stress tensor from file. In this case, nlocal = -the total number of atoms in the system, so particle positions can be -read from the pos array directly, and DFTB+ forces can simply be -included via the fext array. The user should take care in the case of -a parallel calculation, where LAMMPS can assign different particules -to each processor. For example, the user should use functions such as -lammps_gather_atoms() and lammps_scatter_atoms() in the case where the -fortran force calculating code requires the positions of all atoms, -etc. - -A few more important notes: - --Calling the subroutine lammps_set_callback() is required in order to set - a pointer to the callback function in LAMMPS. --The subroutine lammps_set_user_energy() passes in the potential energy - from DFTB+ to LAMMPS. Similarly, lammps_set_user_virial passes the stress tensor. - --The electronic entropy contribution is set via lammps_set_external_vector(). Their needs - to be a call to lammps_set_external_vector_length() before this value can be - passed to LAMMPS. - -This example was created by Nir Goldman, whom you can contact with -questions: - -Nir Goldman, LLNL -ngoldman@llnl.gov diff --git a/examples/COUPLE/fortran_dftb/data.diamond b/examples/COUPLE/fortran_dftb/data.diamond deleted file mode 100644 index b3dd599cf4..0000000000 --- a/examples/COUPLE/fortran_dftb/data.diamond +++ /dev/null @@ -1,148 +0,0 @@ -# Position data file - -64 atoms -1 atom types - -0 7.134 xlo xhi -0 7.134 ylo yhi -0 7.134 zlo zhi - -0.00000000 0.00000000 0.00000000 xy xz yz - -Masses - -1 12.010000 - -Atoms - - 1 1 0 0 0 0 - 2 1 0 0.89175 0.89175 0.89175 - 3 1 0 1.7835 1.7835 0 - 4 1 0 2.67525 2.67525 0.89175 - 5 1 0 0 1.7835 1.7835 - 6 1 0 0.89175 2.67525 2.67525 - 7 1 0 1.7835 0 1.7835 - 8 1 0 2.67525 0.89175 2.67525 - 9 1 0 0 0 3.567 - 10 1 0 0.89175 0.89175 4.45875 - 11 1 0 1.7835 1.7835 3.567 - 12 1 0 2.67525 2.67525 4.45875 - 13 1 0 0 1.7835 5.3505 - 14 1 0 0.89175 2.67525 6.24225 - 15 1 0 1.7835 0 5.3505 - 16 1 0 2.67525 0.89175 6.24225 - 17 1 0 0 3.567 0 - 18 1 0 0.89175 4.45875 0.89175 - 19 1 0 1.7835 5.3505 0 - 20 1 0 2.67525 6.24225 0.89175 - 21 1 0 0 5.3505 1.7835 - 22 1 0 0.89175 6.24225 2.67525 - 23 1 0 1.7835 3.567 1.7835 - 24 1 0 2.67525 4.45875 2.67525 - 25 1 0 0 3.567 3.567 - 26 1 0 0.89175 4.45875 4.45875 - 27 1 0 1.7835 5.3505 3.567 - 28 1 0 2.67525 6.24225 4.45875 - 29 1 0 0 5.3505 5.3505 - 30 1 0 0.89175 6.24225 6.24225 - 31 1 0 1.7835 3.567 5.3505 - 32 1 0 2.67525 4.45875 6.24225 - 33 1 0 3.567 0 0 - 34 1 0 4.45875 0.89175 0.89175 - 35 1 0 5.3505 1.7835 0 - 36 1 0 6.24225 2.67525 0.89175 - 37 1 0 3.567 1.7835 1.7835 - 38 1 0 4.45875 2.67525 2.67525 - 39 1 0 5.3505 0 1.7835 - 40 1 0 6.24225 0.89175 2.67525 - 41 1 0 3.567 0 3.567 - 42 1 0 4.45875 0.89175 4.45875 - 43 1 0 5.3505 1.7835 3.567 - 44 1 0 6.24225 2.67525 4.45875 - 45 1 0 3.567 1.7835 5.3505 - 46 1 0 4.45875 2.67525 6.24225 - 47 1 0 5.3505 0 5.3505 - 48 1 0 6.24225 0.89175 6.24225 - 49 1 0 3.567 3.567 0 - 50 1 0 4.45875 4.45875 0.89175 - 51 1 0 5.3505 5.3505 0 - 52 1 0 6.24225 6.24225 0.89175 - 53 1 0 3.567 5.3505 1.7835 - 54 1 0 4.45875 6.24225 2.67525 - 55 1 0 5.3505 3.567 1.7835 - 56 1 0 6.24225 4.45875 2.67525 - 57 1 0 3.567 3.567 3.567 - 58 1 0 4.45875 4.45875 4.45875 - 59 1 0 5.3505 5.3505 3.567 - 60 1 0 6.24225 6.24225 4.45875 - 61 1 0 3.567 5.3505 5.3505 - 62 1 0 4.45875 6.24225 6.24225 - 63 1 0 5.3505 3.567 5.3505 - 64 1 0 6.24225 4.45875 6.24225 - -Velocities - -1 -0.00733742 -0.0040297 -0.00315229 -2 -0.00788609 -0.00567535 -0.00199152 -3 -0.00239042 0.00710139 -0.00335049 -4 0.00678551 0.0019976 0.00219289 -5 0.00413717 0.00275709 0.000937637 -6 -0.00126313 0.00485636 0.00727862 -7 0.00337547 -0.00234623 -0.000922223 -8 -0.00792183 -0.00509186 -0.00104168 -9 0.00414091 0.00390285 0.000845961 -10 -0.000284543 0.0010771 -0.00458404 -11 -0.00394968 -0.00446363 -0.00361688 -12 0.00067088 -0.00655175 -0.00752464 -13 0.00306632 -0.00245545 -0.00183867 -14 -0.0082145 -0.00564127 0.000281191 -15 0.00504454 0.0045835 0.000495763 -16 0.0035767 0.00320441 -0.00486426 -17 0.00420597 0.00262005 -0.0049459 -18 0.00440579 -1.76783e-05 0.00449311 -19 -0.00406463 0.00613304 0.00285599 -20 0.00171215 -0.00517887 0.00124326 -21 0.0011118 0.00334129 -0.0015222 -22 -0.00838394 -0.00112906 -0.00353379 -23 -0.00578527 -0.00415501 0.00297043 -24 -0.00211466 0.000964108 -0.00716523 -25 -0.000204107 -0.00380986 0.00681648 -26 0.00677838 0.00540935 0.0044354 -27 -0.00266809 -0.00358382 -0.00241889 -28 -0.0003973 0.00236566 0.00558871 -29 0.000754103 0.00457797 0.000105531 -30 -0.00246049 0.00110428 0.00511088 -31 0.00248891 0.00623314 0.00461597 -32 -0.00509423 0.000570503 0.00720856 -33 -0.00244427 -0.00374384 0.00618767 -34 -0.000360752 -8.10558e-05 0.00314052 -35 0.00435313 -0.00630587 -0.0070309 -36 0.00651087 -0.00389833 3.72525e-05 -37 0.00631828 -0.00316064 0.00231522 -38 -0.00579624 -0.00345068 -0.000277486 -39 0.00483974 0.000715028 0.000206355 -40 -0.00388164 -0.00189242 -0.00554862 -41 0.00398115 0.00152915 0.00756919 -42 -0.000552263 0.00352025 -0.000246143 -43 -0.00800284 0.00555703 0.00425716 -44 -0.00734405 -0.00752512 0.00667173 -45 -0.00545636 0.00421035 0.00399552 -46 0.00480246 0.00621147 -0.00492715 -47 -0.00424168 0.00621818 -9.37733e-05 -48 -0.00649561 0.00612908 -0.0020753 -49 -0.0075007 -0.00384737 -0.00687913 -50 -0.00203903 -0.00764372 0.0023883 -51 0.00442642 0.00744072 -0.0049344 -52 -0.00280486 -0.00509128 -0.00678045 -53 0.00679491 0.00583493 0.00333875 -54 0.00574665 -0.00521074 0.00523475 -55 0.00305618 -0.00320094 0.00341297 -56 0.004304 0.000615544 -0.00668787 -57 0.00564532 0.00327373 0.00388611 -58 0.000676899 0.00210326 0.00495295 -59 0.000160781 -0.00744313 -0.00279828 -60 0.00623521 0.00371301 0.00178015 -61 0.00520759 0.000642669 0.00207913 -62 0.00398042 0.0046438 -0.00359978 -63 -0.00478071 -0.00304932 -0.00765125 -64 0.00282671 -0.00548392 -0.00692691 diff --git a/examples/COUPLE/fortran_dftb/dftb_in.hsd b/examples/COUPLE/fortran_dftb/dftb_in.hsd deleted file mode 100644 index 104a4c04ce..0000000000 --- a/examples/COUPLE/fortran_dftb/dftb_in.hsd +++ /dev/null @@ -1,40 +0,0 @@ -#sample DFTB+ script to run this test code -Geometry = GenFormat { -<<< "lammps.gen" -} - -Driver = { -} - -Hamiltonian = DFTB { - LAMMPS = Yes # keyword to print energy, forces, and stress tensor to file(results.out) - SCC = No - MaxAngularMomentum = { - C = "p" - } - Charge = 0.0 - Eigensolver = Standard {} - Filling = Fermi { - Temperature [Kelvin] = 298.0 - } - SlaterKosterFiles = Type2FileNames { - Prefix = "~/slako/mio-1-1/" # the user must define the location of the skf files - Separator = "-" - Suffix = ".skf" - LowerCaseTypeName = No - } - KPointsAndWeights = { - 0.0000000000000 0.0000000000000 0.0000000000000 1.00000000000000 - } -} - -Options = { - CalculateForces = Yes - WriteDetailedOut = No - WriteBandOut = No - RandomSeed = 12345 -} - -ParserOptions = { - ParserVersion = 3 -} diff --git a/examples/COUPLE/fortran_dftb/dftb_pin.hsd b/examples/COUPLE/fortran_dftb/dftb_pin.hsd deleted file mode 100644 index 6d9dea4a15..0000000000 --- a/examples/COUPLE/fortran_dftb/dftb_pin.hsd +++ /dev/null @@ -1,129 +0,0 @@ -Geometry = GenFormat { -64 S -C -1 1 7.099007 7.117657 7.119139 -2 1 0.858709 0.867233 0.882294 -3 1 1.772527 1.811776 7.120239 -4 1 2.702145 2.681271 0.901362 -5 1 0.017539 1.794455 1.788454 -6 1 0.885593 2.694118 2.707994 -7 1 1.795055 7.120787 1.777896 -8 1 2.642849 0.868278 2.670699 -9 1 0.016060 0.017156 3.568644 -10 1 0.891891 0.896406 4.439286 -11 1 1.766086 1.764402 3.550134 -12 1 2.677349 2.648926 4.427174 -13 1 0.010133 1.771283 5.342173 -14 1 0.858153 2.653565 6.241596 -15 1 1.804087 0.020636 5.353268 -16 1 2.689680 0.907188 6.224575 -17 1 0.017845 3.577563 7.113016 -18 1 0.910027 4.459286 0.910286 -19 1 1.766394 5.376046 0.015526 -20 1 2.683727 6.220728 0.898553 -21 1 0.003357 5.363423 1.774139 -22 1 0.856735 6.238324 2.660213 -23 1 1.761079 3.549776 1.797054 -24 1 2.667227 4.463441 2.646074 -25 1 7.132499 3.551558 3.599764 -26 1 0.920387 4.482191 4.479257 -27 1 1.772194 5.337132 3.555569 -28 1 2.675010 6.251629 4.483124 -29 1 0.005702 5.371095 5.351147 -30 1 0.880807 6.249819 6.264231 -31 1 1.793177 3.592396 5.369939 -32 1 2.653179 4.463595 6.274044 -33 1 3.557243 7.118913 0.026006 -34 1 4.458971 0.889331 0.904950 -35 1 5.367903 1.759757 7.104941 -36 1 6.271565 2.658454 0.890168 -37 1 3.591915 1.768681 1.793880 -38 1 4.435612 2.662184 2.676722 -39 1 5.371040 0.000196 1.783464 -40 1 6.226453 0.886640 2.653384 -41 1 3.583339 0.005449 3.600177 -42 1 4.453692 0.909417 4.459713 -43 1 5.314554 1.805409 3.584215 -44 1 6.210181 2.642660 4.486206 -45 1 3.545704 1.802745 5.365369 -46 1 4.476660 2.701226 6.220451 -47 1 5.332820 0.029557 5.347965 -48 1 6.215725 0.915081 6.230289 -49 1 3.536446 3.551469 7.106600 -50 1 4.451181 4.426439 0.900180 -51 1 5.368735 5.377996 7.109524 -52 1 6.230666 6.220985 0.862175 -53 1 3.596626 5.372822 1.797613 -54 1 4.485613 6.221252 2.699652 -55 1 5.364421 3.549838 1.796281 -56 1 6.261739 4.459046 2.648152 -57 1 3.588752 3.581054 3.581755 -58 1 4.462342 4.467270 4.478800 -59 1 5.355202 5.318323 3.556531 -60 1 6.268570 6.259831 4.465795 -61 1 3.588636 5.354278 5.362327 -62 1 4.475747 6.263866 6.227803 -63 1 5.331158 3.554349 5.318368 -64 1 6.254581 4.436344 6.209681 -0.0 0.0 0.0 -7.13400000000000 0 0 -0 7.13400000000000 0 -0 0 7.13400000000000 -} -Driver = {} -Hamiltonian = DFTB { - LAMMPS = Yes - SCC = No - MaxAngularMomentum = { - C = "p" - } - Charge = 0.0 - Eigensolver = Standard {} - Filling = Fermi { - Temperature [Kelvin] = 298.0 - IndependentKFilling = No - } - SlaterKosterFiles = Type2FileNames { - Prefix = "~/slako/mio-1-1/" - Separator = "-" - Suffix = ".skf" - LowerCaseTypeName = No - } - KPointsAndWeights = { -0.0000000000000 0.0000000000000 0.0000000000000 1.00000000000000 - } - PolynomialRepulsive = {} - OldRepulsiveSum = No - OrbitalResolvedSCC = No - OldSKInterpolation = No - NoErep = No - Dispersion = {} - ThirdOrder = No - ThirdOrderFull = No -} -Options = { - CalculateForces = Yes - WriteDetailedOut = No - WriteBandOut = No - RandomSeed = 12345 - MullikenAnalysis = No - WriteEigenvectors = No - WriteAutotestTag = No - WriteDetailedXML = No - WriteResultsTag = No - AtomResolvedEnergies = No - WriteHS = No - WriteRealHS = No - MinimiseMemoryUsage = No - ShowFoldedCoords = No -} -ParserOptions = { - ParserVersion = 3 - WriteHSDInput = Yes - WriteXMLInput = No - StopAfterParsing = No - IgnoreUnprocessedNodes = No -} -Analysis = { - ProjectStates = {} -} diff --git a/examples/COUPLE/fortran_dftb/in.simple b/examples/COUPLE/fortran_dftb/in.simple deleted file mode 100644 index 894a490cf8..0000000000 --- a/examples/COUPLE/fortran_dftb/in.simple +++ /dev/null @@ -1,16 +0,0 @@ -units real -atom_style charge -atom_modify map array -atom_modify sort 0 0.0 -read_data data.diamond -neighbor 1.0 bin -neigh_modify delay 0 every 5 check no -fix 1 all nve -fix 2 all external pf/callback 1 1 - -fix_modify 2 energy yes -thermo_style custom step temp etotal ke pe lx ly lz pxx pyy pzz press - -thermo 1 -timestep 0.5 - diff --git a/examples/COUPLE/fortran_dftb/log.simple b/examples/COUPLE/fortran_dftb/log.simple deleted file mode 100644 index 3496e94ebe..0000000000 --- a/examples/COUPLE/fortran_dftb/log.simple +++ /dev/null @@ -1,71 +0,0 @@ -LAMMPS (6 Jul 2017) -units real -atom_style charge -atom_modify map array -atom_modify sort 0 0.0 -read_data data.diamond - triclinic box = (0 0 0) to (7.134 7.134 7.134) with tilt (0 0 0) - 1 by 1 by 1 MPI processor grid - reading atoms ... - 64 atoms - reading velocities ... - 64 velocities -neighbor 1.0 bin -neigh_modify delay 0 every 5 check no -fix 1 all nve -fix 2 all external pf/callback 1 1 - -fix_modify 2 energy yes -thermo_style custom step temp etotal ke pe lx ly lz pxx pyy pzz press - -thermo 1 -timestep 0.5 - -run 10 -Neighbor list info ... - update every 5 steps, delay 0 steps, check no - max neighbors/atom: 2000, page size: 100000 - master list distance cutoff = 0 - ghost atom cutoff = 0 - binsize = 7.134, bins = 1 1 1 - 0 neighbor lists, perpetual/occasional/extra = 0 0 0 -Per MPI rank memory allocation (min/avg/max) = 2.3 | 2.3 | 2.3 Mbytes -Step Temp TotEng KinEng PotEng Lx Ly Lz Pxx Pyy Pzz Press - 0 298.24835 -69593.587 56.008365 -69649.595 7.134 7.134 7.134 -19980.19 -21024.038 -21097.458 -20700.562 - 1 295.24358 -69593.585 55.444098 -69649.029 7.134 7.134 7.134 -19778.833 -20799.657 -20854.156 -20477.549 - 2 286.37211 -69593.58 53.778115 -69647.358 7.134 7.134 7.134 -19227.52 -20177.28 -20176.12 -19860.306 - 3 272.062 -69593.572 51.090804 -69644.663 7.134 7.134 7.134 -18360.869 -19189.684 -19100.021 -18883.525 - 4 253.01834 -69593.561 47.514575 -69641.075 7.134 7.134 7.134 -17198.143 -17855.03 -17652.036 -17568.403 - 5 230.19242 -69593.547 43.228073 -69636.775 7.134 7.134 7.134 -15750.247 -16183.764 -15854.145 -15929.386 - 6 204.71787 -69593.533 38.44418 -69631.977 7.134 7.134 7.134 -14083.498 -14247.434 -13789.835 -14040.256 - 7 177.82397 -69593.518 33.393748 -69626.911 7.134 7.134 7.134 -12340.963 -12202.878 -11623.171 -12055.671 - 8 150.76736 -69593.503 28.312758 -69621.816 7.134 7.134 7.134 -10637.824 -10180.827 -9495.0496 -10104.567 - 9 124.7737 -69593.49 23.431383 -69616.921 7.134 7.134 7.134 -9113.3842 -8339.0492 -7572.8076 -8341.747 - 10 100.98183 -69593.478 18.963481 -69612.442 7.134 7.134 7.134 -7833.9349 -6756.9749 -5945.8968 -6845.6022 -Loop time of 2.20497 on 1 procs for 10 steps with 64 atoms - -Performance: 0.196 ns/day, 122.499 hours/ns, 4.535 timesteps/s -0.2% CPU use with 1 MPI tasks x no OpenMP threads - -MPI task timing breakdown: -Section | min time | avg time | max time |%varavg| %total ---------------------------------------------------------------- -Pair | 0 | 0 | 0 | 0.0 | 0.00 -Neigh | 1.4305e-06 | 1.4305e-06 | 1.4305e-06 | 0.0 | 0.00 -Comm | 4.22e-05 | 4.22e-05 | 4.22e-05 | 0.0 | 0.00 -Output | 0.00067687 | 0.00067687 | 0.00067687 | 0.0 | 0.03 -Modify | 2.2042 | 2.2042 | 2.2042 | 0.0 | 99.96 -Other | | 6.533e-05 | | | 0.00 - -Nlocal: 64 ave 64 max 64 min -Histogram: 1 0 0 0 0 0 0 0 0 0 -Nghost: 0 ave 0 max 0 min -Histogram: 1 0 0 0 0 0 0 0 0 0 -Neighs: 0 ave 0 max 0 min -Histogram: 1 0 0 0 0 0 0 0 0 0 - -Total # of neighbors = 0 -Ave neighs/atom = 0 -Neighbor list builds = 2 -Dangerous builds not checked -Total wall time: 0:00:02 diff --git a/examples/COUPLE/fortran_dftb/makefile b/examples/COUPLE/fortran_dftb/makefile deleted file mode 100644 index 225bd0025a..0000000000 --- a/examples/COUPLE/fortran_dftb/makefile +++ /dev/null @@ -1,45 +0,0 @@ -SHELL = /bin/sh - -# Path to LAMMPS extraction directory -LAMMPS_ROOT = ../../.. -LAMMPS_SRC = $(LAMMPS_ROOT)/src - -# Uncomment the line below if using the MPI stubs library -MPI_STUBS = #-I$(LAMMPS_SRC)/STUBS - -FC = mpif90 # replace with your Fortran compiler -CXX = mpicc # replace with your C++ compiler - -# Flags for Fortran compiler, C++ compiler, and C preprocessor, respectively -FFLAGS = -O2 -fPIC -CXXFLAGS = -O2 -fPIC -CPPFLAGS = -DOMPI_SKIP_MPICXX=1 -DMPICH_SKIP_MPICXX - -all : liblammps_fortran.a liblammps_fortran.so simpleF.x - -liblammps_fortran.so : LAMMPS.o LAMMPS-wrapper.o LAMMPS-wrapper2.o - $(FC) $(FFLAGS) -shared -o $@ $^ - -simpleF.x: simple.o LAMMPS.o LAMMPS-wrapper.o LAMMPS-wrapper2.o - $(FC) $(FFLAGS) simple.o -o simpleF.x liblammps_fortran.a $(LAMMPS_SRC)/liblammps_mvapich.a -lstdc++ /usr/lib64/libfftw3.a - -liblammps_fortran.a : LAMMPS.o LAMMPS-wrapper.o LAMMPS-wrapper2.o - $(AR) rs $@ $^ - -LAMMPS.o lammps.mod : LAMMPS.F90 - $(FC) $(CPPFLAGS) $(FFLAGS) -c $< - -simple.o : simple.f90 - $(FC) $(FFLAGS) -c $< - -LAMMPS-wrapper.o : LAMMPS-wrapper.cpp LAMMPS-wrapper.h - $(CXX) $(CPPFLAGS) $(CXXFLAGS) -c $< -I$(LAMMPS_SRC) $(MPI_STUBS) - -LAMMPS-wrapper2.o : LAMMPS-wrapper2.cpp LAMMPS-wrapper2.h - $(CXX) $(CPPFLAGS) $(CXXFLAGS) -c $< -I$(LAMMPS_SRC) $(MPI_STUBS) - -clean : - $(RM) *.o *.mod liblammps_fortran.a liblammps_fortran.so - -dist : - tar -czvf fortran-interface-callback.tar.gz LAMMPS-wrapper.h LAMMPS-wrapper.cpp LAMMPS-wrapper2.h LAMMPS-wrapper2.cpp LAMMPS.F90 makefile README simple.f90 diff --git a/examples/COUPLE/fortran_dftb/simple.f90 b/examples/COUPLE/fortran_dftb/simple.f90 deleted file mode 100644 index 4604b4e4a9..0000000000 --- a/examples/COUPLE/fortran_dftb/simple.f90 +++ /dev/null @@ -1,110 +0,0 @@ - module callback - implicit none - contains - subroutine fortran_callback(lmp, timestep, nlocal, ids, c_pos, c_fext) & - & bind(C, name='f_callback') - use, intrinsic :: ISO_C_binding - use LAMMPS - implicit none - type (C_ptr), value :: lmp - integer(C_int64_t), intent(in), value :: timestep - integer(C_int), intent(in), value :: nlocal - real (C_double), dimension(:,:), pointer :: x - type(c_ptr) :: c_pos, c_fext, c_ids - double precision, pointer :: fext(:,:), pos(:,:) - integer, intent(in) :: ids(nlocal) - real(C_double) :: virial(6) - real (C_double) :: etot - real(C_double), pointer :: ts_lmp - double precision :: stress(3,3), ts_dftb - integer :: natom , i - real (C_double), parameter :: econv = 627.4947284155114 ! converts from Ha to - double precision, parameter :: fconv = 1185.793095983065 ! converts from Ha/bohr to - double precision, parameter :: autoatm = 2.9037166638E8 - double precision lx, ly, lz - real (C_double), pointer :: boxxlo, boxxhi - real (C_double), pointer :: boxylo, boxyhi - real (C_double), pointer :: boxzlo, boxzhi - double precision, parameter :: nktv2p = 68568.4149999999935972 - double precision :: volume - type (C_ptr) :: Cptr - type (C_ptr), pointer, dimension(:) :: Catom - - call c_f_pointer(c_pos, pos, [3,nlocal]) - call c_f_pointer(c_fext, fext, [3,nlocal]) - call lammps_extract_global(boxxlo, lmp, 'boxxlo') - call lammps_extract_global(boxxhi, lmp, 'boxxhi') - call lammps_extract_global(boxylo, lmp, 'boxylo') - call lammps_extract_global(boxyhi, lmp, 'boxyhi') - call lammps_extract_global(boxzlo, lmp, 'boxzlo') - call lammps_extract_global(boxzhi, lmp, 'boxzhi') - lx = boxxhi - boxxlo - ly = boxyhi - boxylo - lz = boxzhi - boxzlo - volume = lx*ly*lz - open (unit = 10, status = 'replace', action = 'write', file='lammps.gen') - write(10,*)nlocal,"S" - write(10,*) "C" - do i = 1, nlocal - write(10,'(2I,3F15.6)')i,1,pos(:,ids(i)) - enddo - write(10,*)"0.0 0.0 0.0" - write(10,*)lx,0,0 - write(10,*)0,ly,0 - write(10,*)0,0,lz - close(10) - call system("./dftb+ > dftb.out") - open (unit = 10, status = 'old', file = 'results.out') - read(10,*)etot - read(10,*)ts_dftb - do i = 1, 3 - read(10,*)stress(i,:) - enddo - stress (:,:) = stress(:,:)*autoatm - virial(1) = stress(1,1)/(nktv2p/volume) - virial(2) = stress(2,2)/(nktv2p/volume) - virial(3) = stress(3,3)/(nktv2p/volume) - virial(4) = stress(1,2)/(nktv2p/volume) - virial(5) = stress(1,3)/(nktv2p/volume) - virial(6) = stress(2,3)/(nktv2p/volume) - etot = etot*econv - call lammps_set_external_vector(lmp,1,ts_dftb*econv) - do i = 1, nlocal - read(10,*)fext(:,ids(i)) - fext(:,ids(i)) = fext(:,ids(i))*fconv - enddo - close(10) - call lammps_set_user_energy (lmp, etot) - call lammps_set_user_virial (lmp, virial) - - end subroutine - end module callback - - -program simple_fortran_callback - - use MPI - use LAMMPS - use callback - use, intrinsic :: ISO_C_binding, only : C_double, C_ptr, C_int, C_FUNPTR - implicit none - type (C_ptr) :: lmp - integer :: error, narg, me, nprocs - - call MPI_Init (error) - call MPI_Comm_rank (MPI_COMM_WORLD, me, error) - call MPI_Comm_size (MPI_COMM_WORLD, nprocs, error) - - call lammps_open_no_mpi ('lmp -log log.simple', lmp) - call lammps_file (lmp, 'in.simple') - call lammps_set_callback(lmp) - call lammps_set_external_vector_length(lmp,2) - - call lammps_command (lmp, 'run 10') - call lammps_close (lmp) - call MPI_Finalize (error) - - -end program simple_fortran_callback - -