subroutine get_fio_magnetic_fields(prtcls, F, params)
USE omp_lib
IMPLICIT NONE
TYPE(PARTICLES), INTENT(INOUT) :: prtcls
TYPE(FIELDS), INTENT(IN) :: F
TYPE(KORC_PARAMS), INTENT(IN) :: params
INTEGER (C_INT) :: status
INTEGER :: pp
REAL(rp), DIMENSION(3) :: x
REAL(rp), DIMENSION(3) :: Btmp
TYPE(C_PTR), DIMENSION(size(prtcls%hint)) :: hint
INTEGER :: thread_num
! write(output_unit_write,*) 'in m3dc1 B'
if (prtcls%cart) then
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(pp,status,x)
do pp = 1, SIZE(prtcls%hint)
if (prtcls%flagCon(pp) .EQ. 1_is) then
x = prtcls%X(pp,:)*params%cpp%length
status = fio_eval_field(F%FIO_B, x(1), &
prtcls%B(pp,1), &
prtcls%hint(pp))
if (status .eq. FIO_NO_DATA) then
prtcls%B(pp,:) = 0
prtcls%flagCon(pp) = 0_is
else if (status .ne. FIO_SUCCESS) then
prtcls%flagCon(pp) = 0_is
end if
end if
end do
!$OMP END PARALLEL DO
else
! write(output_unit_write,*) 'in cart false'
!hint=prtcls%hint
!write(output_unit_write,*) 'hint: ',hint
Btmp=0._rp
!$OMP PARALLEL DO DEFAULT(none) &
!$OMP& SHARED(prtcls,params,F) &
!$OMP& PRIVATE(pp,status,x,thread_num) &
!$OMP& FIRSTPRIVATE(Btmp)
do pp = 1, SIZE(prtcls%hint)
thread_num = OMP_GET_THREAD_NUM()
if (prtcls%flagCon(pp) .EQ. 1_is) then
x(1) = prtcls%Y(pp,1)*params%cpp%length
x(2) = prtcls%Y(pp,2)
x(3) = prtcls%Y(pp,3)*params%cpp%length
!prtcls%hint(pp)=c_null_ptr
!write(6,*) 'thread',thread_num,'X',x
! prtcls%hint(pp)=c_null_ptr
!write(output_unit_write,*) 'thread',thread_num,'before interpolating B'
status = fio_eval_field(F%FIO_B, x(1), &
Btmp(1),prtcls%hint(pp))
if (status .eq. FIO_NO_DATA) then
prtcls%B(pp,:) = 0
prtcls%flagCon(pp) = 0_is
else if (status .ne. FIO_SUCCESS) then
prtcls%flagCon(pp) = 0_is
end if
if (.not.params%GC_coords) then
prtcls%B(pp,1)=(Btmp(1)*cos(x(2))-Btmp(2)*sin(x(2)))/ &
params%cpp%Bo
prtcls%B(pp,2)=(Btmp(1)*sin(x(2))+Btmp(2)*cos(x(2)))/ &
params%cpp%Bo
prtcls%B(pp,3)=Btmp(3)/params%cpp%Bo
else
prtcls%B(pp,1)=Btmp(1)/params%cpp%Bo
prtcls%B(pp,2)=Btmp(2)/params%cpp%Bo
prtcls%B(pp,3)=Btmp(3)/params%cpp%Bo
end if
end if
end do
!$OMP END PARALLEL DO
end if
end subroutine get_fio_magnetic_fields