PRACE NPT

      program mod2b

! ----------------------------------------------------------------------

! **********************************************************************

! *** This program is part of the Euroben Benchmark                  ***

! ***                                                                ***

! *** Copyright: EuroBen Group p/o                                   ***

! ***            Utrecht University, Computational Physics Dept.     ***

! ***            P.O. Box 80.000                                     ***

! ***            3508 TA Utrecht                                     ***

! ***            The Netherlands                                     ***

! ***                                                                ***

! *** Author of this program: Ruud van der Pas                       ***

! *** Date                    11/24/1988                             ***

! *** Modified by:            Peter de Rijk                          ***

! *** Date                    02/12/1993                             ***

! *** Modified by:            Gerrit Kolthof                         ***

! *** Date                    02/12/1999 (inserted MPI calls)        ***

! *** Modified by:            Aad van der Steen                      ***

! *** Date                    Autumn 2003                            ***

! **********************************************************************

! ----------------------------------------------------------------------

! --- Version 1.1 (Parallel, MPI).

!- Purpose of program mod2b

!  ------------------------

!  This program solves a linear system Ax = b for a general matrix A

!  of orders as specified in the input file 'mod2b.in'.

! ----------------------------------------------------------------------

      Use                      numerics

      Use                      dist_module

      Implicit                 None

      Include                  'mpif.h'

      Integer               :: m, n, i, j, lda, nrep, nval, ierr

      Real(l_)              :: bmin, bmax

      Real(l_), Allocatable :: a(:,:), b(:)

      Integer, Allocatable  :: ipvt(:)

      Real(l_)              :: gltime, gltime1, gltime2, t1, 

     &                         time1, time2, totime

      Real(l_)              :: start_time, end_time

      Real(l_)              :: ops, speed, comtime

      Logical               :: ok

! -----------------------------------------------------------------------

! ---Set up communication and print status information.

      Call csetup

      start_time = MPI_Wtime()

      If ( me == 0 ) Call state( 'mod2b   ' )

      Open( 1, File = 'mod2b.in' )

      If ( me == 0 ) Print 1000, nodes

   10 Read( 1, *, End = 20 ) n, nrep

      lda = n + 1

      m   = n

      Allocate( a(lda,n), b(n), ipvt(n) )

      ops = ((2.0_l_*n)*n*n)/3.0_l_ + (2.0_l_*n)*n

      time1 = 0.0_l_

      time2 = 0.0_l_

      Call distribute( n, 8 ) 

! --- Generate  matrix.

      Do i = 1, nrep

         Call matgen( m, n, a, lda, b )

! ---Factorise.

         Call MPI_Barrier( MPI_Comm_World, ierr )

         t1 = MPI_Wtime()

         Call getf2( m, n, a, lda, ipvt, ierr ) 

         time1 = time1 + ( MPI_Wtime() - t1 )

! --- Stop on error.

         If ( ierr /= 0 ) Then

            If ( me == 0 ) Print 2000, 'GETF2 ', ierr

            Call MPI_Finalize( ierr )

            Stop

         End If

! --- Solve P*L*U*X=B

         Call MPI_Barrier( MPI_Comm_World, ierr )

         t1 = MPI_Wtime()

         Call getrs( m, n, a, lda, ipvt, b, ierr )

         time2 = time2 + ( MPI_Wtime() - t1 )

! --- Stop on error.

         If ( ierr /= 0 ) Then

            If ( me == 0 ) Print 2000, 'GETRS ', ierr

            Call MPI_Finalize( ierr )

            Stop

         End If

      End Do

      Call check( b, n, ok )

      time1  = time1/nrep

      time2  = time2/nrep

      totime = time1 + time2

! --- Get global wallclock times.

      Call MPI_Reduce( time1, gltime1, 1, MPI_Real8, MPI_Max, 0,

     &                 MPI_Comm_World, ierr )

      Call MPI_Reduce( time2, gltime2, 1, MPI_Real8, MPI_Max, 0,

     &                 MPI_Comm_World, ierr )

      Call MPI_Reduce( totime, gltime, 1, MPI_Real8, MPI_Max, 0,

     &                 MPI_Comm_World, ierr )

      speed  = 1.0e-6_l_*ops/Max( 1.0e-9_l_, gltime )

      If ( me == 0 ) Print 1010, n, gltime1, gltime2, gltime, speed, ok

      Deallocate( a, b, ipvt )

      Call cleanup

      Go To 10

   20 If ( me == 0 ) Print 1020

      end_time =  MPI_Wtime() - start_time

      If (me == 0) Then

         Write(6,22) 'Walltime: ', end_time, " s"

 22      Format(A,F9.3,A)

      End If

      Call MPI_Finalize(ierr)

! ----------------------------------------------------------------------

1000  Format( 'Full linear solver test, No. of procs = ', i3, ':'/

     &        '-----------------------------------------------',

     &        '-------------------'/,

     &        ' Order |  Factoris. |  Solving   |    Total   |',

     &        '    Speed   |     |'/,

     &        '   n   |  Time (s)  |  Time (s)  |  Time (s)  |',

     &        '  (Mflop/s) | OK? |'/,

     &        '-----------------------------------------------',

     &        '-------------------' )

 1010 Format( i6, ' |', g11.4, ' |', g11.4, ' |', g11.4,' |', g11.4,

     &        ' |', l3, '  |' )

 1020 Format( '-----------------------------------------------',

     &        '-------------------' )

 2000 Format( i6 )

! -----------------------------------------------------------------------

      End Program mod2b