intpol.f

Go to the documentation of this file.

!*******************************************************************************
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!*******************************************************************************
 
      MODULE intpol
 
      USE stel_kinds, only: rprec, dp
      USE integration_path
      USE coordinate_utilities
      USE profiler
      USE model
      USE signal
 
      IMPLICIT NONE
!*******************************************************************************
!  intpol module parameters
!*******************************************************************************
      REAL(rprec), PARAMETER :: intpol_polar_constant = 2.62e-13_dp
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) intpol base class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(signal_class) :: intpol_class
         TYPE (vertex), POINTER :: chord_path => null()
      CONTAINS
         PROCEDURE              ::                                             &
     &      get_modeled_signal_last => intpol_get_modeled_signal
         PROCEDURE              ::                                             &
     &      get_type=> intpol_get_type
         PROCEDURE              :: get_gp_i => intpol_get_gp_i
         PROCEDURE              :: get_gp_s => intpol_get_gp_s
         PROCEDURE              :: get_gp_x => intpol_get_gp_x
         final                  :: intpol_destruct
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(intpol_class) :: intpol_pol_class
         REAL (rprec) :: wavelength
         LOGICAL      :: in_degrees
      CONTAINS
         PROCEDURE    ::                                                       &
     &      get_modeled_signal_last => intpol_pol_get_modeled_signal
         PROCEDURE    :: get_gp_i => intpol_pol_get_gp_i
         PROCEDURE    :: get_gp_s => intpol_pol_get_gp_s
         PROCEDURE    :: get_gp_x => intpol_pol_get_gp_x
         final        :: intpol_pol_destruct
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE intpol_gp_context_i
         TYPE (model_class), POINTER :: model => null()
         INTEGER                     :: i
         INTEGER                     :: flags = model_state_all_off
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE intpol_gp_context_s
         TYPE (model_class), POINTER   :: model => null()
         class(signal_class), POINTER :: signal => null()
         INTEGER                       :: flags = model_state_all_off
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE intpol_gp_context_x
         TYPE (model_class), POINTER :: model => null()
         REAL (rprec), DIMENSION(3)  :: xcart
      END TYPE
 
!*******************************************************************************
!  INTERFACE BLOCKS
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE intpol_class
         MODULE PROCEDURE intpol_construct
      END INTERFACE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE intpol_pol_class
         MODULE PROCEDURE intpol_pol_construct
      END INTERFACE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
 
      PRIVATE :: int_function, pol_function, gp_function_i,                    &
     &           gp_function_x
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_construct(chord_paths)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(intpol_class), POINTER :: intpol_construct
      REAL (rprec), DIMENSION(:,:)  :: chord_paths
 
!  local variables
      INTEGER                       :: i
      REAL (rprec)                  :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(intpol_construct)
 
      DO i = 1, SIZE(chord_paths, 1)
         CALL path_append_vertex(intpol_construct%chord_path,                  &
     &                           chord_paths(i,:))
      END DO
 
      CALL profiler_set_stop_time('intpol_construct', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_pol_construct(wavelength, in_degrees, chord_paths)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(intpol_pol_class), POINTER :: intpol_pol_construct
      REAL (rprec), INTENT(in)          :: wavelength
      LOGICAL, INTENT(in)               :: in_degrees
      REAL (rprec), DIMENSION(:,:)      :: chord_paths
 
!  local variables
      INTEGER                           :: i
      REAL (rprec)                      :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(intpol_pol_construct)
 
      DO i = 1, SIZE(chord_paths, 1)
         CALL path_append_vertex(intpol_pol_construct%chord_path,              &
     &                           chord_paths(i,:))
      END DO
 
      intpol_pol_construct%wavelength = wavelength
      intpol_pol_construct%in_degrees = in_degrees
 
      CALL profiler_set_stop_time('intpol_pol_construct', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE intpol_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (intpol_class), INTENT(inout) :: this
 
!  Start of executable code
 
      IF (ASSOCIATED(this%chord_path)) THEN
         CALL path_destruct(this%chord_path)
         this%chord_path => null()
      END IF
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE intpol_pol_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (intpol_pol_class), INTENT(inout) :: this
 
!  Start of executable code
      this%wavelength = 0
      this%in_degrees = .false.
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_get_modeled_signal(this, a_model, sigma,                 &
     &                                   last_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: intpol_get_modeled_signal
      class(intpol_class), INTENT(inout)     :: this
      TYPE (model_class), POINTER             :: a_model
      REAL (rprec), DIMENSION(4), INTENT(out) :: sigma
      REAL (rprec), DIMENSION(4), INTENT(in)  :: last_value
 
!  local variables
      CHARACTER(len=1), ALLOCATABLE           :: context(:)
      INTEGER                                 :: context_length
      REAL (rprec)                            :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      sigma = 0.0
 
      IF (btest(a_model%state_flags, model_state_vmec_flag)   .or.             &
     &    btest(a_model%state_flags, model_state_siesta_flag) .or.             &
     &    btest(a_model%state_flags, model_state_ne_flag)     .or.             &
     &    btest(a_model%state_flags, model_state_shift_flag)  .or.             &
     &    btest(a_model%state_flags, model_state_signal_flag)) THEN
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
         context_length = SIZE(transfer(a_model, context))
         ALLOCATE(context(context_length))
         context = transfer(a_model, context)
 
         intpol_get_modeled_signal(1) =                                        &
     &      path_integrate(a_model%int_params, this%chord_path,                &
     &                     int_function, context)
 
         DEALLOCATE(context)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              intpol_get_modeled_signal(1))
      ELSE
         intpol_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('intpol_get_modeled_signal',                 &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_pol_get_modeled_signal(this, a_model, sigma,             &
     &                                       last_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: intpol_pol_get_modeled_signal
      CLASS (intpol_pol_class), INTENT(inout) :: this
      TYPE (model_class), POINTER             :: a_model
      REAL (rprec), DIMENSION(4), INTENT(out) :: sigma
      REAL (rprec), DIMENSION(4), INTENT(in)  :: last_value
 
!  local variables
      CHARACTER(len=1), ALLOCATABLE           :: context(:)
      INTEGER                                 :: context_length
      REAL (rprec)                            :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      sigma = 0.0
 
      IF (btest(a_model%state_flags, model_state_vmec_flag)   .or.             &
     &    btest(a_model%state_flags, model_state_siesta_flag) .or.             &
     &    btest(a_model%state_flags, model_state_ne_flag)     .or.             &
     &    btest(a_model%state_flags, model_state_shift_flag)  .or.             &
     &    btest(a_model%state_flags, model_state_signal_flag)) THEN
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
         context_length = SIZE(transfer(a_model, context))
         ALLOCATE(context(context_length))
         context = transfer(a_model, context)
 
         intpol_pol_get_modeled_signal(1) =                                    &
     &      intpol_polar_constant*(this%wavelength**2.0_dp) *                  &
     &      path_integrate(a_model%int_params, this%chord_path,                &
     &                     pol_function, context)
         IF (this%in_degrees) THEN
            intpol_pol_get_modeled_signal(1) =                                 &
     &                intpol_pol_get_modeled_signal(1)/degree
         END IF
 
         DEALLOCATE(context)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              intpol_pol_get_modeled_signal(1))
      ELSE
         intpol_pol_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('intpol_pol_get_modeled_signal',             &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_get_type(this)
      USE data_parameters
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=data_name_length) :: intpol_get_type
      CLASS (intpol_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      intpol_get_type = 'ipch'
 
      CALL profiler_set_stop_time('intpol_get_type', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_get_gp_i(this, a_model, i, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                     :: intpol_get_gp_i
      CLASS (intpol_class), INTENT(in) :: this
      TYPE (model_class), POINTER      :: a_model
      INTEGER, INTENT(in)              :: i
      INTEGER, INTENT(in)              :: flags
 
!  local variables
      CHARACTER(len=1), ALLOCATABLE    :: context(:)
      INTEGER                          :: context_length
      TYPE (intpol_gp_context_i)       :: gp_context
      REAL (rprec)                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  The relevant data for the guassian process context.
      gp_context%model => a_model
      gp_context%i = i
      gp_context%flags = flags
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
      context_length = SIZE(transfer(gp_context, context))
      ALLOCATE(context(context_length))
      context = transfer(gp_context, context)
 
      intpol_get_gp_i = path_integrate(a_model%int_params,                     &
     &                                 this%chord_path, gp_function_i,         &
     &                                 context)
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, intpol_get_gp_i)
 
      CALL profiler_set_stop_time('intpol_get_gp_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_get_gp_s(this, a_model, signal, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                     :: intpol_get_gp_s
      CLASS (intpol_class), INTENT(in) :: this
      TYPE (model_class), POINTER      :: a_model
      class(signal_class), POINTER    :: signal
      INTEGER, INTENT(in)              :: flags
 
!  local variables
      CHARACTER(len=1), ALLOCATABLE    :: context(:)
      INTEGER                          :: context_length
      TYPE (intpol_gp_context_s)       :: gp_context
      REAL (rprec)                     :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%model => a_model
      gp_context%signal => signal
      gp_context%flags = flags
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
      context_length = SIZE(transfer(gp_context, context))
      ALLOCATE(context(context_length))
      context = transfer(gp_context, context)
 
      intpol_get_gp_s = path_integrate(a_model%int_params,                     &
     &                                 this%chord_path, gp_function_s,         &
     &                                 context)
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, intpol_get_gp_s)
 
      CALL profiler_set_stop_time('intpol_get_gp_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_get_gp_x(this, a_model, x_cart, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: intpol_get_gp_x
      CLASS (intpol_class), INTENT(in)       :: this
      TYPE (model_class), POINTER            :: a_model
      REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
      INTEGER, INTENT(in)                    :: flags
 
!  local variables
      REAL (rprec)                           :: start_time
      CHARACTER(len=1), ALLOCATABLE          :: context(:)
      INTEGER                                :: context_length
      TYPE (intpol_gp_context_x)             :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%model => a_model
      gp_context%xcart = x_cart
 
!  Cast model into a data context. This is the equivalent to casting to a void
!  pointer in C.
      context_length = SIZE(transfer(gp_context, context))
      ALLOCATE(context(context_length))
      context = transfer(gp_context, context)
 
      intpol_get_gp_x = path_integrate(a_model%int_params,                     &
     &                                 this%chord_path, gp_function_x,
     &                                 context)
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, intpol_get_gp_x)
 
      CALL profiler_set_stop_time('intpol_get_gp_x', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_pol_get_gp_i(this, a_model, i, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                         :: intpol_pol_get_gp_i
      CLASS (intpol_pol_class), INTENT(in) :: this
      TYPE (model_class), POINTER          :: a_model
      INTEGER, INTENT(in)                  :: i
      INTEGER, INTENT(in)                  :: flags
 
!  local variables
      CHARACTER(len=1), ALLOCATABLE        :: context(:)
      INTEGER                              :: context_length
      TYPE (intpol_gp_context_i)           :: gp_context
      REAL (rprec)                         :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  The relevant data for the guassian process context.
      gp_context%model => a_model
      gp_context%i = i
      gp_context%flags = flags
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
      context_length = SIZE(transfer(gp_context, context))
      ALLOCATE(context(context_length))
      context = transfer(gp_context, context)
 
      intpol_pol_get_gp_i = intpol_polar_constant                              &
     &                    * (this%wavelength**2.0_dp)                          &
     &                    * path_integrate(a_model%int_params,                 &
     &                                     this%chord_path,                    &
     &                                     gp_pol_function_i,                  &
     &                                     context)
 
      DEALLOCATE(context)
 
      IF (this%in_degrees) THEN
         intpol_pol_get_gp_i = intpol_pol_get_gp_i/degree
      END IF
      CALL this%scale_and_offset(a_model, intpol_pol_get_gp_i)
 
      CALL profiler_set_stop_time('intpol_pol_get_gp_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_pol_get_gp_s(this, a_model, signal, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                         :: intpol_pol_get_gp_s
      CLASS (intpol_pol_class), INTENT(in) :: this
      TYPE (model_class), POINTER          :: a_model
      class(signal_class), POINTER        :: signal
      INTEGER, INTENT(in)                  :: flags
 
!  local variables
      CHARACTER(len=1), ALLOCATABLE        :: context(:)
      INTEGER                              :: context_length
      TYPE (intpol_gp_context_s)           :: gp_context
      REAL (rprec)                         :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  The relevant data for the guassian process context.
      gp_context%model => a_model
      gp_context%signal => signal
      gp_context%flags = flags
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
      context_length = SIZE(transfer(gp_context, context))
      ALLOCATE(context(context_length))
      context = transfer(gp_context, context)
 
      intpol_pol_get_gp_s = intpol_polar_constant                              &
     &                    * (this%wavelength**2.0_dp)                          &
     &                    * path_integrate(a_model%int_params,                 &
     &                                     this%chord_path,                    &
     &                                     gp_pol_function_s,                  &
     &                                     context)
 
      DEALLOCATE(context)
 
      IF (this%in_degrees) THEN
         intpol_pol_get_gp_s = intpol_pol_get_gp_s/degree
      END IF
      CALL this%scale_and_offset(a_model, intpol_pol_get_gp_s)
 
      CALL profiler_set_stop_time('intpol_pol_get_gp_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION intpol_pol_get_gp_x(this, a_model, x_cart, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: intpol_pol_get_gp_x
      CLASS (intpol_pol_class), INTENT(in)   :: this
      TYPE (model_class), POINTER            :: a_model
      REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
      INTEGER, INTENT(in)                    :: flags
 
!  local variables
      REAL (rprec)                           :: start_time
      CHARACTER(len=1), ALLOCATABLE          :: context(:)
      INTEGER                                :: context_length
      TYPE (intpol_gp_context_x)             :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%model => a_model
      gp_context%xcart = x_cart
 
!  Cast model into a data context. This is the equivalent to casting to a void
!  pointer in C.
      context_length = SIZE(transfer(gp_context, context))
      ALLOCATE(context(context_length))
      context = transfer(gp_context, context)
 
      intpol_pol_get_gp_x = intpol_polar_constant                              &
     &                    * (this%wavelength**2.0_dp)                          &
     &                    * path_integrate(a_model%int_params,                 &
     &                                     this%chord_path,                    &
     &                                     gp_pol_function_x,                  &
     &                                     context)
 
      DEALLOCATE(context)
 
      IF (this%in_degrees) THEN
         intpol_pol_get_gp_x = intpol_pol_get_gp_x/degree
      END IF
      CALL this%scale_and_offset(a_model, intpol_pol_get_gp_x)
 
      CALL profiler_set_stop_time('intpol_pol_get_gp_x', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  PRIVATE
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION int_function(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
      REAL (rprec)                           :: int_function
 
!  local variables
      TYPE (model_class)                     :: a_model
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      a_model = transfer(context, a_model)
      int_function = model_get_ne(a_model, xcart)*dx
 
      CALL profiler_set_stop_time('int_function', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION pol_function(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
      REAL (rprec)                           :: pol_function
 
!  local variables
      TYPE (model_class)                     :: a_model
      REAL (rprec), DIMENSION(3)             :: bcart
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      a_model = transfer(context, a_model)
 
      bcart = equilibrium_get_b_vec(a_model%equilibrium, xcart, .false.)
      pol_function =                                                           &
     &   model_get_ne(a_model, xcart)*dot_product(bcart, dxcart)
 
      CALL profiler_set_stop_time('pol_function', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_function_i(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_function_i
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
 
! local variables
      TYPE (intpol_gp_context_i)             :: gp_context
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context = transfer(context, gp_context)
      gp_function_i = model_get_gp_ne(gp_context%model, xcart,                 &
     &                                gp_context%i)*dx
 
      CALL profiler_set_stop_time('gp_function_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_pol_function_i(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_pol_function_i
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
 
! local variables
      TYPE (intpol_gp_context_i)             :: gp_context
      REAL (rprec), DIMENSION(3)             :: bcart
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context = transfer(context, gp_context)
      bcart = equilibrium_get_b_vec(gp_context%model%equilibrium, xcart,       &
     &                              .false.)
      gp_pol_function_i = model_get_gp_ne(gp_context%model, xcart,             &
     &                                    gp_context%i)                        *
     &                  * dot_product(bcart, dxcart)
 
      CALL profiler_set_stop_time('gp_pol_function_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_function_s(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_function_s
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
 
! local variables
      TYPE (intpol_gp_context_s)             :: gp_context
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context = transfer(context, gp_context)
      gp_function_s = gp_context%signal%get_gp(gp_context%model, xcart,        &
     &                                         gp_context%flags)*dx
 
      CALL profiler_set_stop_time('gp_function_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_pol_function_s(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_pol_function_s
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
 
! local variables
      TYPE (intpol_gp_context_s)             :: gp_context
      REAL (rprec), DIMENSION(3)             :: bcart
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context = transfer(context, gp_context)
      bcart = equilibrium_get_b_vec(gp_context%model%equilibrium, xcart,       &
     &                              .false.)
      gp_pol_function_s = gp_context%signal%get_gp(gp_context%model,           &
     &                                             xcart,                      &
     &                                             gp_context%flags)           &
     &                  * dot_product(bcart, dxcart)
 
      CALL profiler_set_stop_time('gp_pol_function_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_function_x(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_function_x
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
 
! local variables
      TYPE (intpol_gp_context_x)             :: gp_context
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  This is the second signal so put xcart in the second position.
      gp_context = transfer(context, gp_context)
      gp_function_x = model_get_gp_ne(gp_context%model,                        &
     &                                xcart, gp_context%xcart)*dx
 
      CALL profiler_set_stop_time('gp_function_x', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_pol_function_x(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_pol_function_x
      CHARACTER (len=1), INTENT(in)          :: context(:)
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
      REAL (rprec), DIMENSION(3), INTENT(in) :: dxcart
      REAL (rprec), INTENT(in)               :: length
      REAL (rprec), INTENT(in)               :: dx
 
! local variables
      TYPE (intpol_gp_context_x)             :: gp_context
      REAL (rprec), DIMENSION(3)             :: bcart
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  This is the second signal so put xcart in the second position.
      gp_context = transfer(context, gp_context)
      bcart = equilibrium_get_b_vec(gp_context%model%equilibrium, xcart,       &
     &                              .false.)
      gp_pol_function_x = model_get_gp_ne(gp_context%model,                    &
     &                                    xcart, gp_context%xcart)             &
     &                  * dot_product(bcart, dxcart)
 
      CALL profiler_set_stop_time('gp_pol_function_x', start_time)
 
      END FUNCTION
 
      END MODULE