text:
!==============================================================================
!!
!> @anchor  slam_math
!!
!> @brief   Contains math constants and basic functions
!!
!> @details The following math functions are available:
!!
!!   angle                       - compute angle between two vectors
!!   copy_matrix                 - copy a matrix (3x3)
!!   copy_vector                 - copy a vector (3)
!!   cross                       - cross product of two vectors
!!   cubic                       - solve cubic function
!!   dot                         - dot product of two vectors
!!   factorial                   - compute factorial of given integer
!!   get_extrema                 - returns extreme values for a given discrete signal (array)
!!   identity_matrix             - returns identity matrix (3x3)
!!   mag                         - magnitude of two vectors
!!   rot1                        - rotation of vector wrt. x-axis
!!   rot2                        - rotation of vector wrt. y-axis
!!   rot3                        - rotation of vector wrt. z-axis
!!   rot1_matrix                 - rotation of matrix wrt. x-axis
!!   rot2_matrix                 - rotation of matrix wrt. y-axis
!!   rot3_matrix                 - rotation of matrix wrt. z-axis
!!
!> @author  Vitali Braun (VB)
!> @author  Christopher Kebschull (ChK)
!!
!> @date

!!
VB:  26.06.2014 (added Doxygen comments)

!!
VB:  21.04.2015 (added 'get_extrema' function)

!!
ChK: 13.10.2019 (Enforcing camel case and adding copyright)

!!

!!
!> @copyright Institute of Space Systems / TU Braunschweig
!------------------------------------------------------------------------
module slam_math

  use slam_error_handling
  use slam_strings
  use slam_types

  implicit none

  real(dp), parameter :: eps20 = 1.d-20
  real(dp), parameter :: eps15 = 1.d-15
  real(dp), parameter :: eps9  = 1.d-9
  real(dp), parameter :: eps6  = 1.d-6
  real(dp), parameter :: eps3  = 1.d-3

  real(dp), parameter :: pi      = 4.d0*atan(1.d0)    ! pi
  real(dp), parameter :: halfPi  = 0.5d0*pi           ! pi/2
  real(dp), parameter :: twoPi   = pi + pi            ! 2pi
  real(dp), parameter :: rad2deg = 180.d0/pi          ! radians to degrees
  real(dp), parameter :: deg2rad = pi/180.d0          ! degrees to radians

  real(dp), parameter :: as2rad       = deg2rad/3.6d3 ! arcseconds to radians
  real(dp), parameter :: as_in_circle = 1296.d3       ! arcseconds in full circle
  real(dp), parameter :: mas2rad      = as2rad*1.d-6  ! microarcseconds to radians
  real(dp), parameter :: infinite     = 999999.9d0
  real(dp), parameter :: undefined    = 999999.1d0

  real(dp), dimension(3), parameter :: uvec1 = (/1.d0,0.d0,0.d0/)
  real(dp), dimension(3), parameter :: uvec2 = (/0.d0,1.d0,0.d0/)
  real(dp), dimension(3), parameter :: uvec3 = (/0.d0,0.d0,1.d0/) ! definition of three unity vectors

contains

!========================================================================
!!
!>  @brief       Angle between two vectors
!!
!>  @param[in]   vec1
!>  @param[in]   vec2
!>  @param[out]  Theta the angle between the two input vectors
!!
!> @date

!!
ChK: 13.10.2019 (replaced eps9**2 with epsilon(1.d0))

!!

!!
!>  @anchor      angle
!!
!----------------------------------------------------
  subroutine angle(       &
                    vec1, & ! <-- DBL() first vector
                    vec2, & ! <-- DBL() second vector
                    theta & ! --> DBL   angle in rad, the output is set to 999999.1D0
                  )         !           to indicate an undefined value. Be SURE to check
                            !           this at the output phase.

    real(dp), dimension(3), intent(in) :: vec1
    real(dp), dimension(3), intent(in) :: vec2

    real(dp), intent(out) :: theta

    real(dp) :: mag_vec1
    real(dp) :: mag_vec2
    real(dp) :: temp

    mag_vec1 = mag(vec1)
    mag_vec2 = mag(vec2)

    if( mag_vec1 * mag_vec2 > epsilon(1.d0)) then
      temp = dot_product(vec1, vec2) / (mag_vec1 * mag_vec2)
      if (abs(temp) .gt. 1.d0) then
        temp = sign(1.0d0, temp)
      end if
      theta = acos(temp)
    else
      theta = undefined
    end if

  end subroutine angle

  !========================================================================
  !
  !>  @brief       Cross product of two 3D vectors
  !!
  !>  @param[in]   vec1
  !>  @param[in]   vec2
  !!
  !>  @returns     cross vector in 3D
  !!
  !>  @anchor      cross
  !!
  !----------------------------------------------------
  function cross(         &
                   vec1,  & ! <-- DBL() first vector
                   vec2   & ! <-- DBL() second vector
               )

    real(dp), dimension(3)              :: cross
    real(dp), dimension(3), intent(in)  :: vec1
    real(dp), dimension(3), intent(in)  :: vec2

    cross(1) = vec1(2)*vec2(3) - vec1(3)*vec2(2)
    cross(2) = vec1(3)*vec2(1) - vec1(1)*vec2(3)
    cross(3) = vec1(1)*vec2(2) - vec1(2)*vec2(1)

  end function cross

  !!------------------------------------------------------------------------------
  !!
  !> @details  this subroutine solves for the three Roots of a CUBIC equation.  There are
  !!    no restrictions on the coefficients, and imaginary results are passed
  !!    out as separate values.  The general form is y = ax3 + bx2 + cx + d.  Note
  !!    that R1i will ALWAYS be ZERO since there is ALWAYS at least one REAL Root.
  !!
  !> @author        David Vallado     2007, pg 975   719-573-2600    1 Mar 2001
  !> @author        Vitali Braun (20 Feb 2014)
  !!
  !!
  !!
  !!  Locals        :
  !!    temp1       - temporary value
  !!    temp2       - temporary value
  !!    Root1       - temporary value of the Root
  !!    Root2       - temporary value of the Root
  !!    Root3       - temporary value of the Root
  !!    P           - Coefficient of x squared term where x cubed term is 1.0d0
  !!    Q           - Coefficient of x term where x cubed term is 1.0d0
  !!    R           - Coefficient of constant term where x cubed term is 1.0d0
  !!    Delta       - Discriminator for use with Cardans formula
  !!    E0          - ANGLE holder for trigonometric solution
  !!    Phi         - ANGLE used in trigonometric solution
  !!    CosPhi      - Cosine of Phi
  !!    SinPhi      - Sine of Phi
  !!
  !!  Coupling      :
  !!    None.
  !!
  !> @param[in]     a           - Coefficient of x cubed term
  !> @param[in]     b           - Coefficient of x squared term
  !> @param[in]     c           - Coefficient of x term
  !> @param[in]     d           - Constant
  !> @param[out]    R1r         - Real portion of Root 1
  !> @param[out]    R1i         - Imaginary portion of Root 1
  !> @param[out]    R2r         - Real portion of Root 2
  !> @param[out]    R2i         - Imaginary portion of Root 2
  !> @param[out]    R3r         - Real portion of Root 3
  !> @param[out]    R3i         - Imaginary portion of Root 3
  !!
  !> @anchor cubic
  !!
  ! ------------------------------------------------------------------------------
  subroutine cubic( a_in,b_in,c,d, R1r,R1i,R2r,R2i,R3r,R3i )

    implicit none

    real(dp), intent(out) :: R1r,R1i,R2r,R2i,R3r,R3i
    real(dp), intent(in)  :: a_in,b_in,c,d

    real(dp) :: a, b
    real(dp) :: OneThird, temp1, temp2, Root1, Root2, Root3, P, Q, R, Delta, E0, CosPhi, SinPhi, Phi

    ! --------------------  Implementation   ----------------------
    OneThird  = 1.0d0/3.0d0
    R1r   = 0.0d0
    R1i   = 0.0d0
    R2r   = 0.0d0
    R2i   = 0.0d0
    R3r   = 0.0d0
    R3i   = 0.0d0
    Root1 = 0.0d0
    Root2 = 0.0d0
    Root3 = 0.0d0

    ! ----------- Force coefficients into std form ----------------
    a = a_in
    b = b_in

    P = B/A
    Q = C/A
    R = D/A

    a = a_in
    b = b_in

    a = OneThird*( 3.0d0*Q - P*P )
    b = (1.0d0/27.0d0)*( 2.0d0*P*P*P - 9.0d0*P*Q + 27.0d0*R )

    Delta = (a*a*a/27.0d0) + (b*b*0.25d0)

    ! ------------------ Use Cardans formula ----------------------
    if ( Delta > eps9 ) then
      temp1 = (-b*0.5d0)+DSQRT(Delta)
      temp2 = (-b*0.5d0)-DSQRT(Delta)

      if ( abs(temp1) > eps9 ) then
        temp1 = temp1**OneThird
      endif

      if ( abs(temp2) > eps9 ) then
        temp2= temp2**OneThird
      endif

      Root1 = temp1 + temp2
      Root2 = -0.5d0*(temp1 + temp2)
      Root3 = -0.5d0*(temp1 + temp2)
      R2i = -0.5d0*sqrt( 3.0d0 )*(temp1 - temp2)
      R3i = -R2i

    else
      ! --------------- Evaluate zero point ---------------------
      if ( abs( Delta ) < eps9 ) then

        if ( abs(b) < eps9 ) then

          Root1 = -2.0d0 * (b*0.5d0)**OneThird
          Root2 =  (b*0.5d0)**OneThird
          Root3 = Root2

        endif

      else

        ! ------------ Use trigonometric identities -----------
        E0     = 2.0d0*sqrt(-a*OneThird)
        CosPhi = (-b/(2.0d0*sqrt(-a*a*a/27.0d0)) )
        SinPhi = sqrt(1.0d0-CosPhi*CosPhi )
        Phi    = atan2( SinPhi,CosPhi )
        Root1  = E0*cos( Phi*OneThird )
        Root2  = E0*cos( Phi*OneThird + 120.0d0*deg2Rad )
        Root3  = E0*cos( Phi*OneThird + 240.0d0*deg2Rad )

      endif

    endif

    R1r = Root1 - P*OneThird
    R2r = Root2 - P*OneThird
    R3r = Root3 - P*OneThird

  end subroutine cubic

!========================================================================
!!
!> @brief  Compute factorial for given integer
!!
!> @param[in] integer of which the factorial is to be calculated
!!
!> @returns   integer the factorial of input i
!!
!> @anchor factorial
!----------------------------------------------------
  integer function factorial(i)

    integer, intent(in) :: i
    integer             :: j

    factorial = 1
    do j = 2,i
      factorial = factorial*j
    end do

  end function factorial

  !========================================================================
  !!
  !> @brief Initialize matrix to identity
  !!
  !> @param[inout] R the matrix which will be the identity matrix
  !!
  !> @anchor identity_matrix
  !!
  !------------------------------------------------------------------------
  subroutine identity_matrix( R )   ! <--> DBL(:,:) Matrix

    real(dp), dimension(:,:), intent(inout) :: R

    integer :: i

    R = 0.d0
    forall(i=1:size(R,1)) R(i,i) = 1.d0

  end subroutine identity_matrix

!========================================================================
!!
!> @brief Magnitude of a vector
!!
!> @param[in] Vec
!!
!> @returns real(dp) the magnitude of the vector
!!
!> @date

!!
ChK: 13.10.2019 (replaced eps15**2 with epsilon(1.d0))

!!

!!
!> @anchor mag
!!
!----------------------------------------------------
  real(dp) pure function mag(vec)

    real(dp), intent(in) :: vec(3)
    real(dp) temp

    temp = vec(1)*vec(1) + vec(2)*vec(2) + vec(3)*vec(3)

    ! The tolerance is set to 1.d-15, thus the 1.d-30 for the squared test of underflows.
    if (abs(temp) .ge. epsilon(1.d0)) then
      mag = sqrt(temp)
    else
      mag = 0.d0
    end if

  end function mag

  !========================================================================
  !!
  !> @brief Normalize radians to range 0 to 2pi
  !!
  !> @param[in] ang - angle in radians
  !!
  !> @returns real(dp) the angle in radians to range 0 to 2pi
  !!
  !> @anchor angle_2pi
  !-------------------------------------------------------------------------
  real(dp) function angle_2pi ( ang )

    real(dp), intent(in) :: ang
    real(dp) W

    W = mod (ang,twopi)

    if ( W < 0.d0 ) W = W + twopi

    angle_2pi = W

  end function angle_2pi

  !=========================================================================
  !> @brief Reduce an angle to a valid interval
  !!
  !> @param[in] ang  - passed angle to reduce
  !> @param[in] imds - modus identifier
  !> @param[in] jint - interval modus switch
  !> @param[in] ldeg - degree flag
  !!
  !> @returns real(dp) - the reduced angle in the designated intervall
  !!
  !> @anchor redang
  !-------------------------------------------------------------------------
  real(dp) function redang (        & ! reduce an angle to a valid interval
                              ang,  & ! <-- DBL   passed angle to reduce
                              imds, & ! <-- INT   modus identifier
                                      !             1 = interval -pi ... pi
                                      !             2 = interval 0 ... 2*pi
                                      !             3 = interval -pi/2 ... pi/2
                                      !             4 = interval 0 ... pi
                              jint, & ! <-- INT   interval modus switch
                                      !            -1 = open interval   ]x,y]
                                      !             0 = closed interval [x,y]
                                      !             1 = open interval   [x,y[
                              ldeg)   ! <-- LOG   degree flag (.TRUE. = degree)
                                      !                        .FALSE.= radian

    real(dp),  intent(in) :: ang
    integer, intent(in)   :: imds
    integer, intent(in)   :: jint
    logical, intent(in)   :: ldeg
    !--------------------------------------------------------

    !** declaration of local parameters
    integer, parameter ::mmds = 4    ! number of modes supported

    !** declaration of local variables
    real(dp) :: dlw      ! angular difference to lower boundary
    real(dp) :: dup      ! angular difference to upper boundary
    real(dp) :: fac      ! radian/degree factor
    real(dp) :: xlw      ! lower interval boundary (specific)
    real(dp) :: xmds(mmds,2) ! interval boundary (generic)
                             !   1 = lower, 2 = upper
    real(dp) :: xrng     ! interval range (xup-xlw)
    real(dp) :: xup      ! upper interval boundyry (specific)
    integer :: jmds    ! corrected mode switch

    !** define angular borders for different modes
    xmds(1,1) = -pi
    xmds(1,2) = pi
    xmds(2,1) = 0.d0
    xmds(2,2) = twoPi
    xmds(3,1) = -halfPi
    xmds(3,2) = halfPi
    xmds(4,1) = 0.d0
    xmds(4,2) = pi

    !** make sure that mode switch is within valid range
    jmds = min( max(imds,1), mmds)

    !** set angle values according to deg or rad
    if (ldeg) then
       fac = rad2deg
    else
       fac = 1.d0
    end if

    !** set angle offset and range
    xlw  = xmds(jmds,1)*fac
    xup  = xmds(jmds,2)*fac
    xrng = abs(xup-xlw)

    !** reduce angle
    redang = mod( mod(ang+xlw,xrng) + xrng,xrng ) - abs(xlw)

    !** calculate distance of reduced angle from interval boundaries
    dlw = abs(redang - xlw)
    dup = abs(redang - xup)
    !** IF distance to one or more boundary is near zero
    if (dlw<eps15 .OR. dup<eps15) then
       !** resulting angle lies on one border

       !** IF value on lower boundary marked as "open"
       if (jint<0 .AND. dlw<eps15) then
          !** correct lower border result to upper border
          redang = xup
       !** ELSE IF value on upper boundary marked as "open"
       else if (jint>0 .AND. dup<eps15) then
          !** correct upper border result to lower border
          redang = xlw
       !** ELSE
       else if (jint==0) then
          !** take that border which lies next to angle

          if (abs(ang-xup) < abs(ang-xlw)) then
             redang = xup
          else
             redang = xlw
          end if

       end if

    end if

  end function redang

  !========================================================================
  !!
  !>  @brief   Rotation about 1st axis
  !!
  !>  @param[in]  Vec    vector to rotate
  !>  @param[in]  x_val   rotation angle in rad
  !>  @param[out] out_vec result vector
  !!
  !>  @anchor  rot1
  !----------------------------------------------------
  subroutine rot1(        &
                  vec,    &! <-- DBL() vector to rotate
                  x_val,  &! <-- DBL   rotation angle (rad)
                  out_vec &! --> DBL() result vector
                 )

    !** interface
    !-----------------------------------------------
    real(dp), dimension(3), intent(in) :: vec
    real(dp),               intent(in) :: x_val
    real(dp), dimension(3), intent(out) :: out_vec
    !-----------------------------------------------

    ! -----------------------------  Locals  ------------------------------
    real(dp) c, s

    c    = cos( x_val )
    s    = sin( x_val )

    out_vec(3)= c*vec(3) - s*vec(2)
    out_vec(2)= c*vec(2) + s*vec(3)
    out_vec(1)= vec(1)

    return

  end subroutine rot1

  !========================================================================
  !
  !>  @brief Rotation about 2nd axis
  !>  @anchor  rot2
  !>  @param[in]  Vec    vector to rotate
  !>  @param[in]  x_val   rotation angle in rad
  !>  @param[out] out_vec result vector
  !----------------------------------------------------
  subroutine rot2(         &
                   vec,    & ! <-- DBL() vector to rotate
                   x_val,  & ! <-- DBL   rotation angle (rad)
                   out_vec & ! --> DBL() result vector
                 )

    !** interface
    !-----------------------------------------------
    real(dp), dimension(3), intent(in) :: vec
    real(dp),               intent(in) :: x_val

    real(dp), dimension(3), intent(out) :: out_vec
    !-----------------------------------------------

    ! -----------------------------  Locals  ------------------------------
    real(dp) c, s

    c    = cos( x_val )
    s    = sin( x_val )

    out_vec(3) = c*vec(3) + s*vec(1)
    out_vec(1) = c*vec(1) - s*vec(3)
    out_vec(2) = vec(2)

    return

  end subroutine rot2

  !========================================================================
  !!
  !>  @brief   Rotation about 3rd axis
  !!
  !>  @param[in]  vec     vector to rotate
  !>  @param[in]  x_val   rotation angle in rad
  !>  @param[out] out_vec result vector
  !!
  !>  @anchor  rot3
  !----------------------------------------------------
  subroutine rot3(         &
                   vec,    & ! <-- DBL() vector to rotate
                   x_val,  & ! <-- DBL   rotation angle (rad)
                   out_vec & ! --> DBL() result vector
                 )

    !** interface
    !-----------------------------------------------
    real(dp), dimension(3), intent(in) :: vec
    real(dp),               intent(in) :: x_val

    real(dp), dimension(3), intent(out) :: out_vec
    !-----------------------------------------------

    ! -----------------------------  Locals  ------------------------------
    real(dp) c, s

    c    = cos(x_val)
    s    = sin(x_val)

    out_vec(2) = c*vec(2) - s*vec(1)
    out_vec(1) = c*vec(1) + s*vec(2)
    out_vec(3) = vec(3)

    return

  end subroutine rot3

  !========================================================================
  !!
  !>  @brief Rotate matrix wrt. x axis
  !!
  !>  @param[in]  angle  rotation angle in rad
  !>  @param[inout] matrix the (3,3) matrix to rotate
  !!
  !>  @anchor  rot1_matrix
  !----------------------------------------------------
  subroutine rot1_matrix(         &
                          angle,  & ! <--  DBL      angle in radians
                          matrix  & ! <--> DBL(3,3) matrix
                        )
  !-----------------------------------------------------

    !** interface
    !----------------------------------------------
    real(dp), intent(in) :: angle
    real(dp), dimension(3,3), intent(inout) :: matrix
    !----------------------------------------------

    real(dp) :: S, C, A21, A22, A23, A31, A32, A33

    S = sin(angle)
    C = cos(angle)

    A21 =   C*matrix(2,1) + S*matrix(3,1)
    A22 =   C*matrix(2,2) + S*matrix(3,2)
    A23 =   C*matrix(2,3) + S*matrix(3,3)
    A31 = - S*matrix(2,1) + C*matrix(3,1)
    A32 = - S*matrix(2,2) + C*matrix(3,2)
    A33 = - S*matrix(2,3) + C*matrix(3,3)

    matrix(2,1) = A21
    matrix(2,2) = A22
    matrix(2,3) = A23
    matrix(3,1) = A31
    matrix(3,2) = A32
    matrix(3,3) = A33

  end subroutine rot1_matrix

  !========================================================================
  !!
  !>  @brief Rotate matrix wrt. y axis
  !!
  !>  @param[in]  angle  rotation angle in rad
  !>  @param[inout] matrix the (3,3) matrix to rotate
  !!
  !>  @anchor  rot2_matrix
  !----------------------------------------------------
  subroutine rot2_matrix (         &
                           angle,  &  ! <-- DBL      angle in radians
                           matrix  &  ! --> DBL(3,3) matrix
                         )
  !-----------------------------------------------------

    !** interface
    !----------------------------------------------
    real(dp), intent(in) :: angle
    real(dp), dimension(3,3), intent(inout) :: matrix
    !----------------------------------------------

    real(dp) :: S, C, A11, A12, A13, A31, A32, A33

    S = sin(angle)
    C = cos(angle)

    A11 = C*matrix(1,1) - S*matrix(3,1)
    A12 = C*matrix(1,2) - S*matrix(3,2)
    A13 = C*matrix(1,3) - S*matrix(3,3)
    A31 = S*matrix(1,1) + C*matrix(3,1)
    A32 = S*matrix(1,2) + C*matrix(3,2)
    A33 = S*matrix(1,3) + C*matrix(3,3)

    matrix(1,1) = A11
    matrix(1,2) = A12
    matrix(1,3) = A13
    matrix(3,1) = A31
    matrix(3,2) = A32
    matrix(3,3) = A33

  end subroutine rot2_matrix
  !------------------------------------------------------

  !========================================================================
  !
  !>  @brief Rotate matrix wrt. z axis
  !!
  !>  @param[in]  angle  rotation angle in rad
  !>  @param[inout] matrix the (3,3) matrix to rotate
  !!
  !>  @anchor  rot3_matrix
  !----------------------------------------------------
  subroutine rot3_matrix (        &
                           angle, & ! <-- DBL      angle in radians
                           matrix & ! --> DBL(3,3) matrix
                         )

    !** interface
    !----------------------------------------------
    real(dp), intent(in)                    :: angle
    real(dp), dimension(3,3), intent(inout) :: matrix
    !----------------------------------------------

    real(dp) :: S, C, A11, A12, A13, A21, A22, A23

    S = sin(angle)
    C = cos(angle)

    A11 =   C*matrix(1,1) + S*matrix(2,1)
    A12 =   C*matrix(1,2) + S*matrix(2,2)
    A13 =   C*matrix(1,3) + S*matrix(2,3)
    A21 = - S*matrix(1,1) + C*matrix(2,1)
    A22 = - S*matrix(1,2) + C*matrix(2,2)
    A23 = - S*matrix(1,3) + C*matrix(2,3)

    matrix(1,1) = A11
    matrix(1,2) = A12
    matrix(1,3) = A13
    matrix(2,1) = A21
    matrix(2,2) = A22
    matrix(2,3) = A23

  end subroutine rot3_matrix

  !========================================================================
  !
  !>  @brief    Get extreme values for a given discrete signal (array)
  !!
  !>  @author   Vitali Braun
  !!
  !>  @date

  !!
21.04.2015 (initial design)

  !!

  !!
  !!  @anchor   get_extrema
  !----------------------------------------------------
  subroutine get_extrema(x, y, typ, extr, nextr)

    real(dp), dimension(:), intent(in) :: x
    real(dp), dimension(:), intent(in) :: y
    character(len=3),       intent(in) :: typ
    real(dp), dimension(size(y),3), intent(out) :: extr
    integer, intent(out) :: nextr

    character(len=*), parameter :: csubid = 'get_extrema'

    integer :: i
    integer :: lasti

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    nextr = 0
    lasti = 0

    if(typ == 'MAX') then ! search maxima

      do i = 3, size(y)-2
        if((y(i) - y(i-1)) > 0.d0 .and. (y(i+1) - y(i)) < 0.d0) then      ! finite difference of first order
          nextr = nextr + 1
          extr(nextr,1) = x(i)
          extr(nextr,2) = y(i)
          extr(nextr,3) = 1.d0    ! max
        else if(i > lasti+2 .and. (y(i)-2.d0*y(i-1)+y(i-2)) < 0.d0 .and. (y(i+2)-2.d0*y(i+1)+y(i)) > 0.d0) then  ! ... second order
          lasti = i
          nextr = nextr + 1
          extr(nextr,1) = x(i)
          extr(nextr,2) = y(i)
          extr(nextr,3) = 0.d0    ! turning point
        end if
      end do

    else if(typ == 'MIN') then

      do i = 3, size(y)-2
        if((y(i) - y(i-1)) < 0.d0 .and. (y(i+1) - y(i)) > 0.d0) then ! finite difference of first order
          nextr = nextr + 1
          extr(nextr,1) = x(i)
          extr(nextr,2) = y(i)
          extr(nextr,3) = -1.d0    ! min
        else if(i > lasti+2 .and. (y(i)-2.d0*y(i-1)+y(i-2)) > 0.d0 .and. (y(i+2)-2.d0*y(i+1)+y(i)) < 0.d0) then  ! ... second order
          lasti = i
          nextr = nextr + 1
          extr(nextr,1) = x(i)
          extr(nextr,2) = y(i)
          extr(nextr,3) = 0.d0    ! turning point
        end if
      end do

    else
      call setError(E_UNKNOWN_PARAMETER, FATAL)
      return
    end if

    if(isControlled()) then
      call checkout(csubid)
    end if

  end subroutine get_extrema

  !========================================================================
  !
  !>  @brief    Outer product of two vectors a and b
  !!
  !>  @author   Vitali Braun
  !!
  !>  @date

  !!
26.07.2013 (initial design)

  !!

  !!
  !>  @param[in] a
  !>  @param[in] b
  !!
  !>  @returns the outer product of a and b
  !!
  !!  @anchor   outerproduct
  !----------------------------------------------------
  function outerproduct(a,b)

    real(dp), dimension(:), intent(in) :: a
    real(dp), dimension(:), intent(in) :: b
    real(dp), dimension(size(a), size(b)) :: outerproduct

    outerproduct = spread(a,dim=2,ncopies=size(b)) * spread(b,dim=1,ncopies=size(a))

  end function outerproduct

end module slam_math

max_stars_repo_name: Space-Systems/libslam

max_issues_repo_name: Space-Systems/libslam

max_forks_repo_name: Space-Systems/libslam


text:
HANSARD REVISE * NUMERO 33
Le mercredi 19 novembre 1997
LE CORPS NO 2310 DES CADETS DE L'ARMEE
LA TAXE SUR LES PRODUITS ET SERVICES
Mme Caroline St-Hilaire
Mme Judy Wasylycia-Leis
LA JOURNEE NATIONALE DE L'ENFANT
Le tres hon. Jean Chretien
Le tres hon. Jean Chretien
L'hon. Pierre S. Pettigrew
L'hon. Pierre S. Pettigrew
L'hon. Arthur C. Eggleton
M. John O'Reilly
L'hon. Arthur C. Eggleton
L'hon. David M. Collenette
L'hon. David M. Collenette
Mme Nancy Karetak-Lindell
L'AGENCE DE PROMOTION ECONOMIQUE DU CANADA ATLANTIQUE
M. Jean-Guy Chretien
L'hon. Pierre S. Pettigrew
LE MINISTERE DE LA CITOYENNETE ET DE L'IMMIGRATION
Mme Judy Wasylycia-Leis
LA LOI SUR LA COMMISSION CANADIENNE DU BLE
M. Jean-Guy Chretien
M. Jake E. Hoeppner
DEMANDE DE DEBAT D'URGENCE
LA LOI SUR LA COMMISSION CANADIENNE DU BLE
M. Leon E. Benoit
Mme Diane St-Jacques
Mme Judy Wasylycia-Leis
M. Jean-Guy Chretien
HANSARD REVISE * NUMERO 33
Le mercredi 19 novembre 1997
La seance est ouverte a 14 heures.
M. Janko Peric (Cambridge, Lib.):
M. Derrek Konrad (Prince Albert, Ref.):
Les liberaux disent que, au Canada, tout le monde est egal.
C'est ainsi que les liberaux concoivent le Canada.
LE CORPS NO 2310 DES CADETS DE L'ARMEE
M. Carmen Provenzano (Sault Ste. Marie, Lib.):
Le depute de Kamouraska-Riviere-du-Loup-Temiscouata-Les Basques.
M. Paul Crete (Kamouraska-Riviere-du-Loup-Temiscouata-Les Basques, BQ):
Les realisations de la station scientifique Aster sont nombreuses.
Mme Jean Augustine (Etobicoke-Lakeshore, Lib.):
Le travail de M. Ruderman est une exemple de l'esprit qui anime le benevolat.
La population d'Etobicoke-Lakeshore est fiere de ce qu'il a fait.
M. Denis Paradis (Brome-Missisquoi, Lib.):
Une vraie ecole de la vie, quoi.
M. Jason Kenney (Calgary-Sud-Est, Ref.):
Il y aura 50 ans demain qu'ils se sont epouses.
La ceremonie a eu lieu durant la onzieme annee du regne du roi Georges VI.
La Grande-Bretagne etait accablee par de graves problemes economiques.
Dieu protege la reine.
M. Gar Knutson (Elgin-Middlesex-London, Lib.):
Monsieur le President, j'interviens aujourd'hui pour rendre hommage au regiment Elgin.
L'histoire a montre que les membres du regiment Elgin sont habitues au changement.
LA TAXE SUR LES PRODUITS ET SERVICES
Mme Caroline St-Hilaire (Longueuil, BQ):
M. Bernard Patry (Pierrefonds-Dollard, Lib.):
M. Grant McNally (Dewdney-Alouette, Ref.):
Mme Judy Wasylycia-Leis (Winnipeg-Centre-Nord, NPD):
On peut blamer les politiques liberales pour cet etat de choses.
Pourquoi les grandes societes pharmaceutiques gouvernent-elles le pays?
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
Malheureusement, le ministre a refuse d'acceder a ces demandes repetees.
LA JOURNEE NATIONALE DE L'ENFANT
Mme Eleni Bakopanos (Ahuntsic, Lib.):
Je les felicite au nom des enfants d'Ahuntsic.
Il nous incombe, en tant que parlementaires, de laisser un monde meilleur.
M. Preston Manning (chef de l'opposition, Ref.):
Le gouvernement affirme que les negociations vont conduire a une entente.
Ils vont bientot faire partie de la WWF.
Le tres hon. Jean Chretien (premier ministre, Lib.):
Des choses de ce genre se produisent de temps a autre.
Les employes ont le droit d'etre syndiques et de negocier.
M. Preston Manning (chef de l'opposition, Ref.):
L'hon. Lawrence MacAulay (Cardigan, Lib.):
Le gouvernement veut une convention collective et souhaite que les deux parties negocient.
M. Preston Manning (chef de l'opposition, Ref.):
L'hon. Lawrence MacAulay (Cardigan, Lib.):
M. Rahim Jaffer (Edmonton-Strathcona, Ref.):
Le tres hon. Jean Chretien (premier ministre, Lib.):
Nous attendons pour voir quel en sera le resultat.
S'il y a lieu de consulter les Quebecois par la suite, nous aviserons.
M. Gerry Ritz (Battlefords-Lloydminster, Ref.):
De la part des liberaux, c'est toute un aveu.
L'hon. Paul Martin (ministre des Finances, Lib.):
Nous avons reduit les impots des etudiants.
Nous avons reduit les impots des personnes handicapees.
Nous avons reduit les impots des familles pauvres qui ont des enfants.
M. Gilles Duceppe (Laurier-Sainte-Marie, BQ):
On sait aussi que des evenements plutot disgracieux se sont produits hier.
L'hon. Alfonso Gagliano (ministre des Travaux publics et des Services gouvernementaux, Lib.):
Juste avant l'incident, hier, les negociations se poursuivaient en bonne et due forme.
J'espere qu'elles pourront reprendre cet apres-midi.
M. Gilles Duceppe (Laurier-Sainte-Marie, BQ):
L'hon. Alfonso Gagliano (ministre des Travaux publics et des Services gouvernementaux, Lib.):
L'objectif du gouvernement, c'est d'avoir une convention collective negociee.
M. Rejean Lefebvre (Champlain, BQ):
L'hon. Alfonso Gagliano (ministre des Travaux publics et des Services gouvernementaux, Lib.):
Le gouvernement prendra ses responsabilites.
L'hon. Alfonso Gagliano (ministre des Travaux publics et des Services gouvernementaux, Lib.):
Monsieur le President, je suis le ministre responsable de la Societe canadienne des postes.
Mme Alexa McDonough (Halifax, NPD):
Monsieur le President, ma question s'adresse au ministre de l'Industrie.
L'hon. John Manley (ministre de l'Industrie, Lib.):
Monsieur le President, la politique en matiere de brevets pharmaceutiques est controversee.
Elle a ete examinee par un comite de la Chambre l'hiver dernier.
Selon nous, le but de cette politique est fort simple.
Mme Alexa McDonough (Halifax, NPD):
L'hon. John Manley (ministre de l'Industrie, Lib.):
De toute evidence, le NPD ne s'interesse nullement au respect de la propriete intellectuelle.
Il ne fait aucune suggestion legale pratique que nous pourrions...
La deputee de Saint John.
Mme Elsie Wayne (Saint John, PC):
Monsieur le President, ma question s'adresse au ministre du Developpement des ressources humaines.
L'hon. Pierre S. Pettigrew (ministre du Developpement des ressources humaines, Lib.):
Si elle me le disait, je pourrais lui fournir une reponse plus appropriee.
Mme Elsie Wayne (Saint John, PC):
Tout le monde est au courant.
Le monde des affaires l'est.
Je l'ai, monsieur le President.
Evitons l'utilisation d'accessoires a la Chambre.
S'il le desire, le ministre peut repondre a la question.
L'hon. Pierre S. Pettigrew (ministre du Developpement des ressources humaines, Lib.):
Je pensais qu'elle faisait reference a une information plus precise.
Son gouvernement s'appretait a les augmenter.
C'est ce qu'il voulait faire.
Heureusement que nous sommes ici depuis un certain temps.
M. Rob Anders (Calgary-Ouest, Ref.):
L'hon. Lawrence MacAulay (ministre du Travail, Lib.):
D'ici la, je n'ai aucune observation a faire a ce sujet.
M. Gurmant Grewal (Surrey-Centre, Ref.):
Lorsqu'il etait dans l'opposition, le ministre faisait de belles declarations.
Il est maintenant temps.
Va-t-il passer a l'action?
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Nous y avons souleve toutes les questions qui preoccupent le depute.
Les questions concernant les prisonniers ont toutes ete soulevees.
Pour la premiere fois, un certain nombre d'ONG ont participe.
M. Yvan Loubier (Saint-Hyacinthe-Bagot, BQ):
Ma question s'adresse au ministre des Finances.
L'hon. Paul Martin (ministre des Finances, Lib.):
Il faut diminuer les attentes.
Alors, la premisse de la question n'est pas correcte.
M. Yvan Loubier (Saint-Hyacinthe-Bagot, BQ):
Monsieur le President, quelle revelation!
L'hon. Paul Martin (ministre des Finances, Lib.):
M. Eric Lowther (Calgary-Centre, Ref.):
L'hon. Christine Stewart (ministre de l'Environnement, Lib.):
Que va faire le Parti reformiste?
C'est ce que les Canadiens voudraient savoir.
M. Rick Casson (Lethbridge, Ref.):
Nous savons pourtant deux choses.
Le gouvernement va signer un accord ayant force obligatoire.
L'hon. Christine Stewart (ministre de l'Environnement, Lib.):
Les Canadiens seront tous invites a s'attaquer au probleme des changements climatiques.
Mme Helene Alarie (Louis-Hebert, BQ):
Le gouvernement s'apprete a repondre a ce rapport.
Ma question s'adresse au ministre de l'Industrie.
L'hon. John Manley (ministre de l'Industrie, Lib.):
Mme Helene Alarie (Louis-Hebert, BQ):
L'hon. John Manley (ministre de l'Industrie, Lib.):
Alors, si on decide d'apporter des changements a la reglementation, c'est pour...
Je m'excuse d'interrompre l'honorable ministre.
La parole est maintenant au depute de Nanaimo-Cowichan.
M. Reed Elley (Nanaimo-Cowichan, Ref.):
Le verificateur general a de nouveau confirme l'ampleur du probleme.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Cette technologie sera en place d'ici la fin de l'annee en cours.
Elle permettra d'economiser de l'argent et, plus important, de sauver des vies.
M. Maurice Vellacott (Wanuskewin, Ref.):
Monsieur le President, le ministre de la Sante precedent a fait deux promesses contradictoires.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Cela comprend tout d'abord...
Le ministre de la Sante a 15 secondes pour repondre.
Nous sommes fiers de cette loi.
La deputee de Saint-Bruno-Saint-Hubert.
Mme Pierrette Venne (Saint-Bruno-Saint-Hubert, BQ):
Monsieur le President, ma question s'adresse au ministre de la Defense nationale.
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
M. John O'Reilly (Victoria-Haliburton, Lib.):
Le general Pike merite de se faire envoyer promener.
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
Certainement, monsieur le President.
Je crois que cela est plus representatif de ce que peut penser l'armee britannique.
Le depute de Surrey-Nord.
M. Chuck Cadman (Surrey-Nord, Ref.):
Elle propose maintenant de nommer un ombudsman pour les victimes de crimes.
L'hon. Anne McLellan (ministre de la Justice et procureur general du Canada, Lib.):
M. Howard Hilstrom (Selkirk-Interlake, Ref.):
Cette tache incombera aux services federaux de la GRC.
L'hon. Andy Scott (solliciteur general du Canada, Lib.):
M. Peter Mancini (Sydney-Victoria, NPD):
Ma question s'adresse au ministre des Transports.
La parole est au ministre des Transports.
L'hon. David M. Collenette (ministre des Transports, Lib.):
La GRC procede actuellement a une enquete la-dessus.
Je n'en sais pas plus.
M. Peter Mancini (Sydney-Victoria, NPD):
Au cours de cette reunion, il a donne des precisions sur ses allegations de corruption.
L'hon. David M. Collenette (ministre des Transports, Lib.):
Celle-ci tiendra compte de tous les facteurs.
M. Jean Dube (Madawaska-Restigouche, PC):
L'hon. Paul Martin (ministre des Finances, Lib.):
M. Jean Dube (Madawaska-Restigouche, PC):
Monsieur le President, les travailleurs canadiens feraient bien de garder l'oeil ouvert.
L'hon. Paul Martin (ministre des Finances, Lib.):
Mme Nancy Karetak-Lindell (Nunavut, Lib.):
La deputee s'exprime en inuktitut: ]
L'hon. Jane Stewart (ministre des Affaires indiennes et du Nord canadien, Lib.):
En avril 1999, nous les accueillerons dans leurs postes.
L'AGENCE DE PROMOTION ECONOMIQUE DU CANADA ATLANTIQUE
M. Jim Pankiw (Saskatoon-Humboldt, Ref.):
Monsieur le President, je ne sais trop d'ou le depute tire ses chiffres.
M. Jean-Guy Chretien (Frontenac-Megantic, BQ):
On sait que les Americains contestent le prix du lait canadien destine a l'exportation.
C'est ce matin que l'Organisation mondiale du commerce entend la plainte americaine.
L'hon. Lyle Vanclief (ministre de l'Agriculture et de l'Agroalimentaire, Lib.):
Monsieur le President, oui, je confirme que nous defendrons l'industrie laitiere canadienne avec vigueur.
Nous avons defendu l'industrie avec vigueur et nous avons remporte notre cause.
Nous continuerons de defendre l'industrie laitiere avec la meme energie.
M. Peter Stoffer (Sackville-Eastern Shore, NPD):
Hier soir, les deux parties etaient tres pres d'une convention collective.
Que se passe-t-il?
L'hon. Alfonso Gagliano (ministre des Travaux publics et des Services gouvernementaux, Lib.):
Nous esperons qu'elles vont retourner a la table des negociations et conclure un accord.
M. Gilles Bernier (Tobique-Mactaquac, PC):
L'hon. Pierre S. Pettigrew (ministre du Developpement des ressources humaines, Lib.):
Monsieur le President, nous avons etudie la situation tres soigneusement.
La plupart des cheques emis par mon ministere sont envoyes par la poste.
Ce sont les dispositions que nous avons prises.
M. Stan Dromisky (Thunder Bay-Atikokan, Lib.):
Monsieur le President, ma question s'adresse au ministre des Affaires etrangeres.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Monsieur le President, je remercie le depute de sa question opportune.
Cela temoigne de progres reels dans le cadre d'une mission constructive.
M. Peter Goldring (Edmonton-Est, Ref.):
Le ministere des Anciens combattants verse une indemnite juste aux anciens combattants de Hong Kong.
LE MINISTERE DE LA CITOYENNETE ET DE L'IMMIGRATION
M. Real Menard (Hochelaga-Maisonneuve, BQ):
L'hon. Lucienne Robillard (ministre de la Citoyennete et de l'Immigration, Lib.):
Chers collegues, cela met fin a la periode des questions orales.
Je vais les nommer un a un.
Voici les laureats du prix litteraire.
Je recevrai les laureats dans mes appartements apres la periode des questions.
M. Bill Blaikie (Winnipeg-Transcona, NPD):
Monsieur le President, j'invoque le Reglement.
Je remercie le depute pour cette information.
L'hon. Sheila Finestone (Mont-Royal, Lib.):
M. Paul Szabo (Mississauga-Sud, Lib.):
Monsieur le President, je voudrais presenter deux petitions.
La premiere concerne la famille.
M. Paul Szabo (Mississauga-Sud, Lib.):
M. Chuck Strahl (Fraser Valley, Ref.):
Monsieur le President, j'ai plusieurs petitions a presenter a la Chambre.
La premiere, longue de 12 pages, est signee par plus de 300 personnes.
Elle porte sur la definition du mariage.
M. Chuck Strahl (Fraser Valley, Ref.):
Elle porte sur l'age du consentement.
M. Chuck Strahl (Fraser Valley, Ref.):
Ils demandent qu'on les laisse faire leur travail.
M. Eric Lowther (Calgary-Centre, Ref.):
La petition que je presente maintenant fait etat de craintes semblables.
M. John Duncan (Ile de Vancouver-Nord, Ref.):
Mme Louise Hardy (Yukon, NPD):
Monsieur le President, je vais presenter deux petitions.
La premiere vient d'habitants du Yukon.
Malheureusement, on ferme cette station car le ministre l'a juge inutile.
Les citoyens du Yukon s'opposent a cette decision.
Mme Louise Hardy (Yukon, NPD):
Nous reclamons l'abolition du recours a la provocation comme moyen de defense.
Je presente cette petition au nom d'habitants du Yukon et de l'Alberta.
Mme Judy Wasylycia-Leis (Winnipeg-Centre-Nord, NPD):
Monsieur le President, je suggere que toutes les questions soient reservees.
LA LOI SUR LA COMMISSION CANADIENNE DU BLE
Les autres motions sont regroupees pour les fins du debat de la facon suivante:
Les motions nos 2, 31 et 41.
Les motions nos 4 a 19.
Les motions nos 20 a 30, 32, 33, 34, 45 et 47.
Les motions nos 35 a 40.
Les modalites de mise aux voix de chacun des groupes sont disponibles au bureau.
Je vais maintenant mettre la motion no 1 en deliberation.
La Chambre a entendu la motion.
Plait-il a la Chambre d'adopter la motion?
M. Jay Hill (Prince George-Peace River, Ref.):
La Chambre a entendu la proposition du depute de Prince George-Peace River.
La Chambre accorde-t-elle son consentement unanime au remplacement de la motion?
Est-ce d'accord?
Attendu: que l'agriculture est la pierre d'assise de l'economie canadienne;
qu'il est necessaire d'etablir un organisme charge de coordonner ce commerce;
Nous representons un nombre important de citoyens.
Les amendements que nous proposons sont importants et meritent d'etre consideres serieusement.
C'est grave, car nous avons besoin de participer a l'elaboration des lois.
J'espere que la situation changera.
Je propose sept amendements pour pallier aux carences du projet de loi.
Ces amendements amelioreraient la Loi sur la commission canadienne du ble.
D'ailleurs, toutes les lois devraient prevoir des disposition de temporarisation.
Je vais maintenant dire un mot du preambule.
J'ai propose la motion No 1 pour corriger une grave omission.
La Loi sur la Commission canadienne du ble ne comporte aucun preambule.
Si une loi du Parlement a besoin d'un preambule, c'est bien celle-ci.
Cela devrait etre evident.
L'agriculture est la pierre d'assise de l'economie canadienne.
Il est necessaire d'organiser et de coordonner ce commerce.
Y a-t-il quelqu'un a la Chambre qui puisse contester cet objectif?
Je vous cite ce qu'a dit le ministre.
Si tel est le cas, nous devrions l'exprimer par ecrit.
Ce sont la beaucoup plus que de pieuses declarations d'intention.
C'est une grave lacune qu'il n'y en ait pas.
Voici comment doit s'enoncer ce preambule:
Attendu que l'agriculture est la pierre d'assise de l'economie canadienne;
Attendu qu'il est necessaire d'etablir un organisme charge de coordonner ce commerce;
Les amendements que j'ai proposes visent a proteger tous les agriculteurs.
Le gouvernement ne cesse de pretendre qu'il ecoute la majorite des agriculteurs.
Les deputes de ce cote-ci de la Chambre representent un nombre appreciable de producteurs.
J'exhorte le gouvernement a preter attention a nos amendements.
Ils sont pleins de bon sens, raisonnables, et meritent examen.
Le gouvernement ne fait meme pas attention a nos amendements.
Il demande pourquoi donner des ressources.
Il faut que cette attitude change.
Ces amendements sont raisonnables et repondent aux preoccupations des producteurs que nous representons.
M. Gerry Byrne (secretaire parlementaire du ministre des Ressources naturelles, Lib.):
Il constitue un element central de la reglementation de ce secteur d'activite.
C'est pourquoi je suis tres fier d'appuyer ce projet de loi.
C'est essentiellement la question que nous debattons aujourd'hui.
A mon avis, voila la forme d'administration dont devrait etre assorti un processus democratique.
Nous accomplissons ainsi exactement ce que souhaitent les producteurs.
C'est un tres bon comite.
Ils critiquent aussi la possibilite donnee aux producteurs de participer au processus.
Par consequent, je n'appuie pas la proposition d'amendement.
M. Garry Breitkreuz (Yorkton-Melville, Ref.):
Il y en aura peut-etre alors plusieurs.
M. Jean-Guy Chretien (Frontenac-Megantic, BQ):
Je vais vous dire pourquoi.
Cela n'a pas de sacre bon sens!
Le ministre responsable s'objecte.
Je ne peux comprendre pourquoi.
Pourtant, dans le projet de loi C-4, il y a des intentions genereuses.
Ca, c'est un bon pas.
Lorsque le gouvernement en poste etait bleu, c'etaient des conservateurs qui etaient nommes.
Alors, pourquoi avoir peur?
Non, je ne crois pas.
J'invite mes collegues du parti ministeriel a relire le preambule propose ici.
La Commission canadienne du ble devrait egalement repondre de son rendement, de son travail.
M. Dick Proctor (Palliser, NPD):
Les amendements ont ete liquides en une seule seance.
Je ne suis pas d'accord.
C'est ce que fait la motion dont nous sommes saisis.
Pareilles declarations de mission et de vision sont tres en vogue de nos jours.
Des societes et d'autres entites font des declarations semblables.
M. Rick Borotsik (Brandon-Souris, PC):
Il voulait entendre leurs commentaires.
Il voulait s'assurer que leurs commentaires seraient integres dans cette mesure legislative.
Je vais donner a la Chambre deux exemples.
Au comite, j'ai propose une motion pour que le ministre revienne devant le comite.
J'aurais aime entendre ce que ces gens avaient a dire.
Je viens d'un endroit que l'on appelle la ville du ble.
Cette mesure legislative est tres importante.
Ce preambule dit essentiellement que la commission sera au service des producteurs.
Mon parti votera en faveur de la motion no 1.
Je ne vois pas pourquoi le gouvernement s'y opposerait.
M. Jay Hill (Prince George-Peace River, Ref.):
Ces amendements ont ete regroupes d'une maniere bien bizarre.
Voici ce que dit en partie la motion:
Il etablit le ton de tout le projet de loi.
Tous les partis considerent qu'il s'agit la d'un preambule tres important.
Par-dessus tout, nous voulons qu'elle soit comptable envers les producteurs.
Or, il n'y a rien a cet effet dans le projet de loi.
Cela n'a tout simplement pas ete le cas.
Je suis tout a fait d'accord avec cette evaluation.
Le projet de loi ne reglera pas les besoins des agriculteurs de l'ouest canadien.
M. Wayne Easter (secretaire parlementaire du ministre des Peches et des Oceans, Lib.):
Madame la Presidente, je dois m'opposer a cet amendement visant le preambule.
Telle est leur vraie strategie.
Mettons-la sur le tapis et appelons un chat un chat.
Il a parle de ces nominations de maniere assez critique.
Quelle est vraiment sa valeur du point de vue juridique?
D'habitude, on utilise le terme attendu dans les resolutions d'un congres politique.
Le profil d'entreprise dit ceci:
Voila ce que dit l'actuel profil d'entreprise.
Inutile de le repeter dans le preambule du projet de loi.
Nous prevoyons que la nouvelle commission pourra faire des choses semblables.
C'est a ca que jouent les reformistes.
Combien d'avocats y a-t-il dans votre camp?
Je pensais que vous essayiez de representer les producteurs, pas les avocats.
La presidente suppleante (Mme Thibeault):
Je demande au depute de s'adresser a la presidence.
Nous avons tenu des audiences.
Mme Helene Alarie (Louis-Hebert, BQ):
Madame la Presidente, je serai relativement breve, tout etant relatif en cette Chambre.
M. Darrel Stinson (Okanagan-Shuswap, Ref.):
Madame la Presidente, j'invoque le Reglement.
Je crois qu'il n'y a pas quorum.
La presidente suppleante (Mme Thibeault):
Nous compterons les deputes et vous informerons du resultat.
Apres l'appel du timbre:
La presidente suppleante (Mme Thibeault):
Je vois que nous avons le quorum.
M. Jake E. Hoeppner (Portage-Lisgar, Ref.):
Il connait sans doute quelqu'un a Winkler, au Manitoba.
L'un d'eux m'a demande d'appuyer la Commission canadienne du ble.
Il voulais que je m'assure du maintien de la commission du ble.
Il ne lui avait pas vendu de grain.
Je sais maintenant pourquoi il souhaite conserver la Commission canadienne du ble.
Il veut que les prix des grains de provende restent bas.
Voila l'appui que peut trouver la Commission du ble.
Elle a les approvisionnements qu'elle peut livrer.
Le grain a ete vendu a de bons prix.
Pourquoi les grains commercialises par la Commission se trouvent-ils dans des compartiments?
Il n'y a pas d'argent pour cela.
Le depute de Malpeque a parle ensuite de ceux qui enfreignent la loi.
J'aimerais qu'il explique quelles lois ont ete enfreintes.
Est-ce un crime de tacher d'obtenir le meilleur prix pour son grain?
Ils ne veulent pas qu'on vende le grain au meilleur prix.
Pourquoi n'a-t-on jamais inclus un preambule dans la loi?
J'aimerais qu'on me l'explique.
Nous ne sommes pas tous des avocats.
Ils sont rares de ce cote.
Cela me semble ridicule.
Les propos de la deputee du Bloc quebecois m'ont impressionne.
Nous avons toujours ete consideres comme des separatistes.
Les deputes reformistes sont des separatistes.
Pourquoi adopterait-on une mesure legislative qui divisera le pays?
Qu'y a-t-il a dire a ce sujet?
Que repondra le depute de l'Ontario?
Tous les membres siegeant a sa commission du ble sont elus.
En quoi le Manitoba, l'Alberta et la Saskatchewan different-ils de l'Ontario?
C'est ce qu'il faudrait faire.
Pourquoi creer encore une difference?
Je demande une explication.
Je ne vois pas cette explication dans le libelle du projet de loi.
Il fera plus de tort que de bien.
Ce depute de l'opposition s'interesse a l'agriculture.
Il sait de quoi il parle.
Il ne parle pas a tort et a travers.
J'ai ete heureux de dire ces quelques mots.
J'invite les deputes liberaux a rester a la Chambre et a ecouter le debat.
Je constate qu'ils sont encore disparus.
M. Darrel Stinson (Okanagan-Shuswap, Ref.):
Madame la Presidente, j'invoque le Reglement.
Je demande qu'on verifie s'il y a quorum.
La presidente suppleante (Mme Thibeault):
Le depute d'Okanagan-Shuswap demande s'il y a quorum.
Apres l'appel du timbre:
M. Gerry Byrne (secretaire parlementaire du ministre des Ressources naturelles, Lib.):
Voulez-vous en discuter?
M. Charlie Penson (Peace River, Ref.):
La partie qui m'interesse est celle ou il est dit ceci:
Pourquoi vouloir un tel preambule au projet de loi?
C'est une position qu'elle a toujours maintenue devant les tribunaux.
Lorsque la commission s'adresse aux agriculteurs, toutefois, elle dit tout le contraire.
Il ne peut y avoir de partenariat sans obligation de rendre compte.
Info Cereales , mai-juin 1996.
C'est exactement ce que le tribunal a statue.
Et c'est exactement ce qui est arrive.
Il ne traite aucunement de comptes a rendre aux agriculteurs.
C'est-a-dire, essentiellement, ce qui est enonce a l'article 5.
Rien n'est change dans la loi.
Deux tiers des administrateurs de la commission sont des agriculteurs.
Madame la Presidente, notre vis-a-vis, le depute de Malpeque, fait du bruit.
Ils souhaitent un double systeme de commercialisation.
Ils ne veulent pas etre assujettis a ce monopole.
Le projet de loi ne prevoit aucune obligation de rendre compte.
Nous avons un regime...
M. John Bryden (Wentworth-Burlington, Lib.):
Madame la Presidente, j'invoque le Reglement.
Je ne suis pas avocat.
La presidente suppleante (Mme Thibeault):
Il ne s'agit pas d'un rappel au Reglement.
Madame la Presidente, je constate que la verite blesse.
Je pense que, moralement, ils ne sont pas habilites a le faire.
Ils veulent meme nous refuser cela.
C'est inacceptable, et ils devront payer pour cela.
DEMANDE DE DEBAT D'URGENCE
M. Jim Gouk (West Kootenay-Okanagan, Ref.):
Madame la Presidente, j'invoque le Reglement.
Cela entraine de graves problemes economiques.
La presidente suppleante (Mme Thibeault):
Il y a une demarche a suivre dans de tels cas.
Y a-t-il consentement unanime de la Chambre?
La presidente suppleante (Mme Thibeault):
LA LOI SUR LA COMMISSION CANADIENNE DU BLE
M. Ghislain Lebel (Chambly, BQ):
Attendu: que l'agriculture est la pierre d'assise de l'economie canadienne;
qu'il est necessaire d'etablir un organisme charge de coordonner ce commerce;
Ce n'est pas la premiere fois qu'on parle de preambule.
Il y avait un preambule dans lequel on avait inscrit le Quebec comme societe distincte.
C'est drole, le preambule ne voulait rien dire a ce moment-la.
D'autres disaient: Non, ca irait a la fin.
Mais cela ne vient pas de nous.
J'etais assis et je n'ai rien dit.
Le bon sens peut surgir d'un peu partout.
Je disais de Malpeque, mais il surgit parfois aussi de l'Ouest canadien.
Je pense que ces gens-la ont tout a fait raison.
On ne peut esperer plus.
M. John Bryden (Wentworth-Burlington, Lib.):
C'est vrai que je viens du centre de l'Ontario...
Le hansard rendra compte de ce commentaire.
Je rejette cette notion, comme la majorite des Canadiens, je pense.
Qu'est-ce que ca donne?
Qu'est-ce que ca donnera a un juge?
Est-ce vraiment important?
Est-ce que ca peut influencer l'interpretation de la loi?
Il n'y a rien de contraignant la-dedans pour les juges.
Mes collegues d'en face peuvent le verifier.
Les avocats l'appellent la clause des voeux pieux.
Elle ne contient rien de contraignant quant a ce que les juges doivent faire.
C'est a partir du mot edicte que les juges vont lire la loi.
L'expression repondre aux agriculteurs parait noble.
Il est question d'etablir un organe gouvernemental federal.
Nous n'etablissons pas un organe provincial.
Nous ne constituons pas un syndicat d'agriculteurs.
Ce qu'ils proposent, ce sont des syndicats.
Ce parti ne veut pas que l'on gouverne a Ottawa.
Il ne veut pas que l'on gouverne dans les provinces.
C'est une formule qui menera immanquablement a une catastrophe pour le pays.
Le ministre a juge bon d'etablir une commission qui comprend des agriculteurs.
Voila ou doit se situer le debat.
Le president suppleant (M. McClelland):
L'honorable depute de Vegreville-Lakeland.
M. Leon E. Benoit (Lakeland, Ref.):
Monsieur le President, vous avez gache mon plaisir.
Je me faisais une joie de pouvoir vous corriger sur ce point.
Nous avons demande des eclaircissements.
Nous en avons aussi suggere.
Nous aurions un projet de loi clair.
Malheureusement, ce n'est pas le cas, c'est pourquoi nous discutons du preambule.
L'article 5 dit que la commission existe pour le gouvernement du Canada.
Le gouvernement a refuse net d'accepter ce changement.
Je trouve cela irritant.
Nous savons qu'elle finira par etre adoptee.
J'entends le depute de Malpeque qui crie encore de l'autre cote.
Je crois que c'est intolerable.
Retournons a l'amendement que nous debattons.
Je vais remonter au debut du siecle.
Pour commercialiser le grain produit par nos agriculteurs, une serie de cooperatives virent le jour.
Ils avaient pour objectif de faire le maximum de benefices pour les producteurs.
Leur objectif etaient legerement different.
Cette premiere version n'etait pas un monopole.
L'une des pierres angulaires des syndicats etaient que les agriculteurs avaient le choix.
Mitchell Sharp notamment a remis cela en question.
Il est evident que c'etait le mandat de la commission.
C'est tellement vrai.
Apres la guerre, on a maintenu le monopole pendant cinq ans.
Cela a coute aux agriculteurs canadiens des centaines de millions de dollars.
Pourtant, le fardeau n'etait pas reparti entre tous.
C'est pourquoi ce preambule est si important.
Il ne suffit pas.
Ce projet de loi ne fait rien en ce sens.
Il ne s'agit pas de savoir si on doit conserver la commission ou pas.
Une grande majorite d'agriculteurs de l'Ouest veulent de la commission.
Cependant, ils ne veulent pas de monopole.
C'est la le debat.
Ces sondages ont ete deposes au comite et on peut se les procurer.
Les preuves sont la.
M. Ken Epp (Elk Island, Ref.):
Il s'apercoit tres vite que l'un des problemes est la salle de billards.
Ca commence avec le pouvoir.
Un mot qui commence par la lettre p , comme le mot probleme.
Permettez-moi d'elaborer.
Un liberal de l'autre cote a dit que le preambule n'avait aucune importance.
Je ne suis pas d'accord.
Permettez-moi de faire une petite digression.
Il vaudrait mieux laisser le ministre le nommer.
Les deputes veulent-ils savoir ce que je pense?
Voila a quoi ressemblerait leur preambule.
Ce preambule dirait que la commission existe pour les agriculteurs.
Les liberaux persistent a dire que cette commission est la meilleure solution possible.
Qu'ils laissent le choix aux agriculteurs.
Je vous pose la question, monsieur le President.
Je crois que vous avez une certaine experience du monde des affaires.
Un agriculteur peut vendre et acheter du grain fourrager independamment de la commission.
C'est parfaitement ridicule.
La Commission du ble doit avoir une raison d'etre.
Pourquoi devrait-il y avoir une commission du ble sans raison d'etre explicite?
Actuellement, la concurrence est vive dans le secteur agricole.
Mon frere exploite une terre ou j'ai travaille lorsque j'etais enfant.
Si la Commission du ble fait son travail, elle aura du pain sur la planche.
Cela ne fait pas l'ombre d'un doute.
C'est ainsi que cela fonctionne.
Je mets les liberaux au defi.
Il y en a certainement deux ou trois qui peuvent reflechir par eux-memes.
Personnellement, j'estime que c'est presque un droit fondamental.
A qui appartiennent ces cereales?
Qui a prepare le sol?
Qui a paye les taxes?
Qui a paye le carburant?
Qui a paye les engrais?
Qui a paye les tracteurs et la machinerie?
Qui a travaille 18 heures par jour?
Qui a prie pour avoir de la pluie?
Qui a prie pour eloigner les nuees de sauterelles?
Je veux tres serieusement en appeler a mes vis-a-vis.
Puissent-ils se servir de leur tete.
Puissent-ils faire preuve d'independance de jugement et voter pour ce qui est bien.
M. Rick Casson (Lethbridge, Ref.):
Je ne peux imaginer meilleur sujet pour ma premiere intervention.
J'espere ne pas les decevoir.
Je dois dire que c'est un sujet qui suscite beaucoup de division.
Ils ne peuvent plus tolerer qu'elle ne leur rende pas de comptes.
Nous sommes apparemment dans une impasse.
Pourquoi a-t-il choisi de ne pas le faire?
Il ne suffit pas que le gouvernement change le numero pour changer les choses.
Voila ce que ce projet de loi devrait offrir-un rendement maximal pour le producteur.
Il pourrait apprendre quelque chose et inclure certaines des pratiques dans son projet de loi.
Imaginez un peu que les producteurs de grains gerent leur exploitation comme le gouvernement.
Si seulement le gouvernement pouvait avoir une comptabilite aussi serree que les producteurs.
Pourquoi le gouvernement craint-il autant de proposer des options aux producteurs?
Ou est la transparence que les producteurs demandent?
Ce fait en soi sonne l'alarme aupres des groupes de producteurs partout au Canada.
Comment les dirigeants peuvent-ils agir librement, s'ils sont tenus au secret?
Pourquoi le gouvernement liberal ne joue-t-il pas franc jeu?
Mme Diane St-Jacques (Shefford, PC) propose:
Premierement, laissez-moi vous exposer les raisons qui m'ont amenee a deposer cette motion.
Mais il y a une ombre au tableau.
Le probleme est serieux.
Il y a, aujourd'hui, pres d'un million et demi d'enfants pauvres.
Cette entente non devoilee porte deja un nom, soit le Cadre de reinvestissement.
Pourquoi le Cadre de reinvestissement?
Si des enfants sont pauvres, c'est parce que leurs parents le sont aussi.
Citons certains extraits du rapport La securite sociale dans le Canada de demain.
On peut y lire a quel point la famille canadienne et ses besoins changent.
Aujourd'hui, on a moins de deux enfants et les deux parents travaillent.
La famille change, et les mesures pour les soutenir doivent, elles aussi, changer.
Les changements a apporter sont multiples.
Il y a la necessite d'assurer des services de garde d'enfants de qualite.
On doit rendre aussi plus accessible le support a la garde d'enfants handicapes.
On doit egalement regarder du cote des programmes d'action communautaire pour les enfants.
Il y a egalement les prestations parentales ou de grossesse de l'assurance-emploi.
Comment ces enfants peuvent-ils performer a l'ecole?
Un million et demi, un enfant sur quatre.
Finalement, nous y revenons, il y a la prestation federale bonifiee et elargie.
Or, gouverner, c'est choisir.
Au Canada, ca n'a pas de sens.
Et il a raison.
La marge de manoeuvre du Quebec, par exemple, augmentera de 150 millions par annee.
Tout cela, parce qu'on ne protege pas la prestation pour enfants.
Tout cela, parce qu'on n'indexe que partiellement la prestation.
Les enfants sont a la remorque du bon vouloir des gouvernements.
On ne fait que du rattrapage.
Il faut leur donner les moyens de suivre le cout de la vie.
Nous nous dirigions vers un cul-de-sac financier.
La bonne decision devait etre celle-la.
Nous devons maintenant faire des choix de societe.
Il faudrait maintenant y voir.
L'inflation fait grimper la valeur nominale du revenu familial.
Je vous demande donc d'en faire autant pour nos enfants.
Rappelons-nous que l'on doit etre justes dans nos perspectives d'avenir.
Aidons a fournir a nos enfants un milieu de developpement sain.
Redonnons au Canada son titre de champion de l'equite sociale.
M. Tony Valeri (secretaire parlementaire du ministre des Finances, Lib.):
Cette politique s'applique a l'ensemble du regime fiscal.
Etant donne ce cout potentiel, le gouvernement ne peut appuyer la motion.
M. Paul Crete (Kamouraska-Riviere-du-Loup-Temiscouata-Les Basques, BQ):
C'est d'ailleurs assez ironique.
Cette indexation partielle se vit de la facon suivante.
Presentement, il n'y en a aucune.
Plus ironique encore, rappelons que les liberaux ont continue dans le meme sens.
C'est l'actuel vice-premier ministre qui disait cela en fevrier 1992.
Ils ont decide de ne pas changer cette situation.
Donc, toutes les familles sont perdantes.
En 1984, on avait verse l'equivalent de 6,7 milliards pour cette politique familiale.
M. Tremblay disait: Les effets pervers se feront sentir graduellement.
Ces effets pervers se sont effectivement realises.
Mais ce n'est pas ce qu'on a vecu.
On parlait plus tot de 1,5 milliard de dollars.
Il y aura donc encore place a beaucoup d'amelioration.
Cela donnera, comme version finale de la motion:
Donc, je conclus la-dessus et je depose mon amendement.
Je crois que l'amendement est recevable.
Mme Diane Ablonczy (Calgary-Nose Hill, Ref.):
Le Bloc a propose un amendement pour que la prestation soit pleinement indexee.
C'est ce que la deputee de Shefford laisse entendre que nous devons examiner.
Cette desindexation partielle est maintenant en vigueur depuis 12 ans.
Cela revient en realite a une hausse annuelle d'impots automatique.
Ces hausses d'impots ne sont pas evidentes.
Les liberaux peuvent dire une chose et en faire une autre.
Il est tres facile pour eux de cacher cette hausse d'impot.
C'est comme le relevement des fourchettes d'imposition dont on entend parler sans cesse.
Cela revient au meme.
Qu'en est-il en realite?
Cette erosion du revenu familial net se poursuit de bien des facons.
La prestation pour enfants n'en est qu'un exemple.
Cette erosion se traduit par des impots de plus en plus eleves.
Et quelles promesses ont fait les liberaux pour etre elus?
Ils ont diminue de 3 000 $ le revenu familial.
Pas etonnant qu'il y ait de la pauvrete enfantine.
C'est logique: etant responsables de la situation, c'est a eux d'y remedier.
C'est tout a fait inacceptable.
J'espere que ce fait n'echappe a personne.
Pas etonnant qu'il y ait des enfants et des familles pauvres au pays.
Le gouvernement liberal ne fait qu'accroitre le taux d'impot.
C'est exactement ce qu'il est.
Son obsession est devenue maladive.
Il faut qu'il les augmente de plus en plus chaque annee.>
Le Parti reformiste dit simplement que trop c'est trop.
Cela couterait trop cher.
Il a besoin de notre argent.
Mme Judy Wasylycia-Leis (Winnipeg-Centre-Nord, NPD):
Elle prevoit un examen de l'indexation de la prestation pour enfants.
L'inflation rognera chaque annee une partie de ses gains.
Comment pourrons-nous reduire la pauvrete chez les enfants sans reduire le chomage?
Comment pouvons-nous remedier a la pauvrete chez les enfants?
Les chiffres sont eloquents.
Elle ne contribue qu'a faire regagner du terrain perdu.
Les enfants sont pauvres parce que leurs parents sont pauvres.
M. Alex Shepherd (Durham, Lib.):
Je la felicite d'avoir attire l'attention de la Chambre sur cette question.
Pour ma part, je voudrais aborder la question sous un angle different.
En fait, nous avons traverse une epoque inflationniste.
Je suis d'avis que cela a provoque une spirale inflationniste.
Le gouvernement s'inquiete de la pauvrete enfantine.
Il y a moyen de mesurer si la lutte contre la malnutrition enfantine progresse.
Il faut beaucoup de temps, d'efforts et de devouement.
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
Monsieur le President, il est tres agreable de vous voir au fauteuil ce soir.
Cette responsabilite incombe a la ministre elle-meme.
Je repeterai aujourd'hui ce que j'ai deja dit.
Je tiens a proposer deux ou trois choses dans le temps qui m'est imparti.
Ce sont des statistiques scandaleuses.
Il est temps d'agir et il faut agir vite.
Rien n'a encore ete fait.
J'estime que le gouvernement peut prendre aujourd'hui des mesures concretes.
Cela contribuerait certainement a bien montrer la gravite de l'infraction.
Le gouvernement doit faire preuve de leadership a cet egard.
La population canadienne s'est exprimee tres clairement.
Il a ete abondamment question de ce sujet a la Chambre.
La ministre en discutera d'ailleurs avec ses homologues provinciaux.
Des statistiques recentes, provenant du Centre canadien de la statistique juridique, ont ete diffusees hier.
La ministre tient enormement a trouver des solutions a ce probleme.
M. Jean-Guy Chretien (Frontenac-Megantic, BQ):
Mme Louise Harel du Quebec est d'accord.
M. Jean Dupere, president de Lab Chrysotile, est d'accord.
Seul notre ministre du Developpement des ressources humaines a Ottawa s'obstine.
C'est la deroute totale au ministere.
Il n'etait offert que dans certaines provinces.
Les provinces empruntaient egalement cette direction.
L'employeur a toujours montre sa volonte d'aider les travailleurs.
La motion portant que la Chambre s'ajourne maintenant est reputee adoptee.
(La seance est levee a 18 h 44.)

ext: f


text:
! ====================================================================
!
! This file provides the various querying methods by which users can
! query the coalescence object
!
!
! Written by CMJ, XCP-3 (03/2019)
!
! ====================================================================

  function properlyConstructedObject(coalesObj) result(constructed)

! ====================================================================
!
! Returns if the class is constructed or not
!
! ====================================================================

    implicit none
    class(Coalescence), intent(in   ) :: coalesObj
    logical :: constructed

! ====================================================================

    constructed = coalesObj%constructed

    return
! ====================================================================
  end function properlyConstructedObject

  function queryOptions(coalesObj) result(options)

! ====================================================================
!
! Returns the options of the class
!
! ====================================================================

    implicit none
    class(Coalescence), intent(in   ) :: coalesObj
    type(coalescenceOptions) :: options

! ====================================================================

    options = coalesObj%options

    return
! ====================================================================
  end function queryOptions

  function queryData(coalesObj) result(dataObj)

! ====================================================================
!
! Returns the data object of the class
!
! ====================================================================

    implicit none
    class(Coalescence), intent(in   ) :: coalesObj
    type(CoalescenceData) :: dataObj

! ====================================================================

    dataObj = coalesObj%data

    return
! ====================================================================
  end function

max_stars_repo_name: lanl/generalized-spallation-model

max_stars_repo_licenses: Intel Unlicense

max_issues_repo_name: lanl/generalized-spallation-model

max_issues_repo_licenses: Intel Unlicense

max_forks_repo_name: lanl/generalized-spallation-model

max_forks_repo_licenses: Intel Unlicense


! { dg-do compile }
! { dg-options "-std=f95" }

  integer :: i, j, k
  integer(kind=8) :: i8, j8, k8
  real :: x
  double precision :: z

  call system_clock(i, j, k)
  call system_clock(i, j, k8) ! { dg-error "has non-default kind" }
  call system_clock(i, j8, k) ! { dg-error "has non-default kind" }
  call system_clock(i8, j, k) ! { dg-error "has non-default kind" }

  call system_clock(i, x, k) ! { dg-error "Real COUNT_RATE argument" }

  call system_clock(i, z, k) ! { dg-error "Real COUNT_RATE argument" }

  end


text:
Describe Users/islandboy12 here.

20080705 15:10:22 nbsp  Welcome to the Wiki. Please consider the importance of using your RealName. Users/JasonAller

20080705 15:15:52 nbsp You seem to dislike more places than you like (according to your recent reviews). Users/SunjeetBaadkar

20081007 14:09:50 nbsp This place is very very clean especially Kitchen  Users/Brians

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
      SUBROUTINE PSTRQ2 (NTYPE)
C THIS ROUTINE CALCULATES PHASE II OUTPUT FOR PLA3
C
C     NTYPE = 1 TRI-MEMBRANE
C     NTYPE = 2 QUAD-MEMBRANE
C
C     PH1OUT CONTAINS THE FOLLOWING
C     *** NTYPE = 1 ***
C     ELEMENT ID
C     3 SILS
C     5 DUMMY-S
C     3 S ARRAYS EACH 3X3
C
C     *** NTYPE = 2 ***
C     ELEMENT ID
C     4 SILS
C     4 DUMMY-S
C     4 S ARRAYS EACH 3X3
C
      DIMENSION NSIL(4), SI(36)
C
      COMMON /PLA3UV/ IVEC, Z(24)
      COMMON /PLA3ES/ PH1OUT(300)
      COMMON /PLA32S/ STRESS(3),VEC(3),TEMP,DELTA,NSIZE,NPOINT,
     1   DUM(315)
      COMMON /SOUT/  STRES(9)
C
      EQUIVALENCE
     1            (NSIL(1),PH1OUT(2))
     2,           (SI(1),PH1OUT(10))
C
C
C                        I=NSIZE
C     STRESS VECTOR = (SUMMATION  (S ) (U ))
C                        I=1        I    I
C
      NSIZE = NTYPE + 2
      DO 20 I = 1,NSIZE
C     POINTER TO DISPLACEMENT VECTOR
      NPOINT = IVEC + NSIL(I) -1
C
      CALL GMMATS( SI(9*I-8),3,3,0,  Z(NPOINT),3,1,0, VEC(1))
C
      DO 30 J=1,3
   30 STRESS(J) = STRESS(J) + VEC(J)
   20 CONTINUE
C
      STRES(1) = PH1OUT(1)
      STRES(2) = STRESS(1)
      STRES(3) = STRESS(2)
      STRES(4) = STRESS(3)
C
C     ******************************************************************
C
C     PRINCIPAL STRESSES AND ANGLE OF ACTION PHI
      TEMP = STRES(2) - STRES(3)
      STRES(8) = SQRT( (TEMP/2.0E0)**2 + STRES(4)**2 )
      DELTA = (STRES(2) + STRES(3))/2.0E0
      STRES(6) = DELTA + STRES(8)
      STRES(7) = DELTA - STRES(8)
      DELTA = 2.0E0 * STRES(4)
      IF( ABS(DELTA) .LT. 1.0E-15 .AND. ABS(TEMP) .LT. 1.0E-15)GO TO 101
      STRES(5) = ATAN2( DELTA,TEMP ) * 28.6478898 E00
      RETURN
  101 STRES(5) = 0.0E0
      RETURN
      END


!------------------------------------------------------------*- Fortran -*-----
!
!                              S E R I A L B O X
!
! This file is distributed under terms of BSD license.
! See LICENSE.txt for more information.
!
!------------------------------------------------------------------------------

PROGRAM main_consumer
  USE m_ser
  IMPLICIT NONE
  REAL(KIND=8), DIMENSION(5,5,5) :: a

  a = 0.0
  PRINT*,'Before read from serializer: sum(a)=', sum(a)
  CALL deserialize(a)
  PRINT*,'After read from serializer: sum(a)=', sum(a)
END PROGRAM main_consumer


text:
!> @brief Module that contains subroutines and functions to sample various energy distributions.
MODULE korc_energy_pdfs
  USE korc_types
  USE korc_constants
  USE korc_HDF5
  USE korc_hpc
  USE korc_input

  IMPLICIT NONE

  !> @brief KORC derived type that contains information about a given Gamma distribution function @f$f_\Gamma(x,\kappa,\theta)@f$.
  !! @details We write a given Gamma distribution function in terms of its shape factor @f$\kappa@f$ and scale factor
  !! @f$\theta@f$, so that:
  !!
  !!
  !! @f$f_\Gamma(x,\kappa,\theta) = \frac{1}{\Gamma(\kappa) \theta^\kappa}x^{\kappa-1}\exp{\left(-x/\theta\right)}@f$.
  TYPE, PRIVATE :: GAMMA_PARAMS
     REAL(rp) :: min_energy !< Minimum energy of sampled @f$f_\Gamma(x,\kappa,\theta)@f$ in MeV.
     REAL(rp) :: max_energy !< Maximum energy of sampled @f$f_\Gamma(x,\kappa,\theta)@f$ in MeV.
     REAL(rp) :: min_p !< Minimum momentum of sampled @f$f_\Gamma(x,\kappa,\theta)@f$.
     REAL(rp) :: max_p !< Maximum momentum of sampled @f$f_\Gamma(x,\kappa,\theta)@f$.
     REAL(rp) :: k !< Shape factor @f$\kappa@f$.
     REAL(rp) :: t !< Scale factor @f$\theta@f$.
  END TYPE GAMMA_PARAMS

  TYPE(GAMMA_PARAMS), PRIVATE 	:: gamma_pdf_params !< An instance of the KORC derived type GAMMA_PARAMS
  REAL(rp), PRIVATE, PARAMETER 	:: co = (C_E*1.0E6)/(C_ME*C_C**2) !< Constant with units to transform @f$\mathcal{E}@f$ in
  !! @f$f_\Gamma(\mathcal{E},\kappa,\theta)@f$ from MeV to Joules.
  REAL(rp), PRIVATE, PARAMETER 	:: minmax_buffer_size = 10.0_rp !< This is the size of the buffer zone in each direction when
  !!using a Metropolis-Hastings method to sample a distribution.

  PUBLIC 	:: get_gamma_distribution
  PRIVATE :: initialize_gamma_params,&
       save_gamma_params,&
       sample_gamma_distribution,&
       deg2rad,&
       fRE,&
       random_norm,&
       fGamma

CONTAINS

  !> @brief Subroutine that contains calls to subroutine to generate a gamma distribution for the energy distribution of a given
  !! species in the simulation.
  !!
  !! @param[in] params Core KORC simulation parameters.
  !! @param[in,out] g Relativistic gamma factor @f$\gamma@f$ of the particles in a given species in the simulation. These are so that, they follow
  !! a Gamma distribution in energy. The parameters of the Gamma distributions are given by the user.
  !! @param[out] go Mean value of @f$\gamma@f$ of the particles in a given species. used to calculate the minimum required time step to
  !! resolve in detail the full-orbit dynamics of the particles.
  SUBROUTINE get_gamma_distribution(params,g,go)
    TYPE(KORC_PARAMS), INTENT(IN) 						:: params
    REAL(rp), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) 	:: g
    REAL(rp), INTENT(OUT) 								:: go

    call initialize_gamma_params(params)

    call save_gamma_params(params)

    call sample_gamma_distribution(params,g,go)
  END SUBROUTINE get_gamma_distribution

  !> @brief Subroutine that reads from the input file the parameters of the Gamma distribution
  !! @f$f_\Gamma(x,\kappa,\theta) = \frac{1}{\Gamma(\kappa) \theta^\kappa}x^{\kappa-1}\exp{\left(-x/\theta\right)}@f$.
  !!
  !! @param[in] params Core KORC simulation parameters.
  !! @param max_energy Maximum energy of sampled @f$f_\Gamma(x,\kappa,\theta)@f$ in MeV.
  !! @param min_energy Minimum energy of sampled @f$f_\Gamma(x,\kappa,\theta)@f$ in MeV.
  !! @param k Shape factor @f$\kappa@f$.
  !! @param t Scale factor @f$\theta@f$.
  SUBROUTINE initialize_gamma_params(params)
    TYPE(KORC_PARAMS), INTENT(IN) 	:: params
    REAL(rp) 						:: max_energy
    REAL(rp) 						:: min_energy
    REAL(rp) 						:: k
    REAL(rp) 						:: t

    !NAMELIST /EnergyGammaPDF/ max_energy,min_energy,k,t

    !open(unit=default_unit_open,file=TRIM(params%path_to_inputs),status='OLD',form='formatted')
    !read(default_unit_open,nml=EnergyGammaPDF)
    !close(default_unit_open)

    gamma_pdf_params%min_energy = min_energy_gamma*C_E ! In Joules
    gamma_pdf_params%max_energy = max_energy_gamma*C_E ! In Joules
    gamma_pdf_params%k = k_gamma
    gamma_pdf_params%t = t_gamma

    gamma_pdf_params%max_p = SQRT((gamma_pdf_params%max_energy/(C_ME*C_C**2))**2 - 1.0_rp) ! In units of mc
    gamma_pdf_params%min_p = SQRT((gamma_pdf_params%min_energy/(C_ME*C_C**2))**2 - 1.0_rp) ! In units of mc
  END SUBROUTINE initialize_gamma_params

  !> @brief Function that converts @f$x@f$ from degrees to radians.
  !!
  !! @param x Angle @f$x@f$ in degrees.
  !! @param deg2rad Angle @f$x@f$ converted to radians.
  FUNCTION deg2rad(x)
    REAL(rp), INTENT(IN) 	:: x
    REAL(rp) 				:: deg2rad

    deg2rad = C_PI*x/180.0_rp
  END FUNCTION deg2rad

  !> @brief Function that calculates the value of the Gamma distribution @f$f_\Gamma(x,\kappa,\theta) =
  !! \frac{1}{\Gamma(\kappa) \theta^\kappa}x^{\kappa-1}\exp{\left(-x/\theta\right)}@f$.
  !!
  !! @param x Variable @f$x@f$ of @f$f_\Gamma(x,\kappa,\theta)@f$.
  !! @param k Shape factor @f$\kappa@f$ of @f$f_\Gamma(x,\kappa,\theta)@f$.
  !! @param t Scale factor @f$\theta@f$ of @f$f_\Gamma(x,\kappa,\theta)@f$.
  !! @param fGamma Computed value of @f$f_\Gamma(x,\kappa,\theta)@f$.
  FUNCTION fGamma(x,k,t)
    REAL(rp), INTENT(IN) 	:: x
    REAL(rp), INTENT(IN) 	:: k
    REAL(rp), INTENT(IN) 	:: t
    REAL(rp)				:: fGamma

    fGamma = x**(k - 1.0_rp)*EXP(-x/t)/(GAMMA(k)*t**k)
  END FUNCTION fGamma

  !> Evaluation of the energy distribution function @f$f_{RE}(\mathcal{E})@f$ of runaway electrons as function of the normalized momentum
  !! @f$p' = p/m_ec@f$. Here, @f$p'@f$ is the normalized momentum and @f$m_e@f$ and @f$c@f$ are the electron mass and the speed of light.
  !!
  !! @param p Normalized momentum @f$p' = p/m_ec@f$ of a given electron in the simulation.
  !! @param fRE Computed value of the energy distribution function of runaway electrons.
  !! @param Eo Normalized energy @f$\mathcal{E}' = \sqrt{1 + p'}@f$ of the the electron with normalized momentum @f$p'@f$.
  FUNCTION fRE(p)
    REAL(rp), INTENT(IN) 	:: p ! momentum in units of mc
    REAL(rp) 				:: fRE
    REAL(rp) 				:: Eo ! In units of mc^2

    Eo = SQRT(p**2.0_rp + 1.0_rp)

    fRE = fGamma(Eo,gamma_pdf_params%k,gamma_pdf_params%t*co)
  END FUNCTION fRE

  !> @brief Gaussian random number generator.
  !! @details This function returns a deviate of a Gaussian distribution @f$f_G(x;\mu,\sigma) = \frac{1}{\sigma\sqrt{2\pi}} \exp{\left( -(x-\mu)^2/2\sigma^2 \right)}@f$,
  !! with mean @f$\mu@f$, and standard deviation @f$\sigma@f$.
  !!
  !! We use the Inverse Transform Sampling Method for sampling @f$x@f$. With this method we get @f$x = \sqrt{-2\log{(1-y)}}\cos(2\pi z)@f$,
  !! where @f$y@f$ and @f$z@f$ are uniform random numbers in the interval @f$[0,1]@f$.
  !!
  !! @param[in] mu Mean value @f$\mu@f$ of the Gaussian distribution.
  !! @param[in] mu Standard deviation @f$\sigma@f$ of the Gaussian distribution.
  !! @param random_norm Sampled number @f$x@f$ from the Gaussian distribution @f$f_G(x;\mu,\sigma)@f$.
  !! @param rand1 Uniform random number in the interval @f$[0,1]@f$.
  !! @param rand2 Uniform random number in the interval @f$[0,1]@f$.
  FUNCTION random_norm(mean,sigma)
    REAL(rp), INTENT(IN) 	:: mean
    REAL(rp), INTENT(IN) 	:: sigma
    REAL(rp) 				:: random_norm
    REAL(rp) 				:: rand1
    REAL(rp) 				:: rand2

    call RANDOM_NUMBER(rand1)
    call RANDOM_NUMBER(rand2)

    random_norm = SQRT(-2.0_rp*LOG(1.0_rp-rand1))*COS(2.0_rp*C_PI*rand2);
  END FUNCTION random_norm

  !> @brief Subroutine that samples a Gamma distribution representing the runaways' (marginal) energy distribution function.
  !! @details This subroutine uses the Metropolis-Hastings method for sampling the Gamma distribution representing the runaways'
  !! (marginal) energy distribution function. Unlike the typical Metropolis-Hasting method, after setting the boundaries of the region
  !! we want to sample, we perform a sampling in a larger region that contains the original sampling area plus a buffer region.
  !! After finishing the first sampling, we only keep the particles in the original sampling region, the particles in the p_buffer
  !! are sampled again until all of them lie within the original sampling region. This method ensures that the boundaries are
  !! well sampled.
  !!
  !! @param[in] params Core KORC simulation parameters.
  !! @param[in,out] g Relativistic gamma factor @f$\gamma@f$ of the particles in a given species in the simulation. These are so that,
  !! they follow a Gamma distribution in energy. The parameters of the Gamma distributions are given by the user.
  !! @param[out] go Mean value of @f$\gamma@f$ of the particles in a given species. used to calculate the minimum required time step to
  !! resolve in detail the full-orbit dynamics of the particles.
  !! @param p Sampled normalized momentum @f$p' = p/m_ec@f$ of particles in a given particle species.
  !! @param p_buffer Size along the momentum axis of the buffer used in the Metropolis-Hastings method.
  !! @param p_test The test value of the normalized momentum used in the Metropolis-Hastings method.
  !! @param ratio Ratio of probabilities used to determine when a move in during the sampling is kept as part of the sampled chain.
  !! @param rand_unif A deviate of a uniform random distribution in the interval @f$[0,1]@f$.
  !! @param p_samples Temporary array to keep the sampled normalized momentum.
  !! @param deta Step size along the pitch-angle direction of the random walk used in the Metropolis-Hastings sampling.
  !! @param dp  Step size along the momentum direction of the random walk used in the Metropolis-Hastings sampling.
  !! @param ii Iterator.
  !! @param ppp Number of particles per MPI processes.
  !! @param nsamples Number of total samples in the initial condition of a given simulation.
  !! @param mpierr MPI error status.
  SUBROUTINE sample_gamma_distribution(params,g,go)
    TYPE(KORC_PARAMS), INTENT(IN) 						:: params
    REAL(rp), DIMENSION(:), ALLOCATABLE, INTENT(INOUT) 	:: g
    REAL(rp), INTENT(OUT) 								:: go
    REAL(rp), DIMENSION(:), ALLOCATABLE 				:: p
    REAL(rp) 											:: p_buffer
    REAL(rp) 											:: p_test
    REAL(rp) 											:: ratio
    REAL(rp) 											:: rand_unif
    REAL(rp), DIMENSION(:), ALLOCATABLE 				:: p_samples
    REAL(rp) 											:: deta
    REAL(rp) 											:: dp
    INTEGER 											:: ii
    INTEGER 											:: ppp
    INTEGER 											:: nsamples
    INTEGER 											:: mpierr

    ppp = SIZE(g)
    nsamples = ppp*params%mpi_params%nmpi
    ALLOCATE(p(ppp))

    dp = 1.0_rp

    if (params%mpi_params%rank.EQ.0_idef) then
       ALLOCATE(p_samples(nsamples))! Number of samples to distribute among all MPI processes

       call RANDOM_SEED()
       call RANDOM_NUMBER(rand_unif)
       p_buffer = gamma_pdf_params%min_p + (gamma_pdf_params%max_p - gamma_pdf_params%min_p)*rand_unif

       ii=2_idef
       do while (ii .LE. 1000000_idef)
          p_test = p_buffer + random_norm(0.0_rp,dp)
          do while ((p_test.LT.gamma_pdf_params%min_p).OR.(p_test.GT.gamma_pdf_params%max_p))
             p_test = p_buffer + random_norm(0.0_rp,dp)
          end do

          ratio = fRE(p_test)/fRE(p_buffer)

          if (ratio .GE. 1.0_rp) then
             p_buffer = p_test
             ii = ii + 1_idef
          else
             call RANDOM_NUMBER(rand_unif)
             if (rand_unif .LT. ratio) then
                p_buffer = p_test
                ii = ii + 1_idef
             end if
          end if
       end do

       call RANDOM_SEED()
       call RANDOM_NUMBER(rand_unif)
       p_samples(1) = p_buffer

       ii=2_idef
       do while (ii .LE. nsamples)
          p_test = p_samples(ii-1) + random_norm(0.0_rp,dp)
          do while ((p_test.LT.gamma_pdf_params%min_p).OR.(p_test.GT.gamma_pdf_params%max_p))
             p_test = p_samples(ii-1) + random_norm(0.0_rp,dp)
          end do

          ratio = fRE(p_test)/fRE(p_samples(ii-1))

          if (ratio .GE. 1.0_rp) then
             p_samples(ii) = p_test
             ii = ii + 1_idef
          else
             call RANDOM_NUMBER(rand_unif)
             if (rand_unif .LT. ratio) then
                p_samples(ii) = p_test
                ii = ii + 1_idef
             end if
          end if
       end do

       go = SUM(SQRT(1.0_rp + p_samples**2))/nsamples
    end if

    CALL MPI_SCATTER(p_samples,ppp,MPI_REAL8,p,ppp,MPI_REAL8,0,MPI_COMM_WORLD,mpierr)

    CALL MPI_BCAST(go,1,MPI_REAL8,0,MPI_COMM_WORLD,mpierr)

    call MPI_BARRIER(MPI_COMM_WORLD,mpierr)

    g = SQRT(1.0_rp + p**2)

    DEALLOCATE(p)
    if (params%mpi_params%rank.EQ.0_idef) then
       DEALLOCATE(p_samples)
    end if
  END SUBROUTINE sample_gamma_distribution

  !> @brief Surboutine that saves the Gamma distribution parameters to the HDF5 file <i>gamma_distribution_parameters.h5</i>.
  !!
  !! @param[in] params Core KORC simulation parameters.
  !! @param filename String containing the name of the HDF5 file.
  !! @param gname String containing the group name of a set of KORC parameters.
  !! @param attr_array An 1-D array with attributes of 1-D real or integer arrays that are passed to KORC interfaces of HDF5 I/O subroutines.
  !! @param dset Name of data set to be saved to file.
  !! @param attr A single attributes of real or integer data that is passed to KORC interfaces of HDF5 I/O subroutines.
  !! @param h5file_id HDF5 file identifier.
  !! @param group_id HDF5 group identifier.
  !! @param h5error HDF5 error status.
  !! @param units Temporary variable used to add physical units to KORC parameters.
  SUBROUTINE save_gamma_params(params)
    TYPE(KORC_PARAMS), INTENT(IN) 							:: params
    CHARACTER(MAX_STRING_LENGTH) 							:: filename
    CHARACTER(MAX_STRING_LENGTH) 							:: gname
    CHARACTER(MAX_STRING_LENGTH), DIMENSION(:), ALLOCATABLE :: attr_array
    CHARACTER(MAX_STRING_LENGTH) 							:: dset
    CHARACTER(MAX_STRING_LENGTH) 							:: attr
    INTEGER(HID_T) 											:: h5file_id
    INTEGER(HID_T) 											:: group_id
    INTEGER 												:: h5error
    REAL(rp) 												:: units

    if (params%mpi_params%rank .EQ. 0) then
       filename = TRIM(params%path_to_outputs) // "gamma_distribution_parameters.h5"
       call h5fcreate_f(TRIM(filename), H5F_ACC_TRUNC_F, h5file_id, h5error)

       gname = "params"
       call h5gcreate_f(h5file_id, TRIM(gname), group_id, h5error)

       dset = TRIM(gname) // "/min_energy"
       attr = "Minimum energy in avalanche PDF (eV)"
       units = 1.0_rp/C_E
       call save_to_hdf5(h5file_id,dset,units*gamma_pdf_params%min_energy,attr)

       dset = TRIM(gname) // "/max_energy"
       attr = "Maximum energy in avalanche PDF (eV)"
       units = 1.0_rp/C_E
       call save_to_hdf5(h5file_id,dset,units*gamma_pdf_params%max_energy,attr)

       dset = TRIM(gname) // "/max_p"
       attr = "Maximum momentum in avalanche PDF (me*c^2)"
       call save_to_hdf5(h5file_id,dset,gamma_pdf_params%max_p,attr)

       dset = TRIM(gname) // "/min_p"
       attr = "Maximum momentum in avalanche PDF (me*c^2)"
       call save_to_hdf5(h5file_id,dset,gamma_pdf_params%min_p,attr)

       dset = TRIM(gname) // "/k"
       attr = "Shape factor"
       call save_to_hdf5(h5file_id,dset,gamma_pdf_params%k,attr)

       dset = TRIM(gname) // "/t"
       attr = "Scale factor"
       call save_to_hdf5(h5file_id,dset,gamma_pdf_params%t,attr)

       call h5gclose_f(group_id, h5error)

       call h5fclose_f(h5file_id, h5error)
    end if
  END SUBROUTINE save_gamma_params

END MODULE korc_energy_pdfs

max_stars_repo_name: ORNL-Fusion/KORC

max_issues_repo_name: ORNL-Fusion/KORC

max_forks_repo_name: ORNL-Fusion/KORC


text:
Collegiate 4H is an student organizations student organization that provides its members with a sense of identity on campus, enriches their lives through group projects and recreation, and develops confidence and leadership skills. Clubs provide service and support to their local and state 4H Clubs 4H programs, such as serving as judges and conducting training workshops. They are also a service and social group for campus students.

Collegiate 4H is open to all college students who wish to support youth and the 4H program. It is not necessary to have prior 4H experience, only to have an interest in the 4H ideals and in serving your community.

Collegiate 4H at UC Davis has been in existence for many years. We are a service and leadershiporiented group of college students. The club strives to encourage leadership development in teens while also offering several collegepreparatory events throughout the year.

Contact: Club Advisor, Quang Hogan Tong at Mailto(qtong AT ucdavis DOT edu) or 20102011 Club President, Carolyn Abrams at  Mailto(cmabrams AT ucdavis DOT edu)

You See Davis Days

Our largest event is a 3day conference, held ThursdaySaturday before Picnic Day for approximately 20 high school students, during which the delegates stay at our homes and get a taste of life here at UC Davis. This includes pizza parties, auditing the occasional lecture, financial aid/college admissions workshops, and of course the indispensable campus tour. We also work with Kaplan Educational Center Kaplan to provide a lowcost practice SAT workshop to high school 4H members.

 Photos

  Also see other 4H Clubs in the area