text:
Pete Markevich ran unsuccessfully for ASUCD Senate with the Student Focus slate for the Winter 2007 ASUCD Election.  He was the Chair of the ASUCD Academic Affairs Commission and works at the UCD Bookstore.  He is a sophomore Political Science and Economics double Major.  Some of Petes academic interests include International Macroeconomics, Russian Foreign Policy in the PostCold War era, and real world applications of Game Theory.

Pete faced a closed session on May 10, 2007 for his participation in the Davis College Republicans protest on May 1st.  A facebook http://ucdavis.facebook.com/event.php?eid2333922515 event was created in his defense.  LEAD withdrew their intention to close session Markevich due in small part to potential legal conflicts of removing Markevich from office.

ASUCD Experience
Intern, External Affairs Office, Fall 2005
Academic Affairs Commissioner, 20052006
Chair, Academic Affairs Commission, Summer 2006Spring 2007
Member, ASUCD Lobby Corps, Fall 2006present
ASUCD Representative, Undergraduate Advising Council
ASUCD Representative, Undergraduate Council, Academic Senate

Pete began his ASUCD career in the Fall of his freshman year as an intern in the External Affairs Office.  After helping out with a few voter Registration and Student Debt drives, Pete applied to the Academic Affairs Commission, a subordinate body of the ASUCD Senate, and was hired as a Winter Term Commissioner.  As part of the Commission, Pete helped plan the inaugural installment of the Last Lecture Series, a program where the Commission invites a popular UCD professor to give a lecture as if its the last one he or she will ever make.  This allows the professor to go beyond everyday class material and give students guidance and inspiration in their future endeavors.  Also, Pete helped plan and put on the 2006 ASUCD Excellence in Education Awards ceremony, an annual event where students honor their amazing UCD professors.

As chair of AAC, Pete runs weekly meetings every Monday night at 6:30 p.m. in the Fielder Room of the MU.    In Fall of 06, AAC put on the Beer Vs Wine http://www.californiaaggie.com/media/storage/paper981/news/2006/11/03/CampusNews/Professors.Debate.Merits.Of.Beer.Wine2437972.shtml?norewrite200612132047&sourcedomainwww.californiaaggie.com Debate.  In addition, he sits on Senate meetings as an exofficio member of the Senate, meaning that although he doesnt have a vote, he contributes to Senate discussions and works closely with the current senators on a wide range of issues.

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
c     Calculate LU decomposition of a matrix
c     Author: Pearu Peterson, March 2002
c
c     prefixes: d,z,s,c   (double,complex double,float,complex float)
c     suffixes: _c,_r     (column major order,row major order)

      subroutine dlu_c(p,l,u,a,m,n,k,piv,info,permute_l,m1)
      integer m,n,piv(k),i,j,k,permute_l,m1
      double precision l(m,k),u(k,n),a(m,n)
      double precision p(m1,m1)

      external dgetrf,dlaswp
      call dgetrf(m,n,a,m,piv,info)
      if (info.lt.0) then
         return
      endif
      do 20 i=1,m
         do 10, j=1,n
            if (j.le.k) then
               if (i.eq.j) then
                  l(i,j) = 1d0
               elseif (i.gt.j) then
                  l(i,j) = a(i,j)
               endif
            endif
            if (i.le.k.and.i.le.j) then
               u(i,j) = a(i,j)
            endif
 10      continue
 20   continue
      if (permute_l.ne.0) then
         call dlaswp(k,l,m,1,k,piv,-1)
      else
         do 25 i=1,m
            p(i,i)=1d0
 25       continue
         call dlaswp(m,p,m,1,k,piv,-1)
      endif
      end

      subroutine zlu_c(p,l,u,a,m,n,k,piv,info,permute_l,m1)
      integer m,n,piv(k),i,j,k,permute_l,m1
      complex*16 l(m,k),u(k,n),a(m,n)
      double precision p(m1,m1)

      external zgetrf,zlaswp,dlaswp
      call zgetrf(m,n,a,m,piv,info)
      if (info.lt.0) then
         return
      endif
      do 20 i=1,m
         do 10, j=1,n
            if (j.le.k) then
               if (i.eq.j) then
                  l(i,j) = 1d0
               elseif (i.gt.j) then
                  l(i,j) = a(i,j)
               endif
            endif
            if (i.le.k.and.i.le.j) then
               u(i,j) = a(i,j)
            endif
 10      continue
 20   continue
      if (permute_l.ne.0) then
         call zlaswp(k,l,m,1,k,piv,-1)
      else
         do 25 i=1,m
            p(i,i)=1d0
 25       continue
         call dlaswp(m,p,m,1,k,piv,-1)
      endif
      end

      subroutine slu_c(p,l,u,a,m,n,k,piv,info,permute_l,m1)
      integer m,n,piv(k),i,j,k,permute_l,m1
      real l(m,k),u(k,n),a(m,n)
      real p(m1,m1)

      external sgetrf,slaswp
      call sgetrf(m,n,a,m,piv,info)
      if (info.lt.0) then
         return
      endif
      do 20 i=1,m
         do 10, j=1,n
            if (j.le.k) then
               if (i.eq.j) then
                  l(i,j) = 1e0
               elseif (i.gt.j) then
                  l(i,j) = a(i,j)
               endif
            endif
            if (i.le.k.and.i.le.j) then
               u(i,j) = a(i,j)
            endif
 10      continue
 20   continue
      if (permute_l.ne.0) then
         call slaswp(k,l,m,1,k,piv,-1)
      else
         do 25 i=1,m
            p(i,i)=1e0
 25       continue
         call slaswp(m,p,m,1,k,piv,-1)
      endif
      end

      subroutine clu_c(p,l,u,a,m,n,k,piv,info,permute_l,m1)
      integer m,n,piv(k),i,j,k,permute_l,m1
      complex l(m,k),u(k,n),a(m,n)
      real p(m1,m1)

      external cgetrf,claswp,slaswp
      call cgetrf(m,n,a,m,piv,info)
      if (info.lt.0) then
         return
      endif
      do 20 i=1,m
         do 10, j=1,n
            if (j.le.k) then
               if (i.eq.j) then
                  l(i,j) = 1e0
               elseif (i.gt.j) then
                  l(i,j) = a(i,j)
               endif
            endif
            if (i.le.k.and.i.le.j) then
               u(i,j) = a(i,j)
            endif
 10      continue
 20   continue
      if (permute_l.ne.0) then
         call claswp(k,l,m,1,k,piv,-1)
      else
         do 25 i=1,m
            p(i,i)=1e0
 25       continue
         call slaswp(m,p,m,1,k,piv,-1)
      endif
      end

ext: f

max_stars_repo_name: jasonmccampbell/scipy-refactor

max_issues_repo_name: enthought/scipy-refactor

max_forks_repo_name: enthought/scipy-refactor


SUBROUTINE BuildStencilsGridX(alpha,order,x,DiffStencils,Nx,Ny)
! By Allan P. Engsig-Karup.
USE Precision
USE Constants
IMPLICIT NONE
INTEGER :: rank, alpha, Nx, Ny, order, Diff, i
REAL(KIND=long), DIMENSION(:), ALLOCATABLE   :: Stencil, tmpStencil
!INTEGER, DIMENSION(:), ALLOCATABLE   		 :: idx
INTEGER :: idx(2*alpha+1)
REAL(KIND=long), DIMENSION(:,:), ALLOCATABLE :: c
REAL(KIND=long), DIMENSION(Nx,2*alpha+1)     :: DiffStencils
REAL(KIND=long), DIMENSION(Nx,Ny)            :: x
REAL(KIND=long)                              :: x0
rank = 2*alpha+1
ALLOCATE( Stencil(rank)    )
ALLOCATE( tmpStencil(rank) )
ALLOCATE( c(rank,order+1)  )
IF (Nx==1 .AND. order==0) THEN
    ! Direct interpolation
	Stencil           = zero
	Stencil(alpha+1)  = one
	DiffStencils(1,:) = Stencil
ELSE IF (Nx==1 .AND. order>0) THEN
    ! For a stencil of one point, the derivative is zero
	Stencil           = zero
	Stencil(alpha+1)  = zero
	DiffStencils(1,:) = Stencil
ELSE
!	ALLOCATE( idx(rank) )
	DO i=-alpha,alpha,1
		idx(i+alpha+1) = i
	END DO
	DO i = 1 , alpha
		Diff = alpha-i+1
		! Expansion point where the approximation is to be defined
		x0 = x(i,1) ! FIXME: y-index fixed

		! Determine local finite difference stencil coefficients
		CALL weights(x0,x(i+idx+Diff,1),rank-1,rank-1,order,c) ! FIXME: y-index fixed
		Stencil    = c(1:rank,order+1)
		DiffStencils(i,:) = Stencil
	END DO
	DO i = alpha+1 , Nx-alpha
		! Expansion point where the approximation is to be defined
		x0 = x(i,1) ! FIXME: y-index fixed

		! Determine local finite difference stencil coefficients
		! FIXME: put his outside loop if we do not need flexible grids (e.g. in the case of transformation to an equi-distant grid)
		CALL weights(x0,x(i+idx,1),rank-1,rank-1,order,c) ! FIXME: y-index fixed
		Stencil    = c(1:rank,order+1)
		DiffStencils(i,:) = Stencil
	END DO
	DO i = Nx-alpha+1 , Nx
		Diff = (Nx-alpha)-i
		! Expansion point where the approximation is to be defined
		x0 = x(i,1) ! FIXME: y-index fixed

		! Determine local finite difference stencil coefficients
		CALL weights(x0,x(i+idx+Diff,1),rank-1,rank-1,order,c) ! FIXME: y-index fixed
		Stencil    = c(1:rank,order+1)
		DiffStencils(i,:) = Stencil
	END DO
ENDIF
DEALLOCATE(Stencil,tmpStencil,c)

END SUBROUTINE BuildStencilsGridX


!-----------------------------------------------------------------------------!
!          Alternative Symmetric sparse matrix manipulation routines          !
!   Authors: Dorival Piedade Neto and Rodrigo Ribeiro Paccola                 !
!   University of Sao Paulo - Sao Carlos Engineering School - October 2014    !
!-----------------------------------------------------------------------------!

module Sparse

    implicit none

    type list
        integer(4),dimension(:),allocatable::terms
    end type

    type lists
        type(list),dimension(:),allocatable::terms
    end type

    type sparse_matrix
        integer(4)::nnodes,nelems,nterms,ngl,iflag
        real(8)::ti,tf,tacum
        integer(4),dimension(:),allocatable::len_nodes,len_elems,acum,row,col,vec_,cum
        real(8),dimension(:),allocatable::val
        type(list),dimension(:),allocatable::conec,n_n_incid,n_e_incid
        type(lists),dimension(:),allocatable::conec_new
    end type sparse_matrix

    contains

    subroutine prepare_01(sp_matrix, nnodes, nelems, ngl, iflag)
        implicit none

        integer(4)::i
        integer(4),intent(in)::nnodes,nelems,ngl,iflag
        type(sparse_matrix),intent(inout)::sp_matrix

        call cpu_time(sp_matrix%ti)

        sp_matrix%nnodes = nnodes
        sp_matrix%nelems = nelems
        sp_matrix%ngl = ngl
        sp_matrix%iflag = iflag

        allocate(sp_matrix%conec(nelems))
        allocate(sp_matrix%len_elems(nelems))
        allocate(sp_matrix%n_n_incid(nnodes))
        allocate(sp_matrix%n_e_incid(nnodes))
        allocate(sp_matrix%len_nodes(nnodes))
        allocate(sp_matrix%acum(nnodes))

        allocate(sp_matrix%cum(ngl*nnodes+1))

        allocate(sp_matrix%vec_(ngl+1))
        sp_matrix%vec_ = 0
        do i=2,ngl
            sp_matrix%vec_(i+1) = sp_matrix%vec_(i) + i - 1
        enddo

        call cpu_time(sp_matrix%tf)
        if (sp_matrix%iflag.eq.0) then
            write(*,*)'prepare_01 time: ',sp_matrix%tf - sp_matrix%ti
        end if
    end subroutine prepare_01

    subroutine prepare_02(sp_matrix)
        implicit none

        integer(4)::i,j,k,acum,n,ix,ij,jj,counter,accumulated
        integer(4),dimension(:),allocatable::node_aux
        type(sparse_matrix),intent(inout)::sp_matrix

        call cpu_time(sp_matrix%ti)

        do i=1,sp_matrix%nelems
            do j=1,sp_matrix%len_elems(i)
                call add_item(sp_matrix%n_e_incid(sp_matrix%conec(i)%terms(j))%terms,i)
            enddo
        enddo

        allocate(node_aux(sp_matrix%nnodes))
        acum = 0
        do i=1,sp_matrix%nnodes
            node_aux = 0
            do j=1,size(sp_matrix%n_e_incid(i)%terms)
                do k=1,sp_matrix%len_elems(sp_matrix%n_e_incid(i)%terms(j))
                    if (i.le.sp_matrix%conec(sp_matrix%n_e_incid(i)%terms(j))%terms(k)) then
                        node_aux(sp_matrix%conec(sp_matrix%n_e_incid(i)%terms(j))%terms(k)) = 1
                    endif
                enddo
            enddo
            n = size(pack([(ix,ix=1,sp_matrix%nnodes)],node_aux == 1))
            sp_matrix%len_nodes(i) = n
            acum = acum + n
            sp_matrix%acum(i) = acum
            allocate(sp_matrix%n_n_incid(i)%terms(n))
            sp_matrix%n_n_incid(i)%terms = pack([(ix,ix=1,sp_matrix%nnodes)],node_aux == 1)
        enddo
        deallocate(node_aux)

        sp_matrix%nterms = 0
        do i=1,sp_matrix%nnodes
            do ij=1,sp_matrix%ngl
                do j=1,size(sp_matrix%n_n_incid(i)%terms)
                    if (sp_matrix%n_n_incid(i)%terms(j).eq.i) then
                        do jj=ij,sp_matrix%ngl
                            sp_matrix%nterms = sp_matrix%nterms + 1
                        enddo
                    else
                        do jj=1,sp_matrix%ngl
                            sp_matrix%nterms = sp_matrix%nterms + 1
                        enddo
                    endif
                enddo
            enddo
        enddo

        acum = 0
        allocate(sp_matrix%row(sp_matrix%nterms))
        allocate(sp_matrix%col(sp_matrix%nterms))
        allocate(sp_matrix%val(sp_matrix%nterms))
        sp_matrix%val = 0.0d0
        do i=1,sp_matrix%nnodes
            do ij=1,sp_matrix%ngl
                do j=1,size(sp_matrix%n_n_incid(i)%terms)
                    if (sp_matrix%n_n_incid(i)%terms(j).eq.i) then
                        do jj=ij,sp_matrix%ngl
                             acum = acum + 1
                             sp_matrix%row(acum) = (i-1)*sp_matrix%ngl+ij
                             sp_matrix%col(acum) = (sp_matrix%n_n_incid(i)%terms(j)-1)*sp_matrix%ngl+jj
                        enddo
                    else
                        do jj=1,sp_matrix%ngl
                             acum = acum + 1
                             sp_matrix%row(acum) = (i-1)*sp_matrix%ngl+ij
                             sp_matrix%col(acum) = (sp_matrix%n_n_incid(i)%terms(j)-1)*sp_matrix%ngl+jj
                        enddo
                    endif
                enddo
            enddo
        enddo

        allocate(node_aux(1))
        allocate(sp_matrix%conec_new(sp_matrix%nelems))
        do i=1,sp_matrix%nelems
            allocate(sp_matrix%conec_new(i)%terms(sp_matrix%len_elems(i)-1))
            do j=1,sp_matrix%len_elems(i)-1
                allocate(sp_matrix%conec_new(i)%terms(j)%terms(sp_matrix%len_elems(i)-j))
                do k=j+1,sp_matrix%len_elems(i)
                    node_aux = pack([(ix,ix=1,sp_matrix%len_nodes(min(sp_matrix%conec(i)%terms(j),sp_matrix%conec(i)%terms(k))))],sp_matrix%n_n_incid(min(sp_matrix%conec(i)%terms(j),sp_matrix%conec(i)%terms(k)))%terms == max(sp_matrix%conec(i)%terms(j),sp_matrix%conec(i)%terms(k)))
                    sp_matrix%conec_new(i)%terms(j)%terms(k-j) = node_aux(1)
                enddo
            enddo
        enddo
        deallocate(node_aux)

        sp_matrix%cum(1) = 1
        counter = 1
        accumulated = 1
        do i=2,sp_matrix%nterms
            accumulated = accumulated + 1
            if (sp_matrix%row(i) > sp_matrix%row(i-1)) then
                counter = counter + 1
                sp_matrix%cum(counter) = accumulated
            end if
        end do
        sp_matrix%cum(sp_matrix%nnodes*sp_matrix%ngl+1) = accumulated + 1

        call cpu_time(sp_matrix%tf)
        if (sp_matrix%iflag.eq.0) then
            write(*,*)'prepare_02 time: ',sp_matrix%tf - sp_matrix%ti
        end if
    end subroutine prepare_02

    subroutine add_matrix(sp_matrix,id,matrix)
        implicit none

        integer(4)::ino,jno,igl,jgl,ia,ib,imin,imax,ngl,acum,pos
        integer(4),intent(in)::id
        real(8),dimension(:,:),allocatable,intent(in)::matrix
        type(sparse_matrix),intent(inout)::sp_matrix

        call cpu_time(sp_matrix%ti)

        ngl = sp_matrix%ngl
        do ino=1,sp_matrix%len_elems(id)
            ia = ngl * (ino - 1)
            do jno=1,sp_matrix%len_elems(id)
                ib = ngl * (jno - 1)
                imin = sp_matrix%conec(id)%terms(ino)
                imax = sp_matrix%conec(id)%terms(jno)
                if (imax.ge.imin) then
                    if (imin.eq.1) then
                        acum = 0
                    else
                        acum = sp_matrix%acum(imin-1) * (ngl ** 2) - (imin - 1) * sp_matrix%vec_(ngl+1)
                    endif
                    do igl=1,ngl
                        if (imax.eq.imin) then
                            do jgl=igl,ngl
                                pos = acum + sp_matrix%len_nodes(imin) * ngl * (igl - 1) - sp_matrix%vec_(igl) + jgl - igl + 1
                                sp_matrix%val(pos) = sp_matrix%val(pos) + matrix(ia + igl,ib + jgl)
                            enddo
                        else
                            do jgl=1,ngl
                                pos = acum + sp_matrix%len_nodes(imin) * ngl * (igl - 1) - sp_matrix%vec_(igl) + (sp_matrix%conec_new(id)%terms(min(ino,jno))%terms(abs(ino - jno)) - 1) * ngl + jgl - igl + 1
                                sp_matrix%val(pos) = sp_matrix%val(pos) + matrix(ia + igl,ib + jgl)
                            enddo
                        endif
                         !if (imax.eq.imin) then
                         !    do jgl=igl,ngl
                         !        pos = acum + sp_matrix%len_nodes(imin) * ngl * (igl - 1) - sp_matrix%vec_(igl) + jgl - igl + 1
                         !        if (ia + igl .le. ib + jgl) then
                         !            sp_matrix%val(pos) = sp_matrix%val(pos) + matrix(ia + igl,ib + jgl)
                         !        else if (ia + igl .gt. ib + jgl) then
                         !            sp_matrix%val(pos) = sp_matrix%val(pos) + matrix(ib + jgl,ia + igl)
                         !        end if
                         !    enddo
                         !else
                         !    do jgl=1,ngl
                         !        pos = acum + sp_matrix%len_nodes(imin) * ngl * (igl - 1) - sp_matrix%vec_(igl) + &
                         !              (sp_matrix%conec_new(id)%terms(min(ino,jno))%terms(abs(ino - jno)) - 1) * ngl + jgl - igl + 1
                         !        if (ia + igl .le. ib + jgl) then
                         !            sp_matrix%val(pos) = sp_matrix%val(pos) + matrix(ia + igl,ib + jgl)
                         !        else if (ia + igl .gt. ib + jgl) then
                         !            sp_matrix%val(pos) = sp_matrix%val(pos) + matrix(ib + jgl,ia + igl)
                         !        end if
                         !    enddo
                         !endif
                    enddo
                endif
            enddo
        enddo

        call cpu_time(sp_matrix%tf)
        sp_matrix%tacum = sp_matrix%tacum + sp_matrix%tf - sp_matrix%ti
    end subroutine add_matrix

    subroutine add_elem_conec(sp_matrix,id,len,conec)
        implicit none

        integer(4),intent(in)::id,len
        integer(4),dimension(:),allocatable,intent(inout)::conec
        type(sparse_matrix),intent(inout)::sp_matrix

        call move_alloc(conec,sp_matrix%conec(id)%terms)
        sp_matrix%len_elems(id) = len
        !allocate(sp_matrix%conec(id)%terms(len))
        !sp_matrix%conec(id)%terms = conec
    end subroutine add_elem_conec

    subroutine clear_data(sp_matrix)
        implicit none

        type(sparse_matrix),intent(inout)::sp_matrix

        sp_matrix%val = 0.0d0
        sp_matrix%tacum = 0.0d0
    end subroutine clear_data

    subroutine solve_system_of_equation(sp_matrix, vector)
        ! Solves the system of equation A x = b, given by the sp_matrix
        ! (A) and the vector (b), resulting in the solution (x), using the
        ! direct solver Pardiso from Intel MKL.
        implicit none
        type(sparse_matrix),intent(in)::sp_matrix
        real(8),dimension(sp_matrix%nnodes*sp_matrix%ngl),intent(inout)::vector
        integer(4) :: mtype,maxfct,mnum,phase,n,msglvl,error,nrhs
        integer(8),dimension(:),allocatable :: pt
        integer(4),dimension(:),allocatable :: iparm,perm
        real(8),dimension(:),allocatable :: x
        mtype = -2  !matrix type (-2 <= symmetric indefinite; 2 <= symmetric positive definite)
        maxfct = 1
        mnum = 1
        nrhs = 1
        n = sp_matrix%nnodes*sp_matrix%ngl     !number of equation
        msglvl = 0      !message level information
        allocate(x(n),pt(64),iparm(64),perm(n))
        perm = 0
        call pardisoinit(pt,mtype,iparm)
        phase = 13  !controls the execution of the solver (see MKL reference manual)
        iparm(6) = 1    !The solver stores the solution on 'b' (A.x = b)
        call pardiso(pt,maxfct,mnum,mtype,phase,n,sp_matrix%val,sp_matrix%cum,&
                     sp_matrix%col,perm,nrhs,iparm,msglvl,vector,x,error)
        phase = -1
        call pardiso(pt,maxfct,mnum,mtype,phase,n,sp_matrix%val,sp_matrix%cum,&
                     sp_matrix%col,perm,nrhs,iparm,msglvl,vector,x,error)
    end subroutine solve_system_of_equation

    subroutine add_item(list, term)
        implicit none

        integer(4),dimension(:),allocatable,intent(inout)::list
        integer(4),dimension(:),allocatable::tmp
        integer(4),intent(in) :: term

        if (.not.allocated(list)) then
            allocate(list(1))
            list(1) = term
        else
            call move_alloc(list,tmp)
            allocate(list(size(tmp)+1))
            list(1:size(tmp)) = tmp
            list(size(list)) = term
        end if
    end subroutine add_item

    subroutine set_value_to_row(sp_matrix,row,value)
        ! Sets the given value to all sparse matrix terms in the given row.
        implicit none
        type(sparse_matrix), intent(inout)::sp_matrix
        integer(4),intent(in)::row
        real(8),intent(in)::value
        integer(4)::ind, inf, sup
        inf = sp_matrix%cum(row)
        sup = sp_matrix%cum(row+1)-1
        do ind = inf,sup
            sp_matrix%val(ind) = value
        enddo
    end subroutine set_value_to_row

    subroutine set_value_to_col(sp_matrix,col,value)
        ! Sets the given value to all sparse matrix terms in the given column.
        implicit none
        type(sparse_matrix),intent(inout)::sp_matrix
        integer(4),intent(in)::col
        real(8),intent(in)::value
        integer(4)::ind, inf, sup, row_ind
        do row_ind = 1, col
            inf = sp_matrix%cum(row_ind)
            sup = sp_matrix%cum(row_ind+1)-1
            if ((sp_matrix%col(inf).le.col).and.(sp_matrix%col(sup).ge.col)) then
                do ind=inf,sup
                    if (sp_matrix%col(ind).eq.col) then
                        sp_matrix%val(ind) = value
                        exit
                    elseif (sp_matrix%col(ind).gt.col) then
                        exit
                    endif
                end do
            endif
        enddo
    end subroutine set_value_to_col

    subroutine set_value_in_term(sp_matrix,row,col,value)
        ! Sets the given value in the sparse matrix term, if it exists
        implicit none
        type(sparse_matrix),intent(inout)::sp_matrix
        integer(4),intent(in)::row, col
        real(8),intent(in)::value
        integer(4)::ind
        do ind=sp_matrix%cum(row),sp_matrix%cum(row+1)-1
            if (sp_matrix%col(ind)==col) then
                sp_matrix%val(ind) = value
                return
            end if
        end do
    end subroutine set_value_in_term

end module SPARSE


!
! Distributed under the OSI-approved Apache License, Version 2.0.  See
!  accompanying file Copyright.txt for details.
!
!  adios2_mod.f90 : ADIOS2 Fortran bindings central module
!
!   Created on: Mar 13, 2017
!       Author: William F Godoy godoywf@ornl.gov
!

module adios2

    use adios2_parameters_mod
    use adios2_adios_mod
    use adios2_io_mod
    use adios2_variable_mod
    use adios2_engine_mod
    use adios2_file_mod

end module


    program demo_system_clock
    implicit none
    integer, parameter :: wp = kind(1.0d0)
    integer :: count, count_rate, count_max
    integer :: start, finish
    real    :: time_read

       call system_clock(count, count_rate, count_max)
       write(*,*) count, count_rate, count_max

       call system_clock(start, count_rate)
       ! <<<< code to time
       call system_clock(finish)
       time_read=(finish-start)/real(count_rate,wp)
       write(*,'(a30,1x,f7.4,1x,a)') 'time * : ', time_read, ' seconds'

    end program demo_system_clock


text:
C    @(#)ext_ptiz.f	20.7 5/3/00
C****************************************************************
C
C     File: ext_ptiz.f
C
C     Purpose: Routine to extract zone data in PTI format
C
C     Input parameters:
C
C             savfil   - the logical unit opened
C             version  - "23" or "24"
C
C     Author: Walt Powell  Date: 21 May 1996
C     Called by: saveptid.f
C
C****************************************************************
      integer function ext_ptiz (savfil, version, option)
      integer savfil, version
      character *(*) option(10)

      include 'ipfinc/parametr.inc'

      include 'ipfinc/blank.inc'
      include 'ipfinc/pti_data.inc'
      include 'ipfinc/filnam.inc'
      include 'ipfinc/lfiles.inc'
      include 'ipfinc/prt.inc'
      include 'ipfinc/qksrt.inc'

      common /scratch/ count, array(4,MAXBUS)
      integer count, array

      integer total1, status, write_ge_file
      external kmp_ptiz, swp_ptiz
      character xbuf*132
c
c     Sort zone names
c
      do i = 1, num_znam
         array(1,i) = i
         array(2,i) = 0
         array(3,i) = 0
         array(4,i) = 0
      enddo
      key = 4

      call qiksrt (1, num_znam, kmp_ptiz, swp_ptiz)

      total1 = 0
      do i = 1, num_znam
         indz = array(1,i)
         write (xbuf, 10000) pti_znum(indz), pti_znam(indz)
10000    format (i3, 1x, '''', a, '''')
         last = lastch (xbuf)
         status = write_ge_file (0, xbuf(1:last))
         total1 = total1 + 1
      enddo

      xbuf = ' 0 / Begin Area Interchange "I" Data'
      last = lastch (xbuf)
      status = write_ge_file (0, xbuf(1:last))

      write ( errbuf(1), 10100) total1
10100 format (' Total zones extracted:', i5)

      ext_ptiz = total1

      return
      end

max_stars_repo_name: mbheinen/bpa-ipf-tsp

max_issues_repo_name: cuihantao/bpa-ipf-tsp

max_forks_repo_name: mbheinen/bpa-ipf-tsp


text:
	SUBROUTINE AF_RPHT  ( sjhhh, iret )
C************************************************************************
C* AF_RPHT								*
C*									*
C* This subroutine decodes and stores pressure and height from the	*
C* /JHHH group within a RECCO report.					*
C*									*
C* AF_RPHT  ( SJHHH, IRET )						*
C*									*
C* Input parameters:							*
C*	SJHHH		CHAR*		/JHHH group 			*
C*									*
C* Output parameters:							*
C*	RIVALS (IRPMSL)	REAL		Mean sea level pressure in mb	*
C*	RIVALS (IRVSIG)	REAL		Vertical sounding significance	*
C*	RIVALS (IRPRES)	REAL		Pressure in mb			*
C*	RIVALS (IRHGTM)	REAL		Height in meters		*
C*	IRET		INTEGER		Return code 			*
C*					  0 = normal return 		*
C*									*
C**									*
C* Log:									*
C* J. Ator/NP12		11/96						*
C* J. Ator/NP12		08/97	New interface format, style changes	*
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
	INCLUDE		'afcmn.cmn'
C*
	CHARACTER*(*)	sjhhh
C*
	INCLUDE		'ERMISS.FNC'
C-----------------------------------------------------------------------
	iret = 0
C
C*	Check the length of the input string.
C
	lsjhhh = LEN ( sjhhh )
	IF  ( lsjhhh .ne. 5 )  THEN
	    RETURN
	END IF
C
C*	Check that the first character is a "/".
C
	IF  ( sjhhh (1:1) .ne. '/' )  THEN
	    RETURN
	END IF
C
C*	Convert the encoded values to integer.
C
	CALL ST_INTG  ( sjhhh (2:2), j, ier1 )
	CALL ST_INTG  ( sjhhh (3:5), ihhh, ier2 )
	IF  ( ( ier1 .ne. 0 ) .or. ( ier2 .ne. 0 ) )  THEN
	    RETURN
	END IF
C
	IF  ( j .eq. 0 )  THEN
C
C*	    Mean sea level pressure was reported in lieu of
C*	    a height.  Decode and store this value.
C
	    IF  ( ihhh .le. 100 )  THEN
		pmsl = FLOAT ( 1000 + ihhh )
	    ELSE
		pmsl = FLOAT ( ihhh )
	    END IF
	    rivals ( irpmsl ) = pmsl
	    RETURN
	END IF
C
C*	Decode the pressure and height.
C
	pres = RMISSD
	hgtm = FLOAT ( ihhh )
C
	IF  ( j .eq. 1 )  THEN
	    pres = 200.0
	    hgtm = hgtm * 10.0
	    IF  ( hgtm .lt. 7000 )  THEN
		hgtm = hgtm + 10000.0
	    END IF
	ELSE IF  ( j .eq. 2 )  THEN
	    pres = 850.0
	    IF  ( hgtm .lt. 900 )  THEN
		hgtm = hgtm + 1000.0
	    END IF
	ELSE IF  ( j .eq. 3 )  THEN
	    pres = 700.0
	    IF  ( hgtm .lt. 500 )  THEN
		hgtm = hgtm + 3000.0
	    ELSE
		hgtm = hgtm + 2000.0
	    END IF
	ELSE IF  ( j .eq. 4 )  THEN
	    pres = 500.0
	    hgtm = hgtm * 10.0
	ELSE IF  ( j .eq. 5 )  THEN
	    pres = 400.0
	    hgtm = hgtm * 10.0
	ELSE IF  ( j .eq. 6 )  THEN
	    pres = 300.0
	    hgtm = hgtm * 10.0
	    IF  ( hgtm .lt. 3000 )  THEN
		hgtm = hgtm + 10000.0
	    END IF
	ELSE IF  ( j .eq. 7 )  THEN
	    pres = 250.0
	    hgtm = hgtm * 10.0
	    IF  ( hgtm .lt. 5000 )  THEN
		hgtm = hgtm + 10000.0
	    END IF
	ELSE IF  ( j .eq. 9 )  THEN
	    pres = 925.0
	END IF
C
	IF  ( .not. ERMISS ( pres ) )  THEN
C
C*	    Store the pressure and height along with a vertical
C*	    sounding significance value.
C
C*	    Vertical sounding significance values are stored in the
C*	    interface format as bit flags in accordance with
C*	    WMO BUFR Table 0 08 001.
C
	    rivals ( irvsig ) = 32.0
	    rivals ( irpres ) = pres
	    rivals ( irhgtm ) = hgtm
	END IF
C*
	RETURN
	END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak