sxrem.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 sxrem
 
      USE stel_kinds, only: rprec
      USE integration_path
      USE model
      USE signal
 
      IMPLICIT NONE
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) sxrem base class
!  2) sxrem emiss class
!  3) sxrem ti class
!  2) sxrem context
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(signal_class) :: sxrem_class
         TYPE (vertex), POINTER :: chord_path => null()
         INTEGER                :: profile_number
      CONTAINS
         final                  :: sxrem_destruct
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(sxrem_class) :: sxrem_emiss_class
         REAL (rprec) :: geo
      CONTAINS
         PROCEDURE    ::                                                       &
     &      get_modeled_signal_last => sxrem_emiss_get_modeled_signal
         PROCEDURE    :: get_type => sxrem_emiss_get_type
         PROCEDURE    :: get_gp_i => sxrem_emiss_get_gp_i
         PROCEDURE    :: get_gp_s => sxrem_emiss_get_gp_s
         PROCEDURE    :: get_gp_x => sxrem_emiss_get_gp_x
         final        :: sxrem_emiss_destruct
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(sxrem_class) :: sxrem_ti_class
      CONTAINS
         PROCEDURE ::                                                          &
     &      get_modeled_signal_last => sxrem_ti_get_modeled_signal
         PROCEDURE :: get_type => sxrem_ti_get_type
         PROCEDURE :: get_gp_i => sxrem_ti_get_gp_i
         PROCEDURE :: get_gp_s => sxrem_ti_get_gp_s
         PROCEDURE :: get_gp_x => sxrem_ti_get_gp_x
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE sxrem_context
         INTEGER                     :: profile_number
         TYPE (model_class), POINTER :: model => null()
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE sxrem_gp_context_i
         INTEGER                     :: profile_number
         TYPE (model_class), POINTER :: model => null()
         INTEGER                     :: i
         INTEGER                     :: flags = model_state_all_off
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE sxrem_gp_context_s
         INTEGER                       :: profile_number
         TYPE (model_class), POINTER   :: model => null()
         class(signal_class), POINTER :: signal => null()
         INTEGER                       :: flags
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE sxrem_gp_context_x
         INTEGER                     :: profile_number
         TYPE (model_class), POINTER :: model => null()
         REAL (rprec), DIMENSION(3)  :: xcart
         INTEGER                     :: flags
      END TYPE
 
!*******************************************************************************
!  INTERFACE BLOCKS
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE sxrem_emiss_class
         MODULE PROCEDURE sxrem_emiss_construct
      END INTERFACE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE sxrem_ti_class
         MODULE PROCEDURE sxrem_ti_construct
      END INTERFACE
 
      PRIVATE :: sxr_function, ti_function
      PRIVATE :: gp_emiss_function_i, gp_ti_function_i
      PRIVATE :: gp_emiss_function_s, gp_ti_function_s
      PRIVATE :: gp_emiss_function_x, gp_ti_function_x
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_emiss_construct(start_path, end_path, geo,                &
     &                               profile_number)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(sxrem_emiss_class), POINTER     :: sxrem_emiss_construct
      REAL (rprec), DIMENSION(3), INTENT(in) :: start_path
      REAL (rprec), DIMENSION(3), INTENT(in) :: end_path
      REAL (rprec), INTENT(in)               :: geo
      INTEGER, INTENT(in)                    :: profile_number
 
!  local variables
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(sxrem_emiss_construct)
 
      CALL path_append_vertex(sxrem_emiss_construct%chord_path,                &
     &                        start_path)
      CALL path_append_vertex(sxrem_emiss_construct%chord_path,                &
     &                        end_path)
 
      sxrem_emiss_construct%geo = geo
      sxrem_emiss_construct%profile_number = profile_number
 
      CALL profiler_set_stop_time('sxrem_emiss_construct', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ti_construct(start_path, end_path, profile_number)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(sxrem_ti_class), POINTER         :: sxrem_ti_construct
      REAL (rprec), DIMENSION(3), INTENT(in) :: start_path
      REAL (rprec), DIMENSION(3), INTENT(in) :: end_path
      INTEGER, INTENT(in)                    :: profile_number
 
!  local variables
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(sxrem_ti_construct)
 
      CALL path_append_vertex(sxrem_ti_construct%chord_path,                   &
     &                        start_path)
      CALL path_append_vertex(sxrem_ti_construct%chord_path, end_path)
 
      sxrem_ti_construct%profile_number = profile_number
 
      CALL profiler_set_stop_time('sxrem_ti_construct', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE sxrem_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (sxrem_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
 
      this%profile_number = 0
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE sxrem_emiss_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (sxrem_emiss_class), INTENT(inout) :: this
 
!  Start of executable code
      this%geo = 0.0
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_emiss_get_modeled_signal(this, a_model, sigma,            &
     &                                        last_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: sxrem_emiss_get_modeled_signal
      CLASS (sxrem_emiss_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
      TYPE (sxrem_context)                     :: sxr_context
      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_shift_flag)    .or.           &
     &    btest(a_model%state_flags, model_state_sxrem_flag +                  &
     &                               (this%profile_number - 1)) .or.           &
     &    btest(a_model%state_flags, model_state_signal_flag)) THEN
 
!  The relevant data for the soft x-ray context.
         sxr_context%profile_number = this%profile_number
         sxr_context%model => a_model
 
!  Cast data to a context. This is the equivalent to casting to a void pointer
!  in C.
         context_length = SIZE(transfer(sxr_context, context))
         ALLOCATE(context(context_length))
         context = transfer(sxr_context, context)
 
         sxrem_emiss_get_modeled_signal(1) =                                   &
     &      path_integrate(a_model%int_params, this%chord_path,                &
     &                     sxr_function, context)*this%geo
 
         DEALLOCATE(context)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              sxrem_emiss_get_modeled_signal(1))
      ELSE
         sxrem_emiss_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('sxrem_emiss_get_modeled_signal',            &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ti_get_modeled_signal(this, a_model, sigma,               &
     &                                     last_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: sxrem_ti_get_modeled_signal
      CLASS (sxrem_ti_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
      TYPE (sxrem_context)                    :: sxr_context
      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_shift_flag)    .or.           &
     &    btest(a_model%state_flags, model_state_ti_flag)       .or.           &
     &    btest(a_model%state_flags, model_state_sxrem_flag +                  &
     &                               (this%profile_number - 1)) .or.           &
     &    btest(a_model%state_flags, model_state_signal_flag)) THEN
 
!  The relevant data for the soft x-ray context.
         sxr_context%profile_number = this%profile_number
         sxr_context%model => a_model
 
!  Cast model into a data to a context. This is the equivalent to casting to a
!  void pointer in C.
         context_length = SIZE(transfer(sxr_context, context))
         ALLOCATE(context(context_length))
         context = transfer(sxr_context, context)
 
         sxrem_ti_get_modeled_signal(1) =                                      &
     &      path_integrate(a_model%int_params, this%chord_path,                &
     &                     ti_function, context)
 
         DEALLOCATE(context)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              sxrem_ti_get_modeled_signal(1))
      ELSE
         sxrem_ti_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('sxrem_ti_get_modeled_signal',               &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_emiss_get_type(this)
      USE data_parameters
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=data_name_length) :: sxrem_emiss_get_type
      CLASS (sxrem_emiss_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      WRITE (sxrem_emiss_get_type, 1000) this%profile_number
 
      CALL profiler_set_stop_time('sxrem_emiss_get_type', start_time)
 
1000  FORMAT('sxrch(',i2,')')
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ti_get_type(this)
      USE data_parameters
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=data_name_length)   :: sxrem_ti_get_type
      CLASS (sxrem_ti_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                       :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      WRITE (sxrem_ti_get_type, 1000) this%profile_number
 
      CALL profiler_set_stop_time('sxrem_ti_get_type', start_time)
 
1000  FORMAT('sxrch_ti(',i2,')')
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_emiss_get_gp_i(this, a_model, i, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                          :: sxrem_emiss_get_gp_i
      CLASS (sxrem_emiss_class), INTENT(in) :: this
      TYPE (model_class), POINTER           :: a_model
      INTEGER, INTENT(in)                   :: i
      INTEGER, INTENT(in)                   :: flags
 
!  local variables
      REAL (rprec)                          :: start_time
      CHARACTER(len=1), ALLOCATABLE         :: context(:)
      INTEGER                               :: context_length
      TYPE (sxrem_gp_context_i)             :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%profile_number = this%profile_number
      gp_context%model => a_model
      gp_context%i = i
      gp_context%flags = flags
 
!  Cast 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)
 
      sxrem_emiss_get_gp_i = path_integrate(a_model%int_params,                &
     &                                      this%chord_path,                   &
     &                                      gp_emiss_function_i,               &
     &                                      context)*this%geo
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, sxrem_emiss_get_gp_i)
 
      CALL profiler_set_stop_time('sxrem_emiss_get_gp_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ti_get_gp_i(this, a_model, i, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                       :: sxrem_ti_get_gp_i
      CLASS (sxrem_ti_class), INTENT(in) :: this
      TYPE (model_class), POINTER        :: a_model
      INTEGER, INTENT(in)                :: i
      INTEGER, INTENT(in)                :: flags
 
!  local variables
      REAL (rprec)                       :: start_time
      CHARACTER(len=1), ALLOCATABLE      :: context(:)
      INTEGER                            :: context_length
      TYPE (sxrem_gp_context_i)          :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%profile_number = this%profile_number
      gp_context%model => a_model
      gp_context%i = i
      gp_context%flags = flags
 
!  Cast 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)
 
      sxrem_ti_get_gp_i = path_integrate(a_model%int_params,                   &
     &                                   this%chord_path,                      &
     &                                   gp_ti_function_i, context)
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, sxrem_ti_get_gp_i)
 
      CALL profiler_set_stop_time('sxrem_ti_get_gp_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_emiss_get_gp_s(this, a_model, signal, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                          :: sxrem_emiss_get_gp_s
      CLASS (sxrem_emiss_class), INTENT(in) :: this
      TYPE (model_class), POINTER           :: a_model
      class(signal_class), POINTER         :: signal
      INTEGER, INTENT(in)                   :: flags
 
!  local variables
      REAL (rprec)                          :: start_time
      CHARACTER(len=1), ALLOCATABLE         :: context(:)
      INTEGER                               :: context_length
      TYPE (sxrem_gp_context_s)             :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%profile_number = this%profile_number
      gp_context%model => a_model
      gp_context%signal => signal
      gp_context%flags = flags
 
!  Cast 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)
 
      sxrem_emiss_get_gp_s = path_integrate(a_model%int_params,                &
     &                                      this%chord_path,                   &
     &                                      gp_emiss_function_s,               &
     &                                      context)*this%geo
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, sxrem_emiss_get_gp_s)
 
      CALL profiler_set_stop_time('sxrem_emiss_get_gp_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ti_get_gp_s(this, a_model, signal, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                       :: sxrem_ti_get_gp_s
      CLASS (sxrem_ti_class), INTENT(in) :: this
      TYPE (model_class), POINTER        :: a_model
      class(signal_class), POINTER      :: signal
      INTEGER, INTENT(in)                :: flags
 
!  local variables
      REAL (rprec)                       :: start_time
      CHARACTER(len=1), ALLOCATABLE      :: context(:)
      INTEGER                            :: context_length
      TYPE (sxrem_gp_context_s)          :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%profile_number = this%profile_number
      gp_context%model => a_model
      gp_context%signal => signal
      gp_context%flags = flags
 
!  Cast 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)
 
      sxrem_ti_get_gp_s = path_integrate(a_model%int_params,                   &
     &                                   this%chord_path,                      &
     &                                   gp_ti_function_s, context)
 
      DEALLOCATE(context)
 
      CALL this%scale_and_offset(a_model, sxrem_ti_get_gp_s)
 
      CALL profiler_set_stop_time('sxrem_ti_get_gp_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_emiss_get_gp_x(this, a_model, x_cart, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: sxrem_emiss_get_gp_x
      CLASS (sxrem_emiss_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 (sxrem_gp_context_x)              :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%profile_number = this%profile_number
      gp_context%model => a_model
      gp_context%xcart = x_cart
 
!  Cast 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)
 
      sxrem_emiss_get_gp_x = path_integrate(a_model%int_params,                &
     &                                      this%chord_path,                   &
     &                                      gp_emiss_function_x,               &
     &                                      context)*this%geo
 
      CALL this%scale_and_offset(a_model, sxrem_emiss_get_gp_x)
 
      CALL profiler_set_stop_time('sxrem_emiss_get_gp_x', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ti_get_gp_x(this, a_model, x_cart, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: sxrem_ti_get_gp_x
      CLASS (sxrem_ti_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 (sxrem_gp_context_x)              :: gp_context
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      gp_context%profile_number = this%profile_number
      gp_context%model => a_model
      gp_context%xcart = x_cart
      gp_context%flags = flags
 
!  Cast 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)
 
      sxrem_ti_get_gp_x = path_integrate(a_model%int_params,                   &
     &                                   this%chord_path,                      &
     &                                   gp_ti_function_x, context)
 
      CALL this%scale_and_offset(a_model, sxrem_ti_get_gp_x)
 
      CALL profiler_set_stop_time('sxrem_ti_get_gp_x', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  PRIVATE
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxr_function(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: sxr_function
      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 (sxrem_context)                   :: sxr_context
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      sxr_context = transfer(context, sxr_context)
      sxr_function = model_get_sxrem(sxr_context%model, xcart,                 &
     &                               sxr_context%profile_number)*dx
 
      CALL profiler_set_stop_time('sxr_function', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION ti_function(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: ti_function
      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 (sxrem_context)                   :: sxr_context
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      sxr_context = transfer(context, sxr_context)
      ti_function = model_get_sxrem(sxr_context%model, xcart,                  &
     &                              sxr_context%profile_number)                &
     &            * model_get_ti(sxr_context%model, xcart)*dx
 
      CALL profiler_set_stop_time('ti_function', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_emiss_function_i(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_emiss_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 (sxrem_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_emiss_function_i =                                                    &
     &   model_get_gp_sxrem(gp_context%model, xcart, gp_context%i,                   &
     &                      gp_context%profile_number)*dx
 
      CALL profiler_set_stop_time('gp_emiss_function_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_ti_function_i(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_ti_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 (sxrem_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)
      IF (btest(gp_context%flags, model_state_sxrem_flag +                     &
     &                            (gp_context%profile_number - 1))) THEN
         gp_ti_function_i =                                                    &
     &      model_get_gp_sxrem(gp_context%model, xcart, gp_context%i,          &
     &                         gp_context%profile_number) *                    &
     &      model_get_ti(gp_context%model, xcart)
      ELSE IF (btest(gp_context%flags, model_state_ti_flag)) THEN
         gp_ti_function_i = model_get_gp_ti(gp_context%model, xcart,           &
     &                                      gp_context%i)                      &
     &                    * model_get_sxrem(gp_context%model, xcart,           &
     &                                      gp_context%profile_number)
      ELSE
         gp_ti_function_i = 0.0
      END IF
 
      gp_ti_function_i = gp_ti_function_i*dx
 
      CALL profiler_set_stop_time('gp_ti_function_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_emiss_function_s(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_emiss_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 (sxrem_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_emiss_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_ti_function_s(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_ti_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 (sxrem_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)
 
      IF (btest(gp_context%flags, model_state_sxrem_flag +                     &
     &                            (gp_context%profile_number - 1))) THEN
         gp_ti_function_s = gp_context%signal%get_gp(gp_context%model,         &
     &                                               xcart,                    &
     &                                               gp_context%flags)         &
     &                    * model_get_ti(gp_context%model, xcart)
      ELSE IF (btest(gp_context%flags, model_state_ti_flag)) THEN
         gp_ti_function_s = gp_context%signal%get_gp(gp_context%model,         &
     &                                               xcart,                    &
     &                                               gp_context%flags)         &
     &                    * model_get_sxrem(gp_context%model, xcart,           &
     &                                      gp_context%profile_number)
      ELSE
         gp_ti_function_s = 0.0
      END IF
 
      gp_ti_function_s = gp_ti_function_s*dx
 
      CALL profiler_set_stop_time('gp_function_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_emiss_function_x(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_emiss_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 (sxrem_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_emiss_function_x =                                                    &
     &   model_get_gp_sxrem(gp_context%model, xcart, gp_context%xcart,         &
     &                      gp_context%profile_number)*dx
 
      CALL profiler_set_stop_time('gp_emiss_function_x', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION gp_ti_function_x(context, xcart, dxcart, length, dx)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: gp_ti_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 (sxrem_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)
      IF (btest(gp_context%flags, model_state_sxrem_flag +                     &
     &                            (gp_context%profile_number - 1))) THEN
         gp_ti_function_x =                                                    &
     &      model_get_gp_sxrem(gp_context%model, xcart,                        &
     &                         gp_context%xcart,                               &
     &                         gp_context%profile_number) *                    &
     &      model_get_ti(gp_context%model, xcart)
      ELSE IF (btest(gp_context%flags, model_state_ti_flag)) THEN
         gp_ti_function_x = model_get_gp_ti(gp_context%model, xcart,           &
     &                                      gp_context%xcart)                  &
     &                    * model_get_sxrem(gp_context%model, xcart,          &
     &                                      gp_context%profile_number)
      ELSE
         gp_ti_function_x = 0.0
      END IF
 
      gp_ti_function_x = gp_ti_function_x*dx
 
      CALL profiler_set_stop_time('gp_ti_function_x', start_time)
 
      END FUNCTION
 
      END MODULE