Commit acf5ca12 authored by kbk's avatar kbk
Browse files

update_2d_halo on spherical variables + TABS to spaces

parent 65dd04c4
!$Id: bdy_spec.F90,v 1.2 2003-04-07 15:20:53 kbk Exp $
!$Id: bdy_spec.F90,v 1.3 2003-04-23 11:59:39 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -17,7 +17,7 @@
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: FName
character(len=*), intent(in) :: FName
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -27,7 +27,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: bdy_spec.F90,v $
! Revision 1.2 2003-04-07 15:20:53 kbk
! Revision 1.3 2003-04-23 11:59:39 kbk
! update_2d_halo on spherical variables + TABS to spaces
!
! Revision 1.2 2003/04/07 15:20:53 kbk
! added bdy_index and bdy_map
!
! Revision 1.1.1.1 2002/05/02 14:01:11 gotm
......@@ -40,7 +43,7 @@
! initial import into CVS
!
! !LOCAL VARIABLES:
integer :: i,j,k,l,n,rc
integer :: i,j,k,l,n,rc
!
!EOP
!-----------------------------------------------------------------------
......
!$Id: domain.F90,v 1.5 2003-04-07 14:34:42 kbk Exp $
!$Id: domain.F90,v 1.6 2003-04-23 11:59:39 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -11,43 +11,46 @@
! !DESCRIPTION:
!
! !USES:
use halo_zones, only : update_2d_halo,wait_halo,H_TAG
use halo_zones, only: update_2d_halo,wait_halo,H_TAG,U_TAG,V_TAG
IMPLICIT NONE
!
! !PUBLIC DATA MEMBERS:
integer :: format=NETCDF
integer :: grid_type=1,vert_cord=1
integer :: format=NETCDF
integer :: grid_type=1,vert_cord=1
REALTYPE, allocatable, dimension(:) :: ga
REALTYPE :: ddu=-_ONE_,ddl=-_ONE_,d_gamma=20.
logical :: gamma_surf=.true.
integer :: NWB,NNB,NEB,NSB,NOB
REALTYPE :: latitude=0.
REALTYPE :: Hland
REALTYPE :: min_depth,crit_depth
logical :: openbdy=.false.
integer :: calc_points
REALTYPE :: ddu=-_ONE_,ddl=-_ONE_,d_gamma=20.
logical :: gamma_surf=.true.
integer :: NWB,NNB,NEB,NSB,NOB
REALTYPE :: latitude=0.
REALTYPE :: Hland
REALTYPE :: min_depth,crit_depth
logical :: openbdy=.false.
integer :: calc_points
#ifdef STATIC
#include "static_domain.h"
#else
#include "dynamic_declarations_domain.h"
#endif
integer :: nsbv
integer, parameter :: INNER= 1
integer :: ioff=0,joff=0
integer, dimension(:), allocatable :: wi,wfj,wlj
integer, dimension(:), allocatable :: nj,nfi,nli
integer, dimension(:), allocatable :: ei,efj,elj
integer, dimension(:), allocatable :: sj,sfi,sli
integer, allocatable :: bdy_index(:),bdy_map(:,:)
integer :: nsbv
integer, parameter :: INNER= 1
integer :: ioff=0,joff=0
integer, dimension(:), allocatable :: wi,wfj,wlj
integer, dimension(:), allocatable :: nj,nfi,nli
integer, dimension(:), allocatable :: ei,efj,elj
integer, dimension(:), allocatable :: sj,sfi,sli
integer, allocatable :: bdy_index(:),bdy_map(:,:)
!kbk
REALTYPE :: cori= _ZERO_
REALTYPE, parameter :: rearth=6370.9490e3
REALTYPE :: cori= _ZERO_
REALTYPE, parameter :: rearth=6370.9490e3
!
! !REVISION HISTORY:
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: domain.F90,v $
! Revision 1.5 2003-04-07 14:34:42 kbk
! Revision 1.6 2003-04-23 11:59:39 kbk
! update_2d_halo on spherical variables + TABS to spaces
!
! Revision 1.5 2003/04/07 14:34:42 kbk
! parallel support, proper spherical grid init. support
!
! Revision 1.1.1.1 2002/05/02 14:01:11 gotm
......@@ -132,7 +135,7 @@
! !INPUT PARAMETERS:
!
! !INPUT/OUTPUT PARAMETERS:
character(len=*) :: input_dir
character(len=*) :: input_dir
!
! !OUTPUT PARAMETERS:
!
......@@ -144,7 +147,8 @@
! most arrays are statically allocated. In this case the information of
! the extenstion of the domain is obtained from a file called dimensions.h,
! where imin,imax,jmin and jmax are specified as integer parameters.
! If STATIC has not been defined during compilation all arrays are allocatable.! In this case information of the extension of the domain is obtained from
! If STATIC has not been defined during compilation all arrays are allocatable.
! In this case information of the extension of the domain is obtained from
! the bathymetry file. After imin,imax,jmin and jmax are known arrays are
! allocated.
! Next step is to read in the batymetry. Then location of boundaries are read.
......@@ -160,23 +164,24 @@
! See log for module
!
! !LOCAL VARIABLES:
integer :: rc
integer :: np,sz
integer :: i,j,n
integer :: kdum
REALTYPE, parameter :: pi=3.141592654
REALTYPE, parameter :: deg2rad=pi/180.
REALTYPE, parameter :: omega=2.*pi/86400.
character(len=PATH_MAX) :: bathymetry='topo.nc'
character(len=PATH_MAX) :: bdyinfofile='bdyinfo.dat'
character(len=PATH_MAX) :: min_depth_file='minimum_depth.dat'
character(len=PATH_MAX) :: bathymetry_adjust_file='bathymetry.adjust'
character(len=PATH_MAX) :: mask_adjust_file='mask.adjust'
integer :: il=-1,ih=-1,jl=-1,jh=-1
namelist /domain/ grid_type,vert_cord,ddu,ddl, &
d_gamma,gamma_surf, &
bathymetry,openbdy,bdyinfofile,latitude, &
crit_depth,min_depth,kdum,il,ih,jl,jh
integer :: rc
integer :: np,sz
integer :: i,j,n
integer :: kdum
REALTYPE, parameter :: pi=3.141592654
REALTYPE, parameter :: deg2rad=pi/180.
REALTYPE, parameter :: omega=2.*pi/86400.
character(len=PATH_MAX) :: bathymetry='topo.nc'
character(len=PATH_MAX) :: bdyinfofile='bdyinfo.dat'
character(len=PATH_MAX) :: min_depth_file='minimum_depth.dat'
character(len=PATH_MAX) :: bathymetry_adjust_file='bathymetry.adjust'
character(len=PATH_MAX) :: mask_adjust_file='mask.adjust'
integer :: il=-1,ih=-1,jl=-1,jh=-1
namelist /domain/ &
grid_type,vert_cord,ddu,ddl, &
d_gamma,gamma_surf, &
bathymetry,openbdy,bdyinfofile,latitude, &
crit_depth,min_depth,kdum,il,ih,jl,jh
!EOP
!-------------------------------------------------------------------------
!BOC
......@@ -285,25 +290,25 @@ end where
do j=jmin,jmax
do i=imin,imax
dxc(i,j)=deg2rad*(lonu(i,j)-lonu(i-1,j))*rearth &
*cos(deg2rad*latc(i,j))
*cos(deg2rad*latc(i,j))
end do
end do
do j=jmin,jmax
do i=imin-1,imax
dxu(i,j)=deg2rad*(lonc(i+1,j)-lonc(i,j))*rearth &
*cos(deg2rad*latc(i,j))
*cos(deg2rad*latc(i,j))
end do
end do
do j=jmin-1,jmax
do i=imin,imax
dxv(i,j)=deg2rad*(lonx(i,j)-lonx(i-1,j))*rearth &
*cos(deg2rad*latv(i,j))
*cos(deg2rad*latv(i,j))
end do
end do
do j=jmin-1,jmax
do i=imin-1,imax
dxx(i,j)=deg2rad*(lonv(i+1,j)-lonv(i,j))*rearth &
*cos(deg2rad*latx(i,j))
*cos(deg2rad*latx(i,j))
end do
end do
do j=jmin,jmax
......@@ -339,74 +344,94 @@ end where
corv(i,j)=2.*omega*sin(deg2rad*latv(i,j))
end do
end do
call update_2d_halo(dxc,dxc,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
call update_2d_halo(dyc,dyc,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
call update_2d_halo(arcd1,arcd1,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
call update_2d_halo(dxu,dxu,au,imin,jmin,imax,jmax,U_TAG)
call wait_halo(U_TAG)
call update_2d_halo(dyu,dyu,au,imin,jmin,imax,jmax,U_TAG)
call wait_halo(U_TAG)
call update_2d_halo(arud1,arud1,au,imin,jmin,imax,jmax,U_TAG)
call wait_halo(U_TAG)
call update_2d_halo(dxv,dxv,av,imin,jmin,imax,jmax,V_TAG)
call wait_halo(V_TAG)
call update_2d_halo(dyv,dyv,av,imin,jmin,imax,jmax,V_TAG)
call wait_halo(V_TAG)
call update_2d_halo(arvd1,arvd1,av,imin,jmin,imax,jmax,V_TAG)
call wait_halo(V_TAG)
#endif
case(3)
#ifdef CURVILINEAR
do i=imin-1,imax
do j=jmin,jmax
xu(i,j)=0.5*(xx(i,j)+xx(i,j-1))
yu(i,j)=0.5*(yx(i,j)+yx(i,j-1))
xu(i,j)=0.5*(xx(i,j)+xx(i,j-1))
yu(i,j)=0.5*(yx(i,j)+yx(i,j-1))
end do
end do
end do
do i=imin,imax
do j=jmin-1,jmax
xv(i,j)=0.5*(xx(i,j)+xx(i-1,j))
yv(i,j)=0.5*(yx(i,j)+yx(i-1,j))
xv(i,j)=0.5*(xx(i,j)+xx(i-1,j))
yv(i,j)=0.5*(yx(i,j)+yx(i-1,j))
end do
end do
end do
do i=imin,imax
do j=jmin,jmax
if (H(i,j).gt.Hland) then
dxc(i,j)=sqrt((xu(i,j)-xu(i-1,j))**2+(yu(i,j)-yu(i-1,j))**2)
dyc(i,j)=sqrt((xv(i,j)-xv(i,j-1))**2+(yv(i,j)-yv(i,j-1))**2)
if (H(i,j).gt.Hland) then
dxc(i,j)=sqrt((xu(i,j)-xu(i-1,j))**2+(yu(i,j)-yu(i-1,j))**2)
dyc(i,j)=sqrt((xv(i,j)-xv(i,j-1))**2+(yv(i,j)-yv(i,j-1))**2)
arcd1(i,j)=_ONE_/(dxc(i,j)*dyc(i,j))
end if
end if
end do
end do
end do
do j=jmin,jmax
do i=imin,imax-1
if ((H(i+1,j).gt.Hland).and.(H(i,j).gt.Hland)) then
dxu(i,j)=sqrt((xc(i+1,j)-xc(i,j))**2+(yc(i+1,j)-yc(i,j))**2)
dyu(i,j)=sqrt((xx(i,j)-xx(i,j-1))**2+(yx(i,j)-yx(i,j-1))**2)
if ((H(i+1,j).gt.Hland).and.(H(i,j).gt.Hland)) then
dxu(i,j)=sqrt((xc(i+1,j)-xc(i,j))**2+(yc(i+1,j)-yc(i,j))**2)
dyu(i,j)=sqrt((xx(i,j)-xx(i,j-1))**2+(yx(i,j)-yx(i,j-1))**2)
arud1(i,j)=_ONE_/(dxu(i,j)*dyu(i,j))
end if
end if
end do
dxu(imin-1,j)=dxu(imin,j)
dxu(imax,j)=dxu(imax-1,j)
end do
dxu(imin-1,j)=dxu(imin,j)
dxu(imax,j)=dxu(imax-1,j)
end do
do i=imin,imax
do j=jmin,jmax-1
if ((H(i,j+1).gt.Hland).and.(H(i,j).gt.Hland)) then
dyv(i,j)=sqrt((xc(i,j+1)-xc(i,j))**2+(yc(i,j+1)-yc(i,j))**2)
dxv(i,j)=sqrt((xx(i,j)-xx(i-1,j))**2+(yx(i,j)-yx(i-1,j))**2)
if ((H(i,j+1).gt.Hland).and.(H(i,j).gt.Hland)) then
dyv(i,j)=sqrt((xc(i,j+1)-xc(i,j))**2+(yc(i,j+1)-yc(i,j))**2)
dxv(i,j)=sqrt((xx(i,j)-xx(i-1,j))**2+(yx(i,j)-yx(i-1,j))**2)
arvd1(i,j)=_ONE_/(dxv(i,j)*dyv(i,j))
end if
end if
end do
dyv(i,jmin-1)=dyv(i,jmin)
dyv(i,jmax)=dyv(i,jmax-1)
end do
do j=jmin-1,jmax
do i=imin,imax-1
if (((H(i,j+1).gt.Hland).and.(H(i,j).gt.Hland)).or. &
((H(i+1,j).gt.Hland).and.(H(i+1,j+1).gt.Hland))) then
dxx(i,j)=sqrt((xv(i+1,j)-xv(i,j))**2+(yv(i+1,j)-yv(i,j))**2)
end if
dyv(i,jmin-1)=dyv(i,jmin)
dyv(i,jmax)=dyv(i,jmax-1)
end do
do j=jmin-1,jmax
do i=imin,imax-1
if (((H(i,j+1).gt.Hland).and.(H(i,j).gt.Hland)).or. &
((H(i+1,j).gt.Hland).and.(H(i+1,j+1).gt.Hland))) then
dxx(i,j)=sqrt((xv(i+1,j)-xv(i,j))**2+(yv(i+1,j)-yv(i,j))**2)
end if
end do
dxx(imin-1,j)=dxx(imin,j)
dxx(imax,j)=dxx(imax-1,j)
end do
do i=imin-1,imax
do j=jmin,jmax-1
if (((H(i,j+1).gt.Hland).and.(H(i,j).gt.Hland)).or. &
((H(i+1,j).gt.Hland).and.(H(i+1,j+1).gt.Hland))) then
dyx(i,j)=sqrt((xu(i,j+1)-xu(i,j))**2+(yu(i,j+1)-yu(i,j))**2)
end if
dxx(imin-1,j)=dxx(imin,j)
dxx(imax,j)=dxx(imax-1,j)
end do
do i=imin-1,imax
do j=jmin,jmax-1
if (((H(i,j+1).gt.Hland).and.(H(i,j).gt.Hland)).or. &
((H(i+1,j).gt.Hland).and.(H(i+1,j+1).gt.Hland))) then
dyx(i,j)=sqrt((xu(i,j+1)-xu(i,j))**2+(yu(i,j+1)-yu(i,j))**2)
end if
end do
dyx(i,jmin-1)=dyx(i,jmin)
dyx(i,jmax)=dyx(i,jmax-1)
end do
coru = 2.*omega*sin(deg2rad*latu)
corv = 2.*omega*sin(deg2rad*latv)
dyx(i,jmin-1)=dyx(i,jmin)
dyx(i,jmax)=dyx(i,jmax-1)
end do
coru = 2.*omega*sin(deg2rad*latu)
corv = 2.*omega*sin(deg2rad*latv)
#endif
case default
FATAL 'A non valid grid type has been chosen'
......@@ -490,8 +515,8 @@ call print_bdy('Local Boundary Information')
av(i,j)=2
end if
if (az(i,j) .eq. 2 .and. az(i,j+1) .eq. 2) then
av(i,j)=3
end if
av(i,j)=3
end if
end do
end do
......@@ -500,8 +525,8 @@ call print_bdy('Local Boundary Information')
do i=imin,imax
if (az(i ,j) .eq. 1 .and. az(i ,j+1) .eq. 1 .and. &
az(i+1,j) .eq. 1 .and. az(i+1,j+1) .eq. 1) then
ax(i,j)=1
end if
ax(i,j)=1
end if
end do
end do
......@@ -539,7 +564,7 @@ call print_bdy('Local Boundary Information')
IMPLICIT NONE
!
! !INPUT PARAMETERS:
integer, intent(in) :: myid
integer, intent(in) :: myid
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -553,7 +578,7 @@ call print_bdy('Local Boundary Information')
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
integer :: id
integer :: id
!
!EOP
!------------------------------------------------------------------------
......@@ -598,7 +623,7 @@ call print_bdy('Local Boundary Information')
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn
character(len=*), intent(in) :: fn
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -610,11 +635,11 @@ call print_bdy('Local Boundary Information')
! !REVISION HISTORY:
!
! !LOCAL VARIABLES:
integer :: unit = 25 ! kbk
integer :: i,j,k,n
integer :: il,jl,ih,jh
integer :: i1,j1
REALTYPE :: dmin
integer :: unit = 25 ! kbk
integer :: i,j,k,n
integer :: il,jl,ih,jh
integer :: i1,j1
REALTYPE :: dmin
!EOP
!-----------------------------------------------------------------------
!BOC
......@@ -663,7 +688,7 @@ call print_bdy('Local Boundary Information')
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn
character(len=*), intent(in) :: fn
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -675,11 +700,11 @@ call print_bdy('Local Boundary Information')
! !REVISION HISTORY:
!
! !LOCAL VARIABLES:
integer :: unit = 25 ! kbk
integer :: i,j,k,n
integer :: il,jl,ih,jh
integer :: i1,j1
REALTYPE :: x
integer :: unit = 25 ! kbk
integer :: i,j,k,n
integer :: il,jl,ih,jh
integer :: i1,j1
REALTYPE :: x
!EOP
!-----------------------------------------------------------------------
!BOC
......@@ -698,7 +723,7 @@ call print_bdy('Local Boundary Information')
jmin+joff .le. j .and. j .le. jmax+joff ) then
i1 = i-ioff
j1 = j-joff
H(i1,j1) = x
H(i1,j1) = x
end if
end do
end do
......@@ -726,7 +751,7 @@ call print_bdy('Local Boundary Information')
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: fn
character(len=*), intent(in) :: fn
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -738,10 +763,10 @@ call print_bdy('Local Boundary Information')
! !REVISION HISTORY:
!
! !LOCAL VARIABLES:
integer :: unit = 25 ! kbk
integer :: i,j,k,n
integer :: il,jl,ih,jh
integer :: i1,j1
integer :: unit = 25 ! kbk
integer :: i,j,k,n
integer :: il,jl,ih,jh
integer :: i1,j1
!EOP
!-----------------------------------------------------------------------
!BOC
......@@ -788,7 +813,7 @@ call print_bdy('Local Boundary Information')
IMPLICIT NONE
!
! !INPUT PARAMETERS:
integer, intent(in), dimension(E2DFIELD) :: mask
integer, intent(in), dimension(E2DFIELD) :: mask
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -802,7 +827,7 @@ call print_bdy('Local Boundary Information')
! 22Apr99 Karsten Bolding & Hans Burchard Initial code.
!
! !LOCAL VARIABLES:
integer :: i,j
integer :: i,j
!
!EOP
!-----------------------------------------------------------------------
......
!$Id: mirror_bdy_2d.F90,v 1.1 2003-04-07 15:22:03 kbk Exp $
!$Id: mirror_bdy_2d.F90,v 1.2 2003-04-23 11:59:39 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -30,12 +30,15 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: mirror_bdy_2d.F90,v $
! Revision 1.1 2003-04-07 15:22:03 kbk
! Revision 1.2 2003-04-23 11:59:39 kbk
! update_2d_halo on spherical variables + TABS to spaces
!
! Revision 1.1 2003/04/07 15:22:03 kbk
! parallel support
!
!
! !LOCAL VARIABLES:
integer :: i,j,n
integer :: i,j,n
!
!EOP
!-----------------------------------------------------------------------
......
!$Id: mirror_bdy_3d.F90,v 1.1 2003-04-07 15:22:03 kbk Exp $
!$Id: mirror_bdy_3d.F90,v 1.2 2003-04-23 11:59:39 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -30,12 +30,15 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: mirror_bdy_3d.F90,v $
! Revision 1.1 2003-04-07 15:22:03 kbk
! Revision 1.2 2003-04-23 11:59:39 kbk
! update_2d_halo on spherical variables + TABS to spaces
!
! Revision 1.1 2003/04/07 15:22:03 kbk
! parallel support
!
!
! !LOCAL VARIABLES:
integer :: i,j,n
integer :: i,j,n
!
!EOP
!-----------------------------------------------------------------------
......
!$Id: print_bdy.F90,v 1.1 2002-05-02 14:01:12 gotm Exp $
!$Id: print_bdy.F90,v 1.2 2003-04-23 11:59:39 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -16,7 +16,7 @@
IMPLICIT NONE
!
! !INPUT PARAMETERS:
character(len=*), intent(in) :: header
character(len=*), intent(in) :: header
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -26,15 +26,18 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: print_bdy.F90,v $
! Revision 1.1 2002-05-02 14:01:12 gotm
! Initial revision
! Revision 1.2 2003-04-23 11:59:39 kbk
! update_2d_halo on spherical variables + TABS to spaces
!
! Revision 1.1.1.1 2002/05/02 14:01:12 gotm
! recovering after CVS crash
!
! Revision 1.1.1.1 2001/04/17 08:43:08 bbh
! initial import into CVS
!
!
! !LOCAL VARIABLES:
integer :: n
integer :: n
!
!EOP
!-----------------------------------------------------------------------
......
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