lijiext
/
lammps
mirror of https://github.com/lammps/lammps.git
1
0
Fork 1
Code Issues Packages Projects Releases Wiki Activity

make capitalization and whitespace fortran coding style more consistent

This commit is contained in:
Axel Kohlmeyer 2022-10-03 23:49:17 -04:00
parent 647c5e3572
commit 4e9b97d5cb
No known key found for this signature in database
GPG Key ID: D9B44E93BF0C375A
10 changed files with 449 additions and 444 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

211
fortran/lammps.f90
View File

@ -483,10 +483,10 @@ MODULE LIBLAMMPS
END FUNCTION lammps_version
SUBROUTINE lammps_get_os_info(buffer, buf_size) BIND(C)
IMPORT :: C_ptr, C_int
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(C_ptr), VALUE :: buffer
INTEGER(C_int), VALUE :: buf_size
TYPE(c_ptr), VALUE :: buffer
INTEGER(c_int), VALUE :: buf_size
END SUBROUTINE lammps_get_os_info
FUNCTION lammps_config_has_mpi_support() BIND(C)
@ -526,24 +526,24 @@ MODULE LIBLAMMPS
END FUNCTION lammps_config_has_exceptions
FUNCTION lammps_config_has_package(name) BIND(C)
IMPORT :: C_int, C_ptr
IMPORT :: c_int, c_ptr
IMPLICIT NONE
TYPE(C_ptr), VALUE :: name
TYPE(c_ptr), VALUE :: name
INTEGER(c_int) :: lammps_config_has_package
END FUNCTION lammps_config_has_package
FUNCTION lammps_config_package_count() BIND(C)
IMPORT :: C_int
IMPORT :: c_int
IMPLICIT NONE
INTEGER(C_int) :: lammps_config_package_count
INTEGER(c_int) :: lammps_config_package_count
END FUNCTION lammps_config_package_count
FUNCTION lammps_config_package_name(idx, buffer, buf_size) BIND(C)
IMPORT :: C_int, C_ptr
IMPORT :: c_int, c_ptr
IMPLICIT NONE
INTEGER(C_int) :: lammps_config_package_name
INTEGER(C_int), VALUE :: idx, buf_size
TYPE(C_ptr), VALUE :: buffer
INTEGER(c_int) :: lammps_config_package_name
INTEGER(c_int), VALUE :: idx, buf_size
TYPE(c_ptr), VALUE :: buffer
END FUNCTION lammps_config_package_name
!LOGICAL FUNCTION lammps_config_accelerator
@ -551,10 +551,10 @@ MODULE LIBLAMMPS
!SUBROUTINE lammps_get_gpu_device
!LOGICAL FUNCTION lammps_has_id
!INTEGER(C_int) FUNCTION lammps_id_count
!INTEGER(c_int) FUNCTION lammps_id_count
!SUBROUTINE lammps_id_name
!INTEGER(C_int) FUNCTION lammps_plugin_count
!INTEGER(c_int) FUNCTION lammps_plugin_count
!SUBROUTINE lammps_plugin_name
!Both of these use LAMMPS_BIGBIG
@ -572,9 +572,9 @@ MODULE LIBLAMMPS
!SUBROUTINE lammps_fix_external_set_vector
SUBROUTINE lammps_flush_buffers(handle) BIND(C)
IMPORT :: C_ptr
IMPORT :: c_ptr
IMPLICIT NONE
TYPE(C_ptr), VALUE :: handle
TYPE(c_ptr), VALUE :: handle
END SUBROUTINE lammps_flush_buffers
FUNCTION lammps_malloc(size) BIND(C, name='malloc')
@ -602,7 +602,7 @@ MODULE LIBLAMMPS
TYPE(c_ptr), VALUE :: handle
END SUBROUTINE lammps_force_timeout
INTEGER(C_int) FUNCTION lammps_has_error(handle) BIND(C)
INTEGER(c_int) FUNCTION lammps_has_error(handle) BIND(C)
IMPORT :: c_ptr, c_int
IMPLICIT NONE
TYPE(c_ptr), VALUE :: handle
@ -758,7 +758,7 @@ CONTAINS
REAL(c_double) FUNCTION lmp_get_thermo(self,name)
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*) :: name
TYPE(C_ptr) :: Cname
TYPE(c_ptr) :: Cname
Cname = f2c_string(name)
lmp_get_thermo = lammps_get_thermo(self%handle, Cname)
@ -771,27 +771,27 @@ CONTAINS
REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: boxlo(3), boxhi(3)
REAL(c_double), INTENT(OUT), TARGET, OPTIONAL :: xy, yz, xz
LOGICAL, INTENT(OUT), OPTIONAL :: pflags(3), boxflag
INTEGER(c_int), TARGET :: C_pflags(3), C_boxflag
INTEGER(c_int), TARGET :: c_pflags(3), c_boxflag
TYPE(c_ptr) :: ptr(7)
ptr = c_null_ptr
IF ( PRESENT(boxlo) ) ptr(1) = C_LOC(boxlo(1))
IF ( PRESENT(boxhi) ) ptr(2) = C_LOC(boxhi(1))
IF ( PRESENT(xy) ) ptr(3) = C_LOC(xy)
IF ( PRESENT(yz) ) ptr(4) = C_LOC(yz)
IF ( PRESENT(xz) ) ptr(5) = C_LOC(xz)
IF ( PRESENT(pflags) ) ptr(6) = C_LOC(C_pflags(1))
IF ( PRESENT(boxflag) ) ptr(7) = C_LOC(C_boxflag)
IF (PRESENT(boxlo)) ptr(1) = C_LOC(boxlo(1))
IF (PRESENT(boxhi)) ptr(2) = C_LOC(boxhi(1))
IF (PRESENT(xy)) ptr(3) = C_LOC(xy)
IF (PRESENT(yz)) ptr(4) = C_LOC(yz)
IF (PRESENT(xz)) ptr(5) = C_LOC(xz)
IF (PRESENT(pflags)) ptr(6) = C_LOC(c_pflags(1))
IF (PRESENT(boxflag)) ptr(7) = C_LOC(c_boxflag)
CALL lammps_extract_box(self%handle, ptr(1), ptr(2), ptr(3), ptr(4), &
ptr(5), ptr(6), ptr(7))
IF ( PRESENT(pflags) ) pflags = ( C_pflags /= 0_C_int )
IF ( PRESENT(boxflag) ) boxflag = ( C_boxflag /= 0_C_int )
IF (PRESENT(pflags)) pflags = (c_pflags /= 0_c_int)
IF (PRESENT(boxflag)) boxflag = (c_boxflag /= 0_c_int)
END SUBROUTINE lmp_extract_box
! equivalent function to lammps_reset_box
SUBROUTINE lmp_reset_box(self, boxlo, boxhi, xy, yz, xz)
CLASS(lammps), INTENT(IN) :: self
REAL(C_double), INTENT(IN) :: boxlo(3), boxhi(3), xy, yz, xz
REAL(c_double), INTENT(IN) :: boxlo(3), boxhi(3), xy, yz, xz
CALL lammps_reset_box(self%handle, boxlo, boxhi, xy, yz, xz)
END SUBROUTINE lmp_reset_box
@ -857,7 +857,7 @@ CONTAINS
global_data%lammps_instance => self
SELECT CASE (datatype)
CASE (LAMMPS_INT)
IF ( length == 1 ) THEN
IF (length == 1) THEN
global_data%datatype = DATA_INT
CALL C_F_POINTER(Cptr, global_data%i32)
ELSE
@ -865,7 +865,7 @@ CONTAINS
CALL C_F_POINTER(Cptr, global_data%i32_vec, [length])
END IF
CASE (LAMMPS_INT64)
IF ( length == 1 ) THEN
IF (length == 1) THEN
global_data%datatype = DATA_INT64
CALL C_F_POINTER(Cptr, global_data%i64)
ELSE
@ -873,7 +873,7 @@ CONTAINS
CALL C_F_POINTER(Cptr, global_data%i64_vec, [length])
END IF
CASE (LAMMPS_DOUBLE)
IF ( length == 1 ) THEN
IF (length == 1) THEN
global_data%datatype = DATA_DOUBLE
CALL C_F_POINTER(Cptr, global_data%r64)
ELSE
@ -884,8 +884,8 @@ CONTAINS
global_data%datatype = DATA_STRING
length = c_strlen(Cptr)
CALL C_F_POINTER(Cptr, Fptr, [length])
ALLOCATE ( CHARACTER(LEN=length) :: global_data%str )
FORALL ( i=1:length )
ALLOCATE(CHARACTER(LEN=length) :: global_data%str)
FORALL (i=1:length)
global_data%str(i:i) = Fptr(i)
END FORALL
CASE DEFAULT
@ -939,7 +939,7 @@ CONTAINS
CALL C_F_POINTER(Cptr, peratom_data%i64_vec, [ncols])
CASE (LAMMPS_DOUBLE)
peratom_data%datatype = DATA_DOUBLE_1D
IF ( name == 'mass' ) THEN
IF (name == 'mass') THEN
CALL C_F_POINTER(Cptr, dummy, [ncols])
peratom_data%r64_vec(0:) => dummy
ELSE
@ -978,7 +978,7 @@ CONTAINS
Cid = f2c_string(id)
Cptr = lammps_extract_compute(self%handle, Cid, style, type)
IF ( .NOT. C_ASSOCIATED(Cptr) ) THEN
IF (.NOT. C_ASSOCIATED(Cptr)) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'Pointer from LAMMPS is NULL [Fortran/extract_compute]')
END IF
@ -1046,8 +1046,8 @@ CONTAINS
! global data, as it would be if we could access the C++ array directly
Cnrow = -1
Cncol = -1
IF ( PRESENT(nrow) ) THEN
IF ( .NOT. PRESENT(ncol) ) THEN
IF (PRESENT(nrow)) THEN
IF (.NOT. PRESENT(ncol)) THEN
! Presumably the argument that's there is the vector length
Cnrow = nrow - 1_c_int
Cncol = -1_c_int
@ -1057,11 +1057,11 @@ CONTAINS
END IF
END IF
IF ( PRESENT(ncol) ) Cnrow = ncol - 1_c_int
IF (PRESENT(ncol)) Cnrow = ncol - 1_c_int
Cid = f2c_string(id)
Cptr = lammps_extract_fix(self%handle, Cid, style, type, Cnrow, Cncol)
IF ( .NOT. C_ASSOCIATED(Cptr) ) THEN
IF (.NOT. C_ASSOCIATED(Cptr)) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'Pointer from LAMMPS is NULL for fix id "' // id &
// '" [Fortran/extract_fix]')
@ -1082,7 +1082,7 @@ CONTAINS
& [Fortran/extract_fix]')
CASE (LMP_TYPE_VECTOR)
fix_data%datatype = DATA_DOUBLE_1D
IF ( STYLE == LMP_STYLE_ATOM ) THEN
IF (STYLE == LMP_STYLE_ATOM) THEN
nrows = self%extract_setting('nmax')
ELSE
Ctemp = lammps_extract_fix(self%handle, Cid, style, &
@ -1093,7 +1093,7 @@ CONTAINS
CALL C_F_POINTER(Cptr, fix_data%r64_vec, [nrows])
CASE (LMP_TYPE_ARRAY)
fix_data%datatype = DATA_DOUBLE_2D
IF ( STYLE == LMP_STYLE_ATOM ) THEN
IF (STYLE == LMP_STYLE_ATOM) THEN
! Fortran array is transposed relative to C
ncols = self%extract_setting('nmax')
Ctemp = lammps_extract_fix(self%handle, Cid, style, &
@ -1142,7 +1142,7 @@ CONTAINS
INTEGER(c_int), POINTER :: Clength => NULL()
Cname = f2c_string(name)
IF ( PRESENT(group) ) THEN
IF (PRESENT(group)) THEN
Cgroup = f2c_string(group)
ELSE
Cgroup = c_null_ptr
@ -1163,9 +1163,8 @@ CONTAINS
variable_data%datatype = DATA_DOUBLE_1D
length = lmp_extract_setting(self, 'nlocal')
CALL C_F_POINTER(Cptr, double_vec, [length])
IF ( ALLOCATED(variable_data%r64_vec) ) &
DEALLOCATE(variable_data%r64_vec)
ALLOCATE( variable_data%r64_vec(length) )
IF (ALLOCATED(variable_data%r64_vec)) DEALLOCATE(variable_data%r64_vec)
ALLOCATE(variable_data%r64_vec(length))
variable_data%r64_vec = double_vec
CALL lammps_free(Cptr)
CASE (LMP_VAR_VECTOR)
@ -1179,17 +1178,17 @@ CONTAINS
CALL lammps_free(Cname)
CALL lammps_free(Cveclength)
CALL C_F_POINTER(Cptr, double_vec, [length])
IF ( ALLOCATED(variable_data%r64_vec) ) &
IF (ALLOCATED(variable_data%r64_vec)) &
DEALLOCATE(variable_data%r64_vec)
ALLOCATE( variable_data%r64_vec(length) )
ALLOCATE(variable_data%r64_vec(length))
variable_data%r64_vec = double_vec
! DO NOT deallocate the C pointer
CASE (LMP_VAR_STRING)
variable_data%datatype = DATA_STRING
length = c_strlen(Cptr)
CALL C_F_POINTER(Cptr, Cstring, [length])
ALLOCATE ( CHARACTER(LEN=length) :: variable_data%str )
FORALL ( i=1:length )
ALLOCATE(CHARACTER(LEN=length) :: variable_data%str)
FORALL (i=1:length)
variable_data%str(i:i) = Cstring(i)
END FORALL
! DO NOT deallocate the C pointer
@ -1209,14 +1208,14 @@ CONTAINS
CLASS(lammps), INTENT(IN) :: self
CHARACTER(LEN=*), INTENT(IN) :: name, str
INTEGER :: err
TYPE(C_ptr) :: Cstr, Cname
TYPE(c_ptr) :: Cstr, Cname
Cstr = f2c_string(str)
Cname = f2c_string(name)
err = lammps_set_variable(self%handle, Cname, Cstr)
CALL lammps_free(Cname)
CALL lammps_free(Cstr)
IF ( err /= 0 ) THEN
IF (err /= 0) THEN
CALL lmp_error(self, LMP_ERROR_WARNING + LMP_ERROR_WORLD, &
'WARNING: unable to set string variable "' // name &
// '" [Fortran/set_variable]')
@ -1235,13 +1234,13 @@ CONTAINS
REAL(c_double) :: dnatoms
CHARACTER(LEN=100) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
IF (count /= 1 .AND. count /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms&
& requires "count" to be 1 or 3 [Fortran/gather_atoms]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
IF (dnatoms > HUGE(1_c_int)) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms]'
@ -1250,7 +1249,7 @@ CONTAINS
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
IF (ALLOCATED(data)) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms(self%handle, Cname, Ctype, count, Cdata)
@ -1266,16 +1265,16 @@ CONTAINS
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 1_c_int
REAL(C_double) :: dnatoms
REAL(c_double) :: dnatoms
CHARACTER(LEN=100) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
IF (count /= 1 .AND. count /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, 'gather_atoms&
& requires "count" to be 1 or 3 [Fortran/gather_atoms]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
IF (dnatoms > HUGE(1_c_int)) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms]'
@ -1284,7 +1283,7 @@ CONTAINS
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
IF (ALLOCATED(data)) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms(self%handle, Cname, Ctype, count, Cdata)
@ -1300,17 +1299,17 @@ CONTAINS
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 0_c_int
REAL(C_double) :: dnatoms
REAL(c_double) :: dnatoms
CHARACTER(LEN=100) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
IF (count /= 1 .AND. count /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'gather_atoms_concat requires "count" to be 1 or 3 &
&[Fortran/gather_atoms_concat]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
IF (dnatoms > HUGE(1_c_int)) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms_concat with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms_concat]'
@ -1319,7 +1318,7 @@ CONTAINS
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
IF (ALLOCATED(data)) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms_concat(self%handle, Cname, Ctype, count, Cdata)
@ -1335,17 +1334,17 @@ CONTAINS
TYPE(c_ptr) :: Cdata, Cname
INTEGER(c_int) :: natoms
INTEGER(c_int), PARAMETER :: Ctype = 1_c_int
REAL(C_double) :: dnatoms
REAL(c_double) :: dnatoms
CHARACTER(LEN=100) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
IF (count /= 1 .AND. count /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'gather_atoms_concat requires "count" to be 1 or 3 &
&[Fortran/gather_atoms_concat]')
END IF
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
IF (dnatoms > HUGE(1_c_int)) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function gather_atoms_concat with more than', &
HUGE(0_c_int), 'atoms [Fortran/gather_atoms_concat]'
@ -1354,7 +1353,7 @@ CONTAINS
natoms = NINT(dnatoms, c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
IF (ALLOCATED(data)) DEALLOCATE(data)
ALLOCATE(data(natoms*count))
Cdata = C_LOC(data(1))
CALL lammps_gather_atoms_concat(self%handle, Cname, Ctype, count, Cdata)
@ -1373,7 +1372,7 @@ CONTAINS
INTEGER(c_int), PARAMETER :: Ctype = 0_c_int
CHARACTER(LEN=100) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
IF (count /= 1 .AND. count /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'gather_atoms_subset requires "count" to be 1 or 3 &
&[Fortran/gather_atoms]')
@ -1382,7 +1381,7 @@ CONTAINS
ndata = SIZE(ids, KIND=c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
IF (ALLOCATED(data)) DEALLOCATE(data)
ALLOCATE(data(ndata*count))
data = -1_c_int
Cdata = C_LOC(data(1))
@ -1404,7 +1403,7 @@ CONTAINS
INTEGER(c_int), PARAMETER :: Ctype = 1_c_int
CHARACTER(LEN=100) :: error_msg
IF ( count /= 1 .AND. count /= 3 ) THEN
IF (count /= 1 .AND. count /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'gather_atoms_subset requires "count" to be 1 or 3 &
&[Fortran/gather_atoms]')
@ -1413,7 +1412,7 @@ CONTAINS
ndata = SIZE(ids, KIND=c_int)
Cname = f2c_string(name)
IF ( ALLOCATED(data) ) DEALLOCATE(data)
IF (ALLOCATED(data)) DEALLOCATE(data)
ALLOCATE(data(ndata*count))
Cdata = C_LOC(data(1))
Cids = C_LOC(ids(1))
@ -1434,7 +1433,7 @@ CONTAINS
CHARACTER(LEN=100) :: error_msg
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
IF (dnatoms > HUGE(1_c_int)) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function scatter_atoms with more than', &
HUGE(0_c_int), 'atoms [Fortran/scatter_atoms]'
@ -1446,7 +1445,7 @@ CONTAINS
Cdata = C_LOC(data(1))
Ccount = SIZE(data) / natoms
IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN
IF (Ccount /= 1 .AND. Ccount /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'lammps_scatter_atoms requires either 1 or 3 data per atom')
END IF
@ -1466,7 +1465,7 @@ CONTAINS
CHARACTER(LEN=100) :: error_msg
dnatoms = lmp_get_natoms(self)
IF ( dnatoms > HUGE(1_c_int) ) THEN
IF (dnatoms > HUGE(1_c_int)) THEN
WRITE(error_msg,'(A,1X,I0,1X,A)') &
'Cannot use library function scatter_atoms with more than', &
HUGE(0_c_int), 'atoms [Fortran/scatter_atoms]'
@ -1478,7 +1477,7 @@ CONTAINS
Cdata = C_LOC(data(1))
Ccount = SIZE(data) / natoms
IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN
IF (Ccount /= 1 .AND. Ccount /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'scatter_atoms requires either 1 or 3 data per atom &
&[Fortran/scatter_atoms]')
@ -1499,7 +1498,7 @@ CONTAINS
Cndata = SIZE(ids, KIND=c_int)
Ccount = SIZE(data, KIND=c_int) / Cndata
IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN
IF (Ccount /= 1 .AND. Ccount /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'scatter_atoms_subset requires either 1 or 3 data per atom')
END IF
@ -1524,7 +1523,7 @@ CONTAINS
Cndata = SIZE(ids, KIND=c_int)
Ccount = SIZE(data, KIND=c_int) / Cndata
IF ( Ccount /= 1 .AND. Ccount /= 3 ) THEN
IF (Ccount /= 1 .AND. Ccount /= 3) THEN
CALL lmp_error(self, LMP_ERROR_ALL + LMP_ERROR_WORLD, &
'scatter_atoms_subset requires either 1 or 3 data per atom')
END IF
@ -1557,7 +1556,7 @@ CONTAINS
buf_size = LEN(buffer)
CALL lammps_get_os_info(ptr, buf_size)
DO i=1,buf_size
IF ( Cbuffer(i) == C_NULL_CHAR ) EXIT
IF (Cbuffer(i) == c_null_char) EXIT
buffer(i:i) = Cbuffer(i)
END DO
END SUBROUTINE lmp_get_os_info
@ -1580,7 +1579,7 @@ CONTAINS
! equivalent function to lammps_config_has_png_support
LOGICAL FUNCTION lmp_config_has_png_support()
INTEGER(C_int) :: has_png_support
INTEGER(c_int) :: has_png_support
has_png_support = lammps_config_has_png_support()
lmp_config_has_png_support = (has_png_support /= 0_c_int)
@ -1634,10 +1633,10 @@ CONTAINS
Cidx = idx - 1
Cptr = C_LOC(Cbuffer(1))
Csuccess = lammps_config_package_name(Cidx, Cptr, LEN(buffer)+1)
buffer = ''
IF ( Csuccess /= 0_c_int ) THEN
buffer = ' '
IF (Csuccess /= 0_c_int) THEN
strlen = c_strlen(Cptr)
FORALL ( i = 1:strlen )
FORALL (i = 1:strlen)
buffer(i:i) = Cbuffer(i)
END FORALL
END IF
@ -1650,15 +1649,15 @@ CONTAINS
INTEGER, PARAMETER :: MAX_BUFFER_LENGTH = 31
INTEGER :: i, npackage, buf_length
IF ( PRESENT(length) ) THEN
IF (PRESENT(length)) THEN
buf_length = length
ELSE
buf_length = MAX_BUFFER_LENGTH
END IF
IF ( ALLOCATED(package) ) DEALLOCATE(package)
IF (ALLOCATED(package)) DEALLOCATE(package)
npackage = lammps_config_package_count()
ALLOCATE( CHARACTER(LEN=MAX_BUFFER_LENGTH) :: package(npackage) )
ALLOCATE(CHARACTER(LEN=MAX_BUFFER_LENGTH) :: package(npackage))
DO i=1, npackage
CALL lmp_config_package_name(i, package(i))
END DO
@ -1675,7 +1674,7 @@ CONTAINS
LOGICAL FUNCTION lmp_is_running(self)
CLASS(lammps), INTENT(IN) :: self
lmp_is_running = ( lammps_is_running(self%handle) /= 0_C_int )
lmp_is_running = (lammps_is_running(self%handle) /= 0_c_int)
END FUNCTION lmp_is_running
! equivalent function to lammps_force_timeout
@ -1705,7 +1704,7 @@ CONTAINS
CHARACTER(LEN=1, KIND=c_char), POINTER :: c_string(:)
buffer = ' '
IF ( lmp_has_error(self) ) THEN
IF (lmp_has_error(self)) THEN
buflen = LEN(buffer)
length = buflen
Cptr = lammps_malloc(length)
@ -1715,13 +1714,13 @@ CONTAINS
buffer(i:i) = c_string(i)
IF (c_string(i) == c_null_char) EXIT
END DO
IF ( PRESENT(status) ) THEN
IF (PRESENT(status)) THEN
status = Cstatus
END IF
CALL lammps_free(Cptr)
ELSE
buffer = ' '
IF ( PRESENT(status) ) THEN
IF (PRESENT(status)) THEN
status = 0
END IF
END IF
@ -1734,7 +1733,7 @@ CONTAINS
INTEGER(c_int), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_INT ) THEN
IF (rhs%datatype == DATA_INT) THEN
lhs => rhs%i32
ELSE
CALL assignment_error(rhs, 'scalar int')
@ -1745,7 +1744,7 @@ CONTAINS
INTEGER(c_int64_t), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_INT64 ) THEN
IF (rhs%datatype == DATA_INT64) THEN
lhs => rhs%i64
ELSE
CALL assignment_error(rhs, 'scalar long int')
@ -1756,7 +1755,7 @@ CONTAINS
INTEGER(c_int), DIMENSION(:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_INT_1D ) THEN
IF (rhs%datatype == DATA_INT_1D) THEN
lhs => rhs%i32_vec
ELSE
CALL assignment_error(rhs, 'vector of ints')
@ -1767,7 +1766,7 @@ CONTAINS
INTEGER(c_int64_t), DIMENSION(:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_INT64_1D ) THEN
IF (rhs%datatype == DATA_INT64_1D) THEN
lhs => rhs%i64_vec
ELSE
CALL assignment_error(rhs, 'vector of long ints')
@ -1778,7 +1777,7 @@ CONTAINS
REAL(c_double), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE ) THEN
IF (rhs%datatype == DATA_DOUBLE) THEN
lhs => rhs%r64
ELSE
CALL assignment_error(rhs, 'scalar double')
@ -1789,7 +1788,7 @@ CONTAINS
REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN
IF (rhs%datatype == DATA_DOUBLE_1D) THEN
lhs => rhs%r64_vec
ELSE
CALL assignment_error(rhs, 'vector of doubles')
@ -1800,7 +1799,7 @@ CONTAINS
REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN
IF (rhs%datatype == DATA_DOUBLE_2D) THEN
lhs => rhs%r64_mat
ELSE
CALL assignment_error(rhs, 'matrix of doubles')
@ -1811,9 +1810,9 @@ CONTAINS
CHARACTER(LEN=*), INTENT(OUT) :: lhs
CLASS(lammps_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_STRING ) THEN
IF (rhs%datatype == DATA_STRING) THEN
lhs = rhs%str
IF ( LEN_TRIM(rhs%str) > LEN(lhs) ) THEN
IF (LEN_TRIM(rhs%str) > LEN(lhs)) THEN
CALL lmp_error(rhs%lammps_instance, LMP_ERROR_WARNING, &
'String provided by user required truncation [Fortran API]')
END IF
@ -1829,7 +1828,7 @@ CONTAINS
REAL(c_double), INTENT(OUT) :: lhs
CLASS(lammps_fix_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE ) THEN
IF (rhs%datatype == DATA_DOUBLE) THEN
lhs = rhs%r64
ELSE
CALL assignment_error(rhs, 'scalar double')
@ -1840,7 +1839,7 @@ CONTAINS
REAL(c_double), DIMENSION(:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_fix_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN
IF (rhs%datatype == DATA_DOUBLE_1D) THEN
lhs => rhs%r64_vec
ELSE
CALL assignment_error(rhs, 'vector of doubles')
@ -1851,7 +1850,7 @@ CONTAINS
REAL(c_double), DIMENSION(:,:), INTENT(OUT), POINTER :: lhs
CLASS(lammps_fix_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE_2D ) THEN
IF (rhs%datatype == DATA_DOUBLE_2D) THEN
lhs => rhs%r64_mat
ELSE
CALL assignment_error(rhs, 'matrix of doubles')
@ -1865,7 +1864,7 @@ CONTAINS
REAL(c_double), INTENT(OUT) :: lhs
CLASS(lammps_variable_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE ) THEN
IF (rhs%datatype == DATA_DOUBLE) THEN
lhs = rhs%r64
ELSE
CALL assignment_error(rhs, 'scalar double')
@ -1876,9 +1875,9 @@ CONTAINS
REAL(c_double), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: lhs
CLASS(lammps_variable_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_DOUBLE_1D ) THEN
IF ( ALLOCATED(lhs) ) DEALLOCATE(lhs)
ALLOCATE( lhs(SIZE(rhs%r64_vec)) )
IF (rhs%datatype == DATA_DOUBLE_1D) THEN
IF (ALLOCATED(lhs)) DEALLOCATE(lhs)
ALLOCATE(lhs(SIZE(rhs%r64_vec)))
lhs = rhs%r64_vec
ELSE
CALL assignment_error(rhs, 'vector of doubles')
@ -1889,9 +1888,9 @@ CONTAINS
CHARACTER(LEN=*), INTENT(OUT) :: lhs
CLASS(lammps_variable_data), INTENT(IN) :: rhs
IF ( rhs%datatype == DATA_STRING ) THEN
IF (rhs%datatype == DATA_STRING) THEN
lhs = rhs%str
IF ( LEN_TRIM(rhs%str) > LEN(lhs) ) THEN
IF (LEN_TRIM(rhs%str) > LEN(lhs)) THEN
CALL lmp_error(rhs%lammps_instance, LMP_ERROR_WARNING, &
'String provided by user required truncation [Fortran API]')
END IF

42
unittest/fortran/test_fortran_box.f90
View File

@ -23,7 +23,7 @@ SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close")
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_box_setup () BIND(C)
SUBROUTINE f_lammps_box_setup() BIND(C)
USE liblammps
USE keepstuff, ONLY : lmp, demo_input
IMPLICIT NONE
@ -39,84 +39,84 @@ SUBROUTINE f_lammps_delete_everything() BIND(C)
CALL lmp%command("delete_atoms group all");
END SUBROUTINE f_lammps_delete_everything
FUNCTION f_lammps_extract_box_xlo () BIND(C)
FUNCTION f_lammps_extract_box_xlo() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_extract_box_xlo
REAL (c_double) :: boxdim(3)
REAL(c_double) :: f_lammps_extract_box_xlo
REAL(c_double) :: boxdim(3)
CALL lmp%extract_box(boxlo=boxdim)
f_lammps_extract_box_xlo = boxdim(1)
END FUNCTION f_lammps_extract_box_xlo
FUNCTION f_lammps_extract_box_xhi () BIND(C)
FUNCTION f_lammps_extract_box_xhi() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_extract_box_xhi
REAL (c_double) :: boxdim(3)
REAL(c_double) :: f_lammps_extract_box_xhi
REAL(c_double) :: boxdim(3)
CALL lmp%extract_box(boxhi=boxdim)
f_lammps_extract_box_xhi = boxdim(1)
END FUNCTION f_lammps_extract_box_xhi
FUNCTION f_lammps_extract_box_ylo () BIND(C)
FUNCTION f_lammps_extract_box_ylo() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_extract_box_ylo
REAL (c_double) :: boxdim(3)
REAL(c_double) :: f_lammps_extract_box_ylo
REAL(c_double) :: boxdim(3)
CALL lmp%extract_box(boxlo=boxdim)
f_lammps_extract_box_ylo = boxdim(2)
END FUNCTION f_lammps_extract_box_ylo
FUNCTION f_lammps_extract_box_yhi () BIND(C)
FUNCTION f_lammps_extract_box_yhi() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_extract_box_yhi
REAL (c_double) :: boxdim(3)
REAL(c_double) :: f_lammps_extract_box_yhi
REAL(c_double) :: boxdim(3)
CALL lmp%extract_box(boxhi=boxdim)
f_lammps_extract_box_yhi = boxdim(2)
END FUNCTION f_lammps_extract_box_yhi
FUNCTION f_lammps_extract_box_zlo () BIND(C)
FUNCTION f_lammps_extract_box_zlo() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_extract_box_zlo
REAL (c_double) :: boxdim(3)
REAL(c_double) :: f_lammps_extract_box_zlo
REAL(c_double) :: boxdim(3)
CALL lmp%extract_box(boxlo=boxdim)
f_lammps_extract_box_zlo = boxdim(2)
END FUNCTION f_lammps_extract_box_zlo
FUNCTION f_lammps_extract_box_zhi () BIND(C)
FUNCTION f_lammps_extract_box_zhi() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_extract_box_zhi
REAL (c_double) :: boxdim(3)
REAL(c_double) :: f_lammps_extract_box_zhi
REAL(c_double) :: boxdim(3)
CALL lmp%extract_box(boxhi=boxdim)
f_lammps_extract_box_zhi = boxdim(2)
END FUNCTION f_lammps_extract_box_zhi
SUBROUTINE f_lammps_reset_box_2x () BIND(C)
SUBROUTINE f_lammps_reset_box_2x() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: newlo(3), newhi(3), xy, yz, xz
REAL(c_double) :: newlo(3), newhi(3), xy, yz, xz
xy = 0.0_c_double
yz = 0.0_c_double

66
unittest/fortran/test_fortran_extract_atom.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close")
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_atom () BIND(C)
SUBROUTINE f_lammps_setup_extract_atom() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input
IMPLICIT NONE
@ -32,91 +32,91 @@ SUBROUTINE f_lammps_setup_extract_atom () BIND(C)
CALL lmp%commands_list(pair_input)
END SUBROUTINE f_lammps_setup_extract_atom
FUNCTION f_lammps_extract_atom_mass () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_atom_mass() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL(C_double) :: f_lammps_extract_atom_mass
REAL(C_double), DIMENSION(:), POINTER :: mass => NULL()
REAL(c_double) :: f_lammps_extract_atom_mass
REAL(c_double), DIMENSION(:), POINTER :: mass => NULL()
mass = lmp%extract_atom('mass')
f_lammps_extract_atom_mass = mass(1)
END FUNCTION f_lammps_extract_atom_mass
FUNCTION f_lammps_extract_atom_tag_int (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_atom_tag_int(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_tag_int
INTEGER(C_int), DIMENSION(:), POINTER :: tag => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i
INTEGER(c_int) :: f_lammps_extract_atom_tag_int
INTEGER(c_int), DIMENSION(:), POINTER :: tag => NULL()
tag = lmp%extract_atom('id')
f_lammps_extract_atom_tag_int = tag(i)
END FUNCTION f_lammps_extract_atom_tag_int
FUNCTION f_lammps_extract_atom_tag_int64 (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int64_t
FUNCTION f_lammps_extract_atom_tag_int64(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int64_t
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int64_t), INTENT(IN), VALUE :: i
INTEGER(C_int64_t) :: f_lammps_extract_atom_tag_int64
INTEGER(C_int64_t), DIMENSION(:), POINTER :: tag => NULL()
INTEGER(c_int64_t), INTENT(IN), VALUE :: i
INTEGER(c_int64_t) :: f_lammps_extract_atom_tag_int64
INTEGER(c_int64_t), DIMENSION(:), POINTER :: tag => NULL()
tag = lmp%extract_atom('id')
f_lammps_extract_atom_tag_int64 = tag(i)
END FUNCTION f_lammps_extract_atom_tag_int64
FUNCTION f_lammps_extract_atom_type(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_type
INTEGER(C_int), DIMENSION(:), POINTER :: atype => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i
INTEGER(c_int) :: f_lammps_extract_atom_type
INTEGER(c_int), DIMENSION(:), POINTER :: atype => NULL()
atype = lmp%extract_atom('type')
f_lammps_extract_atom_type = atype(i)
END FUNCTION f_lammps_extract_atom_type
FUNCTION f_lammps_extract_atom_mask(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
INTEGER(C_int) :: f_lammps_extract_atom_mask
INTEGER(C_int), DIMENSION(:), POINTER :: mask => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i
INTEGER(c_int) :: f_lammps_extract_atom_mask
INTEGER(c_int), DIMENSION(:), POINTER :: mask => NULL()
mask = lmp%extract_atom('mask')
f_lammps_extract_atom_mask = mask(i)
END FUNCTION f_lammps_extract_atom_mask
SUBROUTINE f_lammps_extract_atom_x (i, x) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
SUBROUTINE f_lammps_extract_atom_x(i, x) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double), DIMENSION(3) :: x
REAL(C_double), DIMENSION(:,:), POINTER :: xptr => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double), DIMENSION(3) :: x
REAL(c_double), DIMENSION(:,:), POINTER :: xptr => NULL()
xptr = lmp%extract_atom('x')
x = xptr(:,i)
END SUBROUTINE f_lammps_extract_atom_x
SUBROUTINE f_lammps_extract_atom_v (i, v) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
SUBROUTINE f_lammps_extract_atom_v(i, v) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double), DIMENSION(3) :: v
REAL(C_double), DIMENSION(:,:), POINTER :: vptr => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double), DIMENSION(3) :: v
REAL(c_double), DIMENSION(:,:), POINTER :: vptr => NULL()
vptr = lmp%extract_atom('v')
v = vptr(:,i)

62
unittest/fortran/test_fortran_extract_compute.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C)
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_compute () BIND(C)
SUBROUTINE f_lammps_setup_extract_compute() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input, pair_input
IMPLICIT NONE
@ -42,91 +42,91 @@ SUBROUTINE f_lammps_setup_extract_compute () BIND(C)
CALL lmp%command("run 0") ! must be here, otherwise will SEGFAULT
END SUBROUTINE f_lammps_setup_extract_compute
FUNCTION f_lammps_extract_compute_peratom_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_peratom_vector(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_compute_peratom_vector
REAL(C_double), DIMENSION(:), POINTER :: vector => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double) :: f_lammps_extract_compute_peratom_vector
REAL(c_double), DIMENSION(:), POINTER :: vector => NULL()
vector = lmp%extract_compute('peratompe', lmp%style%atom, lmp%type%vector)
f_lammps_extract_compute_peratom_vector = vector(i)
END FUNCTION f_lammps_extract_compute_peratom_vector
FUNCTION f_lammps_extract_compute_peratom_array (i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_peratom_array(i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_compute_peratom_array
REAL(C_double), DIMENSION(:,:), POINTER :: array => NULL()
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(c_double) :: f_lammps_extract_compute_peratom_array
REAL(c_double), DIMENSION(:,:), POINTER :: array => NULL()
array = lmp%extract_compute('stress', lmp%style%atom, lmp%type%array)
f_lammps_extract_compute_peratom_array = array(i,j)
END FUNCTION f_lammps_extract_compute_peratom_array
FUNCTION f_lammps_extract_compute_global_scalar () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_global_scalar() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL(C_double) :: f_lammps_extract_compute_global_scalar
REAL(C_double), POINTER :: scalar
REAL(c_double) :: f_lammps_extract_compute_global_scalar
REAL(c_double), POINTER :: scalar
scalar = lmp%extract_compute('totalpe', lmp%style%global, lmp%type%scalar)
f_lammps_extract_compute_global_scalar = scalar
END FUNCTION f_lammps_extract_compute_global_scalar
FUNCTION f_lammps_extract_compute_global_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_global_vector(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_compute_global_vector
REAL(C_double), DIMENSION(:), POINTER :: vector
REAL(c_double) :: f_lammps_extract_compute_global_vector
REAL(c_double), DIMENSION(:), POINTER :: vector
vector = lmp%extract_compute('COM', lmp%style%global, lmp%type%vector)
f_lammps_extract_compute_global_vector = vector(i)
END FUNCTION f_lammps_extract_compute_global_vector
FUNCTION f_lammps_extract_compute_global_array (i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_global_array(i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_compute_global_array
REAL(C_double), DIMENSION(:,:), POINTER :: array
REAL(c_double) :: f_lammps_extract_compute_global_array
REAL(c_double), DIMENSION(:,:), POINTER :: array
array = lmp%extract_compute('RDF', lmp%style%global, lmp%type%array)
f_lammps_extract_compute_global_array = array(i,j)
END FUNCTION f_lammps_extract_compute_global_array
FUNCTION f_lammps_extract_compute_local_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_local_vector(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_compute_local_vector
REAL(C_double), DIMENSION(:), POINTER :: vector
REAL(c_double) :: f_lammps_extract_compute_local_vector
REAL(c_double), DIMENSION(:), POINTER :: vector
vector = lmp%extract_compute('pairdist', lmp%style%local, lmp%type%vector)
f_lammps_extract_compute_local_vector = vector(i)
END FUNCTION f_lammps_extract_compute_local_vector
FUNCTION f_lammps_extract_compute_local_array (i, j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_compute_local_array(i, j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_compute_local_array
REAL(C_double), DIMENSION(:,:), POINTER :: array
REAL(c_double) :: f_lammps_extract_compute_local_array
REAL(c_double), DIMENSION(:,:), POINTER :: array
array = lmp%extract_compute('pairlocal', lmp%style%local, lmp%type%array)
f_lammps_extract_compute_local_array = array(i,j)

44
unittest/fortran/test_fortran_extract_fix.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C)
lmp%handle = C_NULL_PTR
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_fix () BIND(C)
SUBROUTINE f_lammps_setup_extract_fix() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input, more_input
IMPLICIT NONE
@ -40,59 +40,59 @@ SUBROUTINE f_lammps_setup_extract_fix () BIND(C)
CALL lmp%command("run 1") ! must be 1, otherwise move/recenter won't happen
END SUBROUTINE f_lammps_setup_extract_fix
FUNCTION f_lammps_extract_fix_global_scalar () BIND(C) RESULT(scalar)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_fix_global_scalar() BIND(C) RESULT(scalar)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL(C_double) :: scalar
REAL(c_double) :: scalar
scalar = lmp%extract_fix("recenter", lmp%style%global, lmp%type%scalar)
END FUNCTION f_lammps_extract_fix_global_scalar
FUNCTION f_lammps_extract_fix_global_vector (i) BIND(C) RESULT(element)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_fix_global_vector(i) BIND(C) RESULT(element)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double) :: element
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double) :: element
element = lmp%extract_fix("recenter", lmp%style%global, lmp%type%vector, i)
END FUNCTION f_lammps_extract_fix_global_vector
FUNCTION f_lammps_extract_fix_global_array (i,j) BIND(C) RESULT(element)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_fix_global_array(i,j) BIND(C) RESULT(element)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: element
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(c_double) :: element
element = lmp%extract_fix("vec", lmp%style%global, lmp%type%array, i, j)
END FUNCTION f_lammps_extract_fix_global_array
FUNCTION f_lammps_extract_fix_peratom_vector (i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_fix_peratom_vector(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i
REAL(C_double) :: f_lammps_extract_fix_peratom_vector
REAL(C_double), DIMENSION(:), POINTER :: vector
INTEGER(c_int), INTENT(IN), VALUE :: i
REAL(c_double) :: f_lammps_extract_fix_peratom_vector
REAL(c_double), DIMENSION(:), POINTER :: vector
vector = lmp%extract_fix("state", lmp%style%atom, lmp%type%vector, -1, -1)
f_lammps_extract_fix_peratom_vector = vector(i)
END FUNCTION f_lammps_extract_fix_peratom_vector
FUNCTION f_lammps_extract_fix_peratom_array (i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
FUNCTION f_lammps_extract_fix_peratom_array(i,j) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER(C_int), INTENT(IN), VALUE :: i, j
REAL(C_double) :: f_lammps_extract_fix_peratom_array
REAL(C_double), DIMENSION(:,:), POINTER :: array
INTEGER(c_int), INTENT(IN), VALUE :: i, j
REAL(c_double) :: f_lammps_extract_fix_peratom_array
REAL(c_double), DIMENSION(:,:), POINTER :: array
array = lmp%extract_fix("move", lmp%style%atom, lmp%type%array, -1, -1)
f_lammps_extract_fix_peratom_array = array(i,j)

298
unittest/fortran/test_fortran_extract_global.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C, name="f_lammps_close")
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_extract_global () BIND(C)
SUBROUTINE f_lammps_setup_extract_global() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input
IMPLICIT NONE
@ -33,12 +33,12 @@ SUBROUTINE f_lammps_setup_extract_global () BIND(C)
CALL lmp%command('run 0')
END SUBROUTINE f_lammps_setup_extract_global
SUBROUTINE f_lammps_setup_full_extract_global () BIND(C)
SUBROUTINE f_lammps_setup_full_extract_global() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTERFACE
SUBROUTINE f_lammps_setup_extract_global () BIND(C)
SUBROUTINE f_lammps_setup_extract_global() BIND(C)
END SUBROUTINE f_lammps_setup_extract_global
END INTERFACE
@ -50,422 +50,428 @@ SUBROUTINE f_lammps_setup_full_extract_global () BIND(C)
CALL lmp%command('run 0')
END SUBROUTINE f_lammps_setup_full_extract_global
FUNCTION f_lammps_extract_global_units () BIND(C) RESULT(success)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_units() BIND(C) RESULT(success)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER (C_int) :: success
CHARACTER (LEN=16) :: units
INTEGER(c_int) :: success
CHARACTER(LEN=16) :: units
! passing strings from Fortran to C is icky, so we do the test here and
! report the result instead
units = lmp%extract_global('units')
IF ( TRIM(units) == 'lj' ) THEN
success = 1_C_int
IF (TRIM(units) == 'lj') THEN
success = 1_c_int
ELSE
success = 0_C_int
success = 0_c_int
END IF
END FUNCTION f_lammps_extract_global_units
FUNCTION f_lammps_extract_global_ntimestep () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_ntimestep() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: ntimestep
INTEGER (C_int) :: f_lammps_extract_global_ntimestep
INTEGER(c_int), POINTER :: ntimestep
INTEGER(c_int) :: f_lammps_extract_global_ntimestep
ntimestep = lmp%extract_global("ntimestep")
f_lammps_extract_global_ntimestep = ntimestep
END FUNCTION f_lammps_extract_global_ntimestep
FUNCTION f_lammps_extract_global_ntimestep_big () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
FUNCTION f_lammps_extract_global_ntimestep_big() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int64_t), POINTER :: ntimestep
INTEGER (C_int64_t) :: f_lammps_extract_global_ntimestep_big
INTEGER(c_int64_t), POINTER :: ntimestep
INTEGER(c_int64_t) :: f_lammps_extract_global_ntimestep_big
ntimestep = lmp%extract_global("ntimestep")
f_lammps_extract_global_ntimestep_big = ntimestep
END FUNCTION f_lammps_extract_global_ntimestep_big
FUNCTION f_lammps_extract_global_dt () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_dt() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double), POINTER :: dt
REAL (C_double) :: f_lammps_extract_global_dt
REAL(c_double), POINTER :: dt
REAL(c_double) :: f_lammps_extract_global_dt
dt = lmp%extract_global("dt")
f_lammps_extract_global_dt = dt
END FUNCTION f_lammps_extract_global_dt
SUBROUTINE f_lammps_extract_global_boxlo (C_boxlo) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
SUBROUTINE f_lammps_extract_global_boxlo(C_boxlo) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double), DIMENSION(3) :: C_boxlo
REAL (C_double), DIMENSION(:), POINTER :: boxlo
REAL(c_double), DIMENSION(3) :: C_boxlo
REAL(c_double), DIMENSION(:), POINTER :: boxlo
boxlo = lmp%extract_global("boxlo")
C_boxlo = boxlo
END SUBROUTINE f_lammps_extract_global_boxlo
SUBROUTINE f_lammps_extract_global_boxhi (C_boxhi) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
SUBROUTINE f_lammps_extract_global_boxhi(C_boxhi) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double), DIMENSION(3) :: C_boxhi
REAL (C_double), DIMENSION(:), POINTER :: boxhi
REAL(c_double), DIMENSION(3) :: C_boxhi
REAL(c_double), DIMENSION(:), POINTER :: boxhi
boxhi = lmp%extract_global("boxhi")
C_boxhi = boxhi
END SUBROUTINE f_lammps_extract_global_boxhi
FUNCTION f_lammps_extract_global_boxxlo () BIND(C) RESULT(C_boxxlo)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boxxlo() BIND(C) RESULT(C_boxxlo)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_boxxlo
REAL (C_double), POINTER :: boxxlo
REAL(c_double) :: C_boxxlo
REAL(c_double), POINTER :: boxxlo
boxxlo = lmp%extract_global("boxxlo")
C_boxxlo = boxxlo
END FUNCTION f_lammps_extract_global_boxxlo
FUNCTION f_lammps_extract_global_boxxhi () BIND(C) RESULT(C_boxxhi)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boxxhi() BIND(C) RESULT(C_boxxhi)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_boxxhi
REAL (C_double), POINTER :: boxxhi
REAL(c_double) :: C_boxxhi
REAL(c_double), POINTER :: boxxhi
boxxhi = lmp%extract_global("boxxhi")
C_boxxhi = boxxhi
END FUNCTION f_lammps_extract_global_boxxhi
FUNCTION f_lammps_extract_global_boxylo () BIND(C) RESULT(C_boxylo)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boxylo() BIND(C) RESULT(C_boxylo)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_boxylo
REAL (C_double), POINTER :: boxylo
REAL(c_double) :: C_boxylo
REAL(c_double), POINTER :: boxylo
boxylo = lmp%extract_global("boxylo")
C_boxylo = boxylo
END FUNCTION f_lammps_extract_global_boxylo
FUNCTION f_lammps_extract_global_boxyhi () BIND(C) RESULT(C_boxyhi)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boxyhi() BIND(C) RESULT(C_boxyhi)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_boxyhi
REAL (C_double), POINTER :: boxyhi
REAL(c_double) :: C_boxyhi
REAL(c_double), POINTER :: boxyhi
boxyhi = lmp%extract_global("boxyhi")
C_boxyhi = boxyhi
END FUNCTION f_lammps_extract_global_boxyhi
FUNCTION f_lammps_extract_global_boxzlo () BIND(C) RESULT(C_boxzlo)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boxzlo() BIND(C) RESULT(C_boxzlo)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_boxzlo
REAL (C_double), POINTER :: boxzlo
REAL(c_double) :: C_boxzlo
REAL(c_double), POINTER :: boxzlo
boxzlo = lmp%extract_global("boxzlo")
C_boxzlo = boxzlo
END FUNCTION f_lammps_extract_global_boxzlo
FUNCTION f_lammps_extract_global_boxzhi () BIND(C) RESULT(C_boxzhi)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boxzhi() BIND(C) RESULT(C_boxzhi)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_boxzhi
REAL (C_double), POINTER :: boxzhi
REAL(c_double) :: C_boxzhi
REAL(c_double), POINTER :: boxzhi
boxzhi = lmp%extract_global("boxzhi")
C_boxzhi = boxzhi
END FUNCTION f_lammps_extract_global_boxzhi
SUBROUTINE f_lammps_extract_global_periodicity (C_periodicity) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
SUBROUTINE f_lammps_extract_global_periodicity(C_periodicity) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), DIMENSION(3) :: C_periodicity
INTEGER (C_int), DIMENSION(:), POINTER :: periodicity
INTEGER(c_int), DIMENSION(3) :: C_periodicity
INTEGER(c_int), DIMENSION(:), POINTER :: periodicity
periodicity = lmp%extract_global("periodicity")
C_periodicity = periodicity
END SUBROUTINE f_lammps_extract_global_periodicity
FUNCTION f_lammps_extract_global_triclinic () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_triclinic() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: triclinic
INTEGER (C_int) :: f_lammps_extract_global_triclinic
INTEGER(c_int), POINTER :: triclinic
INTEGER(c_int) :: f_lammps_extract_global_triclinic
triclinic = lmp%extract_global("triclinic")
f_lammps_extract_global_triclinic = triclinic
END FUNCTION f_lammps_extract_global_triclinic
FUNCTION f_lammps_extract_global_xy () BIND(C) RESULT(C_xy)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_xy() BIND(C) RESULT(C_xy)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_xy
REAL (C_double), POINTER :: xy
REAL(c_double) :: C_xy
REAL(c_double), POINTER :: xy
xy = lmp%extract_global("xy")
C_xy = xy
END FUNCTION f_lammps_extract_global_xy
FUNCTION f_lammps_extract_global_xz () BIND(C) RESULT(C_xz)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_xz() BIND(C) RESULT(C_xz)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_xz
REAL (C_double), POINTER :: xz
REAL(c_double) :: C_xz
REAL(c_double), POINTER :: xz
xz = lmp%extract_global("xz")
C_xz = xz
END FUNCTION f_lammps_extract_global_xz
FUNCTION f_lammps_extract_global_yz () BIND(C) RESULT(C_yz)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_yz() BIND(C) RESULT(C_yz)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_yz
REAL (C_double), POINTER :: yz
REAL(c_double) :: C_yz
REAL(c_double), POINTER :: yz
yz = lmp%extract_global("yz")
C_yz = yz
END FUNCTION f_lammps_extract_global_yz
FUNCTION f_lammps_extract_global_natoms () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_natoms() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: natoms
INTEGER (C_int) :: f_lammps_extract_global_natoms
INTEGER(c_int), POINTER :: natoms
INTEGER(c_int) :: f_lammps_extract_global_natoms
natoms = lmp%extract_global("natoms")
f_lammps_extract_global_natoms = natoms
END FUNCTION f_lammps_extract_global_natoms
FUNCTION f_lammps_extract_global_natoms_big () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
FUNCTION f_lammps_extract_global_natoms_big() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int64_t), POINTER :: natoms
INTEGER (C_int64_t) :: f_lammps_extract_global_natoms_big
INTEGER(c_int64_t), POINTER :: natoms
INTEGER(c_int64_t) :: f_lammps_extract_global_natoms_big
natoms = lmp%extract_global("natoms")
f_lammps_extract_global_natoms_big = natoms
END FUNCTION f_lammps_extract_global_natoms_big
FUNCTION f_lammps_extract_global_nbonds () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_nbonds() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: nbonds
INTEGER (C_int) :: f_lammps_extract_global_nbonds
INTEGER(c_int), POINTER :: nbonds
INTEGER(c_int) :: f_lammps_extract_global_nbonds
nbonds = lmp%extract_global("nbonds")
f_lammps_extract_global_nbonds = nbonds
END FUNCTION f_lammps_extract_global_nbonds
FUNCTION f_lammps_extract_global_nbonds_big () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
FUNCTION f_lammps_extract_global_nbonds_big() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int64_t), POINTER :: nbonds
INTEGER (C_int64_t) :: f_lammps_extract_global_nbonds_big
INTEGER(c_int64_t), POINTER :: nbonds
INTEGER(c_int64_t) :: f_lammps_extract_global_nbonds_big
nbonds = lmp%extract_global("nbonds")
f_lammps_extract_global_nbonds_big = nbonds
END FUNCTION f_lammps_extract_global_nbonds_big
FUNCTION f_lammps_extract_global_nangles () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_nangles() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: nangles
INTEGER (C_int) :: f_lammps_extract_global_nangles
INTEGER(c_int), POINTER :: nangles
INTEGER(c_int) :: f_lammps_extract_global_nangles
nangles = lmp%extract_global("nangles")
f_lammps_extract_global_nangles = nangles
END FUNCTION f_lammps_extract_global_nangles
FUNCTION f_lammps_extract_global_nangles_big () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
FUNCTION f_lammps_extract_global_nangles_big() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int64_t), POINTER :: nangles
INTEGER (C_int64_t) :: f_lammps_extract_global_nangles_big
INTEGER(c_int64_t), POINTER :: nangles
INTEGER(c_int64_t) :: f_lammps_extract_global_nangles_big
nangles = lmp%extract_global("nangles")
f_lammps_extract_global_nangles_big = nangles
END FUNCTION f_lammps_extract_global_nangles_big
FUNCTION f_lammps_extract_global_ndihedrals () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_ndihedrals() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: ndihedrals
INTEGER (C_int) :: f_lammps_extract_global_ndihedrals
INTEGER(c_int), POINTER :: ndihedrals
INTEGER(c_int) :: f_lammps_extract_global_ndihedrals
ndihedrals = lmp%extract_global("ndihedrals")
f_lammps_extract_global_ndihedrals = ndihedrals
END FUNCTION f_lammps_extract_global_ndihedrals
FUNCTION f_lammps_extract_global_ndihedrals_big () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
FUNCTION f_lammps_extract_global_ndihedrals_big() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int64_t), POINTER :: ndihedrals
INTEGER (C_int64_t) :: f_lammps_extract_global_ndihedrals_big
INTEGER(c_int64_t), POINTER :: ndihedrals
INTEGER(c_int64_t) :: f_lammps_extract_global_ndihedrals_big
ndihedrals = lmp%extract_global("ndihedrals")
f_lammps_extract_global_ndihedrals_big = ndihedrals
END FUNCTION f_lammps_extract_global_ndihedrals_big
FUNCTION f_lammps_extract_global_nimpropers () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_nimpropers() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: nimpropers
INTEGER (C_int) :: f_lammps_extract_global_nimpropers
INTEGER(c_int), POINTER :: nimpropers
INTEGER(c_int) :: f_lammps_extract_global_nimpropers
nimpropers = lmp%extract_global("nimpropers")
f_lammps_extract_global_nimpropers = nimpropers
END FUNCTION f_lammps_extract_global_nimpropers
FUNCTION f_lammps_extract_global_nimpropers_big () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int64_t
FUNCTION f_lammps_extract_global_nimpropers_big() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int64_t
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int64_t), POINTER :: nimpropers
INTEGER (C_int64_t) :: f_lammps_extract_global_nimpropers_big
INTEGER(c_int64_t), POINTER :: nimpropers
INTEGER(c_int64_t) :: f_lammps_extract_global_nimpropers_big
nimpropers = lmp%extract_global("nimpropers")
f_lammps_extract_global_nimpropers_big = nimpropers
END FUNCTION f_lammps_extract_global_nimpropers_big
FUNCTION f_lammps_extract_global_ntypes () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_ntypes() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: ntypes
INTEGER (C_int) :: f_lammps_extract_global_ntypes
INTEGER(c_int), POINTER :: ntypes
INTEGER(c_int) :: f_lammps_extract_global_ntypes
ntypes = lmp%extract_global("ntypes")
f_lammps_extract_global_ntypes = ntypes
END FUNCTION f_lammps_extract_global_ntypes
FUNCTION f_lammps_extract_global_nlocal () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_nlocal() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: nlocal
INTEGER (C_int) :: f_lammps_extract_global_nlocal
INTEGER(c_int), POINTER :: nlocal
INTEGER(c_int) :: f_lammps_extract_global_nlocal
nlocal = lmp%extract_global("nlocal")
f_lammps_extract_global_nlocal = nlocal
END FUNCTION f_lammps_extract_global_nlocal
FUNCTION f_lammps_extract_global_nghost () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_nghost() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: nghost
INTEGER (C_int) :: f_lammps_extract_global_nghost
INTEGER(c_int), POINTER :: nghost
INTEGER(c_int) :: f_lammps_extract_global_nghost
nghost = lmp%extract_global("nghost")
f_lammps_extract_global_nghost = nghost
END FUNCTION f_lammps_extract_global_nghost
FUNCTION f_lammps_extract_global_nmax () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_extract_global_nmax() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int), POINTER :: nmax
INTEGER (C_int) :: f_lammps_extract_global_nmax
INTEGER(c_int), POINTER :: nmax
INTEGER(c_int) :: f_lammps_extract_global_nmax
nmax = lmp%extract_global("nmax")
f_lammps_extract_global_nmax = nmax
END FUNCTION f_lammps_extract_global_nmax
FUNCTION f_lammps_extract_global_boltz () BIND(C) RESULT(C_k_B)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_boltz() BIND(C) RESULT(C_k_B)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_k_B
REAL (C_double), POINTER :: k_B
REAL(c_double) :: C_k_B
REAL(c_double), POINTER :: k_B
k_B = lmp%extract_global("boltz")
C_k_B = k_B
END FUNCTION f_lammps_extract_global_boltz
FUNCTION f_lammps_extract_global_hplanck () BIND(C) RESULT(C_h)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_hplanck() BIND(C) RESULT(C_h)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: C_h
REAL (C_double), POINTER :: h
REAL(c_double) :: C_h
REAL(c_double), POINTER :: h
h = lmp%extract_global("boltz")
C_h = h
END FUNCTION f_lammps_extract_global_hplanck
FUNCTION f_lammps_extract_global_angstrom () BIND(C) RESULT(Angstrom)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_angstrom() BIND(C) RESULT(Angstrom)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: Angstrom
REAL (C_double), POINTER :: A
REAL(c_double) :: Angstrom
REAL(c_double), POINTER :: A
A = lmp%extract_global("angstrom")
Angstrom = A
END FUNCTION f_lammps_extract_global_angstrom
FUNCTION f_lammps_extract_global_femtosecond () BIND(C) RESULT(fs)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
FUNCTION f_lammps_extract_global_femtosecond() BIND(C) RESULT(fs)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
REAL (C_double) :: fs
REAL (C_double), POINTER :: femtosecond
REAL(c_double) :: fs
REAL(c_double), POINTER :: femtosecond
femtosecond = lmp%extract_global("femtosecond")
fs = femtosecond

48
unittest/fortran/test_fortran_extract_variable.f90
View File

@ -42,7 +42,7 @@ CONTAINS
c_absolute_path = c_path_join(c_test_input_directory, c_filename)
length = c_strlen(c_absolute_path)
CALL C_F_POINTER(c_absolute_path, F_absolute_path, [length])
ALLOCATE( CHARACTER(LEN=length) :: absolute_path )
ALLOCATE(CHARACTER(LEN=length) :: absolute_path)
DO i = 1, length
absolute_path(i:i) = F_absolute_path(i)
END DO
@ -159,7 +159,7 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C)
CALL lmp%command('variable greeting file ' // absolute_path('greetings.txt'))
CALL lmp%command('variable atfile atomfile ' &
// absolute_path('atomdata.txt'))
IF ( lmp%config_has_package('PYTHON') ) THEN
IF (lmp%config_has_package('PYTHON')) THEN
CALL lmp%command(py_input)
CALL lmp%command('variable py python square_it')
END IF
@ -174,7 +174,7 @@ SUBROUTINE f_lammps_setup_extract_variable () BIND(C)
END SUBROUTINE f_lammps_setup_extract_variable
FUNCTION f_lammps_extract_variable_index_1 () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -182,7 +182,7 @@ FUNCTION f_lammps_extract_variable_index_1 () BIND(C)
CHARACTER(LEN=256) :: str
str = lmp%extract_variable("idx")
IF ( trim(str) == 'hello' ) THEN
IF (trim(str) == 'hello') THEN
f_lammps_extract_variable_index_1 = 1_c_int
ELSE
f_lammps_extract_variable_index_1 = 0_c_int
@ -190,7 +190,7 @@ FUNCTION f_lammps_extract_variable_index_1 () BIND(C)
END FUNCTION f_lammps_extract_variable_index_1
FUNCTION f_lammps_extract_variable_index_2 () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -198,7 +198,7 @@ FUNCTION f_lammps_extract_variable_index_2 () BIND(C)
CHARACTER(LEN=256) :: str
str = lmp%extract_variable("idx")
IF ( trim(str) == 'goodbye' ) THEN
IF (trim(str) == 'goodbye') THEN
f_lammps_extract_variable_index_2 = 1_c_int
ELSE
f_lammps_extract_variable_index_2 = 0_c_int
@ -206,7 +206,7 @@ FUNCTION f_lammps_extract_variable_index_2 () BIND(C)
END FUNCTION f_lammps_extract_variable_index_2
FUNCTION f_lammps_extract_variable_loop () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_double
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -218,7 +218,7 @@ FUNCTION f_lammps_extract_variable_loop () BIND(C)
END FUNCTION f_lammps_extract_variable_loop
FUNCTION f_lammps_extract_variable_loop_pad () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -231,7 +231,7 @@ FUNCTION f_lammps_extract_variable_loop_pad () BIND(C)
END FUNCTION f_lammps_extract_variable_loop_pad
FUNCTION f_lammps_extract_variable_world () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -244,7 +244,7 @@ FUNCTION f_lammps_extract_variable_world () BIND(C)
END FUNCTION f_lammps_extract_variable_world
FUNCTION f_lammps_extract_variable_universe () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -257,7 +257,7 @@ FUNCTION f_lammps_extract_variable_universe () BIND(C)
END FUNCTION f_lammps_extract_variable_universe
FUNCTION f_lammps_extract_variable_uloop () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -269,7 +269,7 @@ FUNCTION f_lammps_extract_variable_uloop () BIND(C)
END FUNCTION f_lammps_extract_variable_uloop
FUNCTION f_lammps_extract_variable_string () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -282,7 +282,7 @@ FUNCTION f_lammps_extract_variable_string () BIND(C)
END FUNCTION f_lammps_extract_variable_string
FUNCTION f_lammps_extract_variable_format () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -295,7 +295,7 @@ FUNCTION f_lammps_extract_variable_format () BIND(C)
END FUNCTION f_lammps_extract_variable_format
FUNCTION f_lammps_extract_variable_format_pad () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -308,7 +308,7 @@ FUNCTION f_lammps_extract_variable_format_pad () BIND(C)
END FUNCTION f_lammps_extract_variable_format_pad
FUNCTION f_lammps_extract_variable_getenv () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -321,7 +321,7 @@ FUNCTION f_lammps_extract_variable_getenv () BIND(C)
END FUNCTION f_lammps_extract_variable_getenv
FUNCTION f_lammps_extract_variable_file () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_ptr
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_ptr
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string
@ -334,7 +334,7 @@ FUNCTION f_lammps_extract_variable_file () BIND(C)
END FUNCTION f_lammps_extract_variable_file
FUNCTION f_lammps_extract_variable_atomfile(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_double
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -347,7 +347,7 @@ FUNCTION f_lammps_extract_variable_atomfile(i) BIND(C)
END FUNCTION f_lammps_extract_variable_atomfile
FUNCTION f_lammps_extract_variable_python(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_double
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -358,7 +358,7 @@ FUNCTION f_lammps_extract_variable_python(i) BIND(C)
END FUNCTION f_lammps_extract_variable_python
FUNCTION f_lammps_extract_variable_timer() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -368,7 +368,7 @@ FUNCTION f_lammps_extract_variable_timer() BIND(C)
END FUNCTION f_lammps_extract_variable_timer
FUNCTION f_lammps_extract_variable_internal() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -378,7 +378,7 @@ FUNCTION f_lammps_extract_variable_internal() BIND(C)
END FUNCTION f_lammps_extract_variable_internal
FUNCTION f_lammps_extract_variable_equal() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -388,7 +388,7 @@ FUNCTION f_lammps_extract_variable_equal() BIND(C)
END FUNCTION f_lammps_extract_variable_equal
FUNCTION f_lammps_extract_variable_atom(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -401,7 +401,7 @@ FUNCTION f_lammps_extract_variable_atom(i) BIND(C)
END FUNCTION f_lammps_extract_variable_atom
FUNCTION f_lammps_extract_variable_vector(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
IMPLICIT NONE
@ -414,7 +414,7 @@ FUNCTION f_lammps_extract_variable_vector(i) BIND(C)
END FUNCTION f_lammps_extract_variable_vector
SUBROUTINE f_lammps_set_variable_string() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double, C_int
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double, c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
USE keepvar, ONLY : f2c_string

22
unittest/fortran/test_fortran_gather_scatter.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE f_lammps_close() BIND(C)
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_setup_gather_scatter () BIND(C)
SUBROUTINE f_lammps_setup_gather_scatter() BIND(C)
USE LIBLAMMPS
USE keepstuff, ONLY : lmp, big_input, cont_input, more_input
IMPLICIT NONE
@ -33,7 +33,7 @@ SUBROUTINE f_lammps_setup_gather_scatter () BIND(C)
CALL lmp%commands_list(more_input)
END SUBROUTINE f_lammps_setup_gather_scatter
FUNCTION f_lammps_gather_atoms_mask (i) BIND(C)
FUNCTION f_lammps_gather_atoms_mask(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
@ -46,7 +46,7 @@ FUNCTION f_lammps_gather_atoms_mask (i) BIND(C)
f_lammps_gather_atoms_mask = mask(i)
END FUNCTION f_lammps_gather_atoms_mask
FUNCTION f_lammps_gather_atoms_position (i) BIND(C)
FUNCTION f_lammps_gather_atoms_position(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
@ -59,7 +59,7 @@ FUNCTION f_lammps_gather_atoms_position (i) BIND(C)
f_lammps_gather_atoms_position = positions(i)
END FUNCTION f_lammps_gather_atoms_position
FUNCTION f_lammps_gather_atoms_concat_mask (i) BIND(C)
FUNCTION f_lammps_gather_atoms_concat_mask(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
@ -72,7 +72,7 @@ FUNCTION f_lammps_gather_atoms_concat_mask (i) BIND(C)
CALL lmp%gather_atoms_concat('mask', 1_c_int, mask)
CALL lmp%gather_atoms_concat('id', 1_c_int, tag)
DO j = 1, SIZE(tag)
IF ( tag(j) == i ) THEN
IF (tag(j) == i) THEN
f_lammps_gather_atoms_concat_mask = mask(j)
RETURN
END IF
@ -80,7 +80,7 @@ FUNCTION f_lammps_gather_atoms_concat_mask (i) BIND(C)
f_lammps_gather_atoms_concat_mask = -1
END FUNCTION f_lammps_gather_atoms_concat_mask
FUNCTION f_lammps_gather_atoms_concat_position (xyz, id) BIND(C)
FUNCTION f_lammps_gather_atoms_concat_position(xyz, id) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
@ -94,13 +94,13 @@ FUNCTION f_lammps_gather_atoms_concat_position (xyz, id) BIND(C)
CALL lmp%gather_atoms_concat('x', 3_c_int, positions)
CALL lmp%gather_atoms_concat('id', 1_c_int, tag)
DO j = 1, SIZE(tag)
IF ( tag(j) == id ) THEN
IF (tag(j) == id) THEN
f_lammps_gather_atoms_concat_position = positions((j-1)*3 + xyz)
END IF
END DO
END FUNCTION f_lammps_gather_atoms_concat_position
FUNCTION f_lammps_gather_atoms_subset_mask (i) BIND(C)
FUNCTION f_lammps_gather_atoms_subset_mask(i) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
@ -113,7 +113,7 @@ FUNCTION f_lammps_gather_atoms_subset_mask (i) BIND(C)
CALL lmp%gather_atoms_subset('mask', 1_c_int, tag, mask)
DO j = 1, SIZE(tag)
IF ( tag(j) == i ) THEN
IF (tag(j) == i) THEN
f_lammps_gather_atoms_subset_mask = mask(j)
RETURN
END IF
@ -121,7 +121,7 @@ FUNCTION f_lammps_gather_atoms_subset_mask (i) BIND(C)
f_lammps_gather_atoms_subset_mask = -1
END FUNCTION f_lammps_gather_atoms_subset_mask
FUNCTION f_lammps_gather_atoms_subset_position (xyz,id) BIND(C)
FUNCTION f_lammps_gather_atoms_subset_position(xyz,id) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_double
USE LIBLAMMPS
USE keepstuff, ONLY : lmp
@ -134,7 +134,7 @@ FUNCTION f_lammps_gather_atoms_subset_position (xyz,id) BIND(C)
CALL lmp%gather_atoms_subset('x', 3_c_int, tag, positions)
DO j = 1, SIZE(tag)
IF ( tag(j) == id ) THEN
IF (tag(j) == id) THEN
f_lammps_gather_atoms_subset_position = positions((j-1)*3 + xyz)
RETURN
END IF

50
unittest/fortran/test_fortran_get_thermo.f90
View File

@ -23,7 +23,7 @@ SUBROUTINE f_lammps_close() BIND(C)
lmp%handle = c_null_ptr
END SUBROUTINE f_lammps_close
SUBROUTINE f_lammps_get_thermo_setup () BIND(C)
SUBROUTINE f_lammps_get_thermo_setup() BIND(C)
USE liblammps
USE keepstuff, ONLY : lmp, big_input, cont_input, pair_input
IMPLICIT NONE
@ -33,122 +33,122 @@ SUBROUTINE f_lammps_get_thermo_setup () BIND(C)
CALL lmp%commands_list(pair_input)
END SUBROUTINE f_lammps_get_thermo_setup
FUNCTION f_lammps_get_thermo_natoms () BIND(C)
FUNCTION f_lammps_get_thermo_natoms() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_natoms
REAL(c_double) :: f_lammps_get_thermo_natoms
f_lammps_get_thermo_natoms = lmp%get_thermo('atoms')
END FUNCTION f_lammps_get_thermo_natoms
FUNCTION f_lammps_get_thermo_dt () BIND (C)
FUNCTION f_lammps_get_thermo_dt() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_dt
REAL(c_double) :: f_lammps_get_thermo_dt
f_lammps_get_thermo_dt = lmp%get_thermo('dt')
END FUNCTION f_lammps_get_thermo_dt
FUNCTION f_lammps_get_thermo_vol () BIND (C)
FUNCTION f_lammps_get_thermo_vol() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_vol
REAL(c_double) :: f_lammps_get_thermo_vol
f_lammps_get_thermo_vol = lmp%get_thermo('vol')
END FUNCTION f_lammps_get_thermo_vol
FUNCTION f_lammps_get_thermo_lx () BIND (C)
FUNCTION f_lammps_get_thermo_lx() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_lx
REAL(c_double) :: f_lammps_get_thermo_lx
f_lammps_get_thermo_lx = lmp%get_thermo('lx')
END FUNCTION f_lammps_get_thermo_lx
FUNCTION f_lammps_get_thermo_ly () BIND (C)
FUNCTION f_lammps_get_thermo_ly() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_ly
REAL(c_double) :: f_lammps_get_thermo_ly
f_lammps_get_thermo_ly = lmp%get_thermo('ly')
END FUNCTION f_lammps_get_thermo_ly
FUNCTION f_lammps_get_thermo_lz () BIND (C)
FUNCTION f_lammps_get_thermo_lz() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_lz
REAL(c_double) :: f_lammps_get_thermo_lz
f_lammps_get_thermo_lz = lmp%get_thermo('lz')
END FUNCTION f_lammps_get_thermo_lz
FUNCTION f_lammps_get_thermo_xlo () BIND (C)
FUNCTION f_lammps_get_thermo_xlo() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_xlo
REAL(c_double) :: f_lammps_get_thermo_xlo
f_lammps_get_thermo_xlo = lmp%get_thermo('xlo')
END FUNCTION f_lammps_get_thermo_xlo
FUNCTION f_lammps_get_thermo_xhi () BIND (C)
FUNCTION f_lammps_get_thermo_xhi() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_xhi
REAL(c_double) :: f_lammps_get_thermo_xhi
f_lammps_get_thermo_xhi = lmp%get_thermo('xhi')
END FUNCTION f_lammps_get_thermo_xhi
FUNCTION f_lammps_get_thermo_ylo () BIND (C)
FUNCTION f_lammps_get_thermo_ylo() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_ylo
REAL(c_double) :: f_lammps_get_thermo_ylo
f_lammps_get_thermo_ylo = lmp%get_thermo('ylo')
END FUNCTION f_lammps_get_thermo_ylo
FUNCTION f_lammps_get_thermo_yhi () BIND (C)
FUNCTION f_lammps_get_thermo_yhi() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_yhi
REAL(c_double) :: f_lammps_get_thermo_yhi
f_lammps_get_thermo_yhi = lmp%get_thermo('yhi')
END FUNCTION f_lammps_get_thermo_yhi
FUNCTION f_lammps_get_thermo_zlo () BIND (C)
FUNCTION f_lammps_get_thermo_zlo() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_zlo
REAL(c_double) :: f_lammps_get_thermo_zlo
f_lammps_get_thermo_zlo = lmp%get_thermo('zlo')
END FUNCTION f_lammps_get_thermo_zlo
FUNCTION f_lammps_get_thermo_zhi () BIND (C)
FUNCTION f_lammps_get_thermo_zhi() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY: c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (c_double) :: f_lammps_get_thermo_zhi
REAL(c_double) :: f_lammps_get_thermo_zhi
f_lammps_get_thermo_zhi = lmp%get_thermo('zhi')
END FUNCTION f_lammps_get_thermo_zhi

50
unittest/fortran/test_fortran_properties.f90
View File

@ -1,78 +1,78 @@
FUNCTION f_lammps_version () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_version() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER (C_int) :: f_lammps_version
INTEGER(c_int) :: f_lammps_version
f_lammps_version = lmp%version()
END FUNCTION f_lammps_version
SUBROUTINE f_lammps_memory_usage (meminfo) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_double
SUBROUTINE f_lammps_memory_usage(meminfo) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_double
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
REAL (C_double), DIMENSION(3), INTENT(OUT) :: meminfo
REAL(c_double), DIMENSION(3), INTENT(OUT) :: meminfo
CALL lmp%memory_usage(meminfo)
END SUBROUTINE f_lammps_memory_usage
FUNCTION f_lammps_get_mpi_comm () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_get_mpi_comm() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE liblammps
USE keepstuff, ONLY : lmp
IMPLICIT NONE
INTEGER (C_int) :: f_lammps_get_mpi_comm
INTEGER(c_int) :: f_lammps_get_mpi_comm
f_lammps_get_mpi_comm = lmp%get_mpi_comm()
END FUNCTION f_lammps_get_mpi_comm
FUNCTION f_lammps_extract_setting (Cstr) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_char
FUNCTION f_lammps_extract_setting(Cstr) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER (C_int) :: f_lammps_extract_setting
CHARACTER (KIND=C_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr
INTEGER(c_int) :: f_lammps_extract_setting
CHARACTER(KIND=c_char, LEN=1), DIMENSION(*), INTENT(IN) :: Cstr
INTEGER :: strlen, i
CHARACTER (LEN=:), ALLOCATABLE :: Fstr
CHARACTER(LEN=:), ALLOCATABLE :: Fstr
i = 1
DO WHILE (Cstr(i) /= ACHAR(0))
i = i + 1
END DO
strlen = i
allocate ( CHARACTER(LEN=strlen) :: Fstr)
allocate (CHARACTER(LEN=strlen) :: Fstr)
FORALL (i=1:strlen)
Fstr(i:i) = Cstr(i)
END FORALL
f_lammps_extract_setting = lmp%extract_setting(Fstr)
deallocate (Fstr)
DEALLOCATE(Fstr)
END FUNCTION f_lammps_extract_setting
FUNCTION f_lammps_has_error () BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int
FUNCTION f_lammps_has_error() BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER(C_int) :: f_lammps_has_error
INTEGER(c_int) :: f_lammps_has_error
IF ( lmp%has_error() ) THEN
f_lammps_has_error = 1_C_int
IF (lmp%has_error()) THEN
f_lammps_has_error = 1_c_int
ELSE
f_lammps_has_error = 0_C_int
f_lammps_has_error = 0_c_int
END IF
END FUNCTION f_lammps_has_error
FUNCTION f_lammps_get_last_error_message(errmesg, errlen) BIND(C)
USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_int, C_char, C_ptr, C_F_POINTER
USE, INTRINSIC :: ISO_C_BINDING, ONLY : c_int, c_char, c_ptr, C_F_POINTER
USE keepstuff, ONLY : lmp
USE LIBLAMMPS
IMPLICIT NONE
INTEGER(C_int) :: f_lammps_get_last_error_message
INTEGER(c_int) :: f_lammps_get_last_error_message
CHARACTER(KIND=c_char), DIMENSION(*) :: errmesg
INTEGER(C_int), VALUE, INTENT(IN) :: errlen
INTEGER(c_int), VALUE, INTENT(IN) :: errlen
CHARACTER(LEN=:), ALLOCATABLE :: buffer
INTEGER :: status, i