fBase_change_base Subroutine

private subroutine fBase_change_base(sf, old_fBase, iterDim, old_data, sf_data)

change data from oldBase to self. Forier modes are directly copied so, if new mode space is smaller, its like a Fourier cut-off. if new modes do not match old ones, they are set to zero. Note that a change of nfp is not possible· as well as a change from sine to cosine

Type Bound

t_fBase

Arguments

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

self
class(t_fBase), intent(in) :: old_fBase

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~~fbase_change_base~~CallsGraph proc~fbase_change_base t_fBase%fBase_change_base proc~fbase_compare t_fBase%fBase_compare proc~fbase_change_base->proc~fbase_compare

Called by

proc~~fbase_change_base~~CalledByGraph proc~fbase_change_base t_fBase%fBase_change_base proc~base_change_base t_base%base_change_base proc~base_change_base->proc~fbase_change_base proc~bff_convert_to_modes t_boundaryFromFile%bff_convert_to_modes proc~bff_convert_to_modes->proc~fbase_change_base proc~fbase_test fBase_test proc~fbase_test->proc~fbase_change_base proc~get_boozer_sinterp t_sfl_boozer%Get_Boozer_sinterp proc~get_boozer_sinterp->proc~fbase_change_base proc~buildtransform_sfl t_transform_sfl%BuildTransform_SFL proc~buildtransform_sfl->proc~get_boozer_sinterp proc~fbase_init t_fBase%fBase_init proc~fbase_init->proc~fbase_test proc~get_boozer get_boozer proc~get_boozer->proc~get_boozer_sinterp proc~initmhd3d t_functional_mhd3d%InitMHD3D proc~initmhd3d->proc~bff_convert_to_modes proc~restartfromstate RestartFromState proc~restartfromstate->proc~base_change_base 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~rungvec rungvec proc~rungvec->proc~initmhd3d program~gvec_post GVEC_POST program~gvec_post->proc~initmhd3d interface~t_fbase t_fBase interface~t_fbase->proc~fbase_new proc~start_rungvec start_rungvec proc~start_rungvec->proc~rungvec program~gvec GVEC program~gvec->proc~rungvec

Source Code

SUBROUTINE fBase_change_base( sf,old_fBase,iterDim,old_data,sf_data)
  ! MODULES
  IMPLICIT NONE
  ! INPUT VARIABLES -------------------------!
  CLASS(t_fBase),  INTENT(IN   ) :: sf !! self
  CLASS(t_fBase),  INTENT(IN   ) :: old_fBase       !! 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             :: cond(5)
  INTEGER             :: iMode
  INTEGER,ALLOCATABLE :: modeMapSin(:,:),modeMapCos(:,:)
  ! CODE --------------------------------------------------------------------------------------------------------------------------!
  IF(.NOT.old_fBase%initialized) THEN
    CALL abort(__STAMP__, &
        "fBase_change_base: tried to change base with non-initialized fBase!")
  END IF
  IF((iterDim.LT.1).OR.(iterDim.GT.2))THEN
    CALL abort(__STAMP__, &
        "fBase_change_base: iterDim can only be 1 or 2!")
  END IF
  IF(SIZE(old_data,iterDim).NE.SIZE(sf_data,iterDim)) THEN
    CALL abort(__STAMP__, &
        "fBase_change_base: iteration dimenion of old_data and sf_data have to be the same!")
  END IF
  IF(SIZE(old_data,3-iterDim).NE.old_fBase%modes) THEN
    CALL abort(__STAMP__, &
        "fBase_change_base: old_data size does not match old_fBase!")
  END IF
  IF(SIZE( sf_data,3-iterDim).NE.      sf%modes) THEN
    CALL abort(__STAMP__, &
        "fBase_change_base: sf_data size does not match sf fBase!")
  END IF

  CALL sf%compare(old_fBase,cond_out=cond(1:5))

  IF(ALL(cond))THEN
   !same base
   sf_data=old_data
  ELSE
    !actually change base
    IF(.NOT.cond(2)) THEN !nfp
      CALL abort(__STAMP__, &
          "fBase_change_base: different nfp found, cannot change base!")
    END IF
    IF(.NOT.cond(4)) THEN !sin_cos /= sin_cos_old
      ! sin <-> cos : not ok
      ! cos <-> sin : not ok
      ! sin <-> sin_cos : ok
      ! cos <-> sin_cos : ok
      IF(.NOT.(ANY((/sf%sin_cos,old_fBase%sin_cos/).EQ._SINCOS_)))THEN
      CALL abort(__STAMP__, &
          "fBase_change_base: cannot change base between sine and cosine!")
      END IF
    END IF
    ASSOCIATE(mn_max    => old_fBase%mn_max   ,&
              nfp       => old_fBase%nfp      ,&
              Xmn       => old_fBase%Xmn      ,&
              sin_range => old_fBase%sin_range,&
              cos_range => old_fBase%cos_range )
    ALLOCATE(modeMapSin( 0:mn_max(1),-mn_max(2):mn_max(2)))
    ALLOCATE(modeMapCos( 0:mn_max(1),-mn_max(2):mn_max(2)))
    modeMapSin=-1
    DO iMode=sin_range(1)+1,sin_range(2)
      modeMapSin(Xmn(1,iMode),Xmn(2,iMode)/nfp)=iMode
    END DO
    modeMapCos=-1
    DO iMode=cos_range(1)+1,cos_range(2)
      modeMapCos(Xmn(1,iMode),Xmn(2,iMode)/nfp)=iMode
    END DO
    END ASSOCIATE !old_fBase%...

    sf_data=0.0_wp
    IF((old_fBase%sin_range(2)-old_fBase%sin_range(1)).GT.0)THEN ! =_SIN_ / _SIN_COS_
      DO iMode=sf%sin_range(1)+1,sf%sin_range(2)
        IF(    sf%Xmn(1,iMode) .GT.old_fBase%mn_max(1))CYCLE ! remains zero
        IF(ABS(sf%Xmn(2,iMode)/sf%nfp).GT.old_fBase%mn_max(2))CYCLE ! remains zero
        SELECT CASE(iterDim)
        CASE(1)
          sf_data(:,iMode)=old_data(:,modeMapSin(sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp))
        CASE(2)
          sf_data(iMode,:)=old_data(modeMapSin(sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp),:)
        END SELECT
      END DO
    END IF !old_fBase  no sine
    IF((old_fBase%cos_range(2)-old_fBase%cos_range(1)).GT.0)THEN ! =_COS_ / _SIN_COS_
      DO iMode=sf%cos_range(1)+1,sf%cos_range(2)
        IF(    sf%Xmn(1,iMode) .GT.old_fBase%mn_max(1))CYCLE !  m  > m_max_old, remains zero
        IF(ABS(sf%Xmn(2,iMode)/sf%nfp).GT.old_fBase%mn_max(2))CYCLE ! |n| > n_max_old, remains zero
        SELECT CASE(iterDim)
        CASE(1)
          sf_data(:,iMode)=old_data(:,modeMapCos(sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp))
        CASE(2)
          sf_data(iMode,:)=old_data(modeMapCos(sf%Xmn(1,iMode),sf%Xmn(2,iMode)/sf%nfp),:)
        END SELECT
      END DO
    END IF !old_fBase  no sine

    DEALLOCATE(modeMapSin)
    DEALLOCATE(modeMapCos)
  END IF !same base
END SUBROUTINE fBase_change_base