base_evalDOF Subroutine

private subroutine base_evalDOF(sf, deriv, DOFs, y_IP_GP)

evaluate all degrees of freedom at all Gauss Points (deriv=0 solution, deriv=1 first derivative d/ds)

Type Bound

t_base

Arguments

Type IntentOptional Attributes Name
class(t_base), intent(in) :: sf

self
integer, intent(in) :: deriv(2)

=(0,0): base, =(1,0): ds, =(0,2): dtheta, =(0,3): dzeta
real(kind=wp), intent(in) :: DOFs(1:sf%s%nBase,1:sf%f%modes)

array of all modes and all radial dofs
real(kind=wp), intent(out) :: y_IP_GP(sf%f%mn_IP,sf%s%nGP_str:sf%s%nGP_end)

OUTPUT ARRAY OF MPI SUBDOMAIN (GP points)

Calls

proc~~base_evaldof~~CallsGraph proc~base_evaldof t_base%base_evalDOF proc~fbase_evaldof_ip_tens t_fBase%fBase_evalDOF_IP_tens proc~base_evaldof->proc~fbase_evaldof_ip_tens dgemm dgemm proc~fbase_evaldof_ip_tens->dgemm proc~fbase_evaldof_xn t_fBase%fBase_evalDOF_xn proc~fbase_evaldof_ip_tens->proc~fbase_evaldof_xn dgemv dgemv proc~fbase_evaldof_xn->dgemv proc~fbase_eval_xn t_fBase%fBase_eval_xn proc~fbase_evaldof_xn->proc~fbase_eval_xn

Called by

proc~~base_evaldof~~CalledByGraph proc~base_evaldof t_base%base_evalDOF proc~base_test Base_test proc~base_test->proc~base_evaldof proc~evalaux EvalAux proc~evalaux->proc~base_evaldof proc~base_new Base_new proc~base_new->proc~base_test proc~evalenergy EvalEnergy proc~evalenergy->proc~evalaux proc~evalforce EvalForce proc~evalforce->proc~evalaux proc~evaltotals EvalTotals proc~evaltotals->proc~evalaux proc~minimizemhd3d_resetdescent t_minimizer_mhd3d%MinimizeMHD3d_ResetDescent proc~minimizemhd3d_resetdescent->proc~evalaux proc~minimizemhd3d_resetdescent->proc~evalenergy proc~minimizemhd3d_resetdescent->proc~evalforce proc~init_base Init_Base proc~init_base->proc~base_new proc~initmhd3d t_functional_mhd3d%InitMHD3D proc~initmhd3d->proc~base_new proc~initsolutionmhd3d t_functional_mhd3d%InitSolutionMHD3D proc~initsolutionmhd3d->proc~evalenergy proc~initsolutionmhd3d->proc~evalforce interface~writestate WriteState proc~initsolutionmhd3d->interface~writestate proc~minimizemhd3d_descent t_minimizer_mhd3d%MinimizeMHD3D_descent proc~minimizemhd3d_descent->proc~evalenergy proc~minimizemhd3d_descent->proc~evalforce proc~minimizemhd3d_descent->proc~minimizemhd3d_resetdescent proc~minimizemhd3d_descent->interface~writestate proc~readstatefilefromascii ReadStateFileFromASCII proc~readstatefilefromascii->proc~base_new proc~transform_sfl_init t_transform_sfl%transform_SFL_init proc~transform_sfl_init->proc~base_new proc~writestatetoascii WriteStateToASCII proc~writestatetoascii->proc~evaltotals program~gvec_post GVEC_POST program~gvec_post->proc~evalenergy program~gvec_post->proc~evalforce program~gvec_post->proc~initmhd3d interface~readstate ReadState interface~readstate->proc~readstatefilefromascii interface~writestate->proc~writestatetoascii proc~init Init proc~init->proc~initmhd3d proc~init_gvec_to_jorek init_gvec_to_jorek proc~init_gvec_to_jorek->proc~init_base proc~init_gvec_to_jorek->interface~readstate proc~initsolution InitSolution proc~initsolution->proc~initsolutionmhd3d proc~minimizemhd3d t_functional_mhd3d%MinimizeMHD3D proc~minimizemhd3d->proc~minimizemhd3d_descent proc~rungvec rungvec proc~rungvec->proc~initmhd3d proc~rungvec->proc~initsolutionmhd3d proc~rungvec->proc~minimizemhd3d proc~transform_sfl_new transform_sfl_new proc~transform_sfl_new->proc~transform_sfl_init proc~minimize minimize proc~minimize->proc~minimizemhd3d proc~restartfromstate RestartFromState proc~restartfromstate->interface~readstate proc~start_rungvec start_rungvec proc~start_rungvec->proc~rungvec program~gvec GVEC program~gvec->proc~rungvec

Source Code

SUBROUTINE base_evalDOF(sf,deriv,DOFs,y_IP_GP)
! MODULES
IMPLICIT NONE
!-----------------------------------------------------------------------------------------------------------------------------------
! INPUT VARIABLES
  CLASS(t_base), INTENT(IN   ) :: sf     !! self
  INTEGER      , INTENT(IN   ) :: deriv(2)   !! =(0,0): base, =(DERIV_S,0): ds, =(0,DERIV_THET): dtheta, =(0,DERIV_ZETA): dzeta
  REAL(wp)     , INTENT(IN   ) :: DOFs(1:sf%s%nBase,1:sf%f%modes)  !! array of all modes and all radial dofs
!-----------------------------------------------------------------------------------------------------------------------------------
! OUTPUT VARIABLES
  REAL(wp)     , INTENT(OUT  ) :: y_IP_GP(sf%f%mn_IP,sf%s%nGP_str:sf%s%nGP_end)  !! OUTPUT ARRAY OF MPI SUBDOMAIN (GP points)
!-----------------------------------------------------------------------------------------------------------------------------------
! LOCAL VARIABLES
  INTEGER                      :: modes,mn_IP,deg,degGP
  INTEGER                      :: nGP_str,nGP_end,nElems_str,nElems_end

  !matrix matrix version: first s then f
  INTEGER                      :: i,j,iElem,iMode,iGP
  REAL(wp)                     :: y_tmp(sf%s%nGP_str:sf%s%nGP_end,sf%f%modes)
!===================================================================================================================================

  __PERFON('BaseEval')

  modes   = sf%f%modes
  mn_IP   = sf%f%mn_IP
  deg     = sf%s%deg
  degGP   = sf%s%degGP
  nGP_str=  sf%s%nGP_str !< for MPI
  nGP_end=  sf%s%nGP_end !< for MPI
  nElems_str=sf%s%grid%nElems_str !< for MPI
  nElems_end=sf%s%grid%nElems_end !< for MPI

  ! matrix-matrix version of first s then f

  __PERFON('eval_s')
  SELECT CASE(deriv(1))
  CASE(0)
!$OMP PARALLEL DO        &
!$OMP   SCHEDULE(STATIC) DEFAULT(SHARED) PRIVATE(iMode,iElem,j,i)
    DO iMode=1,modes
      DO iElem=nElems_str,nElems_end
        j=sf%s%base_offset(iElem)
        i=(iElem-1)*(degGP+1)+1
        y_tmp(i:i+degGP,iMode)=MATMUL(sf%s%base_GP(0:degGP,0:deg,iElem),DOFs(j:j+deg,iMode))
      END DO !iElem
    END DO!iMode
!$OMP END PARALLEL DO
  CASE(DERIV_S)
!$OMP PARALLEL DO        &
!$OMP   SCHEDULE(STATIC) DEFAULT(SHARED) PRIVATE(iMode,iElem,j,i)
    DO iMode=1,modes
      DO iElem=nElems_str,nElems_end
        j=sf%s%base_offset(iElem)
        i=(iElem-1)*(degGP+1)+1
        y_tmp(i:i+degGP,iMode)=MATMUL(sf%s%base_ds_GP(0:degGP,0:deg,iElem),DOFs(j:j+deg,iMode))
      END DO !iElem
    END DO!iMode
!$OMP END PARALLEL DO
  END SELECT !deriv GP
  __PERFOFF('eval_s')

  __PERFON('eval_f')

!$OMP PARALLEL DO        &
!$OMP   SCHEDULE(STATIC) DEFAULT(SHARED) PRIVATE(iGP)
  DO iGP=nGP_str,nGP_end
    y_IP_GP(:,iGP)=sf%f%evalDOF_IP(deriv(2),y_tmp(iGP,:))
  END DO !iGP
!$OMP END PARALLEL DO
  __PERFOFF('eval_f')



  __PERFOFF('BaseEval')

END SUBROUTINE base_evalDOF