Commit a1b4ee7a authored by kbk's avatar kbk
Browse files

new parallel related files

parent 302bd888
This diff is collapsed.
!$Id: halo_zones.F90,v 1.1 2003-04-07 12:05:42 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: halo_zones - update halo zones in 'getm'
!
! !INTERFACE:
module halo_zones
! !DESCRIPTION:
! This module is included only to supply myid and nprocs used in various
! places in 'getm'. From version 1.4 real use of MPI will be implemented.
!
! !USES:
#ifdef PARALLEL
use halo_mpi
#endif
IMPLICIT NONE
!
! !PUBLIC MEMBER FUNCTIONS:
public init_halo_zones,update_2d_halo,update_3d_halo,wait_halo
!
! !PUBLIC DATA MEMBERS:
#ifndef PARALLEL
integer, parameter :: H_TAG=10,HU_TAG=11,HV_TAG=12
integer, parameter :: D_TAG=20,DU_TAG=21,DV_TAG=22
integer, parameter :: z_TAG=30,U_TAG=31,V_TAG=32
#endif
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: halo_zones.F90,v $
! Revision 1.1 2003-04-07 12:05:42 kbk
! new parallel related files
!
! Revision 1.1.1.1 2002/05/02 14:01:29 gotm
! recovering after CVS crash
!
! !LOCAL VARIABLES:
#ifndef PARALLEL
integer, parameter :: nprocs=1
#endif
!EOP
!-----------------------------------------------------------------------
!BOC
contains
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_halo_zones -
!
! !INTERFACE:
subroutine init_halo_zones()
IMPLICIT NONE
!
! !DESCRIPTION:
! Initialize Parallel environment
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! !LOCAL VARIABLES:
!
!EOP
!-------------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'init_halo_zones'
#endif
#ifdef DEBUG
write(debug,*) 'Leaving init_halo_zones()'
write(debug,*)
#endif
return
end subroutine init_halo_zones
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: update_2d_halo - updates the halo zones for 2D fields.
!
! !INTERFACE:
subroutine update_2d_halo(f1,f2,mask,imin,jmin,imax,jmax,tag)
IMPLICIT NONE
!
! !DESCRIPTION:
! Print information on the MPI environment
!
! !INPUT PARAMETERS:
integer, intent(in) :: imin,jmin,imax,jmax
integer, intent(in) :: tag
integer, intent(in) :: mask(-HALO+1:,-HALO+1:)
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE, intent(inout) :: f1(E2DFIELD),f2(E2DFIELD)
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! !LOCAL VARIABLES:
integer :: i,j,k
integer :: il,jl,ih,jh
!EOP
!-------------------------------------------------------------------------
!BOC
#if 0
select case (tag)
case(HU_TAG, U_TAG , DU_TAG) ! for variables defined on u-grid
il=imin;ih=imax-1;jl=jmin;jh=jmax
case(HV_TAG, V_TAG , DV_TAG) ! for variables defined on v-grid
il=imin;ih=imax;jl=jmin;jh=jmax-1
case default ! for variables defined on scalar-grid
il=imin;ih=imax;jl=jmin;jh=jmax
end select
#endif
il=imin;ih=imax;jl=jmin;jh=jmax
if (nprocs .eq. 1) then
f1(il-1, : ) = f2(il, : )
f1(ih+1, : ) = f2(ih, : )
f1( :, jl-1 ) = f2( :, jl )
f1( :, jh+1 ) = f2( :, jh )
else
#ifdef PARALLEL
call update_2d_halo_mpi(f1,f2,imin,jmin,imax,jmax,tag)
#endif
end if
return
end subroutine update_2d_halo
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: update_3d_halo - updates the halo zones for 3D fields.
!
! !INTERFACE:
subroutine update_3d_halo(f1,f2,mask,iimin,jjmin,iimax,jjmax,kmax,tag)
IMPLICIT NONE
!
! !DESCRIPTION:
! Print information on the MPI environment
!
! !INPUT PARAMETERS:
integer, intent(in) :: iimin,jjmin,iimax,jjmax,kmax
integer, intent(in) :: tag
integer, intent(in) :: mask(-HALO+1:,-HALO+1:)
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE, intent(inout):: f1(I3DFIELD),f2(I3DFIELD)
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! !LOCAL VARIABLES:
integer :: i,j,k
integer :: il,jl,ih,jh
!EOP
!-------------------------------------------------------------------------
!BOC
#if 0
select case (tag)
case(HU_TAG, U_TAG , DU_TAG) ! for variables defined on u-grid
il=iimin;ih=iimax-1;jl=jjmin+1;jh=jjmax-1
il=iimin;ih=iimax-1;jl=jjmin;jh=jjmax
case(HV_TAG, V_TAG , DV_TAG) ! for variables defined on v-grid
il=iimin+1;ih=iimax-1;jl=jjmin;jh=jjmax-1
il=iimin;ih=iimax;jl=jjmin;jh=jjmax-1
case default ! for variables defined on scalar-grid
il=iimin;ih=iimax;jl=jjmin;jh=jjmax
end select
#endif
il=iimin;ih=iimax;jl=jjmin;jh=jjmax
if (nprocs .eq. 1) then
f1(il-1, : , : ) = f2(il, : , : )
f1(ih+1, : , : ) = f2(ih, : , : )
f1( : , jl-1, : ) = f2( : , jl, : )
f1( : , jh+1, : ) = f2( : , jh, : )
else
#ifdef PARALLEL
call update_3d_halo_mpi(f1,f2,iimin,jjmin,iimax,jjmax,kmax,tag)
#endif
end if
return
end subroutine update_3d_halo
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: wait_halo - waits for any un-finished communications
!
! !INTERFACE:
subroutine wait_halo(tag)
IMPLICIT NONE
!
! !DESCRIPTION:
! Print information on the MPI environment
!
! !INPUT PARAMETERS:
integer, intent(in) :: tag
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! !LOCAL VARIABLES:
!EOP
!-------------------------------------------------------------------------
!BOC
#ifdef PARALLEL
!kbk if (nprocs .gt. 1) then
call wait_halo_mpi(tag)
!kbk end if
#endif
return
end subroutine wait_halo
!EOC
!-----------------------------------------------------------------------
end module halo_zones
!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding (BBH) !
!-----------------------------------------------------------------------
!$Id: parallel.F90,v 1.1 2003-04-07 12:05:42 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: parallel - mpi interface to 'getm'
!
! !INTERFACE:
module kurt_parallel
!
! !DESCRIPTION:
!
! !USES:
#ifdef PARALLEL
use halo_mpi, only: init_mpi,print_MPI_info,myid
#endif
IMPLICIT NONE
!
! !PUBLIC DATA MEMBERS:
#ifndef PARALLEL
integer, parameter :: myid=-1
#endif
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: parallel.F90,v $
! Revision 1.1 2003-04-07 12:05:42 kbk
! new parallel related files
!
! Revision 1.1.1.1 2002/05/02 14:01:29 gotm
! recovering after CVS crash
!
! Revision 1.4 2001/06/22 08:19:10 bbh
! Compiler options such as USE_MASK and OLD_DRY deleted.
! Open and passive boundary for z created.
! Various inconsistencies removed.
! wait_halo added.
! Checked loop boundaries
!
! Revision 1.3 2001/05/18 12:53:08 bbh
! Prepared for mask in update_2d_halo - but not used yet
!
! Revision 1.2 2001/05/18 10:03:44 bbh
! Added mask in parameter list to update_3d_halo()
!
! Revision 1.1.1.1 2001/04/17 08:43:08 bbh
! initial import into CVS
!
! !LOCAL VARIABLES:
!EOP
!-----------------------------------------------------------------------
contains
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_parallel - initialize MPI environment
!
! !INTERFACE:
subroutine init_parallel(runid,input_dir)
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*) :: runid,input_dir
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !DESCRIPTION:
! Initialize Parallel environment
!
! !REVISION HISTORY:
!
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
#ifdef PARALLEL
logical :: TO_FILE=.true.
character(len=3) :: buf
character(len=16) :: pid,ext
character(len=PATH_MAX) :: fname
#endif
!
!EOP
!-------------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'init_parallel'
#endif
#ifdef PARALLEL
call init_mpi(input_dir)
call print_MPI_info()
if (TO_FILE) then
if (myid .ge. 0) then
write(buf,'(I3.3)') myid
pid = '.' // TRIM(buf)
else
pid = ''
end if
ext = 'stderr'
fname = TRIM(runid) // TRIM(pid) // '.' // ext
open(stderr,file=Fname)
ext = 'stdout'
fname = TRIM(runid) // TRIM(pid) // '.' // ext
open(stdout,file=Fname)
end if
call print_MPI_info()
#endif
#ifdef DEBUG
write(debug,*) 'Leaving init_parallel()'
write(debug,*)
#endif
return
end subroutine init_parallel
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: clean_parallel - close down the parallel environment
!
! !INTERFACE:
subroutine clean_parallel()
IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !DESCRIPTION:
! Initialize Parallel environment
!
! !REVISION HISTORY:
!
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
#ifdef PARALLEL
integer :: ierr
#endif
!EOP
!-------------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'clean_parallel'
#endif
#ifdef PARALLEL
if(myid .ge. 0) then
call MPI_Finalize(ierr)
end if
#endif
#ifdef DEBUG
write(debug,*) 'Leaving clean_parallel()'
write(debug,*)
#endif
return
end subroutine clean_parallel
!EOC
!-----------------------------------------------------------------------
end module kurt_parallel
!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding (BBH) !
!-----------------------------------------------------------------------
!$Id: read_par_setup.F90,v 1.1 2003-04-07 12:05:42 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: read_par_setup - test input file integrity
!
! !INTERFACE:
subroutine read_par_setup(fn,nprocs,myid,imax,jmax,iextr,jextr, &
ioff,joff,neighbours)
!
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn ! file to read from
integer, intent(in) :: nprocs,myid ! Number of jobs actually started.
integer, intent(in) :: imax,jmax,iextr,jextr
!
! !OUTPUT PARAMETERS:
integer, intent(out) :: ioff,joff,neighbours(8)
!
! !DESCRIPTION:
! Test the content of a file with neighbour list information.
! At the time of calling, the file must be opened and rewound.
! The routine will then rewind the file after use.
!
! The global grid has extent 1:iextr,1:jextr
! The local grid has extent imin:imax,jmin:jmax,
! where it is assumed that imin=jmin=1.
!
! !REVISION HISTORY:
! 2002-02-12 Bjarne Buchmann (bjb@fomfrv.dk) Initial code
!
! !LOCAL VARIABLES:
integer, allocatable:: neighbourlist(:,:)
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 :: 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
!
!EOP
!-------------------------------------------------------------------------
!BOC
! Read #jobs, test vs. actual nprocs in use
STDERR fn
open(unit=iunit,file=fn)
iline = 1
read(iunit,*,err=1010,end=1020) nprocs_read
if (nprocs_read /= nprocs) then
FATAL 'read_par_setup: Number of jobs do not match'
FATAL ' Expected value ',nprocs
FATAL ' Read value ',nprocs_read
stop
end if
allocate(neighbourlist(0:nprocs-1,8),stat=err)
if (err /= 0) &
stop 'read_par_setup: Error allocating memory (neighbourlist)'
!
! 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
if (iextr_read /= iextr .OR. jextr_read /= jextr) then
FATAL 'read_par_setup: Global grid sizes do not match'
FATAL ' Expected ',iextr,' by ',jextr
FATAL ' Read ',iextr_read,' by ',jextr_read
stop
end if
if (imax_read /= imax .OR. jmax_read /= jmax) then
FATAL 'read_par_setup: Local grid sizes do not match'
FATAL ' Expected ',imax,' by ',jmax
FATAL ' Read ',imax_read,' by ',jmax_read
stop
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
if(myid_read .eq. myid) then
ioff = ioff_read
joff = joff_read
end if
!
! Perform straight-forward tests on this input:
if ( ((ioff_read+imax) .LT. 1) .OR. ((joff_read+jmax) .LT. 1) .OR. &
(ioff_read .GT. iextr).OR. (joff_read.GT. jextr) ) then
FATAL 'read_par_setup: Line ',iline
FATAL ' Local grid fully outside global grid'
stop
end if
if (myid_read < 0 .OR. minval(neighbours)<-1) then
FATAL ' read_par_setup: Negative job ID on line ',iline
stop
end if
if (myid_read > nprocs-1 .OR. maxval(neighbours)> nprocs-1 ) then
FATAL 'read_par_setup: Job ID appears too large on line ',iline
stop
end if
if (neighbourlist(myid_read,1) .NE. false_flag) then
FATAL 'read_par_setup: Line ',iline
FATAL ' Job ID ',myid_read,' included twice '
stop
end if
!
! Store in local array
neighbourlist(myid_read,1:8) = neighbours(1:8)
end do
!
! Test whether the entire neighbour array is coherent...
do ijob = 0,nprocs-1
if (minval(neighbourlist(ijob,:))<-1) then
FATAL ' read_par_setup: Job ID ',ijob, &
'does not seem to be specified'
stop
end if
!
! Test each neighbour for consistency on the basic notion that
! "my right-hand-side neighbour's left-hand-side neighbour
! should be myself". The vector neighbour_inverse contains the
! "right-hand-side to left-hand-side" relations.
! The "inverse lookup list" functions so that my neighbour(i) should
! have me as neighbour neighbour_inverse(i)
! Neighbours are indexed clock-wise starting with WEST.
! This makes the vector have the form
! (/5, 6, 7, 8, 1, 2, 3, 4/)
!
do ineigh=1,8
njob = neighbourlist(ijob,ineigh)
!KBKSTDERR njob
if (njob .gt. -1) then
nnjob = neighbourlist(njob,neighbour_inverse(ineigh))
if ( nnjob .ne. ijob ) then
FATAL 'read_par_setup: Neighbourlist inconsistency'
FATAL ' Neighbour no. ',ineigh,'of job ',ijob,' is ',njob
FATAL ' BUT Neighbour ',neighbour_inverse(ineigh),'of job ', &
njob,' is NOT ',ijob
FATAL ' (rather, it is ',nnjob,')'
stop
end if
end if
end do
end do
LEVEL1 'read_par_setup: Consistency OK'
rewind(iunit,err=1030)
neighbours(1:8) = neighbourlist(myid,1:8)
return
!
! Capture errors:
1010 continue
FATAL 'read_par_setup: Unexpected format at line ',iline
stop
1020 continue
FATAL 'read_par_setup: Premature EOF at line',iline
stop
1030 continue
FATAL 'read_par_setup: Could not rewind input file'
stop