Commit 8e50db52 authored by kbk's avatar kbk
Browse files

parallel support

parent 951b1cc2
!$Id: depth_update.F90,v 1.1 2002-05-02 14:00:42 gotm Exp $
!$Id: depth_update.F90,v 1.2 2003-04-07 15:27:00 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -11,10 +11,10 @@
! !DESCRIPTION:
!
! !USES:
use commhalo, only: update_2d_halo,wait_halo,D_TAG,DV_TAG,DU_TAG
use domain, only: imin,imax,jmin,jmax,H,HU,HV,min_depth,crit_depth
use domain, only: az,au,av,dry_z,dry_u,dry_v
use variables_2d, only: D,z,zo,DU,zuo,zu,DV,zvo,zv
use domain, only: imin,imax,jmin,jmax,H,HU,HV,min_depth,crit_depth
use domain, only: az,au,av,dry_z,dry_u,dry_v
use variables_2d, only: D,z,zo,DU,zu,DV,zv
use halo_zones, only : update_2d_halo,wait_halo,D_TAG,DU_TAG,DV_TAG
IMPLICIT NONE
!
! !INPUT PARAMETERS:
......@@ -27,8 +27,11 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: depth_update.F90,v $
! Revision 1.1 2002-05-02 14:00:42 gotm
! Initial revision
! Revision 1.2 2003-04-07 15:27:00 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:00:42 gotm
! recovering after CVS crash
!
! Revision 1.5 2001/08/27 11:53:13 bbh
! TVD-advection for momentum added, some bugs removed
......@@ -61,67 +64,82 @@
write(debug,*) 'depth_update() # ',Ncall
#endif
! Depth in elevation points
D = z+H
call update_2d_halo(D,D,az,imin,jmin,imax,jmax,D_TAG)
call wait_halo(D_TAG)
#undef USE_MASK
! U-points
do j=jmin,jmax
do i=imin,imax
zuo(i,j) = zu(i,j)
#ifdef USE_MASK
if(au(i,j) .gt. 0) then
#endif
x=max(0.25*(zo(i,j)+zo(i+1,j)+z(i,j)+z(i+1,j)),-HU(i,j)+min_depth)
zu(i,j) = x
DU(i,j) = x+HU(i,j)
DU(i,j) = x+HU(i,j)
#ifdef USE_MASK
end if
#endif
end do
end do
call update_2d_halo(DU,DU,au,imin,jmin,imax,jmax,DU_TAG)
call wait_halo(DU_TAG)
! V-points
do j=jmin,jmax
do i=imin,imax
zvo(i,j)=zv(i,j)
#ifdef USE_MASK
if(av(i,j) .gt. 0) then
#endif
x = max(0.25*(zo(i,j)+zo(i,j+1)+z(i,j)+z(i,j+1)),-HV(i,j)+min_depth)
zv(i,j) = x
DV(i,j) = x+HV(i,j)
DV(i,j) = x+HV(i,j)
#ifdef USE_MASK
end if
#endif
end do
end do
call wait_halo(DU_TAG)
!KBK call cp_outside_openbdy_2d(DU)
call update_2d_halo(DV,DV,av,imin,jmin,imax,jmax,DV_TAG)
! Depth in elevation points
D = z+H
call wait_halo(DV_TAG)
!KBK call cp_outside_openbdy_2d(DV)
d1 = 2*min_depth
d2 = crit_depth-2*min_depth
where (az .gt. 0)
dry_z = max(_ZERO_,min(_ONE_,(D-d1/2.)/d2))
end where
where (au .gt. 0)
dry_u = max(_ZERO_,min(_ONE_,(DU-d1)/d2))
end where
where (av .gt. 0)
dry_v = max(_ZERO_,min(_ONE_,(DV-d1)/d2))
end where
!kbk#ifdef DEBUG
#ifdef DEBUG
do j=jmin,jmax
do i=imin,imax
if(D(i,j) .le. _ZERO_ .and. az(i,j) .gt. 0) then
STDERR 'D ',i,j,H(i,j),D(i,j)
STDERR 'depth_update: D ',i,j,H(i,j),D(i,j)
end if
if(DU(i,j) .le. _ZERO_ .and. au(i,j) .gt. 0) then
STDERR 'DU ',i,j,HU(i,j),DU(i,j)
STDERR 'depth_update: DU ',i,j,HU(i,j),DU(i,j)
end if
if(DV(i,j) .le. _ZERO_ .and. av(i,j) .gt. 0) then
STDERR 'DV ',i,j,HV(i,j),DV(i,j)
STDERR 'depth_update: DV ',i,j,HV(i,j),DV(i,j)
end if
end do
end do
!kbk#endif
d1 = 2*min_depth
d2 = crit_depth-2*min_depth
dry_z = max(_ZERO_,min(_ONE_,(D-d1/2.)/d2))
dry_u = max(_ZERO_,min(_ONE_,(DU-d1)/d2))
dry_v = max(_ZERO_,min(_ONE_,(DV-d1)/d2))
#endif
#ifdef DEBUG
write(debug,*) 'Leaving depth_update()'
......@@ -134,4 +152,3 @@
!-----------------------------------------------------------------------
! Copyright (C) 2001 - Hans Burchard and Karsten Bolding !
!-----------------------------------------------------------------------
!$Id: mirror_bdy_2d.F90,v 1.1 2003-04-07 15:22:03 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: mirror_bdy_2d
!
! !INTERFACE:
subroutine mirror_bdy_2d(f,tag)
!
! !DESCRIPTION:
!
! !USES:
use halo_zones, only : U_TAG,V_TAG,H_TAG
use domain, only: imin,imax,jmin,jmax
use domain, only: az,au,av
use domain, only: NWB,NNB,NEB,NSB
use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli
IMPLICIT NONE
!
! !INPUT PARAMETERS:
integer, intent(in) :: tag
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE, intent(inout) :: f(E2DFIELD)
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: mirror_bdy_2d.F90,v $
! Revision 1.1 2003-04-07 15:22:03 kbk
! parallel support
!
!
! !LOCAL VARIABLES:
integer :: i,j,n
!
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'mirror_bdy_2d() # ',Ncall
#endif
select case (tag)
case (U_TAG)
#if 0
do n = 1,NNB
j = nj(n)
do i = nfi(n),nli(n)
if (au(i,j) .eq. 3) f(i,j) = f(i,j-1)
end do
end do
#else
!KBKSTDERR 'mirror_bdy_2d: U_TAG'
#endif
do n = 1,NSB
j = sj(n)
do i = sfi(n),sli(n)
if (au(i,j) .eq. 3) f(i,j) = f(i,j+1)
end do
end do
case (V_TAG)
do n = 1,NWB
i = wi(n)
do j = wfj(n),wlj(n)
if (av(i,j) .eq. 3) f(i,j) = f(i+1,j)
end do
end do
do n = 1,NEB
i = ei(n)
do j = efj(n),elj(n)
if (av(i,j) .eq. 3) f(i,j) = f(i-1,j)
end do
end do
case default
#if 0
do n = 1,NWB
i = wi(n)
do j = wfj(n),wlj(n)
f(i-1,j) = f(i,j)
end do
end do
do n = 1,NNB
j = nj(n)
do i = nfi(n),nli(n)
f(i,j+1) = f(i,j)
end do
end do
do n = 1,NEB
i = ei(n)
do j = efj(n),elj(n)
f(i+1,j) = f(i,j)
end do
end do
do n = 1,NSB
j = sj(n)
do i = sfi(n),sli(n)
f(i,j-1) = f(i,j)
end do
end do
#endif
end select
#ifdef DEBUG
write(debug,*) 'Leaving mirror_bdy_2d()'
write(debug,*)
#endif
return
end subroutine mirror_bdy_2d
!EOC
!-----------------------------------------------------------------------
! Copyright (C) 2003 - Karsten Bolding and Hans Burchard !
!-----------------------------------------------------------------------
!$Id: mirror_bdy_3d.F90,v 1.1 2003-04-07 15:22:03 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: mirror_bdy_3d
!
! !INTERFACE:
subroutine mirror_bdy_3d(f,tag)
!
! !DESCRIPTION:
!
! !USES:
use halo_zones, only : U_TAG,V_TAG,H_TAG
use domain, only: iimin,iimax,jjmin,jjmax,kmax
use domain, only: az,au,av
use domain, only: NWB,NNB,NEB,NSB
use domain, only: wi,wfj,wlj,nj,nfi,nli,ei,efj,elj,sj,sfi,sli
IMPLICIT NONE
!
! !INPUT PARAMETERS:
integer, intent(in) :: tag
!
! !INPUT/OUTPUT PARAMETERS:
REALTYPE, intent(inout) :: f(I3DFIELD)
!
! !OUTPUT PARAMETERS:
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: mirror_bdy_3d.F90,v $
! Revision 1.1 2003-04-07 15:22:03 kbk
! parallel support
!
!
! !LOCAL VARIABLES:
integer :: i,j,n
!
!EOP
!-----------------------------------------------------------------------
!BOC
#ifdef DEBUG
integer, save :: Ncall = 0
Ncall = Ncall+1
write(debug,*) 'mirror_bdy_3d() # ',Ncall
#endif
!KBK
return
!KBK
select case (tag)
case (U_TAG)
#if 0
do n = 1,NNB
j = nj(n)
do i = nfi(n),nli(n)
if (au(i,j) .eq. 3) f(i,j,:) = f(i,j-1,:)
end do
end do
#else
STDERR 'mirror_bdy_3d: U_TAG'
#endif
do n = 1,NSB
j = sj(n)
do i = sfi(n),sli(n)
if (au(i,j) .eq. 3) f(i,j,:) = f(i,j+1,:)
end do
end do
case (V_TAG)
do n = 1,NWB
i = wi(n)
do j = wfj(n),wlj(n)
if (av(i,j) .eq. 3) f(i,j,:) = f(i+1,j,:)
end do
end do
do n = 1,NEB
i = ei(n)
do j = efj(n),elj(n)
if (av(i,j) .eq. 3) f(i,j,:) = f(i-1,j,:)
end do
end do
case (H_TAG)
#if 1
do n = 1,NWB
i = wi(n)
do j = wfj(n),wlj(n)
f(i-1,j,:) = f(i,j,:)
end do
end do
do n = 1,NNB
j = nj(n)
do i = nfi(n),nli(n)
f(i,j+1,:) = f(i,j,:)
end do
end do
do n = 1,NEB
i = ei(n)
do j = efj(n),elj(n)
f(i+1,j,:) = f(i,j,:)
end do
end do
do n = 1,NSB
j = sj(n)
do i = sfi(n),sli(n)
f(i,j-1,:) = f(i,j,:)
end do
end do
#endif
case default
end select
#ifdef DEBUG
write(debug,*) 'Leaving mirror_bdy_3d()'
write(debug,*)
#endif
return
end subroutine mirror_bdy_3d
!EOC
!-----------------------------------------------------------------------
! Copyright (C) 2003 - Karsten Bolding and Hans Burchard !
!-----------------------------------------------------------------------
!$Id: part_domain.F90,v 1.1 2003-04-07 15:22:03 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: part_domain - partition the calculation domain
!
! !INTERFACE:
subroutine part_domain()
!
! !USES:
use domain, only: iextr,jextr
use domain, only: imin,imax,jmin,jmax
use domain, only: iimin,iimax,jjmin,jjmax,kmax
use domain, only: ioff,joff
#ifdef PARALLEL
use halo_mpi, only: part_domain_mpi
#endif
IMPLICIT NONE
!
! !DESCRIPTION:
! Set various integers defining the calculation domain
!
! !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,*) 'part_domain'
#endif
#ifndef PARALLEL
#ifndef STATIC
imin=1 ; imax=iextr ; jmin=1 ; jmax=jextr
#endif
ioff=0 ; joff=0
#else
call part_domain_mpi(iextr,jextr,kmax,imin,imax,jmin,jmax,ioff,joff)
#endif
#ifndef STATIC
iimin=imin ; iimax=imax ; jjmin=jmin ; jjmax=jmax
#endif
#if 0
#ifndef STATIC
if(il .eq. -1 .or. ih .eq. -1 .or. jl .eq. -1 .or. jh .eq. -1) then
imin = 1 ; imax = iextr ; jmin = 1 ; jmax = jextr;
il = imin ; il = imax ; jl = jmin ; jh = jmax
else
imin = 1 ; imax = ih-il+1 ; jmin = 1 ; jmax = jh-jl+1;
end if
#endif
#endif
#ifdef DEBUG
write(debug,*) 'Leaving part_domain()'
write(debug,*)
#endif
return
end subroutine part_domain
!EOC
!-----------------------------------------------------------------------
! Copyright (C) 2002 - Karsten Bolding and Hans Burchard (BBH) !
!-----------------------------------------------------------------------
!$Id: grid_interpol.F90,v 1.1 2002-05-02 14:01:21 gotm Exp $
!$Id: grid_interpol.F90,v 1.2 2003-04-07 15:25:06 kbk Exp $
#include "cppdefs.h"
#ifndef HALO
#define HALO 0
#endif
#if 1
#define USE_VALID_LON_LAT_ONLY
#endif
#ifdef USE_VALID_LON_LAT_ONLY
#define USE_GRIDMAP_UNDEF
#endif
!-----------------------------------------------------------------------
!BOP
!
......@@ -30,8 +36,11 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: grid_interpol.F90,v $
! Revision 1.1 2002-05-02 14:01:21 gotm
! Initial revision
! Revision 1.2 2003-04-07 15:25:06 kbk
! parallel support
!
! Revision 1.1.1.1 2002/05/02 14:01:21 gotm
! recovering after CVS crash
!
! Revision 1.3 2001/09/30 09:06:00 bbh
! Cleaned up
......@@ -55,8 +64,9 @@
! !IROUTINE: init_grid_interpol - initialise grid interpolation.
!
! !INTERFACE:
subroutine init_grid_interpol(imin,imax,jmin,jmax, &
olon,olat,mlon,mlat,southpole,gridmap,t,u,mask)
subroutine init_grid_interpol(imin,imax,jmin,jmax,mask, &
olon,olat,met_lon,met_lat,southpole, &
gridmap,t,u,met_mask)
IMPLICIT NONE
!
! !DESCRIPTION:
......@@ -64,10 +74,11 @@
!
! !INPUT PARAMETERS:
integer, intent(in) :: imin,imax,jmin,jmax
integer, intent(in) :: mask(-HALO+1:,-HALO+1:)
REALTYPE, intent(in) :: olon(-HALO+1:,-HALO+1:),olat(-HALO+1:,-HALO+1:)
REALTYPE, intent(in) :: mlon(:,:),mlat(:,:)
REALTYPE, intent(in) :: met_lon(:,:),met_lat(:,:)
REALTYPE, intent(in) :: southpole(2)
integer, optional, intent(in) :: mask(:,:)
integer, optional, intent(in) :: met_mask(:,:)
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -102,33 +113,24 @@
LEVEL2 'southpole=',southpole
LEVEL2 ' --> rotated_grid=',rotated_grid
if( rotated_grid ) then
allocate(rlon(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_gridinterpol: Error allocating memory (rlon)'
#if 0
allocate(rot_lon(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_gridinterpol: Error allocating memory (rot_lon)'
allocate(rlat(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_gridinterpol: Error allocating memory (rlat)'
allocate(rot_lat(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_gridinterpol: Error allocating memory (rot_lat)'
allocate(beta(E2DFIELD),stat=rc)
if (rc /= 0) stop 'init_gridinterpol: Error allocating memory (beta)'
end if
if ( rotated_grid ) then
call rotated_lat_lon(southpole,olon,olat,rlon,rlat,beta)
call interpol_coefficients(rlon,rlat,mlon,mlat,gridmap,t,u,mask)
else
call interpol_coefficients(olon,olat,mlon,mlat,gridmap,t,u,mask)
endif
#if 0
STDERR olon(111,87),olat(111,87)
STDERR rlon(111,87),rlat(111,87)
i = gridmap(111,87,1)
j = gridmap(111,87,2)
STDERR i,j
STDERR mlon(i,j),mlat(i,j)
STDERR mlon(i+1,j),mlat(i+1,j)
STDERR mlon(i+1,j+1),mlat(i+1,j+1)
STDERR mlon(i,j+1),mlat(i,j+1)
call rotated_lat_lon(mask,southpole,met_lon,met_lat,rot_lon,rot_lat,beta)
call interpol_coefficients(mask,olon,olat,rot_lon,rot_lat,gridmap,t,u,met_mask)
#endif
STDERR 'Check this Karsten - rotated grid'
stop 'init_grid_interpol.F90'
else
call interpol_coefficients(mask,olon,olat,met_lon,met_lat,gridmap,t,u,met_mask)
endif
#ifdef DEBUG
write(debug,*) 'Leaving init_grid_interpol()'
......@@ -144,13 +146,14 @@
! !IROUTINE: do_grid_interpol - do grid interpolation.
!
! !INTERFACE:
subroutine do_grid_interpol(ifield,gridmap,t,u,ofield)
subroutine do_grid_interpol(mask,ifield,gridmap,t,u,ofield)
IMPLICIT NONE
!
! !DESCRIPTION:
! To be written.
!
! !INPUT PARAMETERS:
integer, intent(in) :: mask(-HALO+1:,-HALO+1:)
REALTYPE, intent(in) :: ifield(:,:)
integer, intent(in) :: gridmap(-HALO+1:,-HALO+1:,1:)
REALTYPE, intent(in) :: t(-HALO+1:,-HALO+1:),u(-HALO+1:,-HALO+1:)
......@@ -179,19 +182,29 @@
<