fBase_projectIPtoDOF_tens Subroutine

private subroutine fBase_projectIPtoDOF_tens(sf, add, factor, deriv, y_IP, DOFs)

inverse of fBase_evalDOF_IP_tens

Type Bound

t_fBase

Arguments

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

self
logical, intent(in) :: add

=F initialize DOFs , =T add to DOFs
real(kind=wp), intent(in) :: factor

scale result by factor, before adding to DOFs (should be =1.0_wp if not needed)
integer, intent(in) :: deriv

=0: base, =2: dthet , =3: dzeta
real(kind=wp), intent(in) :: y_IP(:)

point values (at sf%x_IP if x_IP_in not given)
real(kind=wp), intent(inout) :: DOFs(1:sf%modes)

array of all modes

Calls

proc~~fbase_projectiptodof_tens~~CallsGraph proc~fbase_projectiptodof_tens t_fBase%fBase_projectIPtoDOF_tens dgemm dgemm proc~fbase_projectiptodof_tens->dgemm

Called by

proc~~fbase_projectiptodof_tens~~CalledByGraph proc~fbase_projectiptodof_tens t_fBase%fBase_projectIPtoDOF_tens proc~evalforce EvalForce proc~evalforce->proc~fbase_projectiptodof_tens proc~fbase_initdof t_fBase%fBase_initDOF proc~fbase_initdof->proc~fbase_projectiptodof_tens proc~get_boozer_sinterp t_sfl_boozer%Get_Boozer_sinterp proc~get_boozer_sinterp->proc~fbase_projectiptodof_tens proc~lambda_setup_and_solve Lambda_setup_and_solve proc~get_boozer_sinterp->proc~lambda_setup_and_solve proc~lambda_setup_and_solve->proc~fbase_projectiptodof_tens proc~bff_convert_to_modes t_boundaryFromFile%bff_convert_to_modes proc~bff_convert_to_modes->proc~fbase_initdof proc~buildtransform_sfl t_transform_sfl%BuildTransform_SFL proc~buildtransform_sfl->proc~get_boozer_sinterp proc~transform_angles_3d Transform_Angles_3d proc~buildtransform_sfl->proc~transform_angles_3d proc~fbase_test fBase_test proc~fbase_test->proc~fbase_initdof proc~get_boozer get_boozer proc~get_boozer->proc~get_boozer_sinterp proc~get_field Get_Field proc~get_field->proc~fbase_initdof proc~gvec_to_jorek_prepare gvec_to_jorek_prepare proc~gvec_to_jorek_prepare->proc~fbase_initdof proc~gvec_to_jorek_prepare->proc~get_field proc~hmap_axisnb_init_params hmap_axisNB_init_params proc~hmap_axisnb_init_params->proc~fbase_initdof proc~initaverageaxis InitAverageAxis proc~initaverageaxis->proc~fbase_initdof proc~initsolutionmhd3d t_functional_mhd3d%InitSolutionMHD3D proc~initsolutionmhd3d->proc~evalforce proc~init_la_from_solution Init_LA_from_Solution proc~initsolutionmhd3d->proc~init_la_from_solution proc~initsolution~2 InitSolution proc~initsolutionmhd3d->proc~initsolution~2 proc~lambda_solve Lambda_solve proc~lambda_solve->proc~lambda_setup_and_solve proc~minimizemhd3d_descent t_minimizer_mhd3d%MinimizeMHD3D_descent proc~minimizemhd3d_descent->proc~evalforce proc~minimizemhd3d_resetdescent t_minimizer_mhd3d%MinimizeMHD3d_ResetDescent proc~minimizemhd3d_descent->proc~minimizemhd3d_resetdescent proc~minimizemhd3d_resetdescent->proc~evalforce proc~transform_angles_3d->proc~fbase_initdof program~gvec_post GVEC_POST program~gvec_post->proc~evalforce proc~initmhd3d t_functional_mhd3d%InitMHD3D program~gvec_post->proc~initmhd3d interface~t_hmap_axisnb t_hmap_axisNB interface~t_hmap_axisnb->proc~hmap_axisnb_init_params proc~hmap_axisnb_init hmap_axisNB_init interface~t_hmap_axisnb->proc~hmap_axisnb_init proc~fbase_init t_fBase%fBase_init proc~fbase_init->proc~fbase_test proc~hmap_axisnb_init->proc~hmap_axisnb_init_params proc~init_la_from_solution->proc~lambda_solve proc~initmhd3d->proc~bff_convert_to_modes proc~initsolution InitSolution proc~initsolution->proc~initsolutionmhd3d proc~initsolution~2->proc~initaverageaxis proc~minimizemhd3d t_functional_mhd3d%MinimizeMHD3D proc~minimizemhd3d->proc~minimizemhd3d_descent proc~rungvec rungvec proc~rungvec->proc~initsolutionmhd3d proc~rungvec->proc~initmhd3d proc~rungvec->proc~minimizemhd3d proc~fbase_copy t_fBase%fBase_copy proc~fbase_copy->proc~fbase_init proc~fbase_new fBase_new proc~fbase_new->proc~fbase_init proc~init Init proc~init->proc~initmhd3d proc~minimize minimize proc~minimize->proc~minimizemhd3d proc~start_rungvec start_rungvec proc~start_rungvec->proc~rungvec program~gvec GVEC program~gvec->proc~rungvec interface~t_fbase t_fBase interface~t_fbase->proc~fbase_new

Source Code

SUBROUTINE fBase_projectIPtoDOF_tens(sf,add,factor,deriv,y_IP,DOFs)
  ! MODULES
  IMPLICIT NONE
  ! INPUT VARIABLES -------------------------!
  CLASS(t_fBase), INTENT(IN   ) :: sf     !! self
  LOGICAL       , INTENT(IN   ) :: add    !! =F initialize DOFs , =T add to DOFs
  REAL(wp)      , INTENT(IN   ) :: factor !! scale result by factor, before adding to DOFs (should be =1.0_wp if not needed)
  INTEGER       , INTENT(IN   ) :: deriv  !! =0: base, =2: dthet , =3: dzeta
  REAL(wp)      , INTENT(IN   ) :: y_IP(:) !! point values (at sf%x_IP if x_IP_in not given)
  ! OUTPUT VARIABLES -------------------------!
  REAL(wp)      , INTENT(INOUT) :: DOFs(1:sf%modes)  !! array of all modes
  ! LOCAL VARIABLES -------------------------!
  INTEGER                       :: iMode,offset,mTotal,nTotal
  REAL(wp)                      :: Amn(1:sf%mTotal1D,-sf%mn_max(2):sf%mn_max(2))
  REAL(wp)                      :: Ctmp(1:sf%mn_nyq(1),1:2,-sf%mn_max(2):sf%mn_max(2))
  ! CODE --------------------------------------------------------------------------------------------------------------------------!
  IF(SIZE(y_IP,1).NE.sf%mn_IP) CALL abort(__STAMP__, &
         'y_IP not correct when calling fBase_projectIPtoDOF_tens' )
  mTotal=  sf%mTotal1D
  nTotal=2*sf%mn_max(2)+1 !-n_max:n_nax

  SELECT CASE(deriv)
  CASE(0)
!    DO n=-sf%mn_max(2),sf%mn_max(2)
!      DO i=1,sf%mn_nyq(1)
!        Ctmp(i,1,n)=SUM(sf%base1D_IPthet(i,1,:)*Amn(:,n))
!        Ctmp(i,2,n)=SUM(sf%base1D_IPthet(i,2,:)*Amn(:,n))
!      END DO !i
!    END DO !n
!    k=0
!    DO j=1,sf%mn_nyq(2)
!      DO i=1,sf%mn_nyq(1)
!        k=k+1
!        y_IP(k)=SUM(Ctmp(i,1:2,:)*sf%base1D_IPzeta(1:2,:,j))
!      END DO !i
!    END DO !j

    __DGEMM_NT(Ctmp,  sf%mn_nyq(1),sf%mn_nyq(2),y_IP,  2*nTotal,sf%mn_nyq(2),sf%base1D_IPzeta)
    __ADGEMM_TN(Amn,factor, 2*sf%mn_nyq(1),mTotal,sf%base1D_IPthet,  2*sf%mn_nyq(1),nTotal,Ctmp)

  CASE(DERIV_THET)
    __DGEMM_NT(Ctmp,  sf%mn_nyq(1),sf%mn_nyq(2),y_IP,  2*nTotal,sf%mn_nyq(2),sf%base1D_IPzeta)
    __ADGEMM_TN(Amn,factor, 2*sf%mn_nyq(1),mTotal,sf%base1D_dthet_IPthet,  2*sf%mn_nyq(1),nTotal,Ctmp)
  CASE(DERIV_ZETA)
    __DGEMM_NT(Ctmp,  sf%mn_nyq(1),sf%mn_nyq(2),y_IP,  2*nTotal,sf%mn_nyq(2),sf%base1D_dzeta_IPzeta)
    __ADGEMM_TN(Amn,factor, 2*sf%mn_nyq(1),mTotal,sf%base1D_IPthet,  2*sf%mn_nyq(1),nTotal,Ctmp)
  CASE DEFAULT
    CALL abort(__STAMP__, &
         "fbase_evalDOF_IP_tens: derivative must be 0,DERIV_THET,DERIV_ZETA!")
  END SELECT

  offset=sf%mTotal1D-(sf%mn_max(1)+1) !=0 if sin or cos, =sf%mn_max(1)+1 if sin+cos
  !copy modes back
  IF(add)THEN
    DO iMode=sf%sin_range(1)+1,sf%sin_range(2)
      DOFs(iMode)=DOFs(iMode)+Amn(1+sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp)
    END DO
    DO iMode=sf%cos_range(1)+1,sf%cos_range(2)
      DOFs(iMode)=DOFs(iMode)+Amn(offset+1+sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp)
    END DO
  ELSE
    DO iMode=sf%sin_range(1)+1,sf%sin_range(2)
      DOFs(iMode)=Amn(1+sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp)
    END DO
    DO iMode=sf%cos_range(1)+1,sf%cos_range(2)
      DOFs(iMode)=Amn(offset+1+sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp)
    END DO
  END IF !add
END SUBROUTINE fBase_projectIPtoDOF_tens