text:
!-----------------------------------------------------------------------
!     Subroutine:    fieldlines_init_nescoil
!     Authors:       S. Lazerson (lazerson@pppl.gov)
!     Date:          04/28/2016
!     Description:   This subroutine reads the NESCOIL output file
!                    and calculates the field from that file.
!-----------------------------------------------------------------------
      SUBROUTINE fieldlines_init_nescoil
!-----------------------------------------------------------------------
!     Libraries
!-----------------------------------------------------------------------
      USE stel_kinds, ONLY: rprec
      USE safe_open_mod
      USE fieldlines_runtime
      USE fieldlines_grid, ONLY: raxis_g => raxis, phiaxis, &
                                 zaxis_g => zaxis, nr, nphi, nz, &
                                 rmin, rmax, zmin, zmax, phimin, &
                                 phimax, B_R, B_Z, B_PHI,&
                                 BR_spl, BZ_spl
      USE fieldlines_lines, ONLY: nlines
      USE mpi_params
      USE mpi_inc
!-----------------------------------------------------------------------
!     Local Variables
!          ier            Error Flag
!          iunit          File ID Number
!-----------------------------------------------------------------------
      IMPLICIT NONE
      INTEGER, PARAMETER :: BYTE_8 = SELECTED_INT_KIND (8)
#if defined(MPI_OPT)
      INTEGER :: sender, status(MPI_STATUS_SIZE)                     !mpi stuff
      INTEGER(KIND=BYTE_8),ALLOCATABLE :: mnum(:), moffsets(:)
#endif
      INTEGER(KIND=BYTE_8) :: icount, chunk
      INTEGER :: s, i, j, k, nu, nv, mystart,myend

      INTEGER :: iunit, ier, mn_surf, npos, temp_int, mn_pot, &
                 nuv, n, iper, nfp, ibex_nes
      INTEGER, ALLOCATABLE :: xm_surf(:), xn_surf(:), xm_pot(:), xn_pot(:)
      REAL(rprec) :: temp_real, alp, fnuv, x, y, z, bx, by, bz, &
                     bx_temp, by_temp, rmax_nes, rmin_nes, zmax_nes, &
                     zmin_nes, cut_nes, cup_nes
      REAL(rprec), ALLOCATABLE :: rmnc_surf(:), zmns_surf(:), pmns(:),&
                                  x_surf(:), y_surf(:), z_surf(:), &
                                  xu_surf(:),yu_surf(:),zu_surf(:),&
                                  xv_surf(:),yv_surf(:),zv_surf(:),&
                                  snx(:),sny(:),snz(:), &
                                  pot_surf(:), xcur(:), ycur(:), zcur(:),&
                                  dbx(:), dby(:), dbz(:), dn(:), sq2(:),&
                                  sq3(:), dx(:), dy(:), dz(:)
      DOUBLE PRECISION, ALLOCATABLE :: temp_3D(:,:,:)
      DOUBLE PRECISION, ALLOCATABLE :: xu(:), xv(:)
      DOUBLE PRECISION, ALLOCATABLE :: fmn_temp(:,:)
      CHARACTER(256) :: temp_str
!-----------------------------------------------------------------------
!     Begin Subroutine
!-----------------------------------------------------------------------
      ! Set some defaults
      nu = 128; nv = 128; nuv = nu * nv; fnuv = REAL(1)/REAL(nuv)

      ! Read the NESCOIL FILE
      IF (myworkid == master) THEN
          npos = 1
          CALL safe_open(iunit,ier,'nescout.'//TRIM(nescoil_string),'unknown','formatted')
          DO
          READ(iunit,'(A256)') temp_str
          npos = npos + 1
          IF (temp_str(1:40) == '----- Plasma information from VMEC -----') THEN
               READ(iunit,'(A256)') temp_str ! 'np, iota_edge, phip_edge, curpol'
               npos = npos + 1
               READ(iunit,*)  nfp, temp_real, temp_real, temp_real
               npos = npos + 1
          END IF
          IF (temp_str(1:28) == '----- Current Controls -----') THEN
               READ(iunit,'(A256)') temp_str ! 'cut, cup, ibex'
               npos = npos + 1
               READ(iunit,*)  cut_nes, cup_nes, ibex_nes
               npos = npos + 1
          END IF
          IF (temp_str(1:24) == '----- Coil Surface -----') THEN
               READ(iunit,'(A256)') temp_str ! 'Number of fourier modes in table'
               npos = npos + 1
               READ(iunit,*) mn_surf
               npos = npos + 1
               ALLOCATE(xm_surf(mn_surf),xn_surf(mn_surf),rmnc_surf(mn_surf),zmns_surf(mn_surf))
               READ(iunit,'(A256)') temp_str ! '----- Coil surface fourier coefficients -----'
               npos = npos + 1
               READ(iunit,'(A256)') temp_str ! '    m    n         R(m,n)         Z(m,n)'
               npos = npos + 1
               DO i = 1, mn_surf
                    READ(iunit,*)  xm_surf(i), xn_surf(i), rmnc_surf(i),zmns_surf(i), temp_real, temp_real
                    npos = npos + 1
               END DO
          END IF
          IF (temp_str(1:35) == '---- Phi(m,n) for least squares ---') THEN
               mn_pot = 0
               DO
                    ier = 0
                    READ(UNIT=iunit,FMT=*,IOSTAT=ier) temp_int, temp_int, temp_real
                    IF (ier /=0) EXIT
                    mn_pot = mn_pot + 1
               END DO
               ALLOCATE(xm_pot(mn_pot),xn_pot(mn_pot),pmns(mn_pot))
               REWIND(iunit)
               DO i = 1, npos
                    READ(iunit,'(A256)') temp_str
               END DO
               DO i = 1, mn_pot
                    ier = 0
                    READ(UNIT=iunit,FMT=*,IOSTAT=ier) xm_pot(i), xn_pot(i), pmns(i)
               END DO
               EXIT
          END IF
          END DO
          CLOSE(iunit)

          ! Transform to real space
          alp  = pi2/nfp
          ALLOCATE(xu(nu),xv(nv))
          FORALL(i = 1:nu) xu(i) = REAL(i-1)/REAL(nu)
          FORALL(i = 1:nv) xv(i) = REAL(i-1)/REAL(nv)

          ! Transform Boundary (Note NESCOIL convention is mu+nv)
          ALLOCATE(temp_3D(1,nu,nv),fmn_temp(mn_surf,1))
          ALLOCATE(x_surf(nuv), y_surf(nuv), z_surf(nuv), pot_surf(nuv))
          FORALL(i = 1:mn_surf) fmn_temp(i,1) = rmnc_surf(i)
          STOP "NEED TO FIX FIELDLINES_INIT_NESCOIL TO SUPPORT mntouv_local NOW PRIVATE"
          !CALL mntouv(1,1,mn_surf,nu,nv,xu,xv,fmn_temp,xm_surf,xn_surf,temp_3D,0,1)
          rmax_nes = maxval(maxval(maxval(temp_3D,DIM=3),DIM=2),DIM=1)
          rmin_nes = minval(minval(minval(temp_3D,DIM=3),DIM=2),DIM=1)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                x_surf(n) = temp_3D(1,i,j)*cos(pi2*xv(j)/nfp)
                y_surf(n) = temp_3D(1,i,j)*sin(pi2*xv(j)/nfp)
                n = n + 1
             END DO
          END DO
          temp_3D = 0
          FORALL(i = 1:mn_surf) fmn_temp(i,1) = zmns_surf(i)
          !CALL mntouv(1,1,mn_surf,nu,nv,xu,xv,fmn_temp,xm_surf,xn_surf,temp_3D,1,0)
          zmax_nes = maxval(maxval(maxval(temp_3D,DIM=3),DIM=2),DIM=1)
          zmin_nes = minval(minval(minval(temp_3D,DIM=3),DIM=2),DIM=1)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                z_surf(n) = temp_3D(1,i,j)
                n = n + 1
             END DO
          END DO

          ! Calculate Surface normals
          ALLOCATE(xu_surf(nuv), yu_surf(nuv))
          FORALL(i = 1:mn_surf) fmn_temp(i,1) = -rmnc_surf(i)*xm_surf(i)
          !CALL mntouv(1,1,mn_surf,nu,nv,xu,xv,fmn_temp,xm_surf,xn_surf,temp_3D,1,0)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                xu_surf(n) = temp_3D(1,i,j)*cos(pi2*xv(j))
                yu_surf(n) = temp_3D(1,i,j)*sin(pi2*xv(j))
                n = n + 1
             END DO
          END DO
          ALLOCATE(xv_surf(nuv), yv_surf(nuv))
          FORALL(i = 1:mn_surf) fmn_temp(i,1) = -rmnc_surf(i)*xn_surf(i)
          !CALL mntouv(1,1,mn_surf,nu,nv,xu,xv,fmn_temp,xm_surf,xn_surf,temp_3D,1,0)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                xv_surf(n) = temp_3D(1,i,j)*cos(pi2*xv(j))
                yv_surf(n) = temp_3D(1,i,j)*sin(pi2*xv(j))
                n = n + 1
             END DO
          END DO
          xv_surf = xv_surf - y_surf
          yv_surf = yv_surf + x_surf
          ALLOCATE(zu_surf(nuv))
          FORALL(i = 1:mn_surf) fmn_temp(i,1) = zmns_surf(i)*xm_surf(i)
          !CALL mntouv(1,1,mn_surf,nu,nv,xu,xv,fmn_temp,xm_surf,xn_surf,temp_3D,0,0)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                zu_surf(n) = temp_3D(1,i,j)
                n = n + 1
             END DO
          END DO
          ALLOCATE(zv_surf(nuv))
          FORALL(i = 1:mn_surf) fmn_temp(i,1) = zmns_surf(i)*xn_surf(i)
          !CALL mntouv(1,1,mn_surf,nu,nv,xu,xv,fmn_temp,xm_surf,xn_surf,temp_3D,0,0)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                zv_surf(n) = temp_3D(1,i,j)
                n = n + 1
             END DO
          END DO
          DEALLOCATE(rmnc_surf, zmns_surf, xm_surf, xn_surf)
          DEALLOCATE(temp_3D, fmn_temp)
          ALLOCATE(snx(nuv),sny(nuv),snz(nuv),xcur(nuv),ycur(nuv),zcur(nuv))
          snx = yu_surf * zv_surf - zu_surf * yv_surf
          sny = zu_surf * xv_surf - xu_surf * zv_surf
          snz = xu_surf * yv_surf - yu_surf * xv_surf
          xcur = cut_nes*xv_surf-cup_nes*xu_surf
          ycur = cut_nes*yv_surf-cup_nes*yu_surf
          zcur = cut_nes*zv_surf-cup_nes*zu_surf
          DEALLOCATE(xu_surf, yu_surf, zu_surf, xv_surf, yv_surf, zv_surf)
          ALLOCATE(dbx(nuv),dby(nuv),dbz(nuv),dn(nuv),sq2(nuv),sq3(nuv),dx(nuv),dy(nuv),dz(nuv))

          ALLOCATE(temp_3D(1,nu,nv),fmn_temp(mn_pot,1))
          temp_3D = 0
          FORALL(i = 1:mn_pot) fmn_temp(i,1) = pmns(i)
          !CALL mntouv(1,1,mn_pot,nu,nv,xu,xv,fmn_temp,xm_pot,xn_pot,temp_3D,1,1)
          n = 1
          DO i = 1, nu
             DO j = 1, nv
                pot_surf(n) = temp_3D(1,i,j)
                n = n + 1
             END DO
          END DO
          DEALLOCATE(pmns, xn_pot, xm_pot)
          DEALLOCATE(temp_3D, fmn_temp, xu, xv)

      ELSE
         ALLOCATE(x_surf(nuv), y_surf(nuv), z_surf(nuv), pot_surf(nuv), &
                  snx(nuv), sny(nuv), snz(nuv), xcur(nuv), ycur(nuv), zcur(nuv))
         ALLOCATE(dbx(nuv),dby(nuv),dbz(nuv),dn(nuv),sq2(nuv),sq3(nuv),dx(nuv),dy(nuv),dz(nuv))
      END IF

      !

#if defined(MPI_OPT)
      CALL MPI_BARRIER(MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /=0) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 1',ierr_mpi)
      CALL MPI_BCAST(nfp,1,MPI_INTEGER, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 2',ierr_mpi)
      CALL MPI_BCAST(alp,1,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 3',ierr_mpi)
      CALL MPI_BCAST(x_surf,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 5',ierr_mpi)
      CALL MPI_BCAST(y_surf,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 6',ierr_mpi)
      CALL MPI_BCAST(z_surf,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 7',ierr_mpi)
      CALL MPI_BCAST(pot_surf,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 8',ierr_mpi)
      CALL MPI_BCAST(snx,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 9',ierr_mpi)
      CALL MPI_BCAST(sny,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 10',ierr_mpi)
      CALL MPI_BCAST(snz,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 11',ierr_mpi)
      CALL MPI_BCAST(xcur,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 12',ierr_mpi)
      CALL MPI_BCAST(ycur,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 13',ierr_mpi)
      CALL MPI_BCAST(zcur,nuv,MPI_DOUBLE_PRECISION, master, MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /= MPI_SUCCESS) CALL handle_err(MPI_BCAST_ERR,'fieldlines_init_nescoil 14',ierr_mpi)
#endif

      IF (lverb) THEN
         WRITE(6,'(A)') '----- NESCOIL Current Surface -----'
         WRITE(6,'(A,F8.5,A,F8.5,A,I4)') '   R   = [',rmin_nes,',',rmax_nes,'];  NU:   ',nu
         WRITE(6,'(A,F8.5,A,F8.5,A,I4)') '   Z   = [',zmin_nes,',',zmax_nes,'];  NV:   ',nv
         !IF (.not.lplasma_only) CALL virtual_casing_info(6)
         WRITE(6,'(5X,A,I3.3,A)',ADVANCE='no') 'Vacuum Field Calculation [',0,']%'
         CALL FLUSH(6)
      END IF

      ! Break up the Work
      chunk = FLOOR(REAL(nr*nphi*nz) / REAL(nprocs_fieldlines))
      mystart = myworkid*chunk + 1
      myend = mystart + chunk - 1

      ! This section sets up the work so we can use ALLGATHERV
#if defined(MPI_OPT)
      IF (ALLOCATED(mnum)) DEALLOCATE(mnum)
      IF (ALLOCATED(moffsets)) DEALLOCATE(moffsets)
      ALLOCATE(mnum(nprocs_fieldlines), moffsets(nprocs_fieldlines))
      CALL MPI_ALLGATHER(chunk,1,MPI_INTEGER,mnum,1,MPI_INTEGER,MPI_COMM_FIELDLINES,ierr_mpi)
      CALL MPI_ALLGATHER(mystart,1,MPI_INTEGER,moffsets,1,MPI_INTEGER,MPI_COMM_FIELDLINES,ierr_mpi)
      i = 1
      DO
         IF ((moffsets(nprocs_fieldlines)+mnum(nprocs_fieldlines)-1) == nr*nphi*nz) EXIT
         IF (i == nprocs_fieldlines) i = 1
         mnum(i) = mnum(i) + 1
         moffsets(i+1:nprocs_fieldlines) = moffsets(i+1:nprocs_fieldlines) + 1
         i=i+1
      END DO
      mystart = moffsets(myworkid+1)
      chunk  = mnum(myworkid+1)
      myend   = mystart + chunk - 1
#endif
      IF (lafield_only) THEN
            ! This is not supported
      ELSE
         DO s = mystart, myend
            i = MOD(s-1,nr)+1
            j = MOD(s-1,nr*nphi)
            j = FLOOR(REAL(j) / REAL(nr))+1
            k = CEILING(REAL(s) / REAL(nr*nphi))
            x = raxis_g(i)*COS(phiaxis(j))
            y = raxis_g(i)*SIN(phiaxis(j))
            z = zaxis_g(k)
            bx = 0; by = 0; bz = 0;
            DO iper = 0, nfp-1  ! Take advantage of symmetry
               dx = x_surf * COS(alp * iper) + y_surf * SIN(alp * iper) - x
               dy = y_surf * COS(alp * iper) - x_surf * SIN(alp * iper) - y
               dz = z_surf - z
               sq2 = 1/(dx*dx + dy*dy + dz*dz)
               sq3 = sq2*SQRT(sq2)
               dn  = 3*sq2*(snx*dx + sny*dy + snz*dz)*pot_surf
               dbx = (snx*pot_surf - dn*dx + ycur*dz - zcur*dy)*sq3
               dby = (sny*pot_surf - dn*dy + zcur*dx - xcur*dz)*sq3
               dbz = (snz*pot_surf - dn*dz + xcur*dy - ycur*dx)*sq3
               bx_temp = SUM(dbx)*fnuv
               by_temp = SUM(dby)*fnuv
               bx = bx + (bx_temp * COS(alp * iper) - by_temp * SIN(alp * iper))
               by = by + (by_temp * COS(alp * iper) + bx_temp * SIN(alp * iper))
               !IF (myworkid == 10) THEN; WRITE(6,*) fnuv; CALL FLUSH(6); STOP; END IF
               B_Z(i,j,k) = B_Z(i,j,k) + SUM(dbz)*fnuv
            END DO
            B_R(i,j,k) = B_R(i,j,k) + bx * COS(phiaxis(j)) + by * sin(phiaxis(j))
            B_PHI(i,j,k) = B_PHI(i,j,k) + by * COS(phiaxis(j)) - bx * sin(phiaxis(j))
            IF (lverb .and. (MOD(s,nr) == 0)) THEN
               CALL backspace_out(6,6)
               WRITE(6,'(A,I3,A)',ADVANCE='no') '[',INT((100.*s)/(myend-mystart+1)),']%'
               CALL FLUSH(6)
            END IF
         END DO
      END IF

      IF (lverb) THEN
         CALL backspace_out(6,36)
         CALL FLUSH(6)
         WRITE(6,'(36X)',ADVANCE='no')
         CALL FLUSH(6)
         CALL backspace_out(6,36)
         CALL FLUSH(6)
      END IF

#if defined(MPI_OPT)
      CALL MPI_BARRIER(MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /=0) CALL handle_err(MPI_BARRIER_ERR,'torlines_init_external',ierr_mpi)
!       ! Adjust indexing to send 2D arrays
       CALL MPI_ALLGATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL,&
                        B_R,mnum,moffsets-1,MPI_DOUBLE_PRECISION,&
                        MPI_COMM_FIELDLINES,ierr_mpi)
       CALL MPI_ALLGATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL,&
                        B_PHI,mnum,moffsets-1,MPI_DOUBLE_PRECISION,&
                        MPI_COMM_FIELDLINES,ierr_mpi)
       CALL MPI_ALLGATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL,&
                        B_Z,mnum,moffsets-1,MPI_DOUBLE_PRECISION,&
                        MPI_COMM_FIELDLINES,ierr_mpi)
       DEALLOCATE(mnum)
       DEALLOCATE(moffsets)
#endif
      WHERE(B_PHI==0) B_PHI=1

#if defined(MPI_OPT)
      CALL MPI_BARRIER(MPI_COMM_FIELDLINES,ierr_mpi)
      IF (ierr_mpi /=0) CALL handle_err(MPI_BARRIER_ERR,'fieldlines_init_vmec',ierr_mpi)
#endif
!-----------------------------------------------------------------------
!     End Subroutine
!-----------------------------------------------------------------------
      END SUBROUTINE fieldlines_init_nescoil

max_stars_repo_name: joseluisvelasco/STELLOPT

max_issues_repo_name: joseluisvelasco/STELLOPT

max_forks_repo_name: joseluisvelasco/STELLOPT


text:
module mod_common_mpi
  implicit none
  integer :: myid,comm_cart,ierr
  integer :: halo(3)
  integer :: ipencil
end module mod_common_mpi

max_stars_repo_name: GabrieleBoga/CaNS

max_issues_repo_name: GabrieleBoga/CaNS

max_forks_repo_name: GabrieleBoga/CaNS


text:
Name: Kristen Martin

Quote of the Moment: We can complain because rose bushes have thorns, or rejoice because thorn bushes have roses. Abraham Lincoln

About me: Im a parent and Civil Engineering student at http://www.csus.edu/ CSUS.  Im an active board member for my sons preschool, http://www.dottot.com/ DOT Tot.  DOT Tot also has a  http://www.sacwiki.org/DOT_Tot SacWiki page.  I graduated from http://baychef.com/ CCA in 2002 with a degree in Culinary Arts, and worked in restaurants in both SF and Sacramento until I decided to go back to school.  I attend First Baptist Church in Davis regularly, and am involved with the Roaring 20s.  I love living in Davis, grew up here, and am now raising my son here.

Food Blog: http://theshamelessfoodies.blogspot.com/ The Shameless Foodies  I used to write this blog with my friend Users/BrooksHayes Brooks, another Davisite.  We havent updated it in a long time, but its still up and there are some interesting posts:)  Check out other Local Food Blogs in the Davis area.

My adopted orphan Davis Wiki page:  Local Spelling Words is no longer an orphaned page:)  Adopted from Orphaned Pages

20070422 20:49:52 nbsp Yay food. Be sure to check out http://sacwiki.org Users/ArlenAbraham

20070423 14:47:21 nbsp I dont know much either, but I saw both your profiles and thought they deserve a link. Users/ToddBartlow

20070425 13:47:57 nbsp Its wonderful to see caring people adopt needy entries.  Youll be proud of what Ellie Words will amount to. Users/JabberWokky

20080420 21:11:56 nbsp Thanks for uploading the Picnic Day banduh pics. Im in the second one! Users/JeremyOgul

ext: f

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


module moves
  !! Contains helpers for user-defined moves
  !!
  !! Before running the simulation, call [[add_move]] to register your moves.
  !! The sum of all probabilities must be inferior to 1. The remaining probability is
  !! the probability of doing a simple particle translation.
  !!
  !! The move procedure should at least return [[moves:mv_acc]] when the move is accepted
  !! and something else otherwise.
  !!
  !!### Example
  !!
  !!```fortran
  !!use moves
  !!integer function cluster_move(st)
  !!  type(PcmcState), intent(in) :: st
  !!  ! implementation left to the reader
  !!  cluster_move = MV_ACC
  !!end function
  !!
  !!type(mcsimulation) :: simu
  !!call add_move(simu%moves,"cluster move", 0.1d0, cluster_move)
  !!```

  use state, only: PcmcState
  use nrg
  implicit none

  interface
    integer function handler_type(st,nr)
      import
      type(PcmcState) :: st
      type(NrgRoutines) :: nr
    end function handler_type
  end interface

  type Mover
    !! Contains info, statistic and handler on MC moves
    integer(8) :: comp !! number of  attempted moves
    integer(8) :: acc    !! number of  accepted moves
    integer(8) :: hcrej  !! number of  rejected moves (hard overlap)
    integer(8) :: cirrej  !! number of rejected moves (neither for overlap nor for energy)
    character(48) :: name !! name of the move
    procedure(handler_type),pointer,nopass :: handler  !! function that attempts the move
  end type Mover

  integer, parameter, private ::  min_mouvs=15

  type MCMoves
    !! Set of moves
    integer :: nmoves = 0
    real(8), allocatable :: prob_mouvs(:)
    type(Mover), allocatable :: mv(:)
  end type MCMoves

  ! Conventions
  integer,parameter :: mv_acc=0      !! Accepted move
  integer,parameter :: mv_hs_rej=1   !! Move rejected for hard sphere overlap
  integer,parameter :: mv_nrj_rej=2  !! Move rejected for energy condition
  integer,parameter :: mv_bc_rej=4   !! Move rejected for out of bondaries condition
  integer,parameter :: mv_cir_rej=3  !! Move rejected for misc circumstances

contains

  subroutine deallocate_moves(mvs)
    type(MCMoves) :: mvs
    if(allocated(mvs%mv)) then
      deallocate(mvs%mv, mvs%prob_mouvs)
    end if
  end subroutine

  subroutine moves_reset(mvs)
    !! Reset the number of additional moves to 0.
    type(MCMoves) :: mvs
    mvs%nmoves = 0
  end subroutine moves_reset

  subroutine add_move(mvs,name,prob,move_proc)
    !! Registers a move in `mvs`.
    type(MCMoves) :: mvs !! container of moves
    real(8), intent(in) :: prob !! Probability of the move (in [0,1[)
    character(*) :: name      !! Name of the move (used for printing stats)
    procedure(handler_type) :: move_proc !! procedure that performs the move itself (signature integer function(PcmcState))
    integer :: nmoves, mvcap, omvcap
    type(Mover), allocatable :: temp_mv(:)
    real(8), allocatable :: temp_pm(:)
    if(.not. allocated(mvs%mv)) then
      allocate(mvs%mv(min_mouvs), mvs%prob_mouvs(min_mouvs))
    end if
    if(prob > 0) then
      nmoves = mvs%nmoves+1

      omvcap = ubound(mvs%mv,1)
      if(nmoves > omvcap) then
        call move_alloc(mvs%mv, temp_mv)
        call move_alloc(mvs%prob_mouvs, temp_pm)
        mvcap = 1 + floor(omvcap*1.5)
        allocate(mvs%mv(mvcap), mvs%prob_mouvs(mvcap))
        mvs%mv(1:omvcap) = temp_mv(1:omvcap)
        mvs%prob_mouvs(1:omvcap) = temp_pm(1:omvcap)
        deallocate(temp_mv, temp_pm)
      end if

      if(nmoves == 1) then
        mvs%prob_mouvs(1) = 0.0 ! 1st move is default move
      else
        mvs%prob_mouvs(nmoves) = mvs%prob_mouvs(nmoves-1) + prob
      end if

      mvs%mv(nmoves)%name = name
      mvs%mv(nmoves)%comp=0
      mvs%mv(nmoves)%acc=0
      mvs%mv(nmoves)%hcrej=0
      mvs%mv(nmoves)%cirrej=0

      mvs%mv(nmoves)%handler => move_proc
      mvs%nmoves = nmoves
    end if
  end subroutine add_move

  subroutine reset_all_moves(mvs)
    !! Reset `mvs`. Useful to make a new run.
    type(MCMoves) :: mvs
    integer :: i
    do i=1,mvs%nmoves
      mvs%mv(i)%comp=0
      mvs%mv(i)%acc=0
      mvs%mv(i)%hcrej=0
      mvs%mv(i)%cirrej=0
    end do
  end subroutine reset_all_moves

  subroutine new_movinst(st,nr,mouv)
    !! Make a move according to `mouv`
    type(PcmcState) :: st
    type(NrgRoutines) :: nr
    type(Mover) :: mouv
    integer :: stat

    stat = mouv%handler(st,nr)
    mouv%comp = mouv%comp + 1
    if(stat == mv_acc) then
      mouv%acc = mouv%acc + 1
    elseif(stat == mv_hs_rej) then
      mouv%hcrej = mouv%hcrej + 1
    elseif(stat == mv_cir_rej) then
      mouv%cirrej = mouv%cirrej + 1
    end if
  end subroutine new_movinst

  integer function select_move(mvs,pppp)
    !! Selects a move with random number `pppp`. (helper function).
    !! Returns index of the selected move.
    type(MCMoves) :: mvs
    real(8),intent(in) :: pppp
    integer :: ii

    select_move=1 ! Defaults on first move
    do ii=2,mvs%nmoves
      if(pppp<mvs%prob_mouvs(ii)) then
        select_move=ii
        exit
      end if
    end do

  end function select_move

  subroutine change_position_random(x, relRay, outfo, st)
    !! Changes a position `x` at random (within an interval).
    !! `outfo` returns information about the move: 0 means a wall has been hit,
    !! 1 is for a regular translation, 2 is for a translation near a wall.
    use random2
    implicit none
    type(PcmcState) :: st
    real(8),intent(in) :: relRay
    integer, intent(out) :: outfo
    real(8),intent(inout) :: x(3)
    integer :: j
    real(8) :: dx, dump,dump2, deltawall
    if(st%mode_box == 2) then
      deltawall = st%rpar%dx_trans + relRay
      if(x(3) < deltawall .or. 1.d0-x(3) < deltawall) then
        ! Special treatment near a wall. relRay should be the (reduced) radius of the particle.
        dx = st%rpar%dx_trans_wall
        outfo = 2
      else
        dx = st%rpar%dx_trans
        outfo = 1
      end if
      !PBC on X,Y
      do j=1,2
        dump2=x(j)+dx*(ran2(st%rng)-0.5d0)
        dump=modulo(dump2,1.d0)
        x(j)=dump
      enddo
      ! Hard Z Wall
      dump2=x(3)+dx*(ran2(st%rng)-0.5d0)
      if(dump2 < 0.d0  .or. dump2 >  1.d0) then
        outfo = 0
        return
      endif
    else
      dx = st%rpar%dx_trans
      outfo = 1
      do j=1,3
        dump2=x(j)+dx*(ran2(st%rng)-0.5d0)
        dump=modulo(dump2,1.d0)
        x(j)=dump
      enddo
    end if

  end subroutine change_position_random

  integer function translation1P(st, nr)
    !! Attempts a simple translation of a particle in a box.
    use state
    implicit none
    type(PcmcState) :: st
    type(NrgRoutines) :: nr
    type(NrgRec) :: ener1,ener0
    integer :: ip,ibox,counter=0, outfo_rcp
    real(8) :: store_pos(3),pp(3)
    counter=counter+1
    ibox = 1 + floor(ran2(st%rng)*st%ntotbox)
    ip = 1 + floor(ran2(st%rng)*st%boxes(ibox)%n)
    associate(part => st%boxes(ibox)%Parts(ip))

    store_pos=part%pos

    ener0 = nr%energy_1p(st,st%boxes(ibox),part)

    pp = part%pos
    call change_position_random(pp, part%rayon/st%boxes(ibox)%tens(3,3), outfo_rcp,st)
    if(outfo_rcp==0) then
      translation1P=4
      return
    end if
    call change_part_pos(st,ibox, ip, pp, store_pos)
    ener1 = nr%energy_1p(st,st%boxes(ibox),part)
    if(ener1%noverlap) then
      if(metropolis((ener1%ep-ener0%ep)/kT,st%rng)) then
        st%boxes(ibox)%ener%ep = st%boxes(ibox)%ener%ep + ener1%ep - ener0%ep
        translation1P=0
      else
        call change_part_pos(st,ibox, ip, store_pos, pp)
        translation1P=2
      endif
    else
      call change_part_pos(st,ibox, ip, store_pos, pp)
      translation1P=1
    endif

    st%sdata%trans_eff = st%sdata%trans_eff + 1
    if(translation1P==0) st%sdata%reuss_trans=st%sdata%reuss_trans + 1
    if(st%mode_box == 2) then
      st%transss = st%transss + 1
      if(outfo_rcp == 2) then
        st%trans_wall = st%trans_wall + 1
        if(translation1P==0) st%reuss_trans_wall = st%reuss_trans_wall + 1
      else if(outfo_rcp == 1) then
        st%trans_outwall = st%trans_outwall + 1
        if(translation1P==0) st%reuss_trans_outwall = st%reuss_trans_outwall + 1
      end if
    end if

    end associate
  end function translation1P

  subroutine change_part_pos(st, box, ip, new_pos, old_pos)
    !! Changes the position of particle. Returns old position in `old_pos`.
    use celldec
    type(PcmcState) :: st
    integer,intent(in) :: ip,box
    real(8), intent(in) :: new_pos(3)
    real(8), intent(out) :: old_pos(3)
    old_pos = st%boxes(box)%parts(ip)%pos
    st%boxes(box)%parts(ip)%pos = new_pos
    if(st%celllist) call celldec_update(st%boxes(box)%parts(ip),st%clistdecomp(box))
  end subroutine change_part_pos

  subroutine change_part_radius(st, box, ip, new_radius)
    !! Changes the radius of particle `ip`.
    type(PcmcState) :: st
    integer,intent(in) :: ip, box
    real(8), intent(in) :: new_radius
    integer :: old_fam, fam, j
    real(8) :: mr
    st%boxes(box)%parts(ip)%rayon = new_radius
    old_fam = st%boxes(box)%parts(ip)%famille
    ! Updates family within the predefined distribution.
    ! ⚠ Supposes a sorted distribution, may not work.
    if(st%dist%nfam <= 1) then
      fam = 1
    else if(new_radius <= st%dist%rad(1)) then
      fam = 1
    else if(new_radius >= st%dist%rad(st%dist%nfam)) then
      fam = st%dist%nfam
    else
      do j=1, st%dist%nfam-1, 1
        if(st%dist%rad(j) <= new_radius .and. new_radius < st%dist%rad(j+1)) exit
      end do
      mr = 0.5d0*(st%dist%rad(j+1) + st%dist%rad(j))
      if(new_radius <= mr) then
        fam = j
      else
        fam = j+1
      end if
    end if
    if(old_fam /= fam) call change_part_family(st, box, ip, fam)
  end subroutine change_part_radius

  subroutine change_part_echarge(st, box, ip, new_charge)
    !! Changes the internal charge of particle `ip`.
    !! @Warning
    !! For yukawa model it is (effective charge) × exp(κ R)/(1+κ R).
    !! In general adapt to the model used.
    !! @endwarning
    type(PcmcState) :: st
    integer,intent(in) :: ip, box
    real(8), intent(in) :: new_charge
    st%boxes(box)%parts(ip)%ech = new_charge
  end subroutine change_part_echarge

  subroutine change_part_family(st, box, ip, new_family)
    !! Changes the family of a particle `ip`.
    type(PcmcState) :: st
    integer,intent(in) :: ip, box
    integer, intent(in) :: new_family
    integer :: old_fam
    old_fam = st%boxes(box)%parts(ip)%famille
    ! should check if famille is in range
    if(old_fam /= new_family) then
      st%boxes(box)%parts(ip)%famille = new_family
      st%boxes(box)%fam(old_fam) = st%boxes(box)%fam(old_fam) - 1
      st%boxes(box)%fam(new_family) = st%boxes(box)%fam(new_family) + 1
    end if
  end subroutine change_part_family

  subroutine remove_part_box(st, box, ip)
    !! Removes particle `ip` from box `box`.
    use celldec
    implicit none
    type(PcmcState) :: st
    integer,intent(in) :: box, ip
    type(Particule) :: part
    call remove_part_box_nocelllist(st, box, ip, part)
    if(st%celllist) call celldec_update_all(st%clistdecomp(box), st%boxes(box)%n, st%boxes(box)%parts)
  end subroutine remove_part_box

  subroutine remove_part_box_nocelllist(st,box,ip, part)
    !> Removes particle *ip* from box *box*.
    !! @Warning
    !! This version does not update the cell decomposition.
    !! @endwarning
    use celldec, only: Particule
    implicit none
    type(PcmcState) :: st
    integer, intent(in) :: ip,box
    type(Particule), intent(out) :: part
    integer :: i,f

    part = st%boxes(box)%parts(ip)
    f = st%boxes(box)%parts(ip)%famille

    st%boxes(box)%fam(f) = st%boxes(box)%fam(f) - 1
    st%boxes(box)%n = st%boxes(box)%n - 1
    ! Shuffle. Invalidates all pointers (and reference indices) to parts(ip:n) !
    ! And O(n) operation. Alternative is to make holes.
    do i=ip,st%boxes(box)%n
      st%boxes(box)%parts(i) = st%boxes(box)%parts(i+1)
    end do
  end subroutine remove_part_box_nocelllist

  subroutine add_part_box(st, box, part)
    !> Adds particle *part* to box *box*.
    use celldec
    implicit none
    type(PcmcState) :: st
    type(Particule),intent(in) :: part  ! particle
    integer,intent(in) :: box  !! box number
    call add_part_box_nocelllist(st, box, part)
    if(st%celllist) then
      call celldec_add(st%boxes(box)%parts(st%boxes(box)%n),st%clistdecomp(box))
    end if
  end subroutine add_part_box

  subroutine add_part_box_nocelllist(st,box,part)
    !> Adds particle *part* to box *box*.
    !! @Warning
    !! This version does not update the cell decomposition.
    !! @endwarning
    use celldec
    use iso_fortran_env
    implicit none
    type(PcmcState) :: st
    type(Particule),intent(in) :: part
    integer,intent(in) :: box

    integer :: no
    no = st%boxes(box)%n
    if((no+1) > ubound(st%boxes(box)%parts,1)) then
      write(error_unit, '(A,I0,A)') "Error: Reached the maximum number of particles (", ubound(st%boxes(box)%parts,1),")."
      write(error_unit,'(A)') "       You can increase 'max_number_of_particles' in your configuration."
      stop 9
    end if
    st%boxes(box)%n=no+1
    st%boxes(box)%parts(no+1) = part
    st%boxes(box)%fam(part%famille) = st%boxes(box)%fam(part%famille) + 1
  end subroutine add_part_box_nocelllist

  subroutine swap_2parts(st,ibox, part1, part2)
    !! Swaps two particles.
    use celldec
    type(PcmcState) :: st
    integer, intent(in) :: ibox  !! box number
    type(Particule), intent(inout) :: part1, part2
    real(8) :: store_pos(3)
    store_pos=part1%pos
    part1%pos=part2%pos
    part2%pos=store_pos
    if(st%celllist) call celldec_echange(part1,part2,st%clistdecomp(ibox))
  end subroutine swap_2parts

  subroutine swap_2parts_2box(st,ibox1, ibox2, part1, part2)
    !! Swaps two particles between two boxes.
    use celldec
    type(PcmcState) :: st
    integer, intent(in) :: ibox1, ibox2
    type(Particule), intent(inout) :: part1, part2
    type(Particule) :: store_part
    integer :: fam1, fam2
    fam1 = part1%famille
    fam2 = part2%famille
    store_part = part1
    ! Note: Reference to particles (index or pointer) would points to a different particle
    call part_transfer_props(part2, part1)
    call part_transfer_props(store_part, part2)
    ! Needs to update box distributions
    st%boxes(ibox1)%fam(fam1)=st%boxes(ibox1)%fam(fam1)-1
    st%boxes(ibox1)%fam(fam2)=st%boxes(ibox1)%fam(fam2)+1
    st%boxes(ibox2)%fam(fam2)=st%boxes(ibox2)%fam(fam2)-1
    st%boxes(ibox2)%fam(fam1)=st%boxes(ibox2)%fam(fam1)+1
  end subroutine swap_2parts_2box

  subroutine transfer_part_b2b(st,part,box1,box2)
    !! Transfer a particle from box `box1` to box `box2`.
    use celldec
    use iso_fortran_env
    implicit none
    type(PcmcState),target :: st
    type(Particule),target :: part
    integer, intent(in) :: box1,box2

    type(Particule),pointer :: partN
    integer :: fam

    ! Add part to box2
    fam = part%famille
    st%boxes(box2)%n = st%boxes(box2)%n + 1
    if(st%boxes(box2)%n > ubound(st%boxes(box2)%parts,1)) then
      write(error_unit, '(A,I0,A)') "Error: Reached the maximum number of particles (", ubound(st%boxes(box2)%parts,1),")."
      write(error_unit,'(A)') "       To work around this you can increase 'max_number_of_particles' in your configuration."
      stop 3
    end if
    st%boxes(box2)%fam(fam) = st%boxes(box2)%fam(fam) + 1
    call part_transfer_props(part, st%boxes(box2)%parts(st%boxes(box2)%n))
    st%boxes(box2)%parts(st%boxes(box2)%n)%pos = part%pos
    if(st%celllist) call celldec_add(st%boxes(box2)%parts(st%boxes(box2)%n),st%clistdecomp(box2))

    ! Then the trick is to transfer the last particle of box1 to part location
    partN => st%boxes(box1)%parts(st%boxes(box1)%n)
    if(.not. associated(partN, part)) then
      call part_transfer_props(partN, part)
      part%pos = partN%pos
    end if
    ! Then the new last particle can be "removed".
    st%boxes(box1)%n = st%boxes(box1)%n - 1
    st%boxes(box1)%fam(fam) = st%boxes(box1)%fam(fam) - 1
    ! Updates cell decomposition
    if(st%celllist) then
      if(associated(part%precedent)) then
        part%precedent%suivant => part%suivant
      else
        st%clistdecomp(box1)%cells(part%cellule)%hoc => part%suivant
      end if
      if(associated(part%suivant)) part%suivant%precedent => part%precedent

      if(.not.associated(partN,part)) then
        part%precedent => partN%precedent
        part%suivant => partN%suivant
        if(associated(partN%suivant)) partN%suivant%precedent => part
        if(associated(partN%precedent)) then
          partN%precedent%suivant => part
        else
          st%clistdecomp(box1)%cells(partN%cellule)%hoc => part
        end if
        part%cellule = partN%cellule
      end if
    end if

  end subroutine transfer_part_b2b

end module moves


text:
../aes/rtl/AesControl.v
../aes/rtl/AesDecipher.v
../aes/rtl/AesEncipher.v
../aes/rtl/AesInvMixColumns.v
../aes/rtl/AesInvShiftRows.v
../aes/rtl/AesInvSubBytes.v
../aes/rtl/AesKeyExpansion.v
../aes/rtl/AesMixColumns.v
../aes/rtl/AesShiftRows.v
../aes/rtl/AesSubBytes.v
../aes/rtl/Aes.v
../aes/rtl/SPSR.v

../krnl_aes/rtl/axis_interface.sv
../krnl_aes/rtl/krnl_aes_axi_ctrl_slave.v
../krnl_aes/rtl/aes_wrapper.sv
../krnl_aes/rtl/krnl_aes.sv

./rtl/axi_master_counter.sv
./rtl/axi_read_master.sv
./rtl/axi_write_master.sv
./rtl/cbc_engine.v
./rtl/engine_control.v
./rtl/FifoCtlType0.v
./rtl/FifoType0.v
./rtl/krnl_cbc_ctrl_slave.v
./rtl/krnl_cbc.v
./rtl/TPSR.v

./ip_generation/axi_vip_mst/sim/axi_vip_mst_pkg.sv
./ip_generation/axi_vip_mst/sim/axi_vip_mst.sv
./ip_generation/axi_vip_mst/hdl/axi_vip_v1_1_vl_rfs.sv
./ip_generation/axi_vip_mst/hdl/axi_infrastructure_v1_1_vl_rfs.v
./ip_generation/axi_vip_slv/sim/axi_vip_slv_pkg.sv
./ip_generation/axi_vip_slv/sim/axi_vip_slv.sv

../krnl_aes/ip_generation/clk_gen/clk_gen_clk_wiz.v
../krnl_aes/ip_generation/clk_gen/clk_gen.v
../krnl_aes/ip_generation/axi_clock_converter/sim/axi_clock_converter.v
../krnl_aes/ip_generation/axi_clock_converter/hdl/axi_clock_converter_v2_1_vl_rfs.v
../krnl_aes/ip_generation/axis_clock_converter/sim/axis_clock_converter.v
../krnl_aes/ip_generation/axis_clock_converter/hdl/axis_clock_converter_v1_1_vl_rfs.v
../krnl_aes/ip_generation/axis_clock_converter/hdl/axis_infrastructure_v1_1_vl_rfs.v

./tbench/tb_krnl_cbc.sv

$XILINX_VIVADO/data/verilog/src/glbl.v

max_stars_repo_name: jlamperez/Vitis-Tutorials

max_issues_repo_name: jlamperez/Vitis-Tutorials

max_forks_repo_name: jlamperez/Vitis-Tutorials


! PR fortran/27395
! { dg-do run }

program pr27395_1
  implicit none
  integer, parameter :: n=10,m=1001
  integer :: i
  integer, dimension(n) :: sumarray
  call foo(n,m,sumarray)
  do i=1,n
    if (sumarray(i).ne.m*i) call abort
  end do
end program pr27395_1

subroutine foo(n,m,sumarray)
  use omp_lib, only : omp_get_thread_num
  implicit none
  integer, intent(in) :: n,m
  integer, dimension(n), intent(out) :: sumarray
  integer :: i,j
  sumarray(:)=0
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(4)
!$OMP DO PRIVATE(j,i), REDUCTION(+:sumarray)
  do j=1,m
    do i=1,n
      sumarray(i)=sumarray(i)+i
    end do
  end do
!$OMP END DO
!$OMP END PARALLEL
end subroutine foo


! Include file for example MultiNest program obj_detect (see arXiv:0704.3704)

module params
implicit none

! Toy Model Parameters
	integer sdim
      	integer snpix !no. of pixels in the grid (generate a grid with snpix X snpix pixels)
      	integer snclstr !no. of objects to generate, should be a square no.
	parameter (snpix=200,snclstr=8)
      	logical autopos !position clusters uniformly in the field?
      	parameter (autopos=.false.)
	double precision sodata(snpix,snpix)
      	double precision spos(2*snclstr) !cluster position coordinates
      	data spos /0.7, 110.5, 68.2, 166.4, 75.3, 117.0, 78.6, &
      	12.6, 86.8, 41.6, 113.7, 43.1, 124.5, 54.2, 192.3, 150.2/
	double precision samp(snclstr) !amplitude of each object
      	data samp /0.71, 0.91, 0.62, 0.60, 0.63, 0.56, 0.60, 0.90/
	double precision ssig(snclstr) !width of each object
      	data ssig /5.34, 5.40, 5.66, 7.06, 8.02, 6.11, 9.61, 9.67/
	double precision snoise !gaussian noise rms
      	data snoise / 2. /
      	integer dseed!seed for creating mock data,-ve means take it from sys clock
	parameter(dseed=12)
      	double precision spriorran(4,2) !priors on the parameters
      	!uniform prior on x position
	data spriorran(1,1),spriorran(1,2) / 0. , 200. /
      	!uniform prior on y position
	data spriorran(2,1),spriorran(2,2) / 0. , 200. /
      	!uniform prior on amplitude
	data spriorran(3,1),spriorran(3,2) / 0. , 2. /
      	!uniform prior on sigma
	data spriorran(4,1),spriorran(4,2) / 3. , 12. /

! Parameters for MultiNest

      	!whether to do use Nested Importance Sampling
	logical nest_IS
 	parameter(nest_IS=.true.)

      	!whether to do multimodal sampling
	logical nest_mmodal
 	parameter(nest_mmodal=.true.)

      	!sample with constant efficiency
	logical nest_ceff
 	parameter(nest_ceff=.false.)

      	!max no. of live points
      	integer nest_nlive
	parameter(nest_nlive=1000)

      	!tot no. of parameters, should be sdim in most cases but if you need to
      	!store some additional parameters with the actual parameters then
      	!you need to pass them through the likelihood routine
	integer nest_nPar

      	!seed for MultiNest, -ve means take it from sys clock
	integer nest_rseed
	parameter(nest_rseed=-1)

      	!evidence tolerance factor
      	double precision nest_tol
      	parameter(nest_tol=0.5)

      	!enlargement factor reduction parameter
      	double precision nest_efr
      	parameter(nest_efr=0.8d0)

      	!root for saving posterior files
      	character*100 nest_root
	parameter(nest_root='chains/2-')

	!after how many iterations feedback is required & the output files should be updated
	!note: posterior files are updated & dumper routine is called after every updInt*10 iterations
	integer nest_updInt
	parameter(nest_updInt=1000)

	!null evidence (set it to very high negative no. if null evidence is unknown)
	double precision nest_Ztol
	parameter(nest_Ztol=-1.d90)

      	!max modes expected, for memory allocation
      	integer nest_maxModes
      	parameter(nest_maxModes=10)

      	!no. of parameters to cluster (for mode detection)
      	integer nest_nClsPar
      	parameter(nest_nClsPar=2)

      	!whether to resume from a previous run
      	logical nest_resume
      	parameter(nest_resume=.true.)

      	!whether to write output files
      	logical nest_outfile
      	parameter(nest_outfile=.true.)

      	!initialize MPI routines?, relevant only if compiling with MPI
	!set it to F if you want your main program to handle MPI initialization
      	logical nest_initMPI
      	parameter(nest_initMPI=.true.)

      	!points with loglike < nest_logZero will be ignored by MultiNest
      	double precision nest_logZero
      	parameter(nest_logZero=-huge(1d0))

      	!max no. of iterations, a non-positive value means infinity. MultiNest will terminate if either it
	!has done max no. of iterations or convergence criterion (defined through nest_tol) has been satisfied
      	integer nest_maxIter
      	parameter(nest_maxIter=0)

	!parameters to wrap around (0 is F & non-zero T)
	integer nest_pWrap(4)

      	!feedback on the sampling progress?
      	logical nest_fb
      	parameter(nest_fb=.true.)
!=======================================================================

end module params


text:
C
C $Id: agfpbn.f,v 1.6 2008-07-27 00:14:34 haley Exp $
C
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      INTEGER FUNCTION AGFPBN (FPDP)
C
C The value of AGFPBN(FPDP) is a binary dash pattern, obtained from the
C floating-point dash pattern FPDP.  On machines having a word length
C greater than 16 bits, AGFPBN(FPDP) = INT(FPDP).  On machines having
C a word length of 16 bits, this is not true.  For example, when FPDP =
C 65535. (2 to the 16th minus 1), the equivalent binary dash pattern
C does not have the value 65535, but the value -1 (assuming integers
C are represented in a ones' complement format).  So, the functions
C ISHIFT and IOR must be used to generate the dash pattern.
C
      TEMP=FPDP
      AGFPBN=0
C
      DO 101 I=1,16
        IF (MOD(TEMP,2.).GE.1.) AGFPBN=IOR(AGFPBN,ISHIFT(1,I-1))
        TEMP=TEMP/2.
  101 CONTINUE
C
      RETURN
C
      END

max_stars_repo_name: tenomoto/ncl

max_issues_repo_name: tenomoto/ncl

max_forks_repo_name: tenomoto/ncl


text:
module Svc {

  @ A polymorphic database component
  passive component PolyDb {

    @ Mutexed Port to get values
    guarded input port getValue: Svc.Poly

    @ Mutexed Port to set values
    guarded input port setValue: Svc.Poly

  }

}

ext: fpp


text:
HANSARD REVISE * NUMERO 207
Le mercredi 14 avril 1999
LE MOIS DE LA SENSIBILISATION A LA MALADIE DE PARKINSON
Mme Rose-Marie Ur
LE BUREAU D'ASSURANCE-EMPLOI DE NIPAWIN
LES JEUNESSES MUSICALES DU CANADA
L'AVIATION ROYALE DU CANADA
M. Gurbax Singh Malhi
L'hon. Arthur C. Eggleton
L'hon. Arthur C. Eggleton
L'hon. Arthur C. Eggleton
L'hon. Arthur C. Eggleton
L'hon. Arthur C. Eggleton
L'hon. Arthur C. Eggleton
M. Svend J. Robinson
M. Svend J. Robinson
Mme Caroline St-Hilaire
Mme Judy Wasylycia-Leis
M. Rey D. Pagtakhan
L'hon. Pierre S. Pettigrew
LA COMMISSION D'INGENIEURS PERMANENTE DU TRAITE DU FLEUVE
REPONSE DU GOUVERNEMENT A DES PETITIONS
COMITES DE LA CHAMBRE
Procedure et affaires de la Chambre
M. Guy St-Julien
Mme Rose-Marie Ur
L'hon. Harbance Singh Dhaliwal
LOI D'EXECUTION DU BUDGET DE 1999
LA LEGALISATION DE L'USAGE THERAPEUTIQUE ET MEDICAL DE
Mme Diane St-Jacques
HANSARD REVISE * NUMERO 207
Le mercredi 14 avril 1999
La seance est ouverte a 14 heures.
Tous les deputes se levent et chantent O Canada.]
LE MOIS DE LA SENSIBILISATION A LA MALADIE DE PARKINSON
Mme Rose-Marie Ur (Lambton-Kent-Middlesex, Lib.):
LE BUREAU D'ASSURANCE-EMPLOI DE NIPAWIN
M. Derrek Konrad (Prince Albert, Ref.):
M. Mark Assad (Gatineau, Lib.):
Chez nous, la langue francaise occupe une place primordiale.
Felicitations aux grands gagnants.
Il y en a trois de chez nous ici au Canada:
Mme Val Meredith (South Surrey-White Rock-Langley, Ref.):
LES JEUNESSES MUSICALES DU CANADA
Mme Marlene Jennings (Notre-Dame-de-Grace-Lachine, Lib.):
Monsieur le President, nous celebrons cette annee le 50e anniversaire des Jeunesses musicales du Canada.
Longue vie aux Jeunesses musicales du Canada.
M. Nick Discepola (Vaudreuil-Soulanges, Lib.):
L'AVIATION ROYALE DU CANADA
M. Art Hanger (Calgary-Nord-Est, Ref.):
Les membres passes et actuels de l'Aviation canadienne ont droit a toutes nos felicitations.
Ils sont vraiment les Top Guns du Canada.
Mme Brenda Chamberlain (Guelph-Wellington, Lib.):
Je felicite la brasserie Sleeman d'avoir encore une fois marque des points.
Quand il est question de biere, le choix est clair, c'est Sleeman.
M. Gurbax Singh Malhi (Bramalea-Gore-Malton-Springdale, Lib.):
Monsieur le President, c'est aujourd'hui le 300e anniversaire de la nation sikhe.
M. Raymond Lavigne (Verdun-Saint-Henri, Lib.):
M. Gordon Earle (Halifax-Ouest, NPD):
Le gouvernement liberal doit immediatement examiner cette question et corriger cette erreur.
Mme Esmerelda Thornhill, professeur de droit a l'Universite Dalhousie a ecrit:
Mme Francine Lalonde (Mercier, BQ):
Encore une fois, felicitations Julie.
Tous nos voeux t'accompagnent pour ces importants rendez-vous sportifs.
M. Rick Borotsik (Brandon-Souris, PC):
La riviere Souris devrait depasser nettement son niveau d'inondation.
Certaines entreprises sentent deja les effets de cette inondation.
Les agriculteurs pourraient etre les plus durement frappes.
S'il y a d'autres pluies abondantes, cela pourrait se prolonger jusqu'a juin.
Le gagne-pain des agriculteurs et d'autres entreprises de la region est en jeu.
M. John Harvard (Charleswood St. James-Assiniboia, Lib.):
Nous avons de graves problemes.
Que leur ont valu leurs efforts?
Mme Christiane Gagnon (Quebec, BQ):
Mon souhait serait d'avoir la paix
Non seulement pour moi, mais pour la terre entiere.
Si tous les gens de la planete s'aimaient,
Ca deviendrait un peu moins l'enfer.
Mon souhait serait d'avoir la paix
Non seulement pour moi, mais pour les enfants en guerre.
Si tous les pays se desarmaient,
On eviterait que la terre s'envole en poussiere.
M. Preston Manning (chef de l'opposition, Ref.):
Le Canada a-t-il appuye le plan de paix allemand?
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
M. Preston Manning (chef de l'opposition, Ref.):
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Il n'y a pas de difference.
M. Preston Manning (chef de l'opposition, Ref.):
Quelle doit etre la participation du Canada a cette force terrestre de l'ONU?
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Mme Deborah Grey (Edmonton-Nord, Ref.):
Monsieur le President, les discussions ne nous ont pas permis d'obtenir de nouvelles precisions.
Il refuse de tenir ce vote.
Ce serait si facile pour le gouvernement d'acceder a cette demande.
L'hon. Herb Gray (Windsor-Ouest, Lib.):
Monsieur le President, le Parlement canadien a un role a jouer et il le joue.
A trois occasions differentes, nous avons tenu de grands debats exploratoires.
Les porte-parole de l'opposition ont ete tenus au courant de la situation.
Les ministres ont regulierement fait des declarations.
Le Parlement a joue un role actif et continuera de le faire.
Mme Deborah Grey (Edmonton-Nord, Ref.):
Nous sommes en guerre.
Pourquoi en est-il ainsi?
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
Tous les 19 pays membres de l'OTAN sont constamment consultes.
Bien des pays, y compris le Canada, songent a envoyer des avions supplementaires.
M. Gilles Duceppe (Laurier-Sainte-Marie, BQ):
Monsieur le President, lundi, nous avons eu un debat sur la situation au Kosovo.
Voila justement ce que propose le plan allemand.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Monsieur le President, je ne sais pas ou le depute prend son information.
La proposition ne parle pas d'une treve avant qu'il se passe quelque chose.
M. Gilles Duceppe (Laurier-Sainte-Marie, BQ):
On nous dit l'inverse aujourd'hui.
Voila que presentement le premier ministre chinois est ici pour une semaine.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Oui, monsieur le President.
M. Daniel Turp (Beauharnois-Salaberry, BQ):
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
M. Daniel Turp (Beauharnois-Salaberry, BQ):
L'honorable vice-premier ministre a la parole.
L'hon. Herb Gray (vice-premier ministre, Lib.):
S'ils desirent avoir encore une fois cette possibilite, nous allons le considerer tres attentivement.
Mme Alexa McDonough (Halifax, NPD):
Monsieur le President, ma question s'adresse au ministre des Affaires etrangeres.
Cela s'est deja vu.
Qu'on se rappelle Lester Pearson dans la crise de Suez.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Et c'est certes quelque chose que nous cherchons activement.
Nous allons retenir l'idee de la deputee.
Mme Alexa McDonough (Halifax, NPD):
Cela a deja marche.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Je le repete, nous allons continuer a rechercher cela.
Si cela ne fonctionne pas, nous examinerons d'autres options.
M. David Price (Compton-Stanstead, PC):
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
M. David Price (Compton-Stanstead, PC):
Monsieur le President, voici une toute nouvelle affaire.
Avec un peu d'aide, on pourrait reunir environ 2 000 soldats.
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
Monsieur le President, toutes nos troupes sont formees en vue du combat.
Les missions de maintien de la paix comportent toutes sortes de conditions.
Nous l'avons constate en Bosnie et dans d'autres pays.
Tout n'est pas toujours tres calme.
Nos militaires doivent etre prets a faire face a toute eventualite.
Le depute a parle de ces 2 000 militaires hier.
Il a souligne qu'on discutait de quelque chose a Kingston.
Le depute se montre irresponsable et mechant.
M. Preston Manning (chef de l'opposition, Ref.):
On ne discutait donc pas de cette possibilite.
Elle n'etait pas envisagee.
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
Monsieur le President, nous avons ete parfaitement clairs a ce sujet.
M. Preston Manning (chef de l'opposition, Ref.):
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
Monsieur le President, parlons-en, des votes.
S'ils veulent voter, ils peuvent le faire sur une motion de defiance.
M. Rene Laurin (Joliette, BQ):
Ils seraient probablement postes en Macedoine.
L'hon. Arthur C. Eggleton (ministre de la Defense nationale, Lib.):
M. Rene Laurin (Joliette, BQ):
La Chambre n'a donc jamais ete consultee sur les nouveaux plans du gouvernement.
L'hon. Herb Gray (vice-premier ministre, Lib.):
M. John Williams (St. Albert, Ref.):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Ce sont les provinces qui sont responsables des hopitaux.
Je peux dire au depute ce qu'il en est.
M. John Williams (St. Albert, Ref.):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Nous sommes prets a 93 p. 100.
J'espere qu'elles le font.
M. Michel Gauthier (Roberval, BQ):
L'hon. Don Boudria (leader du gouvernement a la Chambre des communes, Lib.):
M. Michel Gauthier (Roberval, BQ):
L'hon. Don Boudria (leader du gouvernement a la Chambre des communes, Lib.):
M. Monte Solberg (Medicine Hat, Ref.):
L'hon. Paul Martin (ministre des Finances, Lib.):
Monsieur le President, les chiffres du depute sont errones.
C'est aux Etats-Unis qu'il a baisse.
M. Monte Solberg (Medicine Hat, Ref.):
Monsieur le President, le ministre est comme un arracheur de dents.
Je conseille aux deputes de choisir leurs comparaisons avec la plus grande prudence.
L'hon. Paul Martin (ministre des Finances, Lib.):
M. Benoit Sauvageau (Repentigny, BQ):
Ma question s'adresse au ministre des Affaires etrangeres.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Aucun plan n'a ete adopte.
Nous n'avons pas encore leur accord.
Nous nous efforcons cependant de l'obtenir.
Mme Karen Redman (Kitchener-Centre, Lib.):
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Nous sommes prets a offrir un soutien materiel pour ce projet de deminage a Chypre.
M. Jim Abbott (Kootenay-Columbia, Ref.):
L'hon. Lawrence MacAulay (solliciteur general du Canada, Lib.):
M. Jim Abbott (Kootenay-Columbia, Ref.):
Monsieur le President, le gouvernement est au pouvoir depuis six ans maintenant.
Pendant cette periode, le probleme n'a pas ete rectifie.
En fait, il n'a fait qu'empirer.
Les paroles du ministre sonnent creux pour les victimes.
L'hon. Lawrence MacAulay (solliciteur general du Canada, Lib.):
Monsieur le President, une mort est une mort de trop.
M. Svend J. Robinson (Burnaby-Douglas, NPD):
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
M. Svend J. Robinson (Burnaby-Douglas, NPD):
Monsieur le President, nous esperons tous avec ferveur que cette proposition connaitra un aboutissement heureux.
Cela ne fait aucun doute.
Pendant combien de temps le ministre est-il pret a attendre?
Combien d'autres personnes doivent mourir?
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
C'est le fait de M. Milosevic, et non du Canada.
Nous continuerons a mener ces discussions en parallele.
Nous esperons qu'elle pourra donner des resultats.
M. Charlie Power (St. John's-Ouest, PC):
Les sept millions de phoque du Groenland pourraient-ils y etre pour quelque chose?
L'hon. David Anderson (ministre des Peches et des Oceans, Lib.):
Le depute de St. John's-Ouest a la parole.
M. Charlie Power (St. John's-Ouest, PC):
L'hon. David Anderson (ministre des Peches et des Oceans, Lib.):
M. Larry McCormick (Hastings-Frontenac-Lennox and Addington, Lib.):
La ministre du Travail dira-t-elle si ces renseignements sont vrais ou non?
L'hon. Claudette Bradshaw (ministre du Travail, Lib.):
Monsieur le President, je remercie le depute de sa question.
Les greves au Canada n'ont jamais ete aussi peu nombreuses depuis 20 ans.
Dix pour cent des fonctionnaires federaux sont assujettis au Code canadien du travail.
Tous les Canadiens devraient feliciter employes, employeurs et syndicats.
M. Howard Hilstrom (Selkirk-Interlake, Ref.):
Le printemps est arrive et les agriculteurs commencent les semailles.
L'hon. Lyle Vanclief (ministre de l'Agriculture et de l'Agroalimentaire, Lib.):
En Saskatchewan, plus de 11 000 demandes ont ete envoyees par courrier aux producteurs.
Nous ne pouvons pas agir tant qu'ils ne les auront pas remplies et renvoyees.
Mme Caroline St-Hilaire (Longueuil, BQ):
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Mme Judy Wasylycia-Leis (Winnipeg-Centre-Nord, NPD):
Le ministre de la Sante reconnaitra-t-il enfin sa responsabilite dans cette crise?
L'hon. Allan Rock (ministre de la Sante, Lib.):
Des activites de recrutement sont d'ailleurs en cours.
Le depute de St. John's-Est a la parole.
M. Norman Doyle (St. John's-Est, PC):
Les phoques se nourrissent litteralement de tout tellement ils ont faim.
Il y a aujourd'hui plus de sept millions de phoques.
L'hon. David Anderson (ministre des Peches et des Oceans, Lib.):
Ce total a ete accepte.
Tina Fagan, la presidente de l'Association canadienne des chasseurs de phoque a dit:
Ils disent pouvoir traiter 275 000 phoques du Groenland...
Il a dit en etre ravi.
Le journal de St. John's a appuye notre decision.
Le depute de Winnipeg-Nord-St.
M. Rey D. Pagtakhan (Winnipeg-Nord-St.
L'hon. Pierre S. Pettigrew (ministre du Developpement des ressources humaines, Lib.):
Monsieur le President, je remercie le depute de sa question.
Comme nous le savons, les enfants sont notre avenir.
Ils representent notre avenir en tant que societe et en tant que pays.
Nous voulons nous assurer que l'argent que nous investissons dans les enfants les aidera...
Le depute de Langley-Abbotsford a la parole.
M. Randy White (Langley-Abbotsford, Ref.):
Monsieur le President, ma question s'adresse au solliciteur general.
Dans notre pays, les represailles a la suite de conflits syndicaux sont vraiment inacceptables.
L'hon. Lawrence MacAulay (solliciteur general du Canada, Lib.):
J'aurais eu une reponse a lui donner.
Mme Monique Guay (Laurentides, BQ):
Ma question s'adresse au premier ministre.
Monsieur le President, nous avons un plan.
Nous avons signe des ententes avec CARE Canada, le CECI et World Vision.
Nous continuons d'attendre les demandes.
M. Bill Blaikie (Winnipeg-Transcona, NPD):
Monsieur le President, ma question s'adresse au ministre des Affaires etrangeres.
L'hon. Lloyd Axworthy (ministre des Affaires etrangeres, Lib.):
Nous avons participe a ce processus.
Voila qui met fin, collegues deputes, a la periode des questions.
J'ai recu avis de trois rappels au Reglement.
Je les entendrai dans l'ordre dans lequel ils me sont parvenus.
Le depute de Pictou-Antigonish-Guysborough invoque le Reglement.
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
Monsieur le President, j'invoque le Reglement.
Les Canadiens ont le droit de savoir.
Je suis convaincu que vous pourriez obtenir des renseignements dans des discussions privees.
Cela n'est pas matiere a recours au Reglement, soit dit en passant.
Le leader parlementaire de l'opposition a la parole pour invoquer le Reglement.
M. Randy White (Langley-Abbotsford, Ref.):
La demande de consentement unanime du depute est recevable.
Le depute a-t-il la permission de la Chambre pour presenter sa motion?
M. Daniel Turp (Beauharnois-Salaberry, BQ):
L'hon. Don Boudria (leader du gouvernement a la Chambre des communes, Lib.):
Puis-je faire cette proposition aux leaders parlementaires?
Ils pourraient toujours ensuite demander le consentement unanime de la Chambre.
M. Randy White (Langley-Abbotsford, Ref.):
Monsieur le President, je respecte vos bonnes paroles et votre decision.
M. Bill Blaikie (Winnipeg-Transcona, NPD):
Voyons ce que le leader du gouvernement a la Chambre a a dire.
L'hon. Sergio Marchi (ministre du Commerce international, Lib.):
LA COMMISSION D'INGENIEURS PERMANENTE DU TRAITE DU FLEUVE COLUMBIA
REPONSE DU GOUVERNEMENT A DES PETITIONS
La Chambre consent-elle a revenir au depot de rapports de comites?
COMITES DE LA CHAMBRE
PROCEDURE ET AFFAIRES DE LA CHAMBRE
Tout outrage au Parlement n'avait qu'un caractere technique et n'etait pas intentionnel.
M. Guy St-Julien (Abitibi-Baie-James-Nunavik, Lib.):
Actuellement, 16 a 20 personnes habitent des logements de trois chambres a coucher.
Les Inuits trouvent extremement troublantes les conditions du logement au Nunavik.
On considere la situation tres intolerable.
M. Werner Schmidt (Kelowna, Ref.):
M. Peter Adams (Peterborough, Lib.):
M. Scott Brison (Kings-Hants, PC):
Mme Rose-Marie Ur (Lambton-Kent-Middlesex, Lib.):
M. Howard Hilstrom (Selkirk-Interlake, Ref.):
Mme Eleni Bakopanos (Ahuntsic, Lib.):
Mme Eleni Bakopanos (Ahuntsic, Lib.):
Monsieur le President, la deuxieme petition a trait a l'equite salariale.
Mme Eleni Bakopanos (Ahuntsic, Lib.):
Monsieur le President, la troisieme petition a trait a la pornographie.
Mme Wendy Lill (Dartmouth, NPD):
M. Paul Szabo (Mississauga-Sud, Lib.):
La premiere petition a trait aux droits de la personne.
M. Paul Szabo (Mississauga-Sud, Lib.):
M. Nelson Riis (Kamloops, Thompson and Highland Valleys, NPD):
Monsieur le President, on repondra aujourd'hui aux questions nos 128 et 205.
Question no 128- M. Lee Morrison:
Annee-Remuneration-Par jour-Total
1993-91 000 $-188 000 $-279 000 $
1994-89 800 $-167 000 $-256 800 $
1995-68 700 $-128 300 $-197 000 $
1996-42 800 $-81 800 $-124 600 $
1997-51 000 $-58 100 $-109 100 $
1993: 53 503 $-75 986 $
1994: 51 717 $-75 986 $
1995: 54 804 $-73 648 $
1996: 55 777 $-74 842 $
1997: 49 517 $-77 007 $
Question no 205- M. Jason Kenney:
L'hon. Harbance Singh Dhaliwal (ministre du Revenu national, Lib.):
Monsieur le President, je suggere que les autres questions soient reservees.
Ces documents sont deposes immediatement.
Motion no P-55
Motion no P-56
LOI D'EXECUTION DU BUDGET DE 1999
Mme Carolyn Bennett (St. Paul's, Lib.):
Elle avait alors insiste pour que tout le personnel soit present.
Nous avons entendu de simples citoyens de partout au Canada.
Nous avons entendu des chercheurs, des analystes de politiques et des gens d'affaires.
Nous avons aussi entendu des gens proposer des solutions.
Les Canadiens estiment qu'il faut absolument reinvestir dans la sante.
Les specialiste, y compris ceux du Forum national sur la sante, ont ete tres clairs.
Il doit y avoir une veritable obligation de rendre compte de l'argent depense.
Je parle ici de l'accord historique de l'union sociale.
Il est desormais obligatoire de faire des evaluations et de rendre des comptes.
Ce sont des choses sur lesquelles on s'entend.
Nous devons repondre aux besoins des Canadiens en maintenant des programmes et des services sociaux.
Les gouvernements federal et provinciaux devront ensuite veiller a ce qu'on le fasse.
Nous avons nos choix, nos leviers politiques, nos stimulants et nos programmes.
Il faut continuer a demander en periode electorale aux Canadiens ce qu'ils veulent.
Le present budget est equilibre.
M. Ken Epp (Elk Island, Ref.):
J'aimerais poser quelques questions a ma collegue.
Elle a parle brievement du nouveau federalisme.
Les autres premiers ministres n'ont pas fait cela.
Je trouve inquietant cependant que le gouvernement federal nous taxe a outrance.
Les Canadiens paient trop d'impot et il est question ici aujourd'hui du budget.
Les Canadiens paient des taxes sur tout.
La plupart des familles ressentent le poids du fardeau fiscal.
Cette exigence est une violation flagrante de la Constitution canadienne.
La plupart des constitutionnalistes le reconnaissent.
J'aimerais connaitre le point de vue de la deputee a ce sujet.
Elles n'ont pas ete menacees d'un gourdin.
En vertu de la Constitution, seuls les hopitaux relevent exclusivement des provinces.
On pratique trop d'actes chirurgicaux inutiles.
On administre des antibiotiques dans les cas de rhume.
On fait trop de choses qui sont totalement inefficaces.
On ordonne des quantites de tests de laboratoire qui sont depasses depuis 20 ans.
Je suis heureuse que ces deux questions arrivent en meme temps.
Ils ont tous signe de leur plein gre.
Des experts sont venus a notre assemblee la semaine derniere.
Cela ne serait pas possible au Canada.
Les Canadiens ne voudraient pas d'une telle centralisation des pouvoirs.
Expliquez-moi cette modification et ce changement a l'engagement qui avait ete pris.
L'honorable deputee de St. Paul's a la parole.
Il fallait que ce soit juste.
M. Jack Ramsay (Crowfoot, Ref.):
Monsieur le President, j'ai une breve question.
Je serais bien heureux si elle pouvait le dire a la Chambre.
Qui a les pouvoirs?
Je serais tres heureuse de trouver la reponse, mais j'ai confiance...
Les pouvoirs de depense, les pouvoirs de depense federaux.
M. Grant Hill (Macleod, Ref.):
Nous avons beaucoup entendu parler du budget de la sante.
Il y a une question qui me fascine.
On a fait beaucoup de publicite a ce sujet.
Pourquoi le gouvernement a-t-il du recourir a une campagne de publicite?
C'est un peu tordu.
Certains de mes collegues ont vu cela.
Je prenais un autre sac, contenant 596 cc de solute.
La difference est importante.
N'importe qui dirait que c'est seulement la moitie, ce qui est exact.
La reaction est dramatique.
La population se plaint.
Quel est le resultat dans la pratique?
La population se moque pas mal des domaines de competence.
J'ai decide de passer en revue les articles de journaux depuis quelque temps.
Il y a beaucoup trop pour que je les cite.
J'y consacrerais tout mon temps de parole.
A Terre-Neuve, chaque annee, 600 patients ont besoin de subir une chirurgie cardiaque.
Ce communique a ete diffuse par CANOE le 19 janvier.
La fondation de l'hopital ira quemander l'argent necessaire aupres du secteur prive.
Ces nouvelles etaient publiees dans la Gazette .
Voici une autre nouvelle interessante.
Combien de Manitobains ont profite de ce forfait?
Il y a 120 Manitobains qui ont decide de ne pas attendre.
C'est ce que rapportait le Free Press de Winnipeg le 27 janvier.
Son ami a demande a une infirmiere de lui poser une couche.
Elle a repondu: Nous n'en avons pas.
Vous devez aller en acheter vous-meme.
En Saskatchewan, des infirmieres victimes de stress font la greve en ce moment.
Nous assistons a l'exode de professionnels des soins de sante.
Il y a cependant un hopital a Sioux Lookout.
Cet hopital est reserve aux autochtones.
Le gouvernement federal en est entierement responsable.
Il s'agit d'une histoire d'incompetence crasse.
Cette histoire est fort interessante.
Les mises en garde se sont multipliees.
Sante Canada a refuse de repondre a l'Universite de Toronto.
Que s'est-il passe le 30 juin?
Pareille situation ne pourrait se produire dans un pays du tiers monde.
Avec cinq heures de preavis, l'urgence de Sioux Lookout a ete fermee.
Un contrat est finalement apparu.
C'etait comme un contrat pour l'acquisition d'un CF-18.
Il n'avait rien a voir avec les questions medicales.
Des elements etaient biffes et effaces.
Les medecins presents ont tout simplement dit qu'ils ne pouvaient pas signer cela.
Ils ont perdu leur anciennete.
Ils ont quitte le Nord.
Au mieux, il n'y aura pas de medecins dans le Nord avant l'ete.
Voici ce qu'il a dit relativement a Sioux Lookout:
La direction generale des services medicaux a tout bousille.
Cette affaire a ete mal geree sur toute la ligne.
Savez-vous quelle a ete la reponse du ministre?
Telle a ete la reponse donnee par Joanne Meyer, une adjointe executive.
Ils ont parle de la crise des soins infirmiers.
On s'attendrait a une reponse immediate.
Eh bien, il y en a eu une.
Ils se sont adresses a Medecins sans frontieres.
Ils sont alles a Medecins sans Frontieres pour obtenir des soins medicaux.
C'est absolument abominable.
Ce n'est pas tout.
Des autochtones sont maintenant en greve de la faim a cet hopital.
Sioux Lookout est un exemple de situation tragique ici meme au Canada.
Le temps nous manque cruellement.
Je suis medecin et chirurgien.
J'ai donne des transfusions de sang a des patients.
Je comprends ce que le juge Krever a dit.
Il a tenu promesse.
Ce sont evidemment les deputes d'en face.
Je dis cela a la blague, mais c'est la triste verite.
Ils devraient aussi etre indexes sur l'inflation.
Il faut recommencer a faire passer le patient en premier.
Les solutions doivent venir des gens qui sont le plus touches.
Je ferais passer le patient en premier.
Nous avons besoin de mecanismes precis pour reduire les listes d'attente au Canada.
Que va-t-il advenir de notre systeme d'assurance-maladie?
Elle a affirme qu'il y a des lacunes dans cette loi.
C'est une femme courageuse.
C'est vraiment ce que nous devrions faire selon moi.
Je suis optimiste a la suite de l'experience de la Nouvelle-Zelande.
Les Neo-Zelandais ont perdu pratiquement tous leurs programmes sociaux.
Leurs programmes destines aux personnes agees ont ete malmenes.
Ils ont perdu les subventions au transport.
Ils ont perdu toutes leurs subventions pour les projets agricoles.
Ils n'ont pas perdu leur assurance-maladie.
Ils ont fait tout ce qu'il fallait pour cela.
Ils ont choisi une solution avec laquelle je ne suis pas d'accord.
Mme Carolyn Bennett (St. Paul's, Lib.):
Monsieur le President, j'ai deux questions a poser au depute.
L'association a dit que ce n'etait pas une question d'argent.
Comment le depute peut-il prouver que ce n'est qu'une question d'argent?
Ce ne sont que les medecins qui semblent avoir de la difficulte a comprendre.
La deputee trouve-t-elle que la situation est reequilibree?
Elle hoche la tete d'un air de dire que c'est faux.
Elle constatera qu'il s'est produit une reduction considerable.
Je n'essaie pas de parler de tout le systeme de sante.
Je parle de la responsabilite federale en matiere de financement.
Certainement, et elle devrait le faire.
Qui en subit les consequences?
C'est un terrible debat lorsque l'on se concentre sur un seul element.
M. Rene Canuel (Matapedia-Matane, BQ):
Je voudrais poser une question a mon collegue qui est medecin.
Il y a les salaires, bien sur.
N'entre pas qui veut a l'ecole de medecine.
On dit qu'on manque de medecins.
Les regions doivent etre aussi bien desservies que les grands centres.
Je voudrais avoir son avis sur la question.
Les problemes ne sont pas specifiquement des problemes d'argent.
Il y a aussi d'autres problemes.
Est-ce qu'il y a une solution pour ce qui est du recrutement?
Les personnes ne se rendent pas dans le Nord.
M. Paul Szabo (Mississauga-Sud, Lib.):
Monsieur le President, le depute a fait allusion aux delais d'attente pour certaines operations.
Il a parle d'arthroplasties de la hanche, si j'ai bien compris.
Le depute de Macleod a la parole pour repondre brievement.
Monsieur le President, le depute a raison.
Les listes d'attente sont attribuables a une foule de facteurs.
M. Paul Szabo (Mississauga-Sud, Lib.):
Ils peuvent intervenir de vive voix ou par ecrit.
Ils peuvent aussi dialoguer avec les membres du comite.
Il s'agit d'un processus tres difficile.
La sante a elle aussi ete un theme predominant.
Nous avons entendu egalement beaucoup d'economistes.
Le deficit de 42 milliards a disparu et notre budget est equilibre.
Grace a ces budgets, les nouvelles sont tres bonnes.
Notre taux de chomage a baisse.
Nous devons vivre selon nos moyens.
Comme les Canadiens le savent, nous faisons egalement d'importants investissements dans la sante.
Est-ce tout ce que les Canadiens voulaient?
Il y a bien d'autres mesures utiles que les Canadiens voudraient promouvoir.
Nous devons continuer de promouvoir et de stimuler des mesures dans d'autres domaines.
Je le repete, chaque budget s'appuie sur le budget precedent.
Nous commencons a voir la tendance qui se dessine.
La Chambre des communes sera appelee a se pencher sur cette question.
C'est environ 170 $ dans la poche de tous les contribuables.
C'est une bonne nouvelle.
Il s'agit de nombres considerables.
Dans le budget de 1998, on avait aussi commence a supprimer les surtaxes.
Les Canadiens savent que nous avons un budget equilibre.
Cette mesure fiscale rapporte au gouvernement du Canada environ 650 millions de dollars par annee.
Nous devons continuer a equilibrer nos comptes et a vivre selon nos moyens.
C'est un choix qu'il fallait faire.
C'est surement une question que nous devrons etudier.
C'est une excellente nouvelle pour les contribuables a faible revenu.
Il y a des priorites a respecter et des compromis a faire.
Il y a des decisions que nous devons prendre chaque annee, dans chaque budget.
Je pense que ce budget est tres bien accueilli a cet endroit.
Monsieur le President, je ne suis pas certain d'avoir saisi la question du depute.
M. Greg Thompson (Nouveau-Brunswick-Sud-Ouest, PC):
Voila pour l'annee de l'education.
Cette annee est censee etre celle de la sante.
Comment le depute accorde-t-il ces chiffres en tant que CA?
Quelles sont les priorites de l'Ontario?
Je sais quelles sont les priorites de Mike Harris.
Il veut se payer une victoire electorale.
M. Ken Epp (Elk Island, Ref.):
Monsieur le President, moi aussi j'ai ecoute avec interet.
Je crois que l'honorable comptable se trompe dans ses chiffres.
On pense qu'on le fera courir plus vite en le fouettant.
Cela ne fonctionne tout simplement pas.
Et le gouvernement federal a l'audace de rejeter le blame sur les provinces.
Que le depute essaie de defendre cela.
Monsieur le President, le depute est dans l'erreur.
C'est une question de priorites.
C'est la la difference.
Clair, ou le Parti reformiste n'a meme pas reussi a recuperer son depot.
Les Canadiens n'accepteront pas ces inepties ou l'on joue avec les chiffres.
M. Grant Hill (Macleod, Ref.):
J'aimerais qu'il reponde a une question simple.
Qu'a-t-il a repondre a cela?
Monsieur le President, le fait est que nous ne pouvons gagner sur les deux tableaux.
C'est ce qu'il affirme.
Ce n'est pas une facon d'offrir des soins de sante.
Cela est lie a l'administration provinciale des soins de sante.
M. Paul Mercier (Terrebonne-Blainville, BQ):
Certains editoriaux l'ont dit avec raison: ce budget est politique.
La Constitution canadienne assure la competence exclusive des provinces en matiere de sante.
Je trouve cela revelateur.
C'est une vision originale de ce qu'est un champ de competence.
J'aborde a present la deuxieme partie de mon expose.
Il convient de degonfler, une fois pour toutes, cette affirmation.
La perequation, d'abord.
Qu'est-ce que la perequation?
C'est une mesure federale pour compenser la pauvrete relative de certaines provinces.
Cette carence de depenses structurantes est une cause determinante de la pauvrete relative du Quebec.
Nous connaissons quelques autres ingredients.
M. Antoine Dube (Levis-et-Chutes-de-la-Chaudiere, BQ):
Pourtant, que demandent les gens de l'industrie?
Evidemment, chaque comte a subi des coupures a cet egard.
Cela a un impact economique.
C'est assez embetant.
C'est beaucoup l'argent.
Le Quebec n'a toutefois pas signe cette entente.
C'est de l'argent!
C'etait la facon qu'il avait de se financer.
Les huit provinces avaient accepte.
Le Code civil est distinct.
Je termine en esperant pouvoir repondre a des questions.
M. Paul Szabo (Mississauga-Sud, Lib.):
Il y a cinq principes dans la Loi canadienne sur la sante.
C'est pourquoi nous n'avons pas un systeme a deux vitesses.
Nous avons un seul regime pour tous les Canadiens.
Un de ces programmes etait les soins de sante.
Les transferts pecuniaires au Quebec baissaient et etaient censes tomber a zero.
Monsieur le President, j'ai beaucoup d'estime pour le depute qui vient de parler.
Cela etant dit, je l'invite a relire la Constitution.
C'est ce qui cree des problemes.
Le president suppleant (M. McClelland):
Nous passons maintenant aux discours de 10 minutes sans questions ni observations.
M. Greg Thompson (Nouveau-Brunswick-Sud-Ouest, PC):
Monsieur le President, le debat d'aujourd'hui rappelle tous les autres debats budgetaires.
Je suis toujours stupefait en entendant ce que disent les ministeriels.
J'ai en effet ete membre de ce gouvernement.
Il y a une autre statistique dont les liberaux ne parlent pas.
Ils ont un trou de memoire.
Il est important de le dire.
Personne ne le contestera.
Mais une chose me laisse perplexe.
Elle a du se perdre quelque part dans le livre rouge.
Et je suppose que tous les exemplaires du livre rouge ont ete recycles en compost.
Les liberaux aiment bien oublier ces 22 milliards.
Leur budget serait-il aussi equilibre aujourd'hui sans cette somme?
Sans elle, le gouvernement serait bien en-deca de ses objectifs.
Je vois des deputes ministeriels faire oui de la tete.
Mais il y a autre chose, une chose fort interessante.
Ou sont les 26 milliards de dollars pris dans la caisse de l'assurance-emploi?
Figurent-ils quelque part dans les livres?
Mon petit doigt me dit que oui.
Le gouvernement soutire cet argent aux employeurs et aux employes du pays.
Les cotisations sont une taxe cachee que les liberaux utilisent pour equilibrer leurs livres.
Je crois que c'est dans la derniere.
Je me rappelle aussi l'expression les menteurs calculent et les chiffres mentent.
Le ministre est un maitre dans l'art de manipuler les chiffres.
Les liberaux aiment bien qualifier ce budget de budget de la sante.
Comment peut-on alors parler de succes ou de realisation?
Il n'en est absolument rien.
J'ai une coupure de presse qui fait etat du budget de la sante.
Elle emane de la province qui publie le Daily Gleaner .
C'est tire du Daily Gleaner de Fredericton, edition du 12 avril.
Il y a 122 recommandations.
Parce que le systeme de sante de toutes les provinces a ete detruit.
Il faut maintenant reparer les pots casses.
Ce n'est donc que de la poudre aux yeux.
Le Canada fait face a une crise, la crise des soins de sante.
L'an dernier, il parlait bien du budget de l'education.
Mais les problemes ne s'arretent pas la.
Le Canada affiche le taux de productivite le moins eleve des pays du G8.
Je ne suis pas le seul a le dire.
Ou est la difference s'il s'agit du G7 ou du G8?
Nous comptons sur la faiblesse de notre dollar pour exporter nos produits sur les marches.
Le gouvernement ne veut pas en parler.
Regardons donc les chiffres.
M. Paul Forseth (New Westminster-Coquitlam-Burnaby, Ref.):
C'est un mythe qu'ils ont presente un budget equilibre.
Les liberaux ont prouve qu'ils n'etaient pas de sages administrateurs des fonds publics.
Le bilan du gouvernement revele qu'il ne penche pas en faveur des familles.
Des 1993, le livre bleu des reformistes disait:
Le ministre a tardivement saisi le comite de la question epineuse.
Cela lui permettra de gagner du temps pour l'instant.
Il faut posseder la competence necessaire pour gouverner.
Il faut faire preuve d'equite.
La politique fiscale canadienne actuelle ne reconnait nullement les enfants.
Cette approche est indefendable.
Les enfants sont directement touches par ces politiques liberales.
C'est faisable, a-t-elle dit.
Des modifications ont ete proposees pour retablir une certaine justice.
Les liberaux ont omis de simplifier le code fiscal.
Nous pourrions peut-etre dire qu'il est 17 h 30. Est-on d'accord?
LA LEGALISATION DE L'USAGE THERAPEUTIQUE ET MEDICAL DE LA MARIJUANA
Mme Sue Barnes (London-Ouest, Lib.):
Dans un rapport paru recemment, on qualifie cela de medecine fondee sur une impression.
Au Canada, nous privilegions une medecine fondee sur l'experience clinique.
L'article 56 dit ceci:
Le hansard peut en temoigner.
On travaille actuellement a leur mise au point.
Ce que nous faisons est une mesure bienvenue.
Il faut que d'importants travaux de recherche commencent sous peu.
C'est une question de compassion.
Je pense qu'il est tres important de souligner leur travail.
Mme Pauline Picard (Drummond, BQ):
Elle parle de legalisation possible de l'usage medical de la marijuana.
Nous sommes en train de considerer tous les aspects de cette question.
Nous esperons etre en mesure d'exprimer notre politique durant les mois qui viennent.
A l'heure actuelle, ce debat est lie a une question medicale.
C'est aussi une question de compassion.
Cela a pour effet d'attenuer les nausees et de stimuler l'appetit.
Actuellement, ces femmes et ces hommes doivent enfreindre la loi pour se soigner.
Ce medicament est disponible en pharmacie.
Voila le choix impossible que donne ce gouvernement aux gens dans le besoin.
Pour cette raison, je desire proposer un sous-amendement a la motion M-381.
M. Bernard Patry (Pierrefonds-Dollard, Lib.):
Quant au terme marijuana, il a une origine etymologique assez obscure.
L'utilisation du cannabis est tres grande.
On peut aussi fabriquer des couvertures, des vetements, des drapeaux et des voiles de bateau.
Monsieur le President, j'invoque le Reglement.
Il ne fait que le preciser.
M. Grant Hill (Macleod, Ref.):
Ce debat est necessaire.
A mon avis, l'usage du cannabis a des fins palliatives est justifiable.
Nous parlons ici exclusivement de l'usage medical de la marijuana.
L'usage medical de la marijuana presente toutefois certains problemes.
La question est loin d'etre simple.
L'impurete du THC et des autres constituants de la marijuana pose un probleme.
Selon de nouvelles etudes, le cannabis a certains effets medicinaux positifs.
Voila les opinions divergentes.
Les cannabinoides qu'on trouve dans la marijuana ont donc un avenir assez prometteur.
L'etude soulevait ensuite des questions tres precises.
Le soulagement de la douleur est probablement le plus gros debouche commercial pour les cannabinoides.
On peut, evidemment, cultiver tres facilement de la marijuana.
On peut certainement le faire a l'exterieur durant l'ete.
Cela rend plus difficile le controle de l'usage recreatif.
D'aucuns estiment qu'il ne faut pas interdire l'usage recreatif.
Je ne suis pas de cet avis du tout.
Je voudrais proposer quelques solutions a nos problemes.
D'autre part, on pourrait avoir des difficultes avec le controle de l'usage recreatif.
Des recherches sont en cours a cette fin.
On pourrait aussi trouver d'autres facons d'administrer le THC.
L'absorption gastrique n'est pas parfaite, comme me l'ont dit des patients.
Il y a trois autres moyens possibles.
La capsule est assez rapidement absorbee.
L'administration du THC par aerosol nasal ou oral est egalement possible.
Cette solution a ete proposee et meme testee par des chercheurs.
Les patchs, qui constituent un autre mode d'administration, ont egalement ete envisages.
Si notre systeme medical etait averti, cela aurait ete fait depuis longtemps.
De 5 a 15 p. 100 des jeunes qui consomment du cannabis connaissent une accoutumance.
Accoutumance est un terme plus approprie.
C'est tout a fait vrai.
Ce debat tombe a point.
Mme Libby Davies (Vancouver-Est, NPD):
Un grand nombre de mes collegues neo-democrates sont tres favorables a cette motion.
Il est saisi de demandes en ce sens.
Pourquoi avons-nous peur de prendre immediatement des mesures a cet egard?
Pourquoi le gouvernement a-t-il peur de faire cela?
Cela tient en partie a notre moralite.
Nous avons entendu le porte-parole du Parti reformiste en matiere de sante.
Tout cela vient de la crainte d'une utilisation a des fins recreatives.
Nous devons faire une reforme progressiste de nos lois concernant les drogues.
Je travaille sur un dossier qui touche beaucoup ma circonscription.
Tous les tabous entourant la drogue influencent leur attitude.
La population appuie une telle reforme, il faut foncer.
Cette situation est une honte.
Le debat est important.
Nous ne voulons pas attendre une autre etude ou un autre plan.
Nous voulons que l'aide soit disponible maintenant, pendant que les essais se deroulent.
Mme Christiane Gagnon (Quebec, BQ):
Ce debat est une premiere dans l'histoire de la Chambre des communes.
Toutefois, ce debat n'est pas nouveau.
A ce chapitre, nous accusons un important retard sur la societe civile.
Laissez-moi vous expliquer pourquoi cette question est si importante.
Toutefois, cette pilule synthetique n'est pas une alternative valable a l'inhalation de THC.
Par le fait meme, l'inhalation de THC ameliore grandement son efficacite therapeutique.
C'est tout a fait inhumain.
Est-ce que les effets secondaires de cette pratique sont acceptables?
Pour nous, bien entendu, l'inhalation de la marijuana provoque des effets secondaires connus.
Aux elections de 1998, six Etats supplementaires ont tenu des referendums sur cette question.
Je demande a cet egard un vote unanime de la Chambre des communes.
Mme Diane St-Jacques (Shefford, PC):
Je ne veux pas qu'on croit que mon discours est purement philosophique.
Est-on d'accord pour permettre a la deputee de continuer?
M. Peter Stoffer (Sackville-Musquodoboit Valley-Eastern Shore, NPD):
J'ai pose une question au ministre de l'Industrie a la Chambre.
Il detient ce portefeuille depuis six ans.
Sa reponse est non.
Ma question est tres claire.
M. Walt Lastewka (secretaire parlementaire du ministre de l'Industrie, Lib.):
Cela me donne l'occasion de parler de la construction navale.
Je crains que le temps de parole du depute ne soit epuise.
M. Antoine Dube (Levis-et-Chutes-de-la-Chaudiere, BQ):
Meme si ses interets sont mis en fiducie, il ne veut pas repondre aux questions.
Ma question concernait le domaine fiscal et etait celle-ci:
La mesure en question est un credit d'impot pour la construction navale.
C'est un programme qui existe depuis deux ans.
M. Walt Lastewka (secretaire parlementaire du ministre de l'Industrie, Lib.):
Le depute sait combien genereux est le regime.
Celui-ci permet d'absorber tres rapidement les couts.
Le gouvernement federal y a affecte 200 millions de dollars entre 1986 et 1993.
Parlons un peu de la construction navale au Quebec.
D'ailleurs, la SEE...
La deputee de Vancouver-Est a la parole.
Mme Libby Davies (Vancouver-Est, NPD):
Le grand sujet de preoccupation ces temps-ci, c'est la securite personnelle.
Les gens s'inquietent pour leur securite personnelle.
Malheureusement, la reponse du gouvernement n'a pas vraiment ete a la hauteur.
Nous devons ameliorer nos conditions sociales.
Il faut ameliorer les programmes de traitement de la toxicomanie et les programmes de logement.
Ce sont les types de programmes qui permettront d'assurer la securite de nos quartiers.
La securite de nos familles et de nos quartiers nous preoccupe tous.
M. Walt Lastewka (secretaire parlementaire du ministre de l'Industrie, Lib.):
Je remercie la deputee pour ses efforts.
M. Garry Breitkreuz (Yorkton-Melville, Ref.):
Il ne sait absolument pas qui a eu le permis portant sa photo.
La personne qui a recu le permis portant ma photo commet un crime odieux.
Imaginons un agent qui intervient dans un conflit familial.
L'agent s'approche de la maison et rencontre Jean Dupont dans la rue.
Inutile d'expliquer les consequences catastrophiques que cela peut avoir.
Voici ce que dit sa lettre:
J'estime qu'on a porte atteinte a ma vie privee et a ma securite.
L'autre personne en cause a surement la meme impression.
Qui est cet autre William Moss qui attend son certificat?
S'il est jamais en difficulte, c'est mon adresse que le gouvernement possede.
Aimeriez-vous vous retrouver dans cette position?
Il ne s'agit pas d'une plainte frivole.
Pensons aux abus que cela peut engendrer.
La question cle demeure.
Je regrette, mais le temps de parole du depute est ecoule.
M. Walt Lastewka (secretaire parlementaire du ministre de l'Industrie, Lib.):
Monsieur le President, je tiens a repondre a la question du depute de Yorkton-Melville.
Voici quels sont les faits.
Nous avons jusqu'a present traite plus de 23 000 cas sous l'ancien systeme.
Je dois dire que nous sommes satisfaits du fonctionnement du nouveau systeme.
J'espere que le depute comprend.
La motion portant que la Chambre s'ajourne maintenant est reputee adoptee.
(La seance est levee a 18 h 54.)


text:
! collect statistics and timing
module statistics
integer, dimension(3) :: &
    amaxloc, vmaxloc, umaxloc, wmaxloc
real :: &
    amax, vmax, umax, wmax, &
    samax, svmax, sumax, slmax, &
    tsmax, tnmin, tnmax, tarrmax, &
    efric, estrain, moment
contains

! write statistics
subroutine stats
use globals
use process
use utilities
logical, save :: init = .true.
integer, save :: fh(20), j = 0
integer, save, allocatable :: prof(:,:)
real, save, allocatable :: maxl(:,:), suml(:,:), maxg(:,:), sumg(:,:)
integer :: m, o, i
real :: val

! init
if (sync) call barrier
timers(3) = clock()

! allocate buffers
if (init) then
    init = .false.
    allocate(prof(4,itio))
    if (faultnormal /= 'no') then
        allocate (maxl(12,itio), maxg(12,itio), suml(3,itio), sumg(3,itio))
        suml = 0.0
        sumg = 0.0
    else
        allocate (maxl(4,itio), maxg(4,itio))
    end if
    maxl = 0.0
    maxg = 0.0
    fh = -1
    if (mpout /= 0) fh = file_null
end if

! buffer stats
if (modulo(it, itstats) == 0) then
    j = j + 1
    maxl(1,j) = amax
    maxl(2,j) = vmax
    maxl(3,j) = umax
    maxl(4,j) = wmax
    val = maxval(maxl)
    if (val /= val .or. val > huge(val)) then
        write (0,*) 'NaN/Inf!'
        write (0,*) 'amax:', amaxloc + nnoff, amax
        write (0,*) 'vmax:', vmaxloc + nnoff, vmax
        write (0,*) 'umax:', umaxloc + nnoff, umax
        write (0,*) 'wmax:', wmaxloc + nnoff, wmax
        stop
    end if
    if (faultnormal /= 'no') then
        maxl(5,j) = samax
        maxl(6,j) = svmax
        maxl(7,j) = sumax
        maxl(8,j) = slmax
        maxl(9,j) = tsmax
        maxl(10,j) = -tnmin
        maxl(11,j) = tnmax
        maxl(12,j) = tarrmax
        suml(1,j) = efric
        suml(2,j) = estrain
        suml(3,j) = moment
    end if
end if

! write stats
if (j > 0 .and. (modulo(it, itio) == 0 .or. it == nt)) then
    call rreduce2(maxg, maxl, 'max')
    if (faultnormal /= 'no') then
        call rreduce2(sumg, suml, 'sum')
    end if
    if (master) then
        m = nt / itstats
        o = it / itstats - j
        maxg(:4,:j) = sqrt(maxg(:4,:j))
        call rio1(fh(1), maxg(1,:j), 'w', 'stats-amax.bin', m, o, mpout)
        call rio1(fh(2), maxg(2,:j), 'w', 'stats-vmax.bin', m, o, mpout)
        call rio1(fh(3), maxg(3,:j), 'w', 'stats-umax.bin', m, o, mpout)
        call rio1(fh(4), maxg(4,:j), 'w', 'stats-wmax.bin', m, o, mpout)
        if (faultnormal /= 'no') then
            maxg(10,:j) = -maxg(10,:j)
            call rio1(fh(5),  maxg(5,:j),  'w', 'stats-samax.bin',   m, o, mpout)
            call rio1(fh(6),  maxg(6,:j),  'w', 'stats-svmax.bin',   m, o, mpout)
            call rio1(fh(7),  maxg(7,:j),  'w', 'stats-sumax.bin',   m, o, mpout)
            call rio1(fh(8),  maxg(8,:j),  'w', 'stats-slmax.bin',   m, o, mpout)
            call rio1(fh(9),  maxg(9,:j),  'w', 'stats-tsmax.bin',   m, o, mpout)
            call rio1(fh(10), maxg(10,:j), 'w', 'stats-tnmin.bin',   m, o, mpout)
            call rio1(fh(11), maxg(11,:j), 'w', 'stats-tnmax.bin',   m, o, mpout)
            call rio1(fh(12), maxg(12,:j), 'w', 'stats-tarrmax.bin', m, o, mpout)
            call rio1(fh(13), sumg(1,:j),  'w', 'stats-efric.bin',   m, o, mpout)
            call rio1(fh(14), sumg(2,:j),  'w', 'stats-estrain.bin', m, o, mpout)
            call rio1(fh(15), sumg(3,:j),  'w', 'stats-moment.bin',  m, o, mpout)
            do i = 1, j
                if (sumg(3,i) > 0.0) then
                    sumg(3,i) = (log10(sumg(3,i)) - 9.05) / 1.5
                else
                    sumg(3,i) = -999
                end if
            end do
            call rio1(fh(16), sumg(3,:j),'w', 'stats-mw.bin', m, o, mpout)
        end if
    end if
    j = 0
end if

! profile
if (sync) call barrier
if (master) then
    timers(4) = clock()
    timers(3) = timers(4) - timers(3)
    i = modulo(it - 1, itio) + 1
    prof(:,i) = timers
    if (i == itio .or. it == nt) then
        call iio1(fh(17), prof(1,:i), 'w', 'prof-halo.bin',  nt, it-i, mpout)
        call iio1(fh(18), prof(2,:i), 'w', 'prof-io.bin',    nt, it-i, mpout)
        call iio1(fh(19), prof(3,:i), 'w', 'prof-stats.bin', nt, it-i, mpout)
        call iio1(fh(20), prof(4,:i), 'w', 'prof-step.bin',  nt, it-i, mpout)
    end if
end if

end subroutine

end module

max_stars_repo_name: gely/coseis

max_issues_repo_name: gely/coseis

max_forks_repo_name: gely/coseis


text:
subroutine ssrkc4(neqn,t0,u0,h,t,u,e)
!
! Subroutine ssrkc4 computes an ODE solution by the
! classical fourth order RK method for one step along the
! solution (by calls to derv to define the ODE derivative
! vector). It also estimates the truncation error of the
! solution, and applies this estimate as a correction
! to the solution vector.
!
! Argument list
!
! neqn number of first order ODEs
!
! t0 initial value of independent variable
!
! u0 initial condition vector of length neqn
!
! h integration step
!
! t independent variable
!
! u ODE solution vector of length neqn after
! one rkc4 step
!
! e estimate of truncation error of the solu-
! tion vector
!
! Double precision coding is used
implicit double precision(a-h,k,o-z)
!
! Size the arrays
parameter(neq=500)
dimension ut0(neq), ut(neq), u4(neq),k1(neq), k2(neq), k3(neq), k4(neq)
dimension u0(neqn), u(neqn), e(neqn)
!
! Derivative vector at initial (base) point
call derv(neqn,t0,u0,ut0)
!
! k1, advance of dependent variable vector and
! independent variable for calculation of k2
do i=1,neqn
    k1(i)=h*ut0(i)
    u(i)=u0(i)+0.5d0*k1(i)
end do
!
t=t0+0.5d0*h
!
! Derivative vector at new u, t
call derv(neqn,t,u,ut)
!
! k2, advance of dependent variable vector and
! independent variable for calculation of k3
do i=1,neqn
    k2(i)=h*ut(i)
    u(i)=u0(i)+0.5d0*k2(i)
end do
!
t=t0+0.5d0*h
!
! Derivative vector at new u, t
call derv(neqn,t,u,ut)
!
! k3, advance of dependent variable vector and
! independent variable for calculation of k4
do i=1,neqn
    k3(i)=h*ut(i)
    u(i)=u0(i)+k3(i)
end do
t=t0+h
!
! Derivative vector at new u, t
call derv(neqn,t,u,ut)
!
! k4, stepping
do i=1,neqn
    k4(i)=h*ut(i)
    !
    ! Second order step
    u(i)=u0(i)+k2(i)
    !
    ! Fourth order step
    u4(i)=u0(i)+(1.0d0/6.0d0)*(k1(i)+2.0d0*k2(i)+2.0d0*k3(i)+k4(i))
end do
do i=1,neqn
    !
    ! Truncation error estimate
    e(i)=u4(i)-u(i)
    !
    ! Fourth order solution vector (from (2,4) RK pair)
    u(i)=u(i)+e(i)
end do
return
!
! End of ssrkc4
end

max_stars_repo_name: cunyizju/Runge-Kutta-ODE-FORTRAN

max_issues_repo_name: cunyizju/Runge-Kutta-ODE-FORTRAN

max_forks_repo_name: cunyizju/Runge-Kutta-ODE-FORTRAN


text:
program  WORKSHARE1

    INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM, N, I
    PARAMETER (N = 10000)
    REAL A(N), B(N), C(N)

    ! Some initializations
    CALL OMP_SET_NUM_THREADS(4)

    !$OMP parallel do private (I) shared(A)
    DO I = 1, N
        A(I) = I
    ENDDO
    !$OMP end parallel do

    B = A

    !$OMP PARALLEL SHARED(A,B,C) PRIVATE(I,TID)

    TID = OMP_GET_THREAD_NUM()
    IF (TID .EQ. 0) THEN
        NTHREADS = OMP_GET_NUM_THREADS()
        PRINT *, 'Number of threads =', NTHREADS
    END IF
    PRINT *, 'Thread', TID, ' starting...'

    !$OMP DO
    DO I = 1, N
        C(I) = A(I) + B(I)
        WRITE(*, 100) TID, I, C(I)
        100 FORMAT(' Thread', I2, ': C(', I3, ')=', F8.2)
    ENDDO
    !$OMP END DO NOWAIT

    PRINT *, 'Thread', TID, ' done.'

    !$OMP END PARALLEL

    return
END

max_stars_repo_name: cmplopes/fortran

max_issues_repo_name: cmplopes/fortran

max_forks_repo_name: cmplopes/fortran


text:
! { dg-do run }
! PR 17992:  Reading an empty file should yield zero with pad='YES'
! (which is the default).
! Test case supplied by milan@cmm.ki.si.
program main
  open(77,status='scratch')
  write(77,'(A)') '',''
  rewind(77)
  i = 42
  j = 42
  read(77,'(/2i2)') i,j
  if (i /= 0 .or. j /= 0) call abort
  close(77)
end program main

max_stars_repo_name: maurizioabba/rose

max_issues_repo_name: sujankh/rose-matlab

max_forks_repo_name: sujankh/rose-matlab


text:
A beeramid is a stack or tower of beer cans or cups. A party and bar past time activity, building a beeramid (a portmanteau of beer and pyramid) requires a multitude of cans or cups. There are a few varieties of beeramid structures determined by how the base is constructed. These include
 Two dimensional beeramid  base is a line
 Three dimensional
  Triangle base
  Square base
  Circle base, etc.

Sudwerks Beeramids

Beeramids are often built at Sudwerk Sudwerks dollar pint night where there an ample amount of cheap beer and people willing to drink it. The beeramids range in size from personal towers with only a few cups to pyramids that are only limited by how high the drinkers can stretch their arm. The current record for beeramid at Sudwerk was set on the dollar pint night on 4/2/2008. Confirmed by employee Jason Agbayani as the largest the employees had ever seen, it had 180 cups at its most (pictured with only 179) before being purposely fallen into by a patron unrelated to the beeramids construction (possibly a Bros bro) to the dismay of most of the brewery who had fallen in favor of the new record. The man who fell the tower was forced to clean up the cups and was then kicked out for the night.

Some placed doubt in the legitimacy of the beeramid because many of the cups were gathered from other tables and not drank by the builders themselves. Jason said that he once saw 10 guys make a tower nearly as tall and drink all the beer themselves but that this was still quite impressive.


!        Generated by TAPENADE     (INRIA, Ecuador team)
!  tapenade 3.x
!
!  Differentiation of rhoi in reverse (adjoint) mode (with options noISIZE i8):
!   gradient     of useful results: *temp rhoi
!   with respect to varying inputs: *temp
!   Plus diff mem management of: temp:in
! MIT License
!
! Copyright (c) 2020 SHEMAT-Suite
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.
!>    @brief calculate ice density  [kg/m^3]
!>    @param[in] i cell index, direction I0
!>    @param[in] j cell index, direction J0
!>    @param[in] k cell index, direction K0
!>    @param[in] ismpl local sample index
!>    @details
!>    Fukusako, S.:
!>    Thermophysical Properties of Ice, Snow,and Sea Ice
!>    International Journal of Thermophysics, 1990, 11, 353-372
!>
!>    There should be another source.
SUBROUTINE RHOI_AD0(i, j, k, ismpl, rhoi_ad)
  use arrays

  USE ARRAYS_AD

  IMPLICIT NONE
  INTEGER :: i, j, k, ui, ismpl
  DOUBLE PRECISION :: plocal, tlocal
  DOUBLE PRECISION :: tlocal_ad
  INTEGER :: branch
  DOUBLE PRECISION :: rhoi_ad
  DOUBLE PRECISION :: rhoi
  tlocal = temp(i, j, k, ismpl)
  IF (tlocal .GT. 0.d0) THEN
    CALL PUSHCONTROL1B(0)
  ELSE
    CALL PUSHCONTROL1B(1)
  END IF
  tlocal_ad = -(0.151d0*rhoi_ad)
  CALL POPCONTROL1B(branch)
  IF (branch .EQ. 0) tlocal_ad = 0.D0
  temp_ad(i, j, k, ismpl) = temp_ad(i, j, k, ismpl) + tlocal_ad
END SUBROUTINE RHOI_AD0