limiter.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 limiter
 
      USE stel_kinds, only: rprec, dp
      USE profiler
      USE signal
 
      IMPLICIT NONE
!*******************************************************************************
!  geometric module parameters
!*******************************************************************************
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) limiter base class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE, EXTENDS(signal_class) :: limiter_class
         LOGICAL                             :: on_edge = .false.
         REAL (rprec), DIMENSION(:), POINTER :: phi => null()
      CONTAINS
         PROCEDURE                           ::                                &
     &      get_modeled_signal_last => limiter_get_modeled_signal
         PROCEDURE                           ::
     &      get_header => limiter_get_header
         PROCEDURE                           ::                                &
     &      get_type => limiter_get_type
         PROCEDURE                           ::                                &
     &      get_max_fval => limiter_get_max_fval
      END TYPE
 
!*******************************************************************************
!  INTERFACE BLOCKS
!*******************************************************************************
 
      CONTAINS
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE limiter_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(limiter_class), INTENT(inout) :: this
 
!  Start of executable code
      IF (ASSOCIATED(this%phi)) THEN
         DEALLOCATE(this%phi)
         this%phi => null()
      END IF
 
      this%on_edge = .false.
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION limiter_get_modeled_signal(this, a_model, sigma,                &
     &                                    last_value)
      USE model
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec), DIMENSION(4) :: limiter_get_modeled_signal
      class(limiter_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
!  The r and z arrays will be allocated by the equilibrium.
      REAL (rprec), DIMENSION(:), POINTER     :: r
      REAL (rprec), DIMENSION(:), POINTER     :: z
      INTEGER                                 :: num_theta
      INTEGER                                 :: phi_index
      REAL (rprec), DIMENSION(3)              :: rphiz_at_max
      REAL (rprec)                            :: fval_max
      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
         r => null()
         z => null()
 
!  Loop over each phi plane. r, z are allocated by equilibrium_get_plasma_edge.
!  There is no need to allocate and deallocate r and z for each phi angle.
         DO phi_index = 1, SIZE(this%phi)
            num_theta =                                                        &
     &         equilibrium_get_plasma_edge(a_model%equilibrium,                &
     &                                     this%phi(phi_index), r, z)
 
           fval_max = this%get_max_fval(num_theta, phi_index, r, z,            &
     &                                  rphiz_at_max)
         END DO
 
         IF (this%on_edge) THEN
            limiter_get_modeled_signal(1) = fval_max
         ELSE
            limiter_get_modeled_signal(1) = max(fval_max, 0.0)
         END IF
         limiter_get_modeled_signal(2:4) = rphiz_at_max
 
!  Dealloctae r and z since they are no longer needed.
         IF (ASSOCIATED(r)) THEN
            DEALLOCATE(r)
         END IF
         IF (ASSOCIATED(z)) THEN
            DEALLOCATE(z)
         END IF
         r => null()
         z => null()
 
         CALL this%scale_and_offset(a_model,                                   &
     &                              limiter_get_modeled_signal(1))
      ELSE
         limiter_get_modeled_signal = last_value
      END IF
 
      CALL profiler_set_stop_time('limiter_get_modeled_signal',                &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION limiter_get_type(this)
      USE data_parameters
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=data_name_length)  :: limiter_get_type
      class(limiter_class), INTENT(in) :: this
 
!  local variables
      REAL (rprec)                      :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      limiter_get_type = 'edge_lim '
 
      CALL profiler_set_stop_time('limiter_get_type', start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE limiter_get_header(this, header)
      USE data_parameters
 
      IMPLICIT NONE
 
!  Declare Arguments
      class(limiter_class), INTENT(in)              :: this
      CHARACTER (len=data_name_length), DIMENSION(7), INTENT(inout) ::         &
     &   header
 
!  local variables
      REAL (rprec)                                   :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      header(1) = 'r (m)'
      header(2) = 'phi (rad)'
      header(3) = 'z (m)'
      header(4) = 'model_sig(1)'
      header(5) = 'model_sig(2)'
      header(6) = 'model_sig(3)'
      header(7) = 'model_sig(4)'
 
      CALL profiler_set_stop_time('limiter_get_header', start_time)
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION limiter_get_max_fval(this, num_theta, phi_index,                &
     &                              r, z, rphiz_at_max)
      USE v3_utilities
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec)                            :: limiter_get_max_fval
      CLASS (limiter_class), INTENT(in)       :: this
      INTEGER, INTENT(in)                     :: num_theta
      INTEGER, INTENT(in)                     :: phi_index
      REAL (rprec), DIMENSION(:), INTENT(in)  :: r
      REAL (rprec), DIMENSION(:), INTENT(in)  :: z
      REAL (rprec), DIMENSION(3), INTENT(out) :: rphiz_at_max
 
!  Start of executable code
      CALL assert(.false., 'limiter_get_max_fval not over written' //          &
     &                     ' for ' // this%get_type())
 
      rphiz_at_max = 0.0
      limiter_get_max_fval = 0.0
 
      END FUNCTION
 
      END MODULE