lbfgs_jpl_version/lsopt.2/pddot.F

      FUNCTION PDDOT(nmax,X,xn,Y,yn,myid,my_veclen,numprocs)
      implicit none
      include 'mpif.h'

      integer :: xn, yn
      integer :: i,nmax,my_veclen,nwork,mystart,myend
      integer :: ierr, myid, numprocs
      integer :: requests(2)
      integer :: statuses(MPI_STATUS_SIZE,2)

      real(kind=8) :: answer, total, totend, DD
      real(kind=8) :: x(nmax), y(nmax)
      DOUBLE PRECISION PDDOT

      DOUBLE PRECISION DDOT
      EXTERNAL DDOT
      total = 0.0
      totend = 0.0

      nwork = nmax/(my_veclen*numprocs)
      write(*,*) "nwork = ", nwork
      
      do i=1,nwork
        !
        mystart = 1 + (i-1)*(my_veclen*numprocs) + myid*my_veclen
        myend = mystart + my_veclen - 1
!        write(*,*)"myid mystart myend = ", myid, mystart, myend

        answer = DDOT( my_veclen, X(mystart:myend), xn, Y(mystart:myend), yn )
!        write(*,*) "myid answer = ", myid, answer

        call MPI_WAITALL(2,requests,statuses,ierr)
        call MPI_REDUCE(answer,totend,1,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
        total = total + totend
      enddo


      DD = (my_veclen*numprocs)*nwork
!     Finish the rest
      answer = 0.0
      mystart = 1 + DD + myid*my_veclen
      myend = mystart + my_veclen - 1
      if(myend .gt. nmax) myend=nmax
      if (mystart.le.nmax) then
        answer = DDOT( my_veclen, X(mystart:myend), 1, Y(mystart:myend), 1 )
!        write(*,*) "myid answer = ", myid, answer
      endif
      call MPI_WAITALL(2,requests,statuses,ierr)
      call MPI_REDUCE(answer,totend,1,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)

      PDDOT = total + totend

      return
      end function PDDOT
1	heimbach	1.1	FUNCTION PDDOT(nmax,X,xn,Y,yn,myid,my_veclen,numprocs)
2			implicit none
3			include 'mpif.h'
4
5			integer :: xn, yn
6			integer :: i,nmax,my_veclen,nwork,mystart,myend
7			integer :: ierr, myid, numprocs
8			integer :: requests(2)
9			integer :: statuses(MPI_STATUS_SIZE,2)
10
11			real(kind=8) :: answer, total, totend, DD
12			real(kind=8) :: x(nmax), y(nmax)
13			DOUBLE PRECISION PDDOT
14
15			DOUBLE PRECISION DDOT
16			EXTERNAL DDOT
17			total = 0.0
18			totend = 0.0
19
20			nwork = nmax/(my_veclen*numprocs)
21			write(,) "nwork = ", nwork
22
23			do i=1,nwork
24			!
25			mystart = 1 + (i-1)(my_veclennumprocs) + myid*my_veclen
26			myend = mystart + my_veclen - 1
27			! write(,)"myid mystart myend = ", myid, mystart, myend
28
29			answer = DDOT( my_veclen, X(mystart:myend), xn, Y(mystart:myend), yn )
30			! write(,) "myid answer = ", myid, answer
31
32			call MPI_WAITALL(2,requests,statuses,ierr)
33			call MPI_REDUCE(answer,totend,1,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
34			total = total + totend
35			enddo
36
37
38			DD = (my_veclennumprocs)nwork
39			! Finish the rest
40			answer = 0.0
41			mystart = 1 + DD + myid*my_veclen
42			myend = mystart + my_veclen - 1
43			if(myend .gt. nmax) myend=nmax
44			if (mystart.le.nmax) then
45			answer = DDOT( my_veclen, X(mystart:myend), 1, Y(mystart:myend), 1 )
46			! write(,) "myid answer = ", myid, answer
47			endif
48			call MPI_WAITALL(2,requests,statuses,ierr)
49			call MPI_REDUCE(answer,totend,1,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
50
51			PDDOT = total + totend
52
53			return
54			end function PDDOT