Commit ab7a36b2 authored by kbk's avatar kbk
Browse files

re-ordered files related to parallel execution

parent 391ac373
#$Id: Makefile,v 1.2 2002-05-02 15:04:42 gotm Exp $
#
# Makefile to build the mpi interface library - libhalo.a
#
include ../Rules.make
#DEFINES += -DSTATIC
LIB = $(LIBDIR)/libhalo${buildtype}.a
MODSRC = parallel.F90 halo_zones.F90 halo_mpi.F90
LIBSRC =
SRC = $(MODSRC) $(LIBSRC)
ifeq ($(parallel),false)
MOD = \
${LIB}(parallel.o)
else
MOD = \
${LIB}(halo_mpi.o) \
${LIB}(halo_zones.o)
endif
ifeq ($(parallel),false)
OBJ =
else
OBJ = \
${LIB}(halo_test.o)
endif
all: modules objects
modules: $(MOD)
objects: $(OBJ)
#objects:
halo_test: modules objects
$(FC) -o $@ $(LIB) -L$(MPILIBDIR) -lmpich
doc:
$(PROTEX) $(SRC) > $(DOCDIR)/halo.tex
clean:
$(RM) $(LIB) $(MODDIR)/halo.{m.mod}
$(RM) ??-{domain,west,north,east,south} halo_test
realclean: clean
$(RM) *.o
distclean: realclean
#-----------------------------------------------------------------------
# Copyright (C) 2001 - Hans Burchard and Karsten Bolding (BBH) !
#-----------------------------------------------------------------------
This diff is collapsed.
#include "cppdefs.h"
program main
use halo_zones, only: init_halo_zones,wait_halo
use halo_zones, only: update_2d_halo,update_3d_halo,set_active_communicator
use halo_zones, only: myid, nprocs, comm_hd
IMPLICIT NONE
#ifndef SYLT_TEST
integer, parameter :: iextr=175,jextr=158,kmax=5
#endif
#ifdef STATIC
#ifdef SYLT_TEST
!#include "/home/kbk/getm-cases/v1.x/sylt/sylt.dim"
#include "/home/kbk/BBH/frv/setups/dk_06nm/dk_06nm.dim
#else
integer, parameter :: imin=1,imax=6,jmin=1,jmax=6
! integer, parameter :: imin=1,imax=iextr,jmin=1,jmax=jextr
integer, parameter :: iimin=imin,iimax=imax,jjmin=jmin,jjmax=jmax
#endif
REALTYPE :: A(E2DFIELD)
REALTYPE :: B(I3DFIELD)
integer :: mask(E2DFIELD)
#else
#ifdef SYLT_TEST
integer, parameter :: iextr=135,jextr=160,kmax=10
#endif
integer :: imin,imax,jmin,jmax
integer :: iimin,iimax,jjmin,jjmax
REALTYPE, DIMENSION(:,:), ALLOCATABLE :: A
REALTYPE, DIMENSION(:,:,:), ALLOCATABLE :: B
integer, DIMENSION(:,:), ALLOCATABLE :: mask
#endif
integer :: domain=19
integer :: west=20,north=21,east=22,south=23
character(len=20) :: fname,fw,fn,fe,fs
integer :: i,j,k,n,ierr
logical :: parallel=.true.
! logical :: parallel=.false.
integer :: id
if(parallel) then
call init_halo_zones(parallel,iextr,jextr,imin,imax,jmin,jmax,kmax)
else
call init_halo_zones(parallel)
end if
#ifndef STATIC
if( .not. parallel) then
imin = 1; imax = iextr
jmin = 1; jmax = jextr
end if
iimin = imin; iimax = imax
jjmin = jmin; jjmax = jmax
allocate(A(E2DFIELD))
allocate(B(I3DFIELD))
allocate(mask(E2DFIELD))
STDERR iextr,jextr,imin,imax,jmin,jmax,kmax
#endif
mask = 1
write(*,'(a,1x,5(i4))') 'part_domain:',myid,imin,imax,jmin,jmax
if (parallel) then
call set_active_communicator(comm_hd)
end if
if(myid .ne. -1) then
write(fname,'(i2.2,a7)') myid,'-domain'
write(fw,'(i2.2,a5)') myid,'-west'
write(fn,'(i2.2,a6)') myid,'-north'
write(fe,'(i2.2,a5)') myid,'-east'
write(fs,'(i2.2,a6)') myid,'-south'
id = myid+1
else
write(fname,'(a9)') 'yy-domain'
write(fw,'(a7)') 'yy-west'
write(fn,'(a8)') 'yy-north'
write(fe,'(a7)') 'yy-east'
write(fs,'(a8)') 'yy-south'
id = 1
end if
open(unit=domain,file=fname,status='replace')
open(unit=west,file=fw,status='replace')
open(unit=north,file=fn,status='replace')
open(unit=east,file=fe,status='replace')
open(unit=south,file=fs,status='replace')
A = id*10
A(imin,jmin+1:jmax-1) = id*10+1 ! west
A(imin+1:imax-1,jmax) = id*10+2 ! north
A(imax,jmin+1:jmax-1) = id*10+3 ! east
A(imin+1:imax-1,jmin) = id*10+4 ! south
B = id*100
do k=1,kmax
B(imin:imax,jmin:jmax,k) = id*100+k
B(imin,jmin+1:jmax-1,k) = id*100+10+k ! west
B(imin+1:imax-1,jmax,k) = id*100+20+k ! north
B(imax,jmin+1:jmax-1,k) = id*100+30+k ! east
B(imin+1:imax-1,jmin,k) = id*100+40+k ! south
end do
#if 0
write(domain,*) 'id = ',myid
write(domain,*) 'Before'
do j=jmax+1,jmin-1,-1
write(domain,*) (INT(A(i,j)), i=imin-1,imax+1)
end do
write(west,*) 'west: myid = ',myid, ' before'
write(east,*) 'east: myid = ',myid, ' before'
write(north,*) 'north: myid = ',myid, ' before'
write(south,*) 'south: myid = ',myid, ' before'
do k=kmax,0,-1
write(west,*) (INT(B(imin,:,k)))
write(east,*) (INT(B(imax,:,k)))
write(north,*) (INT(B(:,jmax,k)))
write(south,*) (INT(B(:,jmin,k)))
end do
#endif
do n=1,1
! Communicate - p. 67
call update_2d_halo(A,A,mask,imin,jmin,imax,jmax,10)
call wait_halo(10)
call update_3d_halo(B,B,mask,iimin,jjmin,iimax,jjmax,kmax,30)
call wait_halo(30)
#if 1
write(domain,*) 'Loop ',n
do j=jmax+1,jmin-1,-1
write(domain,*) (INT(A(i,j)), i=imin-1,imax+1)
end do
write(west,*) 'west: myid = ',myid, ' loop = ',n
write(east,*) 'east: myid = ',myid, ' loop = ',n
write(north,*) 'north: myid = ',myid, ' loop = ',n
write(south,*) 'south: myid = ',myid, ' loop = ',n
do k=kmax,0,-1
write(west,*) (INT(B(imin-1,:,k)))
write(east,*) (INT(B(imax+1,:,k)))
write(north,*) (INT(B(:,jmax+1,k)))
write(south,*) (INT(B(:,jmin-1,k)))
end do
#endif
end do
close(unit=domain)
close(unit=west)
close(unit=north)
close(unit=east)
close(unit=south)
#ifdef STATIC
if(myid .le. 0) STDERR 'STATIC, PARALLEL = ',parallel
#else
if(myid .le. 0) STDERR 'DYNAMIC, PARALLEL = ',parallel
#endif
if(parallel) then
call MPI_FINALIZE(ierr)
end if
end
marlin 0 /home/kbk/NewModel/src/mpi/testpgm
marlin 1 /home/kbk/NewModel/src/mpi/testpgm
marlin 1 /home/kbk/NewModel/src/mpi/testpgm
marlin 1 /home/kbk/NewModel/src/mpi/testpgm
!$Id: parallel.F90,v 1.3 2003-04-01 15:31:11 gotm Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: commhalo - mpi interface to 'getm'
!
! !INTERFACE:
module commhalo
! !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:
IMPLICIT NONE
!
! !PUBLIC DATA MEMBERS:
integer :: myid, nprocs
integer :: comm_hd=-1
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
! Different mesh specification methods
integer, parameter :: ONE_CELL=-1
! Methods of communication
integer, parameter :: ONE_PROCESS=-1
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: parallel.F90,v $
! Revision 1.3 2003-04-01 15:31:11 gotm
! removed dead code
!
! Revision 1.2 2003/03/24 14:21:11 gotm
! corrected boundary indices
!
! 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:
integer, private :: active_comm=-1
integer, private :: comm_method=ONE_PROCESS
!EOP
!-----------------------------------------------------------------------
!BOC
contains
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: init_mpi - initialize MPI environment
!
! !INTERFACE:
subroutine init_mpi()
IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !DESCRIPTION:
! Initialize Parallel environment
!
! !REVISION HISTORY:
!
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
!
!EOP
!-------------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'init_mpi'
#endif
myid = -1
nprocs = 1
#ifdef DEBUG
write(debug,*) 'Leaving init_mpi()'
write(debug,*)
#endif
return
end subroutine init_mpi
!EOC
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: print_mpi_info - write various MPI related info.
!
! !INTERFACE:
subroutine print_mpi_info()
IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !DESCRIPTION:
! Print information on the MPI environment
!
! !REVISION HISTORY:
!
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
!
!EOP
!-------------------------------------------------------------------------
!BOC
LEVEL1 'OK - you specified a parallel run'
LEVEL1 'prallel execution is not available in this version'
LEVEL1 'setting myid and nprocs to useable values'
end subroutine print_mpi_info
!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
!
! !INPUT PARAMETERS:
integer, intent(in) :: imin,jmin,imax,jmax
integer, intent(in) :: tag
REALTYPE, intent(in) :: f2(E2DFIELD)
integer, intent(in) :: mask(E2DFIELD)
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
REALTYPE, intent(out) :: f1(E2DFIELD)
!
! !DESCRIPTION:
! Print information on the MPI environment
!
! !REVISION HISTORY:
!
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
integer :: i,j,k
integer :: ilow,jlow,ihigh,jhigh
!EOP
!-------------------------------------------------------------------------
!BOC
#if 0
select case (tag)
case(HU_TAG, U_TAG , DU_TAG) ! for variables defined on u-grid
ilow=imin;ihigh=imax-1;jlow=jmin;jhigh=jmax
case(HV_TAG, V_TAG , DV_TAG) ! for variables defined on v-grid
ilow=imin;ihigh=imax;jlow=jmin;jhigh=jmax-1
case default ! for variables defined on scalar-grid
ilow=imin;ihigh=imax;jlow=jmin;jhigh=jmax
end select
#endif
ilow=imin;ihigh=imax;jlow=jmin;jhigh=jmax
select case (comm_method)
case(ONE_PROCESS)
f1(ilow -1, : ) = f2(ilow, : )
f1(ihigh+1, : ) = f2(ihigh, : )
f1( :, jlow -1 ) = f2( :, jlow )
f1( :, jhigh+1 ) = f2( :, jhigh )
case default
FATAL 'A non valid communication method has been chosen'
stop 'update_2d_halo'
end select
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
!
! !INPUT PARAMETERS:
integer, intent(in) :: iimin,jjmin,iimax,jjmax,kmax
integer, intent(in) :: tag
integer, intent(in) :: mask(-HALO+1:,-HALO+1:)
REALTYPE, intent(in) :: f2(I3DFIELD)
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
REALTYPE, intent(out):: f1(I3DFIELD)
!
! !DESCRIPTION:
! Print information on the MPI environment
!
! !REVISION HISTORY:
!
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
integer :: i,j,k
integer :: ilow,jlow,ihigh,jhigh
!EOP
!-------------------------------------------------------------------------
!BOC
#if 0
select case (tag)
case(HU_TAG, U_TAG , DU_TAG) ! for variables defined on u-grid
ilow=iimin;ihigh=iimax-1;jlow=jjmin+1;jhigh=jjmax-1
ilow=iimin;ihigh=iimax-1;jlow=jjmin;jhigh=jjmax
case(HV_TAG, V_TAG , DV_TAG) ! for variables defined on v-grid
ilow=iimin+1;ihigh=iimax-1;jlow=jjmin;jhigh=jjmax-1
ilow=iimin;ihigh=iimax;jlow=jjmin;jhigh=jjmax-1
case default ! for variables defined on scalar-grid
ilow=iimin;ihigh=iimax;jlow=jjmin;jhigh=jjmax
end select
#endif
ilow=iimin;ihigh=iimax;jlow=jjmin;jhigh=jjmax
select case (comm_method)
case(ONE_PROCESS)
f1(ilow -1, : , : ) = f2(ilow , : , : )
f1(ihigh+1, : , : ) = f2(ihigh, : , : )
f1( : , jlow -1, : ) = f2( : , jlow , : )
f1( : , jhigh+1, : ) = f2( : , jhigh, : )
case default
FATAL 'A non valid communication method has been chosen'
stop 'update_3d_halo'
end select
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:
! Waits for any un-finished communications. In the case of serial model run,
! only 1 process or blocking communication this routine does not do anything.
!
! !INPUT PARAMETERS:
integer, intent(in) :: tag
!
! !INPUT/OUTPUT PARAMETERS:
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! !LOCAL VARIABLES:
!EOP
!-------------------------------------------------------------------------
!BOC
! if (nprocs .gt. 1) then
! call wait_halo_mpi(tag)
! end if
return
end subroutine wait_halo
!EOC
!-----------------------------------------------------------------------
end module commhalo
!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding (BBH) !
!-----------------------------------------------------------------------
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