      PROGRAM NODE12
C
C     PROBLEM 12
C
C  REFERENCE:  PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
C              CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
C              JOHN R. RICE, MAY 1, 1985
C
C              REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
C
C
C      *************************************************
C      *      Adapted for FORTRAN D benchmarking       *
C      *    by  T. HAUPT  (haupt@sccs.npac.syr.edu)    *
C      *                                               *
C      *    Northeast Parallel Architectures Center    *
C      *   at Syracuse University, Syracuse, NY, USA   *
C      *************************************************
C
C
C       VERSION MIMD/iPSC860-1.00-NODE   (F77+mp)
C       ==================================================
C
      INCLUDE 'picl_def.h'
      DOUBLE PRECISION HOST_SEC, NODE_SEC, STARTTIME
      INTEGER*4 TIMESIZE, TIMETYPE
      DATA TIMESIZE,TIMETYPE /8,10/
      INTEGER*4 ME,HOST,ALLNODES
      INTEGER*4 NPROCS,TOP,ORD,DIR
      INTEGER*4 INITTYPE
      DATA INITTYPE /1/
      DATA TOP,ORD,DIR,ALLNODES /1,1,1,-1/
C -----------------------------------------------------------
C           parameters of the initial broadcast
C -----------------------------------------------------------
      INTEGER*4 MSG(2),MSGSIZE
      DATA MSGSIZE /8/
      EQUIVALENCE (MSG(1),NK),(MSG(2),MK)
C -----------------------------------------------------------
C      parameters of messages with partial results
C -----------------------------------------------------------
      INTEGER*4 BYTES
      REAL RES1,RES2,B(4),BUF1,BUF2
      INTEGER*4 MSG1,MSG2,MSG3
      DATA MSG1,MSG2,MSG3 /25,26,27/
      DATA BYTES /4/

      INTEGER NK,MK
      REAL TP1,TP2
      INTEGER NDIM,MDIM,ND1,MD1,I,J
      PARAMETER (NDIM=1023,MDIM=511,ND1=NDIM+1,MD1=MDIM+1)
      REAL A(NDIM,MDIM),R(MDIM),C(NDIM),ABIG(ND1,MD1)
      REAL ACORN
      INTEGER WEDGE,EEDGE,SEDGE,NEDGE
      INTEGER I1,J1,NX2,NY2
      INTEGER NPROCX,NPROCY,NX,NY
      CALL open0(NPROCS,ME,HOST)
      CALL setarc0(NPROCS,TOP,ORD,DIR)

  100 CONTINUE
      STARTTIME=clock0()
      CALL bcast0(MSG,MSGSIZE,INITTYPE,HOST)
      IF(NK.GT.0) THEN
        IF (ME.LT.NPROCS) THEN


      WEDGE=0
      SEDGE=0
      NEDGE=0
      EEDGE=0

      CALL DISTRIB(NPROCS,NK+1,MK+1,NX,NY,NPROCX,NPROCY)

      MEY=ME/NPROCX+1
      MEX=(ME+1)-(MEY-1)*NPROCX

      NX2=NX
      NY2=NY
      IF(MEX*NX.GT.NK+1) NX2=NK-(NPROCX-1)*NX+1
      IF(MEY*NY.GT.MK+1) NY2=MK-(NPROCY-1)*NY+1

      IF(MEX.EQ.1)        NEDGE=1
      IF(MEX.EQ.NPROCX)   SEDGE=1
      IF(MEY.EQ.1)        WEDGE=1
      IF(MEY.EQ.NPROCY)   EEDGE=1

C
C


C       initialize data

        DO I=1,NX2-SEDGE
           I1=I+(MEX-1)*NX
           DO J=1,NY2-EEDGE
              J1=J+(MEY-1)*NY
              A(I,J)=I1+J1
           ENDDO
        ENDDO

        IF(SEDGE.EQ.1) THEN
           DO J=1,NY-EEDGE
              R(J)=1.0+(J+(MEY-1)*NY)
           ENDDO
        ENDIF

        IF(EEDGE.EQ.1) THEN
          DO I=1,NX-SEDGE
             C(I)=1.0-(I+(MEX-1)*NX)
          ENDDO
        ENDIF

        ACORN=0.5

C       compute  ABIG matrIx

        DO I=1,NX2-SEDGE
         DO J=1,NY2-EEDGE
          ABIG(I,J)=A(I,J)
         ENDDO
        ENDDO

       IF(SEDGE.EQ.1) THEN
         DO J=1,NY2-EEDGE
            ABIG(NX2,J)=R(J)
         ENDDO
       ENDIF

       IF(EEDGE.EQ.1) THEN
         DO I=1,NX2-SEDGE
           ABIG(I,NY2)=C(I)
         ENDDO
       ENDIF

       IF(EEDGE*SEDGE.EQ.1) ABIG(NX2,NY2)=ACORN



C      ABIG done
C      compute result

       IF(MEX.EQ.1.AND.MEY.EQ.1) THEN
        BUFF=ABIG(1,1)
        CALL send0(BUFF,BYTES,MSG1,HOST)
       ENDIF
       IF(MEX.EQ.1.and.MEY.EQ.NPROCY) THEN
        BUFF=ABIG(1,NY2)
        CALL send0(BUFF,BYTES,MSG2,HOST)
       ENDIF
       IF(MEX.EQ.NPROCX.AND.MEY.EQ.NPROCY) THEN
        B(1)=ABIG(NX2-1,NY2-1)
        B(2)=ABIG(NX2,NY2-1)
        B(3)=ABIG(NX2-1,NY2)
        B(4)=ABIG(NX2,NY2)
        CALL send0(B,4*BYTES,MSG3,HOST)
       ENDIF


      NODE_SEC=clock0()-STARTTIME

      IF(ME.EQ.0) CALL send0(NODE_SEC,TIMESIZE,TIMETYPE,HOST)
      GOTO 100
      ENDIF

      ELSE

      CALL close0(1)
      WRITE(6,*) 'end of the job on node', ME
      STOP

      ENDIF
      END

        subroutine distrib(n,nsize,msize,nx,ny,nxp,nyp)

        implicit none
        integer n,nsize,msize,nx,ny,nxp,nyp

        if(n.eq.1) then
          nxp=1
          nyp=1
        elseif(n.eq.2) then
          if(nsize.gt.msize) then
            nxp=2
            nyp=1
           else
            nxp=1
            nyp=2
          endif
         elseif(n.eq.4) then
            nxp=2
            nyp=2
         elseif(n.eq.8) then
          if(nsize.gt.msize) then
            nxp=4
            nyp=2
           else
            nxp=2
            nyp=4
          endif
         elseif(n.eq.16) then
            nxp=4
            nyp=4
         elseif(n.eq.32) then
          if(nsize.gt.msize) then
            nxp=8
            nyp=4
           else
            nxp=4
            nyp=8
          endif
         else
            print *, 'wrong number of processors ',n
            print *, '1 processor assumed'
            nxp=1
            nyp=1
         endif

        nx=(nsize+nxp-1)/nxp
        ny=(msize+nyp-1)/nyp

         return
         end







