C
C $Id: balance.F,v 1.6 1998/12/08 20:46:51 arjan Exp arjan $
C
C------------------------------------------------------------------------
C JV Replace these two routines with just second sort by time
C JV routine but for first pass fill in time_subs with
C JV the orbital counts instead of actual times
C JV and just use that to balance by


      subroutine balance_bynorbs
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"

#ifdef MPI 
#include "mpif.h"
	integer target,total(maxproc),min_sum
	integer min_pe,sub_nums(maxSUB),sub_norbs(maxSUB),sum
	logical used

C JV sort times into decreasing order to get better distribution
        sum = 0
	my_numsubs = 0
	do i = 1,nproc
	   total(i) = 0
	enddo
	do i = 1,NSUB
	   sub_nums(i) = i
           NORBSK = IORBPT(i+1)-IORBPT(i)
           sub_norbs(i) = NORBSK
	   sum = sum + time_subs(i)
	enddo
	target = sum/nproc
	call bsort(nsub,sub_norbs,sub_nums)
	
C Distribute 1 subsystem to each PE, biggest times first
	do i = 1,nproc
	   isub = NSUB-(i-1)
           total(i) = total(i) + sub_norbs(isub)
C Make sure only PE getting the subsys updates it's list
	   if (myid+1 .EQ. i ) then
	      my_numsubs = my_numsubs + 1
	      my_subs(my_numsubs) = sub_nums(isub)
	   endif
        enddo

C Place remaining subsystems in PE with least increase in total time
        do i = NSUB-nproc,1,-1
C Place next subsystem in bin (PE) with smallest total time so far
	     min_sum = total(1)
	     min_pe = 1
	     do j = 2,nproc
	       if( total(j) .LT. min_sum) then
	         min_sum = total(j)
	         min_pe = j
	       endif
	     enddo
             total(min_pe) = total(min_pe) + sub_norbs(i)
	     if (myid+1 .EQ. min_pe ) then
	        my_numsubs = my_numsubs + 1
	        my_subs(my_numsubs) = sub_nums(i)
	     endif
	 enddo
	return
#endif
	end

      subroutine balance_bytime
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"

#ifdef MPI 
       double precision  target,total(maxproc),min_sum,sum
       integer min_pe,sub_nums(maxSUB)

C JV sort times into decreasing order to get better distribution
        sum = 0.0
	my_numsubs = 0
	do i = 1,nproc
	   total(i) = 0.0
	enddo
	do i = 1,NSUB
	   sub_nums(i) = i
	   sum = sum + time_subs(i)
	enddo
	target = sum/nproc

	call rsort(nsub,time_subs,sub_nums)

C Distribute 1 subsystem to each PE, biggest times first
	do i = 1,nproc
	   isub = NSUB-(i-1)
           total(i) = total(i) + time_subs(isub)
C Make sure only PE getting the subsys updates it's list
	   if (myid+1 .EQ. i ) then
	      my_numsubs = my_numsubs + 1
	      my_subs(my_numsubs) = sub_nums(isub)
	   endif
        enddo

C Place remaining subsystems in PE with least increase in total time
        do i = NSUB-nproc,1,-1
C Place next subsystem in bin (PE) with smallest total time so far
	     min_sum = total(1)
	     min_pe = 1
	     do j = 2,nproc
	       if( total(j) .LT. min_sum) then
	         min_sum = total(j)
	         min_pe = j
	       endif
	     enddo
             total(min_pe) = total(min_pe) + time_subs(i)
	     if (myid+1 .EQ. min_pe ) then
	        my_numsubs = my_numsubs + 1
	        my_subs(my_numsubs) = sub_nums(i)
	     endif
	 enddo

	return
#endif
	end


      subroutine mpi_error_check(ierror)
C JV Check a few possible errors that would only happen if running
C JV parallel version

      implicit double precision(a-h,o-z)
#include "divcon.dim"
#include "divcon.h"

#ifdef MPI 
      integer ierror

      ierror = 0

C JV Make sure doing direct - only direct supported in parallel
	if(index(keywrd,'DIRECT') .EQ. 0)  then
             ierror = 1
             write(iscr,'("--------MPI FATAL ERROR---------",/,
     &            "MPI PARALLEL VERSION ONLY SUPPORTS DIRECT",/,
     &            "CALCULATIONS. SPECIFY DIRECT KEYWORD IN INPUT",/,
     &            "TO USE PARALLEL VERSION.")')
	endif
C JV Number of subsystems must be greater than number of procs
!       if (nsub .GT. nproc) then
!            ierror = 2
!            write(iscr,'("---------MPI FATAL ERROR---------",/,
!    &            "Number of processors must be less than or equal",/,
!    &            "to the number of subsystems.",/,
!    &            "Number `of subsystems: ",i10,/,
!    &            "Number of processors: ",i10,/,
!    &            "Decrease processors used or change subsetting.")')
!    &            nsub, nproc
!       endif
	if (MSVAL .GT. MXDIAT ) then
	  ierror = 3
	  write(iscr,'("--------MPI FATAL ERROR---------",/,
     &         "TMP_MPI ARRAY NOT LARGE ENOUGH ",/,
     &         "TMP_MPI ARRAY SIZE: ",i10,/,
     &         "MSVAL: ",i10,/,
     &         "MXDIAG: ",i10)') mxdiat, msval, mxdiag
	endif	

        return
#endif
      end