module temp_like

  implicit none

  real*8, dimension(:), allocatable :: X
  real*8,  dimension(:,:), allocatable :: c_inv
  integer :: Nspec,nX,num_ells,nXfromdiff
  integer, dimension(:), allocatable  :: lminX, lmaxX, np, npt
  real*8 :: sz_143_temp(0:5000)
  real*8 :: ksz_temp(0:5000), tszxcib_temp(0:5000)
  integer :: lmax_sz
  real*8, dimension(:,:), allocatable :: beam_cov_inv,beam_cov_full
  real*8, dimension(:,:,:), allocatable :: beam_modes ! mode#, l, spec#
  integer :: num_modes_per_beam,beam_lmax,beam_Nspec,cov_dim
  real*8,dimension(:,:),allocatable :: Cl_fg
  real(8),dimension(:,:),allocatable::gcal
  integer:: num_non_beam=14
  real(8), dimension(:),  allocatable::  X_beam_corr_model, Y
  logical:: has_dust, has_calib_prior
  logical :: needinit=.true.

  real(8), parameter :: sz_bandpass100_nom143 = 2.022d0
  real(8), parameter :: cib_bandpass143_nom143 = 1.134d0
  real(8), parameter :: sz_bandpass143_nom143 = 0.95d0
  real(8), parameter :: cib_bandpass217_nom217 = 1.33d0

  integer, allocatable :: marge_indices(:),marge_indices_reverse(:)
  integer, allocatable :: keep_indices(:),keep_indices_reverse(:)
  real(8), allocatable :: beam_conditional_mean(:,:)
  logical, allocatable :: want_marge(:)
  integer marge_num, keep_num
  real(8) :: beam_factor = 1 !new beam modes are already scaled (2.7_campc)
  logical :: make_cov_marged = .false.

contains

!!  subroutine like_init(like_file, sz143_file, tszxcib_file, ksz_file, beam_file)
!!
!!    real*8, dimension(:), allocatable :: X
!!    real*8,  dimension(:,:), allocatable :: c_inv
!!    integer :: Nspec,nX,num_ells,nXfromdiff
!!    integer, dimension(:), allocatable  :: lminX, lmaxX, np, npt
!!    real*8 :: sz_143_temp(0:5000)
!!    real*8 :: ksz_temp(0:5000), tszxcib_temp(0:5000)
!!    integer :: lmax_sz
!!    real*8, dimension(:,:), allocatable :: beam_cov_inv
!!    real*8, dimension(:,:,:), allocatable :: beam_modes ! mode#, l, spec#
!!    integer :: num_modes_per_beam,beam_lmax,beam_Nspec,cov_dim
!!
!!    integer :: i, j, l,dummy
!!
!!    character*100 like_file, sz143_file, ksz_file, tszxcib_file, beam_file
!!
!!    ! cl_ksz_148_tbo.dat file is in D_l, format l D_l, from l=2 to 10000
!!    ! tsz_x_cib_template.txt is is (l D_l), from l=2 to 9999, normalized to unity
!!    !    at l=3000
!!
!!    if(needinit .eqv. .false.) then
!!       return
!!    endif
!!
!!    open(48, file=like_file, form='unformatted', status='unknown')
!!
!!    read(48) Nspec,nX
!!    allocate(lminX(Nspec))
!!    allocate(lmaxX(Nspec))
!!    allocate(np(Nspec))
!!    allocate(npt(Nspec))
!!    allocate(X(nX))
!!    allocate(c_inv(nX,nX))
!!
!!    read(48) (lminX(i), lmaxX(i), np(i), npt(i), i = 1, Nspec)
!!    read(48) (X(i), i=1, nX)
!!    read(48)
!!    read(48) ((c_inv(i, j), j = 1, nX), i = 1,  nX)
!!    close(48)
!!
!!    !  open(48, file=sz100_file, form='unformatted', status='unknown')
!!    !  read(48) lmax_sz
!!    !  read(48) (sz_100_temp(l), l = 0, lmax_sz)
!!    !  close(48)
!!
!!    lmax_sz=5000
!!
!!    open(48, file=sz143_file, form='formatted', status='unknown')
!!    do i=2,lmax_sz
!!       read(48,*) dummy,sz_143_temp(i)
!!    enddo
!!    close(48)
!!
!!    open(48, file=ksz_file, form='formatted',status='unknown')
!!    do i=2,lmax_sz
!!       read(48,*) dummy,ksz_temp(i)
!!    enddo
!!    close(48)
!!
!!    open(48, file=tszxcib_file,form='formatted',status='unknown')
!!    do i=2,lmax_sz
!!       read(48,*) dummy,tszxcib_temp(i)
!!    enddo
!!    close(48)
!!
!!    open(48, file=beam_file, form='unformatted', status='unknown')
!!    read(48) beam_Nspec,num_modes_per_beam,beam_lmax
!!    if(beam_Nspec.ne.Nspec) stop 'Problem: beam_Nspec != Nspec'
!!    allocate(beam_modes(num_modes_per_beam,0:beam_lmax,beam_Nspec))
!!    cov_dim=beam_Nspec*num_modes_per_beam
!!    allocate(beam_cov_inv(cov_dim,cov_dim))
!!    read(48) (((beam_modes(i,l,j),j=1,Nspec),l=0,beam_lmax),i=1,num_modes_per_beam)
!!    read(48) ! skipping beam_cov
!!    read(48) ((beam_cov_inv(i,j),j=1,cov_dim),i=1,cov_dim)
!!    close(48)
!!    call like_init_frommem(Nspec, nX,lminX,lmaxX,np,npt, c_inv,X,lmax_sz,sz_143_temp,ksz_temp,tszxcib_temp,beam_Nspec,num_modes_per_beam,beam_lmax,cov_dim,beam_cov_inv,beam_modes,0,1)
!!
!!    deallocate(lminX)
!!    deallocate(lmaxX)
!!    deallocate(np)
!!    deallocate(npt)
!!    deallocate(X)
!!    deallocate(c_inv)
!!    deallocate(beam_cov_inv)
!!    deallocate(beam_modes)
!!
!!    return
!!  end subroutine like_init

  subroutine like_init_frommem(iNspec, inX,ilminX,ilmaxX,inp,inpt, ic_inv,iX,ilmax_sz,isz_143_temp,iksz_temp,itszxcib_temp,ibeam_Nspec,inum_modes_per_beam,ibeam_lmax,icov_dim,ibeam_cov_inv,ibeam_modes,dust_flag,calib_flag,marge_flags,marge_mode)
    integer,intent(in)::iNspec,inX,inum_modes_per_beam,ibeam_lmax,ibeam_Nspec,icov_dim,ilmax_sz
    integer,dimension(:)::ilminX,ilmaxX,inp,inpt
    real*8, dimension(:) :: iX
    real*8,  dimension(:,:) ::ic_inv
    real*8,intent(in) :: iksz_temp(:), itszxcib_temp(:)
    real*8,intent(in) :: isz_143_temp(:)
    real*8, dimension(:,:) :: ibeam_cov_inv
    real*8, dimension(:,:,:) :: ibeam_modes ! mode#, l, spec#
    real(8)::renorm
    integer,intent(in)::dust_flag,calib_flag
    logical,intent(in),dimension(:)::marge_flags
    real(8),intent(in),dimension(:,:)::marge_mode
    integer::i,j,k

    Nspec = iNspec
    nX = inX

    allocate(lminX(Nspec))
    allocate(lmaxX(Nspec))
    allocate(np(Nspec))
    allocate(npt(Nspec))
    allocate(X(nX))
    allocate(c_inv(nX,nX))

    lminX = ilminX
    lmaxX = ilmaxX
    X = iX
    c_inv = ic_inv
    np = inp
    npt = inpt

    lmax_sz = ilmax_sz

    ksz_temp = iksz_temp
    renorm=1.d0/ksz_temp(3000)
    ksz_temp=ksz_temp*renorm

    sz_143_temp = isz_143_temp
    renorm=1.d0/sz_143_temp(3000)
    sz_143_temp=sz_143_temp*renorm

    tszxcib_temp = itszxcib_temp
    renorm=1.d0/tszxcib_temp(3000)
    tszxcib_temp=tszxcib_temp*renorm

    beam_Nspec = ibeam_Nspec
    num_modes_per_beam = inum_modes_per_beam
    beam_lmax = ibeam_lmax
    cov_dim = icov_dim

    allocate(beam_modes(num_modes_per_beam,0:beam_lmax,beam_Nspec))
    allocate(beam_cov_inv(cov_dim,cov_dim))

    beam_modes = ibeam_modes
    beam_cov_inv = ibeam_cov_inv

    allocate(Cl_fg(Nspec,0:maxval(lmaxX)))
    allocate(gcal(1:Nspec,0:beam_lmax))
    allocate(X_beam_corr_model(1:nX))
    allocate(Y(1:nX))

    num_non_beam=14
    if (dust_flag .eq. 1) then
      num_non_beam = 15
      has_dust = .true.
    endif
    has_calib_prior = .true.
    if (calib_flag .eq. 0) then
      has_calib_prior = .false.
    endif

    allocate(want_marge(cov_dim))
    do i=1,cov_dim
      want_marge(i) =  marge_flags(i)
    enddo

    marge_num=count(want_marge)
    keep_num=cov_dim-marge_num

    allocate(marge_indices(marge_num))
    allocate(marge_indices_reverse(cov_dim))
    allocate(keep_indices(keep_num))
    allocate(keep_indices_reverse(cov_dim))

    j=0
    k=0
    do i=1,cov_dim
        if (want_marge(i)) then
            j=j+1
            marge_indices(j) = i
        else
            k=k+1
            keep_indices(k)=i
        end if
        marge_indices_reverse(i)=j
        keep_indices_reverse(i)=k
    end do

    if (marge_num.ne.0) then
      allocate(beam_conditional_mean(marge_num, keep_num))
      do i=1, marge_num
        beam_conditional_mean(i,:) = marge_mode(i,:)
      end do
      if (keep_num>0) then
        allocate(beam_cov_full(cov_dim,cov_dim))
        beam_cov_full = beam_cov_inv
        call Matrix_inverse_internal(beam_cov_full)
        deallocate(beam_cov_inv)
        allocate(beam_cov_inv(keep_num,keep_num))
        beam_cov_inv = beam_cov_full(keep_indices,keep_indices)
        call Matrix_inverse_internal(beam_cov_inv)
        deallocate(beam_cov_full)
      end if

    endif

    needinit=.false.

  end subroutine like_init_frommem

  subroutine compute_fg(Cl_fg,freq_params)
    real(8), intent(in)  :: freq_params(:)
    real(8), intent(inout)  :: Cl_fg(1:,0:)
    integer :: i, j, l, ii,jj
    real(8):: A_ps_100, A_ps_143, A_ps_217, A_cib_143, A_cib_217, A_sz, r_ps, r_cib, xi, A_ksz, ncib,A_dust
    real(8):: zell, zCIB
    real(8):: Lfac
    integer::lmax

    if(needinit .eqv. .true.) then
       stop "initialize first"
    endif
    if (size(freq_params) < num_non_beam) stop 'CAMspec: not enough parameters'
    A_ps_100=freq_params(1)
    A_ps_143 = freq_params(2)
    A_ps_217 = freq_params(3)
    A_cib_143=freq_params(4)
    A_cib_217=freq_params(5)
    A_sz =freq_params(6)  !143
    r_ps = freq_params(7)
    r_cib=freq_params(8)
    ncib = freq_params(9)
    xi=freq_params(13)
    A_ksz=freq_params(14)

    if(has_dust) then
      A_dust = freq_params(15)
    endif

    lmax = ubound(Cl_fg,2)
    !100x100

    Cl_fg(:,0) = 0
    do l = 1, lmax
      zell = real(l,8)
      Lfac = real(l*(l+1),8)

      !100x100
      Cl_fg(1,l) = A_ps_100*1.d-6/9.d0 + &
        A_ksz*ksz_temp(l)/Lfac+ &
        A_sz*sz_bandpass100_nom143*sz_143_temp(l)/Lfac

      ! 143x143
      zCIB = cib_bandpass143_nom143*A_cib_143*(zell/3000)**(ncib)/Lfac
      Cl_fg(2,l) = A_ps_143*1.d-6/9.d0 + zCIB + &
        A_ksz*ksz_temp(l)/Lfac + A_sz*sz_bandpass143_nom143*sz_143_temp(l)/Lfac  &
        -2.0*sqrt(cib_bandpass143_nom143*A_cib_143*sz_bandpass143_nom143*A_sz)*xi*tszxcib_temp(l)/Lfac

      ! 217x217
      zCIB = cib_bandpass217_nom217*A_cib_217*(zell/3000)**(ncib)/Lfac
      Cl_fg(3,l) = A_ps_217*1.d-6/9.d0 + zCIB &
        + A_ksz*ksz_temp(l)/Lfac

      ! 143X217
      zCIB = dsqrt(cib_bandpass143_nom143*A_cib_143*cib_bandpass217_nom217*A_cib_217)*(zell/3000)**(ncib) &
        /Lfac
      Cl_fg(4,l) = r_ps*dsqrt(A_ps_143*A_ps_217)*1.d-6/9.d0 + r_cib*zCIB &
        +A_ksz*ksz_temp(l)/Lfac  &
        -sqrt(cib_bandpass217_nom217*A_cib_217*sz_bandpass143_nom143*A_sz)*xi*tszxcib_temp(l)/Lfac
    end do
    if(has_dust) then
      A_dust = freq_params(15)
      call add_dust(Cl_fg(1,:), Cl_fg(2,:), Cl_fg(3,:), Cl_fg(4,:), 1,lmax,A_dust)
    endif
  end subroutine

  subroutine beams_and_cal_prior(logprior, freq_params)
    real(8),intent(out)::logprior
    real(8),intent(in)::freq_params(:)
    real(8)::cal0,cal1,cal2
    integer::i,j,k,l,ii,jj
    real(8) beam_coeffs(Nspec,num_modes_per_beam)
    real(8) beam_params(cov_dim)

    if(needinit .eqv. .true.) then
       stop "initialize first"
    endif

    if (size(freq_params) < num_non_beam +  keep_num) stop 'CAMspec: not enough parameters'

    cal0=freq_params(10)
    cal1=freq_params(11)
    cal2=freq_params(12)

    call fill_beam_params(freq_params,beam_params)

    do ii=1,beam_Nspec
      do jj=1,num_modes_per_beam
          beam_coeffs(ii,jj)=beam_params(jj+num_modes_per_beam*(ii-1))
      enddo
    enddo

    logprior = 0

    ! add prior on the beam coefs
    if (keep_num>0) then
      do i=1,beam_Nspec
        do j=1,beam_Nspec
          do k=1,num_modes_per_beam
            jj = k+num_modes_per_beam*(i-1)
            if (.not. want_marge(jj)) then
              do l=1,num_modes_per_beam
                ii = l+num_modes_per_beam*(j-1)
                if (.not. want_marge(ii)) then
                  logprior = logprior + beam_coeffs(j,l)*beam_cov_inv(keep_indices_reverse(ii),keep_indices_reverse(jj))*beam_coeffs(i,k)
                endif
              enddo
            endif
          enddo
        enddo
      enddo
    endif

    ! add prior on the calibration coefs

    if (has_calib_prior) then
      logprior = logprior + ((cal2/cal1-0.9966d0)/0.0015d0)**2  + ((cal0/cal1-1.0006d0)/0.0004d0)**2
    endif

  end subroutine

   subroutine plik_dust_template(dust_template__l, lmin, lmax)

    integer,                                intent(in)    :: lmin
    integer,                                intent(in)    :: lmax
    real(8),      dimension(lmin:),         intent(out)   :: dust_template__l

    integer                                               :: i
    real(8)                                               :: l_pivot
    real(8)                                               :: gal_index
    real(8),                                parameter     :: twopi = 6.283185307179586476925286766559005768394

    l_pivot   = 500.0
    gal_index = -2.6

    do i = lmin,lmax
       dust_template__l(i) = (dble(i)/l_pivot)**gal_index / twopi
    enddo

  end subroutine plik_dust_template

  subroutine add_dust(cl100, cl143, cl217, cl143x217, lmin,lmax, amplitude)

    integer,                                intent(in)    :: lmin
    integer,                                intent(in)    :: lmax
    real(8),                                intent(in)    :: amplitude
    real(8),      dimension(lmin:),      intent(inout) :: cl100
    real(8),      dimension(lmin:),      intent(inout) :: cl143
    real(8),      dimension(lmin:),      intent(inout) :: cl217
    real(8),      dimension(lmin:),  intent(inout) :: cl143x217

    real(8)                                               :: cc_100
    real(8)                                               :: cc_143
    real(8)                                               :: cc_217
    real(8)                                               :: rescaling_143_to_100
    real(8)                                               :: rescaling_143_to_217
    real(8),      dimension(:),             allocatable   :: dust_template__l

! frequency averaged color corrections
    cc_100 = 1.090
    cc_143 = 1.023
    cc_217 = 1.130

! amplitude rescalings between nominal frequencies
! include mask 1 -> mask 3 conversion factor for 100 ghz
    rescaling_143_to_100 = 0.466 * 1.66
    rescaling_143_to_217 = 3.170

    allocate(dust_template__l(lmin:lmax))
    dust_template__l = 0.0

    call plik_dust_template(dust_template__l, lmin, lmax)

    cl100 = cl100 + amplitude * cc_100**2 * rescaling_143_to_100**2&
         & * dust_template__l(lmin:lmax)

    cl143 = cl143 + amplitude * cc_143**2&
         & * dust_template__l(lmin:lmax)

    cl217 = cl217 + amplitude * cc_217**2 * rescaling_143_to_217**2&
         & * dust_template__l(lmin:lmax)

    cl143x217 = cl143x217 + amplitude * cc_143 * cc_217 * rescaling_143_to_217&
         & * dust_template__l(lmin:lmax)

    deallocate(dust_template__l)

  end subroutine add_dust

  subroutine fill_beam_params(freq_params,beam_params)
    real(8),intent(in),dimension(:)::freq_params
    real(8),intent(out),dimension(:)::beam_params
    integer::i

    do i=1,keep_num
      beam_params(keep_indices(i)) = freq_params(num_non_beam+i)
    enddo

    if (marge_num>0) then
      beam_params(marge_indices) = matmul(beam_conditional_mean, freq_params(num_non_beam+1:))
    endif

  end subroutine

  subroutine compute_beams_and_cal(gcal,freq_params)
    real(8),dimension(1:Nspec,0:beam_lmax)::gcal
    real(8), intent(in)  :: freq_params(:)
    real(8)::cal0, cal1, cal2
    real(8),dimension(Nspec)::cal
    real(8)::corrected_beam
    integer::i,ispec,l
    real(8),dimension(cov_dim)::beam_params

    if(needinit .eqv. .true.) then
       stop "initialize first"
    endif

    if (size(freq_params) < num_non_beam +  keep_num) stop 'CAMspec: not enough parameters'
    cal0=freq_params(10)
    cal1=freq_params(11)
    cal2=freq_params(12)
    cal(1) = cal0
    cal(2) = cal1
    cal(3) = cal2
    cal(4) = dsqrt(cal1*cal2)

    call fill_beam_params(freq_params,beam_params)
    do ispec=1,Nspec
      do l = 0, beam_lmax
        corrected_beam=1.d0
        do i=1,num_modes_per_beam
          corrected_beam=corrected_beam + beam_params(i+num_modes_per_beam*(ispec-1)) * beam_modes(i,l,ispec) * beam_factor
        enddo
        gcal(ispec,l) = corrected_beam/cal(ispec)
      enddo
    enddo

  end subroutine

  subroutine calc_like(zlike,  cell_cmb, freq_params)
    real(8), intent(in)  :: freq_params(:)
    real(8), dimension(0:) :: cell_cmb
    integer :: i,j
    real(8) zlike,ztemp
    integer :: ofs,ispec
    real(8) logprior

    if(needinit .eqv. .true.) then
       stop "initialize first"
    endif

    if(Nspec.ne.4) then
      print*, 'Nspec inconsistent with foreground corrections in calc_like.'
      stop
    end if

    ! compute forgrounds
    call compute_fg(Cl_fg,freq_params)

    !compute beam and cal corrections
    call compute_beams_and_cal(gcal,freq_params)

    !   100 foreground
    ofs = 1
    do ispec=1,Nspec
      !print *,nX,ispec,npt(ispec),ofs,lmaxX(ispec),lminX(ispec),npt(ispec)-ofs+lmaxX(ispec)-lminX(ispec)+1
      X_beam_corr_model(npt(ispec):npt(ispec)-ofs+lmaxX(ispec)-lminX(ispec)+1) = (cell_cmb(lminX(ispec):lmaxX(ispec)) + Cl_fg(ispec,lminX(ispec):lmaxX(ispec))) * gcal(ispec,lminX(ispec):lmaxX(ispec))
      ofs = 1
    enddo

    !X_beam_corr_model = X
    Y = X - X_beam_corr_model

    zlike = 0
    !$OMP parallel do private(j,i,ztemp) reduction(+:zlike) schedule(static,16)
    do  j = 1, nX
      ztemp= dot_product(Y(j+1:nX), c_inv(j+1:nX, j))
      zlike=zlike+ (ztemp*2 +c_inv(j, j)*Y(j))*Y(j)
    end do
    !    zlike = 0
    !    do  j = 1, nX
    !       ztemp= 0
    !       do  i = 1, nX
    !          ztemp = ztemp + Y(i)*c_inv(i, j)
    !       end do
    !       zlike=zlike+ztemp*Y(j)
    !    end do
    !   zlike = CAMSpec_Quad(c_inv, Y)

    ! compute prior on beams and calibration
    call beams_and_cal_prior(logprior,freq_params)

    !PRINT *,zlike/2,logprior/2,(zlike+logprior)/2

    zlike = zlike + logprior

    end subroutine calc_like

    subroutine Matrix_inverse_internal(M)
      !Inverse of symmetric matrix
      real(8), intent(inout):: M(:,:)
      integer i,j,n
      integer info

      n=Size(M,DIM=1)
      call dpotrf ('L', n, M, n, info)
      if (info/=0)  stop 'Matrix_Cholesky: not positive definite '
      call dpotri ('L', n, M, n, info)
      if (info/=0) stop 'Matrix_inverse: error '
      do i=1,n
          do j=1,i-1
              M(j,i) = M(i,j)
          end do
      end do
    end subroutine Matrix_inverse_internal

end module temp_like


text:
c
c input:           * ** ****
      subroutine rms(y,ny,nrms,xnoise)
c
c  For the array Y, evaluate the RMS average of
c  the noise sample in "nrms" points about the
c  location "ny".
c
      real*4 y(*)

      jstart = ny - nrms/2
      jstart = max0(1,jstart)
      jend = jstart+nrms-1
      if(jend.le.jstart)return
      xmean = 0.
      do j=jstart,jend
        xmean = xmean+y(j)
      enddo
      xmean=xmean/float(jend-jstart+1)
      sum = 0.
      do j=jstart,jend
        sum = sum + (y(j)-xmean)**2
      enddo
      xnoise = sqrt( sum/float(jend-jstart+1) )
      return
      end

ext: f


text:
Debats du Senat (hansard)
2e Session, 36e Legislature,
Volume 138, Numero 16
Le lundi 6 decembre 1999
L'honorable Gildas L. Molgat, President
La Journee nationale de commemoration
Le dixieme anniversaire de la tragedie de l'Ecole polytechnique
Le quatre-vingt-deuxieme anniversaire de l'explosion de Halifax
Les donnees de recensement-L'origine ethnique canadienne-L'effet sur les possibilites de commercialisation
Projet de loi sur la protection des renseignements personnels et les documents electroniques
Depot du rapport du comite sur la partie 1
Depot du rapport du comite sur les parties 2 a 5
Affaires sociales, sciences et technologie
Avis de motion autorisant le comite a etudier l'etat du systeme de sante
Les droits de la personne et les conflits multiethniques
Le Timor oriental-L'etat des helicopteres Sea King
L'arret des operations de la compagnie aerienne InterCanadien-Le service aux petites collectivites
Reponse differee a une question orale
La reglementation des produits d'equarrissage- La politique du gouvernement
Les travaux du Senat
Recours au Reglement-Decision de la presidence
Projet de loi sur la protection des renseignements personnels et les documents electroniques
Projet de loi modificatif-Rapport du comite-Ajournement du debat
Le rapport du comite des affaires etrangeres sur l'etude-Report du debat
Le lundi 6 decembre 1999
La seance est ouverte a 16 heures, le President etant au fauteuil.
La Journee nationale de commemoration
Le dixieme anniversaire de la tragedie de l'Ecole polytechnique
Nous avons modifie les lois.
Honorables senateurs, nous sommes beaucoup trop lents a nous en occuper.
L'honorable Erminie J. Cohen :
C'est aujourd'hui le dixieme anniversaire du massacre de Montreal.
Le 6 decembre 1999 a ete un moment essentiel dans l'histoire du Canada.
Malheureusement, la violence contre les femmes continue d'etre une realite au Canada.
Ce sont des maris, des conjoints, des voisins et des meilleurs amis.
Le statut social ou la situation economique importe peu.
Les hommes et les femmes doivent s'elever contre cette situation honteuse.
Ces jeunes femmes qui avaient toute leur vie a vivre meritaient beaucoup mieux que cela.
Un nouveau phenomene est apparu: la violence dans les cours d'ecole.
C'est un grave probleme que tous les Canadiens doivent contribuer a eliminer.
Il n'est pas suffisant de nous souvenir de ces femmes.
Des journees d'action sont organisees afin d'eliminer la violence faite aux femmes.
Tout cela est extremement important.
Honorables senateurs, nous commemorons aujourd'hui un anniversaire tragique et triste.
En effet, le 6 decembre 1989, un homme, Marc Lepine, assassinait 14 femmes.
Il les a tuees parce qu'elles etaient des femmes.
L'Ecole polytechnique, a Montreal, a ete le theatre de ce drame epouvantable.
Hier, un monument commemoratif a ete devoile a la memoire des victimes.
Cette tragedie defie l'entendement.
Nous devons poursuivre notre reflexion sur les causes profondes de cette violence.
Chaque niveau de gouvernement, chacun dans sa sphere, doit intervenir.
L'honorable Dan Hays (leader adjoint du gouvernement) :
Ce triste anniversaire doit nous donner a reflechir.
Nous continuons a oeuvrer pour l'elimination de la violence faites aux femmes.
Ce n'est pas accidentel.
L'honorable Marisa Ferretti Barth :
Par la suite, Mme Rathjen a fait quelque chose de remarquable.
Voici ce qu'elle a dit:
J'ai parle aux parents des victimes.
Le quatre-vingt-deuxieme anniversaire de l'explosion de Halifax
L'honorable J. Michael Forrestall :
Honorables senateurs, c'est en effet un jour triste pour le Canada.
Aujourd'hui marque le quatre-vingt-deuxieme anniversaire de l'explosion de Halifax.
Les faits entourant l'explosion sont bien connus.
Quelque 13 500 batiments ont ete rases et 6 000 personnes sont demeurees sans abri.
On se rappelle encore cette tragedie incroyable dans notre province.
Une commemoration tres appropriee s'est deroulee au lever du soleil, ce matin, a Halifax.
Les donnees de recensement-L'origine ethnique canadienne-L'effet sur les possibilites de commercialisation
Je refuse d'accepter le qualificatif batarde.
De l'autre cote, ma mere est de souche purement britannique.
Quinze generations de cette famille sont nees et ont grandi sur notre continent.
Qui donc sommes nous?
Comment devons-nous nous decrire nous-memes?
Je crois que nous sommes de fiers Canadiens d'origines mixtes typiquement canadiennes.
Projet de loi sur la protection des renseignements personnels et les documents electroniques
Depot du rapport du comite sur la partie 1
Depot du rapport du comite sur les parties 2 a 5
Honorables senateurs, je donne avis que mardi, le 7 decembre 1999, je proposerai:
Avis de motion autorisant le comitea retenir des services
Honorables senateurs, je donne avis que mardi, le 7 decembre 1999, je proposerai:
Affaires sociales, sciences et technologie
Avis de motion autorisant le comite a etudier l'etat du systeme de sante
Honorables senateurs, je donne avis que, le mardi 7 decembre, je proposerai:
Plus particulierement, que le comite soit autorise a examiner:
a ) Les principes fondamentaux sur lesquels est fonde le systeme public de sante au Canada;
b ) L'historique du systeme de sante au Canada;
c ) Les systemes de sante publics dans d'autres pays;
d ) Le systeme de sante au Canada - pressions et contraintes;
e ) Le role du gouvernement federal dans le systeme de sante au Canada;
Que le Comite presente son rapport final au plus tardle 14 decembre 2001; et
Les droits de la personne et les conflits multiethniques
L'honorable Noel A. Kinsella (chef adjoint de l'opposition) :
Le Timor oriental-L'etat des helicopteres Sea King
L'honorable J. Michael Forrestall :
L'honorable J. Bernard Boudreau (leader du gouvernement) :
Heureusement, ils ont reussi la manoeuvre en toute securite.
Il est repute pour sa stabilite lors de ce genre de manoeuvre.
Je n'irais pas jusqu'a dire que cet amerrissage a ete voulu.
Le Sea King n'est pas destine a fonctionner sur l'eau.
Il flotte, mais tout au plus.
Je ne posais pas necessairement de question sur son etat de fonctionnement.
Peut-etre n'ai-je pas ete assez clair en posant ma question.
Si c'est le cas, va-t-il pouvoir poursuivre sa mission?
L'honorable Noel A. Kinsella (chef adjoint de l'opposition) :
L'honorable J. Bernard Boudreau (leader du gouvernement) :
Honorables senateurs, je n'ai pas de details precis pour l'instant.
Je pourrai peut-etre fournir alors plus de details.
Ce n'est surement pas le dernier mot.
En consequence, il va falloir reglementer de nouveau le secteur.
Qui dit monopole dit nouvelle reglementation.
L'honorable J. Bernard Boudreau (leader du gouvernement) :
Rien n'a encore ete decide.
Le gouvernement et le ministre des Transports sont determines a appliquer ces principes.
Ils resteront la cle de voute de la politique gouvernementale dans ce secteur.
Quoi qu'il en soit, nous verrons en temps et lieu.
L'honorable J. Michael Forrestall :
Honorables senateurs, pour l'instant, le processus suit son cours.
Je suis tres prudent a ce sujet.
L'arret des operations de la compagnie aerienne InterCanadien-Le service aux petites collectivites
L'honorable Noel A. Kinsella (chef adjoint de l'opposition) :
L'honorable J. Bernard Boudreau (leader du gouvernement) :
Honorables senateurs, je remercie le senateur de sa question.
Le leader peut-il les nommer?
Encore la, ce n'est pas l'ideal, mais esperons que ce sera temporaire.
L'honorable J. Bernard Boudreau (leader du gouvernement) :
L'honorable A. Raynell Andreychuk :
Il semble maintenant que cet objectif ne sera pas atteint avant longtemps.
L'honorable J. Bernard Boudreau (leader du gouvernement) :
Toutefois, il serait faux de conclure que les discussions ont pris fin.
Honorables senateurs, je concois que les negociations soient une priorite.
Elles le sont depuis 1947.
Ce n'est clairement pas le cas.
Le ministre et notre gouvernement continueront d'y accorder la priorite qu'elles meritent.
Je pourrais peut-etre obtenir ces renseignements et, si possible, les partager avec le senateur.
Je voudrais une reponse ecrite sur toute la politique des transports au Canada.
Je m'engage a fournir la reponse ecrite la plus detaillee possible.
Reponse differee a une question orale
L'honorable Dan Hays (leader adjoint du gouvernement) :
La reglementation des produits d'equarrissage- La politique du gouvernement
( Reponse a la question posee par l'honorable Mira Spivak le 17 novembre 1999 )
Ceci comprend les bovins, les moutons et les chevres, par exemple.
Les travaux du Senat
Recours au Reglement-Decision de la presidence
Son Honneur le President :
Cependant, j'ai lu attentivement les propos du senateur Corbin sur la question.
Cependant, on dit aussi ou defenseur servile.
La plupart des definitions sont flatteuses.
Projet de loi sur la protection des renseignements personnels et les documents electroniques
Son Honneur le President :
Ces amendements recoivent l'appui de tous les membres du comite.
Son Honneur le President :
Plait-il aux senateurs d'adopter la motion?
(La motion est adoptee et le projet de loi est lu une deuxieme fois.)
Son Honneur le President :
Honorables senateurs, quand lirons-nous ce projet de loi une troisieme fois?
Son Honneur le President :
Honorables senateurs, il appartient au Senat d'en decider.
J'espere qu'il sera donne suite a la requete du senateur.
Son Honneur le President :
Plait-il aux senateurs que nous procedions de la sorte?
Honorables senateurs, conformement a l'avis du 24 novembre 1999, je propose:
Je l'ai fait avec l'approbation du leadership de ce cote-ci.
J'interviens maintenant pour confirmer cet engagement.
Toutefois, cet engagement constitue un probleme pour la motion.
C'est une question importante que j'ai soulevee.
Ce projet de loi combine en fait deux projets de loi distincts.
J'avais l'intention de faire inscrire ces citations au comte rendu.
Ils voulaient bien sur proteger leurs arrieres.
Le fait est que la partie 1 constitue un projet de loi en soi.
Je vous demande une fois de plus de me croire sur parole.
Je reviens a ce que je disais lors de la deuxieme lecture.
Il s'agit en fait de deux projets de loi et non d'un seul.
(Sur la motion du senateur Kirby, le debat est ajourne.)
Projet de loi modificatif-Rapport du comite-Ajournement du debat
Le projet de loi est renvoye avec des propositions d'amendement.
Le rapport concernant le projet de loi comprend les principaux amendements suivants.
Il n'entre plus dans la pratique d'utiliser ce terme dans une mesure legislative.
L'honorable A. Raynell Andreychuk :
Honorables senateurs, j'appuie certainement les observations du senateur Milne.
J'appuie les amendements.
Je tiens cependant a signaler deux sujets d'inquietude.
Je dois cependant exprimer certaines inquietudes concernant l'integrite du processus de rehabilitation.
Pourtant, par inadvertance, tous les dossiers des conducteurs du Manitoba ont ete egares.
Il serait inacceptable que le systeme de rehabilitation ne conserve pas son integrite.
Ce qui m'inquiete, c'est que les systemes se deteriorent avec le temps.
Ils ne figurent donc pas dans le systeme de casiers judiciaires.
Dans pareils cas, une verification du casier judiciaire n'est guere utile.
Les enfants seront proteges dans la mesure ou les processus de selection seront suivis.
Ces deux observations etant faites, j'appuie le projet de loi ainsi modifie.
Cependant, je deconseille au gouvernement d'intervenir dans le processus de rehabilitation.
(Sur la motion du senateur Nolin, le debat est ajourne.)
Le rapport du comite des affaires etrangeres sur l'etude-Report du debat
L'honorable Peter A. Stollery :
Son Honneur le President :
(Le Senat s'ajourne a 14 heures demain.)


text:
module mod_Entry

use mod_uscr_begin
use mod_uscr_end
use mod_uscr_insert_entry
use mod_uscr_insert_entries
use mod_uscr_insert_col
use mod_uscr_insert_row
use mod_uscr_insert_clique
use mod_uscr_insert_block
use mod_uscr_block_begin
use mod_uscr_variable_block_begin
use mod_usgp
use mod_ussp
use mod_INS_ROUTINER
use mod_INSERTING

end module mod_Entry

max_stars_repo_name: NetlibRepository/lapack-www

max_issues_repo_name: NetlibRepository/lapack-www

max_forks_repo_name: NetlibRepository/lapack-www


text:
TEACH
ANOTHER
LANGUAGE TO
KIDS

Theres no time like early childhood to master a second language, right? But few elementary schools offer foreign language instruction. Thats where TALK comes in! TALK offers foreign language classes for kids.

TALK started in 1994 when a group of parents decided to collectively pool their efforts and resources together to offer language classes to kids. It has grown to offer various levels of French and Spanish classes to K6 children at several Davis elementary schools, depending on demand and parent involvement. Though the entire program is run as a parentled nonprofit collective, enrollment and logistical support is provided by the Davis Art Center, which also provides classroom space for the North Davis Elementary School campus. Birch Lane School, Korematsu Elementary School and Pioneer Elementary School classes are oncampus.

TALK emphasizes playbased and creative approaches to language learning, using games, roleplaying, art projects, music, cultural activities and physical engagement.

Class sizes are limited to 6 to 12 children. Teachers are native or nearnative speakers with enthusiasm for sharing their language, who enjoy young children. Classes are held every morning before the start of the school day. TALK aims is to provide language enrichment to children who are still at an age when they can easily absorb a new language.

Classes are held daily from 7:40 am to 8:10 am. Currently, TALK is able to provide French and Spanish classes at Birch Lane, Korematsu, North Davis and Pioneer Elementary Schools. The North Davis classes are held at the Davis Art Center, and a teacher walks North Davis Elementary children to school after class.

As a parent collective, TALK can offer classes as the collective need arises, in response to parent leadership from different elementary school campuses or from different language needs.

20120224 21:59:16 nbsp My 6yo daughter started in TALK when she started Kindergarten this year. Its been great. She has fun each morning in French, which helps her wake up and get ready for school. Her teacher walks her and a few other kids to their classrooms, and shes developing vocabulary while also associating foreign language with fun. Classes are small and the teachers really enjoy kids! Users/NicoleR

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
program complex_dp_param

    integer, parameter :: prec1 = 4, prec2 = 8
    complex(prec1) :: u = (1.05, 1.05)
    complex(prec2) :: v = (1.05, 1.05_8)
    complex(prec2) :: zero = 0.0_4
    print *, u, v, zero

end program

max_stars_repo_name: Thirumalai-Shaktivel/lfortran

max_issues_repo_name: Thirumalai-Shaktivel/lfortran

max_forks_repo_name: Thirumalai-Shaktivel/lfortran


text:
! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/quickbeam/zeff.f90 $
  subroutine zeff(freq,D,N,nsizes,k2,tt,ice,xr,z_eff,z_ray,kr,qe,qs,rho_e)
  use math_lib
  use optics_lib
  implicit none

! Purpose:
!   Simulates radar return of a volume given DSD of spheres
!   Part of QuickBeam v1.03 by John Haynes
!   http://reef.atmos.colostate.edu/haynes/radarsim
!
! Inputs:
!   [freq]      radar frequency (GHz)
!   [D]         discrete drop sizes (um)
!   [N]         discrete concentrations (cm^-3 um^-1)
!   [nsizes]    number of discrete drop sizes
!   [k2]        |K|^2, -1=use frequency dependent default
!   [tt]        hydrometeor temperature (K)
!   [ice]       indicates volume consists of ice
!   [xr]        perform Rayleigh calculations?
!   [qe]        if using a mie table, these contain ext/sca ...
!   [qs]        ... efficiencies; otherwise set to -1
!   [rho_e]     medium effective density (kg m^-3) (-1 = pure)
!
! Outputs:
!   [z_eff]     unattenuated effective reflectivity factor (mm^6/m^3)
!   [z_ray]     reflectivity factor, Rayleigh only (mm^6/m^3)
!   [kr]        attenuation coefficient (db km^-1)
!
! Created:
!   11/28/05  John Haynes (haynes@atmos.colostate.edu)

! ----- INPUTS -----
  integer, intent(in) :: ice, xr
  integer, intent(in) :: nsizes
  real*8, intent(in) :: freq,D(nsizes),N(nsizes),tt,qe(nsizes), &
    qs(nsizes), rho_e(nsizes)
  real*8, intent(inout) :: k2

! ----- OUTPUTS -----
  real*8, intent(out) :: z_eff,z_ray,kr

! ----- INTERNAL -----
  integer :: &
  correct_for_rho        ! correct for density flag
  real*8, dimension(nsizes) :: &
  D0, &                  ! D in (m)
  N0, &                  ! N in m^-3 m^-1
  sizep, &               ! size parameter
  qext, &           ! extinction efficiency
  qbsca, &               ! backscatter efficiency
  rho_ice, &             ! bulk density ice (kg m^-3)
  f                 ! ice fraction
  real*8, dimension(nsizes) :: xtemp
  real*8 :: &
  wl, &                  ! wavelength (m)
  cr                            ! kr(dB/km) = cr * kr(1/km)
  complex*16 :: &
  m                 ! complex index of refraction of bulk form
  complex*16, dimension(nsizes) :: &
  m0                ! complex index of refraction

  integer*4 :: i,one
  real*8 :: pi
  real*8 :: eta_sum, eta_mie, const, z0_eff, z0_ray, k_sum, &
            n_r, n_i, dqv(1), dqsc, dg, dph(1)
  integer*4 :: err
  complex*16 :: Xs1(1), Xs2(1)

  one=1
  pi = acos(-1.0)
  rho_ice(:) = 917
  z0_ray = 0.0

! // conversions
  D0 = d*1E-6            ! m
  N0 = n*1E12            ! 1/(m^3 m)
  wl = 2.99792458/(freq*10)   ! m

! // dielectric constant |k^2| defaults
  if (k2 < 0) then
    k2 = 0.933
    if (abs(94.-freq) < 3.) k2=0.75
    if (abs(35.-freq) < 3.) k2=0.88
    if (abs(13.8-freq) < 3.) k2=0.925
  endif

  if (qe(1) < -9) then

!   // get the refractive index of the bulk hydrometeors
    if (ice == 0) then
      call m_wat(freq,tt,n_r,n_i)
    else
      call m_ice(freq,tt,n_r,n_i)
    endif
    m = cmplx(n_r,-n_i)
    m0(:) = m

    correct_for_rho = 0
    if ((ice == 1) .and. (minval(rho_e) >= 0)) correct_for_rho = 1

!   :: correct refractive index for ice density if needed
    if (correct_for_rho == 1) then
      f = rho_e/rho_ice
      m0 = ((2+m0**2+2*f*(m0**2-1))/(2+m0**2+f*(1-m0**2)))**(0.5)
    endif

!   :: Mie calculations
    sizep = (pi*D0)/wl
    dqv(1) = 0.
    do i=1,nsizes
      call mieint(sizep(i), m0(i), one, dqv, qext(i), dqsc, qbsca(i), &
        dg, xs1, xs2, dph, err)
    end do

  else
!   // Mie table used

    qext = qe
    qbsca = qs

  endif

! // eta_mie = 0.25*sum[qbsca*pi*D^2*N(D)*deltaD]
!                   <--------- eta_sum --------->
! // z0_eff = (wl^4/!pi^5)*(1./k2)*eta_mie
  eta_sum = 0.
  if (size(D0) == 1) then
    eta_sum = qbsca(1)*(n(1)*1E6)*D0(1)**2
  else
    xtemp = qbsca*N0*D0**2
    call avint(xtemp,D0,nsizes,D0(1),D0(size(D0,1)),eta_sum)
  endif

  eta_mie = eta_sum*0.25*pi
  const = (wl**4/pi**5)*(1./k2)
  z0_eff = const*eta_mie

! // kr = 0.25*cr*sum[qext*pi*D^2*N(D)*deltaD]
!                 <---------- k_sum --------->
  k_sum = 0.
  if (size(D0) == 1) then
    k_sum = qext(1)*(n(1)*1E6)*D0(1)**2
  else
    xtemp = qext*N0*D0**2
    call avint(xtemp,D0,nsizes,D0(1),D0(size(D0,1)),k_sum)
  endif
  cr = 10./log(10.)
  kr = k_sum*0.25*pi*(1000.*cr)

! // z_ray = sum[D^6*N(D)*deltaD]
  if (xr == 1) then
    z0_ray = 0.
    if (size(D0) == 1) then
      z0_ray = (n(1)*1E6)*D0(1)**6
    else
      xtemp = N0*D0**6
      call avint(xtemp,D0,nsizes,D0(1),D0(size(D0)),z0_ray)
    endif
  endif

! // convert to mm^6/m^3
  z_eff = z0_eff*1E18 !  10.*alog10(z0_eff*1E18)
  z_ray = z0_ray*1E18 !  10.*alog10(z0_ray*1E18)

  end subroutine zeff

max_stars_repo_licenses: zlib-acknowledgement RSA-MD FTL

max_issues_repo_licenses: zlib-acknowledgement RSA-MD FTL

max_forks_repo_licenses: zlib-acknowledgement RSA-MD FTL