fBase_projectIPtoDOF Subroutine

private subroutine fBase_projectIPtoDOF(sf, add, factor, deriv, y_IP, DOFs)

project from interpolation points to all modes DOFs = addDOFs+ fac MATMUL(base_IP_DOF,y_IP)

Arguments

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

self
logical, intent(in) :: add

=F initialize DOFs , =T add to DOFs
real(kind=wp), intent(in) :: factor

scale result by factor, before adding to DOFs (should be =1.0_wp if not needed)
integer, intent(in) :: deriv

=0: base, =2: dthet , =3: dzeta
real(kind=wp), intent(in) :: y_IP(:)
real(kind=wp), intent(inout) :: DOFs(1:sf%modes)

array of all modes

Calls

proc~~fbase_projectiptodof~~CallsGraph proc~fbase_projectiptodof fBase_projectIPtoDOF dgemv dgemv proc~fbase_projectiptodof->dgemv

Source Code

SUBROUTINE fBase_projectIPtoDOF(sf,add,factor,deriv,y_IP,DOFs)
  ! MODULES
  IMPLICIT NONE
  ! INPUT VARIABLES -------------------------!
  CLASS(t_fBase), INTENT(IN   ) :: sf     !! self
  LOGICAL       , INTENT(IN   ) :: add    !! =F initialize DOFs , =T add to DOFs
  REAL(wp)      , INTENT(IN   ) :: factor !! scale result by factor, before adding to DOFs (should be =1.0_wp if not needed)
  INTEGER       , INTENT(IN   ) :: deriv  !! =0: base, =2: dthet , =3: dzeta
  REAL(wp)      , INTENT(IN   ) :: y_IP(:)
  ! OUTPUT VARIABLES -------------------------!
  REAL(wp)      , INTENT(INOUT) :: DOFs(1:sf%modes)  !! array of all modes
  ! LOCAL VARIABLES -------------------------!
  REAL(wp)                      :: radd
  ! CODE --------------------------------------------------------------------------------------------------------------------------!
  IF(SIZE(y_IP,1).NE.sf%mn_IP) CALL abort(__STAMP__, &
       'y_IP not correct when calling fBase_projectIPtoDOF' )
  radd=MERGE(1.0_wp,0.0_wp,add)
  SELECT CASE(deriv)
  CASE(0)
    __PAMATVEC_T(radd,DOFs,factor,sf%base_IP,y_IP)
  CASE(DERIV_THET)
    __PAMATVEC_T(radd,DOFs,factor,sf%base_dthet_IP,y_IP)
  CASE(DERIV_ZETA)
    __PAMATVEC_T(radd,DOFs,factor,sf%base_dzeta_IP,y_IP)
  CASE DEFAULT
    CALL abort(__STAMP__, &
         "fbase_projectIPtoDOF: derivative must be 0,DERIV_THET,DERIV_ZETA!")
  END SELECT
END SUBROUTINE fBase_projectIPtoDOF