thomson.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 thomson
 
      USE stel_kinds, only: rprec
      USE mpi_inc
      USE profiler
      USE model
      USE signal
 
      IMPLICIT NONE
 
!*******************************************************************************
!  thomson module parameters
!*******************************************************************************
      CHARACTER (len=*), PARAMETER ::                                          &
     &   thomson_p_error = 'Guassian processes are not supported ' //          &
     &                     'for thomson pressure measurements.'
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) thomson base class
!  2) thomson te class
!  3) thomson ne class
!  4) thomson p class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(signal_class) :: thomson_class
         REAL (rprec), DIMENSION(3) :: xcart
      CONTAINS
         PROCEDURE                  :: get_type => thomson_get_type
         final                      :: thomson_destruct
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS (thomson_class) :: thomson_te_class
      CONTAINS
         PROCEDURE ::                                                          &
     &      get_modeled_signal_last => thomson_te_get_modeled_signal
         PROCEDURE :: get_gp_i => thomson_te_get_gp_i
         PROCEDURE :: get_gp_x => thomson_te_get_gp_x
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS (thomson_class) :: thomson_ne_class
      CONTAINS
         PROCEDURE ::                                                          &
     &      get_modeled_signal_last => thomson_ne_get_modeled_signal
         PROCEDURE :: get_gp_i => thomson_ne_get_gp_i
         PROCEDURE :: get_gp_x => thomson_ne_get_gp_x
      END TYPE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS (thomson_class) :: thomson_p_class
      CONTAINS
         PROCEDURE ::                                                          &
     &      get_modeled_signal_last => thomson_p_get_modeled_signal
      END TYPE
 
!*******************************************************************************
!  INTERFACE BLOCKS
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE thomson_te_class
         MODULE PROCEDURE thomson_te_construct
      END INTERFACE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE thomson_ne_class
         MODULE PROCEDURE thomson_ne_construct
      END INTERFACE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE thomson_p_class
         MODULE PROCEDURE thomson_p_construct
      END INTERFACE
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_te_construct(xcart)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(thomson_te_class), POINTER      :: thomson_te_construct
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
 
!  local variables
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(thomson_te_construct)
      thomson_te_construct%xcart = xcart
 
      CALL profiler_set_stop_time('thomson_te_construct', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_ne_construct(xcart)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(thomson_ne_class), POINTER      :: thomson_ne_construct
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
 
!  local variables
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(thomson_ne_construct)
      thomson_ne_construct%xcart = xcart
 
      CALL profiler_set_stop_time('thomson_ne_construct', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_p_construct(xcart)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(thomson_p_class), POINTER       :: thomson_p_construct
      REAL (rprec), DIMENSION(3), INTENT(in) :: xcart
 
!  local variables
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(thomson_p_construct)
      thomson_p_construct%xcart = xcart
 
      CALL profiler_set_stop_time('thomson_p_construct', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE thomson_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (thomson_class), INTENT(inout) :: this
 
!  Start of executable code
      this%xcart = 0.0
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_te_get_modeled_signal(this, a_model, sigma,             &
     &                                       last_value)
      USE model
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: thomson_te_get_modeled_signal
      class(thomson_te_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
      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_te_flag)     .or.             &
     &    btest(a_model%state_flags, model_state_shift_flag)  .or.             &
     &    btest(a_model%state_flags, model_state_signal_flag)) THEN
         thomson_te_get_modeled_signal(1) = model_get_te(a_model,              &
     &                                                   this%xcart)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              thomson_te_get_modeled_signal(1))
      ELSE
         thomson_te_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('thomson_te_get_modeled_signal',             &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_ne_get_modeled_signal(this, a_model, sigma,             &
     &                                       last_value)
      USE model
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: thomson_ne_get_modeled_signal
      CLASS (thomson_ne_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
      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
         thomson_ne_get_modeled_signal(1) = model_get_ne(a_model,              &
     &                                                   this%xcart)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              thomson_ne_get_modeled_signal(1))
      ELSE
         thomson_ne_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('thomson_ne_get_modeled_signal',             &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_p_get_modeled_signal(this, a_model, sigma,              &
     &                                      last_value)
      USE model
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: thomson_p_get_modeled_signal
      CLASS (thomson_p_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
      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_signal_flag)) THEN
         thomson_p_get_modeled_signal(1) =                                     &
     &      equilibrium_get_p(a_model%equilibrium, this%xcart)
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              thomson_p_get_modeled_signal(1))
      ELSE
         thomson_p_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('thomson_p_get_modeled_signal',              &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_get_type(this)
      USE data_parameters
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=data_name_length)  :: thomson_get_type
      CLASS (thomson_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                      :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      thomson_get_type = 'thscte'
 
      CALL profiler_set_stop_time('thomson_get_type', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_get_gp_s(this, a_model, signal, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                      :: thomson_get_gp_s
      CLASS (thomson_class), INTENT(in) :: this
      TYPE (model_class), POINTER       :: a_model
      class(signal_class), INTENT(in)  :: signal
      INTEGER, INTENT(in)               :: flags
 
!  local variables
      REAL (rprec)                      :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      thomson_get_gp_s = signal%get_gp(a_model, this%xcart, flags)
      CALL this%scale_and_offset(a_model, thomson_get_gp_s)
 
      CALL profiler_set_stop_time('thomson_get_gp_s', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_te_get_gp_i(this, a_model, i, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                         :: thomson_te_get_gp_i
      CLASS (thomson_te_class), INTENT(in) :: this
      TYPE (model_class), POINTER          :: a_model
      INTEGER, INTENT(in)                  :: i
      INTEGER, INTENT(in)                  :: flags
 
!  local variables
      REAL (rprec)                         :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      thomson_te_get_gp_i = model_get_gp_te(a_model, this%xcart, i)
 
      CALL this%scale_and_offset(a_model, thomson_te_get_gp_i)
 
      CALL profiler_set_stop_time('thomson_te_get_gp_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_te_get_gp_x(this, a_model, x_cart, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: thomson_te_get_gp_x
      CLASS (thomson_te_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
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      thomson_te_get_gp_x = model_get_gp_te(a_model, this%xcart, x_cart)
      CALL this%scale_and_offset(a_model, thomson_te_get_gp_x)
 
      CALL profiler_set_stop_time('thomson_te_get_gp_x', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_ne_get_gp_i(this, a_model, i, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                         :: thomson_ne_get_gp_i
      CLASS (thomson_ne_class), INTENT(in) :: this
      TYPE (model_class), POINTER          :: a_model
      INTEGER, INTENT(in)                  :: i
      INTEGER, INTENT(in)                  :: flags
 
!  local variables
      REAL (rprec)                         :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      thomson_ne_get_gp_i = model_get_gp_ne(a_model, this%xcart, i)
      CALL this%scale_and_offset(a_model, thomson_ne_get_gp_i)
 
      CALL profiler_set_stop_time('thomson_ne_get_gp_i', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION thomson_ne_get_gp_x(this, a_model, x_cart, flags)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                           :: thomson_ne_get_gp_x
      CLASS (thomson_ne_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
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      thomson_ne_get_gp_x = model_get_gp_ne(a_model, this%xcart, x_cart)
      CALL this%scale_and_offset(a_model, thomson_ne_get_gp_x)
 
      CALL profiler_set_stop_time('thomson_ne_get_gp_x', start_time)
 
      END FUNCTION
 
      END MODULE