Hi all,
do i=1,n_particle
call obtain_DEM_kinematic(i,Pos,Dis,Vel,Acc, UnitE, UnitE1,UnitE2,UnitE3,RVel, RAcc )
ELE(1,i)=Pos(1)
ELE(2,i)=Pos(2)
ELE(3,i)=Pos(3)
ELE(4,i)=get_dem_radius(i)
XYZ(1,i)=ELE(1,i)-ELE(4,i)
XYZ(2,i)=ELE(2,i)-ELE(4,i)
XYZ(3,i)=ELE(3,i)-ELE(4,i)
XYZ(4,i)=ELE(1,i)+ELE(4,i)
XYZ(5,i)=ELE(2,i)+ELE(4,i)
XYZ(6,i)=ELE(3,i)+ELE(4,i)
end do
This is part of my code,I want to use openacc to accerlator it,but the subroutine here contains pointers,and I have tried many methods to inline it,but failed.Doyou have any advice?Thank you!
The following is the subroutine:
subroutine obtain_DEM_kinematic(EDID,Pos,Dis,Vel,Acc, UnitE, UnitE1,UnitE2,UnitE3,RVel, RAcc)
implicit none
integer, intent(in) :: EDID
real( kind = RK ), optional :: Pos(3)
real( kind = RK ), optional :: Dis(3)
real( kind = RK ), optional :: Vel(3)
real( kind = RK ), optional :: Acc(3)
real( kind = RK ), optional :: UnitE(3),UnitE1(3),UnitE2(3),UnitE3(3)
real( kind = RK ), optional :: RVel(3)
real( kind = RK ), optional :: RAcc(3)
integer :: total_dem
character(len = MNL) :: msg, msg1, cdid
total_dem = get_total_number_dem()
if( EDID > total_dem .or. EDID <= 0 ) goto 555
if( present(Pos) ) Pos = dem(edid) % kinematic % POS
if( present(Dis) ) Dis = dem(edid) % kinematic % Dis
if( present(Vel) ) Vel = dem(edid) % kinematic % Vel
if( present(Acc) ) Acc = dem(edid) % kinematic % Acc
if( present(UnitE)) UnitE = dem(edid) % kinematic % UnitE
if( present(UnitE1)) UnitE1 = dem(edid) % kinematic % UnitE1
if( present(UnitE2)) UnitE2 = dem(edid) % kinematic % UnitE2
if( present(UnitE3)) UnitE3 = dem(edid) % kinematic % UnitE3
if( present(RVel) ) RVel = dem(edid) % kinematic % RVel
if( present(RAcc) ) RAcc = dem(edid) % kinematic % RAcc
! write(*,*)acc
!pause
return
555 continue
write(cdid, *) edid; cdid = adjustl( cdid )
msg = 'Subprogram Exception. Discrete element ID is greater than the total number of DEM '
msg1 = 'Discrete Element ID: '//trim(cdid)
call ErrorMSG( msg, msg1 )
return
end subroutine obtain_DEM_kinematic
function get_dem_radius( eid ) result( radius )
implicit none
integer, intent(in) :: eid
real( kind = RK ) :: radius
integer :: total_dem
character(len = MNL) :: msg, msg1, msg2, cdid
radius = -1.0
total_dem = get_total_number_dem()
if( eid > total_dem .or. eid <= 0 ) goto 555
radius = DEM(eid) % radius
return
555 continue
write(cdid, *) eid; cdid = adjustl( cdid )
msg = 'Subprogram Exception. In GET_DEM_RADIUS'
msg1 = 'Discrete element ID is greater than the total number of DEM '
msg2 = 'Discrete Element ID: '//trim(cdid)
call ErrorMSG( msg, msg1 )
return
end function get_dem_radius
- bigwbxu