CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C     Express initialization procedure (1-D)   - 4/24/92
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine EXP_init_1(nproc1,block)

C      implicit none
      integer nproc1, block

      integer env(4), status, myid, numpe, nprocs(3), grids
      integer intsize, realsize, dpsize
      INTEGER minLoc1, maxLoc1, minLoc2, maxLoc2, coord(3)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      common /varsize/ intsize, realsize, dpsize
      common /kxparms/ myid, numpe, grids, nprocs
      COMMON /g_to_l/minLoc1, maxLoc1, minLoc2, maxLoc2, coord
      data intsize, realsize, dpsize /4, 4, 8/
 
C
C--   set up Express
C
      call KXINIT
C
C--   get runtime parameters
C
      call KXPARA(env)

      myid = env(1)
      numpe = env(2)
      grids = 1
      nprocs(1) = nproc1
      nprocs(2) = 0
C
C--   make sure system configuration is same as user specified
C
      if (numpe .NE. nprocs(1)) then
         print *, '*** ERROR: system configuration inconsistent'
         return
      end if
C
C--   set up one dimension mesh
C
      status = KXGDIN(grids, nprocs)
      if (status .LT. 0) then
         print *, '*** ERROR: Failed at KXGDIN'
         return
      endif
      status = kxgdco(myid, coord)     

      minLoc1 = coord(1)*block +1
      maxLoc1 = minLoc1 + block - 1      

      return
      end



CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine broadcast_r(ibuf, idims, ibuf_info, 
     &     obuf, odims, obuf_info, origins)

C      implicit none
      real ibuf(*), obuf(*)
      integer idims, ibuf_info(5,*)
      integer odims, obuf_info(5,*)
      integer origins(*)

      real ibuffer(10000), obuffer(10000)
      integer itotal, ototal
      integer grids, nprocs(3)
      integer myid, numpe, intsize, realsize, dpsize
      integer perbc(3), lnode, rnode, status, type
      integer iitems, oitems, isrc, odest
      integer ilen, olen, i
      integer source, coord(2)

      COMMON/XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
      common /kxparms/ myid, numpe, grids, nprocs
      common /varsize/ intsize, realsize, dpsize

      data type /49/
C     
C--   turn off periodic boundary conditions
C
      do i = 1, grids
         perbc(i) = 0
      end do
      call KXGDBC(perbc)

C
C--   convert origin (coordinates) to processor id
C
      source = KXGDPR(origins)

      if (myid .EQ. source) then

C         do i = 1, 60, 5
C            print 120, obuf(i), obuf(i+1), obuf(i+2), obuf(i+3), 
C     &           obuf(i+4)
C 120        format (i6, i6, i6, i6, i6)
C         end do

C--   prepare output data
C
         if (odims .EQ. 0) then
            ototal = 1
            obuffer(1) = obuf(1)
         else if ((odims .GT. 0) .AND. (odims .LE. 7)) then
            call prepare_odata(obuf, odims, obuf_info, obuffer, ototal)
         else 
            print *, ' *** ERROR: obuf bigger than 7-dim'
            stop
         endif

         status = KXBROD(ototal, source, realsize, IALNOD, 0, type)
         if (status .LT. 0) then
            print *, 'PE ', myid, ' Failed at KXBROD - send ototal'
            stop
         endif

         status = KXBROD(obuffer, source, realsize*ototal, 
     &        IALNOD, 0, type)
         if (status .LT. 0) then
            print *, 'PE ', myid, ' Failed at KXBROD - send'
            stop
         endif

         if (idims .EQ. 0) then
            itotal = 1
            ibuf(1) = obuffer(1)
         else if ((idims .GT. 0) .AND. (idims .LE. 7)) then
            call prepare_idata(ibuf, idims, ibuf_info, obuffer, itotal)
         else 
            print *, ' *** ERROR: ibuf bigger than 7-dim'
            stop
         endif

C         do i = 1, ototal
C            print 100, myid, i, obuffer(i)
C 100        format (' myid = ', i2, '   obuffer(', i4, ') = ', i8)
C         end do

      else
         status = KXBROD(ototal, source, realsize, IALNOD, 0, type)
         if (status .LT. 0) then
            print *, 'PE ', myid, ' Failed at KXBROD - receive ototal'
            stop
         endif

         status = KXBROD(ibuffer, source, realsize*ototal, 
     &        IALNOD, 0, type)
         if (status .LT. 0) then
            print *, 'PE ', myid, ' Failed at KXBROD - receive'
            stop
         endif

C         if (myid .EQ. 3) then
C            do i = 1, ototal
C               print 110, myid, i, ibuffer(i)
C 110           format (' myid = ', i2, '   ibuffer(', i4, ') = ', i8)
C            end do
C         endif

C--   prepare output data
C
         if (idims .EQ. 0) then
            itotal = 1
            ibuf(1) = ibuffer(1)
         else if ((idims .GT. 0) .AND. (idims .LE. 7)) then
            call prepare_idata(ibuf, idims, ibuf_info, ibuffer, itotal)
         else 
            print *, ' *** ERROR: ibuf bigger than 7-dim'
            stop
         endif

C         if (myid .EQ. 3) then
C            print *, ' ototal = ', ototal, ', itotal = ', itotal
C         endif

      endif

      if (ototal .NE. itotal) then
         print *, ' *** ERROR: itotal != ototal'
      endif

C     print *, 'PE = ', myid, ' routinr end'
C      call kmulti(6)
C      print *, 'PE = ',myid,',ibuffer = ', ibuffer(1),
C     &     ', obuffer = ', obuffer(1)
C      call kflush(6)
      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine prepare_odata(obuf, odim, oinfo, obuffer, ototal)

C      implicit none
      real obuf(*), obuffer(*)
      integer odim, oinfo(5,*), ototal

      integer i, k, m, n, o, p, q, r, s
      integer oblock(7), loc(7), here
      integer maxdim
      data maxdim /7/
      
      oblock(1) = 1
      do i = 2, odim
         oblock(i) = oblock(i-1) * (oinfo(4,i-1) - oinfo(3,i-1) + 1)
      end do

      do i = odim+1, maxdim
         oblock(i) = 0
         oinfo(1,i) = 1
         oinfo(2,i) = 1
         oinfo(5,i) = 1
      end do

      k = 0
      loc(1) = oinfo(3,1) - 1

      do m = oinfo(1,7), oinfo(2,7), oinfo(5,7)
         loc(7) = oblock(7) * (m - oinfo(3,7))
      do n = oinfo(1,6), oinfo(2,6), oinfo(5,6)
         loc(6) = loc(7) + oblock(6) * (n - oinfo(3,6))
      do o = oinfo(1,5), oinfo(2,5), oinfo(5,5)
         loc(5) = loc(6) + oblock(5) * (o - oinfo(3,5))        
      do p = oinfo(1,4), oinfo(2,4), oinfo(5,4)
         loc(4) = loc(5) + oblock(4) * (p - oinfo(3,4))
      do q = oinfo(1,3), oinfo(2,3), oinfo(5,3)
         loc(3) = loc(4) + oblock(3) * (q - oinfo(3,3))
         do r = oinfo(1,2), oinfo(2,2), oinfo(5,2)
            loc(2) = loc(3) + oblock(2) * (r - oinfo(3,2)) - loc(1)
            do s = oinfo(1,1), oinfo(2,1), oinfo(5,1)
               here = loc(2) + s
               k = k + 1
               obuffer(k) = obuf(here)
            end do
         end do
      end do
      end do
      end do
      end do
      end do

      ototal = k

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      subroutine prepare_idata(ibuf, idim, iinfo, ibuffer, itotal)

C      implicit none
      real ibuf(*), ibuffer(*)
      integer idim, iinfo(5,*), itotal

      integer i, k, m, n, o, p, q, r, s
      integer iblock(7), loc(7), here
      integer maxdim
      data maxdim /7/
      
      iblock(1) = 1
      do i = 2, idim
         iblock(i) = iblock(i-1) * (iinfo(4,i-1) - iinfo(3,i-1) + 1)
      end do

      do i = idim+1, maxdim
         iblock(i) = 0
         iinfo(1,i) = 1
         iinfo(2,i) = 1
         iinfo(5,i) = 1
      end do

      k = 0
      loc(1) = iinfo(3,1) - 1

      do m = iinfo(1,7), iinfo(2,7), iinfo(5,7)
         loc(7) = iblock(7) * (m - iinfo(3,7))
      do n = iinfo(1,6), iinfo(2,6), iinfo(5,6)
         loc(6) = loc(7) + iblock(6) * (n - iinfo(3,6))
      do o = iinfo(1,5), iinfo(2,5), iinfo(5,5)
         loc(5) = loc(6) + iblock(5) * (o - iinfo(3,5))        
      do p = iinfo(1,4), iinfo(2,4), iinfo(5,4)
         loc(4) = loc(5) + iblock(4) * (p - iinfo(3,4))
      do q = iinfo(1,3), iinfo(2,3), iinfo(5,3)
         loc(3) = loc(4) + iblock(3) * (q - iinfo(3,3))
         do r = iinfo(1,2), iinfo(2,2), iinfo(5,2)
            loc(2) = loc(3) + iblock(2) * (r - iinfo(3,2)) - loc(1)
            do s = iinfo(1,1), iinfo(2,1), iinfo(5,1)
               here = loc(2) + s
               k = k + 1
               ibuf(here) = ibuffer(k)
            end do
         end do
      end do
      end do
      end do
      end do
      end do

      itotal = k

      return
      end


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC


      subroutine EXP_init_2(nproc1,nproc2,block1,block2)

C      implicit none
      integer nproc1,nproc2, block1,block2

      integer env(4), status, myid, numpe, nprocs(3), grids
      integer intsize, realsize, dpsize
      INTEGER minLoc1, maxLoc1, minLoc2, maxLoc2, coord(3)

      COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
c      common /varsize/ intsize, realsize, dpsize
      common /kxparms/ myid, numpe, grids, nprocs
      COMMON /g_to_l/minLoc1, maxLoc1, minLoc2, maxLoc2, coord
      data intsize, realsize, dpsize /4, 4, 8/
 
C
C--   set up Express
C
      call KXINIT
C
C--   get runtime parameters
C
      call KXPARA(env)

      myid = env(1)
      numpe = env(2)
      grids = 2
      nprocs(1) = nproc2
      nprocs(2) = nproc1
      nprocs(3) = 0
C
C--   make sure system configuration is same as user specified
C
      if (numpe .NE. (nprocs(1)*nprocs(2))) then
         print *, '*** ERROR: system configuration inconsistent'
         return
      end if
C
C--   set up one dimension mesh
C
      status = KXGDIN(grids, nprocs)
      if (status .LT. 0) then
         print *, '*** ERROR: Failed at KXGDIN'
         return
      endif
      status = kxgdco(myid, coord)     

      minLoc1 = coord(2)*block1 +1
      maxLoc1 = minLoc1 + block1 - 1      

      minLoc2 = coord(1)*block2 +1
      maxLoc2 = minLoc2 + block2 - 1      

      return
      end


