Lambda_setup_and_solve Subroutine

public subroutine Lambda_setup_and_solve(LA_fbase_in, phiPrime_s, ChiPrime_s, gam_tt, gam_tz, gam_zz, LA_s)

Uses

  • proc~~lambda_setup_and_solve~~UsesGraph proc~lambda_setup_and_solve Lambda_setup_and_solve module~modgvec_fbase MODgvec_fBase proc~lambda_setup_and_solve->module~modgvec_fbase module~modgvec_linalg MODgvec_LinAlg proc~lambda_setup_and_solve->module~modgvec_linalg module~modgvec_globals MODgvec_Globals module~modgvec_fbase->module~modgvec_globals module~modgvec_linalg->module~modgvec_globals iso_fortran_env iso_fortran_env module~modgvec_globals->iso_fortran_env

Arguments

Type IntentOptional Attributes Name
type(t_fBase), intent(in) :: LA_fbase_in
real(kind=wp), intent(in) :: phiPrime_s

toroidal and poloidal flux s derivatives at s_pos
real(kind=wp), intent(in) :: ChiPrime_s

toroidal and poloidal flux s derivatives at s_pos
real(kind=wp), intent(in), DIMENSION(1:LA_fbase_in%mn_IP) :: gam_tt

g_tt/J evaluated on IP points
real(kind=wp), intent(in), DIMENSION(1:LA_fbase_in%mn_IP) :: gam_tz

g_tz/J evaluated on IP points
real(kind=wp), intent(in), DIMENSION(1:LA_fbase_in%mn_IP) :: gam_zz

g_zz/J evaluated on IP points
real(kind=wp), intent(out) :: LA_s(1:LA_fbase_in%modes)

lambda at spos

Calls

proc~~lambda_setup_and_solve~~CallsGraph proc~lambda_setup_and_solve Lambda_setup_and_solve proc~fbase_projectiptodof_tens t_fBase%fBase_projectIPtoDOF_tens proc~lambda_setup_and_solve->proc~fbase_projectiptodof_tens proc~solve SOLVE proc~lambda_setup_and_solve->proc~solve dgemm dgemm proc~fbase_projectiptodof_tens->dgemm dgetrf dgetrf proc~solve->dgetrf dgetrs dgetrs proc~solve->dgetrs

Called by

proc~~lambda_setup_and_solve~~CalledByGraph proc~lambda_setup_and_solve Lambda_setup_and_solve proc~get_boozer_sinterp t_sfl_boozer%Get_Boozer_sinterp proc~get_boozer_sinterp->proc~lambda_setup_and_solve proc~lambda_solve Lambda_solve proc~lambda_solve->proc~lambda_setup_and_solve proc~buildtransform_sfl t_transform_sfl%BuildTransform_SFL proc~buildtransform_sfl->proc~get_boozer_sinterp proc~get_boozer get_boozer proc~get_boozer->proc~get_boozer_sinterp proc~init_la_from_solution Init_LA_from_Solution proc~init_la_from_solution->proc~lambda_solve proc~initsolutionmhd3d t_functional_mhd3d%InitSolutionMHD3D proc~initsolutionmhd3d->proc~init_la_from_solution proc~initsolution InitSolution proc~initsolution->proc~initsolutionmhd3d proc~rungvec rungvec proc~rungvec->proc~initsolutionmhd3d proc~start_rungvec start_rungvec proc~start_rungvec->proc~rungvec program~gvec GVEC program~gvec->proc~rungvec

Source Code

SUBROUTINE Lambda_setup_and_solve(LA_fbase_in,phiPrime_s,ChiPrime_s,gam_tt,gam_tz,gam_zz,LA_s)
  ! MODULES
    USE MODgvec_LinAlg,ONLY: SOLVE
    USE MODgvec_fbase ,ONLY: t_fbase
    IMPLICIT NONE
  !-----------------------------------------------------------------------------------------------------------------------------------
  ! INPUT VARIABLES
    TYPE(t_fbase),INTENT(IN)        :: LA_fbase_in           !< base classes belong to solution U_in
    REAL(wp),INTENT(IN)              :: phiPrime_s,ChiPrime_s   !! toroidal and poloidal flux s derivatives at s_pos
    REAL(wp),DIMENSION(1:LA_fbase_in%mn_IP), INTENT(IN) :: gam_tt  !! g_tt/J evaluated on IP points
    REAL(wp),DIMENSION(1:LA_fbase_in%mn_IP), INTENT(IN) :: gam_tz  !! g_tz/J evaluated on IP points
    REAL(wp),DIMENSION(1:LA_fbase_in%mn_IP), INTENT(IN) :: gam_zz  !! g_zz/J evaluated on IP points
  !-----------------------------------------------------------------------------------------------------------------------------------
  ! OUTPUT VARIABLES
    REAL(wp)     , INTENT(  OUT) :: LA_s(1:LA_fbase_in%modes) !! lambda at spos
  !-----------------------------------------------------------------------------------------------------------------------------------
  ! LOCAL VARIABLES
    INTEGER                               :: iMode,jMode,mn_IP,LA_modes
    REAL(wp)                              :: Amat(1:LA_fbase_in%modes,1:LA_fbase_in%modes)
    REAL(wp),DIMENSION(1:LA_fbase_in%modes) :: RHS,sAdiag
  !  REAL(wp)                              :: gam_ta_da,gam_za_da
    REAL(wp)                              :: sum_gam_ta_da,sum_gam_za_da
    REAL(wp),DIMENSION(1:LA_fbase_in%mn_IP,1:LA_fbase_in%modes) :: gam_ta_da,gam_za_da
  !===================================================================================================================================
    __PERFON('setup_1')
    LA_modes=LA_fbase_in%modes
    mn_IP   =LA_fbase_in%mn_IP

  !$OMP PARALLEL DO        &
  !$OMP   SCHEDULE(STATIC) DEFAULT(NONE) PRIVATE(iMode)  &
  !$OMP   SHARED(mn_IP,LA_modes,LA_fbase_in,sAdiag)
    !estimate of 1/Adiag for preconditioning (=1 for m=n=0)
    DO iMode=1,LA_modes
    sAdiag(iMode)=1.0_wp/(MAX(1.0_wp,REAL((LA_fbase_in%Xmn(1,iMode))**2+LA_fbase_in%Xmn(2,iMode)**2 ,wp) )*REAL(mn_IP,wp))
        !sAdiag(iMode)=1.0_wp
    END DO !iMode
  !$OMP END PARALLEL DO

  !$OMP PARALLEL DO        &
  !$OMP   SCHEDULE(STATIC) DEFAULT(NONE) PRIVATE(iMode)        &
  !$OMP   SHARED(gam_ta_da,gam_za_da,LA_modes,gam_tt,gam_tz,gam_zz,LA_fbase_in)
    DO iMode=1,LA_modes
      gam_ta_da(:,iMode)=gam_tz(:)*LA_fbase_in%base_dthet_IP(:,iMode) - gam_tt(:)*LA_fbase_in%base_dzeta_IP(:,iMode)
      gam_za_da(:,iMode)=gam_zz(:)*LA_fbase_in%base_dthet_IP(:,iMode) - gam_tz(:)*LA_fbase_in%base_dzeta_IP(:,iMode)
    END DO!iMode
  !$OMP END PARALLEL DO

  __PERFOFF('setup_1')
  __PERFON('setup_Amat')

!$OMP PARALLEL DO        &
!$OMP   SCHEDULE(STATIC) DEFAULT(NONE) PRIVATE(jMode)        &
!$OMP   SHARED(Amat,gam_ta_da,gam_za_da,LA_fbase_in,LA_modes,PhiPrime_s,sAdiag)
    DO jMode=1,LA_modes
      !m=n=0 should not be in lambda, but check
      IF (LA_fbase_in%zero_odd_even(jMode).NE.MN_ZERO) THEN
        CALL LA_fbase_in%projectIPtoDOF(.FALSE., PhiPrime_s,DERIV_ZETA,gam_ta_da(:,jMode),Amat(:,jMode))
        CALL LA_fbase_in%projectIPtoDOF(.TRUE. ,-PhiPrime_s,DERIV_THET,gam_za_da(:,jMode),Amat(:,jMode))
        Amat(:,jMode) = Amat(:,jMode) *sAdiag(:)
      ELSE
        Amat(:    ,jMode)=0.0_wp
        Amat(jMode,jMode)=1.0_wp
      END IF
    END DO!jMode
!$OMP END PARALLEL DO

  __PERFOFF('setup_Amat')
  __PERFON('setup_rhs')

  !$OMP PARALLEL DO        &
  !$OMP   SCHEDULE(STATIC) DEFAULT(NONE) PRIVATE(iMode,sum_gam_ta_da,sum_gam_za_da)        &
  !$OMP   SHARED(RHS,gam_ta_da,gam_za_da,LA_fbase_in,LA_modes,chiPrime_s,PhiPrime_s,sAdiag)
    DO iMode=1,LA_modes
      !m=n=0 should not be in lambda, but check
      IF (LA_fbase_in%zero_odd_even(iMode).NE.MN_ZERO) THEN
        sum_gam_ta_da=SUM(gam_ta_da(:,iMode))
        sum_gam_za_da=SUM(gam_za_da(:,iMode))
        ! 1/J( iota (g_thet,zeta dsigma_dthet - g_thet,thet dsigma_dzeta )
        !          +(g_zeta,zeta dsigma_dthet - g_zeta,thet dsigma_dzeta ) )
        RHS(iMode) = (chiPrime_s*sum_gam_ta_da +phiPrime_s*sum_gam_za_da) *sAdiag(iMode)
      ELSE
        RHS(iMode) = 0.0_wp
      END IF
    END DO!iMode
  !$OMP END PARALLEL DO

    __PERFOFF('setup_rhs')
    __PERFON('solve')
    LA_s=SOLVE(Amat,RHS)
    __PERFOFF('solve')
END SUBROUTINE Lambda_setup_and_solve