Homec4science
Diffusion COSOlver (new_coulomb) Browse

cosolver/src/ie_colls_mod.f90
83b8f38f6c51new_coulomb

Last Change
Raw File

ie_colls_mod.f90
View Options

module ie_colls
! ion-electron collisions module
USE PREC_CONST
USE MODEL
use grid
USE BASIC
USE BASIC_MPI
USE restart
USE ARRAY, only : CieTdp,CieFdp,rCieT,rCieF
USE OPERATOR_MODEL
use auxval
use gkcoulomb
implicit none
PROCEDURE(CieT_sub), POINTER :: evaluate_CieT_collisional_matrix => null()
PROCEDURE(CieF_sub), POINTER :: evaluate_CieF_collisional_matrix => null()
ABSTRACT INTERFACE
SUBROUTINE CieT_sub
! Empty
END SUBROUTINE CieT_sub
END INTERFACE
ABSTRACT INTERFACE
SUBROUTINE CieF_sub
! Empty
END SUBROUTINE CieF_sub
END INTERFACE
contains
!
!------------------------------------------------
!
subroutine ie_colls_control
! ie colls
implicit none
IF(me_i .eq. 0) WRITE(*,*) '====== Ion-Electron Collisions ======='
IF(me_i .eq. 0) WRITE(*,*) 'Set Ion-Electron Collision ...'
CALL set_ie_colls
IF( ITEST .ne. 0) THEN
IF(me_i .eq. 0) WRITE(*,*) 'Construct collisional matrices CieT ... '
CALL evaluate_auxval_test
call set_CieT_collisional_matrix
CALL evaluate_CieT_collisional_matrix
ENDIF
IF( IBACK .ne. 0) THEN
IF(me_i .eq. 0) WRITE(*,*) 'Construct collisional matrices CieF ... '
call evaluate_auxval_field
call set_CieF_collisional_matrix
CALL evaluate_CieF_collisional_matrix
ENDIF
end subroutine ie_colls_control
!
!------------------------------------------------
!
SUBROUTINE set_ie_colls
! Set ion-electron basic/model
IMPLICIT NONE
!
CALL set_model('ie')
!
CALL set_basic('ie')
!
END SUBROUTINE set_ie_colls
!
!------------------------------------------------
!
! TEST COMPONENT
!
SUBROUTINE set_CieT_collisional_matrix
! Evaluate the electron-ion test collisional matrix
IMPLICIT NONE
!
!
IF( ITEST .ne. 0 ) THEN
IF(IFGKCOULOMB) THEN
!
evaluate_CieT_collisional_matrix => CieT_gk_coulomb
call set_gkcoulomb
bfm_ = bafm_
bpfm_ = bafm_
IF ( .not. GKC_USE_FULL) then
call load_gk_coulomb_coeffs('ieT')
else
call set_tabljpmf('t')
endif
!
ELSE
!
evaluate_CieT_collisional_matrix => CieT_dflt
!
ENDIF
ELSE
evaluate_CieT_collisional_matrix => CieT_zeros_dflt
ENDIF
!
END SUBROUTINE set_CieT_collisional_matrix
!
!----------------------------------------------------
!
SUBROUTINE CieT_dflt
! Evaluate the ion-electron collisional matrix
! Computes the test collisional matrix.
!
!
IMPLICIT NONE
!
INTEGER :: irow,irow_tmp, lbar_start, istep
INTEGER, DIMENSION(2) :: lk
!
! initialize indices
lbar_start = lbari_s_l
istep=1
!
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'CieT [x/ ', numbi(Pmaxi,Jmaxi) ,']:'
! Test-part
IF( ITEST .ne. 0) THEN
DO irow=lbar_start,lbari_e_l
! Get Hermite-Laguerre indices
irow_tmp = rows_i(irow)
lk = invnumbi(irow_tmp)
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCieT(:) = TO_FM('0')
CALL COLLISIONTI(lk(1),lk(2),rCieT)
CieTdp(irow,:) = TO_DP(rCieT(:))
! save current state
istep = istep +1
ENDDO
ENDIF
!
END SUBROUTINE CieT_dflt
!
!--------------------------------------------------------------
!
SUBROUTINE CieT_gk_coulomb
! Evaluate ion-electron test GK Coulomb
use restart
use gkcoulomb
implicit none
INTEGER :: l,k,irow, icol, ii
INTEGER :: j,n,np,istep
INTEGER :: lbar_start, count
INTEGER, DIMENSION(4) :: lbarjnnp
INTEGER, DIMENSION(2) :: lk
!
!
lbar_start = lbari_s_l
istep=1
!
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'CieT [x/ ', numbi(Pmaxi,Jmaxi) ,']:'
DO irow=lbar_start,lbari_e_l
lbarjnnp = rows_i_4dim(irow,1:4)
! Hermite-Laguerre indices
lk = invnumbi(lbarjnnp(1))
j = lbarjnnp(2)
n = lbarjnnp(3)
np = lbarjnnp(4)
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCieT(:) = ZEROFM
CALL coulombTGK(lk(1), lk(2),j, n, np, rCieT)
CieTdp(irow,:) = TO_DP(rCieT(:))
! save current state
istep = istep +1
ENDDO
! Finalize GK Coulomb by performing summation over (j,np)
IF( nprocs > 1 ) THEN
DO icol =1, numbi( Pmaxi, Jmaxi)
count = (lbari_e_l - lbari_s_l +1 )
call mpi_gather( CieTdp(:, icol) , count, MPI_DOUBLE_PRECISION &
, CieTdp_global(:, icol), count, MPI_DOUBLE_PRECISION, 0, comm_i, ierr)
ENDDO
ELSE
CieTdp_global = CieTdp
ENDIF
CieTdp_finalized = 0._dp
IF( me_i .eq. 0) THEN
DO irow = 1, numbi( Pmaxi, Jmaxi)
DO ii = 1, lbarimax
if( rows_i_4dim( ii, 1 ) .eq. irow) THEN
CieTdp_finalized( irow, :) = CieTdp_finalized( irow, :) &
+ CieTdp_global( ii,:)
ENDIF
ENDDO
ENDDO
ENDIF
!
END SUBROUTINE CieT_gk_Coulomb
!
!------------------------------------------------
!
SUBROUTINE CieT_zeros_dflt
! Evaluate the ion-electron collisional matrix
! Computes the test collisional matrix.
!
!
IMPLICIT NONE
!
INTEGER :: irow,irow_tmp
INTEGER, DIMENSION(2) :: lk
INTEGER :: lbar_start, istep
! initialize indices
lbar_start = lbari_s_l
istep=1
! Test-part
IF( ITEST .ne. 0) THEN
DO irow=lbari_s_l,lbari_e_l
! Get Hermite-Laguerre indices
irow_tmp = rows_i(irow)
lk = invnumbi(irow_tmp)
rCieT(:) = TO_FM('0')
CieTdp(irow,:) = TO_DP(rCieT(:))
! save current state
istep = istep +1
ENDDO
ENDIF
!
END SUBROUTINE CieT_zeros_dflt
!
!--------------------------------------------------------------
!
! FIELD COMPONENT
!
SUBROUTINE set_CieF_collisional_matrix
! Evaluate the ion-electron collisional matrix
IMPLICIT NONE
!
IF (IBACK .ne. 0 ) THEN
IF(IFGKCOULOMB) THEN
!
evaluate_CieF_collisional_matrix => CieF_gk_coulomb
call set_gkcoulomb
bfm_ = bafm_
bpfm_ = bbfm_
IF(.not. GKC_USE_FULL) then
call load_gk_coulomb_coeffs('ieF')
else
call set_tabljpmf('f')
endif
!
ELSE
evaluate_CieF_collisional_matrix => CieF_dflt
!
ENDIF
ELSE
evaluate_CieF_collisional_matrix => CieF_zeros_dflt
ENDIF
!
END SUBROUTINE set_CieF_collisional_matrix
!
!--------------------------------------------------------------
!
SUBROUTINE CieF_dflt
! Evaluate the ion-electron collisional matrix
! Computes the test collisional matrix.
!
!
IMPLICIT NONE
!
! Local variables
INTEGER :: irow,irow_tmp
INTEGER :: lbar_start, istep
INTEGER, DIMENSION(2) :: lk
!
! initialize indices
lbar_start = lbari_s_l
istep=1
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'CieF [x/ ', numbi(Pmaxi,Jmaxi) ,']:'
! Back-Reaction
IF (IBACK .ne. 0) THEN
DO irow = lbari_s_l,lbari_e_l
irow_tmp = rows_i(irow)
lk = invnumbi(irow_tmp)
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCieF(:) = TO_FM('0')
CALL COLLISIONFI(lk(1),lk(2),rCieF)
CieFdp(irow,:) = TO_DP(rCieF(:))
! save current state
istep = istep +1
ENDDO
ENDIF
!
END SUBROUTINE CieF_dflt
!
!--------------------------------------------------------------
!
SUBROUTINE CieF_gk_coulomb
! Evaluate ion-electron field GK Coulomb
use restart
use gkcoulomb
implicit none
INTEGER :: l,k,irow,icol, ii, count
INTEGER :: j,n,np,istep
INTEGER :: lbar_start
INTEGER, DIMENSION(4) :: lbarjnnp
INTEGER, DIMENSION(2) :: lk
!
!
!
! initialize indices
lbar_start = lbari_s_l
istep=1
!
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'CieF [x/ ', lbari_e_l ,']:'
DO irow=lbar_start,lbari_e_l
lbarjnnp = rows_i_4dim(irow,1:4)
! Hermite-Laguerre indices
lk = invnumbi(lbarjnnp(1))
j = lbarjnnp(2)
n = lbarjnnp(3)
np = lbarjnnp(4)
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCieF(:) = ZEROFM
CALL coulombFGK(lk(1),lk(2),j,n,np,rCieF)
CieFdp(irow,:) = TO_DP(rCieF(:))
istep = istep +1
ENDDO
! Finalize GK Coulomb by performing summation over (j,np)
IF( nprocs > 1 ) THEN
DO icol =1, numbi( Pmaxi, Jmaxi)
count = (lbari_e_l - lbari_s_l +1 )
call mpi_gather( CieFdp(:, icol) , count, MPI_DOUBLE_PRECISION &
, CieFdp_global(:, icol), count, MPI_DOUBLE_PRECISION, 0, comm_i, ierr)
ENDDO
ELSE
CieFdp_global = CieFdp
ENDIF
CieFdp_finalized = 0._dp
IF( me_i .eq. 0) THEN
DO irow = 1, numbi( Pmaxi, Jmaxi)
DO ii = 1, lbarimax
if( rows_i_4dim( ii, 1 ) .eq. irow) THEN
CieFdp_finalized( irow, :) = CieFdp_finalized( irow, :) &
+ CieFdp_global( ii,:)
ENDIF
ENDDO
ENDDO
ENDIF
!
END SUBROUTINE CieF_gk_Coulomb
!
!---------------------------------------------------------------
!
SUBROUTINE CieF_zeros_dflt
! Evaluate the ion-electron collisional matrix
! Computes the test collisional matrix.
!
!
IMPLICIT NONE
!
! Local variables
INTEGER :: irow,irow_tmp
INTEGER, DIMENSION(2) :: lk
! Back-Reaction
IF (IBACK .ne. 0) THEN
DO irow = lbari_s_l,lbari_e_l
irow_tmp = rows_i(irow)
lk = invnumbi(irow_tmp)
write(*,'(a)', advance = 'no') '.'
rCieF(:) = TO_FM('0')
CieFdp(irow,:) = TO_DP(rCieF(:))
ENDDO
ENDIF
END SUBROUTINE CieF_zeros_dflt
!
end module ie_colls
c4science · Help