text:
subroutine amrex_probinit (init,name,namlen,problo,probhi) bind(c)

  use eos_module
  use eos_type_module
  use bl_error_module
  use network
  use probdata_module
  use extern_probin_module
  use bl_constants_module

  use amrex_fort_module, only : rt => amrex_real
  implicit none

  integer init, namlen
  integer name(namlen)
  real(rt)         problo(1), probhi(1)
  real(rt)         xn(nspec)

  integer untin,i

  type (eos_t) :: eos_state

  real(rt)         :: lambda_f, v_f

  namelist /fortin/ pert_frac, pert_delta, rho_fuel, T_fuel, T_ash

  ! Build "probin" filename -- the name of file containing
  ! fortin namelist.
  integer, parameter :: maxlen = 256
  character probin*(maxlen)

  if (namlen .gt. maxlen) then
     call bl_error("probin file name too long")
  end if

  do i = 1, namlen
     probin(i:i) = char(name(i))
  end do

  ! set namelist defaults
  pert_frac = 0.2e0_rt
  pert_delta = 0.02e0_rt
  rho_fuel = ONE
  T_fuel = ONE
  T_ash = ONE

  ! Read namelists
  open(newunit=untin, file=probin(1:namlen), form='formatted', status='old')
  read(untin, fortin)
  close(untin)

end subroutine amrex_probinit

! ::: -----------------------------------------------------------
! ::: This routine is called at problem setup time and is used
! ::: to initialize data on each grid.
! :::
! ::: NOTE:  all arrays have one cell of ghost zones surrounding
! :::        the grid interior.  Values in these cells need not
! :::        be set here.
! :::
! ::: INPUTS/OUTPUTS:
! :::
! ::: level     => amr level of grid
! ::: time      => time at which to init data
! ::: lo,hi     => index limits of grid interior (cell centered)
! ::: nstate    => number of state components.  You should know
! :::		   this already!
! ::: state     <=  Scalar array
! ::: delta     => cell size
! ::: xlo,xhi   => physical locations of lower left and upper
! :::              right hand corner of grid.  (does not include
! :::		   ghost region).
! ::: -----------------------------------------------------------
subroutine ca_initdata(level,time,lo,hi,nscal, &
                      state,state_l1,state_h1,delta,xlo,xhi)

  use network, only: nspec, network_species_index
  use probdata_module
  use prob_params_module, only: problo, probhi
  use meth_params_module, only : NVAR, URHO, UMX, UMZ, UEDEN, UEINT, UTEMP, UFS
  use eos_type_module
  use eos_module
  use bl_constants_module

  use amrex_fort_module, only : rt => amrex_real
  implicit none

  integer level, nscal
  integer lo(1), hi(1)
  integer state_l1,state_h1
  real(rt)         state(state_l1:state_h1,NVAR)
  real(rt)         time, delta(1)
  real(rt)         xlo(1), xhi(1)

  real(rt)         xx, x_int, L, f, pert_width
  integer i

  real(rt)         :: e_fuel, p_fuel
  real(rt)         :: rho_ash, e_ash
  real(rt)         :: xn_fuel(nspec), xn_ash(nspec)

  type (eos_t) :: eos_state

  integer :: ifuel, iash

  ifuel = network_species_index("helium-4")
  iash = network_species_index("oxygen-16")

  L = probhi(1) - problo(1)
  x_int = problo(1) + pert_frac*L

  pert_width = pert_delta*L

  ! fuel state
  xn_fuel(:) = ZERO
  xn_fuel(ifuel) = ONE

  eos_state%rho = rho_fuel
  eos_state%T = T_fuel
  eos_state%xn(:) = xn_fuel(:)

  call eos(eos_input_rt, eos_state)

  e_fuel = eos_state%e
  p_fuel = eos_state%p

  ! compute the ash state -- this should be hot but in pressure equilibrium
  xn_ash(:) = ZERO
  xn_ash(iash) = ONE

  eos_state%rho = rho_fuel  ! initial guess
  eos_state%p = p_fuel      ! pressure equilibrum
  eos_state%T = T_ash
  eos_state%xn(:) = xn_ash(:)

  call eos(eos_input_tp, eos_state)

  rho_ash = eos_state % rho
  e_ash = eos_state % e

  !print *, 'fuel: ', rho_fuel, T_fuel, xn_fuel
  !print *, 'ash: ', rho_ash, T_ash, xn_ash

  do i = lo(1), hi(1)
     xx = problo(1) + delta(1)*(dble(i) + 0.5e0_rt)

     if (xx <= x_int) then

        ! ash
        state(i,URHO ) = rho_ash
        state(i,UMX:UMZ) = ZERO
        state(i,UEDEN) = rho_ash*e_ash
        state(i,UEINT) = rho_ash*e_ash
        state(i,UTEMP) = T_ash
        state(i,UFS:UFS-1+nspec) = rho_ash*xn_ash(:)

     elseif (xx > x_int .and. xx < x_int + pert_width) then

        ! linearly interpolate
        f = (xx - x_int)/pert_width
        eos_state%T = (ONE-f)*T_ash + f*T_fuel
        eos_state%rho = (ONE-f)*rho_ash + f*rho_fuel
        eos_state%xn(:) = (ONE-f)*xn_ash(:) + f*xn_fuel(:)

        call eos(eos_input_rt, eos_state)

        state(i,URHO ) = eos_state%rho
        state(i,UMX:UMZ) = ZERO
        state(i,UEDEN) = eos_state%rho*eos_state%e
        state(i,UEINT) = eos_state%rho*eos_state%e
        state(i,UTEMP) = eos_state%T
        state(i,UFS:UFS-1+nspec) = eos_state%rho*eos_state%xn(:)

     else

        ! fuel
        state(i,URHO ) = rho_fuel
        state(i,UMX:UMZ) = ZERO
        state(i,UEDEN) = rho_fuel*e_fuel
        state(i,UEINT) = rho_fuel*e_fuel
        state(i,UTEMP) = T_fuel
        state(i,UFS:UFS-1+nspec) = rho_fuel*xn_fuel(:)
     endif

  enddo

end subroutine ca_initdata

max_stars_repo_name: yingtchen/Castro

max_issues_repo_name: yingtchen/Castro

max_forks_repo_name: yingtchen/Castro


text:
!>  boundary conditions module
!
!>  Various BC related functionality. Need to expand.

module boundary_conditions
  use types, only: bc_config
  use kinds, only: ccs_int, ccs_real

  implicit none

  private
  public :: read_bc_config

  contains

  !>  Wrapper for reading config file and assigning data to BC structure
  !
  !> @param[in] filename - name of config file
  !> @param[out] bcs     - boundary conditions structure
  subroutine read_bc_config(filename, bcs)
    use yaml, only: parse, error_length
    character(len=*), intent(in) :: filename
    type(bc_config), intent(out) :: bcs

    class(*), pointer :: config_file
    character(len=error_length) :: error

    config_file => parse(filename, error=error)
    if (error/='') then
      print*,trim(error)
      stop 1
    endif

    call get_bcs(config_file, bcs)
  end subroutine read_bc_config

  !>  Assigns bc data to structure
  !
  !> @param[in] config_file - pointer to configuration file
  !> @param[out] bcs        - boundary conditions structure
  subroutine get_bcs(config_file, bcs)
    use bc_constants
    use read_config, only: get_boundaries

    class(*), pointer, intent(in) :: config_file
    type(bc_config), intent(out) :: bcs
    character(len=16), dimension(:), allocatable :: region
    character(len=16), dimension(:), allocatable :: bc_type
    real(ccs_real), dimension(:,:), allocatable :: bc_data
    integer(ccs_int) :: i

    call get_boundaries(config_file, region, bc_type, bc_data)

    do i = 1, size(region)
      select case(region(i))
        case("left")
          bcs%region(i) = bc_region_left
        case("right")
          bcs%region(i) = bc_region_right
        case("top")
          bcs%region(i) = bc_region_top
        case("bottom")
          bcs%region(i) = bc_region_bottom
        case default
          print *, 'invalid BC region selected'
          stop
      end select

      select case(bc_type(i))
        case("periodic")
          bcs%bc_type(i) = bc_type_periodic
        case("sym")
          bcs%bc_type(i) = bc_type_sym
        case("dirichlet")
          bcs%bc_type(i) = bc_type_dirichlet
        case("const_grad")
          bcs%bc_type(i) = bc_type_const_grad
        case default
          print *, 'invalid BC type selected'
          stop
      end select
    end do
    ! ALEXEI: This specifies the values of the boundary conditions at the corners of the box (if dirichlet,
    ! otherwise ignored).This is necessary for the scalar_advection case setup and the tests, but should be
    ! generalised in the longer term. Since we are working in 2D for now we only need a subset of the
    ! vectors specified
    bcs%endpoints(:,:) = bc_data(2:,:2)
  end subroutine get_bcs
end module boundary_conditions

max_stars_repo_name: asimovpp/asimov-ccs

max_issues_repo_name: asimovpp/asimov-ccs

max_forks_repo_name: asimovpp/asimov-ccs


text:
!
!     CalculiX - A 3-dimensional finite element program
!              Copyright (C) 1998-2019 Guido Dhondt
!
!     This program 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(version 2);
!
!
!     This program 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.
!
!     You should have received a copy of the GNU General Public License
!     along with this program; if not, write to the Free Software
!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
!
      subroutine writeboun(nodeboun,ndirboun,xboun,typeboun,nboun)
!
!     writes an MPC to standard output (for debugging purposes)
!
      implicit none
!
      character*1 typeboun(*)
      integer nodeboun(*),ndirboun(*),nboun,i
      real*8 xboun(*)
!
      write(*,*)
      write(*,'(''SPC '')')
      do i=1,nboun
         write(*,'(i5,1x,i10,1x,i5,1x,e11.4,1x,a1)') i,nodeboun(i),
     &             ndirboun(i),xboun(i),typeboun(i)
      enddo
!
      return
      end

ext: f

max_stars_repo_name: alleindrach/calculix-desktop

max_issues_repo_name: alleindrach/calculix-desktop

max_forks_repo_name: alleindrach/calculix-desktop


text:
      SUBROUTINE ITEMA2 (STATE,  I1,I2,GOT)
C     READ FOR UPDATE AND LOCK AN ITEM-SET
C     GF 20.08.1980
C
      INCLUDE 'PARS.f'
      INCLUDE 'ITES.f'
      INCLUDE 'STAS.f'
      INCLUDE 'PRIS.f'
      INTEGER*2 PARASK
      INTEGER*2 I1,I2
     = ,GOT     ! = 1 (0) IF THE STATE WAS (NOT) REALLY READ
     = ,STATE   ! ACCESS TO THIS ITEM-SET
C
      ITE(1) = STAITE(STATE)
      I1 = 1
      I2 = ITE(1)
      RETURN
C----
      IF (ITEPAG .GT. 1 .OR. ITEPAG .LT. 0)
     =  CALL ASSERT (152,STATE,STAITE(STATE))
      CALL ITEMA1 (STATE,  ITE(1),GOT)
      I1 = 1
      I2 = ITE(1)
      RETURN
      END

max_stars_repo_name: gfis/jextra

max_issues_repo_name: gfis/jextra

max_forks_repo_name: gfis/jextra


text:
subroutine GhostPointsAndLocalOrdering(a)
   use MPI
   use typre
   use Mod_PointToProc
   use Mod_Mesh
   implicit none

   class(FemMesh), intent(inout) :: a

   logical, allocatable     :: lwa(:)
   integer(ip), allocatable :: iwa(:)

   integer(ip) :: minpo,maxpo,ielem,ipoin,pnode,inode,ispos,iwasize

   integer(ip), allocatable :: LocalToGlobal(:)
   type(PointToProc) :: Point2Proc
   integer(ip), allocatable :: ProcList(:)

   !MPI
   integer :: ierr

   call a%Timer%GhostPoints%Tic

   !Decide which are my ghost points
   minpo = a%poin0 +1
   maxpo = a%poin0 + a%npoinLocal

   call a%Memor%alloc(a%npoinLocal,iwa ,'iwa' ,'ScatterData')
   iwasize = a%npoinLocal
   call a%Memor%alloc(a%gnpoin,lwa,'lwa','ScatterData')

   a%npoinGhost = 0
   do ielem = 1,a%nelem
      call getlnods(ielem,pnode,ispos,a%pnods,a%lnods,a%nelty,a%nnode)
      do inode = 1,pnode
         if (a%lnods(ispos+inode) > maxpo .or. a%lnods(ispos+inode) < minpo) then !point is a ghost!
            if (lwa(a%lnods(ispos+inode)) .eqv. .false.) then
               lwa(a%lnods(ispos+inode)) = .true.
               a%npoinGhost = a%npoinGhost+1
               if (a%npoinGhost > iwasize) then
                  iwasize = iwasize*2
                  call a%Memor%Realloc(iwasize,iwa,'iwa','ScatterData')
               endif
               iwa(a%npoinGhost) = a%lnods(ispos+inode)
            endif
         endif
      enddo
   enddo
   a%npoin = a%npoinLocal + a%npoinGhost

   !Build  the LocalToGlobal Array
   call a%Memor%alloc(a%npoinLocal+a%npoinGhost,LocalToGlobal,'LocalToGlobal','ScatterData')
   do ipoin = 1,a%npoinLocal
      LocalToGlobal(ipoin) = ipoin + a%poin0
   enddo
   LocalToGlobal(a%npoinLocal+1:a%npoinLocal+a%npoinGhost) = iwa(1:a%npoinGhost)

   call a%Memor%dealloc(a%gnpoin,lwa,'lwa','ScatterData')
   call a%Memor%dealloc(size(iwa), iwa,'iwa','ScatterData')

   call MPI_REDUCE( a%npoinGhost, a%gnpoinGhost, 1, MPI_INTEGER4, MPI_SUM, a%MPIroot,a%MPIcomm, ierr )
   call MPI_REDUCE( a%npoinGhost, a%MaxNpoinGhostPerProc, 1, MPI_INTEGER4, MPI_MAX, a%MPIroot,a%MPIcomm, ierr )

   call a%Timer%GhostPoints%Toc

!----------------------------------------------------------------------------

   call a%Timer%BuildLocalOrdering%Tic

   !I also want to store the processor number of each ghost point. At this point, I do not know it
   call a%Memor%alloc(a%npoin,ProcList,'ProcList','GhostPoints')

   call Point2Proc%SetMPI(a%MPIcomm,a%MPIsize,a%MPIroot,a%MPIrank)
   call Point2Proc%SetMemor(a%Memor)
   call Point2Proc%Initialize(a%poin0)
   ProcList(1:a%npoinLocal) = a%MPIrank
   do ipoin = 1,a%npoinGhost
      call Point2Proc%GetProc(LocalToGlobal(a%npoinLocal+ipoin),ProcList(a%npoinLocal+ipoin))
   enddo
   call Point2Proc%Finalize

   !Create and Initialize the LocalOrdering
   call a%ParallelLibrary%CreateOrdering(a%LocalOrdering,a%Memor)  !FACTORY
   call a%LocalOrdering%Init(a%MPIcomm,a%npoinLocal+a%npoinGhost,LocalToGlobal,ProcList,a%Memor)

   !Ghost Point List deallocate
   call a%Memor%dealloc(a%npoin,ProcList,'ProcList','BuildArrayCommunicator')
   call a%Memor%dealloc(a%npoinLocal+a%npoinGhost,LocalToGlobal,'LocalToGlobal','ScatterData')

   call a%Timer%BuildLocalOrdering%Toc
end subroutine

subroutine BuildArrayCommunicator(a)
   use typre
   use Mod_Mesh
   implicit none

   class(FemMesh), intent(inout) :: a

   integer(ip), allocatable :: ProcList(:)

   call a%Timer%BuildArrayCommunicator%Tic

   call a%ParallelLibrary%CreateCommunicator(a%ArrayCommunicator,a%Memor)
   call a%ArrayCommunicator%Init(a%MPIcomm,a%MPIsize,a%MPIrank,a%npoinLocal,a%npoinGhost,a%gnpoin,a%LocalOrdering,a%Memor)

   call a%Timer%BuildArrayCommunicator%Toc

end subroutine

subroutine Ghostcoord(a)
   use MPI
   use typre
   use Mod_Mesh
   implicit none

   class(FemMesh), intent(inout) :: a

   integer(ip) :: ierr

   call a%Timer%GhostCoord%Tic

   call a%ArrayCommunicator%GhostCommunicate(a%ndime,a%coord)

   call a%Timer%GhostCoord%Toc

end subroutine

subroutine LnodsToLocal(a)
   use typre
   use Mod_Mesh
   implicit none

   class(FemMesh), intent(inout) :: a

   integer(ip) :: iaux,idummy,ierr

   call a%Timer%LnodsToLocal%Tic

   !Transform lnods to local numbering
   iaux = size(a%lnods)
   call a%LocalOrdering%Global2Local(iaux,a%lnods,a%lnods)

   call a%Timer%LnodsToLocal%Tic
end subroutine

max_stars_repo_name: ciaid-colombia/InsFEM

max_issues_repo_name: ciaid-colombia/InsFEM

max_forks_repo_name: ciaid-colombia/InsFEM


text:
! { dg-do  run }
! { dg-require-effective-target lto }
! { dg-options "-flto" }
! Check that there are no warnings with LTO for a KIND argument.
!
program test
   implicit none
   real, allocatable :: x(:,:)

   allocate(x(2,5))
   if (any(shape(x) /= [ 2, 5 ])) call abort
   if (any(shape(x,kind=1) /= [ 2, 5 ])) call abort
   if (any(shape(x,kind=2) /= [ 2, 5 ])) call abort
   if (any(shape(x,kind=4) /= [ 2, 5 ])) call abort
   if (any(shape(x,kind=8) /= [ 2, 5 ])) call abort
 end program test

max_stars_repo_name: TUDSSL/TICS

max_issues_repo_name: TUDSSL/TICS

max_forks_repo_name: TUDSSL/TICS


text:
Phil of Phils Driving School is a licensed Drivers Training and Education driver training instructor with 7 years experience, who will take the extra effort to help applicants pass drivers license test. Applicant will be learning in a 2008 Chrysler, fully insured, and modified with a dual breaking system for safety. Offering lessons to people 18 years + and specializing in training seniors or those who may be having some difficulty in passing their drivers license exam. Servicing the Sacramento and Davis areas.

20121005 17:55:21 nbsp Did a few lessons with Phil. Nice patient and effective. Flexible schedule and pickups always on time. Gonna do test next week. Fingers crossed. Users/EricShan

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search