InitProfile Subroutine

private subroutine InitProfile(sf, var, var_profile)

Uses

  • proc~~initprofile~~UsesGraph proc~initprofile InitProfile module~modgvec_cubic_spline MODgvec_cubic_spline proc~initprofile->module~modgvec_cubic_spline module~modgvec_readintools MODgvec_ReadInTools proc~initprofile->module~modgvec_readintools module~modgvec_rprofile_base MODgvec_rProfile_base proc~initprofile->module~modgvec_rprofile_base module~modgvec_rprofile_bspl MODgvec_rProfile_bspl proc~initprofile->module~modgvec_rprofile_bspl module~modgvec_rprofile_poly MODgvec_rProfile_poly proc~initprofile->module~modgvec_rprofile_poly module~modgvec_globals MODgvec_Globals module~modgvec_cubic_spline->module~modgvec_globals module~sll_m_bsplines sll_m_bsplines module~modgvec_cubic_spline->module~sll_m_bsplines module~modgvec_readintools->module~modgvec_globals module~modgvec_rprofile_base->module~modgvec_globals module~modgvec_rprofile_bspl->module~modgvec_rprofile_base module~modgvec_rprofile_bspl->module~modgvec_globals module~modgvec_rprofile_bspl->module~sll_m_bsplines module~modgvec_rprofile_poly->module~modgvec_rprofile_base module~modgvec_rprofile_poly->module~modgvec_globals iso_fortran_env iso_fortran_env module~modgvec_globals->iso_fortran_env 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_working_precision sll_m_working_precision module~sll_m_bsplines->module~sll_m_working_precision module~sll_m_bsplines_base->module~sll_m_working_precision 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_bsplines_base module~sll_m_bsplines_uniform->module~sll_m_working_precision

Arguments

Type IntentOptional Attributes Name
class(t_functional_mhd3d), intent(inout) :: sf
character(len=4), intent(in) :: var
class(c_rProfile), ALLOCATABLE :: var_profile

Calls

proc~~initprofile~~CallsGraph proc~initprofile InitProfile getreal getreal proc~initprofile->getreal getrealarray getrealarray proc~initprofile->getrealarray getstr getstr proc~initprofile->getstr interface~interpolate_cubic_spline interpolate_cubic_spline proc~initprofile->interface~interpolate_cubic_spline proc~getrealallocarray GETREALALLOCARRAY proc~initprofile->proc~getrealallocarray sdeallocate sdeallocate proc~initprofile->sdeallocate interface~interpolate_cubic_spline->interface~interpolate_cubic_spline interface~findstr FindStr proc~getrealallocarray->interface~findstr proc~converttoproposalstr ConvertToProposalStr proc~getrealallocarray->proc~converttoproposalstr proc~count_sep count_sep proc~getrealallocarray->proc~count_sep swrite swrite proc~getrealallocarray->swrite interface~findstr->interface~findstr proc~remove_blanks remove_blanks proc~converttoproposalstr->proc~remove_blanks

Called by

proc~~initprofile~~CalledByGraph proc~initprofile InitProfile proc~initmhd3d t_functional_mhd3d%InitMHD3D proc~initmhd3d->proc~initprofile

Source Code

SUBROUTINE InitProfile(sf, var,var_profile)
  ! MODULES
  USE MODgvec_ReadInTools    , ONLY: GETSTR,GETLOGICAL,GETINT,GETINTARRAY,GETREAL,GETREALALLOCARRAY, GETREALARRAY
  USE MODgvec_rProfile_bspl  , ONLY: t_rProfile_bspl
  USE MODgvec_rProfile_poly  , ONLY: t_rProfile_poly
  USE MODgvec_cubic_spline   , ONLY: interpolate_cubic_spline
  USE MODgvec_rProfile_base, ONLY: c_rProfile
  IMPLICIT NONE
!-----------------------------------------------------------------------------------------------------------------------------------
! INPUT VARIABLES
  CLASS(t_functional_mhd3d), INTENT(INOUT) :: sf
  CHARACTER(LEN=4), INTENT(IN) :: var
!-----------------------------------------------------------------------------------------------------------------------------------
! OUTPUT VARIABLES
  CLASS(c_rProfile), ALLOCATABLE   :: var_profile
!-----------------------------------------------------------------------------------------------------------------------------------
! LOCAL VARIABLES
  INTEGER              :: n_profile_knots
  REAL(wp),ALLOCATABLE :: profile_knots(:)
  INTEGER              :: n_profile_coefs    !! number of polynomial/bspline coeffients for profile profile
  REAL(wp),ALLOCATABLE :: profile_coefs(:)   !! polynomial/bspline coefficients of the profile profile
  CHARACTER(LEN=20)    :: profile_type
  REAL(wp),ALLOCATABLE :: profile_rho2(:)
  REAL(wp),ALLOCATABLE :: profile_vals(:)
  INTEGER              :: n_profile_vals
  INTEGER              :: n_profile_rho2
  REAL(wp)             :: profile_BC_vals(1:2)
  CHARACTER(LEN=10)    :: profile_BC_type(1:2)
  REAL(wp)             :: profile_scale
  CHARACTER(LEN=10)    :: possible_BCs(0:2)
  INTEGER              :: BC(1:2),iBC,jBC
  !===================================================================================================================================
  possible_BCs(0)="not_a_knot"
  possible_BCs(1)="1st_deriv"
  possible_BCs(2)="2nd_deriv"

  profile_scale=GETREAL(var//"_scale",Proposal=1.0_wp)
  profile_type  = GETSTR(var//"_type") !make it mandatory
  IF (profile_type.EQ."polynomial") THEN
    CALL GETREALALLOCARRAY(var//"_coefs",profile_coefs,n_profile_coefs) !a+b*s+c*s^2...
    profile_coefs=profile_coefs*profile_scale
    var_profile = t_rProfile_poly(profile_coefs)
  ELSE IF (profile_type.EQ."bspline") THEN
    CALL GETREALALLOCARRAY(var//"_coefs",profile_coefs,n_profile_coefs)
    profile_coefs=profile_coefs*profile_scale
    CALL GETREALALLOCARRAY(var//"_knots",profile_knots,n_profile_knots)
    var_profile = t_rProfile_bspl(coefs=profile_coefs,knots=profile_knots)
  ELSE IF (profile_type.EQ."interpolation") THEN
    CALL GETREALALLOCARRAY(var//"_vals",profile_vals, n_profile_vals)
    CALL GETREALALLOCARRAY(var//"_rho2",profile_rho2, n_profile_rho2)
    IF (n_profile_vals .NE. n_profile_rho2) THEN
      CALL abort(__STAMP__,&
      'Size of '//var//'_rho2 and '//var//'_vals must be equal!')
    END IF
    profile_BC_type(1) = GETSTR(var//"_BC_type_axis",Proposal="not_a_knot")
    profile_BC_type(2) = GETSTR(var//"_BC_type_edge",Proposal="not_a_knot")
    BC=-1
    DO iBC=1,2
      DO jBC=0,2
        IF (INDEX(TRIM(profile_BC_type(iBC)),TRIM(possible_BCs(jBC)))>0) THEN
          BC(iBC)=jBC
          EXIT
        END IF
      END DO !jBC
    END DO !iBC
    IF(ANY(BC<0)) THEN
      CALL abort(__STAMP__,&
                 "BC_type can only be 'not_a_knot', '1st_deriv' or '2nd_deriv'!")
    END IF

    IF(ANY(BC>0)) THEN
     profile_BC_vals = GETREALARRAY(var//"_BC_vals", 2, Proposal=(/0.0_wp, 0.0_wp/))
     CALL interpolate_cubic_spline(profile_rho2,profile_vals, profile_coefs, profile_knots, BC, profile_BC_vals)
    ELSE
     CALL interpolate_cubic_spline(profile_rho2,profile_vals, profile_coefs, profile_knots, BC)
    END IF

    profile_coefs=profile_coefs*profile_scale
    var_profile = t_rProfile_bspl(profile_knots,profile_coefs)
    SDEALLOCATE(profile_vals)
    SDEALLOCATE(profile_rho2)
  ELSE
    CALL abort(__STAMP__,&
    'Specified '//var//'_type unknown. It must be either "polynomial", "bspline" or "interpolation".')
  END IF ! profile type

  SDEALLOCATE(profile_knots)
  SDEALLOCATE(profile_coefs)
END SUBROUTINE InitProfile