text:
** Copyright (c) 1989, NVIDIA CORPORATION.  All rights reserved.
**
** Licensed under the Apache License, Version 2.0 (the "License");
** you may not use this file except in compliance with the License.
** You may obtain a copy of the License at
**
**     http://www.apache.org/licenses/LICENSE-2.0
**
** Unless required by applicable law or agreed to in writing, software
** distributed under the License is distributed on an "AS IS" BASIS,
** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
** See the License for the specific language governing permissions and
** limitations under the License.

*   Milstd & VMS intrinsics: ISHFTC, IBITS, BTEST, IBSET, IBCLR

C    test procedural forms.

	program fa07
	parameter n = 20
	intrinsic iishft, jishft
	intrinsic iibits, jibits
	intrinsic iibset, jibset
	intrinsic iibclr, jibclr
	intrinsic iishftc, jishftc
	intrinsic bitest, bjtest
	integer results(n), expect(n)
	integer*2 i1010, i1100, ii, i1, i2, i3
	integer*4 j1010, j1100, ji
	data i1010, i1100, j1010, j1100
     +	    / '1010'x, '1100'x, '1010'x, '1100'x/

	external l2fun, l4fun
	logical*2 l2fun
	logical*4 l4fun
	external i2fun3, i4fun3
	integer*2 i2fun3
	integer*4 i4fun3
	external i2fun4, i4fun4
	integer*2 i2fun4
	integer*4 i4fun4

	results(1) = 0
	i1 = 12		! currently have problems passing constants
	if (l2fun( bitest, i1010, i1)) results(1) = 1
	results(2) = 0
	if (l4fun( bjtest, j1010, 12)) results(2) = 1
	results(3) = 0
	i1 = 8
	if (l2fun(bitest, i1100, i1)) results(3) = 1
	results(4) = 0
	if (l4fun(bjtest, j1100, 8)) results(4) = 1

	i1 = 5
	results(5) = i2fun3(iibset, i1010, i1)
	results(6) = i4fun3(jibset, j1010, 6)
	i1 = 9
	results(7) = i2fun3(iibset, i1100, i1)
	results(8) = i4fun3(jibset, j1100, 13)

	i1 = 12
	results(9) = i2fun3(iibclr, i1010, i1)
	results(10) = i4fun3(jibclr, j1010, 12)
	i1 = 8
	results(11) = i2fun3(iibclr, i1100, i1)
	results(12) = i4fun3(jibclr, j1100, 8)

	i1 = 4
	i2 = 4
	results(13) = i2fun4(iibits, i1010, i1, i1)
	results(14) = i4fun4(jibits, j1010, 12, 12)
	i1 = 12
	i2 = 8
	results(15) = i2fun4(iibits, i1100, i2, i1)
	results(16) = i4fun4(jibits, j1100, 8, 12)

	i1 = 9
	i2 = 1
	results(17) = i2fun4(iishftc, i1100, i2, i1)
	results(18) = i4fun4(jishftc, j1010, 8, 12)
	i1 = 5
	i2 = 1
	results(19) = i2fun4(iishftc, i1010, i2, i1)
	results(20) = i4fun4(jishftc, j1100, 1, 13)

	call check(results, expect, n)
	data expect / 1, 1, 1, 1,		! btest
     +    '1030'x, '1050'x, '1300'x, '3100'x,   ! bset
     +    '10'x, '10'x, '1000'x, '1000'x,	! ibclr
     +    1, 1, '11'x, '11'x,			! ibits
     +    '1001'x, '1001'x, '1001'x, '0201'x	! ishftc
     +  /
	end
	logical*2 function l2fun(a, b, c)
	logical*2 a
	integer*2 b, c
	external a
	l2fun = a(b, c)
	end
	logical*4 function l4fun(a, b, c)
	logical*4 a
	integer*4 b, c
	external a
	l4fun = a(b, c)
	end
	integer*2 function i2fun3(a, b, c)
	integer*2 a, b, c
	external a
	i2fun3 = a(b, c)
	end
	integer*4 function i4fun3(a, b, c)
	integer*4 a, b, c
	external a
	i4fun3 = a(b, c)
	end
	integer*2 function i2fun4(a, b, c, d)
	integer*2 a, b, c, d
	external a
	i2fun4 = a(b, c, d)
	end
	integer*4 function i4fun4(a, b, c, d)
	integer*4 a, b, c, d
	external a
	i4fun4 = a(b, c, d)
	end

max_stars_repo_name: kammerdienerb/flang

max_issues_repo_name: kammerdienerb/flang

max_forks_repo_name: kammerdienerb/flang


text:
C
C $Id: galbex.f,v 1.7 2008-07-27 00:17:13 haley Exp $
C
C                Copyright (C)  2000
C        University Corporation for Atmospheric Research
C                All Rights Reserved
C
C The use of this Software is governed by a License Agreement.
C
      SUBROUTINE GALBEX (LABL,MLBL,NLBL)
C
        CHARACTER*(*) LABL
C
C Given a character string LABL, of arbitrary length, find the index of
C the first non-blank character in it (MLBL) and the index of the last
C non-blank character following that (NLBL).
C
        LLBL=LEN(LABL)
C
        DO 101 I=1,LLBL
          IF (LABL(I:I).NE.' ') THEN
            MLBL=I
            GO TO 102
          END IF
  101   CONTINUE
        MLBL=1
C
  102   DO 103 I=MLBL,LLBL-1
          IF (LABL(I+1:I+1).EQ.' ') THEN
            NLBL=I
            GO TO 104
          END IF
  103   CONTINUE
        NLBL=LLBL
C
C Done.
C
  104   RETURN
C
      END

ext: f

max_stars_repo_name: tenomoto/ncl

max_issues_repo_name: tenomoto/ncl

max_forks_repo_name: tenomoto/ncl


text:
      PROGRAM AGEX05
C
C Define the error file, the Fortran unit number, the workstation type,
C and the workstation ID to be used in calls to GKS routines.
C
C     PARAMETER (IERRF=6, LUNIT=2, IWTYPE=1,  IWKID=1)   ! NCGM
C     PARAMETER (IERRF=6, LUNIT=2, IWTYPE=8,  IWKID=1)   ! X Windows
C     PARAMETER (IERRF=6, LUNIT=2, IWTYPE=11, IWKID=1)   ! PDF
C     PARAMETER (IERRF=6, LUNIT=2, IWTYPE=20, IWKID=1)   ! PostScript
C
      PARAMETER (IERRF=6, LUNIT=2, IWTYPE=1,  IWKID=1)
C
C Define the data arrays.
C
      REAL XDRA(401,6),YDRA(401,6)
C
C Initialize GKS.
C
      CALL GOPKS (IERRF, ISZDM)
      CALL GOPWK (IWKID, LUNIT, IWTYPE)
      CALL GACWK (IWKID)
C
C Compute required constants.
C
      PI=3.14159265358979
      PID200=PI/200.
      PITTWO=2.*PI
      PIT2D3=2.*PI/3.
      PIT4D3=4.*PI/3.
      RADOSC=SQRT(3.)/3.
      RADOLC=SQRT(3.)/2.
      BSSCLL=ATAN(SQRT(12.)/6.)
      BSSCUL=ATAN(SQRT(143.)/7.)
      BSLCLL=ATAN(SQRT(143.)/17.)
      BSLCUL=ATAN(SQRT(2.0))
C
C Fill the data arrays.
C
      DO 101 I=1,401
        THETA=PID200*REAL(I-1)
        XDRA(I,1)=   -.5+RADOSC*COS(THETA)
        YDRA(I,1)=       RADOSC*SIN(THETA)
        IF (ABS(THETA       ).GE.BSSCLL.AND.
     +      ABS(THETA       ).LE.BSSCUL) XDRA(I,1)=1.E36
        IF (ABS(THETA-PITTWO).GE.BSSCLL.AND.
     +      ABS(THETA-PITTWO).LE.BSSCUL) XDRA(I,1)=1.E36
        XDRA(I,2)=    .5+RADOSC*COS(THETA)
        YDRA(I,2)=       RADOSC*SIN(THETA)
        IF (ABS(THETA-PIT2D3).GE.BSSCLL.AND.
     +      ABS(THETA-PIT2D3).LE.BSSCUL) XDRA(I,2)=1.E36
        XDRA(I,3)=       RADOSC*COS(THETA)
        YDRA(I,3)=RADOLC+RADOSC*SIN(THETA)
        IF (ABS(THETA-PIT4D3).GE.BSSCLL.AND.
     +      ABS(THETA-PIT4D3).LE.BSSCUL) XDRA(I,3)=1.E36
        XDRA(I,4)=   -.5+RADOLC*COS(THETA)
        YDRA(I,4)=       RADOLC*SIN(THETA)
        IF (ABS(THETA       ).GE.BSLCLL.AND.
     +      ABS(THETA       ).LE.BSLCUL) XDRA(I,4)=1.E36
        IF (ABS(THETA-PITTWO).GE.BSLCLL.AND.
     +      ABS(THETA-PITTWO).LE.BSLCUL) XDRA(I,4)=1.E36
        XDRA(I,5)=    .5+RADOLC*COS(THETA)
        YDRA(I,5)=       RADOLC*SIN(THETA)
        IF (ABS(THETA-PIT2D3).GE.BSLCLL.AND.
     +      ABS(THETA-PIT2D3).LE.BSLCUL) XDRA(I,5)=1.E36
        XDRA(I,6)=       RADOLC*COS(THETA)
        YDRA(I,6)=RADOLC+RADOLC*SIN(THETA)
        IF (ABS(THETA-PIT4D3).GE.BSLCLL.AND.
     +      ABS(THETA-PIT4D3).LE.BSLCUL) XDRA(I,6)=1.E36
  101 CONTINUE
C
C Specify subscripting of XDRA and YDRA.
C
      CALL AGSETI ('ROW.',2)
C
C Set up grid shape to make 1 unit in x = 1 unit in y.
C
      CALL AGSETF ('GRID/SHAPE.',2.)
C
C Turn off background, then turn labels back on.
C
      CALL AGSETF ('BACKGROUND.',4.)
      CALL AGSETI ('LABEL/CONTROL.',2)
C
C Turn off left label.
C
      CALL AGSETC ('LABEL/NAME.','L')
      CALL AGSETI ('LABEL/SUPPRESSION FLAG.',1)
C
C Change text of bottom label.
C
      CALL AGSETC ('LABEL/NAME.','B')
      CALL AGSETI ('LINE/NUMBER.',-100)
      CALL AGSETC ('LINE/TEXT.','PURITY, BODY, AND FLAVOR$')
C
C Draw a boundary around the edge of the plotter frame.
C
      CALL BNDARY
C
C Draw the graph, using EZMXY.
C
      CALL EZMXY (XDRA,YDRA,401,6,401,'EXAMPLE 5 (EZMXY)$')
C
C Close GKS.
C
      CALL GDAWK (IWKID)
      CALL GCLWK (IWKID)
      CALL GCLKS
C
      STOP
C
      END
      SUBROUTINE BNDARY
C
C Routine to draw the plotter-frame edge.
C
      CALL PLOTIT (    0,    0,0)
      CALL PLOTIT (32767,    0,1)
      CALL PLOTIT (32767,32767,1)
      CALL PLOTIT (    0,32767,1)
      CALL PLOTIT (    0,    0,1)
      RETURN
      END


text:
      module vmec0
      use kind_spec
      character*5, parameter :: version_ = '7.00'
      end module vmec0

      module trig
      use kind_spec
      real(rprec), allocatable, dimension(:) :: trigsu
      real(rprec), allocatable, dimension(:) :: trigsv
      end module trig

      module parambs
      use vmec0
      use bootsj_input
      real(rprec), parameter :: pi = 3.141592653589793238462643_dp
      real(rprec), parameter :: dmu0 = 4.0e-7_dp*pi
      integer, parameter :: nlambda = 101       !this now only governs the trapped calcualtion
      integer :: nthetah, nzetah                !poloidal, toridal grid parameters
      integer, parameter :: nthetahm = 32       !poloidal, toroidal  grid refinement
      integer, parameter :: nzetahm = 16        !for bmax
      integer, parameter :: iotasign = 1
      real(rprec), parameter :: zetasign = -1
      integer :: irdim, irup
      integer, dimension(:), allocatable :: jlist, jlist_idx
      real(rprec)  delta_rho_1
      real(rprec), dimension(:), allocatable :: flux,
     1    aiogar, aipsi, gpsi, pres1,
     2    betar, dense, densi, tempe1, tempi1
      integer, dimension(:), allocatable :: idx
      real(rprec), dimension(:,:), allocatable ::
     1  bfield, gsqrt_b,  b2obm, omb32, bfieldm,    !  arrays to store quantities on the
     2  sinmi, sinnj, cosmi, cosnj,                 !  theta phi grid
     2  sinmim, sinnjm, cosmim, cosnjm              !  quantities that are on the theata

      real(rprec), dimension(:), allocatable ::
     1    dibs, aibs, dibst, aibst, phip,
     2    bsdense, bsdensi, bstempe, bstempi, bsdenste, bsdensti,
     3    bstempte, bstempti, qsafety, capr, caps, h2,
     4    ftrapped, fpassing, epsttok, fttok, b2avg,
     5    gbsnorm, aiterm1, other1, ajBbs,
     6    rhoar, bsnorm, fptok, amain, d_rho,
     7    bmax1, thetamax, zetahmax
      real(rprec)   alphae, alphai , psimax
      real(rprec)   temperho1, tempirho1, densrho1
      real(rprec), dimension(:,:,:), allocatable :: amnfit
      real(rprec)   periods
      real(rprec), dimension(:), allocatable :: theta, zetah
      real(rprec), dimension(nthetahm) :: thetam
      real(rprec), dimension(nzetahm) :: zetahm
      complex(rprec), dimension(:,:), allocatable ::
     1    dmn, fmn, alpha1mn
      real(rprec), dimension(:,:), allocatable :: rfmn
      real(rprec)   avgbobm2, sum_gsqrt_b
      real(rprec), dimension(136) :: w1, alamb_h
CCCCfix needed--put nlambda variables into the trapped fraction calculation
      real(rprec)   dlambda, drho
      real(rprec)  sign_jacobian
      logical, dimension(:), allocatable :: lsurf
      logical l_boot_all, lscreen
      end module parambs


text:
       INTEGER FUNCTION LNBLNK (STRING)
C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
C Purpose:   Returns the position of the last non-blank character
C
C Arguments: STRING   character string (input only)
C
C Remarks:   All FORTRAN 77 character variables are blank padded on the
C            right.  The intrinsic function LEN returns the dimension
C            of the character object, not the length of the contents.
C
C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
C $Header: /tmp/mss/nwchem/src/rimp2/lnblnk.f,v 1.4 1995-12-16 21:06:36 gg502 Exp $
C
C    Revision 0.0  87/07/24  bernholdt (VAX)
C $Log: not supported by cvs2svn $
c Revision 1.3  1995/02/02  23:21:12  d3g681
c RJH: A CVS ID for every file and automated generation of a version output
c
c Revision 1.2  1994/09/01  21:07:41  d3e129
c removed call to char from parameter statement.  not allowed by
c fortran standard.
c RAK
c
c Revision 1.1  1994/06/14  21:54:19  gg502
c First cut at RIMP2.
c
c Revision 1.1  91/08/26  23:11:19  bernhold
c Initial revision
c
C    Revision 1.1  88/01/11  22:08:15  bernhold
C    Initial revision
C
C
C System:     Standard FORTRAN 77
C
C Copyright 1987 David E. Bernholdt
C:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
C$Id$
       IMPLICIT NONE
       INTEGER I
       CHARACTER*(*) STRING
       CHARACTER*1 BLANK, NULL
       PARAMETER (BLANK = ' ')
C
C      Start at the end and work backwards
C
       NULL=CHAR(0)
       DO 100 I = LEN(STRING), 1, -1
C         Look for first non-whitespace character
          IF (STRING(I:I) .NE. BLANK .AND. String(I:I) .ne. NULL) THEN
             LNBLNK = I
             RETURN
          ENDIF
  100  CONTINUE
C
C      If we get this far, the string is empty
       LNBLNK = 0
       RETURN
       END

max_stars_repo_name: dinisAbranches/nwchem

max_issues_repo_name: dinisAbranches/nwchem

max_forks_repo_name: dinisAbranches/nwchem


text:
  function poten (clientTarg, i, ipatin)

! ======================================================================
!
!     Calculation of particle potential in  nuclear zone number i.
!
!   Called by: CASCAD PINPN REFRAC
!
!    CEM95 written by S. G. Mashnik
!    Edited by A. J. Sierk,  LANL  T-2  February, 1996.
!   "Last" change: 13-AUG-2003 by NVMokhov
!    Edited by A. J. Sierk, LANL T-16, October, 2003.
!    Edited by AJS, LANL T-2, December, 2011.
!
! ======================================================================
!
!  Definition of ipatin:
!                       ipatin(1); charge of particle
!                       ipatin(2); non-zero for photon interaction
!                       ipatin(3); strangeness of particle
!                       ipatin(4); particle baryon number
!                       ipatin(5); zone number of nucleus where particle
!                                  is located.
!
! ======================================================================

    use, intrinsic:: iso_fortran_env, only: int32, real64
    use standardDCMParams, only: zro, one
    use standardDCMDataClass, only: StandardDCMData

    implicit none
    class(StandardDCMData), intent(inout) :: clientTarg
    integer(int32),         intent(in   ) :: i
    integer(int32),         intent(in   ) :: ipatin(5)
    real(real64)                          :: poten

    real(real64) :: temp1, temp2, temp3

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

    if (i-clientTarg%numZones() >= 2) then
       poten = zro
    else
       temp1 = dble(ipatin(1))
       if (i-clientTarg%numZones() == 1) then
!  i = n+1; nuclear part of potential energy vanishes
          poten = temp1*clientTarg%coulombPote( clientTarg%numZones()+1 )
       else
          if (ipatin(3).ne.0) then
!  Coulomb energy only
             poten = temp1*clientTarg%coulombPote(i)
          else
             if (ipatin(4) == 0) then
!  Meson (pion binding + Coulomb energy):
                temp2 = dble(ipatin(2) - 1)
                poten = temp1*clientTarg%coulombPote(i) - &
                     & clientTarg%pionPote() * temp2
             else
!  Baryon (Coulomb + particle sep. eng. + Fermi energy)
                temp3 = dble(ipatin(4))
                poten = temp1*clientTarg%coulombPote(i) &
                     & + clientTarg%protFermiMom(i) * temp1 &
                     & + (one - temp1) * clientTarg%neutFermiMom(i) &
                     & + temp3*clientTarg%getSepEnergy()
             endif
          endif
       endif
    endif
    return
! ======================================================================
  end function poten

max_stars_repo_name: lanl/generalized-spallation-model

max_stars_repo_licenses: Intel Unlicense

max_issues_repo_name: lanl/generalized-spallation-model

max_issues_repo_licenses: Intel Unlicense

max_forks_repo_name: lanl/generalized-spallation-model

max_forks_repo_licenses: Intel Unlicense


!-----------------------------------------------------
!Module containing a few other subroutines:
!-----------------------------------------------------
!
module other_routines
implicit none
contains
!
!---------------------------------------------
!Periodic system:
!---------------------------------------------
!
subroutine periodic (atoms, masses)
Implicit none
integer, parameter :: dp = SELECTED_REAL_KIND(15)
!
    real(dp), dimension(118), intent(inout) :: masses
    character(len=3), dimension(118), intent(inout) :: atoms
!
    atoms = (/'H  ', 'He ', 'Li ', 'Be ', 'B  ', 'C  ', 'N  ', 'O  ', &
'F  ', 'Ne ', 'Na ', 'Mg ', 'Al ', 'Si ', 'P  ', 'S  ', 'Cl ', 'Ar ', &
'K  ', 'Ca ', 'Sc ', 'Ti ', 'V  ', 'Cr ', 'Mn ', 'Fe ', 'Co ', 'Ni ', &
'Cu ', 'Zn ', 'Ga ', 'Ge ', 'As ', 'Se ', 'Br ', 'Kr ', 'Rb ', 'Sr ', &
'Y  ', 'Zr ', 'Nb ', 'Mo ', 'Tc ', 'Ru ', 'Rh ', 'Pd ', 'Ag ', 'Cd ', &
'In ', 'Sn ', 'Sb ', 'Te ', 'I  ', 'Xe ', 'Cs ', 'Ba ', 'La ', 'Ce ', &
'Pr ', 'Nd ', 'Pm ', 'Sm ', 'Eu ', 'Gd ', 'Tb ', 'Dy ', 'Ho ', 'Er ', &
'Tm ', 'Yb ', 'Lu ', 'Hf ', 'Ta ', 'W  ', 'Re ', 'Os ', 'Ir ', 'Pt ', &
'Au ', 'Hg ', 'Tl ', 'Pb ', 'Bi ', 'Po ', 'At ', 'Rn ', 'Fr ', 'Ra ', &
'Ac ', 'Th ', 'Pa ', 'U  ', 'Np ', 'Pu ', 'Am ', 'Cm ', 'Bk ', 'Cf ', &
'Es ', 'Fm ', 'Md ', 'No ', 'Lr ', 'Rf ', 'Db ', 'Sg ', 'Bh ', 'Hs ', &
'Mt ', 'Ds ', 'Rg ', 'Cn ', 'Uut', 'Fl ', 'Uup', 'Lv ', 'Uus', 'Uuo'/)
!
    masses = (/1.008, 4.0026, 6.94, 9.0122, 10.81, 12.011, 14.007, 15.999, &
18.998, 20.180, 22.990, 24.305, 26.982, 28.085, 30.974, 32.06, 35.45, &
39.948, 39.098, 40.078, 44.956, 47.867, 50.942, 51.996, 54.938, 55.845, &
58.933, 58.693, 63.546, 65.38, 69.723, 72.63, 74.922, 78.96, 79.904, &
83.798, 85.468, 87.62, 89.906, 91.224, 92.906, 95.96, 97.91, 101.07, &
102.91, 106.42, 107.87, 112.41, 114.82, 118.71, 121.76, 127.60, 126.90, &
131.29, 132.91, 137.33, 138.91, 140.12, 140.91, 144.24, 144.91, 150.36, &
151.96, 157.25, 158.93, 162.50, 164.93, 167.26, 168.93, 173.05, 174.97, &
178.49, 180.95, 183.84, 186.21, 190.23, 192.22, 195.08, 196.97, 200.59, &
204.38, 207.2, 208.98, 208.98, 209.99, 222.02, 223.02, 226.03, 227.03, &
232.04, 231.04, 238.03, 237.05, 244.06, 243.06, 247.07, 247.07, 251.08, &
252.08, 257.10, 258.10, 259.10, 262.11, 265.12, 268.13, 271.13, 270.0, &
277.15, 276.15, 281.16, 280.16, 285.17, 284.18, 289.19, 288.19, 293.0, &
294.0, 294.0/)
!
end subroutine periodic
!
!--------------------------------
!CPU time:
!--------------------------------
!
subroutine CPU (start)
implicit none
!
integer, parameter :: dp = SELECTED_REAL_KIND(15)
real(dp), intent(in) :: start
real(dp) :: finish, cputime
!
call CPU_time(finish)
cputime = finish - start
write(2,*) 'CPU_TIME:', cputime
!
end subroutine CPU
!
!--------------------------------
!Print standard deviation:
!--------------------------------
!
subroutine average_dev (st, element)
implicit none
!
integer, parameter :: dp = SELECTED_REAL_KIND(15)
real(dp), intent(in) ::  st
character(len=26), intent(in) :: element
character(len=50) :: doublechar
!
write(doublechar,*) st
write(2,*) 'average deviation of the atomic positions &
    from the symmetrically perfect case for the ' // &
    adjustl(trim(element)) // ': ' // adjustl(trim(doublechar))
!
end subroutine average_dev
!
end module other_routines


text:
The Stock Judging Pavilion, as its name implies, was a place where livestock were once judged on our Cows bucolic campus. It has existed in two buildings in its history, both which are still with us. The first, which was built in 1907, used to be located roughly where the bike parking lot in front of Olson Hall is today. According to the http://centennial.ucdavis.edu/timeline/index.php?decade1960 UCD Centennial historical timeline, in 1963 the stockjudging pavilion was moved, converted into an Elizabethan theater and renamed the Wyatt Pavilion Wyatt Pavilion Theatre. The second building, which was constructed sometime between 1919 and 1923, now houses the ASUCD Bike Barn and Outdoor Adventures.

The official website for the Bike Barn actually claims that the second building was constructed in 1910;  however, this claim seems doubtful because the second building does not yet appear on the maps Sanborn fire insurance map of December 1911.  By the time the next Sanborn map was produced in 1921, the second building, labeled Stock Judging, can be clearly observed in an area right next to where the livestock was held.  At the same time, the first building was still shown in its original position.  At some point between 1921 and 1945, the original pavilion was moved so as to sit directly next to the second building, and at this point, it had apparently resumed its former functions.  The Sanborn map of 1945 refers to the first building as the stock pavilion whereas it states that the newer building was being used for storage and classroom purposes.  Based on this information, it seems reasonable to conclude that the second building was possibly intended as a temporary replacement or that the original building was preferable and people missed it enough to warrant a move to the better location which was closer to the livestock.

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


! { dg-do compile }
! PR fortran/48831
! Contributed by Tobias Burnus

program p1
    implicit none
    integer, parameter  :: i1    = kind(0)
    integer, parameter  :: i2(1) = [i1]
    integer(kind=i2(1)) :: i3

    i3 = int(0, i1)
    print *, i3

    i3 = int(0, i2(1))  ! This line gives an error when compiling.
    print *, i3
end program p1


text:
program main  ! ordered I/O with Barriers

  implicit none
  include 'mpif.h'
  integer :: size, rank, ierr
  integer :: sum, i

  call mpi_init(ierr)
  call mpi_comm_size(MPI_COMM_WORLD, size, ierr)
  call mpi_comm_rank(MPI_COMM_WORLD, rank, ierr)

  call mpi_scan(rank, sum, 1, MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierr)

  do i = 0, size - 1
     if (i == rank) then
        write(6,"(x,a,i0,a,i0)") "partial sum(", i, ") = ", sum
     endif
     call mpi_barrier(MPI_COMM_WORLD, ierr)
  enddo

  call mpi_finalize(ierr)
end

max_stars_repo_name: David-Loibl/cprog

max_issues_repo_name: David-Loibl/cprog

max_forks_repo_name: David-Loibl/cprog


text:
      SUBROUTINE vsetup (iseq_count)
      USE vmec_main
      USE vacmod
      USE realspace
      USE mgrid_mod, ONLY: nbcoil_max, nlim_max, nextcur, mgrid_mode
      USE gmres_mod, ONLY: nfcn

      IMPLICIT NONE
!-----------------------------------------------
!   D u m m y   A r g u m e n t s
!C-----------------------------------------------
      INTEGER, INTENT(IN) :: iseq_count
!      REAL(dp)            :: vseton, vsetoff
C-----------------------------------------------
!
!     Reset default initial values
!
!     m=1 constraint (=t: apply correct, polar constraint; =f, apply approx. constraint)
      lconm1 = .true.
!      lconm1 = .false.
!	IF (lrfp) lconm1 = .false.    !SPH102109 converges better

!     2d preconditioner
      nfcn = 0

      lrecon = .true.
      loldout = .false.
      ledge_dump = .false.

      z00 = zero
      mgrid_mode = 'S'             !Assume scaled mode; read in from mgrid in free-bdy mode
      nextcur = 0
!
!     SOME DEFAULT VALUES WHICH MAY BE READ IN
!

!
!     Reconstruction stuff
!
      delbsq = one
      lpofr = .true.
      imse = -1
      itse = 0
      isnodes = 0
      ipnodes = 0
      iopt_raxis = 1
      imatch_phiedge = 1
      nflxs = 0
      nbfld = 0
      mseangle_offset = zero
      mseangle_offsetm = zero
      pres_offset = zero
      sigma_current = 1.e30_dp
      sigma_delphid = 1.e30_dp
      tensi = one
      tensp = one
      tensi2 = zero
      fpolyi = one
      presfac = one
      phidiam = 1.e30_dp

      mseprof = one
      indxflx = 0
      indxbfld = 0
      sigma_stark = 1.1*cbig
      sigma_thom = 1.1*cbig
      sigma_flux = 1.1*cbig
      sigma_b = 1.1*cbig

!
!     FREE-BOUNDARY STUFF, ONLY INITIALIZED FIRST TIME
!
      IF (iseq_count .eq. 0) THEN
         nbcoil_max = 0
         nlim_max = 0
      END IF

      END SUBROUTINE vsetup

max_stars_repo_name: joseluisvelasco/STELLOPT

max_issues_repo_name: joseluisvelasco/STELLOPT


text:
      subroutine inmentat
!***********************************************************************
!  Copyright, 1993, 2004,  The  Regents of the University of California.
!  This program was prepared by the Regents of the University of
!  California at Los Alamos National Laboratory (the University) under
!  contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE).
!  All rights in the program are reserved by the DOE and the University.
!  Permission is granted to the public to copy and use this software
!  without charge, provided that this Notice and any statement of
!  authorship are reproduced on all copies. Neither the U.S. Government
!  nor the University makes any warranty, express or implied, or
!  assumes any liability or responsibility for the use of this software.
C***********************************************************************
CD1
CD1 PURPOSE
CD1
CD1 Read in geometric data generated by mentat mesh generator.
CD1
C***********************************************************************
CD2
CD2 REVISION HISTORY
CD2
CD2 Revision                    ECD
CD2 Date         Programmer     Number  Comments
CD2
CD2 21-DEC-93    Z. Dash        22      Initial implementation.
CD2
CD2 $Log:   /pvcs.config/fehm90/src/inmentat.f_a  $
!D2
!D2    Rev 2.5   06 Jan 2004 10:43:20   pvcs
!D2 FEHM Version 2.21, STN 10086-2.21-00, Qualified October 2003
!D2
!D2    Rev 2.4   29 Jan 2003 09:09:00   pvcs
!D2 FEHM Version 2.20, STN 10086-2.20-00
!D2
!D2    Rev 2.3   14 Nov 2001 13:10:16   pvcs
!D2 FEHM Version 2.12, STN 10086-2.12-00
!D2
!D2    Rev 2.2   06 Jun 2001 13:24:48   pvcs
!D2 FEHM Version 2.11, STN 10086-2.11-00
!D2
!D2    Rev 2.1   30 Nov 2000 12:03:52   pvcs
!D2 FEHM Version 2.10, STN 10086-2.10-00
!D2
!D2    Rev 2.0   Fri May 07 14:42:40 1999   pvcs
!D2 FEHM Version 2.0, SC-194 (Fortran 90)
CD2
CD2    Rev 1.2   Tue Jan 30 12:54:02 1996   hend
CD2 Updated Requirements Traceability
CD2
CD2    Rev 1.1   03/18/94 16:03:34   gaz
CD2 Added solve_new and cleaned up memory management.
CD2
CD2    Rev 1.0   01/20/94 10:25:06   pvcs
CD2 original version in process of being certified
CD2
C***********************************************************************
CD3
CD3 INTERFACES
CD3
CD3 Formal Calling Parameters
CD3
CD3   None
CD3
CD3 Interface Tables
CD3
CD3   None
CD3
CD3 Files
CD3
CD3   Name                     Use  Description
CD3
CD3   iout                     O    File used for general code output
CD3   unit 42                  I    File that contains mentat or patran mesh
CD3                                   generator geometric data
CD3
C***********************************************************************
CD4
CD4 GLOBAL OBJECTS
CD4
CD4 Global Constants
CD4
CD4   None
CD4
CD4 Global Types
CD4
CD4   None
CD4
CD4 Global Variables
CD4
CD4                            COMMON
CD4   Identifier      Type     Block  Description
CD4
CD4   cord            REAL*8   fbs    Contains the coordinates of each node
CD4   iout            INT      faai   Unit number for output file
CD4   nei             INT      faai   Total number of elements in the problem
CD4   nelm            INT      fbb    ?Nodal connectivity information
CD4   neq             INT      faai   Number of nodes
CD4   ns              INT      faai   Number of nodes per element
CD4
CD4
CD4 Global Subprograms
CD4
CD4   Identifier      Type     Description
CD4
CD4
C***********************************************************************
CD5
CD5 LOCAL IDENTIFIERS
CD5
CD5 Local Constants
CD5
CD5   None
CD5
CD5 Local Types
CD5
CD5   None
CD5
CD5 Local variables
CD5
CD5   Identifier      Type     Description
CD5
CD5   cc1             CHAR     Data content flag
CD5   i               INT      Loop index
CD5   itype           INT      ?
CD5   j               INT      ?
CD5   len             INT      ?
CD5   lenm1           INT      ?
CD5   nel             INT      ?
CD5   neref           INT      ?
CD5   node1           INT      ?
CD5   node2           INT      ?
CD5   node3           INT      ?
CD5   node4           INT      ?
CD5
CD5 Local Subprograms
CD5
CD5   Identifier      Type     Description
CD5
CD5
C***********************************************************************
CD6
CD6 FUNCTIONAL DESCRIPTION
CD6
C***********************************************************************
CD7
CD7 ASSUMPTIONS AND LIMITATIONS
CD7
CD7 None
CD7
C***********************************************************************
CD8
CD8 SPECIAL COMMENTS
CD8
CD8  Requirements from SDN: 10086-RD-2.20-00
CD8    SOFTWARE REQUIREMENTS DOCUMENT (RD) for the
CD8    FEHM Application Version 2.20
CD8
C***********************************************************************
CD9
CD9 REQUIREMENTS TRACEABILITY
CD9
CD9 2.6 Provide Input/Output Data Files
CD9 3.0 INPUT AND OUTPUT REQUIREMENTS
CD9
C***********************************************************************
CDA
CDA REFERENCES
CDA
CDA None
CDA
C***********************************************************************
CPS
CPS PSEUDOCODE
CPS
CPS BEGIN  inmentat
CPS
CPS
CPS   REPEAT
CPS     read data content flag
CPS   UNTIL connectivity data is found
CPS
CPS   read element information
CPS   IF 2D elements
CPS      set number of nodes per element to 4
CPS   ELSE if 3D elements
CPS      set number of nodes per element to 8
CPS   ENDIF
CPS
CPS   rewind to beginning of last line read
CPS   FOR each element
CPS       read element number, type, and nodal connectivity information
CPS   ENDFOR
CPS
CPS   IF 2D elements
CPS
CPS      FOR each element
CPS          check for triangles
CPS          IF triangular elements
CPS             set length between common nodes to zero
CPS          ENDIF
CPS      ENDFOR
CPS
CPS   ELSE if 3D elements
CPS
CPS      FOR each element
CPS          reorder nodal connections
CPS          check for prisms
CPS          IF prism elements
CPS             set length between common nodes to zero
CPS          ENDIF
CPS      ENDFOR
CPS
CPS   ENDIF
CPS
CPS   REPEAT
CPS     read data content flag
CPS   UNTIL coordinate data is found
CPS
CPS   set node count to zero
CPS   read data content flag
CPS
CPS   LOOP
CPS     read data content flag
CPS   EXITIF end of coordinate data
CPS     rewind to beginning of last line read
CPS     increment node count
CPS     read node number and coordinate (x, y, z) values
CPS   END LOOP
CPS
CPS END  inmentat
CPS
C***********************************************************************

      use combi
      use comdti
      use comai
      implicit none

      integer i, itype, j, len, lenm1, nel, neref
      integer node1, node2, node3, node4

      character*10  cc1

c**** input to read mesh file from mentat mesh generator ****

 10   continue
      read (42, '(a10)')  cc1
      if (cc1 .ne. 'connectivi')  go  to  10

c**** read element information ****

      read (42, *)   nei
      read (42, *)   nel, itype

      if (itype .eq. 11)  then
c**** 2-d elements ****
         ns     =  4
      else
c**** 3-d elements ****
         ns     =  8
      end if

      backspace  42

c**** read in element ****

      do   i = 1, nei
         read (42, *) nel, itype,
     *        (nelm((nel - 1) * ns + j), j = 1, ns)
      end do

c**** check for triangles or prisms ****

      if (ns .eq. 4)  then
         do i = 1, nei
            len    =  (i - 1) * ns + ns
            lenm1  =  len - 1
            if (nelm(len) .eq. nelm(lenm1))  nelm(len) =  0
         end do
      else
         if (ns .eq. 8) then
            do i = 1, nei
               neref         =  (i - 1) * ns
               node1         =  nelm(neref + 1)
               node2         =  nelm(neref + 2)
               node3         =  nelm(neref + 3)
               node4         =  nelm(neref + 4)
               nelm(neref + 1) =  nelm(neref + 5)
               nelm(neref + 2) =  nelm(neref + 6)
               nelm(neref + 3) =  nelm(neref + 7)
               nelm(neref + 4) =  nelm(neref + 8)
               nelm(neref + 5) =  node1
               nelm(neref + 6) =  node2
               nelm(neref + 7) =  node3
               nelm(neref + 8) =  node4
               len   = (i - 1) * ns + ns
               lenm1 = (len - 1)
               if (nelm(len) .eq. nelm(lenm1)) then
                  nelm(len )  =  0
                  nelm(lenm1) =  0
               end if
            end do
         end if
      end if

c**** read in coordinates ****

 40   continue
      read (42, '(a10)')  cc1
      if (cc1 .ne. 'coordinate')  go  to  40

      neq    =  0
      read (42, '(a10)')  cc1

 41   continue
      read (42, '(a10)')  cc1
      if ((cc1 .eq. 'property  ') .or. (cc1 .eq. 'end option')) then
         go to 12
      end if
      backspace  42
      neq  =  neq + 1
      read (42, *)  j, cord(j, 1), cord(j, 2), cord(j, 3)
      go  to  41

 12   continue

      end

max_stars_repo_name: satkarra/FEHM

max_issues_repo_name: satkarra/FEHM

max_forks_repo_name: satkarra/FEHM


text:
c     Subroutine to read in last file number
c     AJ_Kettle, 16Mar2019
c     10Apr2020: used for 01May2020 release

      SUBROUTINE readin_lastfile_number(s_directory_lastfile,
     +  i_start)

      IMPLICIT NONE
c************************************************************************
c     Variables passed into program

      CHARACTER(LEN=300)  :: s_directory_lastfile
      INTEGER             :: i_start
c*****
c     Variables used within subroutine

      INTEGER             :: i,j,k,ii,jj,kk
      INTEGER             :: io
      LOGICAL             :: there
      INTEGER             :: i_last_index
c************************************************************************
c      print*,'just entered readin_lastfile_number'

c      print*,'s_directory_lastfile',TRIM(s_directory_lastfile)
c      print*,'i_start=',i_start

c      i_start_index=0     !initial to 0

c     Inquire if file exists
      INQUIRE(FILE=TRIM(s_directory_lastfile)//'lastfile.dat',
     +  EXIST=there)

c     assign starting index if file does not exist
      IF (.NOT.there) THEN
       i_start=1
      ENDIF

c     get starting index if file exists
      IF (there) THEN
       OPEN(UNIT=1,FILE=TRIM(s_directory_lastfile)//'lastfile.dat',
     +  FORM='formatted',STATUS='OLD',ACTION='READ')

c      Read header
       READ(1,1000,IOSTAT=io) i_last_index
 1000  FORMAT(t3,i10)

c       print*,'i_last_index=',i_last_index

       i_start=i_last_index+1

       CLOSE(UNIT=1)
      ENDIF

c      print*,'i_start=',i_start

c      print*,'just leaving reading_lastfile_number'
c      STOP 'readin_lastfile_number'

      RETURN
      END

max_stars_repo_name: glamod/glamod-nuim

max_issues_repo_name: glamod/glamod-nuim

max_forks_repo_name: glamod/glamod-nuim


text:
!
! The Laboratory of Algorithms
!
! The MIT License
!
! Copyright 2011-2015 Andrey Pudov.
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the 'Software'), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
! THE SOFTWARE.
!

module MERubiksCubeSearch

    use MERubiksCubeCommon
    use MERubiksCubeCube
    use MERubiksCubeRotator

    use iso_fortran_env
    use omp_lib

    implicit none
    private

    type, public :: TESearch
    contains
        procedure, nopass :: search
    end type
contains
    !
    ! Searches for desired state of a cube and returns true if solution is
    ! found, and false otherwise.
    !
    ! source      - the source state of a cube.
    ! destination - the desired state of a cube.
    ! mask        - the mask to compare states.
    ! rotations   - the list of available rotations.
    ! depth       - the maximum number of steps.
    !
    ! status      - return true if solution is found, and false otherwise.
    !
    function search(source, destination, mask, rotations, depth) result(status)
        integer, dimension(:), intent(in) :: source
        integer, dimension(:), intent(in) :: destination
        logical, dimension(:), intent(in) :: mask
        integer, dimension(:), intent(in) :: rotations
        integer, intent(in)               :: depth

        integer, dimension(0:depth) :: buffer
        integer, dimension(1:depth) :: sequence

        type(TECube)     cube
        type(TERotator)  rotator

        integer(kind=int64) expectation, count
        integer index, jndex
        logical masked
        logical status

        ! array dividing parameters
        integer nthreads, threadid
        integer start, end
        real    divider

        ! seach elapsed time
        real(kind=real64) :: time1, time2

        cube    = TECube()
        rotator = TERotator()

        masked = .not. all(mask == .true.)
        status = SOLUTION_NOT_FOUND

        print '(A)', 'Initial state: '
        call cube%set(source)
        call cube%print()
        print '(X)'

        print '(A)', 'Desired state: '
        call cube%set(destination)
        call cube%print()
        print '(X)'

        if (masked) then
            print '(A)', 'Comparison mask: '
            call cube%set(mask + 6)
            call cube%print()
            print '(X)'
        end if

        time1 = omp_get_wtime()

        !$omp parallel private(cube, buffer, nthreads, threadid, start, end, divider, expectation, count)

        nthreads = omp_get_num_threads()
        threadid = omp_get_thread_num()
        buffer   = 0
        start    = -1
        end      = -1

        expectation = size(rotations) ** depth / nthreads
        if (expectation == 0) then
            print '(A)', 'Search in progress... (status is unavailable)'
        end if

        ! iterate over possible rotations
        do while ((buffer(0) == 0) .and. (buffer(1) /= end))
            if (start == -1) then
                divider = size(rotations) / real(nthreads)
                start   = floor(divider * threadid + 1.0)
                end     = ceiling(start + divider - 1)

                buffer(1) = start - 1
            end if

            ! begin rotation sequence
            call cube%set(source)

            !print '(\A3)', CUBE_ROTATIONS(rotations(buffer(1:depth) + 1))
            do index = 1, depth
                call rotator%rotate(cube, rotations(buffer(index) + 1))

                ! validate current and destired states
                if (all((cube%get() - destination) == 0)) then
                !if (all(((cube%get() - destination) * mask) == 0) &
                !        .and. .not. all((cube%get() - destination) == 0)) then
                    print '(A)', 'Desired pattern found.'
                    print '(\A3)', CUBE_ROTATIONS(rotations(buffer(1:depth) + 1))
                    print '(X)'
                    sequence = buffer(1:depth) + 1
                    jndex = rotator%optimize(sequence, rotations)
                    print '(\A3)', CUBE_ROTATIONS(rotations(sequence(1:jndex)))
                    print '(X/)'

                    status = SOLUTION_FOUND
                end if
            end do

            !omp flush(status)
            !if ((status == SOLUTION_FOUND) .and. (masked == .false.)) then
            !    buffer(1) = end
            !end if

            count = count + 1
            !print '(X)'

            !omp master
            !if ((mod(count, 2500000) == 0) .and. (expectation /= 0)) then
            !    print '(\A,I3,A)', 'Search in progress... ', (count * 100 / expectation), '%'
            !    print '(\A)', achar(13)
            !end if
            !omp end master

            buffer(depth) = buffer(depth) + 1
            jndex = depth
            do while (buffer(jndex) == size(rotations))
                buffer(jndex) = 0
                jndex = jndex - 1
                buffer(jndex) = buffer(jndex) + 1
            end do
        end do

        !$omp end parallel

        if (status == SOLUTION_NOT_FOUND) then
            print '(A)', 'Desired pattern doesn''t found.'
        end if

        time2 = omp_get_wtime()
        print '(X/,A,F0.3,A)', 'Elapsed time: ', time2 - time1, 's.'
    end function
end module

max_stars_repo_name: andreypudov/Algorithms

max_issues_repo_name: andreypudov/Algorithms

max_forks_repo_name: andreypudov/Algorithms


text:
       implicit double precision (a-h,o-z)
       common /factl/ fact(0:100)
       common /herm/ h(0:100)
       dimension wf(0:100,1000),ddwf(0:100,1000)
       dimension xx(1000),yy(1000)
       dimension dy(1000),ddy(1000)
       dimension ham(200,200)
       pi=4.0d0*datan(1.0d0)
       read(*,*)nmax
       call factorial(nmax)
       nx=301
       xmin=-15.d0
       xmax=+15.d0
       xinc=(xmax-xmin)/dfloat(nx-1)
       x=xmin
       do i=1,nx
         xx(i)=x
         call hermite(nmax,x)
         do n=0,nmax
           wf(n,i)=dsqrt(1.0d0/(2.0d0**n*dsqrt(pi)*fact(n)))*
     &       dexp(-x*x/2.0d0)*h(n)
         end do
         ddwf(0,i)=(x**2-1.0d0)*wf(0,i)
         ddwf(1,i)=-dsqrt(8.0d0)*x*wf(0,i)+(x**2-1.0d0)*wf(1,i)
         do n=2,nmax
           ddwf(n,i)=2*dsqrt(dfloat(n*(n-1)))*wf(n-2,i)
     &             -dsqrt(dfloat(8*n))*x*wf(n-1,i)
     &             +(x**2-1.0d0)*wf(n,i)
         end do
         x=x+xinc
       end do
       do n=0,nmax
         do i=1,nx
           yy(i)=wf(n,i)
         end do
         call splderiv(xx,yy,1000,nx,dy)
         call splderiv(xx,dy,1000,nx,ddy)
         do i=1,nx
c           print *, i,ddwf(n,i),ddy(i)
c           ddwf(n,i)=ddy(i)
         end do
       end do
       do n=0,nmax
         do n1=0,nmax
           do i=1,nx
             yy(i)=wf(n1,i)*xx(i)**2/2.0d0*wf(n,i)
           end do
           ppe=simp(xx,yy,nx)
           do i=1,nx
             yy(i)=-wf(n1,i)*ddwf(n,i)/2.0d0
c             write(*,*)i,xx(i),yy(i)
           end do
           rke=simp(xx,yy,nx)
           write(*,'(1x,2i2,2f8.4)')n,n1,ppe,rke
           ham(n+1,n1+1)=rke+ppe
         end do
       end do
       do n=0,nmax
         write(*,'(1x,200f8.4)')(ham(n+1,n1+1),n1=0,nmax)
       end do

       end

       subroutine factorial(n)
       implicit double precision (a-h,o-z)
       common /factl/ fact(0:100)
       fact(0)=1
       do i=1,n
         fact(i)=fact(i-1)*i
       end do
       end

      subroutine hermite(n,x)
      implicit real*8 (a-h,o-z)
      common /herm/ h(0:100)
      h(0)=1.0d0
      h(1)=2.0d0*x
      do i=2,n
        h(i)=2.0d0*x*h(i-1)-2.0d0*(i-1)*h(i-2)
      end do
      end

      real*8 function simp(x,y,n)
      implicit real*8 (a-h,o-z)
      dimension x(1000),y(1000)
      h=dabs(x(n)-x(1))/dfloat(n-1)
      sum=0.0d0
      do i=1,n/2
         sum=sum+y(2*i-1)+4.0d0*y(2*i)+y(2*i+1)
      end do
      simp=sum*h/3.0d0
c      write(*,'(1x,i5,6f12.6)')n,x(1),y(1),x(n),y(n),h,sum
      end


text:
All Things Right And Relevant is a large consignment store in which all profits go towards funding mental health programs in Yolo County. Its partnered with the R & R Thrift next door. It has a novel pricing system where every tag has three prices each associated with a date range. The longer an item sits on the shelf, the cheaper it is.  If the item expires (passes the latest date on the tag) or isnt of high enough quality, it goes next door to R & R Thrift.

They stock furniture, collectibles, as well as clothing for men, women and children.  They also sell a generous selection of Sees candies.

The store is operated by mental health clients.

 Consigning

Consigning is a quick and easy way to get a little money from items you no longer need or want.

R&R accepts gift quality items for consignment. Clothing should be in excellent condition, clean, pressed, and in season and style.  Nonclothing items should be in good repair, clean, and free of dust and dirt.

They do not accept unframed prints, bed parts and mattresses, used computers, televisions, fax machines, other electronic equipment, used electrical equipment, nonfunctional appliances, radio and stereo equipment, telephones or answering machines, typewriters, hair dryers, curling irons, childrens toys with wheels or multiple parts, or anything with a value less than $2.00. They only accept 10 things per person, per consignment day. They also only accept seasonal clothing (i.e. no winter clothing accepted in spring).

Anything that doesnt meet consignment guidelines is considered a donation to R&R. They do not review items at the time of consignment, so dont consign anything youre not prepared to donate! You can call to get your consignment balance over the phone.

Normal consignment hours are Tuesday, Thursday & Saturday from 11:00 until 1:00 and again on Thursday from 67 p.m. if they have space in the store.  Go to the consignment door (between them and R&R Thrift), get a pink (for clothing) or blue (for everything else) consignment sheet, and fill it out. You can take extras home to fill out ahead of time, or print the sheet off of their website (www.rrconsignments.org). Put clothing on the clear plastic hangers provided, then hang them on the rack inside the door (or wherever the volunteers direct you). Pin the consignment sheet to one of the items with a provided clothespin.

Proceeds from the sale of consigned items are split 46/54 between the consignor and R&R, respectively. This is calculated using the actual cost the item sold for, so if it sells on a sale day, youll get less. Payment is made via cash or check at the register. If your item is not sold, you may pick it up anytime within 29 days from the time its consigned. After 29 days, they become property of R&R.

 History

All Things Right And Relevant used to be located at 1640 East 8th St. in the Davis Manor Center Davis Manor shopping center before moving to their current location in April 2012. (http://www.davisenterprise.com/localnews/allthingsrightandrelevanttoopeninnewlocationtuesday/ see story here).

For older reviews see All Things Right And Relevant/20072008 Reviews Reviews from 20072008

20090724 22:21:31 nbsp I havent sold anything on consignment here but I do want to put in a plug for this shop because they have nice stuff and take the time to organize and arrange it well.  I also like the sliding scale price where it goes down after a certain date.  I shop here, even with higher prices than other thrift stores, because I like that they support a variety of local organizations and even staff some members who benefit from those organizations.  I think it is fine they are picky about protocol on how to make a donation, it saves everybodys time in the long run! Thanks for being in Davis, R&R. Users/dandysgirl

20091013 14:21:26 nbsp I gave Right and Relevant some of my clothes to sell on consignment.  When I went to check on my items they were not on the racks (I searched every piece of clothing in the place) and they had not sold the items that were missing.  Basically I had two pairs of shoes and a pair of designer jeans stolen.  I told a family friend who used to volunteer there and she told me it happens there all the time.  The employees are aware of the problem and they even know who the thieves are.  They feel if people are stealing they really must need the items.  Hey managementif people are selling their clothes they must need the money as well.  Also, do people in need, need to have designer jeans and expensive shoes?  There is a thrift store right next store.  I warn you, DO NOT GIVE THEM YOUR CLOTHES!  The store Nina and Tom, located at 129 E Street, just recently started doing consignment.  When I took clothes to Nina and Tom they sold two pieces in the first hour they were there!!  Once again, if you dont want your clothes stolen DO NOT GO TO ALL THING RIGHT AND RELEVANT! Users/Bear47

20091103 06:18:39 nbsp I am new at consigning with R & R and I have to agree with most of the comments. I have consigned brand new merchandise with tags and very slightly worn clothing, only to not see it on the racks or on my account.  I am saddened by this type of business because I drive pretty far for the cause. Also, the last couple of times I have been in there they have not been giving out print outs on what has been sold.  Shame, Shame, Shame Users/jackieshowel

20091120 14:51:43 nbsp I dont consign, I just brought stuff there and was happy to find a used Coach bag for $8! :) They do have great stuff sometimes.  Users/val

20091203 07:23:02 nbsp I am really grateful that Nina and Tom have realized how much Davis needed a better consignment store. They tell you what theyll take right at the door and call you if your things dont sell. Its a much more honest model (and I think as a result theyre going to attract more and more of the better clothing in Davis used clothing supply). No one has to worry about their best consignments being pilfered anymore! Users/calvin2

20100107 20:29:30 nbsp I have been in here several times.  The selection is not very good and it is pricey because it is consignment shop.  The clothes are usually cheaper brands and more for an older crowd. Go to SPCA thrift.  R&R is a much better space, but the selection at SPCA is far better.   By the way, the employees here are not very friendly at all.  Often they wont even acknowledge you when you enter or are shopping in the store.  Users/stodd84

20100127 17:46:01 nbsp They offered to hold my bicycle pannier, which they referred to as a No Backpack Policy backpack, at the counter while I shopped. I declined their offer and left instead. I guess they can be added to the list of businesses that it isnt convenient to shop at if you are on bike and dont have a car to leave you possessions in. Users/JasonAller

20100127 17:53:19 nbsp I cant imagine why anyone would ever consign anything here, as they say right up front that they basically feel that they have the right to just take anything they want for any reason and call it a donation.

Not a bad place to shop, however.  I bought a very nice silver dish here for a very good price.  Im guessing it was a donation. Users/rfrazier

20100128 18:00:43 nbsp I am currently volunteering here and I am impressed at how many people actually shop/ consign here. I didnt know this place existed until about a month ago. Just to clear up some stink on the consignments. The volunteers/ staff who are determining whether or not your items are worthy for consignment are very honest people. I personally have witnessed the process they go through to decide whether or not the items will be consigned. A lot of the time there are good items declined because the consignee failed to make sure the clothing was washed etc. If the clothing has anything wrong with it, they will not put it on the floor to sell.  Users/TICKtacTOEtag

20100217 14:21:00 nbsp All Things Right and Relevant is grateful for the chance to respond to the concerns expressed in wiki’s comments
Our employees and volunteers work to process an enormous number of items within a 24hour period. Many items consigned are not acceptable. Even new items with tags can be rejected for stains, missing buttons or broken zippers. We do not accept these items in R&R Thrift; they are sent to other charities.
We are trying to accommodate our consigners by offering them a precheck so consignors will know which items are accepted for consignment.
We have taken away the consignment fees.
We are addressing theft issues, including, beginning in March, monitoring our dressing rooms.
If problems arise, tell us. We may not be able to solve everything, but if you don’t tell us what’s wrong, we can’t solve anything.
Come in and ask to speak to the manager.
Call us at 5307599648.
Email us at rightandrelevant@gmail.com
 Users/R&R

20100217 18:34:11 nbsp I started volunteering at R&R almost a year ago.  It has been an extremely positive experience for me. I have met customers, employees, and other volunteers most of whom feel like a warm and welcoming family. The people who work there are honest, caring, and really conscientious about consignors items and issues. In this busy place it is common to hear people say this is my favorite store. I also consign some things occasionally and have never been treated unfairly.  Im impressed by R&Rs response to some pretty harsh criticism. They are actively and openly addressing issues while continuing to keep their focus on the mental health programs they help fund. Im proud and grateful to work there. Thanks R&R!  Barb Users/BBBMac

20100323 13:45:16 nbsp Youve heard of Nightmare on Elm St? R&R is nightmare on 8th St.  Truth is I really do like buying things there, but they are so anal about the rules there that its ridiculous!  And the rules change....sometimes arbitrarily. I have a friend who use to volunteer there and felt like they were sticklers with the rules for consigners but then priced and placed things in a very unfair manner.  I just spend over and hour there trying to consign stuff and then they would not let me use $1.20 that was in my account because I didnt have my ID with me (thats the first time theyve asked for ID in 8 years). Then when I started to get upset about the process, the staffer trying to sound empathic but sounding more like a psychology parody said, you seem like youre having a hard day. LOL  Well, duh...  I felt the precious minutes of my life being wasted....Time for a new game plan! Users/deetales

20100711 07:10:21 nbsp I havent sold anything here, though I have at My Sisters Closet in Woodland, so I get the jist.
Even though I KNOW its a consignment shop, why, oh why, was there a $3,000 CHAIR IN THERE?! It wasnt vintage, it had no stats on why it should be that much. Whaaat. Someones asking for way too much. I did however, find a nice faux leather (nonbranded, though :/) teal purse there for like $8, that was a really bitchin deal. Users/Mogitha

20100716 17:24:42 nbsp Caution! I consigned a beautiful new coat here, with the tags still on, and it disappeared. Based on comments below I believe that staff/volunteers grabbed it and returned it to the store I bought it at, pocketing the money. I dont go there anymore, which is a shame because they do have a lot of nice stuff. Users/JasperD

20130630 01:17:03 nbsp I got a lot of nice maternity clothes here when I was pregnant. Users/AmyHuey

20140204 12:33:50 nbsp Just completed my first consignment experience...and Im delighted!  It was quick and easy to submit my 20 items over the course of two days, and I just picked up a check for $55. Way better than a yard sale!!  Users/Linda


        !COMPILER-GENERATED INTERFACE MODULE: Fri May 22 16:59:06 2020
        ! This source file is for reference only and may not completely
        ! represent the generated interface used by the compiler.
        MODULE DESFXY__genmod
          INTERFACE
            SUBROUTINE DESFXY(X,Z,ICAS,UX,UZ,SX,SZ,SXZ,A1,B1,A2,B2,AL,AK&
     &,AM,RLM)
              REAL(KIND=8) :: X
              REAL(KIND=8) :: Z
              INTEGER(KIND=4) :: ICAS
              COMPLEX(KIND=8) :: UX
              COMPLEX(KIND=8) :: UZ
              COMPLEX(KIND=8) :: SX
              COMPLEX(KIND=8) :: SZ
              COMPLEX(KIND=8) :: SXZ
              REAL(KIND=8) :: A1
              REAL(KIND=8) :: B1
              COMPLEX(KIND=8) :: A2
              COMPLEX(KIND=8) :: B2
              COMPLEX(KIND=8) :: AL
              COMPLEX(KIND=8) :: AK
              COMPLEX(KIND=8) :: AM
              REAL(KIND=8) :: RLM
            END SUBROUTINE DESFXY
          END INTERFACE
        END MODULE DESFXY__genmod