initialize_GC_fields_3D Subroutine

private subroutine initialize_GC_fields_3D(F)

Computes the auxiliary fields and that are used in the RHS of the evolution equations for the GC orbit model.

Arguments

Type IntentOptional AttributesName
type(FIELDS), intent(inout) :: F

An instance of the KORC derived type FIELDS.


Called by

proc~~initialize_gc_fields_3d~~CalledByGraph proc~initialize_gc_fields_3d initialize_GC_fields_3D proc~initialize_fields initialize_fields proc~initialize_fields->proc~initialize_gc_fields_3d program~main main program~main->proc~initialize_fields

Contents


Source Code

  subroutine initialize_GC_fields_3D(F)
    !! Computes the auxiliary fields \(\nabla|{\bf B}|\) and
    !! \(\nabla\times\hat{b}\) that are used in the RHS of the
    !! evolution equations for the GC orbit model.
    TYPE(FIELDS), INTENT(INOUT)      :: F
    !! An instance of the KORC derived type FIELDS.
    INTEGER                        :: ii,jj
    !! Iterator across F%dim
    REAL(rp), DIMENSION(:,:,:),ALLOCATABLE :: Bmag
    !! Magnetic field magnitude
    REAL(rp), DIMENSION(:,:,:,:),ALLOCATABLE :: bhat
    !! Magnetic field unit vector

    Bmag=SQRT(F%B_3D%R**2+F%B_3D%PHI**2+F%B_3D%Z**2)

    ALLOCATE(bhat(F%dims(1),F%dims(2),F%dims(3),3))

    bhat(:,:,:,1)=F%B_3D%R/Bmag
    bhat(:,:,:,2)=F%B_3D%PHI/Bmag
    bhat(:,:,:,3)=F%B_3D%Z/Bmag

    ! Single-sided difference for axiliary fields at edge nodes
    ! Differential over R on first index, differential over Z
    ! on second index.

    F%gradB_3D%R=0._rp
    F%gradB_3D%PHI=0._rp
    F%gradB_3D%Z=0._rp

    F%curlb_3D%R=0._rp
    F%curlb_3D%PHI=0._rp
    F%curlb_3D%Z=0._rp
    
    ! gradB
    ! edge nodes at minimum R,Z
    F%gradB_3D%R(1,:,:)=F%gradB_3D%R(1,:,:)+ &
         (Bmag(2,:,:)-Bmag(1,:,:))/(F%X%R(2)-F%X%R(1))
    do ii=1_idef,F%dims(1)
       F%gradB_3D%PHI(ii,1,:)=F%gradB_3D%PHI(ii,1,:)+ &
            (Bmag(ii,2,:)-Bmag(ii,F%dims(2),:))/ &
            (F%X%R(ii)*(F%X%PHI(2)-F%X%PHI(F%dims(2))))
    end do
    F%gradB_3D%Z(:,:,1)=F%gradB_3D%Z(:,:,1)+ &
         (Bmag(:,:,2)-Bmag(:,:,1))/(F%X%Z(2)-F%X%Z(1))

    ! edge nodes at maximum R,Z
    F%gradB_3D%R(F%dims(1),:,:)=F%gradB_3D%R(F%dims(1),:,:)+ &
         (Bmag(F%dims(1),:,:)-Bmag(F%dims(1)-1,:,:))/ &
         (F%X%R(F%dims(1))-F%X%R(F%dims(1)-1))
    do ii=1_idef,F%dims(1)
       F%gradB_3D%PHI(ii,F%dims(2),:)=F%gradB_3D%PHI(ii,F%dims(2),:)+ &
            (Bmag(ii,1,:)-Bmag(ii,F%dims(2)-1,:))/ &
            (F%X%R(ii)*(F%X%PHI(1)-F%X%PHI(F%dims(2)-1)))
    end do       
    F%gradB_3D%Z(:,:,F%dims(3))=F%gradB_3D%Z(:,:,F%dims(3))+ &
         (Bmag(:,:,F%dims(3))-Bmag(:,:,F%dims(3)-1))/ &
         (F%X%Z(F%dims(3))-F%X%Z(F%dims(3)-1))

    ! curlb
    ! edge nodes at minimum R,PHI,Z
    ! R component has differential over PHI and Z
    do ii=1_idef,F%dims(1)
       F%curlb_3D%R(ii,1,:)=F%curlb_3D%R(ii,1,:)+ &
            (bhat(ii,2,:,3)-bhat(ii,F%dims(2),:,3))/ &
            (F%X%R(ii)*(F%X%PHI(2)-F%X%PHI(F%dims(2))))
    end do
    F%curlb_3D%R(:,:,1)=F%curlb_3D%R(:,:,1)-&
         (bhat(:,:,2,2)-bhat(:,:,1,2))/(F%X%Z(2)-F%X%Z(1))

    ! PHI component has differentials over R and Z
    F%curlb_3D%PHI(1,:,:)=F%curlb_3D%PHI(1,:,:)- &
         (bhat(2,:,:,3)-bhat(1,:,:,3))/ &
         (F%X%R(2)-F%X%R(1))         

    F%curlb_3D%PHI(:,:,1)=F%curlb_3D%PHI(:,:,1)+ &
         ((bhat(:,:,2,1)-bhat(:,:,1,1))/(F%X%Z(2)-F%X%Z(1)))

    ! Z component has differentials over R and PHI
    F%curlb_3D%Z(1,:,:)=F%curlb_3D%Z(1,:,:)+ &
         ((bhat(2,:,:,2)*F%X%R(2)- &
         bhat(1,:,:,2)*F%X%R(1))/(F%X%R(2)-F%X%R(1)))/F%X%R(1)

    do ii=1_idef,F%dims(1)
       F%curlb_3D%Z(ii,1,:)=F%curlb_3D%Z(ii,1,:)-&
            (bhat(ii,2,:,1)-bhat(ii,F%dims(2),:,1))/ &
            (F%X%R(ii)*(F%X%PHI(2)-F%X%PHI(F%dims(2))))
    end do

    ! edge nodes at maximum R,PHI,Z
    ! R component has differential over PHI and Z
    do ii=1_idef,F%dims(1)
       F%curlb_3D%R(ii,F%dims(2),:)=F%curlb_3D%R(ii,F%dims(2),:)+ &
            (bhat(ii,1,:,3)-bhat(ii,F%dims(2)-1,:,3))/ &
            (F%X%R(ii)*(F%X%PHI(1)-F%X%PHI(F%dims(2)-1)))
    end do
    F%curlb_3D%R(:,:,F%dims(3))=F%curlb_3D%R(:,:,F%dims(3)) &
         -(bhat(:,:,F%dims(3),2)-bhat(:,:,F%dims(3)-1,2))/ &
         (F%X%Z(F%dims(3))-F%X%Z(F%dims(3)-1))

    ! PHI component has differentials over R and Z
    F%curlb_3D%PHI(F%dims(1),:,:)=F%curlb_3D%PHI(F%dims(1),:,:)- &
         (bhat(F%dims(1),:,:,3)-bhat(F%dims(1)-1,:,:,3))/ &
         (F%X%R(F%dims(1))-F%X%R(F%dims(1)-1))         

    F%curlb_3D%PHI(:,:,F%dims(3))=F%curlb_3D%PHI(:,:,F%dims(3))+ &
         ((bhat(:,:,F%dims(3),1)-bhat(:,:,F%dims(3)-1,1))/ &
         (F%X%Z(F%dims(3))-F%X%Z(F%dims(3)-1)))

    ! Z component has differentials over R and PHI
    F%curlb_3D%Z(F%dims(1),:,:)=F%curlb_3D%Z(F%dims(1),:,:)+ &
         ((bhat(F%dims(1),:,:,2)*F%X%R(F%dims(1))- &
         bhat(F%dims(1)-1,:,:,2)*F%X%R(F%dims(1)-1))/(F%X%R(F%dims(1))- &
         F%X%R(F%dims(1)-1)))/F%X%R(F%dims(1))

    do ii=1_idef,F%dims(1)
       F%curlb_3D%Z(ii,F%dims(2),:)=F%curlb_3D%Z(ii,F%dims(2),:)-&
            (bhat(ii,1,:,1)-bhat(ii,F%dims(2)-1,:,1))/ &
            (F%X%R(ii)*(F%X%PHI(1)-F%X%PHI(F%dims(2)-1)))
    end do
    
    do ii=2_idef,F%dims(1)-1
       ! central difference over R for interior nodes
       F%gradB_3D%R(ii,:,:)=F%gradB_3D%R(ii,:,:)+ &
            (Bmag(ii+1,:,:)-Bmag(ii-1,:,:))/ &
            (F%X%R(ii+1)-F%X%R(ii-1))
       
       F%curlb_3D%Z(ii,:,:)=F%curlb_3D%Z(ii,:,:)+ &
            ((bhat(ii+1,:,:,2)*F%X%R(ii+1)- &
            bhat(ii-1,:,:,2)*F%X%R(ii-1))/(F%X%R(ii+1)-F%X%R(ii-1)))/ &
            F%X%R(ii)
       F%curlb_3D%PHI(ii,:,:)=F%curlb_3D%PHI(ii,:,:)- &
            (bhat(ii+1,:,:,3)-bhat(ii-1,:,:,3))/ &
            (F%X%R(ii+1)-F%X%R(ii-1))
    end do
    do ii=2_idef,F%dims(2)-1
       ! central difference over PHI for interior nodes       
       do jj=1_idef,F%dims(1)
          F%gradB_3D%PHI(jj,ii,:)=F%gradB_3D%PHI(jj,ii,:)+ &
               (Bmag(jj,ii+1,:)-Bmag(jj,ii-1,:))/ &
               (F%X%R(jj)*(F%X%PHI(ii+1)-F%X%PHI(ii-1)))
          
          F%curlb_3D%Z(jj,ii,:)=F%curlb_3D%Z(jj,ii,:)-&
               (bhat(jj,ii+1,:,1)-bhat(jj,ii-1,:,1))/ &
               (F%X%R(jj)*(F%X%PHI(ii+1)-F%X%PHI(ii-1)))
          F%curlb_3D%R(jj,ii,:)=F%curlb_3D%R(jj,ii,:)+ &
               (bhat(jj,ii+1,:,3)-bhat(jj,ii-1,:,3))/ &
            (F%X%R(jj)*(F%X%PHI(ii+1)-F%X%PHI(ii-1)))
       end do
    end do
    do ii=2_idef,F%dims(3)-1
       ! central difference over Z for interior nodes
       F%gradB_3D%Z(:,:,ii)=F%gradB_3D%Z(:,:,ii)+ &
            (Bmag(:,:,ii+1)-Bmag(:,:,ii-1))/ &
            (F%X%Z(ii+1)-F%X%Z(ii-1))
       
       F%curlb_3D%R(:,:,ii)=F%curlb_3D%R(:,:,ii)- &
            (bhat(:,:,ii+1,2)-bhat(:,:,ii-1,2))/ &
            (F%X%Z(ii+1)-F%X%Z(ii-1))
       F%curlb_3D%PHI(:,:,ii)=F%curlb_3D%PHI(:,:,ii)+ &
            ((bhat(:,:,ii+1,1)-bhat(:,:,ii-1,1))/(F%X%Z(ii+1)-F%X%Z(ii-1)))
    end do

    DEALLOCATE(Bmag)
    DEALLOCATE(bhat) 

  end subroutine initialize_GC_fields_3D