Homec4science
Diffusion COSOlver (master) Browse

cosolver/src/basic_mod.f90
5b66a09e0f20master

Last Change
Raw File

basic_mod.f90
View Options

MODULE basic
! Basic module
USE prec_const
USE FMZM
USE basic_mpi
IMPLICIT NONE
!! LOGICAL :: selfcolls = .true. ! Include self collision
LOGICAL :: eecolls = .true. ! Include ion self collision
LOGICAL :: iicolls = .true. ! Include electron self collision
LOGICAL :: eicolls = .true. ! electron-ion collisions
LOGICAL :: iecolls = .true. ! Ion-electrons collisions
! Drift/Gyrokinetic collision Operator
LOGICAL :: GK = .true. ! Set GK collision Operator
! Energy collisional Coulomb sum bounds
! same for e and i
INTEGER :: JEmaxx=15 ! Energy upper bound summation
! Upper bound spherical harmonics (used in GK Coulomb)
INTEGER ::PMMAXX = 10
INTEGER :: imaxx = 3 ! improved sugama upper bound sum
! FLR upper sum bound
INTEGER :: neFLR = 0! upper bound FLR electron
INTEGER :: neFLRs = 0 ! lower bound FLR electron
INTEGER :: niFLR = 0 ! upper bound FLR ion
INTEGER :: niFLRs =0 ! lower bound FLR ion
INTEGER :: npeFLR = 0 ! upper bound FLR electron
INTEGER :: npiFLR = 0 ! upper bound FLR ion
INTEGER :: naFLR = 0 ! upper bound FLR sum first species, i.e. a
INTEGER :: nbFLR = 0 ! Upper bound FLR sum second species, i.e. b
INTEGER :: naFLRs = 0 ! lower bound FLR sum first species, i.e. a
INTEGER :: nbFLRs = 0 ! lower bound FLR sum second species, i.e. b
INTEGER :: npaFLR =0
INTEGER :: npbFLR =0
! Harmonics operator sum
INTEGER :: mmaxx ! upper harmonics sum in GK Coulomb collision operator, mmaxx = p by default
! Error functions upper bound
INTEGER :: ERFMAX = 200
! Basis transformation sum upper bounds
INTEGER :: PMAXX
INTEGER :: GMAXX
INTEGER :: FMAXX
INTEGER :: HMAXX
INTEGER :: NFLRMAXX
INTEGER :: NPFLRMAXX
! Ion-Electron Hermite-Laguerre Resolution
! Ion
INTEGER :: Pmaxi = 10
INTEGER :: Jmaxi = 10
! Electron
INTEGER :: Pmaxe = 10
INTEGER :: Jmaxe = 10
! Species dependent 1D indices
INTEGER :: Pmaxa
INTEGER :: Jmaxa
INTEGER :: Pmaxb
INTEGER :: Jmaxb
! Improved Sugama
INTEGER :: ImpSugamaJmax = 1
INTEGER :: ImpSugamaKmax = 1
LOGICAL, PUBLIC, PROTECTED :: DO_SUGAMA_RELATIONS_CHECK = .FALSE.
LOGICAL, PUBLIC, PROTECTED :: DO_SUGAMA_FRICTION_COEFFS_COMPUTATION = .FALSE.
! 1D collisional matrix dimensions
INTEGER :: dimCeiF
INTEGER :: dimCeiT
INTEGER :: dimCieT
INTEGER :: dimCieF
INTEGER :: dimCee
INTEGER :: dimCii
! output labels
character(len=4) :: strPmaxi,strJmaxi,strPmaxe,strJmaxe,strlmaxx,strkmaxx,strnmaxx,strqmaxx,strNiFLR,strNeFLR
character(len=1) :: strself, strei, strie
! Output format KOUT
CHARACTER(len=7) :: FMFRMT = 'F100.20'
! string lenght
integer, parameter :: llen = 256
integer, parameter :: slen = 64
! T4 coefficients format and params.
CHARACTER*100:: T4dir
INTEGER,PARAMETER :: T4len= 100
INTEGER,PARAMETER :: NNLKPJlen = 11
INTEGER :: idxT4max ! maximum number of T4 in each dimension loaded
LOGICAL :: IFT4 = .false.
! T5 coefficients format and params
CHARACTER*100:: T5dir
INTEGER,PARAMETER :: FMlen= 100 ! character length of T5 coeff.
INTEGER,PARAMETER :: NNLKMPJlen = 14
INTEGER :: idxT5max ! maximum number of T5 in each dimension loaded
LOGICAL :: IFT5 = .false.
! Pre-computed coefficient format
INTEGER,PARAMETER :: NNLJPMFlen = 14
INTEGER,PARAMETER :: PJMNCOLlen = 14
INTEGER,PARAMETER :: NNPJMlen = 8
! Define Hermite-Laguerre 1D index mapping
PROCEDURE(NUMB), POINTER :: numba => null()
PROCEDURE(NUMB), POINTER :: numbb => null()
PROCEDURE(NUMB), POINTER :: buffnumb => null()
PROCEDURE(INVNUMB), POINTER :: invnumba => null()
PROCEDURE(INVNUMB), POINTER :: invnumbb => null()
! COSOlver root dir
CHARACTER(len=512), PROTECTED :: cosolver_dir
LOGICAL :: nlend = .false. ! 1=> end runs
INTERFACE allocate_array
MODULE PROCEDURE allocate_array_dp1,allocate_array_dp2,allocate_array_dp3,allocate_array_dp4,allocate_array_dp5
MODULE PROCEDURE allocate_array_fm1,allocate_array_fm2,allocate_array_fm3,allocate_array_fm4,allocate_array_fm5
MODULE PROCEDURE allocate_array_dc1,allocate_array_dc2,allocate_array_dc3,allocate_array_dc4
MODULE PROCEDURE allocate_array_i1,allocate_array_i2,allocate_array_i3,allocate_array_i4
MODULE PROCEDURE allocate_array_l1,allocate_array_l2,allocate_array_l3,allocate_array_l4
MODULE PROCEDURE allocate_array_str3,allocate_array_str4,allocate_array_str5
END INTERFACE allocate_array
! 2D Hermite-Laguerre indices mapping
ABSTRACT INTERFACE
INTEGER FUNCTION NUMB(pp,jj)
INTEGER, INTENT(in) :: pp,jj
! code here
END FUNCTION NUMB
END INTERFACE
! 1D indice remapping
ABSTRACT INTERFACE
FUNCTION INVNUMB(lbar) RESULT(PJ)
INTEGER, INTENT(in) :: lbar
INTEGER, DIMENSION(2) :: PJ
! code here
END FUNCTION INVNUMB
END INTERFACE
CONTAINS
subroutine read_inputfile
! read inputfile
implicit none
character(256 ) :: line_
real(dp):: rand_
IF( me .eq. 0) then
call random_seed()
call random_number(rand_ )
lu_in = 10 + floor(rand_ * 80, dp)
DO
read( nkbd, '(a)', END=110) line_
WRITE(lu_in, '(a)') trim(adjustl(line_))
ENDDO
110 CONTINUE
rewind(lu_in)
ENDIF
call mpi_bcast(lu_in, 1, mpi_integer, 0, mpi_comm_world, ierr )
write(strlu_, '(I2)') lu_in
end subroutine read_inputfile
!
!-------------------------------------------------------
!
SUBROUTINE basic_data
! Read basic data from input file
use prec_const
IMPLICIT NONE
character(len=8) :: fmt = '(I3.1)' ! ... P_e, J_e,... < 100 !!!
! Namelist
NAMELIST /BASIC/ eecolls,iicolls, eicolls, iecolls,Pmaxi,Jmaxi,Pmaxe,Jmaxe,ImpSugamaJmax,ImpSugamaKmax,JEmaxx,PMMAXX,neFLR,niFLR,neFLRs,niFLRs,npeFLR,npiFLR, cosolver_dir, DO_SUGAMA_RELATIONS_CHECK, DO_SUGAMA_FRICTION_COEFFS_COMPUTATION, ERFMAX
NAMELIST /BASIS_TRANSFORMATION_PAR/ T5dir,T4dir,idxT4max,idxT5max,IFT4,IFT5
! READ INPUT BASIC
IF( me .ne. 0 ) GOTO 110
READ(lu_in,basic)
! WRITE(*,basic)
READ(lu_in,BASIS_TRANSFORMATION_PAR)
! WRITE(*,BASIS_TRANSFORMATION_PAR)
110 CONTINUE
! Collisional matrices dimension
!
dimCeiT = numbe(Pmaxe,Jmaxe)*numbe(Pmaxe,Jmaxe)
dimCeiF = numbe(Pmaxe,Jmaxe)*numbi(Pmaxi,Jmaxi)
dimCieT = numbi(Pmaxi,Jmaxi)*numbi(Pmaxi,Jmaxi)
dimCieF = numbi(Pmaxi,Jmaxi)*numbe(Pmaxe,Jmaxe)
dimCee = dimCeiT
dimCii = dimCieT
!
! Sum Energy bound
imaxx = JEmaxx
!
IF( npiFLR .eq. 0) npiFLR = niFLR
IF( npeFLR .eq. 0) npeFLR = neFLR
!
! IF(eecolls .and. iicolls .and. Pmaxe .eq. Pmaxi .and. Jmaxe .eq. Jmaxi) THEN
! iicolls = .false.
! ENDIF
!
!
! Broadcast from PE 0 to
!
CALL MPI_bcast(eecolls,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(iicolls,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(eicolls,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(iecolls,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(Pmaxi,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(Jmaxi,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(Pmaxe,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(Jmaxe,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(JEmaxx,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(PMMAXX,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(neFLR,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(niFLR,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(neFLRs,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(niFLRs,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(npeFLR,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(npiFLR,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(dimCeiT,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(dimCeiF,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(dimCee,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(dimCieT,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(dimCieF,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(dimCii,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(T5dir,100,MPI_CHARACTER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(T4dir,100,MPI_CHARACTER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(idxT4max,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(idxT5max,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(IFT4,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(IFT5,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(ERFMAX,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
!
CALL MPI_bcast( ImpSugamaJmax,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast( ImpSugamaKmax,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
CALL MPI_bcast(cosolver_dir, 512,MPI_CHARACTER,0,MPI_COMM_WORLD,ierr)
!
! convert to str
write(strPmaxi,fmt) Pmaxi
write(strPmaxe,fmt) Pmaxe
write(strJmaxi,fmt) Jmaxi
write(strJmaxe,fmt) Jmaxe
write(strNiFLR,fmt) niFLR
write(strNeFLR,fmt) neFLR
! Set upper bound for error functions
!
! Note: check all possible places where it appears
! ERFMAX = 2*( max(Pmaxe,Pmaxi) + 2*( max(Jmaxi,Jmaxe) + max(neFLR,niFLR) ) ) + JEmaxx + 2
!! PMAX = max(Pmaxe,Pmaxi) + 2*(max(Jmaxe,Jmaxi) + max(neFLR,niFLR))
! Basis transformation sum upper bounds
FMAXX = max(Jmaxe,Jmaxi) + max(niFLR,neFLR)
PMAXX = 2*FMAXX + max(Pmaxe,Pmaxi)
GMAXX = PMAXX+2*JEmaxx
HMAXX = JEmaxx + floor(real(PMAXX)/2)
NFLRMAXX = max(neFLR,niFLR)
NPFLRMAXX = max(npeFLR,npiFLR)
!
END SUBROUTINE basic_data
!
!================================================================================
!
subroutine set_basic(ab)
! set the Hermite-Laguerre resolution for each species
implicit none
!
character(len=2), intent(in) :: ab
! Electrons-Electrons
IF(ab .EQ. 'ee') THEN
Pmaxa = Pmaxe
Jmaxa = Jmaxe
Pmaxb = Pmaxe
Jmaxb = Jmaxe
! FLR bound
naFLR = neFLR
nbFLR = naFLR
naFLRs = neFLRs
nbFLR = naFLRs
npaFLR = npeFLR
npbFLR = npeFLR
! Set numa/numbb procedure
numba => numbe
numbb => numbe
invnumba => invnumbe
invnumbb => invnumbe
END IF
! Ions-Ions
IF(ab .EQ. 'ii') THEN
Pmaxa = Pmaxi
Jmaxa = Jmaxi
Pmaxb = Pmaxi
Jmaxb = Jmaxi
! FLR bound
naFLR = niFLR
nbFLR = niFLR
naFLRs = niFLRs
nbFLRs = niFLRs
npaFLR = npiFLR
npbFLR = npiFLR
! Set numa/numbb procedure
numba => numbi
numbb => numbi
! Set invnumb procedure
invnumba => invnumbi
invnumbb => invnumbi
END IF
! Electron-Ions
IF( ab .eq. 'ei') THEN
Pmaxa = Pmaxe
Jmaxa = Jmaxe
Pmaxb = Pmaxi
Jmaxb = Jmaxi
! FLR bound
naFLR = neFLR
nbFLR = niFLR
naFLRs = neFLRs
nbFLRs = niFLRs
npaFLR = npeFLR
npbFLR = npiFLR
! Set numa/numbb procedure
numba => numbe
numbb => numbi
! Set invnumb procedure
invnumba => invnumbe
invnumbb => invnumbi
ENDIF
! Ions-Electrons
IF( ab .eq. 'ie') THEN
Pmaxa = Pmaxi
Jmaxa = Jmaxi
Pmaxb = Pmaxe
Jmaxb = Jmaxe
! FLR bound
naFLR = niFLR
nbFLR = neFLR
naFLRs = niFLRs
nbFLRs = neFLRs
npaFLR = npiFLR
npbFLR = npeFLR
! Set numa/numbb procedure
numba => numbi
numbb => numbe
! Set invnumb procedure
invnumba => invnumbi
invnumbb => invnumbe
ENDIF
end subroutine set_basic
!================================================================================
subroutine invert_basic
! invert basic parameters a->b, b->a
implicit none
!
! local vars.
integer :: buff
! invert a ->b
! Hermite
buff = pmaxa
pmaxa = pmaxb
pmaxb = buff
! Laguerre
buff = jmaxa
jmaxa = jmaxb
jmaxb = buff
! FLR bound
buff = naFLR
naFLR = nbFLR
nbFLR =buff
! numb pointer
buffnumb => numba
numba => numbb
numbb => buffnumb
end subroutine invert_basic
!================================================================================
! To allocate arrays of doubles, integers, etc. at run time
SUBROUTINE allocate_array_dp1(a,is1,ie1)
real(dp), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1))
a=0.0_dp
END SUBROUTINE allocate_array_dp1
SUBROUTINE allocate_array_dp2(a,is1,ie1,is2,ie2)
real(dp), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2))
a=0.0_dp
END SUBROUTINE allocate_array_dp2
SUBROUTINE allocate_array_dp3(a,is1,ie1,is2,ie2,is3,ie3)
real(dp), DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3))
a=0.0_dp
END SUBROUTINE allocate_array_dp3
SUBROUTINE allocate_array_dp4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4)
real(dp), DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4))
a=0.0_dp
END SUBROUTINE allocate_array_dp4
SUBROUTINE allocate_array_dp5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5)
real(dp), DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5))
a=0.0_dp
END SUBROUTINE allocate_array_dp5
!__________________ TO ALLOCATE FM ARRAYS_________________
SUBROUTINE allocate_array_fm2(a,is1,ie1,is2,ie2)
TYPE(FM), DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2))
a=TO_FM('0.0')
END SUBROUTINE allocate_array_fm2
SUBROUTINE allocate_array_fm1(a,is1,ie1)
TYPE(FM), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1))
a=TO_FM('0.0')
END SUBROUTINE allocate_array_fm1
SUBROUTINE allocate_array_fm3(a,is1,ie1,is2,ie2,is3,ie3)
TYPE(FM), DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3))
a=TO_FM('0.0')
END SUBROUTINE allocate_array_fm3
SUBROUTINE allocate_array_fm4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4)
TYPE(FM), DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4))
a=TO_FM('0.0')
END SUBROUTINE allocate_array_fm4
SUBROUTINE allocate_array_fm5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5)
TYPE(FM), DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5))
a=TO_FM('0.0')
END SUBROUTINE allocate_array_fm5
SUBROUTINE allocate_array_dc1(a,is1,ie1)
DOUBLE COMPLEX, DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1))
a=CMPLX(0.0_dp,0.0_dp)
END SUBROUTINE allocate_array_dc1
SUBROUTINE allocate_array_dc2(a,is1,ie1,is2,ie2)
DOUBLE COMPLEX, DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2))
a=CMPLX(0.0_dp,0.0_dp)
END SUBROUTINE allocate_array_dc2
SUBROUTINE allocate_array_dc3(a,is1,ie1,is2,ie2,is3,ie3)
DOUBLE COMPLEX, DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3))
a=CMPLX(0.0_dp,0.0_dp)
END SUBROUTINE allocate_array_dc3
SUBROUTINE allocate_array_dc4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4)
DOUBLE COMPLEX, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4))
a=CMPLX(0.0_dp,0.0_dp)
END SUBROUTINE allocate_array_dc4
SUBROUTINE allocate_array_i1(a,is1,ie1)
INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1))
a=0
END SUBROUTINE allocate_array_i1
SUBROUTINE allocate_array_i2(a,is1,ie1,is2,ie2)
INTEGER, DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2))
a=0
END SUBROUTINE allocate_array_i2
SUBROUTINE allocate_array_i3(a,is1,ie1,is2,ie2,is3,ie3)
INTEGER, DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3))
a=0
END SUBROUTINE allocate_array_i3
SUBROUTINE allocate_array_i4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4)
INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4))
a=0
END SUBROUTINE allocate_array_i4
SUBROUTINE allocate_array_l1(a,is1,ie1)
LOGICAL, DIMENSION(:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1))
a=.false.
END SUBROUTINE allocate_array_l1
SUBROUTINE allocate_array_l2(a,is1,ie1,is2,ie2)
LOGICAL, DIMENSION(:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2))
a=.false.
END SUBROUTINE allocate_array_l2
SUBROUTINE allocate_array_l3(a,is1,ie1,is2,ie2,is3,ie3)
LOGICAL, DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3))
a=.false.
END SUBROUTINE allocate_array_l3
SUBROUTINE allocate_array_l4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4)
LOGICAL, DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4))
a=.false.
END SUBROUTINE allocate_array_l4
SUBROUTINE allocate_array_str4(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4)
CHARACTER(len=*), DIMENSION(:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4))
a='0.0'
END SUBROUTINE allocate_array_str4
SUBROUTINE allocate_array_str3(a,is1,ie1,is2,ie2,is3,ie3)
CHARACTER(len=*), DIMENSION(:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3))
a='0.0'
END SUBROUTINE allocate_array_str3
SUBROUTINE allocate_array_str5(a,is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5)
CHARACTER(len=*), DIMENSION(:,:,:,:,:), ALLOCATABLE, INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: is1,ie1,is2,ie2,is3,ie3,is4,ie4,is5,ie5
IF(allocated(a)) DEALLOCATE(a)
ALLOCATE(a(is1:ie1,is2:ie2,is3:ie3,is4:ie4,is5:ie5))
a='0.0'
END SUBROUTINE allocate_array_str5
INTEGER FUNCTION numbe(pp,jj)
! Electron 1D Hermite-Laguerre index mapping function
! Note : we add +1 compare to MOLI to include F_aM. This component is then removed in MOLI when extracting the collisional matrix iCa
!
INTEGER,INTENT(in) :: pp,jj
numbe = (Jmaxe+1)*pp + 1 + jj
END FUNCTION numbe
INTEGER FUNCTION numbi(pp,jj)
! ! Ion 1D Hermite-Laguerre index mapping function
INTEGER, INTENT(in) :: pp,jj
numbi = (Jmaxi +1)*pp + 1 + jj
END FUNCTION numbi
FUNCTION invnumbe(lbar) RESULT(pj)
! Electron Remap 1D index to Hermite-Laguerre indices
!
IMPLICIT NONE
!
INTEGER, INTENT(in) :: lbar
INTEGER, DIMENSION(2) :: pj
!
pj(1) = int(floor(real(lbar - 1)/(Jmaxe+1)))
pj(2) = lbar -1 - (Jmaxe +1)*pj(1)
!
END FUNCTION invnumbe
FUNCTION invnumbi(lbar) RESULT(pj)
! Ion Remap 1D index to Hermite-Laguerre indices
!
IMPLICIT NONE
!
INTEGER, INTENT(in) :: lbar
INTEGER,DIMENSION(2) :: pj
!
pj(1) = int(floor(real(lbar - 1)/(Jmaxi+1)))
pj(2) = lbar -1 - (Jmaxi +1)*pj(1)
!
END FUNCTION invnumbi
SUBROUTINE print_FM(iout,XIN)
! print XIN Type FM variable
USE FMZM
IMPLICIT NONE
!
INTEGER,INTENT(IN) :: iout
TYPE(FM),INTENT(IN) :: XIN
CHARACTER(100) :: ST1
!
CALL FM_ENTER_USER_ROUTINE
!
! print XIN
IF( iout .eq. 0 ) THEN
CALL FM_FORM(FMFRMT, XIN,ST1)
WRITE(*,*) ADJUSTL(TRIM(ST1))
ELSE
CALL FM_FORM(FMFRMT, XIN,ST1)
WRITE(iout,*) ADJUSTL(TRIM(ST1))
ENDIF
!
CALL FM_ENTER_USER_ROUTINE
!
END SUBROUTINE print_FM
END MODULE basic
c4science · Help