Homec4science
Diffusion COSOlver (master) Browse

cosolver/src/self_colls_mod.f90
5a16512d28damaster

Last Change
Raw File

self_colls_mod.f90
View Options

MODULE self_colls
! self collisions module
USE PREC_CONST
USE BASIC
USE BASIC_MPI
USE MODEL
USE ARRAY, ONLY: Ceedp,Ciidp,rCee,rCii
USE OPERATOR_MODEL
USE OUTPUT
USE GRID
use restart
use auxval
use gkcoulomb
IMPLICIT NONE
PROCEDURE(Caa_sub), POINTER :: evaluate_Cii_collisional_matrix => null()
PROCEDURE(Caa_sub), POINTER :: evaluate_Cee_collisional_matrix => null()
ABSTRACT INTERFACE
SUBROUTINE Caa_sub
! Empty
END SUBROUTINE Caa_sub
END INTERFACE
CONTAINS
!_______________________________________________________________________
SUBROUTINE set_self_colls(ss)
! set self collisions parameters to species s
IMPLICIT NONE
!
!
CHARACTER(len=2),INTENT(IN):: ss
!
CALL set_model(ss) ! ... set temperature/mass ratio to 1 for both a = [e,i]
!
CALL set_basic(ss)
!
!
END SUBROUTINE set_self_colls
!
!_______________________________________________________________________
! electron-electron collision
SUBROUTINE ee_colls_control
!
IMPLICIT NONE
!
IF(me_self .eq. 0) WRITE(*,*) '====== Electron-Electron Collisions ======='
IF( ESELF .ne. 0 ) THEN
IF(me_self .eq. 0) WRITE(*,*) 'Set Electron-Electron Collisions ...'
CALL set_self_colls('ee') ! ... electrons-slef collision
CALL evaluate_auxval_field
IF(me_self .eq. 0) WRITE(*,*) 'Construct self collisional matrix Cee ... '
call set_Cee_collisional_matrix
call evaluate_Cee_collisional_matrix
ENDIF
!
!
END SUBROUTINE ee_colls_control
!
!_______________________________________________________________________
!
SUBROUTINE set_Cee_collisional_matrix
! Set evaluate_Cee_collisional_matrix routine
IMPLICIT NONE
!
!
IF (ESELF .ne. 0 ) THEN
IF(IFGKCOULOMB ) THEN
evaluate_Cee_collisional_matrix => Cee_gk_coulomb
!
call set_gkcoulomb
bfm_ = bafm_
bpfm_ = bafm_
IF(.not. GKC_USE_FULL ) then
call load_gk_coulomb_coeffs('ee')
else
call set_tabljpmf('s')
ENDIF
!
ELSE
! Evaluate Cee
evaluate_Cee_collisional_matrix => Cee_dflt
!
ENDIF
ELSE
evaluate_Cee_collisional_matrix => Cee_zeros_dflt
ENDIF
!
!
END SUBROUTINE set_Cee_collisional_matrix
!
!_______________________________________________________________________
!
SUBROUTINE Cee_dflt
! evaluate electron-electron collision matrix
use restart
IMPLICIT NONE
! Local variables
INTEGER :: irow_tmp,lbar_start
INTEGER :: irow
INTEGER, DIMENSION(2) :: lk
! current indices for restart
INTEGER :: istep
lbar_start = lbaree_s_l
istep=1
IF( me .eq. 0 ) write(*, '(a,1x, i3,a)' ) 'Cee [x/ ', numbe(Pmaxe,Jmaxe) ,']:'
DO irow = lbar_start,lbaree_e_l
irow_tmp = rows_e(irow)
lk = invnumbe(irow_tmp)
! write(nscr,'(i3)', advance = 'no') irow
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCee(:) = ZEROFM
CALL COLLISIONSELFE(lk(1),lk(2),rCee)
Ceedp(irow,:) = TO_DP(rCee(:))
! save current state
istep = istep +1
ENDDO
!
!
END SUBROUTINE Cee_dflt
!_______________________________________________________________________
!
!
SUBROUTINE Cee_zeros_dflt
! evaluate electron-electron collision matrix
use restart
IMPLICIT NONE
! Local variables
INTEGER :: irow_tmp,lbar_start
INTEGER :: irow
INTEGER, DIMENSION(2) :: lk
! current indices for restart
INTEGER :: istep
lbar_start = lbaree_s_l
DO irow = lbar_start,lbaree_e_l
irow_tmp = rows_e(irow)
lk = invnumbe(irow_tmp)
rCee(:) = ZEROFM
Ceedp(irow,:) = TO_DP(rCee(:))
! save current state
istep = istep +1
ENDDO
!
!
END SUBROUTINE Cee_zeros_dflt
!
!-----------------------------------------------------------------
!
SUBROUTINE Cee_gk_coulomb
! Evaluate GK Coulomb
use restart
use gkcoulomb
implicit none
INTEGER :: l,k,irow, ii, icol
INTEGER :: j,n,np,istep
INTEGER :: lbar_start
INTEGER, DIMENSION(4) :: lbarjnnp
INTEGER, DIMENSION(2) :: lk
INTEGER :: count
!
!
!
lbar_start = lbaree_s_l
istep=1
!
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'Cee [x/ ', lbaree_e_l ,']:'
!
DO irow=lbar_start,lbaree_e_l
lbarjnnp = rows_e_4dim(irow,1:4)
lk = invnumbe(lbarjnnp(1))
j = lbarjnnp(2)
n = lbarjnnp(3)
np = lbarjnnp(4)
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCee(:) = ZEROFM
CALL coulombSelfGK(lk(1),lk(2),j,n,np,rCee)
Ceedp(irow,:) = TO_DP(rCee(:))
istep = istep +1
ENDDO
! Finalize GK Coulomb by performing summation over (j,np)
IF( nprocs > 1 ) THEN
DO icol =1, numbe( Pmaxe, Jmaxe)
count = (lbaree_e_l - lbaree_s_l +1 )
call mpi_gather( Ceedp(:, icol) , count, MPI_DOUBLE_PRECISION &
, Ceedp_global(:, icol), count, MPI_DOUBLE_PRECISION, 0, comm_self, ierr)
ENDDO
ELSE
Ceedp_global = Ceedp
ENDIF
Ceedp_finalized = 0._dp
IF( me_self .eq. 0) THEN
DO irow = 1, numbe( Pmaxe, Jmaxe)
DO ii = 1, lbaremax
if( rows_e_4dim( ii, 1 ) .eq. irow) THEN
Ceedp_finalized( irow, :) = Ceedp_finalized( irow, :) &
+ Ceedp_global( ii,:)
ENDIF
ENDDO
ENDDO
ENDIF
!
END SUBROUTINE Cee_gk_coulomb
!
!_______________________________________________________________________
! ion-ion collision
!
subroutine ii_colls_control
! ii_colls
implicit none
IF(me_self .eq. 0) WRITE(*,*) '====== Ion-Ion Collisions ======='
IF( ISELF .ne. 0 ) THEN
IF(me_self .eq. 0) WRITE(*,*) 'self Collisions ...'
CALL set_self_colls('ii') ! ... self collision
CALL evaluate_auxval_field
IF(me_self .eq. 0) WRITE(*,*) 'Construct ion-ion collisional matrix Cii ... '
call set_Cii_collisional_matrix
CALL evaluate_Cii_collisional_matrix
ENDIF
!
end subroutine ii_colls_control
!
!__________________________________________________________________
!
SUBROUTINE set_Cii_collisional_matrix
! Set evaluate_Cii_collisional_matrix routine
IMPLICIT NONE
!
!
IF (ISELF .ne. 0 ) THEN
IF(IFGKCOULOMB ) THEN
evaluate_Cii_collisional_matrix => Cii_gk_coulomb
call set_gkcoulomb
bfm_ = bafm_
bpfm_ = bafm_
IF( .not. GKC_USE_FULL) THEN
call load_gk_coulomb_coeffs('ii')
ELSE
call set_tabljpmf('s')
ENDIF
ELSE
evaluate_Cii_collisional_matrix => Cii_dflt
ENDIF
ELSE
evaluate_Cii_collisional_matrix => Cii_zeros_dflt
ENDIF
!
END SUBROUTINE set_Cii_collisional_matrix
!
!_______________________________________________________________________
!
SUBROUTINE Cii_dflt
! evaluate ion-ion collision matrix
use restart
IMPLICIT NONE
! Local variables
INTEGER :: irow_tmp,lbar_start
INTEGER :: irow
INTEGER, DIMENSION(2) :: lk
! current indices for restart
INTEGER :: istep
lbar_start = lbarii_s_l
istep=1
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'Cii [x/ ', numbi(Pmaxi,Jmaxi) ,']:'
DO irow = lbar_start,lbarii_e_l
irow_tmp = rows_i(irow)
lk = invnumbi(irow_tmp)
write(nscr,'(a)', advance = 'no') '.'
flush(nscr)
rCii(:) = ZEROFM
CALL COLLISIONSELFI(lk(1),lk(2),rCii)
Ciidp(irow,:) = TO_DP(rCii(:))
! save current state
istep = istep +1
ENDDO
!
!
END SUBROUTINE Cii_dflt
!_______________________________________________________________________
!
!
SUBROUTINE Cii_zeros_dflt
! evaluate ion-ion collision matrix
use restart
IMPLICIT NONE
! Local variables
INTEGER :: irow_tmp,lbar_start
INTEGER :: irow
INTEGER, DIMENSION(2) :: lk
! current indices for restart
INTEGER :: istep
lbar_start = lbarii_s_l
DO irow = lbar_start,lbarii_e_l
irow_tmp = rows_i(irow)
lk = invnumbi(irow_tmp)
write(*,*) 'Cii:', lk(1),'/',Pmaxi, ', ',lk(2),'/',Jmaxi
rCii(:) = ZEROFM
Ciidp(irow,:) = TO_DP(rCii(:))
! save current state
istep = istep +1
ENDDO
!
!
END SUBROUTINE Cii_zeros_dflt
!
!-----------------------------------------------------------------
!
SUBROUTINE Cii_gk_coulomb
! Evaluate GK Coulomb
use restart
use gkcoulomb
implicit none
INTEGER :: l,k,irow, icol, ii
INTEGER :: j,n,np,istep
INTEGER :: lbar_start
INTEGER, DIMENSION(4) :: lbarjnnp
INTEGER, DIMENSION(2) :: lk
INTEGER :: count
!
!
!
! initialize indices
lbar_start = lbarii_s_l
IF( me .eq. 0 ) write(*, '(a,1x, i5,a)' ) 'Cii [x/ ', lbarii_e_l ,']:'
istep=1
!
DO irow=lbar_start,lbarii_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)
rCii(:) = ZEROFM
CALL coulombSelfGK(lk(1),lk(2),j,n,np,rCii)
Ciidp(irow,:) = TO_DP(rCii(:))
istep = istep +1
ENDDO
! Finalize GK Coulomb by performing summation over (j,np)
IF( nprocs > 1 ) THEN
DO icol =1, numbi( Pmaxi, Jmaxi)
count = (lbarii_e_l - lbarii_s_l +1 )
call mpi_gather( Ciidp(:, icol) , count, MPI_DOUBLE_PRECISION &
, Ciidp_global(:, icol), count, MPI_DOUBLE_PRECISION, 0, comm_self, ierr)
ENDDO
ELSE
Ciidp_global = Ciidp
ENDIF
Ciidp_finalized = 0._dp
IF( me_self .eq. 0) THEN
DO irow = 1, numbi( Pmaxi, Jmaxi)
DO ii = 1, lbarimax
if( rows_i_4dim( ii, 1 ) .eq. irow) THEN
Ciidp_finalized( irow, :) = Ciidp_finalized( irow, :) &
+ Ciidp_global( ii,:)
ENDIF
ENDDO
ENDDO
ENDIF
END SUBROUTINE Cii_gk_Coulomb
!
!
END MODULE self_colls
c4science · Help