sBase_change_base Subroutine

private subroutine sBase_change_base(sf, old_sBase, iterDim, old_data, sf_data)

change data from old_sBase to self. using interpolations of the old data at the new interpolation points

Type Bound

t_sBase

Arguments

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

self
class(c_sbase), intent(in) :: old_sBase

base of old_data
integer, intent(in) :: iterDim

iterate on first or second dimension or old_data/sf_data
real(kind=wp), intent(in) :: old_data(:,:)
real(kind=wp), intent(out) :: sf_data(:,:)

Calls

proc~~sbase_change_base~~CallsGraph proc~sbase_change_base t_sBase%sBase_change_base eval eval proc~sbase_change_base->eval evalDOF_base evalDOF_base proc~sbase_change_base->evalDOF_base proc~sbase_compare t_sBase%sBase_compare proc~sbase_change_base->proc~sbase_compare proc~sbase_initdof t_sBase%sBase_initDOF proc~sbase_change_base->proc~sbase_initdof proc~sgrid_compare t_sGrid%sGrid_compare proc~sbase_compare->proc~sgrid_compare compute_interpolant compute_interpolant proc~sbase_initdof->compute_interpolant

Called by

proc~~sbase_change_base~~CalledByGraph proc~sbase_change_base t_sBase%sBase_change_base proc~sbase_test sBase_test proc~sbase_test->proc~sbase_change_base proc~sbase_new sBase_new proc~sbase_test->proc~sbase_new proc~sbase_init t_sBase%sBase_init proc~sbase_init->proc~sbase_test proc~sbase_copy t_sBase%sBase_copy proc~sbase_copy->proc~sbase_init proc~sbase_new->proc~sbase_init proc~base_copy t_base%base_copy proc~base_copy->proc~sbase_copy proc~base_new Base_new proc~base_new->proc~sbase_new proc~readstatefilefromascii ReadStateFileFromASCII proc~readstatefilefromascii->proc~sbase_new proc~readstatefilefromascii->proc~base_new interface~readstate ReadState interface~readstate->proc~readstatefilefromascii proc~init_base Init_Base proc~init_base->proc~base_new proc~initmhd3d t_functional_mhd3d%InitMHD3D proc~initmhd3d->proc~base_new proc~transform_sfl_init t_transform_sfl%transform_SFL_init proc~transform_sfl_init->proc~base_new proc~init Init proc~init->proc~initmhd3d proc~init_gvec_to_jorek init_gvec_to_jorek proc~init_gvec_to_jorek->interface~readstate proc~init_gvec_to_jorek->proc~init_base proc~restartfromstate RestartFromState proc~restartfromstate->interface~readstate proc~rungvec rungvec proc~rungvec->proc~initmhd3d proc~transform_sfl_new transform_sfl_new proc~transform_sfl_new->proc~transform_sfl_init program~gvec_post GVEC_POST program~gvec_post->proc~initmhd3d proc~start_rungvec start_rungvec proc~start_rungvec->proc~rungvec program~gvec GVEC program~gvec->proc~rungvec

Source Code

SUBROUTINE sBase_change_base( sf,old_sBase,iterDim,old_data,sf_data)
! MODULES
IMPLICIT NONE
!-----------------------------------------------------------------------------------------------------------------------------------
! INPUT VARIABLES
  CLASS(t_sBase),  INTENT(IN   ) :: sf !! self
  CLASS(c_sBase),  INTENT(IN   ) :: old_sBase       !! base of old_data
  INTEGER         ,INTENT(IN   ) :: iterDim        !! iterate on first or second dimension or old_data/sf_data
  REAL(wp)        ,INTENT(IN   ) :: old_data(:,:)
!-----------------------------------------------------------------------------------------------------------------------------------
! OUTPUT VARIABLES
  REAL(wp)        ,INTENT(  OUT) :: sf_data(:,:)
!-----------------------------------------------------------------------------------------------------------------------------------
! LOCAL VARIABLES
  LOGICAL              :: sameBase
  INTEGER              :: iIP,iter,iterSize
  REAL(wp),ALLOCATABLE :: eval_old_sbase(:,:),gIP(:,:)
  INTEGER ,ALLOCATABLE :: Elem_old_sbase(:)
!===================================================================================================================================
  SELECT TYPE(old_sBase); CLASS IS(t_sBase)
  IF(.NOT.old_sBase%initialized) THEN
    CALL abort(__STAMP__, &
        "sBase_chamge_base: tried to change base with non-initialized sBase!")
  END IF
  IF((iterDim.LT.1).OR.(iterDim.GT.2))THEN
    CALL abort(__STAMP__, &
        "sBase_chamge_base: iterDim can only be 1 or 2!")
  END IF
  iterSize=SIZE(old_data,iterDim)
  IF(iterSize.NE.SIZE(sf_data,iterDim)) THEN
    CALL abort(__STAMP__, &
        "sBase_chamge_base: iteration dimenion of old_data and sf_data have to be the same!")
  END IF
  IF(SIZE(old_data,3-iterDim).NE.old_sBase%nbase) THEN
    CALL abort(__STAMP__, &
        "sBase_chamge_base: old_data size does not match old_sBase!")
  END IF
  IF(SIZE( sf_data,3-iterDim).NE.      sf%nbase) THEN
    CALL abort(__STAMP__, &
        "sBase_chamge_base: sf_data size does not match sf sBase!")
  END IF

  CALL sf%compare(old_sBase,is_same=sameBase)

  IF(sameBase)THEN
   !same base
   sf_data=old_data
  ELSE
    !actually change base
    ALLOCATE(Elem_old_sbase(1:sf%nBase),eval_old_sbase(0:old_sbase%deg,1:sf%nBase))
    ALLOCATE(gIP(1:sf%nBase,iterSize))
    DO iIP=1,sf%nBase
      CALL old_sbase%eval(sf%S_IP(iIP),0,Elem_old_sbase(iIP),eval_old_sbase(:,iIP))
    END DO
    SELECT CASE(iterDim)
    CASE(1)
      DO iIP=1,sf%nBase
        DO iter=1,iterSize
          gIP(iIP,iter)=old_sbase%evalDOF_base(Elem_old_sbase(iIP),eval_old_sbase(:,iIP),old_data(iter,:))
        END DO
      END DO
      DO iter=1,iterSize
        sf_data(iter,:)=sf%initDOF(gIP(:,iter))
      END DO
    CASE(2)
      DO iIP=1,sf%nBase
        DO iter=1,iterSize
          gIP(iIP,iter)=old_sbase%evalDOF_base(Elem_old_sbase(iIP),eval_old_sbase(:,iIP),old_data(:,iter))
        END DO
      END DO
      DO iter=1,iterSize
        sf_data(:,iter)=sf%initDOF(gIP(:,iter))
      END DO
    END SELECT !iterDim

    DEALLOCATE(Elem_old_sBase,eval_old_sbase,gIP)
  END IF !same base

  END SELECT !TYPE
END SUBROUTINE sBase_change_base