text:
David M. Greenwald is married to Cecilia EscamillaGreenwald, whom he met on a political campaign, Mark DeSios State Senate campaign in 1998. David Greenwald came here as a graduate student in Political Science at University of California, Davis.  He got his Masters in Political Science in 2007.  He grew up in San Luis Obispo, Ca.  In 1994, he ran for the school board in San Luis Obispo, narrowly losing in a five person race.  He earned a bachelors degree in political science and history in 1996.  In 199697, he worked for People for the American Way in Washington, D.C.  He also worked on Congresswoman Lois Capps field operation for her special election in 199798 after her husband first term Congressman Walter Capps passed away in November of 1997.

He was out of politics from 1998 until 2006, when his wife, Cecilia, came under fire for her role in pushing for civilian police review in Davis as Chair of the Human Relations Commission.  He claims to have no personal political aspirations.  Cecilia EscamillaGreenwald ran 2008 City Council Election for City Council in 2008.

David founded and maintains the political blog, The Peoples Vanguard of Davis, in August of 2006 posting under the pseudonym, Doug Paul Davis.  The Vanguard has become an alternative to the mainstream news in Davis.

In December 2008, David Greenwald was hired as the Editor of the http://californiaprogressreport.com California Progress Reporta liberal blog that covers California politics.

David received the Thong H. Huynh Awards Thong Hy Huynh Memorial Award for Community Education and Awareness in 2009 for his work with the Vanguard.

He and his wife Cecilia became certified foster parents in the fall of 2009 and received Jasmine as a foster child on December 7, 2009.  They adopted Jasmine as their daughter on October 24, 2011.  They also have nephews Malachi, 8, and Jeremiah 10 mos, who they are guardians for.

In 2010, he launched Yolo Judicial Watch as a sideproject of the Vanguard.  The project monitors and reports on case and other issue involving the Yolo County Judicial system.

David is of no relation to former Mayor and Councilmember Sue Greenwald.

Email Mailto(info AT davisvanguard DOT org)

20080226 10:56:52 nbsp Davids not still a grad student is he? I couldnt find his info on the UCD people search.  Users/JeremyOgul

20090914 15:09:45 nbsp Is Doug interested in doing a piece of how to remain anonymous in various dealings online? Users/StevenDaubert

20100521 16:36:23 nbsp I would like to talk to you in person or over the phone sometime in the near future, thank you for your time Users/StevenDaubert

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
      program main
      include 'mpif.h'

      integer ierr, world_rank, world_size, source, destination, number
      integer num1, target
      num1 = 100

      call mpi_init( ierr )

      call mpi_comm_rank( MPI_COMM_WORLD, world_rank, ierr )

      call mpi_comm_size( MPI_COMM_WORLD, world_size, ierr )

      if (world_size < 2) then
        print *,'World size must be greater than 1'
        call mpi_abort(MPI_COMM_WORLD, ierr)
      endif

      if (world_rank > 0) then
        source = world_rank - 1
        call mpi_recv( number, 1, MPI_INT, source, 0, MPI_COMM_WORLD,
     $       MPI_STATUS_IGNORE, ierr )

        print *,'Process ', world_rank, 'received number', number,
     $       'from process', source
      else
        number = num1
        print *,'Process ', world_rank, 'initialised number = ', number
      endif

      number = number + world_rank

      if (world_rank < world_size - 1) then

        destination = world_rank + 1;

        call mpi_send(number, 1, MPI_INT, destination, 0,
     $       MPI_COMM_WORLD, ierr)

        print *,'Process ', world_rank, 'sent number', number,
     $       'to process', destination

      else
        target = 100 + world_rank * (world_rank + 1) / 2

        print *,'Process ', world_rank, 'Final answer', number,
     $       'should be', target

        if (number == target) then
          print *, 'SUCCESS FOR NPROC = ', world_size
        else
          print *, 'FAILURE'
        endif

      endif

      call mpi_finalize(ierr)

      end

ext: f

max_stars_repo_name: cedadev/quick-software-tests

max_issues_repo_name: cedadev/quick-software-tests

max_forks_repo_name: agstephens/quick-software-tests


text:
!! INTERNAL COMPILER ERROR
!!
!! Update: Now working in 16.1.1.2
!!
!! Using xlf 16.1.1-rc3 on power9
!!
!! $ xlf2008 ibm-20181203d.f90
!! ** map_any_type   === End of Compilation 1 ===
!! ** parameter_list_type   === End of Compilation 2 ===
!! ** scalar_func_factories   === End of Compilation 3 ===
!! ** phase_property_table_factory   === End of Compilation 4 ===
!! xlf2008: 1501-230 (S) Internal compiler error; please contact your Service Representative. For more information visit:
!!

module map_any_type
  private
  type :: list_item
    class(*), allocatable :: value
  end type
  type, public :: map_any
    type(list_item), pointer :: first => null()
  end type
end module

module parameter_list_type
  use map_any_type
  type :: parameter_list
    type(map_any) :: params = map_any()
  end type
end module

module scalar_func_factories
contains
  subroutine alloc_scalar_func(params)
    use parameter_list_type
    type(parameter_list) :: params
  end subroutine
end module

module phase_property_table_factory
  use scalar_func_factories
  use parameter_list_type
contains
  subroutine init(params)
    type(parameter_list) :: params
  end subroutine
end module

! INTERNAL COMPILER ERROR ON THIS PROGRAM UNIT
program test_init_phase_property_table
  use phase_property_table_factory, only: init
end program

max_stars_repo_name: dhnza/fortran-compiler-tests

max_issues_repo_name: dhnza/fortran-compiler-tests

max_forks_repo_name: dhnza/fortran-compiler-tests


text:
    !> Generic element for finite strains
    !!
    !!
	!! @param iShiftU = nint(CommonPar(1))
	!! @param iShiftDeltaU = nint(CommonPar(2))
	!! @param iFemType  = nint(CommonPar(3))
	!! @param iFType  = nint(commonPar(4))
	!! @param iMaterial  = nint(commonPar(5))
	!! @param iDamageParType  = nint(commonPar(6))
	!!
    !! @author Rocha, Felipe Figueredo

Subroutine computeCoeficientsCilindrical_arcLength(AE, BE, MaxLRows, XLL, NDim, iDofT, NodElt, &
											Sol0, Sol1, CommonPar, Param, JParam, DelT, DTm, Time)
!     ------------------------------------------------------------------
	use funcAux
	use globalVariables, only : NdimE
	use ptsGaussLib

	implicit none

	!   ===== SUBROUTINE ARGUMENTS  =======
	integer :: MaxLRows,Ndim,iDofT, NodElt! all integers
	Real*8 :: DelT, DTm,Time ! all reals
	Real*8 :: AE(MaxLRows,MaxLRows), BE(MaxLRows), XLL(*), Sol0(*), Sol1(*), Param(*), JParam(*), CommonPar(*)

!~ 	!   =====   END ARGUMENTS  =======

	Integer :: nG, i, ip, ipDim, ipDimE, ipDof,ipDofmod ! counters
	Integer :: constLaw ! if NparamDamage = 0 , no damage
	Real*8 :: dV , Det
	real*8, allocatable, dimension(:) ::  Sol_dUf_Star, Sol_dUf_Bar , Sol_DUf_acc, Sol_dU_acc, Xel, SolGy
	integer :: pOrder , NGP, NodG, iFEMtype , iFtype, iSimplex, iBubble, lU
	type(ptGaussClass) :: PtG

	real*8 :: Gbar(NdimE,NdimE), lambda, y(NdimE) , arcLength, dLarcLength_acc
	integer :: 	iShift_c1, iShift_c2, iShift_c3, iShift_dUf_Star, iShift_dUf_Bar, &
				iShift_DUf_acc, iShift_dLarcLength_acc

	real*8 :: Nmat(NdimE,NdimE*NodElt)  , dU_acc_ng(NdimE) , v(NdimE) , w(NdimE) , c1, c2, c3

	arcLength = CommonPar(1)
	iShift_c1 = nint(CommonPar(2))
	iShift_c2 = nint(CommonPar(3))
	iShift_c3 = nint(CommonPar(4))
	iShift_dUf_Star = nint(CommonPar(5))
	iShift_dUf_Bar = nint(CommonPar(6))
	iShift_DUf_acc = nint(CommonPar(7))
	iShift_dLarcLength_acc = nint(CommonPar(8))
	iFEMtype =  nint(commonPar(9))

	call setFEMtype(iFEMtype,NodG,pOrder,NGP,iSimplex,iBubble)

	call getSliceAllocate(Sol_dUf_Bar,Sol1,1,NodG, iShift_dUf_Bar + 1 , iShift_dUf_Bar + NdimE, iDofT)
	call getSliceAllocate(Sol_dUf_Star,Sol1,1,NodG, iShift_dUf_Star + 1 , iShift_dUf_Star + NdimE, iDofT)
	call getSliceAllocate(Sol_DUf_acc,Sol1,1,NodG, iShift_DUf_acc + 1 , iShift_DUf_acc + NdimE, iDofT)
	call getSliceAllocate(Xel,XLL,1,NodG,1 ,NdimE, Ndim)

	allocate(SolGy(NodG*NdimE))

	dLarcLength_acc = Sol1(NodG*idofT + iShift_dLarcLength_acc + 1)

	SolGy = 0.0d0
	Gbar = 0.0d0
	Gbar(2,2) = 1.0d0

	do i = 1 , NodG
		ip = (i-1)*NdimE
		y = Xel(ip + 1 : ip + NdimE)
		SolGy( ip + 1 : ip + NdimE) = matmul(Gbar,y)
	end do

	Sol_dU_acc = dLarcLength_acc*SolGy + Sol_DUf_acc

	lU = NodG*NdimE

	call PtG%init(Xel,NodG,NdimE,NGP,pOrder,iBubble, iSimplex)

	c1 = 0.0d0
	c2 = 0.0d0
	c3 = 0.0d0

	do nG = 1, NGP ! LoopGauss

		call PtG%getNmat(Nmat(:,1:lU),nG)

		dU_acc_ng = matmul(Nmat(:,1:lU), Sol_dU_acc(1:lU) )
		v = matmul(Nmat(:,1:lU), SolGy(1:lU)) + matmul(Nmat(:,1:lU), Sol_dUf_Bar(1:lU))
		w = dU_acc_ng + matmul(Nmat(:,1:lU), Sol_dUf_Star(1:lU) )

		dV=ptG%dV(nG)

		c1 = c1 + dot_product(v,v)*dV
		c2 = c2 + 2.0d0*dot_product(v,w)*dV
		c3 = c3 + (dot_product(w,w) - arcLength*arcLength)*dV

	end do !LoopGauss

	ip = NodG*iDofT + 1
	AE(ip + iShift_c1,ip + iShift_c1) =  1.0d0
	AE(ip + iShift_c2,ip + iShift_c2) =  1.0d0
	AE(ip + iShift_c3,ip + iShift_c3) =  1.0d0
	BE(ip + iShift_c1) =  c1
	BE(ip + iShift_c2) =  c2
	BE(ip + iShift_c3) =  c3

end subroutine

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Subroutine computeCoeficientsCilindrical_arcLengthS(Coupling,CommonPar,iDofT,Ndim,MaxLRows,iAdd)
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    use funcAux
    use ptsGaussLib
    IMPLICIT NONE
    Integer :: MaxLRows,Ndim,iDofT, iAdd
    Integer   Coupling(MaxLRows,MaxLRows)
    Real*8 CommonPar(*)

    Integer :: iShift_c1, iShift_c2, iShift_c3, ip, NodG, iFEMtype

    Coupling = 0

    iShift_c1 = nint(CommonPar(2))
	iShift_c2 = nint(CommonPar(3))
	iShift_c3 = nint(CommonPar(4))
	iFEMtype =  nint(commonPar(9))

	call setNodG(iFEMtype, NodG)
	ip = NodG * idofT + 1

	Coupling(ip + iShift_c1,ip + iShift_c1) =  1
	Coupling(ip + iShift_c2,ip + iShift_c2) =  1
	Coupling(ip + iShift_c3,ip + iShift_c3) =  1

end Subroutine

max_stars_repo_name: felipefr/gpmaterials

max_issues_repo_name: felipefr/gpmaterials

max_forks_repo_name: felipefr/gpmaterials


text:
! This Source Code Form is subject to the terms of the Mozilla Public
! License, v. 2.0. If a copy of the MPL was not distributed with this
! file, You can obtain one at http://mozilla.org/MPL/2.0/.
!
! File:   get_basis_data.f90
! Author: Francis Ricci
!
! Created on June 20, 2014, 11:04 AM
!

module get_basis_data
    use iso_c_binding
    implicit none

    interface
        !get nuclear repulsion energy, returning value into nuclear_energy
        subroutine c_get_nuclear_repulsion(nuclear_energy) bind(c)
            use iso_c_binding
            implicit none
            real(kind=C_DOUBLE), intent(out)::nuclear_energy
        end subroutine c_get_nuclear_repulsion
    end interface

    interface
        !get number of atoms, returning value through num_atoms
        subroutine c_get_num_atoms(num_atoms) bind(c)
            use iso_c_binding
            implicit none
            integer(kind=C_INT64_T), intent(out)::num_atoms
        end subroutine c_get_num_atoms
    end interface

    interface
        !get number of shells, returning value through nShell
        subroutine c_nr_shells(nShell) bind(c)
            use iso_c_binding
            implicit none
            integer(kind=C_INT64_T), intent(out)::nShell
        end subroutine c_nr_shells
    end interface

    interface
        !get nuclear coordinates, returning value through coordinates
        subroutine c_get_coordinates(n_atoms, coordinates) bind(c)
            use iso_c_binding
            implicit none

            integer(kind=C_INT64_T), intent(in)::n_atoms
            real(kind=C_DOUBLE), intent(out)::coordinates(1,1)
        end subroutine c_get_coordinates
    end interface

    interface
        !generate mapping of each basis function to its atomic center
        subroutine c_get_basis_map(number_bas, basismap) bind(c)
            use iso_c_binding
            implicit none

            integer(kind=C_INT64_T), intent(in)::number_bas
            integer(kind=C_INT64_T), intent(out)::basismap(1)
        end subroutine c_get_basis_map
    end interface

    interface
        !get some datarmation about the basis functions
        subroutine c_basis_func_data(nFuncInShell, number_bas, nShell) bind(c)
            use iso_c_binding
            implicit none

            integer(kind=C_INT64_T), intent(in)::number_bas
            integer(kind=C_INT64_T), intent(out)::nFuncInShell(1)
            integer(kind=C_INT64_T), intent(out)::nShell

        end subroutine c_basis_func_data
    end interface

contains
    !get nuclear repulsion energy, returning value into nuclear_energy
    subroutine get_nuclear_repulsion(nuclear_energy)
        use iso_c_binding
        implicit none

        real(kind=8), intent(out)::nuclear_energy

        call c_get_nuclear_repulsion(nuclear_energy)
    end subroutine get_nuclear_repulsion

    !get number of atoms, returning value through num_atoms
    subroutine get_num_atoms(num_atoms)
        use iso_c_binding
        implicit none

        integer(kind=8), intent(out)::num_atoms

        call c_get_num_atoms(num_atoms)
    end subroutine get_num_atoms

    !get number of shells, returning value through nshell
    subroutine nr_shells(nShell)
        use iso_c_binding
        implicit none

        integer(kind=8), intent(out)::nShell

        call c_nr_shells(nShell)
    end subroutine nr_shells

    !get nuclear coordinates, returning value through coordinates
    subroutine get_coordinates(n_atoms, coordinates)
        use iso_c_binding
        implicit none

        integer(kind=8), intent(in)::n_atoms
        real(kind=8), intent(out)::coordinates(n_atoms,3)

        call c_get_coordinates(n_atoms, coordinates)
    end subroutine get_coordinates

    subroutine get_basis_map(number_bas, basisfunc2atom)
        use iso_c_binding
        implicit none

        integer(kind=8), intent(in)::number_bas
        integer(kind=8), intent(out)::basisfunc2atom(number_bas)

        call c_get_basis_map(number_bas, basisfunc2atom)
    end subroutine get_basis_map

    !get some datarmation about the basis functions
    subroutine basis_func_data(nFuncInShell, number_bas, nShell)
        use iso_c_binding
        implicit none

        integer(kind=8), intent(in)::number_bas
        integer(kind=8), intent(out)::nFuncInShell(number_bas)
        integer(kind=8), intent(out)::nShell

        call c_basis_func_data(nFuncInShell, number_bas, nShell)
    end subroutine basis_func_data

end module get_basis_data

max_stars_repo_name: EACcodes/TigerCI

max_issues_repo_name: EACcodes/TigerCI

max_forks_repo_name: EACcodes/TigerCI


module stencil_test_module

  implicit none

  private

  public :: lapleb_MSD, lapl_MSD, init_phi

contains

  subroutine lapleb_MSD(&
       lph,lph_l1,lph_l2,lph_l3,lph_h1,lph_h2,lph_h3, &
       phi,phi_l1,phi_l2,phi_l3,phi_h1,phi_h2,phi_h3, &
       fd0,fd0_l1,fd0_l2,fd0_l3,fd0_h1,fd0_h2,fd0_h3, &
       fd1,fd1_l1,fd1_l2,fd1_l3,fd1_h1,fd1_h2,fd1_h3, &
       fd2,fd2_l1,fd2_l2,fd2_l3,fd2_h1,fd2_h2,fd2_h3, &
       lo, hi, dx) bind(C,name="lapleb_MSD")

    integer, intent(in) :: lph_l1,lph_l2,lph_l3,lph_h1,lph_h2,lph_h3
    integer, intent(in) :: phi_l1,phi_l2,phi_l3,phi_h1,phi_h2,phi_h3
    integer, intent(in) :: fd0_l1,fd0_l2,fd0_l3,fd0_h1,fd0_h2,fd0_h3
    integer, intent(in) :: fd1_l1,fd1_l2,fd1_l3,fd1_h1,fd1_h2,fd1_h3
    integer, intent(in) :: fd2_l1,fd2_l2,fd2_l3,fd2_h1,fd2_h2,fd2_h3

    integer, intent(in) :: lo(3),hi(3)

    double precision, intent(inout) :: lph(lph_l1:lph_h1,lph_l2:lph_h2,lph_l3:lph_h3)
    double precision, intent(in   ) :: phi(phi_l1:phi_h1,phi_l2:phi_h2,phi_l3:phi_h3)
    double precision, intent(in   ) :: fd0(fd0_l1:fd0_h1,fd0_l2:fd0_h2,fd0_l3:fd0_h3,4)
    double precision, intent(in   ) :: fd1(fd1_l1:fd1_h1,fd1_l2:fd1_h2,fd1_l3:fd1_h3,4)
    double precision, intent(in   ) :: fd2(fd2_l1:fd2_h1,fd2_l2:fd2_h2,fd2_l3:fd2_h3,4)
    double precision, intent(in   ) :: dx

    integer :: i,j,k,ip,im,jp,jm,kp,km, in, jn, kn, ii, jj, kk, iface, jface, kface, is, js, ks
    double precision :: fac, c0, c1, f00, f01, f10, f11, Fx(0:1), Fy(0:1), Fz(0:1)

    fac = 1.d0 / (dx*dx)

    do k=lo(3),hi(3)
       do j=lo(2),hi(2)
          do i=lo(1),hi(1)

             do ii=0,1
                iface = i+ii

                jn = j + SIGN(1.d0, fd0(iface,j,k,3))
                kn = k + SIGN(1.d0, fd0(iface,j,k,4))

                f00 = fac*(phi(iface,j ,k ) - phi(iface-1,j ,k ))
                f10 = fac*(phi(iface,jn,k ) - phi(iface-1,jn,k ))
                f01 = fac*(phi(iface,j ,kn) - phi(iface-1,j ,kn))
                f11 = fac*(phi(iface,jn,kn) - phi(iface-1,jn,kn))

                c0 = ABS(fd0(iface,j,k,3))
                c1 = ABS(fd0(iface,j,k,4))

                Fx(ii) = (f00*(1.d0-c0)*(1.d0-c1) + f10*c0*(1.d0-c1) &
                     + f01*(1.d0-c0)*c1 + f11*c0*c1)*fd0(iface,j,k,1)
             enddo

             do jj=0,1
                jface = j+jj

                in = i + SIGN(1.d0, fd1(i,jface,k,2))
                kn = k + SIGN(1.d0, fd1(i,jface,k,4))

                f00 = fac*(phi(i ,jface,k ) - phi(i ,jface-1,k ))
                f10 = fac*(phi(in,jface,k ) - phi(in,jface-1,k ))
                f01 = fac*(phi(i ,jface,kn) - phi(i ,jface-1,kn))
                f11 = fac*(phi(in,jface,kn) - phi(in,jface-1,kn))

                c0 = ABS(fd1(i,jface,k,2))
                c1 = ABS(fd1(i,jface,k,4))

                Fy(jj) = (f00*(1.d0-c0)*(1.d0-c1) + f10*c0*(1.d0-c1) &
                     + f01*(1.d0-c0)*c1 + f11*c0*c1)*fd1(i,jface,k,1)
             enddo

             do kk=0,1
                kface = k+kk

                in = i + SIGN(1.d0, fd2(i,j,kface,2))
                jn = j + SIGN(1.d0, fd2(i,j,kface,3))

                f00 = fac*(phi(i ,j ,kface) - phi(i ,j ,kface-1))
                f10 = fac*(phi(in,j ,kface) - phi(in,j ,kface-1))
                f01 = fac*(phi(i ,jn,kface) - phi(i ,jn,kface-1))
                f11 = fac*(phi(in,jn,kface) - phi(in,jn,kface-1))

                c0 = ABS(fd2(i,j,kface,2))
                c1 = ABS(fd2(i,j,kface,3))

                Fz(kk) = (f00*(1.d0-c0)*(1.d0-c1) + f10*c0*(1.d0-c1) &
                     + f01*(1.d0-c0)*c1 + f11*c0*c1)*fd2(i,j,kface,1)
             enddo

             lph(i,j,k) = Fx(1) - Fx(0) + Fy(1) - Fy(0) + Fz(1) - Fz(0)

          enddo
       enddo
    enddo

  end subroutine lapleb_MSD

  subroutine lapl_MSD(&
       lph,lph_l1,lph_l2,lph_l3,lph_h1,lph_h2,lph_h3, &
       phi,phi_l1,phi_l2,phi_l3,phi_h1,phi_h2,phi_h3, &
       lo, hi, dx) bind(C,name="lapl_MSD")

    integer, intent(in) :: lph_l1,lph_l2,lph_l3,lph_h1,lph_h2,lph_h3
    integer, intent(in) :: phi_l1,phi_l2,phi_l3,phi_h1,phi_h2,phi_h3

    integer, intent(in) :: lo(3),hi(3)

    double precision, intent(inout) :: lph(lph_l1:lph_h1,lph_l2:lph_h2,lph_l3:lph_h3)
    double precision, intent(in   ) :: phi(phi_l1:phi_h1,phi_l2:phi_h2,phi_l3:phi_h3)
    double precision, intent(in   ) :: dx

    integer :: i,j,k
    double precision :: fac

    fac = 1.d0 / (dx*dx)

    do k=lo(3),hi(3)
       do j=lo(2),hi(2)
          do i=lo(1),hi(1)
             lph(i,j,k) = fac*(phi(i+1,j,k) + phi(i-1,j,k) - 2*phi(i,j,k)) &
                  +       fac*(phi(i,j+1,k) + phi(i,j-1,k) - 2*phi(i,j,k)) &
                  +       fac*(phi(i,j,k+1) + phi(i,j,k-1) - 2*phi(i,j,k))
          enddo
       enddo
    enddo

  end subroutine lapl_MSD

  subroutine init_phi(&
       phi,phi_l1,phi_l2,phi_l3,phi_h1,phi_h2,phi_h3, &
       lo, hi, plo, dx) bind(C,name="init_phi")

    integer, intent(in) :: phi_l1,phi_l2,phi_l3,phi_h1,phi_h2,phi_h3

    integer, intent(in) :: lo(3),hi(3)

    double precision, intent(inout) :: phi(phi_l1:phi_h1,phi_l2:phi_h2,phi_l3:phi_h3)
    double precision, intent(in   ) :: plo(3), dx

    integer :: i,j,k
    double precision :: x,y,z

    do k=lo(3),hi(3)
       z = plo(3) + (k+0.5d0)*dx
       do j=lo(2),hi(2)
          y = plo(2) + (j+0.5d0)*dx
          do i=lo(1),hi(1)
             x = plo(1) + (i+0.5d0)*dx
             phi(i,j,k) = 0.5d0 * (z-0.5d0)**2
          enddo
       enddo
    enddo

  end subroutine init_phi

end module stencil_test_module


text:
C    @(#)nx_date.f	20.2 2/28/00
      subroutine nx_date( month, day, year, weekday )
      integer month, day, year, weekday

C     This is the "root level" routine that should be changed
c     if you don't have a "c" compiler and your system supports
c     a Fortran callable date routine.

C     This routine gets the current date from the system in
c     integer format

C**********************************************************************
C***  Use one of the following - comment out the others  **************
C**********************************************************************

C**********************************************************************
C     The following code is the standard portable code that calls
c     a "C" routine that calls a standard "C" library routine.

      integer tm(9)

C *** CALTME is a "C" routine that is portable

      call caltme( tm )
      day   = tm(4)
      month = tm(5) + 1
      year  = mod (tm(6), 100)
      weekday = tm(7) + 1
C**********************************************************************
C**********************************************************************
C     VAX/VMS VERSION THAT AVOIDS CALLS TO "C" USING THE VMS
C     FORTRAN LIBRARY ROUTINE "IDATE"

C     call idate(  month, day, year )

C**********************************************************************
C**********************************************************************

C     Your system's Fortran date routine and any code to return
C     month, day, year

C**********************************************************************

      return
      end

max_stars_repo_name: mbheinen/bpa-ipf-tsp

max_issues_repo_name: cuihantao/bpa-ipf-tsp

max_forks_repo_name: mbheinen/bpa-ipf-tsp


text:
      SUBROUTINE ATIMA
      IMPLICIT None
C
C 1.    ATIMA
C
C 1.1   ATIMA PROGRAM SPECIFICATION
C
C 1.1.1 ATIMA ADDS ENTRIES TO THE TABLE OF CONTENTS FOR THE ATIME UTILITY
C       ROUTINE TEXT MESSAGE. IT ALSO ADDS ENTRIES TO THE TABLE OF CONTENTS
C       FOR THE FLOW CONTROL MESSAGE.
C
C 1.2   ATIMA PROGRAM INTERFACE
C
C 1.2.4 DATA BASE ACCESS -
C            ACCESS CODES:
C              1.  'ATI MESS'  -  THE DATA BASE ACCESS CODE FOR THE
C                                 ATIME UTILITY ROUTINE TEXT MESSAGE.
C              2.  'ATI CFLG'  -  THE DATA BASE ACCESS CODE FOR THE ATIME
C                                 UTILITY ROUTINE FLOW CONTROL MESSAGE.
C
C 1.2.6 SUBROUTINE INTERFACE -
C             CALLER SUBROUTINES: TOCUP
C             CALLED SUBROUTINES: ADDA
C
C 1.2.9 PROGRAMMER - DALE MARKHAM  02/04/77
C                    PETER DENATALE 07/18/77
C                    BRUCE SCHUPLER 09/16/77
C                    SAVITA GOEL    06/04/87 (CDS FOR A900)
C                    Jim Ryan 89.07.25 Documentaton simplified.
C
C     ATIMA Program Structure
C
C     ADD for ATIME utility text message.
      CALL ADDA (1,'ATI MESS','ATIME Message Definition        ',
     1     40, 1, 1 )
C
C     ADD for ATIME utility flow control message.
      CALL ADDA (1,'ATI CFLG','ATIME Flow Control Message Def. ',
     1     40,1,1)
C
C     Normal Program Conclusion.
      RETURN
      END
C
C*******************************************************************************
      SUBROUTINE ATIMI
      IMPLICIT None
C
C 2.    ATIMI
C
C 2.1   ATIMI PROGRAM SPECIFICATION
C
C 2.1.1 ATIMI IS THE ATIME UTILITY ROUTINE INPUT AND INITIALIZATION SECTION.
C
C 2.2   ATIMI PROGRAM INTERFACE
C
C 2.2.2 COMMON BLOCKS USED -
C
      Real*8  ATMUTC(3), ROTEPH(2,20), A1UTC(3), A1DIFF(3)
      COMMON / EOPCM / ATMUTC, ROTEPH, A1UTC, A1DIFF
C           VARIABLES 'TO/FROM':
C            1. ATMUTC(3)   - THE 'TAI MINUS UTC' INFORMATION ARRAY. THIS ARRAY
C                             CONTAINS RESPECTIVELY THE EPOCH, VALUE, AND TIME
C                             RATE OF CHANGE OF 'TAI MINUS UTC'.
C                             (DAYS, SEC, SEC/SEC)
C
      INCLUDE 'ccon.i'
C            VARIABLES 'FROM':
C              1. KATIC - THE ATIME UTILITY ROUTINE FLOW CONTROL FLAG.
C              2. KATID - THE ATIME UTILITY ROUTINE DEBUG OUTPUT FLAG.

      INCLUDE 'inputs.i'
C            Variables from:
C              1. Input_EOP - T/F logical flag telling whether to use external
C                             EOP file input
C
C 2.2.3 PROGRAM SPECIFICATIONS -
C
      INTEGER*2 NDO(3), Kerr
      INTEGER*2      LATIU(40),      LON(40),    LOFF(40)
      CHARACTER*40 C_LATIU(2),     C_LON(2),   C_LOFF(2)
      EQUIVALENCE (C_LATIU,LATIU),(C_LON,LON),(C_LOFF,LOFF)
C
      DATA C_LATIU /
     .'ATIME Utility routine - VERSION # 3, Las',
     .'t modification - 89:12:12 Jim Ryan.     '/
C
      DATA C_LON /
     .'ATIME Utility routine is turned on.     ',
     .'                                        '/
C
      DATA C_LOFF /
     .'ATIME Utility routine is turned off.    ',
     .'                                        '/
C
C 2.2.4 DATA BASE ACCESS -
C            'GET' VARIABLES:
C              1. ATMUTC(3) - THE 'TAI MINUS UTC' INFORMATION ARRAY. THIS ARRAY
C                             CONTAINS RESPECTIVELY THE EPOCH, VALUE, AND TIME
C                             RATE OF CHANGE OF 'TAI MINUS UTC'.
C                             (DAYS, SEC, SEC/SEC)
C            'PUT' VARIABLES:
C              1. LATIU(40) - THE ATIME UTILITY ROUTINE TEXT MESSAGE.
C              2. LON(40)   - THE ATIME UTILITY 'TURNED ON' MESSAGE.
C              3. LOFF(40)  - THE ATIME UTILITY 'TURNED OFF' MESSAGE.
C            ACCESS CODES:
C              1. 'ATI MESS'  -  THE DATA BASE ACCESS CODE FOR THE
C                                 ATIME UTILITY ROUTINE TEXT MESSAGE.
C              2. 'TAI- UTC'  -  THE DATA BASE ACCESS CODE FOR THE
C                                 'TAI MINUS UTC' INFORMATION ARRAY.
C              3. 'ATI CFLG'  -  THE DATA BASE ACCESS CODE FOR THE
C                                 ATIME UTILITY FLOW CONTROL MESSAGE.
C
C 2.2.6 SUBROUTINE INTERFACE -
C             CALLER SUBROUTINES: INITL
C             CALLED SUBROUTINES: GET4, KILL, PUTA
C
C 2.2.8 PROGRAM VARIABLES -
C           1. KERR   - THE DATA BASE ERROR RETURN FLAG.
C           2. NDO(3) - THE DATA BASE RETURN ARRAY INDICES.
C
C 2.2.9 PROGRAMMER - DALE MARKHAM  02/04/77
C                    PETER DENATALE 07/18/77
C                    BRUCE SCHUPLER 02/07/78
C                    Jim Ryan 89.07.25 Documentaton simplified.
C                    Jim Ryan 89.12.12 UNIX-like database interface
C                             implimented.
C                    D. Gordon 96.02.27 Double dimensioning of ATMUTC(3)
C                             removed, found by Warwick Wilson, ATNF.
C                    D. Gordon 98.05.01 Expanded and renamed common block
C                             ATICM to EOPCM. Pass in ATMUTC if using external
C                             EOP input.
C
C     ATIMI Program Structure
C
C     PUT the ATIME utility text message.
      CALL PUTA ('ATI MESS      ', LATIU, 40, 1, 1 )
C
C     PUT the flow control message based on the value of KATIC.
      IF (KATIC .NE. 1) CALL PUTA ('ATI CFLG      ',LON,40,1,1)
      IF (KATIC .EQ. 1) CALL PUTA ('ATI CFLG      ',LOFF,40,1,1)
C
      IF (.not. Input_EOP) THEN         ! Already have ATMUTC?
C      GET the 'TAI MINUS UTC' array from the database and check for errors.
        CALL GET4 ('TAI- UTC      ', ATMUTC, 3, 1, 1, NDO, KERR )
        IF ( KERR .EQ. 0 )  GO TO 300
         CALL CKILL (6HATIMI , 1, KERR )
      ENDIF                             ! Already have ATMUTC?
C
C     Check KATID for debug output.
  300 IF ( KATID .EQ. 0 )  GO TO 500
      WRITE ( 6, 9)
    9 FORMAT (1X, "Debug output for subroutine ATIMI." )
C
      WRITE(6,8)' ATMUTC  ',ATMUTC
    8 FORMAT(A,4D25.16/(7X,5D25.16))
C
C     Normal conclusion.
  500 RETURN
      END
C
C******************************************************************************
      SUBROUTINE ATIME ( UTC, XJD, AT, DUTCAT )
      IMPLICIT None
C
C 3.    ATIME
C
C 3.1   ATIME PROGRAM SPECIFICATION
C
C 3.1.1 ATIME IS THE UTILITY ROUTINE WHICH COMPUTES THE ATOMIC TIME
C       FROM THE UTC TIME AND ALSO CALCULATES THE PARTIAL DERIVATIVE
C       OF THE UTC TIME WITH RESPECT TO THE ATOMIC TIME.
C
C 3.2   ATIME PROGRAM INTERFACE
C
      Real*8 UTC, XJD, AT, DUTCAT
C
C 3.2.1 CALLING SEQUENCE -
C          INPUT VARIABLES:
C            1. UTC - THE UTC FRACTION OF THE UTC DAY. (SEC/SEC)
C            2. XJD - THE JULIAN DATE AT 0:00 UTC OF THE DATE IN QUESTION.
C          OUTPUT VARIABLES:
C            1. AT     - THE ATOMIC TIME FRACTION OF THE ATOMIC TIME DAY. (DAYS)
C            2. DUTCAT - THE PARTIAL DERIVATIVE OF THE UTC TIME WITH RESPECT TO
C                        THE ATOMIC TIME. (SEC/SEC)
C
C 3.2.2 COMMON BLOCKS USED -
C
      Real*8           PI, TWOPI, HALFPI, CONVD, CONVDS, CONVHS, SECDAY
      COMMON / CMATH / PI, TWOPI, HALFPI, CONVD, CONVDS, CONVHS, SECDAY
      EXTERNAL CMATHB
C           VARIABLES 'FROM':
C             1. SECDAY - THE CONVERSION FACTOR OF COORDINATE TIME SECONDS PER
C                         COORDINATE TIME DAY. (SEC/DAY)
C
      Real*8  ATMUTC(3), ROTEPH(2,20), A1UTC(3), A1DIFF(3)
      COMMON / EOPCM / ATMUTC, ROTEPH, A1UTC, A1DIFF
C           VARIABLES 'TO/FROM':
C             1. ATMUTC(3) - THE 'TAI MINUS UTC' INFORMATION ARRAY. CONTAINS
C                            RESPECTIVELY THE EPOCH, VALUE, AND TIME RATE OF
C                            CHANGE OF 'TAI MINUS UTC'. (DAYS, SEC, SEC/SEC)
C
      INCLUDE 'ccon.i'
C           VARIABLES 'FROM':
C             1. KATIC - THE ATIME UTILITY ROUTINE FLOW CONTROL FLAG.
C             2. KATID - THE ATIME UTILITY ROUTINE DEBUG OUTPUT FLAG.
C
C 3.2.3 PROGRAM SPECIFICATIONS -
C
C 3.2.6 SUBROUTINE INTERFACE -
C             CALLER SUBROUTINES: DRIVG
C             CALLED SUBROUTINES: NONE
C
C 3.2.7 CONSTANTS USED - SECDAY
C
C 3.2.8 PROGRAM VARIABLES - NONE
C
C 3.2.9 PROGRAMMER - DALE MARKHAM  02/04/77
C                    PETER DENATALE 07/18/77
C                    BRUCE SCHUPLER 02/07/78
C                    Jim Ryan 89.07.25 Documentaton simplified.
C
C   ATIME Program Structure
C
C     Compute the atomic time fraction of the atomic time day.
      AT = + ATMUTC(2) / SECDAY
     1     + ATMUTC(3) * ( XJD  -  ATMUTC(1) )
     2     + UTC
C
C     Compute the partial derivative of the UTC time with respect
C     to atomic time.
      DUTCAT = 1.D0 / ( 1.D0  +  ATMUTC(3) )
C
C     Check KATIC to see if the utility is to be turned off.
      IF ( KATIC .NE. 1 )  GO TO 400
        AT     = UTC
        DUTCAT = 1.D0
C
C     Check KATID for debug output.
  400 IF ( KATID .EQ. 0 )  GO TO 500
      WRITE ( 6, 9)
    9 FORMAT (1X, "Debug output for utility ATIME." )
C
      WRITE(6,8)' ATMUTC  ',ATMUTC
    8 FORMAT(A,4D25.16/(7X,5D25.16))
      WRITE(6,8)' SECDAY  ',SECDAY
      WRITE ( 6, 9200 )  UTC, XJD, AT, DUTCAT
 9200 FORMAT (1X, "UTC    = ", D30.16, /, 1X,
     1            "XJD    = ", D30.16, /, 1X,
     2            "AT     = ", D30.16, /, 1X,
     3            "DUTCAT = ", D30.16 )
C
  500 RETURN
      END

max_stars_repo_name: liulei/VOLKS

max_issues_repo_name: liulei/VOLKS

max_forks_repo_name: liulei/VOLKS


text:
Address(Cassidy Lane) is a rural lane outside of the city limits to the west of Davis.

 Intersecting Streets

  County Road 32 which is the extension of Russell Boulevard


text:
module coarray_intrinsic_alternatives
    !! Module to allow use of Fortran 2018 intrinsics co_sum and co_broadcast etc in limited situations, even
    !! if the compiler doesn't support them (e.g. true of ifort 2019).
    !! This code will only do something if compiled with -DCOARRAY_PROVIDE_CO_ROUTINES

    use iso_fortran_env, only: int32, real32, real64, real128
    use iso_c_binding, only: c_float, c_double
#if defined(COARRAY_PROVIDE_CO_ROUTINES) || defined(COARRAY_USE_MPI_FOR_INTENSIVE_COMMS)
    use mpi
#endif

    implicit none

    private
    public sync_all_generic, this_image2, num_images2, swals_mpi_init, swals_mpi_finalize

#ifdef COARRAY_PROVIDE_CO_ROUTINES
    public :: co_broadcast, co_sum, co_max, co_min

    ! Can add more kinds/ranks as required
    interface co_broadcast
        module procedure co_broadcast_int32, co_broadcast_int32_rank1, co_broadcast_int32_rank2, &
            co_broadcast_c_float, co_broadcast_c_float_rank1, co_broadcast_c_float_rank2, &
            co_broadcast_c_double, co_broadcast_c_double_rank1, co_broadcast_c_double_rank2
    end interface

    interface co_sum
        module procedure co_sum_int32, co_sum_real32, co_sum_real64, co_sum_real128
    end interface

    interface co_max
        module procedure co_max_int32, co_max_real32, co_max_real64, co_max_real128
    end interface

    interface co_min
        module procedure co_min_int32, co_min_real32, co_min_real64, co_min_real128
    end interface
#endif

    contains
#ifdef COARRAY_PROVIDE_CO_ROUTINES

    !
    ! Co-broadcast from a source image
    !
    subroutine co_broadcast_int32(var, source_image)
        integer(int32), intent(inout) :: var
        integer(int32), intent(in) :: source_image

        integer :: ierr

        call MPI_Bcast(var, 1, MPI_INTEGER4, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_int32_rank1(var, source_image)
        integer(int32), intent(inout) :: var(:)
        integer(int32), intent(in) :: source_image

        integer :: ierr, var_size

        var_size = size(var)
        call MPI_Bcast(var, var_size, MPI_INTEGER4, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_int32_rank2(var, source_image)
        integer(int32), intent(inout) :: var(:,:)
        integer(int32), intent(in) :: source_image

        integer :: ierr, var_size

        var_size = size(var)
        call MPI_Bcast(var, var_size, MPI_INTEGER4, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_c_float(var, source_image)
        real(c_float), intent(inout) :: var
        integer(int32), intent(in) :: source_image

        integer :: ierr

        call MPI_Bcast(var, 1, MPI_REAL, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_c_float_rank1(var, source_image)
        real(c_float), intent(inout) :: var(:)
        integer(int32), intent(in) :: source_image

        integer :: ierr, var_size

        var_size = size(var)
        call MPI_Bcast(var, var_size, MPI_REAL, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_c_float_rank2(var, source_image)
        real(c_float), intent(inout) :: var(:,:)
        integer(int32), intent(in) :: source_image

        integer :: ierr, var_size

        var_size = size(var)
        call MPI_Bcast(var, var_size, MPI_REAL, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_c_double(var, source_image)
        real(c_double), intent(inout) :: var
        integer(int32), intent(in) :: source_image

        integer :: ierr

        call MPI_Bcast(var, 1, MPI_DOUBLE_PRECISION, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_c_double_rank1(var, source_image)
        real(c_double), intent(inout) :: var(:)
        integer(int32), intent(in) :: source_image

        integer :: ierr, var_size

        var_size = size(var)
        call MPI_Bcast(var, var_size, MPI_DOUBLE_PRECISION, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    subroutine co_broadcast_c_double_rank2(var, source_image)
        real(c_double), intent(inout) :: var(:,:)
        integer(int32), intent(in) :: source_image

        integer :: ierr, var_size

        var_size = size(var)
        call MPI_Bcast(var, var_size, MPI_DOUBLE_PRECISION, source_image-1, MPI_COMM_WORLD, ierr)

    end subroutine

    !
    ! co-sum
    !

    subroutine co_sum_int32(var)
        integer(int32), intent(inout) :: var

        integer :: ierr, size_var

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_INTEGER4, MPI_SUM, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_sum_real32(var)
        real(real32), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_REAL, MPI_SUM, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_sum_real64(var)
        real(real64), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_sum_real128(var)
        real(real128), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_REAL16, MPI_SUM, MPI_COMM_WORLD, ierr)
    end subroutine

    !
    ! co-max
    !

    subroutine co_max_int32(var)
        integer(int32), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_INTEGER4, MPI_MAX, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_max_real32(var)
        real(real32), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_REAL, MPI_MAX, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_max_real64(var)
        real(real64), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_max_real128(var)
        real(real128), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_REAL16, MPI_MAX, MPI_COMM_WORLD, ierr)
    end subroutine

    !
    ! co-min
    !

    subroutine co_min_int32(var)
        integer(int32), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_INTEGER4, MPI_MIN, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_min_real32(var)
        real(real32), intent(inout) :: var

        integer :: ierr
        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_REAL, MPI_MIN, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_min_real64(var)
        real(real64), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_WORLD, ierr)
    end subroutine

    subroutine co_min_real128(var)
        real(real128), intent(inout) :: var

        integer :: ierr

        call MPI_Allreduce(MPI_IN_PLACE, var, 1, MPI_REAL16, MPI_MIN, MPI_COMM_WORLD, ierr)
    end subroutine

#endif

    subroutine sync_all_generic
        !! Alternative to "sync all" which uses mpi directly if COARRAY_USE_MPI_FOR_INTENSIVE_COMMS is defined
        integer :: ierr
#if defined(COARRAY_USE_MPI_FOR_INTENSIVE_COMMS)
        call mpi_barrier(MPI_COMM_WORLD, ierr)
#elif defined(COARRAY)
        sync all
#endif

    end subroutine

    integer function this_image2()
        !! Alternative to this_image() which uses mpi directly if COARRAY_USE_MPI_FOR_INTENSIVE_COMMS is defined
        integer :: ierr
#if defined(COARRAY_USE_MPI_FOR_INTENSIVE_COMMS)
        call mpi_comm_rank(MPI_COMM_WORLD, this_image2, ierr)
        this_image2 = this_image2 + 1
#elif defined(COARRAY)
        this_image2 = this_image()
#else
        this_image2 = 1
#endif
    end function

    integer function num_images2()
        !! Alternative to num_images() which uses mpi directly if COARRAY_USE_MPI_FOR_INTENSIVE_COMMS is defined
        integer :: ierr
#if defined(COARRAY_USE_MPI_FOR_INTENSIVE_COMMS)
        call mpi_comm_size(MPI_COMM_WORLD, num_images2, ierr)
#elif defined(COARRAY)
        num_images2 = num_images()
#else
        num_images2 = 1
#endif
    end function

    subroutine swals_mpi_init()
        !! Calls mpi_init(ierr) if COARRAY_USE_MPI_FOR_INTENSIVE_COMMS is defined, and mpi is not initialised. Otherwise do nothing
        integer :: ierr
        logical :: flag
#if defined(COARRAY_USE_MPI_FOR_INTENSIVE_COMMS)
        call mpi_initialized(flag, ierr)
        if(.not. flag) call mpi_init(ierr)
#endif
    end subroutine

    subroutine swals_mpi_finalize()
        !! Calls mpi_finalize(ierr) if COARRAY_USE_MPI_FOR_INTENSIVE_COMMS is defined. Otherwise do nothing
        integer :: ierr
        logical :: flag
#if defined(COARRAY_USE_MPI_FOR_INTENSIVE_COMMS)
        call mpi_finalized(flag, ierr)
        if (.not. flag) call mpi_finalize(ierr)
#endif
    end subroutine

end module

max_stars_repo_name: KayaGeoAus/ptha

max_issues_repo_name: KayaGeoAus/ptha

max_forks_repo_name: KayaGeoAus/ptha


text:
!------------------------------------------------------------------------!
!  The Community Multiscale Air Quality (CMAQ) system software is in     !
!  continuous development by various groups and is based on information  !
!  from these groups: Federal Government employees, contractors working  !
!  within a United States Government contract, and non-Federal sources   !
!  including research institutions.  These groups give the Government    !
!  permission to use, prepare derivative works of, and distribute copies !
!  of their work in the CMAQ system to the public and to permit others   !
!  to do so.  The United States Environmental Protection Agency          !
!  therefore grants similar permission to use the CMAQ system software,  !
!  but users are requested to provide copies of derivative works or      !
!  products designed to operate in the CMAQ system to the United States  !
!  Government without restrictions as to use by others.  Software        !
!  that is used with the CMAQ system but distributed under the GNU       !
!  General Public License or the GNU Lesser General Public License is    !
!  subject to their copyright restrictions.                              !
!------------------------------------------------------------------------!

      INTEGER FUNCTION INDEXN ( NAME1, N, NAME2, INDICES )

C***********************************************************************
C
C  FUNCTION:
C
C    This routine searches for all occurrences of NAME1 in list NAME2
C
C  REVISION HISTORY:
C
C    5/88   Modified for ROMNET
C
C  ARGUMENT LIST DESCRIPTION:
C
C    Input arguments:
C
C      NAME1       Character string being searched for
C      N           Length of array to be searched
C      NAME2       Character array to be searched
C      INDICES     Index array of all occurrences
C
C    Output arguments:
C
C      INDEXN      The number of occurrences of NAME1 within the NAME2
C                  array.  If string was not found, INDEXN = 0
C
C  LOCAL VARIABLE DESCRIPTION:
C
C      None
C
C***********************************************************************

      IMPLICIT NONE

      INTEGER     N
      INTEGER     I
      INTEGER     INDICES(*)

      CHARACTER*(*) NAME1
      CHARACTER*(*) NAME2(*)

C...Assume NAME1 is not in list NAME2

      INDEXN = 0

      DO I = 1, N

        IF ( INDEX( NAME2( I ), NAME1 ) .GT. 0 ) THEN
          INDEXN = INDEXN + 1
          INDICES( INDEXN ) = I
        END IF

      END DO

      RETURN
      END

max_stars_repo_name: Simeng-unique/CMAQ-changed

max_issues_repo_name: Simeng-unique/CMAQ-changed

max_forks_repo_name: Simeng-unique/CMAQ-changed


text:
subroutine clawpack46_rptt3(ixyz,icoor,imp,impt,maxm,meqn,mwaves,&
    maux,mbc,mx,ql,qr,aux1,aux2,aux3,bsasdq,cmbsasdq,cpbsasdq)
    ! Riemann solver in the transverse direction for the
    ! advection equations.
    !
    ! On input,
    !
    !    ql,qr is the data along some one-dimensional slice, as in rpn3
    !         This slice is
    !             in the x-direction if ixyz=1,
    !             in the y-direction if ixyz=2, or
    !             in the z-direction if ixyz=3.
    !
    !    bsasdq is an array of flux differences that result from a
    !         transverse splitting (a previous call to rpt3).
    !         This stands for B^* A^* \Dq but could represent any of
    !         6 possibilities, e.g.  C^* B^* \Dq, as specified by ixyz
    !         and icoor (see below).
    !         Moreover, each * represents either + or -, as specified by
    !         imp and impt.
    !
    !    ixyz indicates the direction of the original Riemann solve,
    !         called the x-like direction in the table below:
    !
    !               x-like direction   y-like direction   z-like direction
    !      ixyz=1:        x                  y                  z
    !      ixyz=2:        y                  z                  x
    !      ixyz=3:        z                  x                  y
    !
    !    icoor indicates direction in which the transverse solve should
    !         be performed.
    !      icoor=2: split in the y-like direction.
    !      icoor=3: split in the z-like direction.
    !
    !    For example,
    !        ixyz=1, icoor=3 means bsasdq=B^*A^*\Dq, and should be
    !                        split in z into
    !                           cmbsasdq = C^-B^*A^*\Dq,
    !                           cpbsasdq = C^+B^*A^*\Dq.
    !
    !        ixyz=2, icoor=3 means bsasdq=C^*B^*\Dq, and should be
    !                        split in x into
    !                           cmbsasdq = A^-C^*B^*\Dq,
    !                           cpbsasdq = A^+C^*B^*\Dq.
    !
    !    The parameters imp and impt are generally needed only if aux
    !    arrays are being used, in order to access the appropriate
    !    variable coefficients:
    !
    !    imp =  1 if bsasdq = B^*A^- \Dq, a left-going flux difference
    !           2 if bsasdq = B^*A^+ \Dq, a right-going flux difference
    !    impt = 1 if bsasdq = B^-A^* \Dq, a down-going flux difference
    !           2 if bsasdq = B^+A^* \Dq, an up-going flux difference
    !
    !    aux2(:,:,2) is a 1d slice of the aux array along the row
    !                 where the data ql, qr lie.
    !    aux1(:,:,2) and aux3(:,:,2) are neighboring rows in the
    !                 y-like direction
    !    aux2(:,:,1) and aux2(:,:,3) are neighboring rows in the
    !                z-like direction

    implicit none

    integer, intent(in) :: ixyz, icoor, maxm, meqn, mwaves, mbc, mx, maux, imp, impt
    double precision, intent(in) :: ql, qr, bsasdq, aux1, aux2, aux3
    double precision, intent(out) :: cmbsasdq, cpbsasdq

    dimension       ql(meqn,1-mbc:maxm+mbc)
    dimension       qr(meqn,1-mbc:maxm+mbc)
    dimension   bsasdq(meqn,1-mbc:maxm+mbc)
    dimension cmbsasdq(meqn,1-mbc:maxm+mbc)
    dimension cpbsasdq(meqn,1-mbc:maxm+mbc)
    dimension     aux1(maux,1-mbc:maxm+mbc,3)
    dimension     aux2(maux,1-mbc:maxm+mbc,3)
    dimension     aux3(maux,1-mbc:maxm+mbc,3)

    integer :: i, i1, iuvw

    ! set iuvw = 1 for u, 2 for v, 3 for w component of velocity
    ! depending on transverse direction:
    iuvw = ixyz + icoor - 1
    if (iuvw.gt.3) iuvw = iuvw-3

    do i=2-mbc,mx+mbc
        i1 = i-2+imp    !#  =  i-1 for amdq,  i for apdq
        if (icoor == 2) then
            !! double-transverse dir. is the y-like direction
            if (impt == 1) then
                cmbsasdq(1,i) = dmin1(aux2(iuvw,i1,1),0.d0)*bsasdq(1,i)
                cpbsasdq(1,i) = dmax1(aux3(iuvw,i1,1),0.d0)*bsasdq(1,i)
            elseif (impt == 2) then
                cmbsasdq(1,i) = dmin1(aux2(iuvw,i1,3),0.d0)*bsasdq(1,i)
                cpbsasdq(1,i) = dmax1(aux3(iuvw,i1,3),0.d0)*bsasdq(1,i)
            endif
        else
            !! double-transverse dir. is the z-like direction
            if (impt == 1) then
                !! bmasdq is split into cmbmasdq and cpbmasdq
                cmbsasdq(1,i) = dmin1(aux1(iuvw,i1,2),0.d0)*bsasdq(1,i)
                cpbsasdq(1,i) = dmax1(aux1(iuvw,i1,3),0.d0)*bsasdq(1,i)
            elseif (impt == 2) then
                !! bpasdq is split into cmbpasdq and cpbpasdq
                cmbsasdq(1,i) = dmin1(aux3(iuvw,i1,2),0.d0)*bsasdq(1,i)
                cpbsasdq(1,i) = dmax1(aux3(iuvw,i1,3),0.d0)*bsasdq(1,i)
            endif
        endif
    end do

    return
end subroutine clawpack46_rptt3

max_stars_repo_name: ECLAIRWaveS/ForestClaw

max_issues_repo_name: ECLAIRWaveS/ForestClaw

max_forks_repo_name: ECLAIRWaveS/ForestClaw


! PR fortran/45636
! { dg-do compile }
! { dg-options "-O2 -fdump-tree-forwprop2" }
! PR 45636 - make sure no memset is needed for a short right-hand side.
program main
  character(len=2), parameter :: x='a '
  character(len=1), parameter :: y='b'
  character(len=4) :: a, b
  a = x
  b = y
  call sub(a, b)
end program main
! This test will fail on targets which prefer memcpy/memset over
! move_by_pieces/store_by_pieces.
! { dg-final { scan-tree-dump-times "memset" 0 "forwprop2" { xfail { { hppa*-*-* && { ! lp64 } } || { mips*-*-* && { ! nomips16 } } } } } }


text:
Davis Municipal Code Davis Municipal Code/27 Chapter 27
 PARKS AND OPEN SPACE AREAS
 27.03.100 Fires, smoking and fireworks.

No person using a city open space area shall make or kindle a fire for any purpose except at places provided for such purpose, and/or if granted a special permit by the director, to do so.

Smoking is prohibited in any city open space area. Fireworks are prohibited in any city open space areas. (Ord. No. 1877, § 1 (part).)


text:
!  OpenACC Runtime Library Definitions.

!  Copyright (C) 2014-2018 Free Software Foundation, Inc.

!  Contributed by Tobias Burnus <burnus@net-b.de>
!              and Mentor Embedded.

!  This file is part of the GNU Offloading and Multi Processing Library
!  (libgomp).

!  Libgomp is free software; you can redistribute it and/or modify it
!  under the terms of the GNU General Public License as published by
!  the Free Software Foundation; either version 3, or (at your option)
!  any later version.

!  Libgomp is distributed in the hope that it will be useful, but WITHOUT ANY
!  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
!  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
!  more details.

!  Under Section 7 of GPL version 3, you are granted additional
!  permissions described in the GCC Runtime Library Exception, version
!  3.1, as published by the Free Software Foundation.

!  You should have received a copy of the GNU General Public License and
!  a copy of the GCC Runtime Library Exception along with this program;
!  see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
!  <http://www.gnu.org/licenses/>.

module openacc_kinds
  use iso_fortran_env, only: int32
  implicit none

  private :: int32
  public :: acc_device_kind

  integer, parameter :: acc_device_kind = int32

  public :: acc_device_none, acc_device_default, acc_device_host
  public :: acc_device_not_host, acc_device_nvidia

  ! Keep in sync with include/gomp-constants.h.
  integer (acc_device_kind), parameter :: acc_device_none = 0
  integer (acc_device_kind), parameter :: acc_device_default = 1
  integer (acc_device_kind), parameter :: acc_device_host = 2
  ! integer (acc_device_kind), parameter :: acc_device_host_nonshm = 3 removed.
  integer (acc_device_kind), parameter :: acc_device_not_host = 4
  integer (acc_device_kind), parameter :: acc_device_nvidia = 5

  public :: acc_handle_kind

  integer, parameter :: acc_handle_kind = int32

  public :: acc_async_noval, acc_async_sync

  ! Keep in sync with include/gomp-constants.h.
  integer (acc_handle_kind), parameter :: acc_async_noval = -1
  integer (acc_handle_kind), parameter :: acc_async_sync = -2

end module

module openacc_internal
  use openacc_kinds
  implicit none

  interface
    function acc_get_num_devices_h (d)
      import
      integer acc_get_num_devices_h
      integer (acc_device_kind) d
    end function

    subroutine acc_set_device_type_h (d)
      import
      integer (acc_device_kind) d
    end subroutine

    function acc_get_device_type_h ()
      import
      integer (acc_device_kind) acc_get_device_type_h
    end function

    subroutine acc_set_device_num_h (n, d)
      import
      integer n
      integer (acc_device_kind) d
    end subroutine

    function acc_get_device_num_h (d)
      import
      integer acc_get_device_num_h
      integer (acc_device_kind) d
    end function

    function acc_async_test_h (a)
      logical acc_async_test_h
      integer a
    end function

    function acc_async_test_all_h ()
      logical acc_async_test_all_h
    end function

    subroutine acc_wait_h (a)
      integer a
    end subroutine

    subroutine acc_wait_async_h (a1, a2)
      integer a1, a2
    end subroutine

    subroutine acc_wait_all_h ()
    end subroutine

    subroutine acc_wait_all_async_h (a)
      integer a
    end subroutine

    subroutine acc_init_h (d)
      import
      integer (acc_device_kind) d
    end subroutine

    subroutine acc_shutdown_h (d)
      import
      integer (acc_device_kind) d
    end subroutine

    function acc_on_device_h (d)
      import
      integer (acc_device_kind) d
      logical acc_on_device_h
    end function

    subroutine acc_copyin_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_copyin_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_copyin_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_present_or_copyin_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_present_or_copyin_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_present_or_copyin_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_create_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_create_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_create_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_present_or_create_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_present_or_create_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_present_or_create_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_copyout_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_copyout_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_copyout_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_delete_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_delete_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_delete_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_update_device_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_update_device_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_update_device_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    subroutine acc_update_self_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end subroutine

    subroutine acc_update_self_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end subroutine

    subroutine acc_update_self_array_h (a)
      type (*), dimension (..), contiguous :: a
    end subroutine

    function acc_is_present_32_h (a, len)
      use iso_c_binding, only: c_int32_t
      logical acc_is_present_32_h
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int32_t) len
    end function

    function acc_is_present_64_h (a, len)
      use iso_c_binding, only: c_int64_t
      logical acc_is_present_64_h
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_int64_t) len
    end function

    function acc_is_present_array_h (a)
      logical acc_is_present_array_h
      type (*), dimension (..), contiguous :: a
    end function
  end interface

  interface
    function acc_get_num_devices_l (d) &
        bind (C, name = "acc_get_num_devices")
      use iso_c_binding, only: c_int
      integer (c_int) :: acc_get_num_devices_l
      integer (c_int), value :: d
    end function

    subroutine acc_set_device_type_l (d) &
        bind (C, name = "acc_set_device_type")
      use iso_c_binding, only: c_int
      integer (c_int), value :: d
    end subroutine

    function acc_get_device_type_l () &
        bind (C, name = "acc_get_device_type")
      use iso_c_binding, only: c_int
      integer (c_int) :: acc_get_device_type_l
    end function

    subroutine acc_set_device_num_l (n, d) &
        bind (C, name = "acc_set_device_num")
      use iso_c_binding, only: c_int
      integer (c_int), value :: n, d
    end subroutine

    function acc_get_device_num_l (d) &
        bind (C, name = "acc_get_device_num")
      use iso_c_binding, only: c_int
      integer (c_int) :: acc_get_device_num_l
      integer (c_int), value :: d
    end function

    function acc_async_test_l (a) &
        bind (C, name = "acc_async_test")
      use iso_c_binding, only: c_int
      integer (c_int) :: acc_async_test_l
      integer (c_int), value :: a
    end function

    function acc_async_test_all_l () &
        bind (C, name = "acc_async_test_all")
      use iso_c_binding, only: c_int
      integer (c_int) :: acc_async_test_all_l
    end function

    subroutine acc_wait_l (a) &
        bind (C, name = "acc_wait")
      use iso_c_binding, only: c_int
      integer (c_int), value :: a
    end subroutine

    subroutine acc_wait_async_l (a1, a2) &
        bind (C, name = "acc_wait_async")
      use iso_c_binding, only: c_int
      integer (c_int), value :: a1, a2
    end subroutine

    subroutine acc_wait_all_l () &
        bind (C, name = "acc_wait_all")
      use iso_c_binding, only: c_int
    end subroutine

    subroutine acc_wait_all_async_l (a) &
        bind (C, name = "acc_wait_all_async")
      use iso_c_binding, only: c_int
      integer (c_int), value :: a
    end subroutine

    subroutine acc_init_l (d) &
        bind (C, name = "acc_init")
      use iso_c_binding, only: c_int
      integer (c_int), value :: d
    end subroutine

    subroutine acc_shutdown_l (d) &
        bind (C, name = "acc_shutdown")
      use iso_c_binding, only: c_int
      integer (c_int), value :: d
    end subroutine

    function acc_on_device_l (d) &
        bind (C, name = "acc_on_device")
      use iso_c_binding, only: c_int
      integer (c_int) :: acc_on_device_l
      integer (c_int), value :: d
    end function

    subroutine acc_copyin_l (a, len) &
        bind (C, name = "acc_copyin")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_present_or_copyin_l (a, len) &
        bind (C, name = "acc_present_or_copyin")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_create_l (a, len) &
        bind (C, name = "acc_create")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_present_or_create_l (a, len) &
        bind (C, name = "acc_present_or_create")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_copyout_l (a, len) &
        bind (C, name = "acc_copyout")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_delete_l (a, len) &
        bind (C, name = "acc_delete")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_update_device_l (a, len) &
        bind (C, name = "acc_update_device")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    subroutine acc_update_self_l (a, len) &
        bind (C, name = "acc_update_self")
      use iso_c_binding, only: c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end subroutine

    function acc_is_present_l (a, len) &
        bind (C, name = "acc_is_present")
      use iso_c_binding, only: c_int32_t, c_size_t
      !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
      integer (c_int32_t) :: acc_is_present_l
      type (*), dimension (*) :: a
      integer (c_size_t), value :: len
    end function
  end interface
end module

module openacc
  use openacc_kinds
  use openacc_internal
  implicit none

  public :: openacc_version

  public :: acc_get_num_devices, acc_set_device_type, acc_get_device_type
  public :: acc_set_device_num, acc_get_device_num, acc_async_test
  public :: acc_async_test_all
  public :: acc_wait, acc_async_wait, acc_wait_async
  public :: acc_wait_all, acc_async_wait_all, acc_wait_all_async
  public :: acc_init, acc_shutdown, acc_on_device
  public :: acc_copyin, acc_present_or_copyin, acc_pcopyin, acc_create
  public :: acc_present_or_create, acc_pcreate, acc_copyout, acc_delete
  public :: acc_update_device, acc_update_self, acc_is_present

  integer, parameter :: openacc_version = 201306

  interface acc_get_num_devices
    procedure :: acc_get_num_devices_h
  end interface

  interface acc_set_device_type
    procedure :: acc_set_device_type_h
  end interface

  interface acc_get_device_type
    procedure :: acc_get_device_type_h
  end interface

  interface acc_set_device_num
    procedure :: acc_set_device_num_h
  end interface

  interface acc_get_device_num
    procedure :: acc_get_device_num_h
  end interface

  interface acc_async_test
    procedure :: acc_async_test_h
  end interface

  interface acc_async_test_all
    procedure :: acc_async_test_all_h
  end interface

  interface acc_wait
    procedure :: acc_wait_h
  end interface

  ! acc_async_wait is an OpenACC 1.0 compatibility name for acc_wait.
  interface acc_async_wait
    procedure :: acc_wait_h
  end interface

  interface acc_wait_async
    procedure :: acc_wait_async_h
  end interface

  interface acc_wait_all
    procedure :: acc_wait_all_h
  end interface

  ! acc_async_wait_all is an OpenACC 1.0 compatibility name for acc_wait_all.
  interface acc_async_wait_all
    procedure :: acc_wait_all_h
  end interface

  interface acc_wait_all_async
    procedure :: acc_wait_all_async_h
  end interface

  interface acc_init
    procedure :: acc_init_h
  end interface

  interface acc_shutdown
    procedure :: acc_shutdown_h
  end interface

  interface acc_on_device
    procedure :: acc_on_device_h
  end interface

  ! acc_malloc: Only available in C/C++
  ! acc_free: Only available in C/C++

  ! As vendor extension, the following code supports both 32bit and 64bit
  ! arguments for "size"; the OpenACC standard only permits default-kind
  ! integers, which are of kind 4 (i.e. 32 bits).
  ! Additionally, the two-argument version also takes arrays as argument.
  ! and the one argument version also scalars. Note that the code assumes
  ! that the arrays are contiguous.

  interface acc_copyin
    procedure :: acc_copyin_32_h
    procedure :: acc_copyin_64_h
    procedure :: acc_copyin_array_h
  end interface

  interface acc_present_or_copyin
    procedure :: acc_present_or_copyin_32_h
    procedure :: acc_present_or_copyin_64_h
    procedure :: acc_present_or_copyin_array_h
  end interface

  interface acc_pcopyin
    procedure :: acc_present_or_copyin_32_h
    procedure :: acc_present_or_copyin_64_h
    procedure :: acc_present_or_copyin_array_h
  end interface

  interface acc_create
    procedure :: acc_create_32_h
    procedure :: acc_create_64_h
    procedure :: acc_create_array_h
  end interface

  interface acc_present_or_create
    procedure :: acc_present_or_create_32_h
    procedure :: acc_present_or_create_64_h
    procedure :: acc_present_or_create_array_h
  end interface

  interface acc_pcreate
    procedure :: acc_present_or_create_32_h
    procedure :: acc_present_or_create_64_h
    procedure :: acc_present_or_create_array_h
  end interface

  interface acc_copyout
    procedure :: acc_copyout_32_h
    procedure :: acc_copyout_64_h
    procedure :: acc_copyout_array_h
  end interface

  interface acc_delete
    procedure :: acc_delete_32_h
    procedure :: acc_delete_64_h
    procedure :: acc_delete_array_h
  end interface

  interface acc_update_device
    procedure :: acc_update_device_32_h
    procedure :: acc_update_device_64_h
    procedure :: acc_update_device_array_h
  end interface

  interface acc_update_self
    procedure :: acc_update_self_32_h
    procedure :: acc_update_self_64_h
    procedure :: acc_update_self_array_h
  end interface

  ! acc_map_data: Only available in C/C++
  ! acc_unmap_data: Only available in C/C++
  ! acc_deviceptr: Only available in C/C++
  ! acc_hostptr: Only available in C/C++

  interface acc_is_present
    procedure :: acc_is_present_32_h
    procedure :: acc_is_present_64_h
    procedure :: acc_is_present_array_h
  end interface

  ! acc_memcpy_to_device: Only available in C/C++
  ! acc_memcpy_from_device: Only available in C/C++

end module

function acc_get_num_devices_h (d)
  use openacc_internal, only: acc_get_num_devices_l
  use openacc_kinds
  integer acc_get_num_devices_h
  integer (acc_device_kind) d
  acc_get_num_devices_h = acc_get_num_devices_l (d)
end function

subroutine acc_set_device_type_h (d)
  use openacc_internal, only: acc_set_device_type_l
  use openacc_kinds
  integer (acc_device_kind) d
  call acc_set_device_type_l (d)
end subroutine

function acc_get_device_type_h ()
  use openacc_internal, only: acc_get_device_type_l
  use openacc_kinds
  integer (acc_device_kind) acc_get_device_type_h
  acc_get_device_type_h = acc_get_device_type_l ()
end function

subroutine acc_set_device_num_h (n, d)
  use openacc_internal, only: acc_set_device_num_l
  use openacc_kinds
  integer n
  integer (acc_device_kind) d
  call acc_set_device_num_l (n, d)
end subroutine

function acc_get_device_num_h (d)
  use openacc_internal, only: acc_get_device_num_l
  use openacc_kinds
  integer acc_get_device_num_h
  integer (acc_device_kind) d
  acc_get_device_num_h = acc_get_device_num_l (d)
end function

function acc_async_test_h (a)
  use openacc_internal, only: acc_async_test_l
  logical acc_async_test_h
  integer a
  if (acc_async_test_l (a) .eq. 1) then
    acc_async_test_h = .TRUE.
  else
    acc_async_test_h = .FALSE.
  end if
end function

function acc_async_test_all_h ()
  use openacc_internal, only: acc_async_test_all_l
  logical acc_async_test_all_h
  if (acc_async_test_all_l () .eq. 1) then
    acc_async_test_all_h = .TRUE.
  else
    acc_async_test_all_h = .FALSE.
  end if
end function

subroutine acc_wait_h (a)
  use openacc_internal, only: acc_wait_l
  integer a
  call acc_wait_l (a)
end subroutine

subroutine acc_wait_async_h (a1, a2)
  use openacc_internal, only: acc_wait_async_l
  integer a1, a2
  call acc_wait_async_l (a1, a2)
end subroutine

subroutine acc_wait_all_h ()
  use openacc_internal, only: acc_wait_all_l
  call acc_wait_all_l ()
end subroutine

subroutine acc_wait_all_async_h (a)
  use openacc_internal, only: acc_wait_all_async_l
  integer a
  call acc_wait_all_async_l (a)
end subroutine

subroutine acc_init_h (d)
  use openacc_internal, only: acc_init_l
  use openacc_kinds
  integer (acc_device_kind) d
  call acc_init_l (d)
end subroutine

subroutine acc_shutdown_h (d)
  use openacc_internal, only: acc_shutdown_l
  use openacc_kinds
  integer (acc_device_kind) d
  call acc_shutdown_l (d)
end subroutine

function acc_on_device_h (d)
  use openacc_internal, only: acc_on_device_l
  use openacc_kinds
  integer (acc_device_kind) d
  logical acc_on_device_h
  if (acc_on_device_l (d) .eq. 1) then
    acc_on_device_h = .TRUE.
  else
    acc_on_device_h = .FALSE.
  end if
end function

subroutine acc_copyin_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_copyin_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_copyin_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_copyin_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_copyin_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_copyin_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_copyin_array_h (a)
  use openacc_internal, only: acc_copyin_l
  type (*), dimension (..), contiguous :: a
  call acc_copyin_l (a, sizeof (a))
end subroutine

subroutine acc_present_or_copyin_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_present_or_copyin_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_present_or_copyin_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_present_or_copyin_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_present_or_copyin_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_present_or_copyin_array_h (a)
  use openacc_internal, only: acc_present_or_copyin_l
  type (*), dimension (..), contiguous :: a
  call acc_present_or_copyin_l (a, sizeof (a))
end subroutine

subroutine acc_create_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_create_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_create_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_create_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_create_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_create_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_create_array_h (a)
  use openacc_internal, only: acc_create_l
  type (*), dimension (..), contiguous :: a
  call acc_create_l (a, sizeof (a))
end subroutine

subroutine acc_present_or_create_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_present_or_create_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_present_or_create_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_present_or_create_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_present_or_create_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_present_or_create_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_present_or_create_array_h (a)
  use openacc_internal, only: acc_present_or_create_l
  type (*), dimension (..), contiguous :: a
  call acc_present_or_create_l (a, sizeof (a))
end subroutine

subroutine acc_copyout_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_copyout_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_copyout_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_copyout_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_copyout_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_copyout_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_copyout_array_h (a)
  use openacc_internal, only: acc_copyout_l
  type (*), dimension (..), contiguous :: a
  call acc_copyout_l (a, sizeof (a))
end subroutine

subroutine acc_delete_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_delete_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_delete_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_delete_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_delete_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_delete_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_delete_array_h (a)
  use openacc_internal, only: acc_delete_l
  type (*), dimension (..), contiguous :: a
  call acc_delete_l (a, sizeof (a))
end subroutine

subroutine acc_update_device_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_update_device_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_update_device_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_update_device_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_update_device_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_update_device_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_update_device_array_h (a)
  use openacc_internal, only: acc_update_device_l
  type (*), dimension (..), contiguous :: a
  call acc_update_device_l (a, sizeof (a))
end subroutine

subroutine acc_update_self_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_update_self_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  call acc_update_self_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_update_self_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_update_self_l
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  call acc_update_self_l (a, int (len, kind = c_size_t))
end subroutine

subroutine acc_update_self_array_h (a)
  use openacc_internal, only: acc_update_self_l
  type (*), dimension (..), contiguous :: a
  call acc_update_self_l (a, sizeof (a))
end subroutine

function acc_is_present_32_h (a, len)
  use iso_c_binding, only: c_int32_t, c_size_t
  use openacc_internal, only: acc_is_present_l
  logical acc_is_present_32_h
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int32_t) len
  if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
    acc_is_present_32_h = .TRUE.
  else
    acc_is_present_32_h = .FALSE.
  end if
end function

function acc_is_present_64_h (a, len)
  use iso_c_binding, only: c_int64_t, c_size_t
  use openacc_internal, only: acc_is_present_l
  logical acc_is_present_64_h
  !GCC$ ATTRIBUTES NO_ARG_CHECK :: a
  type (*), dimension (*) :: a
  integer (c_int64_t) len
  if (acc_is_present_l (a, int (len, kind = c_size_t)) .eq. 1) then
    acc_is_present_64_h = .TRUE.
  else
    acc_is_present_64_h = .FALSE.
  end if
end function

function acc_is_present_array_h (a)
  use openacc_internal, only: acc_is_present_l
  logical acc_is_present_array_h
  type (*), dimension (..), contiguous :: a
  acc_is_present_array_h = acc_is_present_l (a, sizeof (a)) == 1
end function

max_stars_repo_name: Lovely-Qianyun/Qt-IDE

max_issues_repo_name: Lovely-Qianyun/Qt-IDE

max_forks_repo_name: Lovely-Qianyun/Qt-IDE


text:
\ number.f      - pictured number output words
\ ------------------------------------------------------------------------

  .( loading number.f ) cr

\ ------------------------------------------------------------------------

  0 var hld                 \ points to place to construct number

\ ------------------------------------------------------------------------
\ initiate pictured number construction

: <#            ( --- )
  pad !> hld ;              \ point hold at pad

\ ------------------------------------------------------------------------
\ store one digit/char of number, decrement pointer

: hold      ( c1 --- )
  decr> hld                 \ decrement pointer to pad area
  hld c! ;                  \ store char c1 at address pointed to by hld

\  -------------------------------------------------------------------------
\  hold a '-' if number is negative

: sign          ( n1 --- )
  0< not ?exit
  '-' hold ;

\ ------------------------------------------------------------------------
\ add one digit in current radix to number string

: #         ( d1 --- d2 )
  base mu/mod rot           \ divide number d1 by current radix.
  dup 9 > 7 and +           \ adjust remainder if above 9, add 7
  '0' + hold ;              \ convert to printable character and add it

\ -------------------------------------------------------------------------
\ convert rest of number n1 in current base

: #s            ( d1 --- 0 0 )
  begin
    #                       \ convert next digit
    2dup or 0=              \ anything left to convert ?
  until ;                   \ if so, keep going

\ ------------------------------------------------------------------------
\ complete conversion of number to a string

: #>        ( d1 --- a1 n1 )
  2drop                     \ clean up
  hld pad over - ;          \ return anddress and length of new string

\ ------------------------------------------------------------------------
\ convert a double number to string

: (d.)      ( d1 --- a1 n1 )
  tuck dabs                 \ retain sign, make positive
  <# #s rot sign #> ;       \ convert number, add possible neg sign

\ ------------------------------------------------------------------------
\ display string representation of double number d1 in current radix

: d.        ( d1 --- )
  (d.) type space ;

\ ------------------------------------------------------------------------
\ display right justified number

: d.r       ( d1 n1 --- )
  >r (d.)
  r> over - spaces
  type ;

\ ------------------------------------------------------------------------
\ convert a single to a double ( these dot words work on doubles only )

: .         ( n1 --- )
  s>d d. ;

\ ------------------------------------------------------------------------
\ display right justified single

: .r        ( n1 n2 --- )
  >r s>d r>
  d.r ;

\ ------------------------------------------------------------------------
\ display unsigned single

: u.        ( u1 --- )
  0 d. ;

\ ------------------------------------------------------------------------
\ display right justified unsigned single

: u.r       ( u1 --- )
  0 swap d.r ;

\ ------------------------------------------------------------------------

: radix         ( n1 --- )  !> base ;

\ ------------------------------------------------------------------------
\ forth can use almost any damned base it wants to

: hex           ( --- )  16 radix ;
: decimal       ( --- )  10 radix ;
: binary        ( --- )   2 radix ;
: octal         ( --- )   8 radix ;

\ ========================================================================


! Begin MIT license text.
! _______________________________________________________________________________________________________

! Copyright 2019 Dr William R Case, Jr (dbcase29@gmail.com)

! 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 and documentation.

! 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.
! _______________________________________________________________________________________________________

! End MIT license text.

      MODULE LINK0_USE_IFs

! USE Interface statements for all subroutines called by SUBROUTINE LINK0

      USE TIME_INIT_Interface
      USE OURDAT_Interface
      USE OURTIM_Interface
      USE LOADC0_Interface
      USE LOADB0_Interface
      USE ALLOCATE_IN4_FILES_Interface
      USE LOADE_Interface
      USE ALLOCATE_NL_PARAMS_Interface
      USE SET_FILE_CLOSE_STAT_Interface
      USE ALLOCATE_MODEL_STUF_Interface
      USE LOADC_Interface
      USE READ_L1Z_Interface
      USE LINK1_RESTART_DATA_Interface
      USE LOADB_RESTART_Interface
      USE SET_SPARSE_MAT_SYM_Interface
      USE PRINT_CONSTANTS_1_Interface
      USE GET_MACHINE_PARAMS_Interface
      USE PRINT_ORDER_Interface
      USE FILE_OPEN_Interface
      USE LOADB_Interface
      USE DEALLOCATE_MODEL_STUF_Interface
      USE WRITE_EDAT_Interface
      USE OUTA_HERE_Interface
      USE WRITE_ENF_TO_L1O_Interface
      USE FILE_CLOSE_Interface
      USE ELESORT_Interface
      USE ELEM_PROP_MATL_IIDS_Interface
      USE GRID_PROC_Interface
      USE GET_ELEM_AGRID_BGRID_Interface
      USE SEQ_PROC_Interface
      USE SUBCASE_PROC_Interface
      USE GRID_ELEM_CONN_TABLE_Interface
      USE CORD_PROC_Interface
      USE WRITE_GRID_COORDS_Interface
      USE ALLOCATE_DOF_TABLES_Interface
      USE READ_DOF_TABLES_Interface
      USE CALC_TDOF_ROW_START_Interface
      USE WRITE_TSET_Interface
      USE WRITE_TDOF_Interface
      USE EMG_Interface
      USE DOF_PROC_Interface
      USE WRITE_USETSTR_Interface
      USE CONM2_PROC_1_Interface
      USE ALLOCATE_RBGLOBAL_Interface
      USE GPWG_USERIN_Interface
      USE GPWG_Interface
      USE ALLOCATE_SPARSE_MAT_Interface
      USE READ_MATRIX_1_Interface
      USE PRT_MATS_ON_RESTART_Interface
      USE DEALLOCATE_SPARSE_MAT_Interface
      USE RB_DISP_MATRIX_PROC_Interface
      USE GET_MATRIX_DIAG_STATS_Interface
      USE STIFF_MAT_EQUIL_CHK_Interface
      USE CONM2_PROC_2_Interface
      USE TEMPERATURE_DATA_PROC_Interface
      USE PRESSURE_DATA_PROC_Interface
      USE TDOF_COL_NUM_Interface
      USE ALLOCATE_COL_VEC_Interface
      USE YS_ARRAY_Interface
      USE DEALLOCATE_COL_VEC_Interface
      USE WRITE_L1Z_Interface
      USE OUTPUT4_MATRIX_MSGS_Interface
      USE WRITE_L1A_Interface
      USE CHK_ARRAY_ALLOC_STAT_Interface
      USE WRITE_ALLOC_MEM_TABLE_Interface
      USE FILE_INQUIRE_Interface
      USE WRITE_FIJFIL_Interface

      END MODULE LINK0_USE_IFs


text:
The Buzz is a relatively new annual parties party event at UC Davis campus, beginning around 2005. Featuring free entertainment, games, food, and fun, its presented on the first Friday night of the academic year.  It generally features music scene live bands, such as indypop artists http://www.myspace.com/thecataracs the Cataracs and rapper http://www.myspace.com/shawnchrystopher Shawn Chrystopher (2010), http://www.myspace.com/unimuzik UNI (2009), http://www.myspace.com/naturalroots Natural Roots (2009), Double Funk Crunch (2008), or  Suburban Legends (2007). The free event also features inflatable games, performance competitions, carnival games, and information booths.

The Buzz is similar in concept to the nowdefunct Turbulence, which had attempted to be an oncampus concert and game night aimed mostly at freshmen, although its open to all UC Davis affiliates as well as community members. It began the same year that the Turbulence program had been canceled. The Buzz, however, is presented by ASUCD Entertainment Council, Campus Unions, Campus Recreation and Student Housing, and has been more successful with a turnout of more than 12,000 in 2009.

The 2011 Buzz will be held on Friday, September 23, from 6 p.m. until 10 p.m. on the East Quad and West Quad.

For more information and updates about the Buzz event, you can follow the http://www.facebook.com/ucdavis.thebuzz The Buzz on facebook

 External links
  http://theaggie.org/article/1317 Breakdancers battle at The Buzz, California Aggie, September 25, 2008
  http://www.youtube.com/watch?veFvNRPPueqc YouTube video of 2007 Buzz
  http://thebuzz.ucdavis.edu/ UC Davis Buzz Website

Anybody care to add some photos of the event?

20090424 13:53:20 nbsp Ive heard there will be a UCD Idol or some other talent show competition for this event. Anyone else heard anything? Users/MattSmidebush


text:
      SUBROUTINE split(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS)
C
C     THIS SUBROUTINE SPLITS OUTPUT FOR C, N, P, WATER AND HEAT
C     FROM OUTPUT FILES FOR THE ENTIRE LANDSCAPE WRITTEN DURING
C     EACH SCENE OF THE MODEL RUN INTO INDIVIDUAL FILES FOR EACH
C     GRID CELL AT THE END OF THE SCENE WITH FILE NAME PREFIXES
C     INDICATING ITS COLUMN AND ROW POSITION.
C
      include "parameters.h"
      include "filec.h"
      include "files.h"
      include "blkc.h"
      CHARACTER*16 DATA(30),DATAC(30,250,250),DATAP(JP,JY,JX)
     2,DATAM(JP,JY,JX),DATAX(JP),DATAY(JP),DATAZ(JP,JY,JX)
     3,OUTS(10),OUTP(10),OUTFILS(10,JY,JX),OUTFILP(10,JP,JY,JX)
      CHARACTER*3 CHOICE(102,20)
      CHARACTER*8 CDATE
      CHARACTER*8 CDOY,DATE,HOUR
      CHARACTER*16 CHEAD
      CHARACTER*16 OUTFILE
      CHARACTER*16 HEAD(50)
      DIMENSION HEAX(50)
      DO 9995 NX=NHW,NHE
      DO 9990 NY=NVN,NVS
      DO 1010 N=21,25
      IF(DATAC(N,NE,NEX).NE.'NO')THEN
      LUN=N+10
      LUX=N+30
      REWIND(LUN)
C      OPEN(LUX,FILE=OUTFILS(N-20,NY,NX),STATUS='UNKNOWN')
      OPEN(LUX,FILE=trim(outdir)//OUTFILS(N-20,NY,NX),STATUS='UNKNOWN')
      READ(LUN,'(A12,2A8,50A16)')CDOY,DATE,HOUR
     2,(HEAD(K),K=1,NOUTS(N-20))
      WRITE(LUX,'(A12,2A8,50A16)')CDOY,DATE,HOUR
     2,(HEAD(K),K=1,NOUTS(N-20))
1000  READ(LUN,'(A16,F8.3,4X,A8,I8,50E16.8)',END=1005)OUTFILE
     2,DOY,CDATE,J,(HEAX(K),K=1,NOUTS(N-20))
      IF(OUTFILE.EQ.OUTFILS(N-20,NY,NX))THEN
      WRITE(LUX,'(F8.3,4X,A8,I8,50E16.8)')
     2DOY,CDATE,J,(HEAX(K),K=1,NOUTS(N-20))
      ENDIF
      GO TO 1000
1005  CLOSE(LUX)
C     CLOSE(LUN)
      ENDIF
1010  CONTINUE
      DO 1110 N=26,30
      IF(DATAC(N,NE,NEX).NE.'NO')THEN
      LUN=N+10
      LUX=N+30
      REWIND(LUN)
C      OPEN(LUX,FILE=OUTFILS(N-20,NY,NX),STATUS='UNKNOWN')
      OPEN(LUX,FILE=trim(outdir)//OUTFILS(N-20,NY,NX),STATUS='UNKNOWN')
      READ(LUN,'(A12,A8,50A16)')CDOY,DATE,(HEAD(K),K=1,NOUTS(N-20))
      WRITE(LUX,'(A12,A8,50A16)')CDOY,DATE,(HEAD(K),K=1,NOUTS(N-20))
1100  READ(LUN,'(A16,F8.3,4X,A8,50E16.8)',END=1105)OUTFILE
     2,DOY,CDATE,(HEAX(K),K=1,NOUTS(N-20))
      IF(OUTFILE.EQ.OUTFILS(N-20,NY,NX))THEN
      WRITE(LUX,'(F8.3,4X,A8,50E16.8)')
     2DOY,CDATE,(HEAX(K),K=1,NOUTS(N-20))
      ENDIF
      GO TO 1100
1105  CLOSE(LUX)
C     CLOSE(LUN)
      ENDIF
1110  CONTINUE
      DO 9985 NZ=1,NP0(NY,NX)
      DO 1210 N=21,25
      IF(DATAC(N,NE,NEX).NE.'NO')THEN
      LUN=N+20
      LUX=N+40
      REWIND(LUN)
C      OPEN(LUX,FILE=OUTFILP(N-20,NZ,NY,NX),STATUS='UNKNOWN')
      OPEN(LUX,FILE=trim(outdir)//OUTFILP(N-20,NZ,NY,NX)
     2,STATUS='UNKNOWN')
      READ(LUN,'(A12,2A8,50A16)')CDOY,DATE,HOUR
     2,(HEAD(K),K=1,NOUTP(N-20))
      WRITE(LUX,'(A12,2A8,50A16)')CDOY,DATE,HOUR
     2,(HEAD(K),K=1,NOUTP(N-20))
1200  READ(LUN,'(A16,F8.3,4X,A8,I8,50E16.8)',END=1205)OUTFILE
     2,DOY,CDATE,J,(HEAX(K),K=1,NOUTP(N-20))
      IF(OUTFILE.EQ.OUTFILP(N-20,NZ,NY,NX))THEN
      WRITE(LUX,'(F8.3,4X,A8,I8,50E16.8)')
     2DOY,CDATE,J,(HEAX(K),K=1,NOUTP(N-20))
      ENDIF
      GO TO 1200
1205  CLOSE(LUX)
C     CLOSE(LUN)
      ENDIF
1210  CONTINUE
      DO 1310 N=26,30
      IF(DATAC(N,NE,NEX).NE.'NO')THEN
      LUN=N+20
      LUX=N+40
      REWIND(LUN)
C      OPEN(LUX,FILE=OUTFILP(N-20,NZ,NY,NX),STATUS='UNKNOWN')
      OPEN(LUX,FILE=trim(outdir)//OUTFILP(N-20,NZ,NY,NX)
     2,STATUS='UNKNOWN')
      READ(LUN,'(A12,A8,50A16)')CDOY,DATE,(HEAD(K),K=1,NOUTP(N-20))
      WRITE(LUX,'(A12,A8,50A16)')CDOY,DATE,(HEAD(K),K=1,NOUTP(N-20))
      IF(N.LE.29)THEN
1300  READ(LUN,'(A16,F8.3,4X,A8,50E16.8)',END=1305)OUTFILE
     2,DOY,CDATE,(HEAX(K),K=1,NOUTP(N-20))
      IF(OUTFILE.EQ.OUTFILP(N-20,NZ,NY,NX))THEN
      WRITE(LUX,'(F8.3,4X,A8,50E16.8)')
     2DOY,CDATE,(HEAX(K),K=1,NOUTP(N-20))
      ENDIF
      GO TO 1300
      ELSE
1400  READ(LUN,'(A16,F8.3,4X,A8,A16,I16,50E16.8)',END=1305)OUTFILE
     2,DOY,CDATE,CHEAD,IHEAD,(HEAX(K),K=1,NOUTP(N-20))
      IF(OUTFILE.EQ.OUTFILP(N-20,NZ,NY,NX))THEN
      WRITE(LUX,'(F8.3,4X,A8,A16,I16,50E16.8)')
     2DOY,CDATE,CHEAD,IHEAD,(HEAX(K),K=1,NOUTP(N-20))
      ENDIF
      GO TO 1400
      ENDIF
1305  CLOSE(LUX)
C     CLOSE(LUN)
      ENDIF
1310  CONTINUE
9985  CONTINUE
9990  CONTINUE
9995  CONTINUE
      RETURN
      END

max_stars_repo_name: ThemosTsikas/ECOSYS

max_issues_repo_name: ThemosTsikas/ECOSYS

max_forks_repo_name: ThemosTsikas/ECOSYS


text:
PROGRAM pidosits

  !-------------------------------  PIDOSITS.3.3D  -----------------------------------
  !
  !  Parallel Integral Discrete Ordinates & Source Iteration Transport Solver
  !  By RJZerr, April 2010
  !
  !  Using DD equations, solves neutron transport with
  !   1. Integral Discrete Ordinates Approach from Azmy
  !   2. Source Iteration Approach
  !
  !  Solves in parallel with the Parallel Block Jacobi approach. Each
  !   sub-domain solves for scalar flux and outgoing angular flux. Angular fluxes
  !   are passed to neighbors to solve for new scalar flux. Iterate until
  !   convergence is reached.
  !
  !  Features:  1. Double Precision
  !             2. Module files for input, solution, and timing variables
  !             3. DD with NO flux fixup and NO acceleration
  !             4. Multigroup with Isotropic Downscattering
  !             5. Printing and Solution Editing Options
  !             6. Multi-file Input/Output
  !             7. Full domain BCs include Vac/Refl/Inp
  !
  !  Use makefile in same directory to compile and link.
  !
  !  Update from previous version:
  !   Multiple sub-domains per processor, solved with red-black iterations
  !   Only allow IDO solution--direct with factorization
  !   Apply 'd0' to all assigned Real*8 values to ensure double precision entry
  !
  !-----------------------------------------------------------------------------------

  USE invar
  USE totvar
  USE solvar
  IMPLICIT NONE
  CHARACTER(8) :: infile, outfile, qdfile, xsfile, srcfile, mtfile, bcfile
  INTEGER :: statin, statout, ferr, ierr, iexit, i, j
  INTEGER, DIMENSION(25) :: ipak
  REAL*8, DIMENSION(2) :: rpak
  REAL*8 :: tstart, ttosolve, tjmat, tsolve, tend, tts, tj, ts, te, tres
  REAL*8 :: t1, t2, t3, t4, td1, td2, td3, td4, tdiff1, tdiff2, tdiff3, tdiff4
  LOGICAL :: existence

  INCLUDE 'mpif.h'

  ! Initialize MPI
  CALL MPI_INIT(ierr)

  ! Get the start time
  tstart = MPI_WTIME()

  CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
  CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,ierr)

  ! Set the process that does the reading
  root = 0

  ! Have the root process above take care of input and output
  IF (irank == root) THEN
    CALL GETARG(1, infile) !, statin)
    CALL GETARG(2, outfile) !, statout)
    IF (statin .EQ. -1 .OR. statout .EQ. -1) THEN
      PRINT *, "Failed reading input and/or output file names."
      ferr = 1
    ELSE
      OPEN (UNIT = 7, FILE = infile, STATUS = "OLD", ACTION = "READ")
      ! Check if the output file exists or not, then open appropriately
      INQUIRE (FILE = outfile, EXIST = existence)
      IF (existence .EQV. .TRUE.) THEN
        OPEN (UNIT = 8, FILE = outfile, STATUS = "OLD", ACTION = "WRITE")
      ELSE
        OPEN (UNIT = 8, FILE = outfile, STATUS = "NEW", ACTION = "WRITE")
      END IF
      ferr = 0
    END IF
  END IF

  ! Broadcast the fer to all processes and stop program if necessary
  CALL MPI_BCAST(ferr,1,MPI_INTEGER,root,MPI_COMM_WORLD,ierr)
  IF (ferr == 1) THEN
    CALL MPI_FINALIZE(ierr)
    STOP
  END IF

  ! Set up the introductory info
  IF (irank == root) CALL version

  ! Read input data:
  ! Input will call dependency algorithms, namely the input check
  IF (irank == root) THEN
    CALL input(qdfile, xsfile, srcfile, mtfile, bcfile, iexit)
  ELSE
    ! Other processes get the integer package first, then unpacks
    CALL MPI_BCAST(ipak,25,MPI_INTEGER,root,MPI_COMM_WORLD,ierr)
    nx     = ipak(1)
    ny     = ipak(2)
    nz     = ipak(3)
    npx    = ipak(4)
    npy    = ipak(5)
    npz    = ipak(6)
    sdnx   = ipak(7)
    sdny   = ipak(8)
    sdnz   = ipak(9)
    nxsd   = ipak(10)
    nysd   = ipak(11)
    nzsd   = ipak(12)
    nsdp   = ipak(13)
    nm     = ipak(14)
    bitmx  = ipak(15)
    apo    = ipak(16)
    neq    = ipak(17)
    xys    = ipak(18)
    xzs    = ipak(19)
    yzs    = ipak(20)
    bcs    = ipak(21)
    bcs2   = ipak(22)
    itp    = ipak(23)
    sfp    = ipak(24)
    iexit  = ipak(25)
    ! Other processes receive the bc array
    CALL MPI_BCAST(bc,6,MPI_INTEGER,root,MPI_COMM_WORLD,ierr)
    ! Other processes then receive the real package
    CALL MPI_BCAST(rpak,2,MPI_DOUBLE_PRECISION,root,MPI_COMM_WORLD,ierr)
    ! Allocate data before continuing
    ALLOCATE(ang(apo,3), w(apo), sigt(nm), sigs(nm))
    CALL MPI_BCAST(ang,(3*apo),MPI_DOUBLE_PRECISION,root,MPI_COMM_WORLD,ierr)
    CALL MPI_BCAST(w,apo,MPI_DOUBLE_PRECISION,root,MPI_COMM_WORLD,ierr)
    CALL MPI_BCAST(sigt,nm,MPI_DOUBLE_PRECISION,root,MPI_COMM_WORLD,ierr)
    CALL MPI_BCAST(sigs,nm,MPI_DOUBLE_PRECISION,root,MPI_COMM_WORLD,ierr)
    ! Unpack rpak
    err  = rpak(1)
    tolr = rpak(2)
  END IF

  ! Stop all processes if there was an error detected. 0 process writes out error messages
  IF (iexit > 0) THEN
    CALL MPI_FINALIZE(ierr)
    STOP
  END IF

  ! Echo the input data:
  IF (irank == root) CALL echo(infile, outfile, qdfile, xsfile, srcfile, mtfile, bcfile)

  ! All processes call for the parallel setup
  CALL psds

  IF (irank == root) THEN
    ! Now each process has their information, can deallocate
    DEALLOCATE(dxt,dyt,dzt,matt,st)
    !   DEALLOCATE(posinz,neginz,posiny,neginy,posinx,neginx)
  END IF

  ! Solve the transport problem:
  CALL solve(ttosolve,tjmat,tsolve)

  ! Print the output
  IF (irank == root) CALL output

  ! ------------------ Final Actions, Timing Data ----------------------------------
  ! Get the times, relative to 'tstart'
  tts = ttosolve - tstart
  tj = tjmat - tstart
  ts = tsolve - tstart

  ! Reduce to Max values for reporting
  CALL MPI_REDUCE(tts,t1,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)
  CALL MPI_REDUCE(tj,t2,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)
  CALL MPI_REDUCE(ts,t3,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)

  ! Compute the differences and get max of them
  td1 = tjmat - ttosolve
  td2 = tsolve - tjmat
  td3 = tsolve - ttosolve
  CALL MPI_REDUCE(td1,tdiff1,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)
  CALL MPI_REDUCE(td2,tdiff2,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)
  CALL MPI_REDUCE(td3,tdiff3,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)

  ! Time the end of the job
  tend = MPI_WTIME()
  te = tend - tstart
  CALL MPI_REDUCE(te,t4,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)
  td4 = tend - tsolve
  CALL MPI_REDUCE(td4,tdiff4,1,MPI_DOUBLE_PRECISION,MPI_MAX,root,MPI_COMM_WORLD,ierr)

  ! Get timing resolution
  tres = MPI_WTICK()

  ! Print the relevant times of the execution
  IF (irank == root) THEN
    WRITE(8,'(/,2X,A,/)') "Fortran95 Timing Estimates with MPI_WTIME..."
    WRITE(8,100)
    WRITE(8,101) "InputWrk", t1, t1
    WRITE(8,101) "IDOmatrx", t2, tdiff1
    WRITE(8,101) "IDOitrns", t3, tdiff2
    WRITE(8,101) "SolveTot", t3, tdiff3
    WRITE(8,101) "PrintOut", t4, tdiff4
    WRITE(8,'(/,5X,A,ES9.2)') "Timing Resolution (s): ", tres
    WRITE(8,102)
100 FORMAT(5X,'WorkDone',3X,'Absolute(s)',6X,'Difference(s)')
101 FORMAT(5X,A8,3X,F9.3,5X,F9.3)
102 FORMAT(//,'*********************   END PROGRAM   ************************')
  END IF

  ! Deallocate the allocated arrays
  IF (irank == root .AND. sfp == 1) DEALLOCATE(fluxt)
  DEALLOCATE(dx,dy,dz,mat,ang,w,sigt,sigs,s,flux)
  DEALLOCATE(psii)

  ! End the PIDOSITS program
  CALL MPI_FINALIZE(ierr)

  STOP
END PROGRAM pidosits

max_stars_repo_name: lanl/pidots

max_issues_repo_name: lanl/pidots

max_forks_repo_name: lanl/pidots