Commit 5bc8206b authored by kbk's avatar kbk
Browse files

re-ordering mask calculation

parent 220a8d99
!$Id: domain.F90,v 1.6 2003-04-23 11:59:39 kbk Exp $ !$Id: domain.F90,v 1.7 2003-05-02 08:32:31 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -47,7 +47,10 @@ ...@@ -47,7 +47,10 @@
! Original author(s): Karsten Bolding & Hans Burchard ! Original author(s): Karsten Bolding & Hans Burchard
! !
! $Log: domain.F90,v $ ! $Log: domain.F90,v $
! Revision 1.6 2003-04-23 11:59:39 kbk ! Revision 1.7 2003-05-02 08:32:31 kbk
! re-ordering mask calculation
!
! Revision 1.6 2003/04/23 11:59:39 kbk
! update_2d_halo on spherical variables + TABS to spaces ! update_2d_halo on spherical variables + TABS to spaces
! !
! Revision 1.5 2003/04/07 14:34:42 kbk ! Revision 1.5 2003/04/07 14:34:42 kbk
...@@ -239,30 +242,120 @@ call get_dimensions(trim(input_dir) // bathymetry,iextr,jextr,rc) ...@@ -239,30 +242,120 @@ call get_dimensions(trim(input_dir) // bathymetry,iextr,jextr,rc)
HU = -10. HU = -10.
HV = -10. HV = -10.
lonc = -1000. lonc = -1000.
latc = -1000. latc = -1000.
call get_bathymetry(H,Hland,iextr,jextr,ioff,joff,imin,imax,jmin,jmax,rc) call get_bathymetry(H,Hland,iextr,jextr,ioff,joff, &
imin,imax,jmin,jmax,rc)
call update_2d_halo(H,H,az,imin,jmin,imax,jmax,H_TAG) call update_2d_halo(H,H,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG) call wait_halo(H_TAG)
#if 0
call update_2d_halo(lonc,lonc,az,imin,jmin,imax,jmax,H_TAG) call update_2d_halo(lonc,lonc,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG) call wait_halo(H_TAG)
call update_2d_halo(latc,latc,az,imin,jmin,imax,jmax,H_TAG) call update_2d_halo(latc,latc,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG) call wait_halo(H_TAG)
#endif
case default case default
FATAL 'A non valid input format has been chosen' FATAL 'A non valid input format has been chosen'
stop 'init_domain' stop 'init_domain'
end select end select
#if 0 ! Calculation masks
#ifdef DK_03NM_TEST ! Do we want to set a minimum depth for certain regions
where (H .lt. 2.) call set_min_depth(trim(input_dir) // min_depth_file)
H = -10.
end where ! Do we want to do adjust the bathymetry
#endif call adjust_bathymetry(trim(input_dir) // bathymetry_adjust_file)
#endif
! Reads boundary location information
if (openbdy) then
call bdy_spec(trim(input_dir) // bdyinfofile)
call print_bdy('Global Boundary Information')
call have_bdy()
call print_bdy('Local Boundary Information')
end if
! Define calculation masks
az = 0
where (H .gt. Hland+SMALL)
az=1
end where
#define BOUNDARY_POINT 2
! western boundary - at present elev only
do n=1,NWB
az(wi(n),wfj(n):wlj(n)) = BOUNDARY_POINT
if(wfj(n) .eq. jmin) az(wi(n),jmin-1) = az(wi(n),jmin)
if(wlj(n) .eq. jmax) az(wi(n),jmax+1) = az(wi(n),jmax)
end do
! northern boundary - at present elev only
do n=1,NNB
az(nfi(n):nli(n),nj(n)) = BOUNDARY_POINT
if(nfi(n) .eq. imin) az(imin-1,nj(n)) = az(imin,nj(n))
if(nli(n) .eq. imax) az(imax+1,nj(n)) = az(imax,nj(n))
end do
! easter boundary - at present elev only
do n=1,NEB
az(ei(n),efj(n):elj(n)) = BOUNDARY_POINT
if(efj(n) .eq. jmin) az(ei(n),jmin-1) = az(ei(n),jmin)
if(elj(n) .eq. jmax) az(ei(n),jmax+1) = az(ei(n),jmax)
end do
! southern boundary - at present elev only
do n=1,NSB
az(sfi(n):sli(n),sj(n)) = BOUNDARY_POINT
if(sfi(n) .eq. imin) az(imin-1,sj(n)) = az(imin,sj(n))
if(sli(n) .eq. imax) az(imax+1,sj(n)) = az(imax,sj(n))
end do
#undef BOUNDARY_POINT
! Do we want to do adjust the mask
call adjust_mask(trim(input_dir) // mask_adjust_file)
! mask for U-points
au=0
do j=jmin,jmax
do i=imin,imax
if (az(i,j) .eq. 1 .and. az(i+1,j) .eq. 1) then
au(i,j)=1
end if
if ((az(i,j) .eq. 1 .and. az(i+1,j) .eq. 2).or. &
(az(i,j) .eq. 2 .and. az(i+1,j) .eq. 1)) then
au(i,j)=2
end if
if (az(i,j) .eq. 2 .and. az(i+1,j) .eq. 2) then
au(i,j)=3
end if
end do
end do
! mask for V-points
av=0
do j=jmin,jmax
do i=imin,imax
if (az(i,j) .eq. 1 .and. az(i,j+1) .eq. 1) then
av(i,j)=1
end if
if ((az(i,j) .eq. 1 .and. az(i,j+1) .eq. 2).or. &
(az(i,j) .eq. 2 .and. az(i,j+1) .eq. 1)) then
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
end do
end do
! mask for X-points
ax=0
do j=jmin,jmax
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
end do
end do
select case (grid_type) select case (grid_type)
case(1) case(1)
...@@ -283,87 +376,101 @@ end where ...@@ -283,87 +376,101 @@ end where
#endif #endif
case(2) case(2)
#ifdef SPHERICAL #ifdef SPHERICAL
lonu=lonx
lonv=lonc lonu=lonx
latv=latx lonv=lonc
latu=latc latv=latx
do j=jmin,jmax latu=latc
do i=imin,imax
dxc(i,j)=deg2rad*(lonu(i,j)-lonu(i-1,j))*rearth & do j=jmin,jmax
*cos(deg2rad*latc(i,j)) do i=imin,imax
end do dxc(i,j)=deg2rad*(lonu(i,j)-lonu(i-1,j))*rearth &
end do *cos(deg2rad*latc(i,j))
do j=jmin,jmax end do
do i=imin-1,imax end do
dxu(i,j)=deg2rad*(lonc(i+1,j)-lonc(i,j))*rearth & call update_2d_halo(dxc,dxc,az,imin,jmin,imax,jmax,H_TAG)
*cos(deg2rad*latc(i,j)) call wait_halo(H_TAG)
end do
end do do j=jmin,jmax
do j=jmin-1,jmax do i=imin-1,imax
do i=imin,imax dxu(i,j)=deg2rad*(lonc(i+1,j)-lonc(i,j))*rearth &
dxv(i,j)=deg2rad*(lonx(i,j)-lonx(i-1,j))*rearth & *cos(deg2rad*latc(i,j))
*cos(deg2rad*latv(i,j)) end do
end do end do
end do call update_2d_halo(dxu,dxu,au,imin,jmin,imax,jmax,U_TAG)
do j=jmin-1,jmax call wait_halo(U_TAG)
do i=imin-1,imax
dxx(i,j)=deg2rad*(lonv(i+1,j)-lonv(i,j))*rearth & do j=jmin-1,jmax
*cos(deg2rad*latx(i,j)) do i=imin,imax
end do dxv(i,j)=deg2rad*(lonx(i,j)-lonx(i-1,j))*rearth &
end do *cos(deg2rad*latv(i,j))
do j=jmin,jmax end do
do i=imin,imax end do
dyc(i,j)=deg2rad*(latv(i,j)-latv(i,j-1))*rearth call update_2d_halo(dxv,dxv,av,imin,jmin,imax,jmax,V_TAG)
end do call wait_halo(V_TAG)
end do
do i=imin-1,imax do j=jmin-1,jmax
do j=jmin,jmax do i=imin-1,imax
dyu(i,j)=deg2rad*(latx(i,j)-latx(i,j-1))*rearth dxx(i,j)=deg2rad*(lonv(i+1,j)-lonv(i,j))*rearth &
end do *cos(deg2rad*latx(i,j))
end do end do
do j=jmin-1,jmax end do
do i=imin,imax
dyv(i,j)=deg2rad*(latc(i,j+1)-latc(i,j))*rearth do j=jmin,jmax
end do do i=imin,imax
end do dyc(i,j)=deg2rad*(latv(i,j)-latv(i,j-1))*rearth
do j=jmin-1,jmax end do
do i=imin-1,imax end do
dyx(i,j)=deg2rad*(latu(i,j+1)-latu(i,j))*rearth call update_2d_halo(dyc,dyc,az,imin,jmin,imax,jmax,H_TAG)
end do call wait_halo(H_TAG)
end do
do j=jmin,jmax do i=imin-1,imax
do i=imin,imax do j=jmin,jmax
arcd1(i,j)=_ONE_/(dxc(i,j)*dyc(i,j)) dyu(i,j)=deg2rad*(latx(i,j)-latx(i,j-1))*rearth
arud1(i,j)=_ONE_/(dxu(i,j)*dyu(i,j)) end do
arvd1(i,j)=_ONE_/(dxv(i,j)*dyv(i,j)) end do
end do call update_2d_halo(dyu,dyu,au,imin,jmin,imax,jmax,U_TAG)
end do call wait_halo(U_TAG)
do j=jmin-1,jmax
do i=imin,imax
dyv(i,j)=deg2rad*(latc(i,j+1)-latc(i,j))*rearth
end do
end do
call update_2d_halo(dyv,dyv,av,imin,jmin,imax,jmax,V_TAG)
call wait_halo(V_TAG)
do j=jmin-1,jmax
do i=imin-1,imax
dyx(i,j)=deg2rad*(latu(i,j+1)-latu(i,j))*rearth
end do
end do
do j=jmin,jmax
do i=imin,imax
arcd1(i,j)=_ONE_/(dxc(i,j)*dyc(i,j))
arud1(i,j)=_ONE_/(dxu(i,j)*dyu(i,j))
arvd1(i,j)=_ONE_/(dxv(i,j)*dyv(i,j))
end do
end do
call update_2d_halo(arcd1,arcd1,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
call update_2d_halo(arud1,arud1,au,imin,jmin,imax,jmax,U_TAG)
call wait_halo(U_TAG)
call update_2d_halo(arvd1,arvd1,av,imin,jmin,imax,jmax,V_TAG)
call wait_halo(V_TAG)
do j=jmin,jmax do j=jmin,jmax
do i=imin,imax do i=imin,imax
coru(i,j)=2.*omega*sin(deg2rad*latu(i,j)) coru(i,j)=2.*omega*sin(deg2rad*latu(i,j))
corv(i,j)=2.*omega*sin(deg2rad*latv(i,j)) corv(i,j)=2.*omega*sin(deg2rad*latv(i,j))
end do end do
end do end do
call update_2d_halo(dxc,dxc,az,imin,jmin,imax,jmax,H_TAG) call update_2d_halo(coru,coru,au,imin,jmin,imax,jmax,U_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 wait_halo(U_TAG)
call update_2d_halo(corv,corv,av,imin,jmin,imax,jmax,V_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) call wait_halo(V_TAG)
#endif #endif
case(3) case(3)
#ifdef CURVILINEAR #ifdef CURVILINEAR
...@@ -438,98 +545,8 @@ end where ...@@ -438,98 +545,8 @@ end where
stop 'init_domain' stop 'init_domain'
end select end select
! Do we want to set a minimum depth for certain regions STDERR 'az'
call set_min_depth(trim(input_dir) // min_depth_file) call print_mask(az)
! Do we want to do adjust the bathymetry
call adjust_bathymetry(trim(input_dir) // bathymetry_adjust_file)
! Reads boundary location information
if (openbdy) then
call bdy_spec(trim(input_dir) // bdyinfofile)
call print_bdy('Global Boundary Information')
call have_bdy()
call print_bdy('Local Boundary Information')
end if
! Define calculation masks
az = 0
where (H .gt. Hland+SMALL)
az=1
end where
#define BOUNDARY_POINT 2
! western boundary - at present elev only
do n=1,NWB
az(wi(n),wfj(n):wlj(n)) = BOUNDARY_POINT
if(wfj(n) .eq. jmin) az(wi(n),jmin-1) = az(wi(n),jmin)
if(wlj(n) .eq. jmax) az(wi(n),jmax+1) = az(wi(n),jmax)
end do
! northern boundary - at present elev only
do n=1,NNB
az(nfi(n):nli(n),nj(n)) = BOUNDARY_POINT
if(nfi(n) .eq. imin) az(imin-1,nj(n)) = az(imin,nj(n))
if(nli(n) .eq. imax) az(imax+1,nj(n)) = az(imax,nj(n))
end do
! easter boundary - at present elev only
do n=1,NEB
az(ei(n),efj(n):elj(n)) = BOUNDARY_POINT
if(efj(n) .eq. jmin) az(ei(n),jmin-1) = az(ei(n),jmin)
if(elj(n) .eq. jmax) az(ei(n),jmax+1) = az(ei(n),jmax)
end do
! southern boundary - at present elev only
do n=1,NSB
az(sfi(n):sli(n),sj(n)) = BOUNDARY_POINT
if(sfi(n) .eq. imin) az(imin-1,sj(n)) = az(imin,sj(n))
if(sli(n) .eq. imax) az(imax+1,sj(n)) = az(imax,sj(n))
end do
#undef BOUNDARY_POINT
! Do we want to do adjust the mask
call adjust_mask(trim(input_dir) // mask_adjust_file)
au=0
do j=jmin,jmax
do i=imin,imax
if (az(i,j) .eq. 1 .and. az(i+1,j) .eq. 1) then
au(i,j)=1
end if
if ((az(i,j) .eq. 1 .and. az(i+1,j) .eq. 2).or. &
(az(i,j) .eq. 2 .and. az(i+1,j) .eq. 1)) then
au(i,j)=2
end if
if (az(i,j) .eq. 2 .and. az(i+1,j) .eq. 2) then
au(i,j)=3
end if
end do
end do
av=0
do j=jmin,jmax
do i=imin,imax
if (az(i,j) .eq. 1 .and. az(i,j+1) .eq. 1) then
av(i,j)=1
end if
if ((az(i,j) .eq. 1 .and. az(i,j+1) .eq. 2).or. &
(az(i,j) .eq. 2 .and. az(i,j+1) .eq. 1)) then
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
end do
end do
ax=0
do j=jmin,jmax
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
end do
end do
#ifdef DEBUG #ifdef DEBUG
STDERR 'az' STDERR 'az'
call print_mask(az) call print_mask(az)
...@@ -839,7 +856,7 @@ call print_bdy('Local Boundary Information') ...@@ -839,7 +856,7 @@ call print_bdy('Local Boundary Information')
do j=jmax,jmin,-1 do j=jmax,jmin,-1
! write(0,'(5000(i1,x))') (mask(i,j), i=imin,imax) ! write(0,'(5000(i1,x))') (mask(i,j), i=imin,imax)
write(0,'(5000(i1))') (mask(i,j), i=imin,imax) write(0,'(5000(i1))') (mask(i,j), i=imin,imax,1)
end do end do
return return
......
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