c**********************************************************************
c  Common Basic Routine Test Program
c
c  1998 1/18
c    composed by H.Kuroda
c
c***********************************************************************
c   All Rights Reserved, Copyright (C) 1998, H.Kuroda
c/*-
c * Copyright (c) 1998 Information Promotion Agency of Japan and H.Kuroda
c * All rights reserved.
c *
c * Redistribution and non-commercial use in source and binary forms,
c * with or without modification, are permitted provided that the following
c * conditions are met:
c *
c * 1. Redistributions of source code must retain the above copyright
c *    notice, this list of conditions and the following disclaimer.
c *
c * 2. Redistributions in binary form must reproduce the above copyright
c *    notice, this list of conditions and the following disclaimer in the
c *    documentation and/or other materials provided with the distribution.
c *
c * 3. All advertising materials mentioning features or use of this
c *    software must display the following acknowledgement:
c *
c *    This product includes software developed by Information Promotion
c *    Agency of Japan and H.Kuroda
c *
c * 4. The name "Information Promotion Agency" or "H.Kuroda" should not be
c *    used to endorse or promote products derived from this software
c *    without specific prior written permission.
c *
c * 5. Any use of the source code or the binary in a commercial product,
c *    whether may it be the origial representation or in some modified form,
c *    is not permitted without specific prior written permission.
c *
c * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
c * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
c * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
c * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
c * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
c * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
c * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
c * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
c * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
c * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
c * SUCH DAMAGE.
c */

      INCLUDE 'mppf.f'
      PROGRAM MAIN
      INCLUDE 'mppf.h'
      INTEGER A(16),B(16)
      INTEGER IPE,IALL,ISTATUS,IERR
      INTEGER IMAX1,IMAX2
      INTEGER ISTATUS(MPP_STATUS_SIZE)

      CALL MPP_INIT(IERR)
      CALL MPP_COMM_RANK(MPP_COMM_WORLD,IPE,IERR)
      CALL MPP_COMM_SIZE(MPP_COMM_WORLD,IALL,IERR)

      IF( IPE.EQ.0 ) THEN
	 PRINT *,"Common Basic Routine Test Program Start!"
      ENDIF
      
      PRINT *,"PE=",IPE, "  NUMBER OF PE=",IALL

      IF( IPE.EQ.0 )THEN
        A(1)=13
        A(2)=-7
        A(3)=0
        A(4)=-123
        B(1)=5
        B(2)=-3
        B(3)=1
        B(4)=0
      END IF

      CALL MPP_BARRIER(MPP_COMM_WORLD,IERR)

      IF( IPE.EQ.0 )THEN
          CALL MPP_SEND(A,4,MPP_INTEGER,1,1,MPP_COMM_WORLD,IERR)
      ENDIF

      IF( IPE.EQ.1 )THEN
        PRINT *,"PE=",IPE
        CALL MPP_RECV(A(1),4,MPP_INTEGER,0,1,MPP_COMM_WORLD,
     1                ISTATUS,IERR)
        PRINT *,"PE=",IPE,"  A(4)=",A(1),A(2),A(3),A(4)
      ENDIF

      CALL MPP_BARRIER(MPP_COMM_WORLD,IERR)
      CALL MPP_BCAST(B,4,MPP_INTEGER,0,MPP_COMM_WORLD,IERR)

      PRINT *,"PE=",IPE,"  B(4)=",B(1),B(2),B(3),B(4)

      IMAX1=IPE*2
      CALL MPP_ALLREDUCE(IMAX1,IMAX2,1,MPP_INTEGER,MPP_MAX,
     1                   MPP_COMM_WORLD,IERR)

      PRINT *,"PE=",IPE,"  NUM=",IMAX1,"  MAX=",IMAX2

      CALL MPP_FINALIZE(MPP_COMM_WORLD,IERR)

      IF( IPE.EQ.0 ) THEN
	  PRINT *,"Error Message Test Start"
          PRINT *,"ERROR CODE=1100  MESSAGE:"
	  CALL ERROR_STRING(1100)
          PRINT *,"ERROR CODE=1200  MESSAGE:"
	  CALL ERROR_STRING(1200) 
          PRINT *,"ERROR CODE=1300  MESSAGE:"
	  CALL ERROR_STRING(1300) 
          PRINT *,"ERROR CODE=1400  MESSAGE:"
	  CALL ERROR_STRING(1400) 
      END