ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

git-svn-id: svn://svn.icms.temple.edu/lammps-ro/trunk@8989 f3b2605a-c512-4ea7-a41b-209d697bcdaa

Browse Source
This commit is contained in:
sjplimp
2012-10-22 14:37:08 +00:00
parent d028daec92
commit 5f377d2d45
1 changed files with 1169 additions and 1175 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
examples/COUPLE/fortran2/LAMMPS.F90
View File

@ -563,7 +563,6 @@ contains !! Wrapper functions local to this module {{{1
character (len=*), intent(in) :: id character (len=*), intent(in) :: id
integer, intent(in) :: style, type integer, intent(in) :: style, type
type (C_ptr) :: Cptr type (C_ptr) :: Cptr
real (C_double), dimension(:,:), pointer :: Fptr
integer :: nr, nc integer :: nr, nc
! Check for the correct dimensionality ! Check for the correct dimensionality
if ( type == 0 ) then if ( type == 0 ) then
@ -578,9 +577,7 @@ contains !! Wrapper functions local to this module {{{1
call lammps_extract_compute_arraysize (ptr, id, style, nr, nc) call lammps_extract_compute_arraysize (ptr, id, style, nr, nc)
allocate (compute(nr, nc)) allocate (compute(nr, nc))
Cptr = lammps_extract_compute_Cptr (ptr, id, style, type) Cptr = lammps_extract_compute_Cptr (ptr, id, style, type)
call C_F_pointer (Cptr, Fptr, (/nr, nc/)) compute = Cdoublestar_to_2darray (Cptr, nr, nc)
compute = Fptr
nullify (Fptr)
! C pointer should not be freed ! C pointer should not be freed
end subroutine lammps_extract_compute_dp2a end subroutine lammps_extract_compute_dp2a
subroutine lammps_extract_compute_r2a (compute, ptr, id, style, type) subroutine lammps_extract_compute_r2a (compute, ptr, id, style, type)
@ -710,7 +707,6 @@ contains !! Wrapper functions local to this module {{{1
character (len=*), intent(in) :: id character (len=*), intent(in) :: id
integer, intent(in) :: style, type, i, j integer, intent(in) :: style, type, i, j
type (C_ptr) :: Cptr type (C_ptr) :: Cptr
real (C_double), dimension(:,:), pointer :: Fptr
integer :: nr, nc integer :: nr, nc
! Check for the correct dimensionality ! Check for the correct dimensionality
if ( style == 0 ) then if ( style == 0 ) then
@ -729,9 +725,7 @@ contains !! Wrapper functions local to this module {{{1
call lammps_extract_fix_arraysize (ptr, id, style, nr, nc) call lammps_extract_fix_arraysize (ptr, id, style, nr, nc)
allocate (fix(nr, nc)) allocate (fix(nr, nc))
Cptr = lammps_extract_fix_Cptr (ptr, id, style, type, i, j) Cptr = lammps_extract_fix_Cptr (ptr, id, style, type, i, j)
call C_F_pointer (Cptr, Fptr, (/nr, nc/)) fix = Cdoublestar_to_2darray (Cptr, nr, nc)
fix = Fptr
nullify (Fptr)
! C pointer should not be freed ! C pointer should not be freed
end subroutine lammps_extract_fix_dp2a end subroutine lammps_extract_fix_dp2a
subroutine lammps_extract_fix_r2a (fix, ptr, id, style, type, i, j) subroutine lammps_extract_fix_r2a (fix, ptr, id, style, type, i, j)