sxrem_ratio.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_ratio
 
      USE stel_kinds, only: rprec, dp
      USE model
      USE signal
 
      IMPLICIT NONE
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) sxrem_ratio base class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(signal_class) :: sxrem_ratio_class
         REAL (rprec), DIMENSION(3) :: x_cart
         INTEGER, DIMENSION(2)      :: indices
      CONTAINS
         PROCEDURE                  ::                                         &
     &      get_modeled_signal_last => sxrem_ratio_get_modeled_signal
         PROCEDURE                  ::                                         &
     &      get_observed_signal => sxrem_ratio_get_observed_signal
         PROCEDURE                  :: get_type => sxrem_ratio_get_type
         PROCEDURE                  ::                                         &
     &      write_auxiliary => sxrem_ratio_write_auxiliary
         final                      :: sxrem_ratio_destruct
      END TYPE sxrem_ratio_class
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      INTERFACE sxrem_ratio_class
         MODULE PROCEDURE sxrem_ratio_construct
      END INTERFACE
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ratio_construct(x_cart, indices)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(sxrem_ratio_class), POINTER     :: sxrem_ratio_construct
      REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
      INTEGER, DIMENSION(2), INTENT(in)      :: indices
 
!  local variables
      REAL (rprec)                           :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      ALLOCATE(sxrem_ratio_construct)
 
      sxrem_ratio_construct%x_cart = x_cart
      sxrem_ratio_construct%indices = indices
 
      CALL profiler_set_stop_time('sxrem_ratio_construct', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE sxrem_ratio_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (sxrem_ratio_class), INTENT(inout) :: this
 
!  Start of executable code
      this%x_cart = 0.0
      this%indices = 0
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTERS SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ratio_get_modeled_signal(this, a_model, sigma,            &
     &                                        last_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: sxrem_ratio_get_modeled_signal
      class(sxrem_ratio_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)                             :: emissivity
      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%indices(1) - 1))   .or.             &
     &    btest(a_model%state_flags, model_state_sxrem_flag +                  &
     &                               (this%indices(2) - 1))   .or.             &
     &    btest(a_model%state_flags, model_state_signal_flag)) THEN
 
         emissivity = model_get_sxrem_cart(a_model, this%x_cart,               &
     &                                     this%indices(2))
 
         IF (emissivity .eq. 0.0) THEN
            sxrem_ratio_get_modeled_signal(1) = 1.0
         ELSE
            sxrem_ratio_get_modeled_signal(1) =                                &
     &         model_get_sxrem_cart(a_model, this%x_cart,                      &
     &                              this%indices(1))/emissivity
         END IF
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              sxrem_ratio_get_modeled_signal(1))
      ELSE
         sxrem_ratio_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('sxrem_ratio_get_modeled_signal',            &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ratio_get_observed_signal(this, a_model)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec) :: sxrem_ratio_get_observed_signal
      class(sxrem_ratio_class), INTENT(in) :: this
      TYPE (model_class), INTENT(in)        :: a_model
 
!  local variables
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      sxrem_ratio_get_observed_signal =                                        &
     &   model_get_sxrem_ratio(a_model, model_get_te_cart(a_model,             &
     &                                                    this%x_cart))
 
      CALL profiler_set_stop_time('sxrem_ratio_get_observed_signal',           &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION sxrem_ratio_get_type(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=data_name_length)      :: sxrem_ratio_get_type
      class(sxrem_ratio_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      sxrem_ratio_get_type = 'sxrem ratio'
 
      CALL profiler_set_stop_time('sxrem_ratio_get_type', start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  UTILITY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE sxrem_ratio_write_auxiliary(this, iou, index, a_model)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(sxrem_ratio_class), INTENT(in) :: this
      INTEGER, INTENT(in)                   :: iou
      INTEGER, INTENT(in)                   :: index
      TYPE (model_class), INTENT(in)        :: a_model
 
!  local variables
      REAL (rprec)                          :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      WRITE (iou,1000) this%indices(1), this%indices(2)
 
      CALL profiler_set_stop_time('sxrem_ratio_write_auxiliary',               &
     &                            start_time)
 
1000  FORMAT('sxrem profile ratio',1x,i2,'/',1x,i2)
 
      END SUBROUTINE
 
      END MODULE