Init_LA_from_Solution Subroutine

private subroutine Init_LA_from_Solution(U_init)

Uses

  • proc~~init_la_from_solution~~UsesGraph proc~init_la_from_solution Init_LA_from_Solution module~modgvec_globals MODgvec_Globals proc~init_la_from_solution->module~modgvec_globals module~modgvec_hmap MODgvec_hmap proc~init_la_from_solution->module~modgvec_hmap module~modgvec_lambda_solve MODgvec_lambda_solve proc~init_la_from_solution->module~modgvec_lambda_solve module~modgvec_mhd3d_vars MODgvec_MHD3D_Vars proc~init_la_from_solution->module~modgvec_mhd3d_vars module~modgvec_mpi MODgvec_MPI proc~init_la_from_solution->module~modgvec_mpi module~modgvec_sol_var_mhd3d MODgvec_sol_var_MHD3D proc~init_la_from_solution->module~modgvec_sol_var_mhd3d iso_fortran_env iso_fortran_env module~modgvec_globals->iso_fortran_env module~modgvec_c_hmap MODgvec_c_hmap module~modgvec_hmap->module~modgvec_c_hmap module~modgvec_hmap_axisnb MODgvec_hmap_axisNB module~modgvec_hmap->module~modgvec_hmap_axisnb module~modgvec_hmap_cyl MODgvec_hmap_cyl module~modgvec_hmap->module~modgvec_hmap_cyl module~modgvec_hmap_frenet MODgvec_hmap_frenet module~modgvec_hmap->module~modgvec_hmap_frenet module~modgvec_hmap_knot MODgvec_hmap_knot module~modgvec_hmap->module~modgvec_hmap_knot module~modgvec_hmap_rz MODgvec_hmap_RZ module~modgvec_hmap->module~modgvec_hmap_rz module~modgvec_lambda_solve->module~modgvec_globals module~modgvec_mhd3d_vars->module~modgvec_globals module~modgvec_mhd3d_vars->module~modgvec_hmap module~modgvec_mhd3d_vars->module~modgvec_sol_var_mhd3d module~modgvec_base MODgvec_base module~modgvec_mhd3d_vars->module~modgvec_base module~modgvec_boundaryfromfile MODgvec_boundaryFromFile module~modgvec_mhd3d_vars->module~modgvec_boundaryfromfile module~modgvec_rprofile_base MODgvec_rProfile_base module~modgvec_mhd3d_vars->module~modgvec_rprofile_base module~modgvec_sgrid MODgvec_sGrid module~modgvec_mhd3d_vars->module~modgvec_sgrid module~modgvec_sol_var_mhd3d->module~modgvec_globals module~modgvec_c_sol_var MODgvec_c_sol_var module~modgvec_sol_var_mhd3d->module~modgvec_c_sol_var module~modgvec_base->module~modgvec_globals module~modgvec_base->module~modgvec_sgrid module~modgvec_fbase MODgvec_fBase module~modgvec_base->module~modgvec_fbase module~modgvec_sbase MODgvec_sBase module~modgvec_base->module~modgvec_sbase module~modgvec_boundaryfromfile->module~modgvec_globals module~modgvec_io_netcdf MODgvec_IO_NETCDF module~modgvec_boundaryfromfile->module~modgvec_io_netcdf module~modgvec_c_hmap->module~modgvec_globals module~modgvec_c_sol_var->module~modgvec_globals module~modgvec_hmap_axisnb->module~modgvec_globals module~modgvec_hmap_axisnb->module~modgvec_c_hmap module~modgvec_hmap_axisnb->module~modgvec_fbase module~modgvec_hmap_axisnb->module~modgvec_io_netcdf module~modgvec_hmap_cyl->module~modgvec_globals module~modgvec_hmap_cyl->module~modgvec_c_hmap module~modgvec_hmap_frenet->module~modgvec_globals module~modgvec_hmap_frenet->module~modgvec_c_hmap module~modgvec_hmap_knot->module~modgvec_globals module~modgvec_hmap_knot->module~modgvec_c_hmap module~modgvec_hmap_rz->module~modgvec_globals module~modgvec_hmap_rz->module~modgvec_c_hmap module~modgvec_rprofile_base->module~modgvec_globals module~modgvec_sgrid->module~modgvec_globals module~modgvec_fbase->module~modgvec_globals module~modgvec_io_netcdf->module~modgvec_globals module~modgvec_sbase->module~modgvec_globals module~modgvec_sbase->module~modgvec_sgrid module~sll_m_bsplines sll_m_bsplines module~modgvec_sbase->module~sll_m_bsplines module~sll_m_spline_interpolator_1d sll_m_spline_interpolator_1d module~modgvec_sbase->module~sll_m_spline_interpolator_1d module~sll_m_spline_matrix sll_m_spline_matrix module~modgvec_sbase->module~sll_m_spline_matrix module~sll_m_assert sll_m_assert module~sll_m_bsplines->module~sll_m_assert module~sll_m_bsplines_base sll_m_bsplines_base module~sll_m_bsplines->module~sll_m_bsplines_base module~sll_m_bsplines_non_uniform sll_m_bsplines_non_uniform module~sll_m_bsplines->module~sll_m_bsplines_non_uniform module~sll_m_bsplines_uniform sll_m_bsplines_uniform module~sll_m_bsplines->module~sll_m_bsplines_uniform module~sll_m_errors sll_m_errors module~sll_m_bsplines->module~sll_m_errors module~sll_m_working_precision sll_m_working_precision module~sll_m_bsplines->module~sll_m_working_precision module~sll_m_spline_interpolator_1d->module~sll_m_spline_matrix module~sll_m_spline_interpolator_1d->module~sll_m_assert module~sll_m_boundary_condition_descriptors sll_m_boundary_condition_descriptors module~sll_m_spline_interpolator_1d->module~sll_m_boundary_condition_descriptors module~sll_m_spline_interpolator_1d->module~sll_m_bsplines_base module~sll_m_spline_interpolator_1d->module~sll_m_errors module~sll_m_spline_1d sll_m_spline_1d module~sll_m_spline_interpolator_1d->module~sll_m_spline_1d module~sll_m_spline_interpolator_1d->module~sll_m_working_precision module~sll_m_spline_matrix->module~sll_m_errors module~sll_m_spline_matrix_banded sll_m_spline_matrix_banded module~sll_m_spline_matrix->module~sll_m_spline_matrix_banded module~sll_m_spline_matrix_base sll_m_spline_matrix_base module~sll_m_spline_matrix->module~sll_m_spline_matrix_base module~sll_m_spline_matrix_dense sll_m_spline_matrix_dense module~sll_m_spline_matrix->module~sll_m_spline_matrix_dense module~sll_m_spline_matrix->module~sll_m_working_precision module~sll_m_boundary_condition_descriptors->module~sll_m_working_precision module~sll_m_bsplines_base->module~sll_m_assert module~sll_m_bsplines_base->module~sll_m_working_precision module~sll_m_bsplines_non_uniform->module~sll_m_assert module~sll_m_bsplines_non_uniform->module~sll_m_bsplines_base module~sll_m_bsplines_non_uniform->module~sll_m_working_precision module~sll_m_bsplines_uniform->module~sll_m_assert module~sll_m_bsplines_uniform->module~sll_m_bsplines_base module~sll_m_bsplines_uniform->module~sll_m_errors module~sll_m_bsplines_uniform->module~sll_m_working_precision module~sll_m_errors->iso_fortran_env module~sll_m_spline_1d->module~sll_m_assert module~sll_m_spline_1d->module~sll_m_bsplines_base module~sll_m_spline_1d->module~sll_m_working_precision module~sll_m_spline_matrix_banded->iso_fortran_env module~sll_m_spline_matrix_banded->module~sll_m_assert module~sll_m_spline_matrix_banded->module~sll_m_errors module~sll_m_spline_matrix_banded->module~sll_m_spline_matrix_base module~sll_m_spline_matrix_banded->module~sll_m_working_precision module~sll_m_spline_matrix_base->module~sll_m_working_precision module~sll_m_spline_matrix_dense->iso_fortran_env module~sll_m_spline_matrix_dense->module~sll_m_assert module~sll_m_spline_matrix_dense->module~sll_m_errors module~sll_m_spline_matrix_dense->module~sll_m_spline_matrix_base module~sll_m_spline_matrix_dense->module~sll_m_working_precision

Initialize LAMBDA FROM U_init%X1,%X2 and iota profile, this computation is distributed over MPIranks

! CALL par_reduce(LA_gIP,'SUM',0) ! IF(MPIroot)THEN ! DO iMode=1,modes ! IF(zero_odd_even(iMode).EQ.0)THEN ! U_init%LA(:,iMode)=0.0_wp ! (0,0) mode should not be here, but must be zero if its used. ! ELSE ! U_init%LA(:,iMode)=LA_base%s%initDOF( LA_gIP(:,iMode) ) ! END IF!iMode ~ 0 ! BC_val =(/ 0.0_wp, 0.0_wp/) ! CALL LA_base%s%applyBCtoDOF(U_init%LA(:,iMode),LA_BC_type(:,iMode),BC_val) ! END DO !iMode=1,modes ! END IF ! CALL par_BCast(U_init%LA,0)

Arguments

Type IntentOptional Attributes Name
class(t_sol_var_MHD3D), intent(inout) :: U_init

Calls

proc~~init_la_from_solution~~CallsGraph proc~init_la_from_solution Init_LA_from_Solution interface~enter_subregion enter_subregion proc~init_la_from_solution->interface~enter_subregion interface~exit_subregion exit_subregion proc~init_la_from_solution->interface~exit_subregion interface~gettime GetTime proc~init_la_from_solution->interface~gettime interface~par_bcast par_Bcast proc~init_la_from_solution->interface~par_bcast interface~par_reduce par_Reduce proc~init_la_from_solution->interface~par_reduce interface~progressbar ProgressBar proc~init_la_from_solution->interface~progressbar proc~hmap_new_auxvar hmap_new_auxvar proc~init_la_from_solution->proc~hmap_new_auxvar proc~lambda_solve Lambda_solve proc~init_la_from_solution->proc~lambda_solve proc~rprofile_eval_at_rho c_rProfile%rProfile_eval_at_rho proc~init_la_from_solution->proc~rprofile_eval_at_rho proc~sbase_applybctodof_lgm t_sBase%sBase_applyBCtoDOF_LGM proc~init_la_from_solution->proc~sbase_applybctodof_lgm proc~sbase_initdof t_sBase%sBase_initDOF proc~init_la_from_solution->proc~sbase_initdof interface~enter_subregion->interface~enter_subregion interface~exit_subregion->interface~exit_subregion interface~gettime->interface~gettime proc~par_bcast_array1d par_Bcast_array1D interface~par_bcast->proc~par_bcast_array1d proc~par_bcast_array1d_int par_Bcast_array1D_int interface~par_bcast->proc~par_bcast_array1d_int proc~par_bcast_array1d_str par_Bcast_array1D_str interface~par_bcast->proc~par_bcast_array1d_str proc~par_bcast_array2d par_Bcast_array2D interface~par_bcast->proc~par_bcast_array2d proc~par_bcast_scalar par_Bcast_scalar interface~par_bcast->proc~par_bcast_scalar proc~par_bcast_scalar_int par_Bcast_scalar_int interface~par_bcast->proc~par_bcast_scalar_int proc~par_bcast_scalar_str par_Bcast_scalar_str interface~par_bcast->proc~par_bcast_scalar_str proc~par_reduce_array1d par_Reduce_array1D interface~par_reduce->proc~par_reduce_array1d proc~par_reduce_array2d par_Reduce_array2D interface~par_reduce->proc~par_reduce_array2d proc~par_reduce_scalar par_Reduce_scalar interface~par_reduce->proc~par_reduce_scalar proc~par_reduce_scalar_int par_Reduce_scalar_int interface~par_reduce->proc~par_reduce_scalar_int interface~progressbar->interface~progressbar proc~fbase_evaldof_ip_tens t_fBase%fBase_evalDOF_IP_tens proc~lambda_solve->proc~fbase_evaldof_ip_tens proc~hmap_eval_gij_aux c_hmap%hmap_eval_gij_aux proc~lambda_solve->proc~hmap_eval_gij_aux proc~hmap_eval_jh_aux c_hmap%hmap_eval_Jh_aux proc~lambda_solve->proc~hmap_eval_jh_aux proc~lambda_setup_and_solve Lambda_setup_and_solve proc~lambda_solve->proc~lambda_setup_and_solve proc~sbase_evaldof_s t_sBase%sBase_evalDOF_s proc~lambda_solve->proc~sbase_evaldof_s eval_at_rho2 eval_at_rho2 proc~rprofile_eval_at_rho->eval_at_rho2 proc~rho2_derivative rho2_derivative proc~rprofile_eval_at_rho->proc~rho2_derivative proc~rprofile_drho2 c_rProfile%rProfile_drho2 proc~rprofile_eval_at_rho->proc~rprofile_drho2 proc~rprofile_drho3 c_rProfile%rProfile_drho3 proc~rprofile_eval_at_rho->proc~rprofile_drho3 proc~rprofile_drho4 c_rProfile%rProfile_drho4 proc~rprofile_eval_at_rho->proc~rprofile_drho4 proc~solve SOLVE proc~sbase_applybctodof_lgm->proc~solve compute_interpolant compute_interpolant proc~sbase_initdof->compute_interpolant 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 eval_gij eval_gij proc~hmap_eval_gij_aux->eval_gij eval_Jh eval_Jh proc~hmap_eval_jh_aux->eval_Jh proc~lambda_setup_and_solve->proc~solve proc~fbase_projectiptodof_tens t_fBase%fBase_projectIPtoDOF_tens proc~lambda_setup_and_solve->proc~fbase_projectiptodof_tens proc~poly_derivative_prefactor poly_derivative_prefactor proc~rho2_derivative->proc~poly_derivative_prefactor proc~rprofile_drho2->eval_at_rho2 proc~rprofile_drho2->proc~rho2_derivative proc~rprofile_drho3->eval_at_rho2 proc~rprofile_drho3->proc~rho2_derivative proc~rprofile_drho4->eval_at_rho2 proc~rprofile_drho4->proc~rho2_derivative proc~sbase_eval t_sBase%sBase_eval proc~sbase_evaldof_s->proc~sbase_eval proc~sbase_evaldof_base t_sBase%sBase_evalDOF_base proc~sbase_evaldof_s->proc~sbase_evaldof_base dgetrf dgetrf proc~solve->dgetrf dgetrs dgetrs proc~solve->dgetrs dgemv dgemv proc~fbase_evaldof_xn->dgemv proc~fbase_eval_xn t_fBase%fBase_eval_xn proc~fbase_evaldof_xn->proc~fbase_eval_xn proc~fbase_projectiptodof_tens->dgemm eval_basis eval_basis proc~sbase_eval->eval_basis eval_basis_and_n_derivs eval_basis_and_n_derivs proc~sbase_eval->eval_basis_and_n_derivs lagrangeinterpolationpolys lagrangeinterpolationpolys proc~sbase_eval->lagrangeinterpolationpolys proc~sgrid_find_elem t_sGrid%sGrid_find_elem proc~sbase_eval->proc~sgrid_find_elem

Called by

proc~~init_la_from_solution~~CalledByGraph proc~init_la_from_solution Init_LA_from_Solution proc~initsolutionmhd3d t_functional_mhd3d%InitSolutionMHD3D proc~initsolutionmhd3d->proc~init_la_from_solution proc~initsolution~2 InitSolution proc~initsolution~2->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 Init_LA_from_Solution(U_init)
! MODULES
  USE MODgvec_Globals,       ONLY:ProgressBar,getTime,myRank,nRanks
  USE MODgvec_MHD3D_Vars   , ONLY:X1_base,X2_base,LA_base,LA_BC_Type,hmap, Phi_profile, chi_profile
  USE MODgvec_sol_var_MHD3D, ONLY:t_sol_var_mhd3d
  USE MODgvec_lambda_solve,  ONLY:lambda_solve
  USE MODgvec_MPI           ,ONLY:par_reduce,par_BCast
  USE MODgvec_hmap          ,ONLY:hmap_new_auxvar,PP_T_HMAP_AUXVAR
!$ USE omp_lib
  IMPLICIT NONE
!-----------------------------------------------------------------------------------------------------------------------------------
! INPUT VARIABLES
!-----------------------------------------------------------------------------------------------------------------------------------
! OUTPUT VARIABLES
  CLASS(t_sol_var_MHD3D), INTENT(INOUT) :: U_init
!-----------------------------------------------------------------------------------------------------------------------------------
! LOCAL VARIABLES
  INTEGER  :: iMode,is,ns_str,ns_end,iRank,nBase
  REAL(wp) :: BC_val(2),rhopos
  REAL(wp) :: StartTime,EndTime
  REAL(wp),DIMENSION(1:LA_base%s%nBase):: PhiPrime,chiPrime
  REAL(wp) :: LA_gIP(1:LA_base%s%nBase,1:LA_base%f%modes)
#ifdef PP_WHICH_HMAP
  TYPE(PP_T_HMAP_AUXVAR),ALLOCATABLE  :: hmap_xv(:) !! auxiliary variables for hmap
#else
  CLASS(PP_T_HMAP_AUXVAR),ALLOCATABLE  :: hmap_xv(:) !! auxiliary variables for hmap
#endif
!===================================================================================================================================
  StartTime=GetTime()
  SWRITE(UNIT_stdOut,'(4X,A)') "... Initialize lambda from mapping ..."
  CALL enter_subregion("reinit-lambda")
  nBase        = LA_base%s%nBase
  ASSOCIATE(modes        => LA_base%f%modes, &
            s_IP         => LA_base%s%s_IP, &
            zero_odd_even=> LA_base%f%zero_odd_even, &
            modes_str    => LA_base%f%modes_str, &
            modes_end    => LA_base%f%modes_end, &
            offset_modes => LA_Base%f%offset_modes )
  !evaluate profiles only in MPIroot!
  IF(MPIroot)THEN
    DO is=1,nBase
      rhopos=MIN(1.0_wp-1.0e-12_wp,MAX(1.0e-4_wp,s_IP(is))) !exclude axis
      phiPrime(is)=Phi_profile%eval_at_rho(rhopos,deriv=1)
      chiPrime(is)=chi_profile%eval_at_rho(rhopos,deriv=1)
    END DO
  END IF !MPIroot
  CALL par_BCast(phiPrime,0)
  CALL par_BCast(chiPrime,0)
  !initialize Lambda, radially parallel
  ns_str = (nBase*(myRank  ))/nRanks+1
  ns_end = (nBase*(myRank+1))/nRanks
  LA_gIP=0.0_wp
  CALL ProgressBar(0,ns_end) !init

  CALL hmap_new_auxvar(hmap,X1_base%f%x_IP(2,:),hmap_xv,.FALSE.) !no 2nd derivative needed
  DO is=ns_str,ns_end
    rhopos=MIN(1.0_wp-1.0e-12_wp,MAX(1.0e-4_wp,s_IP(is))) !exclude axis
    CALL lambda_Solve(rhopos,hmap,hmap_xv,X1_base,X2_base,LA_base%f,U_init%X1,U_init%X2,LA_gIP(is,:),phiPrime(is),chiPrime(is))
    CALL ProgressBar(is,ns_end)
  END DO !is
  DEALLOCATE(hmap_xv)
!!!  CALL par_reduce(LA_gIP,'SUM',0)
!!!  IF(MPIroot)THEN
!!!    DO iMode=1,modes
!!!      IF(zero_odd_even(iMode).EQ.MN_ZERO)THEN
!!!        U_init%LA(:,iMode)=0.0_wp ! (0,0) mode should not be here, but must be zero if its used.
!!!      ELSE
!!!        U_init%LA(:,iMode)=LA_base%s%initDOF( LA_gIP(:,iMode) )
!!!      END IF!iMode ~ MN_ZERO
!!!      BC_val =(/ 0.0_wp, 0.0_wp/)
!!!      CALL LA_base%s%applyBCtoDOF(U_init%LA(:,iMode),LA_BC_type(:,iMode),BC_val)
!!!    END DO !iMode=1,modes
!!!  END IF
!!!  CALL par_BCast(U_init%LA,0)
  !reduce radially, different mode sets to different MPIranks (should be a gatherv)
  DO iRank=0,nRanks-1
    IF(offset_modes(iRank+1)-offset_modes(iRank).GT.0) &
      CALL par_Reduce(LA_gIP(1:nbase,offset_modes(iRank)+1:offset_modes(iRank+1)),'SUM',iRank)
  END DO
  DO iMode=modes_str,modes_end
    IF(zero_odd_even(iMode).EQ.MN_ZERO)THEN
      U_init%LA(1:nBase,iMode)=0.0_wp ! (0,0) mode should not be here, but must be zero if its used.
    ELSE
      U_init%LA(1:nBase,iMode)=LA_base%s%initDOF( LA_gIP(1:nBase,iMode) )
    END IF!iMode ~ MN_ZERO
    BC_val =(/ 0.0_wp, 0.0_wp/)
    CALL LA_base%s%applyBCtoDOF(U_init%LA(:,iMode),LA_BC_type(:,iMode),BC_val)
  END DO !iMode=modes_str, modes_end
  ! broadcast result: different mode ranges to different MPIranks
  DO iRank=0,nRanks-1
    IF(offset_modes(iRank+1)-offset_modes(iRank).GT.0) &
      CALL par_Bcast(U_init%LA(1:nBase,offset_modes(iRank)+1:offset_modes(iRank+1)),iRank)
  END DO
  END ASSOCIATE !LA
  EndTime=GetTime()
  CALL exit_subregion("reinit-lambda")
  SWRITE(UNIT_stdOut,'(4X,A,F9.2,A)') " init lambda took [ ",EndTime-StartTime," sec]"
END SUBROUTINE Init_LA_from_solution