init_SC_E1D Subroutine

public subroutine init_SC_E1D(params, F, spp)

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(in) :: params
type(FIELDS), intent(inout) :: F
type(SPECIES), intent(in) :: spp

Calls

proc~~init_sc_e1d~~CallsGraph proc~init_sc_e1d init_SC_E1D proc~initialize_sc1d_field_interpolant initialize_SC1D_field_interpolant proc~init_sc_e1d->proc~initialize_sc1d_field_interpolant mpi_allreduce mpi_allreduce proc~init_sc_e1d->mpi_allreduce ezspline_init ezspline_init proc~initialize_sc1d_field_interpolant->ezspline_init ezspline_allocated ezspline_allocated proc~initialize_sc1d_field_interpolant->ezspline_allocated ezspline_error ezspline_error proc~initialize_sc1d_field_interpolant->ezspline_error ezspline_setup ezspline_setup proc~initialize_sc1d_field_interpolant->ezspline_setup

Contents

Source Code


Source Code

  subroutine init_SC_E1D(params,F,spp)
 
    TYPE(FIELDS), INTENT(INOUT)                 :: F
    TYPE(KORC_PARAMS), INTENT(IN) 		:: params
    TYPE(SPECIES), INTENT(IN)    :: spp
    real(rp),dimension(F%dim_1D) :: Vpart
    real(rp),dimension(spp%ppp) :: RR,ZZ,rm,vpll
    real(rp),dimension(F%dim_1D) :: Vden,Jsamone,Jsamall,Jexp,dJdt
    real(rp),dimension(F%dim_1D) :: a,b,c,u,gam,r,r_1D,Ai
    real(rp) :: dr,Isam,bet,sigr,ar,arg,arg1,arg2,arg3
    integer :: pp,ii,rind
    INTEGER 				:: mpierr

!    if (params%mpi_params%rank .EQ. 0) then
!       write(output_unit_write,*) 'Calculating SC_E1D'
!    end if

    ! 1D nearest grid point weighting in minor radius
    
    RR=spp%vars%Y(:,1)
    ZZ=spp%vars%Y(:,3)
    rm=sqrt((RR-F%Ro)**2._rp+(ZZ-F%Zo)**2._rp)*params%cpp%length

!    write (output_unit_write,*) params%mpi_params%rank,'RR',RR
!    write (output_unit_write,*) params%mpi_params%rank,'ZZ',spp%vars%Y(:,3)
    write (output_unit_write,*) 'rm',rm
    
    
    dr=F%r_1D(2)-F%r_1D(1)

    vpll=spp%vars%V(:,1)/spp%vars%g

    ! Weighting parallel velocity

!    write (output_unit_write,*) 'vpll',vpll
    
    Vpart=0._rp
    r_1D=F%r_1D
    sigr=dr
    
    do pp=1_idef,spp%ppp
       ! NGP weighting
       rind=FLOOR((rm(pp)-dr/2)/dr)+2_ip
       Vpart(rind)=Vpart(rind)+vpll(pp)

       ! First-order weighting
!       rind=FLOOR(rm(pp)/dr)+1_ip
!       Vpart(rind)=Vpart(rind)+vpll(pp)*(F%r_1D(rind+1)-rm(pp))/dr
!       Vpart(rind+1)=Vpart(rind+1)+vpll(pp)*(rm(pp)-F%r_1D(rind))/dr

       ! Gaussian weighting
!       do ii=1_idef,F%dim_1D
!          arg=MIN((r_1D(ii)-rm(pp))**2._rp/(2._rp*sigr**2._rp),100._rp)          
!          Vpart(ii)=Vpart(ii)+1/sqrt(2._rp*C_PI*sigr**2._rp)* &
!               exp(-arg) 
!       end do
       
    end do

    ! Calculating density of minor radial annulus

    ar=F%AB%a
    
    do ii=1_idef,F%dim_1D
       ! NGP weighting
       if(ii.eq.1) then
          Vden(ii)=Vpart(ii)/(C_PI*dr**2/4)
       else
          Vden(ii)=Vpart(ii)/(2*C_PI*dr**2*(ii-1))
       end if
       ! First-order weighting
!       if(ii.eq.1) then
!          Vden(ii)=Vpart(ii)/(C_PI*dr**2/3)
!       else
!          Vden(ii)=Vpart(ii)/(2*C_PI*dr**2*(ii-1))
!       end if

       ! Gaussian weighting

!       arg=MIN(r_1D(ii)**2._rp/(2._rp*sigr**2._rp),100._rp)
!       arg1=MIN((ar-r_1D(ii))**2._rp/(2._rp*sigr**2._rp),100._rp)
!       arg2=MIN((ar-r_1D(ii))/(sqrt(2._rp)*sigr),10._rp)
!       arg3=MIN((r_1D(ii))/(sqrt(2._rp)*sigr),10._rp)
       
!       Ai(ii)=sqrt(C_PI*sigr)*(sqrt(2._rp)*sigr*(exp(-arg)- &
!            exp(-arg1))+r_1D(ii)*sqrt(C_PI)* &
!            (erf(arg2)-erf(-arg3)))
!       Vden(ii)=Vpart(ii)/Ai(ii)
       
    end do
    
    Jsamone=C_E*Vden

    ! Add sampled current densities from all MPI processes Jsamone,
    ! and output of total sampled current density Jsamall to each
    ! MPI process.
    
    call MPI_ALLREDUCE(Jsamone,Jsamall,F%dim_1D,MPI_REAL8,MPI_SUM, &
         MPI_COMM_WORLD,mpierr)
    
!    write(output_unit_write,*) 'Jsam: ',Jsamall(1:10)

    ! Integrating current density to scale total current to
    ! experimentally determined total current


    Isam=0._rp
    do ii=1_idef,F%dim_1D
       if ((ii.eq.1).or.(ii.eq.F%dim_1D)) then
          Isam=Isam+Jsamall(ii)*r_1D(ii)/2._rp
       else 
          Isam=Isam+Jsamall(ii)*r_1D(ii)
       end if
    end do
    Isam=2._rp*C_PI*Isam*dr
!    write(output_unit_write,*) params%mpi_params%rank,'Isam: ',Isam

    F%Ip0=F%Ip_exp/Isam

    
    Jexp=Jsamall*F%Ip0

    F%J3_SC_1D%PHI=Jexp 
    F%J2_SC_1D%PHI=Jexp
    F%J1_SC_1D%PHI=Jexp        
    
    ! Calculating time-derivative of E_phi
    
    dJdt=(3._rp*F%J1_SC_1D%PHI-4._rp*F%J2_SC_1D%PHI+F%J3_SC_1D%PHI)/ &
         (2._rp*F%dt_E_SC)
    
!    write(output_unit_write,*) params%mpi_params%rank,'J(1)',F%J_SC_1D%PHI(1)
    
    ! Solving 1D Poisson equation with tridiagonal matrix solve

    a=0._rp
    b=-2._rp
    c=0._rp
    u=0._rp
    gam=0._rp
!    r=-2*dr**2*C_MU*Jexp
    r=2*dr**2*C_MU*dJdt

    do ii=2_idef,F%dim_1D
       a(ii)=(REAL(ii)-2._rp)/(REAL(ii)-1._rp)
       c(ii)=REAL(ii)/(REAL(ii)-1._rp)
    end do

    bet=b(2)
    u(2)=r(2)/bet
    do ii=3_idef,F%dim_1D-1
       gam(ii)=c(ii-1)/bet
       bet=b(ii)-a(ii)*gam(ii)
       if (bet.eq.0) then
          stop 'tridiag failed'         
       end if
       u(ii)=(r(ii)-a(ii)*u(ii-1))/bet
    end do

    do ii=F%dim_1D-2,2,-1
       u(ii)=u(ii)-gam(ii+1)*u(ii+1)
    end do

    u(1)=(4._rp*u(2)-u(3))/3._rp

    ! Writing over F%A* data
    
!    F%A3_SC_1D%PHI=F%A2_SC_1D%PHI
!    F%A2_SC_1D%PHI=F%A1_SC_1D%PHI
!    F%A1_SC_1D%PHI=u
    
!    if (init) then
!       F%A3_SC_1D%PHI=F%A1_SC_1D%PHI
!       F%A2_SC_1D%PHI=F%A1_SC_1D%PHI 
!    end if

!    write(output_unit_write,*) params%mpi_params%rank,'A1(1)',F%A1_SC_1D%PHI(1)
!    write(output_unit_write,*) params%mpi_params%rank,'A2(1)',F%A2_SC_1D%PHI(1)
!    write(output_unit_write,*) params%mpi_params%rank,'A3(1)',F%A3_SC_1D%PHI(1)
    
    ! Calculating inductive E_phi

!    F%E_SC_1D%PHI=-(3*F%A1_SC_1D%PHI-4*F%A2_SC_1D%PHI+F%A3_SC_1D%PHI)/ &
!         (2*F%dt_E_SC)

    F%E_SC_1D%PHI=u

    if (params%mpi_params%rank.eq.0) then
       write(output_unit_write,*) 'J1(2)',F%J1_SC_1D%PHI(2)
       write(output_unit_write,*) 'J2(2)',F%J2_SC_1D%PHI(2)
       write(output_unit_write,*) 'J3(2)',F%J3_SC_1D%PHI(2)
       
       write(output_unit_write,*) 'E(1)',F%E_SC_1D%PHI(1)
    end if
       
    ! Normalizing inductive E_phi
    
    F%E_SC_1D%PHI=F%E_SC_1D%PHI/params%cpp%Eo

#ifdef PSPLINE
    call initialize_SC1D_field_interpolant(params,F)
#endif
    
  end subroutine init_SC_E1D