adv_GCinterp_fio_top Subroutine

public subroutine adv_GCinterp_fio_top(params, spp, P, F)

Uses

  • proc~~adv_gcinterp_fio_top~~UsesGraph proc~adv_gcinterp_fio_top adv_GCinterp_fio_top omp_lib omp_lib proc~adv_gcinterp_fio_top->omp_lib

Arguments

Type IntentOptional AttributesName
type(KORC_PARAMS), intent(inout) :: params

Core KORC simulation parameters.

type(SPECIES), intent(inout), DIMENSION(:), ALLOCATABLE:: spp

An instance of the derived type SPECIES containing all the parameters and simulation variables of the different species in the simulation.

type(PROFILES), intent(in) :: P
type(FIELDS), intent(inout) :: F

Calls

proc~~adv_gcinterp_fio_top~~CallsGraph proc~adv_gcinterp_fio_top adv_GCinterp_fio_top omp_get_thread_num omp_get_thread_num proc~adv_gcinterp_fio_top->omp_get_thread_num

Called by

proc~~adv_gcinterp_fio_top~~CalledByGraph proc~adv_gcinterp_fio_top adv_GCinterp_fio_top program~main main program~main->proc~adv_gcinterp_fio_top

Contents

Source Code


Source Code

  subroutine adv_GCinterp_fio_top(params,spp,P,F)

    USE omp_lib
    IMPLICIT NONE
    
    TYPE(KORC_PARAMS), INTENT(INOUT)                           :: params
    !! Core KORC simulation parameters.
    TYPE(PROFILES), INTENT(IN)                                 :: P
    TYPE(FIELDS), INTENT(INOUT)                                   :: F
    TYPE(SPECIES), DIMENSION(:), ALLOCATABLE, INTENT(INOUT)    :: spp
    !! An instance of the derived type SPECIES containing all the parameters
    !! and simulation variables of the different species in the simulation.
    REAL(rp), DIMENSION(params%pchunk)               :: Bmag
    REAL(rp),DIMENSION(params%pchunk) :: Y_R,Y_PHI,Y_Z
    REAL(rp),DIMENSION(params%pchunk) :: B_R,B_PHI,B_Z
    REAL(rp),DIMENSION(params%pchunk) :: E_R,E_PHI,E_Z
    REAL(rp),DIMENSION(params%pchunk) :: ne,Te,Zeff,ni
    REAL(rp),DIMENSION(params%pchunk,params%num_impurity_species) :: nimp    
    REAL(rp),DIMENSION(params%pchunk) :: V_PLL,V_MU
    REAL(rp),DIMENSION(params%pchunk) :: PSIp
    REAL(rp),DIMENSION(params%pchunk) :: curlb_R,curlb_PHI,curlb_Z
    REAL(rp),DIMENSION(params%pchunk) :: gradB_R,gradB_PHI,gradB_Z
    INTEGER(is),DIMENSION(params%pchunk) :: flagCon,flagCol
    REAL(rp) :: m_cache,q_cache,B0,EF0,R0,q0,lam,ar
    TYPE(C_PTR), DIMENSION(params%pchunk)  :: hint


    INTEGER                                                    :: ii
    !! Species iterator.
    INTEGER                                                    :: pp
    !! Particles iterator.
    INTEGER                                                    :: cc,pchunk
    !! Chunk iterator.
    INTEGER(ip)                                                    :: tt
    INTEGER(ip)                                                    :: ttt
    !! time iterator.
    INTEGER             :: thread_num


    !write(6,*) '2Y_R',spp(1)%vars%Y(1:4,1)*params%cpp%length
    !write(6,*) '2(p/mc)',spp(1)%vars%V(1:4,1)

    do ii = 1_idef,params%num_species      

       pchunk=params%pchunk
       q_cache=spp(ii)%q
       m_cache=spp(ii)%m


       !$OMP PARALLEL DO default(none) &
       !$OMP& FIRSTPRIVATE(q_cache,m_cache,pchunk) &
       !$OMP& SHARED(params,ii,spp,P,F) &
       !$OMP& PRIVATE(pp,tt,Bmag,cc,Y_R,Y_PHI,Y_Z,V_PLL,V_MU,B_R,B_PHI,B_Z, &
       !$OMP& flagCon,flagCol,E_PHI,PSIp,curlb_R,curlb_PHI,curlb_Z, &
       !$OMP& gradB_R,gradB_PHI,gradB_Z,ne,nimp,Te,Zeff,ni,E_R,E_Z,hint, &
       !$OMP& thread_num)

       do pp=1_idef,spp(ii)%ppp,pchunk

          thread_num = OMP_GET_THREAD_NUM()

          !write(6,*) thread_num,'3Y_R',spp(ii)%vars%Y(pp,1)*params%cpp%length
          !write(6,*) thread_num,'3(p/mc)',spp(ii)%vars%V(pp,1)
          
          !          write(output_unit_write,'("pp: ",I16)') pp

          !$OMP SIMD
          do cc=1_idef,pchunk
             Y_R(cc)=spp(ii)%vars%Y(pp-1+cc,1)
             Y_PHI(cc)=spp(ii)%vars%Y(pp-1+cc,2)
             Y_Z(cc)=spp(ii)%vars%Y(pp-1+cc,3)

             B_R(cc)=spp(ii)%vars%B(pp-1+cc,1)
             B_PHI(cc)=spp(ii)%vars%B(pp-1+cc,2)
             B_Z(cc)=spp(ii)%vars%B(pp-1+cc,3)

             E_R(cc)=spp(ii)%vars%E(pp-1+cc,1)
             E_PHI(cc)=spp(ii)%vars%E(pp-1+cc,2)
             E_Z(cc)=spp(ii)%vars%E(pp-1+cc,3)

             gradB_R(cc)=spp(ii)%vars%gradB(pp-1+cc,1)
             gradB_PHI(cc)=spp(ii)%vars%gradB(pp-1+cc,2)
             gradB_Z(cc)=spp(ii)%vars%gradB(pp-1+cc,3)

             curlb_R(cc)=spp(ii)%vars%curlb(pp-1+cc,1)
             curlb_PHI(cc)=spp(ii)%vars%curlb(pp-1+cc,2)
             curlb_Z(cc)=spp(ii)%vars%curlb(pp-1+cc,3)

             V_PLL(cc)=spp(ii)%vars%V(pp-1+cc,1)
             V_MU(cc)=spp(ii)%vars%V(pp-1+cc,2)

             PSIp(cc)=spp(ii)%vars%PSI_P(pp-1+cc)

             flagCon(cc)=spp(ii)%vars%flagCon(pp-1+cc)
             flagCol(cc)=spp(ii)%vars%flagCol(pp-1+cc)

             hint(cc)=spp(ii)%vars%hint(pp-1+cc)

             ne(cc)=spp(ii)%vars%ne(pp-1+cc)
             ni(cc)=spp(ii)%vars%ni(pp-1+cc)
             nimp(cc,:)=spp(ii)%vars%nimp(pp-1+cc,:)
             Te(cc)=spp(ii)%vars%Te(pp-1+cc)
          end do
          !$OMP END SIMD


          do tt=1_ip,params%t_skip

             !write(6,*) thread_num,'4Y_R',Y_R*params%cpp%length
             !write(6,*) thread_num,'4(p/mc)',V_PLL
             
             
             !if (mod(tt,params%t_skip/100).eq.0) then
             !   write(output_unit_write,*) 'iteration',tt
             !   flush(output_unit_write)
             !endif
             
             call advance_GCinterp_fio_vars(spp(ii)%vars,pp,tt, &
                  params,Y_R,Y_PHI,Y_Z,V_PLL,V_MU,q_cache,m_cache, &
                  flagCon,flagCol, &
                  F,P,B_R,B_PHI,B_Z,E_R,E_PHI,E_Z,PSIp,curlb_R,curlb_PHI, &
                  curlb_Z,gradB_R,gradB_PHI,gradB_Z,ne,ni,Te,Zeff,nimp,hint)
          end do !timestep iterator


          !$OMP SIMD
          do cc=1_idef,pchunk
             spp(ii)%vars%Y(pp-1+cc,1)=Y_R(cc)
             spp(ii)%vars%Y(pp-1+cc,2)=Y_PHI(cc)
             spp(ii)%vars%Y(pp-1+cc,3)=Y_Z(cc)
             spp(ii)%vars%V(pp-1+cc,1)=V_PLL(cc)
             spp(ii)%vars%V(pp-1+cc,2)=V_MU(cc)

             spp(ii)%vars%flagCon(pp-1+cc)=flagCon(cc)
             spp(ii)%vars%flagCol(pp-1+cc)=flagCol(cc)

             spp(ii)%vars%B(pp-1+cc,1) = B_R(cc)
             spp(ii)%vars%B(pp-1+cc,2) = B_PHI(cc)
             spp(ii)%vars%B(pp-1+cc,3) = B_Z(cc)

             spp(ii)%vars%gradB(pp-1+cc,1) = gradB_R(cc)
             spp(ii)%vars%gradB(pp-1+cc,2) = gradB_PHI(cc)
             spp(ii)%vars%gradB(pp-1+cc,3) = gradB_Z(cc)

             spp(ii)%vars%curlb(pp-1+cc,1) = curlb_R(cc)
             spp(ii)%vars%curlb(pp-1+cc,2) = curlb_PHI(cc)
             spp(ii)%vars%curlb(pp-1+cc,3) = curlb_Z(cc)

             spp(ii)%vars%E(pp-1+cc,1) = E_R(cc)
             spp(ii)%vars%E(pp-1+cc,2) = E_PHI(cc)
             spp(ii)%vars%E(pp-1+cc,3) = E_Z(cc)
             spp(ii)%vars%PSI_P(pp-1+cc) = PSIp(cc)

             spp(ii)%vars%ne(pp-1+cc) = ne(cc)
             spp(ii)%vars%ni(pp-1+cc) = ni(cc)
             spp(ii)%vars%nimp(pp-1+cc,:) = nimp(cc,:)
             spp(ii)%vars%Te(pp-1+cc) = Te(cc)
             spp(ii)%vars%Zeff(pp-1+cc) = Zeff(cc)

             spp(ii)%vars%hint(pp-1+cc) = hint(cc)
          end do
          !$OMP END SIMD



          !$OMP SIMD
          do cc=1_idef,pchunk

             Bmag(cc)=sqrt(B_R(cc)*B_R(cc)+B_PHI(cc)*B_PHI(cc)+ &
                  B_Z(cc)*B_Z(cc))

             spp(ii)%vars%g(pp-1+cc)=sqrt(1+V_PLL(cc)**2+ &
                  2*V_MU(cc)*Bmag(cc))

             spp(ii)%vars%eta(pp-1+cc) = atan2(sqrt(2*m_cache*Bmag(cc)* &
                  spp(ii)%vars%V(pp-1+cc,2)),spp(ii)%vars%V(pp-1+cc,1))* &
                  180.0_rp/C_PI
          end do
          !$OMP END SIMD

       end do !particle chunk iterator
       !$OMP END PARALLEL DO




    end do !species iterator

  end subroutine adv_GCinterp_fio_top