Skip to content
Snippets Groups Projects
Commit 186aab80 authored by Antoine Cyril David Hoffmann's avatar Antoine Cyril David Hoffmann
Browse files

GK pitch angle is now on CO=3

parent 37b68108
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 71 additions and 65 deletions
src/collision_mod.F90
+ 71
− 65
View file @ 186aab80
...@@ -421,11 +421,11 @@ CONTAINS ...@@ -421,11 +421,11 @@ CONTAINS
IF (CO .EQ. 2) THEN IF (CO .EQ. 2) THEN
IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK Sugama matrix ===' IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK Sugama matrix ==='
ELSEIF(CO .EQ. 3) THEN ELSEIF(CO .EQ. 3) THEN
IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK Full Coulomb matrix ===' IF (my_id .EQ. 0) WRITE(*,*) '=== Load GK pitch angle matrix ==='
ELSEIF(CO .EQ. -2) THEN ELSEIF(CO .EQ. -2) THEN
IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK Sugama matrix ===' IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK Sugama matrix ==='
ELSEIF(CO .EQ. -3) THEN ELSEIF(CO .EQ. -3) THEN
IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK Full Coulomb matrix ===' IF (my_id .EQ. 0) WRITE(*,*) '=== Load DK pitch angle matrix ==='
ENDIF ENDIF
! Opening the compiled cosolver matrices results ! Opening the compiled cosolver matrices results
...@@ -478,7 +478,7 @@ CONTAINS ...@@ -478,7 +478,7 @@ CONTAINS
ELSE ELSE
write(ikp_string,'(i5.5)') 0 write(ikp_string,'(i5.5)') 0
ENDIF ENDIF
!!!!!!!!!!!! Electron matrices !!!!!!!!!!!! !!!!!!!!!!!! E-E matrices !!!!!!!!!!!!
! get the self electron colision matrix ! get the self electron colision matrix
! Allocate space for storing full collision matrix ! Allocate space for storing full collision matrix
CALL allocate_array( Ceepj_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1)) CALL allocate_array( Ceepj_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1))
...@@ -501,38 +501,7 @@ CONTAINS ...@@ -501,38 +501,7 @@ CONTAINS
ENDDO ENDDO
DEALLOCATE(Ceepj_full) DEALLOCATE(Ceepj_full)
! Get test and field e-i collision matrices !!!!!!!!!!!!!!! I-I 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)
!!!!!!!!!!!!!!! Ion matrices !!!!!!!!!!!!!!
! get the self electron colision matrix ! get the self electron colision matrix
CALL allocate_array( Ciipj_full, 1,(pdimi+1)*(jdimi+1), 1,(pdimi+1)*(jdimi+1)) 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' WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Caapj/Ciipj'
...@@ -553,36 +522,73 @@ CONTAINS ...@@ -553,36 +522,73 @@ CONTAINS
ENDDO ENDDO
DEALLOCATE(Ciipj_full) DEALLOCATE(Ciipj_full)
! get the Test and Back field electron ion collision matrix IF(abs(CO) .NE. 3) THEN ! Pitch angle is only applied on like-species
CALL allocate_array( CiepjT_full, 1,(pdimi+1)*(jdimi+1), 1,(pdimi+1)*(jdimi+1)) !!!!!!!!!!!!!!! E-I matrices !!!!!!!!!!!!!!
CALL allocate_array( CiepjF_full, 1,(pdimi+1)*(jdimi+1), 1,(pdime+1)*(jdime+1)) ! Get test and field e-i collision matrices
WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Ciepj/CiepjT' CALL allocate_array( CeipjT_full, 1,(pdime+1)*(jdime+1), 1,(pdime+1)*(jdime+1))
CALL getarr(fid, var_name, CiepjT_full) CALL allocate_array( CeipjF_full, 1,(pdime+1)*(jdime+1), 1,(pdimi+1)*(jdimi+1))
WRITE(var_name,'(a,a,a)') TRIM(ADJUSTL(ikp_string)),'/Ciepj/CiepjF' WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Ceipj/CeipjT'
CALL getarr(fid, var_name, CiepjF_full) CALL getarr(fid, var_name, CeipjT_full)
! Fill sub array with only usefull polynmials degree WRITE(var_name,'(a,a)') TRIM(ADJUSTL(ikp_string)),'/Ceipj/CeipjF'
DO ip_i = 0,Pmaxi ! Loop over rows CALL getarr(fid, var_name, CeipjF_full)
DO ij_i = 0,Jmaxi ! Fill sub array with only usefull polynmials degree
irow_sub = (Jmaxi +1)*ip_i + ij_i +1 DO ip_e = 0,pmaxe ! Loop over rows
irow_full = (jdimi +1)*ip_i + ij_i +1 DO ij_e = 0,jmaxe
DO il_i = 0,Pmaxi ! Loop over columns irow_sub = (jmaxe +1)*ip_e + ij_e +1
DO ik_i = 0,Jmaxi irow_full = (jdime +1)*ip_e + ij_e +1
icol_sub = (Jmaxi +1)*il_i + ik_i +1 DO il_e = 0,pmaxe ! Loop over columns
icol_full = (jdimi +1)*il_i + ik_i +1 DO ik_e = 0,jmaxe
CiepjT_kp(irow_sub,icol_sub,ikp) = CiepjT_full(irow_full,icol_full) icol_sub = (jmaxe +1)*il_e + ik_e +1
ENDDO icol_full = (jdime +1)*il_e + ik_e +1
ENDDO CeipjT_kp(irow_sub,icol_sub,ikp) = CeipjT_full(irow_full,icol_full)
DO il_e = 0,pmaxe ! Loop over columns ENDDO
DO ik_e = 0,jmaxe ENDDO
icol_sub = (jmaxe +1)*il_e + ik_e +1 DO il_i = 0,pmaxi ! Loop over columns
icol_full = (jdime +1)*il_e + ik_e +1 DO ik_i = 0,jmaxi
CiepjF_kp(irow_sub,icol_sub,ikp) = CiepjF_full(irow_full,icol_full) icol_sub = (Jmaxi +1)*il_i + ik_i +1
ENDDO icol_full = (jdimi +1)*il_i + ik_i +1
ENDDO CeipjF_kp(irow_sub,icol_sub,ikp) = CeipjF_full(irow_full,icol_full)
ENDDO ENDDO
ENDDO ENDDO
DEALLOCATE(CiepjF_full) ENDDO
DEALLOCATE(CiepjT_full) 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
ENDIF ENDIF
ENDDO ENDDO
CALL closef(fid) CALL closef(fid)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment