Commit fd6a7218 authored by bjb's avatar bjb
Browse files

Optionally read number of threads from subdomain spec file

parent 1513cab9
!$Id: halo_mpi.F90,v 1.15 2008-09-16 10:03:24 kb Exp $
!$Id: halo_mpi.F90,v 1.16 2009-12-11 11:43:20 bjb Exp $
#include "cppdefs.h"
#ifndef HALO
#define HALO 0
......@@ -66,6 +66,9 @@ include "mpif.h"
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: halo_mpi.F90,v $
! Revision 1.16 2009-12-11 11:43:20 bjb
! Optionally read number of threads from subdomain spec file
!
! Revision 1.15 2008-09-16 10:03:24 kb
! added Holtermanns emergency break algorithm
!
......@@ -447,6 +450,7 @@ include "mpif.h"
!
! !INTERFACE:
SUBROUTINE part_domain_mpi(iextr,jextr,kmax,imin,imax,jmin,jmax,ioff,joff)
!$ use omp_lib
IMPLICIT NONE
!
! !DESCRIPTION:
......@@ -470,7 +474,7 @@ include "mpif.h"
! Original author(s): Karsten Bolding & Hans Burchard
!
! !LOCAL VARIABLES:
integer :: i,j,zz(2),neighbours(nneighbours)
integer :: i,j,zz(2),neighbours(nneighbours),numthreads
character(len=*),parameter:: par_setup="par_setup.dat"
!EOP
!-------------------------------------------------------------------------
......@@ -523,7 +527,7 @@ include "mpif.h"
#endif
case(MESH_FROM_FILE)
call read_par_setup(par_setup,nprocs,myid,imax,jmax,iextr,jextr, &
ioff,joff,neighbours)
ioff,joff,neighbours,numthreads)
left = neighbours(1) ; if (left .eq. -1) left = MPI_PROC_NULL
ul = neighbours(2) ; if (ul .eq. -1) ul = MPI_PROC_NULL
up = neighbours(3) ; if (up .eq. -1) up = MPI_PROC_NULL
......@@ -532,6 +536,13 @@ include "mpif.h"
lr = neighbours(6) ; if (lr .eq. -1) lr = MPI_PROC_NULL
down = neighbours(7) ; if (down .eq. -1) down = MPI_PROC_NULL
ll = neighbours(8) ; if (ll .eq. -1) ll = MPI_PROC_NULL
! IF we use OMP and IF the number of read threads is sensible (>0), then set #threads:
!$ if (numthreads>0) then
!$ LEVEL1 'Setting number of threads to ',numthreads
!$ call omp_set_num_threads(numthreads)
!$ end if
!$ LEVEL1 'Number of threads is ',omp_get_max_threads()
case default
FATAL 'A non valid partitioning method has been chosen'
call MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
......
!$Id: read_par_setup.F90,v 1.3 2005-04-29 12:51:59 kbk Exp $
!$Id: read_par_setup.F90,v 1.4 2009-12-11 11:43:20 bjb Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -7,7 +7,7 @@
!
! !INTERFACE:
subroutine read_par_setup(fn,nprocs,myid,imax,jmax,iextr,jextr, &
ioff,joff,neighbours)
ioff,joff,neighbours,numthreads)
!
IMPLICIT NONE
!
......@@ -17,7 +17,7 @@
integer, intent(in) :: imax,jmax,iextr,jextr
!
! !OUTPUT PARAMETERS:
integer, intent(out) :: ioff,joff,neighbours(8)
integer, intent(out) :: ioff,joff,neighbours(8),numthreads
!
! !DESCRIPTION:
! Test the content of a file with neighbour list information.
......@@ -30,17 +30,21 @@
!
! !REVISION HISTORY:
! 2002-02-12 Bjarne Buchmann (bjb@fomfrv.dk) Initial code
! 2009-10-22 Bjarne Buchmann (bjb@frv.dk) Add read number threads per subdomain
!
! !LOCAL VARIABLES:
integer :: myid_read
integer :: nprocs_read,err,ijob,ioff_read,joff_read
integer :: imax_read,jmax_read,iextr_read,jextr_read
integer :: iline, njob, nnjob, ineigh
integer, allocatable :: neighbourlist(:,:)
integer :: iline, njob, nnjob, ineigh, nthreads_read
integer :: thislineok
integer, allocatable :: neighbourlist(:,:), nthreads(:)
integer :: neighbour_inverse(8) = &
(/5, 6, 7, 8, 1, 2, 3, 4/)
integer, parameter :: false_flag = -2 ! No-good PID
integer, parameter :: iunit=87 ! check 87 KBK
character(len=255) :: line
integer :: iostat,iostat2
!
!EOP
!-------------------------------------------------------------------------
......@@ -48,8 +52,19 @@
! Read #jobs, test vs. actual nprocs in use
open(unit=iunit,file=fn)
iline = 1
read(iunit,*,err=1010,end=1020) nprocs_read
iline = 0 ! Index for line number in file
thislineok = 0 ! Flag for this line read OK
do while (thislineok .eq. 0 .and. iostat == 0)
iline=iline+1
read(iunit,'(A)',iostat=iostat,end=1020,err=1010) line
! skip comments and empty lines
if (line(1:1) == '#' .or. line(1:1) == '!' .or. &
len(trim(line)) == 0 ) then
else
read(line,*,err=1010,end=1020) nprocs_read
thislineok=1
end if
end do
if (nprocs_read /= nprocs) then
FATAL 'read_par_setup: Number of jobs do not match'
......@@ -61,13 +76,26 @@
allocate(neighbourlist(0:nprocs-1,8),stat=err)
if (err /= 0) &
stop 'read_par_setup: Error allocating memory (neighbourlist)'
allocate(nthreads(0:nprocs-1),stat=err)
if (err /= 0) &
stop 'read_par_setup: Error allocating memory (nthreads)'
!
! Flag all neighbourlists to be "unrecongnized value"
neighbourlist(:,:) = false_flag
!
iline = 2
read(iunit,*,err=1010,end=1020) &
imax_read,jmax_read,iextr_read,jextr_read
nthreads(:) = -1
!
thislineok = 0
do while (thislineok .eq. 0 .and. iostat == 0)
iline=iline+1
read(iunit,'(A)',iostat=iostat,end=1020,err=1010) line
if (line(1:1) == '#' .or. line(1:1) == '!' .or. &
len(trim(line)) == 0 ) then
else
read(line,*,err=1010,end=1020) &
imax_read,jmax_read,iextr_read,jextr_read
thislineok=1
end if
end do
if (iextr_read /= iextr .OR. jextr_read /= jextr) then
FATAL 'read_par_setup: Global grid sizes do not match'
......@@ -84,14 +112,34 @@
end if
!
! Read following lines (one per job)
do ijob=0,nprocs-1
iline = iline+1
read(iunit,*,err=1010,end=1020) &
myid_read,ioff_read,joff_read,neighbours
thislineok = 0
do while (thislineok .eq. 0 .and. iostat == 0)
iline=iline+1
read(iunit,'(A)',iostat=iostat,end=1020,err=1010) line
if (line(1:1) == '#' .or. line(1:1) == '!' .or. &
len(trim(line)) == 0 ) then
else
! Read lines of format:
! ID IOFF JOFF 8xNEIGHs numThr
! Accept older format without "numThr" (number of threads)
! First try new format:
read(line,*,iostat=iostat2) &
myid_read,ioff_read,joff_read,neighbours,nthreads_read
if (iostat2 .ne. 0) then
! Try alternative old format
read(line,*,err=1010,end=1020) &
myid_read,ioff_read,joff_read,neighbours
nthreads_read=0
end if
thislineok=1
end if
end do
if(myid_read .eq. myid) then
ioff = ioff_read
joff = joff_read
numthreads = nthreads_read
end if
!
! Perform straight-forward tests on this input:
......@@ -158,7 +206,7 @@
end do
LEVEL1 'read_par_setup: Consistency OK'
rewind(iunit,err=1030)
close(iunit)
neighbours(1:8) = neighbourlist(myid,1:8)
return
......@@ -173,10 +221,6 @@
FATAL 'read_par_setup: Premature EOF at line',iline
stop
1030 continue
FATAL 'read_par_setup: Could not rewind input file'
stop
end subroutine read_par_setup
!EOC
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment