Homec4science
Diffusion GYACOMO (OBSOLETE: LATEST VERSION ON gitlab.epfl.ch) (gather_output) Browse

gyacomo/src/collision_mod.F90
cd9c3e804ccbgather_output

Last Change
Raw File

collision_mod.F90
View Options

module collision
! contains the Hermite-Laguerre collision operators. Solved using COSOlver.
USE array
USE basic
USE fields
USE futils
USE grid
USE model
USE prec_const
USE time_integration
USE utility
IMPLICIT NONE
PRIVATE
! Set the collision model to use
! (Lenard-Bernstein: 'LB', Dougherty: 'DG', Sugama: 'SG', Lorentz: 'LR', Landau: 'LD')
CHARACTER(len=2),PUBLIC,PROTECTED :: collision_model
LOGICAL, PUBLIC, PROTECTED :: gyrokin_CO =.true. ! activates GK effects on CO
LOGICAL, PUBLIC, PROTECTED :: interspecies =.true. ! activates interpecies collision
CHARACTER(len=128), PUBLIC :: mat_file ! COSOlver matrix file names
LOGICAL, PUBLIC, PROTECTED :: cosolver_coll ! check if cosolver matrices are used
PUBLIC :: collision_readinputs, coll_outputinputs
PUBLIC :: compute_TColl
PUBLIC :: compute_lenard_bernstein, compute_dougherty
PUBLIC :: LenardBernstein_e, LenardBernstein_i!, LenardBernstein GK
PUBLIC :: DoughertyGK_ee, DoughertyGK_ii!, Dougherty GK
PUBLIC :: load_COSOlver_mat, compute_cosolver_coll
PUBLIC :: apply_COSOlver_mat_e, apply_COSOlver_mat_i
CONTAINS
SUBROUTINE collision_readinputs
! Read the input parameters
IMPLICIT NONE
NAMELIST /COLLISION_PAR/ collision_model, gyrokin_CO, interspecies, mat_file
READ(lu_in,collision_par)
SELECT CASE(collision_model)
CASE ('LB') ! Lenhard bernstein
cosolver_coll = .false.
interspecies = .false.
CASE ('DG') ! Dougherty
cosolver_coll = .false.
interspecies = .false.
CASE ('SG') ! Sugama
cosolver_coll = .true.
CASE ('LR') ! Lorentz (Pitch angle)
cosolver_coll = .true.
interspecies = .false.
CASE ('LD') ! Landau
cosolver_coll = .true.
CASE ('none')
cosolver_coll = .false.
interspecies = .false.
CASE DEFAULT
ERROR STOP 'Error stop: collision model not recognized!!'
END SELECT
END SUBROUTINE collision_readinputs
SUBROUTINE coll_outputinputs(fidres, str)
! Write the input parameters to the results_xx.h5 file
IMPLICIT NONE
INTEGER, INTENT(in) :: fidres
CHARACTER(len=256), INTENT(in) :: str
CHARACTER(len=2) :: gkco = 'dk'
CHARACTER(len=2) :: abco = 'aa'
CHARACTER(len=6) :: coname
IF (gyrokin_CO) gkco = 'GK'
IF (interspecies) abco = 'ab'
WRITE(coname,'(a2,a2,a2)') collision_model,gkco,abco
CALL attach(fidres, TRIM(str), "CO", coname)
CALL attach(fidres, TRIM(str), "matfilename", mat_file)
END SUBROUTINE coll_outputinputs
SUBROUTINE compute_TColl
USE basic
USE model, ONLY : nu
IMPLICIT NONE
! Execution time start
CALL cpu_time(t0_coll)
IF (nu .NE. 0) THEN
SELECT CASE(collision_model)
CASE ('LB')
CALL compute_lenard_bernstein
CASE ('DG')
CALL compute_dougherty
CASE ('SG','LR','LD')
CALL compute_cosolver_coll
CASE ('none')
IF(KIN_E) &
TColl_e = 0._dp
TColl_i = 0._dp
CASE DEFAULT
ERROR STOP 'Error stop: collision operator not recognized!!'
END SELECT
ELSE
IF(KIN_E) &
TColl_e = 0._dp
TColl_i = 0._dp
ENDIF
! Execution time end
CALL cpu_time(t1_coll)
tc_coll = tc_coll + (t1_coll - t0_coll)
END SUBROUTINE compute_TColl
!******************************************************************************!
!! Lenard Bernstein collision operator
!******************************************************************************!
SUBROUTINE compute_lenard_bernstein
IMPLICIT NONE
COMPLEX(dp) :: TColl_
IF (KIN_E) THEN
DO ip = ips_e,ipe_e;DO ij = ijs_e,ije_e
DO ikx = ikxs, ikxe;DO iky = ikys, ikye; DO iz = izs,ize
CALL LenardBernstein_e(ip,ij,iky,ikx,iz,TColl_)
TColl_e(ip,ij,iky,ikx,iz) = TColl_
ENDDO;ENDDO;ENDDO
ENDDO;ENDDO
ENDIF
DO ip = ips_i,ipe_i;DO ij = ijs_i,ije_i
DO ikx = ikxs, ikxe;DO iky = ikys, ikye; DO iz = izs,ize
CALL LenardBernstein_i(ip,ij,iky,ikx,iz,TColl_)
TColl_i(ip,ij,iky,ikx,iz) = TColl_
ENDDO;ENDDO;ENDDO
ENDDO;ENDDO
END SUBROUTINE compute_lenard_bernstein
!******************************************************************************!
!! for electrons
!******************************************************************************!
SUBROUTINE LenardBernstein_e(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_,ij_,iky_,ikx_,iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
REAL(dp) :: j_dp, p_dp, be_2, kp
INTEGER :: eo_
!** Auxiliary variables **
eo_ = MODULO(parray_e(ip_),2)
p_dp = REAL(parray_e(ip_),dp)
j_dp = REAL(jarray_e(ij_),dp)
kp = kparray(iky_,ikx_,iz_,eo_)
be_2 = kp**2 * sigmae2_taue_o2 ! this is (be/2)^2
eo_ = MODULO(parray_e(ip_),2)
!** Assembling collison operator **
! -nuee (p + 2j) Nepj
TColl_ = -nu_ee * (p_dp + 2._dp*j_dp)*nadiab_moments_e(ip_,ij_,iky_,ikx_,iz_)
IF(gyrokin_CO) THEN
TColl_ = TColl_ - nu_ee *2._dp*be_2*nadiab_moments_e(ip_,ij_,iky_,ikx_,iz_)
ENDIF
END SUBROUTINE LenardBernstein_e
!******************************************************************************!
!! for ions
!******************************************************************************!
SUBROUTINE LenardBernstein_i(ip_,ij_,iky_,ikx_,iz_,TColl_)
USE fields, ONLY: moments_i
USE grid, ONLY: parray_i, jarray_i, kxarray, kyarray
USE basic
USE model, ONLY: sigmai2_taui_o2, nu_i
USE time_integration, ONLY : updatetlevel
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_,ij_,iky_,ikx_,iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
REAL(dp) :: j_dp, p_dp, kp, bi_2
INTEGER :: eo_
!** Auxiliary variables **
eo_ = MODULO(parray_i(ip_),2)
p_dp = REAL(parray_i(ip_),dp)
j_dp = REAL(jarray_i(ij_),dp)
kp = kparray(iky_,ikx_,iz_,eo_)
bi_2 = kp**2 * sigmai2_taui_o2 ! this is (be/2)^2
!** Assembling collison operator **
! -nuii (p + 2j) Nipj
TColl_ = -nu_i * (p_dp + 2._dp*j_dp)*nadiab_moments_i(ip_,ij_,iky_,ikx_,iz_)
IF(gyrokin_CO) THEN
TColl_ = TColl_ - nu_i *2._dp*bi_2*nadiab_moments_i(ip_,ij_,iky_,ikx_,iz_)
ENDIF
END SUBROUTINE LenardBernstein_i
!******************************************************************************!
!! Doughtery collision operator
!******************************************************************************!
SUBROUTINE compute_dougherty
IMPLICIT NONE
COMPLEX(dp) :: TColl_
IF (KIN_E) THEN
DO iz = izs,ize
DO iky = ikys, ikye;
DO ikx = ikxs, ikxe;
DO ij = ijs_e,ije_e
DO ip = ips_e,ipe_e;
IF(gyrokin_CO) THEN
CALL DoughertyGK_ee(ip,ij,iky,ikx,iz,TColl_)
ELSE
CALL DoughertyDK_ee(ip,ij,iky,ikx,iz,TColl_)
ENDIF
TColl_e(ip,ij,iky,ikx,iz) = TColl_
ENDDO;ENDDO;ENDDO
ENDDO;ENDDO
ENDIF
DO iz = izs,ize
DO iky = ikys, ikye;
DO ikx = ikxs, ikxe;
DO ij = ijs_i,ije_i
DO ip = ips_i,ipe_i;
IF(gyrokin_CO) THEN
CALL DoughertyGK_ii(ip,ij,iky,ikx,iz,TColl_)
ELSE
CALL DoughertyDK_ii(ip,ij,iky,ikx,iz,TColl_)
ENDIF
TColl_i(ip,ij,iky,ikx,iz) = TColl_
ENDDO;ENDDO;ENDDO
ENDDO;ENDDO
END SUBROUTINE compute_dougherty
!******************************************************************************!
!! Doughtery driftkinetic collision operator for electrons
!******************************************************************************!
SUBROUTINE DoughertyDK_ee(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_,ij_,iky_,ikx_,iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
COMPLEX(dp) :: upar, Tpar, Tperp
REAL(dp) :: j_dp, p_dp
!** Auxiliary variables **
p_dp = REAL(parray_e(ip_),dp)
j_dp = REAL(jarray_e(ij_),dp)
!** Assembling collison operator **
TColl_ = -(p_dp + 2._dp*j_dp)*nadiab_moments_e(ip_,ij_,iky_,ikx_,iz_)
IF( (p_dp .EQ. 1._dp) .AND. (j_dp .EQ. 0._dp)) THEN !Ce10
TColl_ = TColl_ + nadiab_moments_e(ip1_e,1,iky_,ikx_,iz_)
ELSEIF( (p_dp .EQ. 2._dp) .AND. (j_dp .EQ. 0._dp)) THEN ! Ce20
TColl_ = TColl_ + twothird*nadiab_moments_e(ip2_e,1,iky_,ikx_,iz_) &
- SQRT2*twothird*nadiab_moments_e(ip0_e,2,iky_,ikx_,iz_)
ELSEIF( (p_dp .EQ. 0._dp) .AND. (j_dp .EQ. 1._dp)) THEN ! Ce01
TColl_ = TColl_ + 2._dp*twothird*nadiab_moments_e(ip0_e,2,iky_,ikx_,iz_) &
- SQRT2*twothird*nadiab_moments_e(ip2_e,1,iky_,ikx_,iz_)
ENDIF
TColl_ = nu_ee * TColl_
END SUBROUTINE DoughertyDK_ee
!******************************************************************************!
!! Doughtery driftkinetic collision operator for ions
!******************************************************************************!
SUBROUTINE DoughertyDK_ii(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_,ij_,iky_,ikx_,iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
COMPLEX(dp) :: upar, Tpar, Tperp
REAL(dp) :: j_dp, p_dp
!** Auxiliary variables **
p_dp = REAL(parray_i(ip_),dp)
j_dp = REAL(jarray_i(ij_),dp)
!** Assembling collison operator **
TColl_ = -(p_dp + 2._dp*j_dp)*nadiab_moments_i(ip_,ij_,iky_,ikx_,iz_)
IF( (p_dp .EQ. 1._dp) .AND. (j_dp .EQ. 0._dp)) THEN ! kronecker p1j0
TColl_ = TColl_ + nadiab_moments_i(ip1_i,1,iky_,ikx_,iz_)
ELSEIF( (p_dp .EQ. 2._dp) .AND. (j_dp .EQ. 0._dp)) THEN ! kronecker p2j0
TColl_ = TColl_ + twothird*nadiab_moments_i(ip2_i,1,iky_,ikx_,iz_) &
- SQRT2*twothird*nadiab_moments_i(ip0_i,2,iky_,ikx_,iz_)
ELSEIF( (p_dp .EQ. 0._dp) .AND. (j_dp .EQ. 1._dp)) THEN ! kronecker p0j1
TColl_ = TColl_ + 2._dp*twothird*nadiab_moments_i(ip0_i,2,iky_,ikx_,iz_) &
- SQRT2*twothird*nadiab_moments_i(ip2_i,1,iky_,ikx_,iz_)
ENDIF
TColl_ = nu_i * TColl_
END SUBROUTINE DoughertyDK_ii
!******************************************************************************!
!! Doughtery gyrokinetic collision operator for electrons
!******************************************************************************!
SUBROUTINE DoughertyGK_ee(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_,ij_,iky_,ikx_,iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
COMPLEX(dp) :: n_,upar_,uperp_,Tpar_, Tperp_, T_
COMPLEX(dp) :: nadiab_moment_0j
REAL(dp) :: Knp0, Knp1, Knm1, kp
INTEGER :: in_, eo_
REAL(dp) :: n_dp, j_dp, p_dp, be_, be_2
!** Auxiliary variables **
p_dp = REAL(parray_e(ip_),dp)
eo_ = MODULO(parray_e(ip_),2)
j_dp = REAL(jarray_e(ij_),dp)
kp = kparray(iky_,ikx_,iz_,eo_)
be_2 = kp**2 * sigmae2_taue_o2 ! this is (be/2)^2
be_ = 2_dp*kp * sqrt_sigmae2_taue_o2 ! this is be
!** Assembling collison operator **
! Velocity-space diffusion (similar to Lenard Bernstein)
! -nuee (p + 2j + b^2/2) Nepj
TColl_ = -(p_dp + 2._dp*j_dp + 2._dp*be_2)*nadiab_moments_e(ip_,ij_,iky_,ikx_,iz_)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF( p_dp .EQ. 0 ) THEN ! Kronecker p0
!** build required fluid moments **
n_ = 0._dp
upar_ = 0._dp; uperp_ = 0._dp
Tpar_ = 0._dp; Tperp_ = 0._dp
DO in_ = 1,jmaxe+1
n_dp = REAL(in_-1,dp)
! Store the kernels for sparing readings
Knp0 = Kernel_e(in_ ,iky_,ikx_,iz_,eo_)
Knp1 = Kernel_e(in_+1,iky_,ikx_,iz_,eo_)
Knm1 = Kernel_e(in_-1,iky_,ikx_,iz_,eo_)
! Nonadiabatic moments (only different from moments when p=0)
nadiab_moment_0j = nadiab_moments_e(ip0_e,in_,iky_,ikx_,iz_)
! Density
n_ = n_ + Knp0 * nadiab_moment_0j
! Perpendicular velocity
uperp_ = uperp_ + be_*0.5_dp*(Knp0 - Knm1) * nadiab_moment_0j
! Parallel temperature
Tpar_ = Tpar_ + Knp0 * (SQRT2*nadiab_moments_e(ip2_e,in_,iky_,ikx_,iz_) + nadiab_moment_0j)
! Perpendicular temperature
Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j
ENDDO
T_ = (Tpar_ + 2._dp*Tperp_)/3._dp - n_
! Add energy restoring term
TColl_ = TColl_ + T_* 4._dp * j_dp * Kernel_e(ij_ ,iky_,ikx_,iz_,eo_)
TColl_ = TColl_ - T_* 2._dp * (j_dp + 1._dp) * Kernel_e(ij_+1,iky_,ikx_,iz_,eo_)
TColl_ = TColl_ - T_* 2._dp * j_dp * Kernel_e(ij_-1,iky_,ikx_,iz_,eo_)
TColl_ = TColl_ + uperp_*be_* (Kernel_e(ij_,iky_,ikx_,iz_,eo_) - Kernel_e(ij_-1,iky_,ikx_,iz_,eo_))
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ELSEIF( p_dp .eq. 1 ) THEN ! kronecker p1
!** build required fluid moments **
upar_ = 0._dp
DO in_ = 1,jmaxe+1
! Parallel velocity
upar_ = upar_ + Kernel_e(in_,iky_,ikx_,iz_,eo_) * nadiab_moments_e(ip1_e,in_,iky_,ikx_,iz_)
ENDDO
TColl_ = TColl_ + upar_*Kernel_e(ij_,iky_,ikx_,iz_,eo_)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ELSEIF( p_dp .eq. 2 ) THEN ! kronecker p2
!** build required fluid moments **
n_ = 0._dp
upar_ = 0._dp; uperp_ = 0._dp
Tpar_ = 0._dp; Tperp_ = 0._dp
DO in_ = 1,jmaxe+1
n_dp = REAL(in_-1,dp)
! Store the kernels for sparing readings
Knp0 = Kernel_e(in_ ,iky_,ikx_,iz_,eo_)
Knp1 = Kernel_e(in_+1,iky_,ikx_,iz_,eo_)
Knm1 = Kernel_e(in_-1,iky_,ikx_,iz_,eo_)
! Nonadiabatic moments (only different from moments when p=0)
nadiab_moment_0j = nadiab_moments_e(ip0_e,in_,iky_,ikx_,iz_)
! Density
n_ = n_ + Knp0 * nadiab_moment_0j
! Parallel temperature
Tpar_ = Tpar_ + Knp0 * (SQRT2*nadiab_moments_e(ip2_e,in_,iky_,ikx_,iz_) + nadiab_moment_0j)
! Perpendicular temperature
Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j
ENDDO
T_ = (Tpar_ + 2._dp*Tperp_)/3._dp - n_
TColl_ = TColl_ + T_*SQRT2*Kernel_e(ij_,iky_,ikx_,iz_,eo_)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ENDIF
! Multiply by electron-electron collision coefficient
TColl_ = nu_ee * TColl_
END SUBROUTINE DoughertyGK_ee
!******************************************************************************!
!! Doughtery gyrokinetic collision operator for ions
!******************************************************************************!
SUBROUTINE DoughertyGK_ii(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_,ij_,iky_,ikx_,iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
COMPLEX(dp) :: n_,upar_,uperp_,Tpar_, Tperp_, T_
COMPLEX(dp) :: bi_, bi_2
COMPLEX(dp) :: nadiab_moment_0j
REAL(dp) :: Knp0, Knp1, Knm1, kp
INTEGER :: in_, eo_
REAL(dp) :: n_dp, j_dp, p_dp
!** Auxiliary variables **
p_dp = REAL(parray_i(ip_),dp)
eo_ = MODULO(parray_i(ip_),2)
j_dp = REAL(jarray_i(ij_),dp)
kp = kparray(iky_,ikx_,iz_,eo_)
bi_2 = kp**2 *sigmai2_taui_o2 ! this is (bi/2)^2
bi_ = 2_dp*kp*sqrt_sigmai2_taui_o2 ! this is bi
!** Assembling collison operator **
! Velocity-space diffusion (similar to Lenard Bernstein)
! -nui (p + 2j + b^2/2) Nipj
TColl_ = -(p_dp + 2._dp*j_dp + 2._dp*bi_2)*nadiab_moments_i(ip_,ij_,iky_,ikx_,iz_)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 0 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IF( p_dp .EQ. 0 ) THEN ! Kronecker p0
!** build required fluid moments **
n_ = 0._dp
upar_ = 0._dp; uperp_ = 0._dp
Tpar_ = 0._dp; Tperp_ = 0._dp
DO in_ = 1,jmaxi+1
n_dp = REAL(in_-1,dp)
! Store the kernels for sparing readings
Knp0 = Kernel_i(in_ ,iky_,ikx_,iz_,eo_)
Knp1 = Kernel_i(in_+1,iky_,ikx_,iz_,eo_)
Knm1 = Kernel_i(in_-1,iky_,ikx_,iz_,eo_)
! Nonadiabatic moments (only different from moments when p=0)
nadiab_moment_0j = nadiab_moments_i(ip0_i,in_,iky_,ikx_,iz_)
! Density
n_ = n_ + Knp0 * nadiab_moment_0j
! Perpendicular velocity
uperp_ = uperp_ + bi_*0.5_dp*(Knp0 - Knm1) * nadiab_moment_0j
! Parallel temperature
Tpar_ = Tpar_ + Knp0 * (SQRT2*nadiab_moments_i(ip2_i,in_,iky_,ikx_,iz_) + nadiab_moment_0j)
! Perpendicular temperature
Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j
ENDDO
T_ = (Tpar_ + 2._dp*Tperp_)*onethird - n_
! Add energy restoring term
TColl_ = TColl_ + T_* 4._dp * j_dp * Kernel_i(ij_ ,iky_,ikx_,iz_,eo_)
TColl_ = TColl_ - T_* 2._dp * (j_dp + 1._dp) * Kernel_i(ij_+1,iky_,ikx_,iz_,eo_)
TColl_ = TColl_ - T_* 2._dp * j_dp * Kernel_i(ij_-1,iky_,ikx_,iz_,eo_)
TColl_ = TColl_ + uperp_*bi_* (Kernel_i(ij_,iky_,ikx_,iz_,eo_) - Kernel_i(ij_-1,iky_,ikx_,iz_,eo_))
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ELSEIF( p_dp .eq. 1 ) THEN ! kxonecker p1
!** build required fluid moments **
upar_ = 0._dp
DO in_ = 1,jmaxi+1
! Parallel velocity
upar_ = upar_ + Kernel_i(in_,iky_,ikx_,iz_,eo_) * nadiab_moments_i(ip1_i,in_,iky_,ikx_,iz_)
ENDDO
TColl_ = TColl_ + upar_*Kernel_i(ij_,iky_,ikx_,iz_,eo_)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Non zero term for p = 2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ELSEIF( p_dp .eq. 2 ) THEN ! kxonecker p2
!** build required fluid moments **
n_ = 0._dp
upar_ = 0._dp; uperp_ = 0._dp
Tpar_ = 0._dp; Tperp_ = 0._dp
DO in_ = 1,jmaxi+1
n_dp = REAL(in_-1,dp)
! Store the kernels for sparing readings
Knp0 = Kernel_i(in_ ,iky_,ikx_,iz_,eo_)
Knp1 = Kernel_i(in_+1,iky_,ikx_,iz_,eo_)
Knm1 = Kernel_i(in_-1,iky_,ikx_,iz_,eo_)
! Nonadiabatic moments (only different from moments when p=0)
nadiab_moment_0j = nadiab_moments_i(ip0_i,in_,iky_,ikx_,iz_)
! Density
n_ = n_ + Knp0 * nadiab_moment_0j
! Parallel temperature
Tpar_ = Tpar_ + Knp0 * (SQRT2*nadiab_moments_i(ip2_i,in_,iky_,ikx_,iz_) + nadiab_moment_0j)
! Perpendicular temperature
Tperp_ = Tperp_ + ((2._dp*n_dp+1._dp)*Knp0 - (n_dp+1._dp)*Knp1 - n_dp*Knm1)*nadiab_moment_0j
ENDDO
T_ = (Tpar_ + 2._dp*Tperp_)*onethird - n_
TColl_ = TColl_ + T_*SQRT2*Kernel_i(ij_,iky_,ikx_,iz_,eo_)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ENDIF
! Multiply by ion-ion collision coefficient
TColl_ = nu_i * TColl_
END SUBROUTINE DoughertyGK_ii
!******************************************************************************!
!! compute the collision terms in a (Np x Nj x Nkx x Nky) matrix all at once
!******************************************************************************!
SUBROUTINE compute_cosolver_coll
IMPLICIT NONE
COMPLEX(dp), DIMENSION(1:total_np_e) :: local_sum_e, buffer_e, total_sum_e
COMPLEX(dp), DIMENSION(ips_e:ipe_e) :: TColl_distr_e
COMPLEX(dp), DIMENSION(1:total_np_i) :: local_sum_i, buffer_i, total_sum_i
COMPLEX(dp), DIMENSION(ips_i:ipe_i) :: TColl_distr_i
COMPLEX(dp) :: TColl
INTEGER :: ikxs_C, ikxe_C, ikys_C, ikye_C
DO iz = izs,ize
DO ikx = ikxs,ikxe
DO iky = ikys,ikye
IF(KIN_E) THEN
DO ij = 1,Jmaxe+1
! Electrons
! Loop over all p to compute sub collision term
DO ip = 1,total_np_e
CALL apply_COSOlver_mat_e(ip,ij,iky,ikx,iz,TColl)
local_sum_e(ip) = TColl
ENDDO
IF (num_procs_p .GT. 1) THEN
! Sum up all the sub collision terms on root 0
CALL MPI_REDUCE(local_sum_e, buffer_e, total_np_e, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, comm_p, ierr)
! distribute the sum over the process among p
CALL MPI_SCATTERV(buffer_e, counts_np_e, displs_np_e, MPI_DOUBLE_COMPLEX,&
TColl_distr_e, local_np_e, MPI_DOUBLE_COMPLEX,&
0, comm_p, ierr)
ELSE
TColl_distr_e = local_sum_e
ENDIF
! Write in output variable
DO ip = ips_e,ipe_e
TColl_e(ip,ij,iky,ikx,iz) = TColl_distr_e(ip)
ENDDO
ENDDO
ENDIF
! Ions
DO ij = 1,Jmaxi+1
DO ip = 1,total_np_i
CALL apply_COSOlver_mat_i(ip,ij,iky,ikx,iz,TColl)
local_sum_i(ip) = TColl
ENDDO
IF (num_procs_p .GT. 1) THEN
! Reduce the local_sums to root = 0
CALL MPI_REDUCE(local_sum_i, buffer_i, total_np_i, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, comm_p, ierr)
! buffer contains the entire collision term along p, we scatter it between
! the other processes (use of scatterv since Pmax/Np is not an integer)
CALL MPI_SCATTERV(buffer_i, counts_np_i, displs_np_i, MPI_DOUBLE_COMPLEX,&
TColl_distr_i, local_np_i, MPI_DOUBLE_COMPLEX, &
0, comm_p, ierr)
ELSE
TColl_distr_i = local_sum_i
ENDIF
! Write in output variable
DO ip = ips_i,ipe_i
TColl_i(ip,ij,iky,ikx,iz) = TColl_distr_i(ip)
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
END SUBROUTINE compute_cosolver_coll
!******************************************************************************!
!!!!!!! Compute electron collision term
!******************************************************************************!
SUBROUTINE apply_COSOlver_mat_e(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_, ij_ ,ikx_, iky_, iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
INTEGER :: ip2,ij2, p_int,j_int, p2_int,j2_int, iky_C, ikx_C, iz_C
p_int = parray_e_full(ip_); j_int = jarray_e_full(ij_);
IF (gyrokin_CO) THEN ! GK operator (k-dependant)
ikx_C = ikx_; iky_C = iky_; iz_C = iz_
ELSE ! DK operator (only one mat for every k)
ikx_C = 1; iky_C = 1; iz_C = 1;
ENDIF
TColl_ = 0._dp ! Initialization of the local sum
! sum the electron-self and electron-ion test terms
ploopee: DO ip2 = ips_e,ipe_e
p2_int = parray_e(ip2)
jloopee: DO ij2 = ijs_e,ije_e
j2_int = jarray_e(ij2)
IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxe))&
TColl_ = TColl_ + nadiab_moments_e(ip2,ij2,iky_,ikx_,iz_) &
*( nu_e * CeipjT(bare(p_int,j_int), bare(p2_int,j2_int),iky_C, ikx_C, iz_C) &
+nu_ee * Ceepj (bare(p_int,j_int), bare(p2_int,j2_int),iky_C, ikx_C, iz_C))
ENDDO jloopee
ENDDO ploopee
! sum the electron-ion field terms
ploopei: DO ip2 = ips_i,ipe_i
p2_int = parray_i(ip2)
jloopei: DO ij2 = ijs_i,ije_i
j2_int = jarray_i(ij2)
IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxi))&
TColl_ = TColl_ + nadiab_moments_i(ip2,ij2,iky_,ikx_,iz_) &
*(nu_e * CeipjF(bare(p_int,j_int), bari(p2_int,j2_int),iky_C, ikx_C, iz_C))
END DO jloopei
ENDDO ploopei
END SUBROUTINE apply_COSOlver_mat_e
!******************************************************************************!
!!!!!!! Compute ion collision term
!******************************************************************************!
SUBROUTINE apply_COSOlver_mat_i(ip_,ij_,iky_,ikx_,iz_,TColl_)
IMPLICIT NONE
INTEGER, INTENT(IN) :: ip_, ij_ ,ikx_, iky_, iz_
COMPLEX(dp), INTENT(OUT) :: TColl_
INTEGER :: ip2,ij2, p_int,j_int, p2_int,j2_int, iky_C, ikx_C, iz_C
p_int = parray_i_full(ip_); j_int = jarray_i_full(ij_);
IF (gyrokin_CO) THEN ! GK operator (k-dependant)
ikx_C = ikx_; iky_C = iky_; iz_C = iz_;
ELSE ! DK operator (only one mat for every k)
ikx_C = 1; iky_C = 1; iz_C = 1;
ENDIF
TColl_ = 0._dp ! Initialization
! sum the ion-self and ion-electron test terms
ploopii: DO ip2 = ips_i,ipe_i
p2_int = parray_i(ip2)
jloopii: DO ij2 = ijs_i,ije_i
j2_int = jarray_i(ij2)
IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxi))&
! Ion-ion collision
TColl_ = TColl_ + nadiab_moments_i(ip2,ij2,iky_,ikx_,iz_) &
* nu_i * Ciipj (bari(p_int,j_int), bari(p2_int,j2_int), iky_C, ikx_C, iz_C)
IF(KIN_E) & ! Ion-electron collision test
TColl_ = TColl_ + nadiab_moments_i(ip2,ij2,iky_,ikx_,iz_) &
* nu_ie * CiepjT(bari(p_int,j_int), bari(p2_int,j2_int), iky_C, ikx_C, iz_C)
ENDDO jloopii
ENDDO ploopii
IF(KIN_E) THEN ! Ion-electron collision field
ploopie: DO ip2 = ips_e,ipe_e ! sum the ion-electron field terms
p2_int = parray_e(ip2)
jloopie: DO ij2 = ijs_e,ije_e
j2_int = jarray_e(ij2)
IF((CLOS .NE. 1) .OR. (p2_int+2*j2_int .LE. dmaxe))&
TColl_ = TColl_ + nadiab_moments_e(ip2,ij2,iky_,ikx_,iz_) &
*(nu_ie * CiepjF(bari(p_int,j_int), bare(p2_int,j2_int), iky_C, ikx_C, iz_C))
ENDDO jloopie
ENDDO ploopie
ENDIF
END SUBROUTINE apply_COSOlver_mat_i
!******************************************************************************!
!!!!!!! Load the collision matrix coefficient table from COSOlver results
!******************************************************************************!
SUBROUTINE load_COSOlver_mat ! Load a sub matrix from iCa files (works for pmaxa,jmaxa<=P_full,J_full)
IMPLICIT NONE
! Indices for row and columns of the COSOlver matrix (4D compressed 2D matrices)
INTEGER :: irow_sub, irow_full, icol_sub, icol_full
INTEGER :: fid ! file indexation
INTEGER :: ip_e, ij_e, il_e, ik_e, ikps_C, ikpe_C ! indices for electrons loops
REAL(dp), DIMENSION(2) :: dims_e
INTEGER :: pdime, jdime ! dimensions of the COSOlver matrices
REAL(dp), DIMENSION(:,:), ALLOCATABLE :: Ceepj_full, CeipjT_full ! To load the entire matrix
REAL(dp), DIMENSION(:,:), ALLOCATABLE :: CeipjF_full ! ''
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ceepj__kp, CeipjT_kp ! To store the coeff that will be used along kperp
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: CeipjF_kp ! ''
INTEGER :: ip_i, ij_i, il_i, ik_i ! same for ions
INTEGER, DIMENSION(2) :: dims_i
INTEGER :: pdimi, jdimi ! dimensions of the COSOlver matrices
REAL(dp), DIMENSION(:,:), ALLOCATABLE :: Ciipj_full, CiepjT_full ! .
REAL(dp), DIMENSION(:,:), ALLOCATABLE :: CiepjF_full ! .
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: Ciipj__kp, CiepjT_kp ! .
REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: CiepjF_kp ! .
INTEGER :: NFLR
REAL(dp), DIMENSION(:), ALLOCATABLE :: kp_grid_mat ! kperp grid of the matrices
INTEGER :: ikp_next, ikp_prev, nkp_mat, ikp_mat
REAL(dp) :: kp_max
REAL(dp) :: kp_next, kp_prev, kperp_sim, kperp_mat, zerotoone, be_2, bi_2
CHARACTER(len=128) :: var_name, kperp_string, ikp_string
!! Some terminal info
SELECT CASE (collision_model)
CASE ('SG')
IF (my_id .EQ. 0) WRITE(*,*) '=== Load Sugama matrix ==='
CASE ('LR')
IF (my_id .EQ. 0) WRITE(*,*) '=== Load Lorentz matrix ==='
CASE ('LD')
IF (my_id .EQ. 0) WRITE(*,*) '=== Load Landau matrix ==='
END SELECT
SELECT CASE (gyrokin_CO)
CASE (.true.)
IF (my_id .EQ. 0) WRITE(*,*) '..gyrokinetic model..'
CASE (.false.)
IF (my_id .EQ. 0) WRITE(*,*) '..driftkinetic model..'
END SELECT
! Opening the compiled cosolver matrices results
if(my_id.EQ.0)write(*,*) mat_file
CALL openf(mat_file,fid, 'r', 'D', mpicomm=comm_p);
! Get matrices dimensions (polynomials degrees and kperp grid)
CALL getarr(fid, '/dims_e', dims_e) ! Get the electron polynomial degrees
pdime = dims_e(1); jdime = dims_e(2);
CALL getarr(fid, '/dims_i', dims_i) ! Get the ion polynomial degrees
pdimi = dims_i(1); jdimi = dims_i(2);
IF ( ((pdime .LT. pmaxe) .OR. (jdime .LT. jmaxe)) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Pe,Je Matrix too small !!'
IF ( ((pdimi .LT. pmaxi) .OR. (jdimi .LT. jmaxi)) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Pi,Ji Matrix too small !!'
CALL getsize(fid, '/coordkperp', nkp_mat) ! Get the dimension kperp grid of the matrices
CALL allocate_array(kp_grid_mat, 1,nkp_mat)
CALL getarr(fid, '/coordkperp', kp_grid_mat)
! check that we have enough kperps mat
IF (LINEARITY .NE. 'linear') THEN
IF ( (kp_grid_mat(nkp_mat) .LT. 2./3.*kp_max) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Matrix kperp grid too small !!'
ELSE
IF ( (kp_grid_mat(nkp_mat) .LT. kp_max) .AND. (my_id .EQ. 0)) WRITE(*,*) '!! Matrix kperp grid too small !!'
ENDIF
IF (gyrokin_CO) THEN ! GK operator (k-dependant)
ikps_C = 1; ikpe_C = nkp_mat
ELSE ! DK operator (only one mat for all k)
ikps_C = 1; ikpe_C = 1
ENDIF
CALL allocate_array( Ceepj__kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C)
CALL allocate_array( CeipjT_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C)
CALL allocate_array( CeipjF_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C)
CALL allocate_array( Ciipj__kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C)
CALL allocate_array( CiepjT_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C)
CALL allocate_array( CiepjF_kp, 1,(pmaxe+1)*(jmaxe+1), 1,(pmaxe+1)*(jmaxe+1), ikps_C,ikpe_C)
DO ikp = ikps_C,ikpe_C ! Loop over everz kperp values
! Kperp value in string format to select in cosolver hdf5 file
IF (gyrokin_CO) THEN
write(ikp_string,'(i5.5)') ikp-1
ELSE
write(ikp_string,'(i5.5)') 0
ENDIF
!!!!!!!!!!!! E-E matrices !!!!!!!!!!!!
! get the self electron colision matrix
! Allocate space for storing full collision matrix
CALL allocate_array( Ceepj_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1))
! Naming of the array to load (kperp dependant)
WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Caapj/Ceepj'
CALL getarr(fid, var_name, Ceepj_full) ! get array (moli format)
! Fill sub array with the usefull polynmial degrees only
DO ip_e = 0,pmaxe ! Loop over rows
DO ij_e = 0,jmaxe
irow_sub = (jmaxe +1)*ip_e + ij_e +1
irow_full = (jdime +1)*ip_e + ij_e +1
DO il_e = 0,pmaxe ! Loop over columns
DO ik_e = 0,jmaxe
icol_sub = (jmaxe +1)*il_e + ik_e +1
icol_full = (jdime +1)*il_e + ik_e +1
Ceepj__kp (irow_sub,icol_sub,ikp) = Ceepj_full (irow_full,icol_full)
ENDDO
ENDDO
ENDDO
ENDDO
DEALLOCATE(Ceepj_full)
!!!!!!!!!!!!!!! I-I matrices !!!!!!!!!!!!!!
! get the self electron colision matrix
CALL allocate_array( Ciipj_full, 1,(pdimi+1)*(jdimi+1), 1,(pdimi+1)*(jdimi+1))
WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Caapj/Ciipj'
CALL getarr(fid, var_name, Ciipj_full) ! get array (moli format)
! Fill sub array with only usefull polynmials degree
DO ip_i = 0,Pmaxi ! Loop over rows
DO ij_i = 0,Jmaxi
irow_sub = (Jmaxi +1)*ip_i + ij_i +1
irow_full = (jdimi +1)*ip_i + ij_i +1
DO il_i = 0,Pmaxi ! Loop over columns
DO ik_i = 0,Jmaxi
icol_sub = (Jmaxi +1)*il_i + ik_i +1
icol_full = (jdimi +1)*il_i + ik_i +1
Ciipj__kp (irow_sub,icol_sub,ikp) = Ciipj_full (irow_full,icol_full)
ENDDO
ENDDO
ENDDO
ENDDO
DEALLOCATE(Ciipj_full)
IF(interspecies) THEN ! Pitch angle is only applied on like-species
!!!!!!!!!!!!!!! E-I matrices !!!!!!!!!!!!!!
! Get test and field e-i collision matrices
CALL allocate_array( CeipjT_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1))
CALL allocate_array( CeipjF_full, 1,(pdime+1)*(jdime+1), 1,(pdimi+1)*(jdimi+1))
WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Ceipj/CeipjT'
CALL getarr(fid, var_name, CeipjT_full)
WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Ceipj/CeipjF'
CALL getarr(fid, var_name, CeipjF_full)
! Fill sub array with only usefull polynmials degree
DO ip_e = 0,pmaxe ! Loop over rows
DO ij_e = 0,jmaxe
irow_sub = (jmaxe +1)*ip_e + ij_e +1
irow_full = (jdime +1)*ip_e + ij_e +1
DO il_e = 0,pmaxe ! Loop over columns
DO ik_e = 0,jmaxe
icol_sub = (jmaxe +1)*il_e + ik_e +1
icol_full = (jdime +1)*il_e + ik_e +1
CeipjT_kp(irow_sub,icol_sub,ikp) = CeipjT_full(irow_full,icol_full)
ENDDO
ENDDO
DO il_i = 0,pmaxi ! Loop over columns
DO ik_i = 0,jmaxi
icol_sub = (Jmaxi +1)*il_i + ik_i +1
icol_full = (jdimi +1)*il_i + ik_i +1
CeipjF_kp(irow_sub,icol_sub,ikp) = CeipjF_full(irow_full,icol_full)
ENDDO
ENDDO
ENDDO
ENDDO
DEALLOCATE(CeipjF_full)
DEALLOCATE(CeipjT_full)
!!!!!!!!!!!!!!! I-E matrices !!!!!!!!!!!!!!
! get the Test and Back field electron ion collision matrix
CALL allocate_array( CiepjT_full, 1,(pdimi+1)*(jdimi+1), 1,(pdimi+1)*(jdimi+1))
CALL allocate_array( CiepjF_full, 1,(pdimi+1)*(jdimi+1), 1,(pdime+1)*(jdime+1))
WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Ciepj/CiepjT'
CALL getarr(fid, var_name, CiepjT_full)
WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Ciepj/CiepjF'
CALL getarr(fid, var_name, CiepjF_full)
! Fill sub array with only usefull polynmials degree
DO ip_i = 0,Pmaxi ! Loop over rows
DO ij_i = 0,Jmaxi
irow_sub = (Jmaxi +1)*ip_i + ij_i +1
irow_full = (jdimi +1)*ip_i + ij_i +1
DO il_i = 0,Pmaxi ! Loop over columns
DO ik_i = 0,Jmaxi
icol_sub = (Jmaxi +1)*il_i + ik_i +1
icol_full = (jdimi +1)*il_i + ik_i +1
CiepjT_kp(irow_sub,icol_sub,ikp) = CiepjT_full(irow_full,icol_full)
ENDDO
ENDDO
DO il_e = 0,pmaxe ! Loop over columns
DO ik_e = 0,jmaxe
icol_sub = (jmaxe +1)*il_e + ik_e +1
icol_full = (jdime +1)*il_e + ik_e +1
CiepjF_kp(irow_sub,icol_sub,ikp) = CiepjF_full(irow_full,icol_full)
ENDDO
ENDDO
ENDDO
ENDDO
DEALLOCATE(CiepjF_full)
DEALLOCATE(CiepjT_full)
ELSE
CeipjT_kp = 0._dp; CeipjF_kp = 0._dp; CiepjT_kp = 0._dp; CiepjF_kp = 0._dp;
ENDIF
ENDDO
CALL closef(fid)
IF (gyrokin_CO) THEN ! Interpolation of the kperp matrix values on kx ky grid
IF (my_id .EQ. 0 ) WRITE(*,*) '...Interpolation from matrices kperp to simulation kx,ky...'
DO ikx = ikxs,ikxe
DO iky = ikys,ikye
DO iz = izs,ize
! Check for nonlinear case if we are in the anti aliased domain or the filtered one
kperp_sim = kparray(iky,ikx,iz,0) ! current simulation kperp
! Find the interval in kp grid mat where kperp_sim is contained
! Loop over the whole kp mat grid to find the smallest kperp that is
! larger than the current kperp_sim (brute force...)
DO ikp=1,nkp_mat
ikp_mat = ikp ! the first indice of the interval (k0)
kperp_mat = kp_grid_mat(ikp)
IF(kperp_mat .GT. kperp_sim) EXIT ! a matrix with kperp2 > current kx2 + ky2 has been found
ENDDO
! Interpolation
! interval boundaries
ikp_next = ikp_mat !index of k1 (larger than kperp_sim thanks to previous loop)
ikp_prev = ikp_mat - 1 !index of k0 (smaller neighbour to interpolate inbetween)
if ( (kp_grid_mat(ikp_prev) .GT. kperp_sim) .OR. (kp_grid_mat(ikp_next) .LT. kperp_sim) ) THEN
! write(*,*) 'Warning, linear interp of collision matrix failed!! '
! write(*,*) kp_grid_mat(ikp_prev), '<', kperp_sim, '<', kp_grid_mat(ikp_next)
ENDIF
! 0->1 variable for linear interp, i.e. zero2one = (k-k0)/(k1-k0)
zerotoone = (kperp_sim - kp_grid_mat(ikp_prev))/(kp_grid_mat(ikp_next) - kp_grid_mat(ikp_prev))
! Linear interpolation between previous and next kperp matrix values
Ceepj (:,:,iky,ikx,iz) = (Ceepj__kp(:,:,ikp_next) - Ceepj__kp(:,:,ikp_prev))*zerotoone + Ceepj__kp(:,:,ikp_prev)
Ciipj (:,:,iky,ikx,iz) = (Ciipj__kp(:,:,ikp_next) - Ciipj__kp(:,:,ikp_prev))*zerotoone + Ciipj__kp(:,:,ikp_prev)
IF(interspecies) THEN
CeipjT(:,:,iky,ikx,iz) = (CeipjT_kp(:,:,ikp_next) - CeipjT_kp(:,:,ikp_prev))*zerotoone + CeipjT_kp(:,:,ikp_prev)
CeipjF(:,:,iky,ikx,iz) = (CeipjF_kp(:,:,ikp_next) - CeipjF_kp(:,:,ikp_prev))*zerotoone + CeipjF_kp(:,:,ikp_prev)
CiepjT(:,:,iky,ikx,iz) = (CiepjT_kp(:,:,ikp_next) - CiepjT_kp(:,:,ikp_prev))*zerotoone + CiepjT_kp(:,:,ikp_prev)
CiepjF(:,:,iky,ikx,iz) = (CiepjF_kp(:,:,ikp_next) - CiepjF_kp(:,:,ikp_prev))*zerotoone + CiepjF_kp(:,:,ikp_prev)
ELSE
CeipjT(:,:,iky,ikx,iz) = 0._dp
CeipjF(:,:,iky,ikx,iz) = 0._dp
CiepjT(:,:,iky,ikx,iz) = 0._dp
CiepjF(:,:,iky,ikx,iz) = 0._dp
ENDIF
ENDDO
ENDDO
ENDDO
ELSE ! DK -> No kperp dep, copy simply to final collision matrices
Ceepj (:,:,1,1,1) = Ceepj__kp(:,:,1)
CeipjT(:,:,1,1,1) = CeipjT_kp(:,:,1)
CeipjF(:,:,1,1,1) = CeipjF_kp(:,:,1)
Ciipj (:,:,1,1,1) = Ciipj__kp(:,:,1)
CiepjT(:,:,1,1,1) = CiepjT_kp(:,:,1)
CiepjF(:,:,1,1,1) = CiepjF_kp(:,:,1)
ENDIF
! Deallocate auxiliary variables
DEALLOCATE (Ceepj__kp); DEALLOCATE (CeipjT_kp); DEALLOCATE (CeipjF_kp)
DEALLOCATE (Ciipj__kp); DEALLOCATE (CiepjT_kp); DEALLOCATE (CiepjF_kp)
IF( .NOT. interspecies ) THEN
IF(my_id.EQ.0) write(*,*) "--Like Species operator--"
CeipjF = 0._dp;
CeipjT = 0._dp;
CiepjF = 0._dp;
CiepjT = 0._dp;
ENDIF
IF (my_id .EQ. 0) WRITE(*,*) '============DONE==========='
END SUBROUTINE load_COSOlver_mat
!******************************************************************************!
end module collision
c4science · Help