text:
      FUNCTION K71R(J,M,K,L,R,JA)
C BY JAMES E HILL
C TYPED BY JM 3/16/79
      K71R=JA       ! Added 7/32/93 to report own old value
      IF (M .EQ. 1) GOTO 1700
      IF (M .EQ. 2) GOTO 1600
      IF (J .EQ. 0) GOTO 1000
      IB = IB + 1
      IF (IB .EQ. 2) GOTO 500
      K71R = 0
500   K71R = 1
      IB = 0
      GOTO 1710
1000  IA = IA + 1
      IF (IA .EQ. 2) GOTO 110
      K71R = 0
      GOTO 1710
110   K71R = 1
      IA = 0
      GOTO 1710
1600  K71R = 1
      IF (J .EQ. 1) K71R = 0
      GOTO 1710
1700  IA = 0
      IB = 0
      K71R = 0
1710  RETURN
      END

max_stars_repo_name: Axelrod-Python/TourExec

max_issues_repo_name: Axelrod-Python/TourExec

max_forks_repo_name: Axelrod-Python/TourExec


text:
program array_copy_mpi
  ! Example of sending/receiving an array of integers using MPI.
  ! Listing 1.2 in the book.
  use mpi
  implicit none

  integer :: ierr, nproc, procsize, request
  integer :: stat(mpi_status_size)

  integer :: array(5) = 0
  integer, parameter :: sender = 0, receiver = 1

  call mpi_init(ierr)
  call mpi_comm_rank(mpi_comm_world, nproc, ierr)
  call mpi_comm_size(mpi_comm_world, procsize, ierr)

  if (procsize /= 2) then
    call mpi_finalize(ierr)
    error stop 'Error: This program must be run on 2 parallel processes'
  end if

  if (nproc == sender) array = [1, 2, 3, 4, 5]

  print '(a,i2,a,5(4x,i2))', 'array on proc ', nproc, ' before copy:', array

  call mpi_barrier(mpi_comm_world, ierr)

  if (nproc == sender) then
    call mpi_isend(array, size(array), mpi_int, receiver, 1, &
                   mpi_comm_world, request, ierr)
  else if (nproc == receiver) then
    call mpi_irecv(array, size(array), mpi_int, sender, 1, &
                   mpi_comm_world, request, ierr)
    call mpi_wait(request, stat, ierr)
  end if

  print '(a,i2,a,5(4x,i2))', 'array on proc ', nproc, ' after copy: ', array

  call mpi_finalize(ierr)

end program array_copy_mpi

max_stars_repo_name: wilsonify/c-consumer

max_issues_repo_name: wilsonify/c-consumer

max_forks_repo_name: wilsonify/c-consumer


text:
      subroutine fmc11e(a,n,z,w,ir)
c   multiply a vector z by the inverse of the factors given in a
      implicit double precision (a-h,o-z)
      dimensiona(*),z(n),w(n)
      if(ir.lt.n)return
      w(1)=z(1)
      if(n.gt.1)goto 400
      z(1)=z(1)/a(1)
      return
  400 continue
      do 402 i=2,n
      ij=i
      i1=i-1
      v=z(i)
      do 401 j=1,i1
      v=v-a(ij)*z(j)
  401 ij=ij+n-j
      w(i)=v
  402 z(i)=v
      z(n)=z(n)/a(ij)
      np=n+1
      do 411 nip=2,n
      i=np-nip
      ii=ij-nip
      v=z(i)/a(ii)
      ip=i+1
      ij=ii
      do 410 j=ip,n
      ii=ii+1
  410 v=v-a(ii)*z(j)
  411 z(i)=v
      return
      end

ext: f

max_stars_repo_name: alpgodev/numx

max_issues_repo_name: alpgodev/numx

max_forks_repo_name: alpgodev/numx


text:
      subroutine cdrssd(adhfs,adhfsd,advfs,advfsd,axhfs,axhfsd,
     $ axlks,axlksd,axvfs,axvfsd,cdrs,cdrsd,ipch,ipchmx,ipcv,ipcvmx,
     $ narxmx,nbasp,nbaspd,nbtmax,ndrs,ndrsd,ndrsmx,ndrsr,ndrsrd,
     $ nstmax,ntprmx)
c
c     This subroutine copies the reactions and reaction properties as
c     they are currently written into the 'd' set.
c
c     This subroutine is called by:
c
c       EQ3NR/eq3nr.f
c       EQ6/eq6.f
c
c-----------------------------------------------------------------------
c
c     Principal input:
c
c       adhfs  = standard array of coefficients for computing
c                  pressure derivatives of enthalpy functions as a
c                  function of temperature
c       advfs  = standard array of coefficients for computing
c                  pressure derivatives of volume functions as a
c                  function of temperature
c       axhfs  = standard array of coefficients for computing
c                  enthalpy functions as a function of temperature
c       axlks  = standard array of coefficients for computing
c                  equilibrium constants as a function of temperature
c       axvfs  = standard array of coefficients for computing
c                  volume functions as a function of temperature
c       cdrs   = standard array of reaction coefficients
c       narxmx = number of coefficient elements of axlks per species
c                  per temperature range
c       nbtmax = maximum number of basis species
c       ndrs   = standard  array of indices of species corresponding to
c                  reaction coefficients
c       ndrsr  = standard pointer array for indices of species appearing
c                  in reactions
c       nstmax = maximum number of species
c       ntprmx = maximum number of temperature ranges
c
c     Principal output:
c
c       adhfsd = 'data file' array of coefficients for computing
c                  pressure derivatives of enthalpy functions as a
c                  function of temperature
c       advfsd = 'data file' array of coefficients for computing
c                  pressure derivatives of volume functions as a
c                  function of temperature
c       axhfsd = 'data file' array of coefficients for computing
c                  enthalpy functions as a function of temperature
c       axlksd = 'data file' array of coefficients for computing
c                  equilibrium constants as a function of temperature
c       axvfsd = 'data file' array of coefficients for computing
c                  volume functions as a function of temperature
c       cdrsd  = 'data file' array of reaction coefficients
c       ndrsd  = 'data file'  array of indices of species corresponding
c                  to reaction coefficients
c       ndrsrd = 'data file' pointer array for indices of species
c                  appearing in reactions
c
c-----------------------------------------------------------------------
c
      implicit none
c
c-----------------------------------------------------------------------
c
c     Calling sequence variable declarations.
c
      integer ipchmx,ipcvmx,narxmx,nbtmax,ndrsmx,nstmax,ntprmx
c
      integer nbasp(nbtmax),nbaspd(nbtmax),ndrs(ndrsmx),ndrsd(ndrsmx),
     $ ndrsr(2,nstmax),ndrsrd(2,nstmax)
      integer ipch,ipcv
c
      real*8 adhfs(narxmx,ntprmx,ipchmx,nstmax),
     $ adhfsd(narxmx,ntprmx,ipchmx,nstmax),
     $ advfs(narxmx,ntprmx,ipcvmx,nstmax),
     $ advfsd(narxmx,ntprmx,ipcvmx,nstmax),
     $ axhfs(narxmx,ntprmx,nstmax),axhfsd(narxmx,ntprmx,nstmax),
     $ axlks(narxmx,ntprmx,nstmax),axlksd(narxmx,ntprmx,nstmax),
     $ axvfs(narxmx,ntprmx,nstmax),axvfsd(narxmx,ntprmx,nstmax),
     $ cdrs(ndrsmx),cdrsd(ndrsmx)
c
c-----------------------------------------------------------------------
c
c     Local variable declarations.
c
      integer jhmax,jvmax,nmax
c
c-----------------------------------------------------------------------
c
      nmax = narxmx*ntprmx*nstmax
      jhmax = narxmx*ntprmx*ipchmx*nstmax
      jvmax = narxmx*ntprmx*ipcvmx*nstmax
c
      call copyaa(axlks,axlksd,nmax)
c
      if (ipch .ge. 0) then
        call copyaa(axhfs,axhfsd,nmax)
        if (ipch .ge. 1) call copyaa(adhfs,adhfsd,jhmax)
      endif
c
      if (ipcv .ge. 0) then
        call copyaa(axvfs,axvfsd,nmax)
        if (ipcv .ge. 1) call copyaa(advfs,advfsd,jvmax)
      endif
c
      nmax = 2*nstmax
      call copyia(ndrsr,ndrsrd,nmax)
c
      call copyaa(cdrs,cdrsd,ndrsmx)
      call copyia(ndrs,ndrsd,ndrsmx)
c
      call copyia(nbasp,nbaspd,nbtmax)
c
      end