C -*- Fortran -*-
      program main
      implicit none
      include 'mpif.h'

      integer :: mpimax,i,j,itag,ierr,k
      real*8 :: y,z,cptime,cputotal,cptdum,cput_process,sum

C we allow maximally 500 processes
      parameter (mpimax=500)
      integer :: mpierror, mpisize, mpirank
      integer :: status(MPI_STATUS_SIZE)
      dimension CPUT_process(0:mpimax)


C start the parallelization
      call MPI_Init(mpierror)
      call MPI_Comm_size(MPI_COMM_WORLD, mpisize, mpierror)
      if (mpisize.gt.mpimax) then
       write(6,*) ' we allow maximally ',mpimax,' processes '
       write(6,*) ' but you asked for ',mpisize,' processes '
       stop
      end if
      call MPI_Comm_rank(MPI_COMM_WORLD, mpirank, mpierror)

C-----------------------------------
C
      call system(' echo "  execution host is : `hostname`"')

       WRITE(6,*) ' a small test program '
       write(6,*) ' process ',mpirank,'/',mpisize
       call system(' echo "  execution host is : `hostname`"')
C
      if (mpirank.eq.0) CALL DATING('MPIPERF ',1)

C close the first printing section
C
      CALL TIMING('FRST')

      call mpi_barrier(MPI_COMM_WORLD,ierr)

      z=0.D0
      do i=1,100
       do j=1,100
        do k=1,100
         y=sin(dble(2*i+j+3*k))
         y=y*y-exp(abs(y))
         z=z+2.D0+y*exp(-abs(y)) + mpirank
        end do
       end do
      end do
      write(6,*) ' i j k ',i,j,k
      write(6,*) ' proc No :', mpirank,' has z = ',z

      CALL TIMING('END ')
      call mpi_barrier(MPI_COMM_WORLD,ierr)

      CALL MPI_REDUCE(z, sum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0,
     -  MPI_COMM_WORLD,ierr)
      if (mpirank.eq.0) write(6,*) ' sum = ', sum

      IF (MPIRANK.NE.0) then
       CPTDUM=CPTIME(1)
       itag=27
       call mpi_send(CPTDUM,1,MPI_DOUBLE_PRECISION,0,itag
     -          ,MPI_COMM_WORLD,ierr)
      else
       CPUT_PROCESS(0)=CPTIME(1)
       CPUTOTAL=CPUT_PROCESS(0)
       do i=1,mpisize-1
         itag=27
         call mpi_recv(CPTDUM,1,MPI_DOUBLE_PRECISION,i,itag
     -   ,MPI_COMM_WORLD,status,ierr)
        CPUT_PROCESS(I)=CPTDUM
        CPUTOTAL=CPUTOTAL+CPUT_PROCESS(I)
       end do
      end if

      call MPI_Finalize(mpierror)

      if (mpirank.eq.0) then
       do i=0,mpisize-1
        WRITE(6,9654) i,cput_process(i)
       end do
       WRITE(6,9655) cputotal
 9654  format('  CPU-time spent on process No ',i4,' is ',F12.3,' sec')
 9655  format(1X,70('-')
     -   ,/,'  Total accumulated cputime is ',F20.3,' sec')

       CALL DATING('MPIPERF ',2)
      end if

      end

      SUBROUTINE CPUTIM(TIM)
      IMPLICIT REAL*8 (A-H,O-Z)
C
C     UNIX SYSTEM
C
      REAL T(2),SEC1,ETIME
      SEC1=ETIME(T)
      TIM=DBLE(T(1)+T(2))
C
C dummy
C
C     TIM=0.
C
C  AIX/PS2     
C
C     INTEGER CLOCK
C     I=CLOCK(I)
C     TIM=DBLE(I/1000000.)
C
C RS6000 
C
C     REAL T
C     T=MCLOCK(TIMES)
C     TIM=T/100.
      RETURN
      END
C
      REAL*8 FUNCTION CPTIME(I)
      IMPLICIT REAL*8 (A-H,O-Z)
      INTEGER I
C
      IF (I.EQ.1) THEN
       CALL CPUTIM(X)
       CPTIME=X
      ELSEIF (I.EQ.4.OR.I.EQ.3) THEN
       CALL CPUTIM(X)
       IX1=INT(X/3600.)
       IX2=INT((X-REAL(IX1*3600))/60.)
       X2=X-REAL(IX1*3600 + IX2*60)
       IF (I.EQ.4) THEN
        CALL TIMING(' ALL ')
        WRITE(6,*)
        WRITE (6,9991) IX1,IX2,X2
       END IF
 9991  FORMAT(' TOTAL CPUTIME: ',I5,' hrs '
     -     ,I3,' mins and ',f7.4,' secs')
       CPTIME=X
      ENDIF
      RETURN
      END
C
      SUBROUTINE SECNND(X)
      REAL*8 X,CPTIME
      X=CPTIME(1)
      RETURN
      END
C
      SUBROUTINE TIMG(NOMZ)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      CHARACTER*4 NOMZ
      CALL SECNND(FT)
      WRITE(6,100)NOMZ,FT
 100  FORMAT(1X,53('T'),1X,A4,' CPU',F11.3)
      RETURN
      END
C
      SUBROUTINE TIMING(NOMZ)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      CHARACTER*4 NOMZ
      CALL SECNND(FT)
      WRITE(6,100)NOMZ,FT
 100  FORMAT(1X,53('T'),1X,A4,' CPU',F11.3)
CF    CALL FLUSH(6)
      RETURN
      END
C
      SUBROUTINE DATIM(A,B)
      CHARACTER*8 A,B
      CHARACTER*24 DATE
      CHARACTER*3 MON(12)
      CHARACTER*2 M(13)
      DATA MON /'Jan','Feb','Mar','Apr','May','Jun','Jul',
     *                    'Aug','Sep','Oct','Nov','Dec'/
      DATA M /'01','02','03','04','05','06','07','08',
     *                   '09','10','11','12','**'/
      DO 3 I=1,24
3     DATE(I:I)='-'
      CALL FDATE(DATE)
      DO 1 I=1,12
      IF (DATE(5:7).EQ.MON(I)) GOTO 2
1     CONTINUE
      I=13
2     CONTINUE
      A(1:2)=DATE(9:10)
      A(3:3)='.'
      A(4:5)=M(I)
      A(6:6)='.'
      A(7:8)=DATE(23:24)
      B(1:8)=DATE(12:19)
      RETURN
      END
C
      SUBROUTINE DATING(PNAME,IACT)
      CHARACTER*8 PNAME,A,B
      CALL DATIM(A,B)
C remove leading or trailing blanks from pname
      IFST=1
 100  CONTINUE
      IF (PNAME(IFST:IFST).EQ.' ') THEN
       IFST=IFST+1
       IF (IFST.LT.8) GO TO 100
      END IF
      ILST=8
      IF (IFST.EQ.8) GO TO 300
 200  CONTINUE
      IF (PNAME(ILST:ILST).EQ.' ') THEN
       ILST=ILST-1
       IF (ILST.GT.1) GO TO 200
      END IF
 300  CONTINUE

      IF (IACT.EQ.1) THEN
       WRITE(6,9901) PNAME(IFST:ILST),A,B
      ELSE IF (IACT.EQ.2) THEN
       WRITE(6,9902) PNAME(IFST:ILST),A,B
      ELSE 
       WRITE(6,9903) PNAME(IFST:ILST),A,B
      END IF
 9901 FORMAT(//,' Started ',A,';  date: ',A8,' time: ',A8,//)
 9902 FORMAT(//,' Finished ',A,';  date: ',A8,' time: ',A8,//)
 9903 FORMAT(//,1X,A,';  date: ',A8,' time: ',A8,//)
      RETURN
      END
C