text:
	SUBROUTINE IP_HELP  ( pname, pagflg, iret )
C************************************************************************
C* IP_HELP								*
C*									*
C* This subroutine writes a help file for a variable, unless PNAME	*
C* is blank.  In that case, help for the program will be written.	*
C*									*
C* IP_HELP  ( PNAME, PAGFLG, IRET )					*
C*									*
C* Input parameters:							*
C*	PNAME		CHAR*		Variable			*
C*	PAGFLG		LOGICAL		Flag to indicate paging		*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code			*
C*				   	  0 = normal return 		*
C*					 -6 = no help available		*
C**									*
C* Log:									*
C* M. desJardins/GSFC	 6/88	Added non-TAE subs			*
C* M. desJardins/GSFC	 4/90	Added call to FL_INQR			*
C* M. desJardins/GSFC	 7/90	Added help on program			*
C* M. desJardins/GSFC	10/90	Fix help for GFUNC, GVECT, TRACEx	*
C* M. desJardins/NMC	 1/92	Change so that HELP alone gives NOTAE 	*
C*				help; also combine NT_HELP & NT_PHLP	*
C* M. desJardins/NMC	 2/92	Fix for ambiguous parameters		*
C* K. Brill/NMC		 5/93	Remove unneeded ST_LCUC & ST_LSTR	*
C* S. Jacobs/NMC         2/94   Added file name return to FL_INQR       *
C* K. Tyle/GSC		 7/96	Renamed from NT_HELP			*
C* S. Jacobs/NCEP	 7/96	Changed environ vars to "$.../" format	*
C* K. Tyle/GSC		 2/97	Search current directory for .hl2, .hlp	*
C* T. Piper/SAIC	02/04	Changed the location of help files	*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'ipcmn.cmn'
C*
	CHARACTER*(*)	pname
	LOGICAL		pagflg
C*
	CHARACTER	hlpfil*72, record*80, ppp*12, answer*12,
     +			newfil*132
	LOGICAL		exist
C-----------------------------------------------------------------------
	iret = 0
C
C*	Get variable for help.
C
	CALL ST_LDSP  ( pname, ppp, lenin, ier )
C
C*	If general help was requested, get help on program.
C
	IF  ( lenin .eq. 0 )  THEN
	    ppp = 'NOTAE'
	    hlpfil = '$GEMHLP/hlp/NOTAE.HLP'
	    CALL FL_INQR  ( hlpfil, exist, newfil, ier )
	  ELSE
C
C*	    Check for abbreviation.
C
	    CALL IP_FVAR  ( ppp, ifound, ier )
C
C*	    If this is not a parameter, maybe it it a program.
C
	    IF  ( ier .ne. 0 )  THEN
		iret = ier
		RETURN
	      ELSE IF  ( ifound .ne. 0 )  THEN
		ppp = cparmn ( ifound )
		CALL ST_LSTR  ( ppp, lenin, ier )
	    END IF
C
C*	    Check for the special case of GFUNC or GVECT or TRACE.
C
	    IF  ( ( ppp .eq. 'GFUNC' ) .or. ( ppp .eq. 'GVECT' ) )
     +		       THEN
		ppp = 'GPARM'
		lenin = 5
	      ELSE IF  (  ppp (1:5) .eq. 'TRACE' )  THEN
		ppp = 'TRACE'
		lenin = 5
	    END IF
C
C*	    Check for .HL2 file in current directory.
C
	    hlpfil = ppp ( : lenin ) // '.HL2'
C
C*	    Inquire whether the file is available.
C
	    CALL FL_INQR  ( hlpfil, exist, newfil, ier )
C
C*	    If the file is not found, check $GEMHLP directory.
C
	    IF  ( .not. exist )  THEN
	    	hlpfil = '$GEMHLP/hlx/' // ppp ( : lenin ) // '.HL2'
	    	CALL FL_INQR  ( hlpfil, exist, newfil, ier )
	    END IF
C
C*	    If the file is not found, maybe it is a program.
C
	    IF  ( .not. exist )  THEN
		hlpfil = ppp ( : lenin ) // '.HLP'
		CALL FL_INQR  ( hlpfil, exist, newfil, ier )
	    END IF
C
C*	    If the file is not found, check $GEMHLP directory.
C
	    IF  ( .not. exist )  THEN
		hlpfil = '$GEMHLP/hlp/' // ppp ( : lenin ) // '.HLP'
		CALL FL_INQR  ( hlpfil, exist, newfil, ier )
	    END IF
	END IF
C
C*	If the file does not exist, write an error message and return.
C
	IF  ( .not. exist )  THEN
	    ier = -6
	    CALL ER_WMSG  ( 'IP', ier, ppp, ierr )
	    RETURN
	END IF
C
C*	Open the help file and check for error.
C
	CALL FL_SOPN  ( hlpfil, lun, iret )
	IF  ( iret .ne. 0 )  RETURN
C
C*	Read a record and write it to the terminal.
C
	iostat = 0
	knt    = 0
	IF  ( pagflg )  THEN
	    maxknt = 30
	  ELSE
	    maxknt = 100000
	END IF
	DO WHILE  ( iostat .eq. 0 )
C
C*	    Page if too many lines have been written.
C
	    IF  ( knt .ge. maxknt )  THEN
		CALL TM_PROM ( 'Enter <CR> to page',
     +				.false., .false., ier )
		CALL TM_RCHR ( answer, ier )
		IF  ( ier .eq. 2 )  THEN
		    iostat = -1
		END IF
		knt = 0
	    END IF
	    knt = knt + 1
	    IF  ( iostat .eq. 0 )  THEN
		READ ( lun, 2000, IOSTAT = iostat ) record
2000		FORMAT ( A )
	    END IF
	    IF  ( iostat .eq. 0 )  THEN
		CALL ST_LSTR  ( record, lenr, ier )
		IF  ( lenr .eq. 0 )  lenr = 1
		WRITE  (  6,  2001 ) record ( : lenr )
2001		FORMAT ( 1X, A )
	    END IF
	END DO
C
C*	Close the file.
C
	CALL FL_CLOS  ( lun, ier )
C*
	RETURN
	END

ext: f

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
      integer y1(4),y2(4,4),y3(4,4,4),y4(4,4,4,4),
     . y5(4,4,4,4,4),y6(4,4,4,4,4,4),y7(4,4,4,4,4,4,4)
      integer y1max,y2max,y3max,y4max,y5max,y6max,y7max
      parameter(y1max=4,y2max=10,y3max=20,y4max=35,y5max=56,y6max=84,
     .          y7max=120)
      common/ydef/y1,y2,y3,y4,y5,y6,y7
!$omp threadprivate(/ydef/)

max_stars_repo_name: tmartini/JHUGen

max_issues_repo_name: tmartini/JHUGen

max_forks_repo_name: tmartini/JHUGen


text:
Loquat trees (Eriobotrya japonica) are indigenous to southeastern China and have been cultivated in Japan for over 1,000 years. In Cambodia, the fruit is reffered to as PlyYeloe. Well suited to our California climate, loquats have been grown here since about 1870, and will fruit as long as the weather climate is neither too cool nor excessively humid; though loquats will produce in Davis, extreme heat can be detrimental and dry, hot winds will scorch foliage.

The loquat is a large evergreen shrub or small tree that typically grows to about ten feet, though it has been known to grow up to thirty feet. This shallowrooted tree is often used as an ornamental for the tropical look of its thick leaves, which  are generally 5 to 12 inches long, dark green and glossy on the upper surface with parallel veining. Small, white, fragrant flowers are borne in fall/early winter in panicles at the ends of the branches, giving way to one to twoinch oval yellowish clustering fruit in the summer (March through June in Davis). The succulent, mildly sweet flesh is whitishyellow or orange with each fruit containing three to five large brown seeds. Loquat fruits should be allowed to ripen fully before harvesting about 90 days from full flower opening until the fruits begin to soften. The loquat is often eaten as a fresh fruit and can also be used to make Alcohol wine.

The loquat is normally pollinated by Honeybees bees but some cultivars are selfinfertile; to ensure fruiting, interplant with another cultivar. Loquats are wind tolerant and grow best in full sun, but also do well in partial shade and are tolerant of a variety of soil types with good drainage. Loquat trees can withstand drought, but prefer regular, deep watering. Light applications of nitrogen fertilizers one to threetimes per year are suggested  too much nitrogen will reduce flowering. Loquats also respond well to severe pruning, which should be done just after harvest.

In California few pests bother loquats. Occasionally infestations of scale insects black scale may appear, fruit flies can be a serious pest, birds and bird watching birds will peck at the ripe fruit and deer will browse on the foliage. Unfortunately, http://ipm.ucdavis.edu/PMG/PESTNOTES/pn7414.html fire blight disease can cause rapid dieback of loquats locally. Prune out affected branches at the first sign of the disease.

On campus, you can find at least one loquat tree planted against the back entrance of the Botanical Conservatory amidst a large grouping of flowering maple flowering maples, while the Cruess Hall courtyard holds several along its western periphery. For a listing of other plants found growing in Davis, visit our Town Flora.  Outside of campus, you can find a loquat tree on Anderson near Covell, and in several places around the North Davis Greenbelt (most prominently behind Suntree Apartments).
Visit http://maps.google.com/maps/ms?hlen&glus&ieUTF8&msa0&msid101873520512973484071.0004444583b8984b4b0eb here for a google map of fruit trees in Davis.  The map is public and collaborative, so please add trees if you know of their locations.  (You must have a google signin.)  Use pushpins to mark the locations of trees.  If the tree is on private property, please indicate that in the note, and only mark it after getting permission from the owner first.

While the loquat trees themselves may be wind tolerant, the fruit is easily susceptible to bruising.  During heavy gusts, ripe fruit may bruise while still on the tree.  New growth on a loquat tree is typically lighter green than mature leaves.

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
module rancom
implicit none
save
real(kind=8) :: RANLST(100)
integer(kind=8) :: ISEED3(8),IBFCTR
contains

SUBROUTINE RANDST(ISEED)
real :: diff
integer(kind=8) :: is,iseed
integer :: i
IBFCTR = 256
IS=ISEED
DO I=1,8
   ISEED3(I)=MOD(IS,IBFCTR)
   IS=IS/IBFCTR
enddo
DO I=1,8
   ISEED3(I) = ISEED3(I) + ISEED3(I)
enddo
DO I=1,8
   diff=ISEED3(I)-IBFCTR
   do while(diff>=0)
      ISEED3(I) = ISEED3(I) - IBFCTR
      ISEED3(I+1) = ISEED3(I+1) + 1
      diff=ISEED3(I)-IBFCTR
   enddo
enddo
ISEED3(1) = ISEED3(1) + 1
DO I=1,8
   diff=ISEED3(I)-IBFCTR
   do while(diff>=0)
      ISEED3(I) = ISEED3(I) - IBFCTR
      ISEED3(I+1) = ISEED3(I+1) + 1
      diff=ISEED3(I)-IBFCTR
   enddo
enddo
DO I=1,100
   RANLST(I)=RAND1(ISEED3)
enddo
end SUBROUTINE RANDST

FUNCTION RAND0(IDUM)
integer :: idum,j
real(kind=8) :: rand0
J=INT(99E0*RANLST(100))+1
RAND0 = RANLST(100)
RANLST(100)=RANLST(J)
RANLST(J)=RAND1(ISEED3)
END FUNCTION RAND0

FUNCTION RAND1(ISEED)
integer(kind=8) :: ip
integer :: i,j,k
real :: bi,rand1
integer(kind=8) :: iseed(8),IA(8),IC(8),ID(8)
DATA IA/45,127,149,76,45,244,81,88/
DATA BI/3.90625D-3/

ID=0
IC=0
big: DO J=1,8
   middle: DO I=1,9-J
      K=J+I-1
      IP=IA(J)*ISEED(I)
      do while(k<=8)
         IP=IP+ID(K)
         ID(K)=MOD(IP,IBFCTR)
         IP=IP/IBFCTR
         IF (IP==0) cycle middle
         k=k+1
       enddo
   enddo middle
enddo big
iseed=id

RAND1=FLOAT(ISEED(1))
DO I=2,8
   RAND1=FLOAT(ISEED(I))+RAND1*BI
enddo
RAND1=RAND1*BI
END FUNCTION RAND1

end module rancom

program initialqv
use constants
use atsymb
use rancom
implicit none
! program to calculate initial q and v for a drc mopac run
! Activate with a microcanonical ensemble
! enmta is the energy of the microcanonical ensemble in kcal/mol
! nmbar is the number of normal modes of the molecule
! nlms is the number of modes excited
! inlms are the indixes of the normal modes to be excited
real(kind=8) :: rand
integer(kind=8) :: iclock0,iclock,flagseed
real,dimension(:),allocatable :: ampa,wwa,ww,coor,dcoor,q,p,w,qz,qq,pp,v,norm
real,dimension(:,:),allocatable :: c
real :: enmta,dum,sdum,wt,rnd
real, dimension(3) :: vcm,qcm
integer :: nn,nmbar,i,n,k,j,ii,nlin,ncbl,idum,jfrst,jlast,nlms,icount
integer, dimension(:),allocatable :: inlms
character*2,dimension(:),allocatable :: fasymb
! read number of modes and energy
read(*,*) flagseed
read(*,*) n
allocate(q(3*n),p(3*n),v(3*n),qz(3*n),qq(3*n),pp(3*n),w(n),fasymb(n))
do i=1,n
   read(*,*) fasymb(i),qz(3*i-2),qz(3*i-1),qz(3*i)
   do j = 1 , natom
!      if(string_tolower(fasymb(i))==asymb(j)) w(i)=ams(j)
      if(fasymb(i)==asymb(j)) w(i)=ams(j)
   enddo
enddo
read(*,*) nlin
wt=sum(w)
nmbar=3*n-6+nlin
! read the energy (in kcal/mol)
read(*,*) enmta
!****new
read(*,*) nlms
allocate(ampa(nmbar),wwa(nmbar),ww(nmbar),coor(nmbar),dcoor(nmbar),c(3*n,nmbar),norm(nmbar),inlms(nmbar))
if(nlms>0) read(*,*) (inlms(i),i=1,nlms)
if(nlms==0) then
   inlms=(/ (i,i=1,nmbar) /)
   nlms=nmbar
endif
nmbar=inlms(nlms)
!****new
DUM=ENMTA*C1
! normal modes-1
NN=NMBAR-1
! read the freqs and eigenvectors
! ncbl is the number of complete blocks (in freq MOPAC file) 8 columns
if(mod(real(nmbar),8.)==0) then
   ncbl=nmbar/8
else
   ncbl=nmbar/8+1
endif
! read the first complete blocks
DO I=1,ncbl
   if(i<ncbl) then
      jfrst=8*i-7
      jlast=8*i
   else
      jfrst=8*ncbl-7
      jlast=nmbar
   endif
   read(*,*) (wwa(j),j=jfrst,jlast)
   do ii=1,3*n
      read(*,*) idum,(c(ii,j),j=jfrst,jlast)
   enddo
enddo
ww=wwa*c6
! normalize the eigenvectors
norm=0
do i=1,nmbar
   do j=1,n
      norm(i)=norm(i)+c(3*j-2,i)*c(3*j-2,i)*w(j)
      norm(i)=norm(i)+c(3*j-1,i)*c(3*j-1,i)*w(j)
      norm(i)=norm(i)+c(3*j  ,i)*c(3*j  ,i)*w(j)
   enddo
   norm(i)=sqrt(norm(i))
   do j=1,n
      c(3*j-2,i)=c(3*j-2,i)/norm(i)
      c(3*j-1,i)=c(3*j-1,i)/norm(i)
      c(3*j  ,i)=c(3*j  ,i)/norm(i)
   enddo
enddo
!call exit
!
! random_number generator
! it ensures a different random sequence every time is run

CALL SYSTEM_CLOCK(COUNT=iclock0)
if(flagseed==0) iclock=iclock0
if(flagseed>0) iclock=flagseed
CALL RANDST(iclock)

!
icount=0
do i=1,nn
   do j=1,nlms
      if(i==inlms(j)) then
         icount=icount+1
         rand=rand0(0)
         SDUM=1.0D0/DBLE(nlms-Icount)
         SDUM=DUM*(1.0D0-RAND**SDUM)
         DUM=DUM-SDUM
         AMPA(I)=SQRT(2.0D0*SDUM)/WW(I)
      endif
   enddo
ENDDO
AMPA(NMBAR)=SQRT(2.0D0*DUM)/WW(NMBAR)

! coor and dcoor are the Q and QDOT vectors
do i=1,nmbar
   rand=rand0(0)
   dum=2.d0*pi*rand
! for low freq modes give only kinetic energy
   if(wwa(i)<=1000) then
     coor(i)=0.d0
     dcoor(i)=-ww(i)*ampa(i)
   else
     coor(i)=ampa(i)*cos(dum)
     dcoor(i)=-ww(i)*ampa(i)*sin(dum)
   endif
enddo

!
!  TRANSFORM FROM NORMAL MODE TO CARTESIAN COORDINATES AND VELOCIT
!
q=0
p=0
DO I=1,N
   DO K=1,3
      J=3*I+1-K
      DO ii=1,NMbar
         Q(J)=Q(J)+C(J,ii)*COOR(ii)
         P(J)=P(J)+C(J,ii)*DCOOR(ii)
      ENDDO
      P(J)=P(J)*W(I)
      Q(J)=Q(J)+QZ(J)
   ENDDO
ENDDO

!! remove center of mass velocity
vcm=0
qcm=0
DO I=1,N
   VCM(1)=VCM(1)+P(3*i-2)
   VCM(2)=VCM(2)+P(3*i-1)
   VCM(3)=VCM(3)+P(3*i  )
   QCM(1)=QCM(1)+W(i)*Q(3*i-2)
   QCM(2)=QCM(2)+W(i)*Q(3*i-1)
   QCM(3)=QCM(3)+W(i)*Q(3*i  )
ENDDO
vcm=vcm/wt
qcm=qcm/wt

DO I=1,N
   PP(3*i-2)=P(3*i-2)-W(i)*VCM(1)
   PP(3*i-1)=P(3*i-1)-W(i)*VCM(2)
   PP(3*i  )=P(3*i  )-W(i)*VCM(3)
   QQ(3*i-2)=Q(3*i-2)-QCM(1)
   QQ(3*i-1)=Q(3*i-1)-QCM(2)
   QQ(3*i  )=Q(3*i  )-QCM(3)
ENDDO
q=qq
p=pp
!write(*,*) "Cartesian coordinates (Angstroms)"
!write(*,*)
do i=1,n
   write(*,*) fasymb(i),q(3*i-2),"1",q(3*i-1),"1",q(3*i),"1"
enddo
!write(*,*) "Cartesian velocities (cm/s)"
write(*,*)
do i=1,n
   v(3*i-2)=vf*p(3*i-2)/w(i)
   v(3*i-1)=vf*p(3*i-1)/w(i)
   v(3*i  )=vf*p(3*i  )/w(i)
   write(*,*) v(3*i-2),v(3*i-1),v(3*i)
enddo

contains
function string_tolower( string ) result (new)
    character(len=*)           :: string

    character(len=len(string)) :: new

    integer                    :: i
    integer                    :: k

    new    = string
    do i = 1,len(string)
        k = iachar(string(i:i))
        if ( k >= iachar('A') .and. k <= iachar('Z') ) then
            k = k + iachar('a') - iachar('A')
            new(i:i) = achar(k)
        endif
    enddo
end function string_tolower

end program initialqv

max_stars_repo_name: emartineznunez/AutoMeKin

max_forks_repo_name: emartineznunez/AutoMeKin


!
!                Parallel Sparse BLAS  version 3.5
!      (C) Copyright 2006, 2010, 2015, 2017
!        Salvatore Filippone    Cranfield University
!        Alfredo Buttari        CNRS-IRIT, Toulouse
!
!    Redistribution and use in source and binary forms, with or without
!    modification, are permitted provided that the following conditions
!    are met:
!      1. Redistributions of source code must retain the above copyright
!         notice, this list of conditions and the following disclaimer.
!      2. Redistributions in binary form must reproduce the above copyright
!         notice, this list of conditions, and the following disclaimer in the
!         documentation and/or other materials provided with the distribution.
!      3. The name of the PSBLAS group or the names of its contributors may
!         not be used to endorse or promote products derived from this
!         software without specific written permission.
!
!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!    POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
! package: psb_linmap_type_mod
!    Defines data types for mapping between vectors belonging
!    to different spaces.
!
module psb_base_linmap_mod
  use psb_const_mod
  use psb_desc_mod, only: psb_desc_type

  type psb_base_linmap_type
    integer(psb_ipk_) :: kind
    integer(psb_ipk_), allocatable  :: iaggr(:), naggr(:)
    type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null()
    type(psb_desc_type)   :: desc_X, desc_Y
  contains
    procedure, pass(map)  :: sizeof   => base_map_sizeof
    procedure, pass(map)  :: is_ok    => base_is_ok
    procedure, pass(map)  :: is_asb   => base_is_asb
    procedure, pass(map)  :: get_kind => base_get_kind
    procedure, pass(map)  :: set_kind => base_set_kind
    procedure, pass(map)  :: free     => base_free
    procedure, pass(map)  :: clone    => base_clone
  end type psb_base_linmap_type

  interface psb_move_alloc
    module procedure  psb_base_linmap_transfer
  end interface

  private :: base_map_sizeof, base_is_ok, base_is_asb,&
       & base_get_kind, base_set_kind, base_free, base_clone

contains

  function base_get_kind(map) result(val)
    implicit none
    class(psb_base_linmap_type), intent(in) :: map
    integer(psb_ipk_) :: val

    val = map%kind
  end function base_get_kind

  subroutine base_set_kind(map_kind,map)
    implicit none
    integer(psb_ipk_), intent(in)          :: map_kind
    class(psb_base_linmap_type), intent(inout) :: map

    map%kind = map_kind

  end subroutine base_set_kind

  function base_is_ok(map) result(res)
    use psb_desc_mod
    implicit none
    class(psb_base_linmap_type), intent(in) :: map
    logical  :: res
    res = .false.

    select case(map%get_kind())
    case (psb_map_aggr_)
      if (.not.associated(map%p_desc_X)) return
      if (.not.associated(map%p_desc_Y)) return
      res = map%p_desc_X%is_ok().and.map%p_desc_Y%is_ok()
    case(psb_map_gen_linear_)
      res = map%desc_X%is_ok().and.map%desc_Y%is_ok()
    end select

  end function base_is_ok

  function base_is_asb(map) result(res)
    use psb_desc_mod
    implicit none
    class(psb_base_linmap_type), intent(in) :: map
    logical  :: res
    res = .false.

    select case(map%get_kind())
    case (psb_map_aggr_)
      if (.not.associated(map%p_desc_X)) return
      if (.not.associated(map%p_desc_Y)) return
      res = map%p_desc_X%is_asb().and.map%p_desc_Y%is_asb()
    case(psb_map_gen_linear_)
      res = map%desc_X%is_asb().and.map%desc_Y%is_asb()
    end select

  end function base_is_asb

  function base_map_sizeof(map) result(val)
    use psb_desc_mod
    implicit none
    class(psb_base_linmap_type), intent(in) :: map
    integer(psb_long_int_k_) :: val

    val = psb_sizeof_int
    if (allocated(map%iaggr))   &
         & val = val + psb_sizeof_int*size(map%iaggr)
    if (allocated(map%naggr))   &
         & val = val + psb_sizeof_int*size(map%naggr)
    val = val + map%desc_X%sizeof()
    val = val + map%desc_Y%sizeof()

  end function base_map_sizeof

  subroutine  psb_base_linmap_transfer(mapin,mapout,info)
    use psb_realloc_mod
    use psb_desc_mod
    use psb_mat_mod, only : psb_move_alloc
    implicit none
    type(psb_base_linmap_type), intent(inout) :: mapin,mapout
    integer(psb_ipk_), intent(out)            :: info

    mapout%kind = mapin%kind
    call psb_move_alloc(mapin%iaggr,mapout%iaggr,info)
    call psb_move_alloc(mapin%naggr,mapout%naggr,info)
    mapout%p_desc_X => mapin%p_desc_X
    mapin%p_desc_X  => null()
    mapout%p_desc_Y => mapin%p_desc_Y
    mapin%p_desc_Y  => null()
    call psb_move_alloc(mapin%desc_X,mapout%desc_X,info)
    call psb_move_alloc(mapin%desc_Y,mapout%desc_Y,info)

  end subroutine psb_base_linmap_transfer

  subroutine  base_clone(map,mapout,info)
    use psb_desc_mod
    use psb_realloc_mod
    implicit none
    class(psb_base_linmap_type), intent(inout) :: map
    class(psb_base_linmap_type), intent(inout) :: mapout
    integer(psb_ipk_)     :: info

    mapout%kind = map%kind
    call psb_safe_ab_cpy(map%iaggr,mapout%iaggr,info)
    call psb_safe_ab_cpy(map%naggr,mapout%naggr,info)
    mapout%p_desc_X => map%p_desc_X
    mapout%p_desc_Y => map%p_desc_Y
    call map%desc_X%clone(mapout%desc_X,info)
    call map%desc_Y%clone(mapout%desc_Y,info)

  end subroutine base_clone

  subroutine  base_free(map,info)
    implicit none
    class(psb_base_linmap_type) :: map
    integer(psb_ipk_), intent(out)       :: info

    if (allocated(map%iaggr)) &
         & deallocate(map%iaggr,stat=info)
    if (allocated(map%naggr)) &
         & deallocate(map%naggr,stat=info)
    map%p_desc_X  => null()
    map%p_desc_Y  => null()
    if (map%desc_X%is_ok()) call map%desc_X%free(info)
    if (map%desc_Y%is_ok()) call map%desc_Y%free(info)

  end subroutine base_free

end module psb_base_linmap_mod


text:
Kung Fu is an umbrella name for a wide variety of Chinese martial arts systems. Styles which are categorized under the name Kung Fu include:
  Wu Shu
  San Shou
  Shaolin
  Hung Gar
  Wing Chun
  Pai Hao/White Crane
  Tang Lang/Mantis
  Internal Boxing Neijiaquan Styles
     Taijiquan Tai Chi
     Xingyiquan
     Baguazhang

However, Kung Fu over the years has encompassed likely thousands of different styles. However, many of them fell into obscurity over the years because of secrecy, or because the style was absorbed, or transformed into another style. Kung Fu is often categorized into Soft or Hard styles, or Internal and External. Hard or External styles focus on physical techniques. They may rely on developing strength, speed or other techniques, and generally can vary from style to style. Internal or Soft styles are influenced by Taoism and Chinese Internal Medicine with a focus on relaxation and the circulation of chi.  It is claimed by some practitioners of Internal styles that the skill that can be attained by an External style is limited by body constraints, whereas with Internal styles, there are no limits to skill.

For more information about wiki:WikiPedia:Kung_fu Kung Fu refer to Wikipedia.

Places in Davis to practice Kung Fu:
  http://www.daviskungfu.com/ Davis Kung Fu
  Kung Fu Club
 Tai Chi Club at UC Davis
  Experimental College
  UCD Wing Chun Club

New Tai Chi, Xingyiquan, and Baguazhang classes are now being offered at the Experimental College.  See the https://ecollege.ucdavis.edu/classes/search?termsummer2014session1&group&instructor100939&q Summer 2014 schedule
 The Tai Chi Club at UC Davis now has practice sessions in the other internal boxing styles of Xingyiquan and Baguazhang.


text: #redirect Square Tomato


text:
see also Davis Cemetery.

Wiscombes Davis Funeral Chapel has served the needs of grieving families for many years. They provide their services as funeral directors to aid during a difficult time, specializing in all aspects of Funeral Service and Cremation Services.

Ownership changed hands in December 2010 when Vera Smith became the new owner and funeral director.

The previous owner, Shawn Wiscombe, Campaign Contributions/Proposition 8 (2008) donated money for political proposition campaigns.


program GenKingMatrix
	implicit none
	integer, parameter :: rows = 100
	integer, parameter :: cols = 100
	real, parameter :: pi = 3.1415927
	integer ierr
	real :: time
	COMPLEX*8 m (rows, cols)
	DOUBLE PRECISION ima (rows, cols)
	DOUBLE PRECISION rea (rows, cols)
	DOUBLE PRECISION ieig (cols)
	DOUBLE PRECISION reig (cols)
	DOUBLE PRECISION fv1 (cols)
	DOUBLE PRECISION fv2 (cols)
	DOUBLE PRECISION fv3 (cols)
	DOUBLE PRECISION reiv (rows, cols)
	DOUBLE PRECISION ieiv (rows, cols)
	DOUBLE COMPLEX eig (cols)
	integer i, j
	integer count, count_rate, count_max
	COMPLEX*16 :: sum
	REAL(8) :: s

	call SYSTEM_CLOCK (count, count_rate, count_max)
	call srand(count)

	do i=1, 1000
		call genkmatrix (m, rows, cols)
		call getreal (m, rea, rows, cols)
		call getimag (m, ima, rows, cols)
		call cg (rows, cols, rea, ima, reig, ieig, 0, reiv, ieiv, fv1, fv2, fv3, ierr)
		call getcmplx (eig, reig, ieig, cols)

		sum = CMPLX(0.0, 0.0)
		do j=1, cols
			sum = sum + eig (j)
		end do

		s = REALPART (sum) / cols
		print *, s
		if (s .lt. (pi / 2)) then
			print *, 'Generated a king matrix...'
			stop 0
		end if
	end do

	print *, 'No king matrix was generated...'
	stop 1
end program GenKingMatrix

! Subroutine -- Zero --
!
! Initializes the members of the Matrix
! ``m'' with zeros
subroutine zero (m, rows, cols)
	integer rows
	integer cols
	COMPLEX*16 m (rows, cols)
	integer i, j

	do i=1,rows
		do j=1,cols
			m (i, j) = CMPLX(0.0, 0.0)
		end do
	end do
end subroutine zero

! Subroutine -- random --
!
! Initializes the Matrix m with random values
subroutine random (m, rows, cols)
	integer rows
	integer cols
	COMPLEX*16 m (rows, cols)
	integer i, j

	do i=1,rows
		do j=1,cols
			m (i, j) = CMPLX(rand () * 1000.0, rand() * 1000.0)
		end do
	end do
end subroutine random

! Subroutine genkmatrix
!
! Generates a king matrix m
subroutine genkmatrix (m, rows, cols)
	real, parameter :: pi = 3.1415927
	integer rows
	integer cols
	COMPLEX*8 m(rows, cols)
	integer i, j

	do i=1,rows
		do j=1,cols
			m (i, j) = CMPLX (rand () * pi, rand () * pi)
		end do
	end do
end subroutine genkmatrix

subroutine getreal (m, rea, rows, cols)
	integer rows
	integer cols
	COMPLEX*8 m (rows, cols)
	DOUBLE PRECISION rea (rows, cols)
	integer i, j

	do i=1,rows
		do j=1,cols
			rea (i, j) = REALPART (m (i, j))
		end do
	end do
end subroutine getreal

subroutine getimag (m, imag, rows, cols)
	integer rows
	integer cols
	COMPLEX*8 m (rows, cols)
	DOUBLE PRECISION imag (rows, cols)
	integer i, j

	do i=1,rows
		do j=1,cols
			imag (i, j) = IMAGPART (m (i, j))
		end do
	end do
end subroutine getimag

subroutine getcmplx (d, r, im, n)
	integer n
	double complex d (n)
	double precision r(n)
	double precision im(n)
	integer i

	do i=1,n
		d (i) = CMPLX (r (i), im(i))
	end do
end subroutine getcmplx

double precision function getsum (vec, n)
	integer n
	DOUBLE PRECISION vec (n)
	integer i

	getsum = 0.0
	do i=1,n
		getsum = getsum + vec (i)
	end do
end function getsum


text:
! Very simple radiation tracing module
! Assumes all neutral hydrogen absorbs all photons with a simple dust model
! Sam Geen, March 2018

subroutine trace_radiation(dr,Qion,sigmaDust,nH,drecombinationsdr,ncell)
! Trace a ray through the spherical grid and ionise everything in the way
! Use very simple instant ionisation/recombination model
! This part is largely to make iterating through the ray faster, other parts done in numpy in radiation.py
implicit none

! Interface variables
real(kind=8)::dr
integer::ncell
real(kind=8),dimension(1:ncell)::Qion,sigmaDust,nH,drecombinationsdr
! Internal variables
integer::icell

! Loop through cells
do icell=2,ncell
    ! See Draine (2011) equation 2
    Qion(icell) = Qion(icell-1) - (drecombinationsdr(icell) + nH(icell) * sigmaDust(icell) * Qion(icell-1))*dr
    ! If no photons left, set the remaining bins to zero and exit the loop
    if (Qion(icell) .lt. 0.0) then
        Qion(icell:ncell) = 0.0
        exit
    endif
end do

! Loop through

end subroutine trace_radiation

max_stars_repo_name: samgeen/Weltgeist

max_issues_repo_name: samgeen/Weltgeist

max_forks_repo_name: samgeen/Weltgeist