Commit 6c0481b3 authored by kbk's avatar kbk
Browse files

fixed sequence of boundary updates

parent a2e9d2f6
!$Id: m2d.F90,v 1.15 2006-03-01 15:54:07 kbk Exp $ !$Id: m2d.F90,v 1.16 2006-08-25 09:00:17 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -32,9 +32,9 @@ ...@@ -32,9 +32,9 @@
logical :: bdy2d=.false. logical :: bdy2d=.false.
integer :: bdyfmt_2d,bdytype,bdyramp_2d=-1 integer :: bdyfmt_2d,bdytype,bdyramp_2d=-1
character(len=PATH_MAX) :: bdyfile_2d character(len=PATH_MAX) :: bdyfile_2d
REAL_4B :: bdy_old(1000) REAL_4B :: bdy_old(1500)
REAL_4B :: bdy_new(1000) REAL_4B :: bdy_new(1500)
REAL_4B :: bdy_data(1000) REAL_4B :: bdy_data(1500)
REAL_4B, allocatable :: bdy_times(:) REAL_4B, allocatable :: bdy_times(:)
integer, parameter :: comm_method=-1 integer, parameter :: comm_method=-1
! !
...@@ -198,8 +198,6 @@ ...@@ -198,8 +198,6 @@
write(debug,*) 'integrate_2d() # ',Ncall write(debug,*) 'integrate_2d() # ',Ncall
#endif #endif
if (have_boundaries) call update_2d_bdy(loop,bdyramp_2d)
if (mod(loop-1,MM) .eq. 0) then ! MacroMicro time step if (mod(loop-1,MM) .eq. 0) then ! MacroMicro time step
#ifndef NO_BOTTFRIC #ifndef NO_BOTTFRIC
call bottom_friction(runtype) call bottom_friction(runtype)
...@@ -221,6 +219,7 @@ ...@@ -221,6 +219,7 @@
Uint=Uint+U Uint=Uint+U
Vint=Vint+V Vint=Vint+V
end if end if
if (have_boundaries) call update_2d_bdy(loop,bdyramp_2d)
call sealevel() call sealevel()
call depth_update() call depth_update()
......
!$Id: bdy_3d.F90,v 1.10 2006-03-01 15:54:08 kbk Exp $ !$Id: bdy_3d.F90,v 1.11 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -239,9 +239,6 @@ ...@@ -239,9 +239,6 @@
end do end do
end do end do
call mirror_bdy_3d(T,H_TAG)
call mirror_bdy_3d(S,H_TAG)
#ifdef GETM_BIO #ifdef GETM_BIO
if ( allocated(cc3d) ) then if ( allocated(cc3d) ) then
do n=1,size(cc3d,1) do n=1,size(cc3d,1)
......
!$Id: m3d.F90,v 1.31 2006-03-17 11:06:33 kbk Exp $ !$Id: m3d.F90,v 1.32 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -26,7 +26,7 @@ ...@@ -26,7 +26,7 @@
! !USES: ! !USES:
use exceptions use exceptions
use parameters, only: avmmol use parameters, only: avmmol
use domain, only: maxdepth,vert_cord use domain, only: maxdepth,vert_cord,az
use m2d, only: Am use m2d, only: Am
use variables_2d, only: D,z,UEx,VEx use variables_2d, only: D,z,UEx,VEx
#ifndef NO_BAROCLINIC #ifndef NO_BAROCLINIC
...@@ -43,6 +43,9 @@ ...@@ -43,6 +43,9 @@
use variables_3d use variables_3d
use advection_3d, only: init_advection_3d use advection_3d, only: init_advection_3d
use bdy_3d, only: init_bdy_3d, do_bdy_3d use bdy_3d, only: init_bdy_3d, do_bdy_3d
! Necessary to use halo_zones because update_3d_halos() have been moved out
! temperature.F90 and salinity.F90 - should be changed at a later stage
use halo_zones, only: update_3d_halo,wait_halo,D_TAG
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -363,7 +366,6 @@ ...@@ -363,7 +366,6 @@
#endif #endif
call start_macro() call start_macro()
#ifndef NO_BAROCLINIC #ifndef NO_BAROCLINIC
if (bdy3d) call do_bdy_3d(0,T)
#endif #endif
#ifdef MUDFLAT #ifdef MUDFLAT
call coordinates(vert_cord,cord_relax,maxdepth) call coordinates(vert_cord,cord_relax,maxdepth)
...@@ -421,6 +423,23 @@ ...@@ -421,6 +423,23 @@
if(runtype .eq. 4) then ! prognostic T and S if(runtype .eq. 4) then ! prognostic T and S
if (calc_temp) call do_temperature(n) if (calc_temp) call do_temperature(n)
if (calc_salt) call do_salinity(n) if (calc_salt) call do_salinity(n)
! The following is a bit clumpsy and should be changed when do_bdy_3d()
! operates on individual fields and not as is the case now - on both
! T and S.
#ifndef NO_BAROCLINIC
if (bdy3d) call do_bdy_3d(0,T)
if (calc_temp) then
call update_3d_halo(T,T,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
call mirror_bdy_3d(T,D_TAG)
end if
if (calc_salt) then
call update_3d_halo(S,S,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
call mirror_bdy_3d(S,D_TAG)
end if
#endif
end if end if
#endif #endif
......
!$Id: salinity.F90,v 1.21 2006-03-19 10:19:36 hb Exp $ !$Id: salinity.F90,v 1.22 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -299,6 +299,7 @@ salt_field_no=1 ...@@ -299,6 +299,7 @@ salt_field_no=1
call update_3d_halo(S,S,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG) call update_3d_halo(S,S,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG) call wait_halo(D_TAG)
call mirror_bdy_3d(S,D_TAG)
#ifdef DEBUG #ifdef DEBUG
write(debug,*) 'Leaving init_salinity()' write(debug,*) 'Leaving init_salinity()'
...@@ -488,9 +489,6 @@ salt_field_no=1 ...@@ -488,9 +489,6 @@ salt_field_no=1
end do end do
#endif #endif
call update_3d_halo(S,S,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
#ifdef DEBUG #ifdef DEBUG
write(debug,*) 'Leaving do_salinity()' write(debug,*) 'Leaving do_salinity()'
write(debug,*) write(debug,*)
......
!$Id: temperature.F90,v 1.17 2006-03-01 15:54:08 kbk Exp $ !$Id: temperature.F90,v 1.18 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -191,6 +191,7 @@ temp_field_no=1 ...@@ -191,6 +191,7 @@ temp_field_no=1
call update_3d_halo(T,T,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG) call update_3d_halo(T,T,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG) call wait_halo(D_TAG)
call mirror_bdy_3d(T,D_TAG)
#ifdef DEBUG #ifdef DEBUG
write(debug,*) 'Leaving init_temperature()' write(debug,*) 'Leaving init_temperature()'
...@@ -361,9 +362,6 @@ temp_field_no=1 ...@@ -361,9 +362,6 @@ temp_field_no=1
end do end do
end do end do
call update_3d_halo(T,T,az,iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
#ifdef DEBUG #ifdef DEBUG
write(debug,*) 'Leaving do_temperature()' write(debug,*) 'Leaving do_temperature()'
write(debug,*) write(debug,*)
......
!$Id: uu_momentum_3d.F90,v 1.10 2006-03-01 15:54:08 kbk Exp $ !$Id: uu_momentum_3d.F90,v 1.11 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -214,6 +214,7 @@ end do ...@@ -214,6 +214,7 @@ end do
end if end if
call wait_halo(U_TAG) call wait_halo(U_TAG)
call mirror_bdy_3d(uu,U_TAG)
#ifdef DEBUG #ifdef DEBUG
write(debug,*) 'Leaving uu_momentum_3d()' write(debug,*) 'Leaving uu_momentum_3d()'
......
!$Id: vv_momentum_3d.F90,v 1.13 2006-03-01 15:54:08 kbk Exp $ !$Id: vv_momentum_3d.F90,v 1.14 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -230,6 +230,7 @@ ...@@ -230,6 +230,7 @@
end if end if
call wait_halo(V_TAG) call wait_halo(V_TAG)
call mirror_bdy_3d(vv,V_TAG)
#ifdef DEBUG #ifdef DEBUG
write(debug,*) 'Leaving vv_momentum_3d()' write(debug,*) 'Leaving vv_momentum_3d()'
......
!$Id: mirror_bdy_2d.F90,v 1.2 2003-04-23 11:59:39 kbk Exp $ !$Id: mirror_bdy_2d.F90,v 1.3 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -30,7 +30,10 @@ ...@@ -30,7 +30,10 @@
! Original author(s): Karsten Bolding & Hans Burchard ! Original author(s): Karsten Bolding & Hans Burchard
! !
! $Log: mirror_bdy_2d.F90,v $ ! $Log: mirror_bdy_2d.F90,v $
! Revision 1.2 2003-04-23 11:59:39 kbk ! Revision 1.3 2006-08-25 09:00:19 kbk
! fixed sequence of boundary updates
!
! Revision 1.2 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.1 2003/04/07 15:22:03 kbk ! Revision 1.1 2003/04/07 15:22:03 kbk
...@@ -51,35 +54,46 @@ ...@@ -51,35 +54,46 @@
select case (tag) select case (tag)
case (U_TAG) case (U_TAG)
#if 0
do n = 1,NNB do n = 1,NNB
j = nj(n) j = nj(n)
f(nfi(n)-2,j) = f(nfi(n)-2,j-1)
f(nfi(n)-1,j) = f(nfi(n)-1,j-1)
do i = nfi(n),nli(n) do i = nfi(n),nli(n)
if (au(i,j) .eq. 3) f(i,j) = f(i,j-1) if (au(i,j) .eq. 3) f(i,j) = f(i,j-1)
end do end do
f(nli(n)+1,j) = f(nfi(n)+1,j-1)
f(nli(n)+2,j) = f(nfi(n)+2,j-1)
end do end do
#else
!KBKSTDERR 'mirror_bdy_2d: U_TAG'
#endif
do n = 1,NSB do n = 1,NSB
j = sj(n) j = sj(n)
f(sfi(n)-2,j) = f(sfi(n)-2,j+1)
f(sfi(n)-1,j) = f(sfi(n)-1,j+1)
do i = sfi(n),sli(n) do i = sfi(n),sli(n)
if (au(i,j) .eq. 3) f(i,j) = f(i,j+1) if (au(i,j) .eq. 3) f(i,j) = f(i,j+1)
end do end do
f(sli(n)+1,j) = f(sli(n)+1,j+1)
f(sli(n)+2,j) = f(sli(n)+2,j+1)
end do end do
case (V_TAG) case (V_TAG)
do n = 1,NWB do n = 1,NWB
i = wi(n) i = wi(n)
f(i,wfj(n)-2) = f(i+1,wfj(n)-2)
f(i,wfj(n)-1) = f(i+1,wfj(n)-1)
do j = wfj(n),wlj(n) do j = wfj(n),wlj(n)
if (av(i,j) .eq. 3) f(i,j) = f(i+1,j) if (av(i,j) .eq. 3) f(i,j) = f(i+1,j)
end do end do
f(i,wlj(n)+1) = f(i+1,wlj(n)+1)
f(i,wlj(n)+2) = f(i+1,wlj(n)+2)
end do end do
do n = 1,NEB do n = 1,NEB
i = ei(n) i = ei(n)
f(i,efj(n)-2) = f(i+1,efj(n)-2)
f(i,efj(n)-1) = f(i+1,efj(n)-1)
do j = efj(n),elj(n) do j = efj(n),elj(n)
if (av(i,j) .eq. 3) f(i,j) = f(i-1,j) if (av(i,j) .eq. 3) f(i,j) = f(i-1,j)
end do end do
f(i,elj(n)+1) = f(i+1,elj(n)+1)
f(i,elj(n)+2) = f(i+1,elj(n)+2)
end do end do
case default case default
#if 0 #if 0
......
!$Id: mirror_bdy_3d.F90,v 1.2 2003-04-23 11:59:39 kbk Exp $ !$Id: mirror_bdy_3d.F90,v 1.3 2006-08-25 09:00:19 kbk Exp $
#include "cppdefs.h" #include "cppdefs.h"
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!BOP !BOP
...@@ -11,7 +11,7 @@ ...@@ -11,7 +11,7 @@
! !DESCRIPTION: ! !DESCRIPTION:
! !
! !USES: ! !USES:
use halo_zones, only : U_TAG,V_TAG,H_TAG use halo_zones, only : U_TAG,V_TAG,H_TAG,D_TAG
use domain, only: iimin,iimax,jjmin,jjmax,kmax use domain, only: iimin,iimax,jjmin,jjmax,kmax
use domain, only: az,au,av use domain, only: az,au,av
use domain, only: NWB,NNB,NEB,NSB use domain, only: NWB,NNB,NEB,NSB
...@@ -30,7 +30,10 @@ ...@@ -30,7 +30,10 @@
! Original author(s): Karsten Bolding & Hans Burchard ! Original author(s): Karsten Bolding & Hans Burchard
! !
! $Log: mirror_bdy_3d.F90,v $ ! $Log: mirror_bdy_3d.F90,v $
! Revision 1.2 2003-04-23 11:59:39 kbk ! Revision 1.3 2006-08-25 09:00:19 kbk
! fixed sequence of boundary updates
!
! Revision 1.2 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.1 2003/04/07 15:22:03 kbk ! Revision 1.1 2003/04/07 15:22:03 kbk
...@@ -48,72 +51,91 @@ ...@@ -48,72 +51,91 @@
Ncall = Ncall+1 Ncall = Ncall+1
write(debug,*) 'mirror_bdy_3d() # ',Ncall write(debug,*) 'mirror_bdy_3d() # ',Ncall
#endif #endif
!KBK
return
!KBK
select case (tag) select case (tag)
case (U_TAG) case (U_TAG)
#if 0
do n = 1,NNB do n = 1,NNB
j = nj(n) j = nj(n)
f(nfi(n)-2,j,:) = f(nfi(n)-2,j-1,:)
f(nfi(n)-1,j,:) = f(nfi(n)-1,j-1,:)
do i = nfi(n),nli(n) do i = nfi(n),nli(n)
if (au(i,j) .eq. 3) f(i,j,:) = f(i,j-1,:) if (au(i,j) .eq. 3) f(i,j,:) = f(i,j-1,:)
end do end do
f(nli(n)+1,j,:) = f(nfi(n)+1,j-1,:)
f(nli(n)+2,j,:) = f(nfi(n)+2,j-1,:)
end do end do
#else
STDERR 'mirror_bdy_3d: U_TAG'
#endif
do n = 1,NSB do n = 1,NSB
j = sj(n) j = sj(n)
f(sfi(n)-2,j,:) = f(sfi(n)-2,j+1,:)
f(sfi(n)-1,j,:) = f(sfi(n)-1,j+1,:)
do i = sfi(n),sli(n) do i = sfi(n),sli(n)
if (au(i,j) .eq. 3) f(i,j,:) = f(i,j+1,:) if (au(i,j) .eq. 3) f(i,j,:) = f(i,j+1,:)
end do end do
f(sli(n)+1,j,:) = f(sli(n)+1,j+1,:)
f(sli(n)+2,j,:) = f(sli(n)+2,j+1,:)
end do end do
case (V_TAG) case (V_TAG)
do n = 1,NWB do n = 1,NWB
i = wi(n) i = wi(n)
f(i,wfj(n)-2,:) = f(i+1,wfj(n)-2,:)
f(i,wfj(n)-1,:) = f(i+1,wfj(n)-1,:)
do j = wfj(n),wlj(n) do j = wfj(n),wlj(n)
if (av(i,j) .eq. 3) f(i,j,:) = f(i+1,j,:) if (av(i,j) .eq. 3) f(i,j,:) = f(i+1,j,:)
end do end do
f(i,wlj(n)+1,:) = f(i+1,wlj(n)+1,:)
f(i,wlj(n)+2,:) = f(i+1,wlj(n)+2,:)
end do end do
do n = 1,NEB do n = 1,NEB
i = ei(n) i = ei(n)
f(i,efj(n)-2,:) = f(i+1,efj(n)-2,:)
f(i,efj(n)-1,:) = f(i+1,efj(n)-1,:)
do j = efj(n),elj(n) do j = efj(n),elj(n)
if (av(i,j) .eq. 3) f(i,j,:) = f(i-1,j,:) if (av(i,j) .eq. 3) f(i,j,:) = f(i-1,j,:)
end do end do
f(i,elj(n)+1,:) = f(i+1,elj(n)+1,:)
f(i,elj(n)+2,:) = f(i+1,elj(n)+2,:)
end do end do
case (H_TAG) case (H_TAG,D_TAG)
#if 1
do n = 1,NWB do n = 1,NWB
i = wi(n) i = wi(n)
f(i-1,wfj(n)-2,:) = f(i,wfj(n)-2,:)
f(i-1,wfj(n)-1,:) = f(i,wfj(n)-1,:)
do j = wfj(n),wlj(n) do j = wfj(n),wlj(n)
f(i-1,j,:) = f(i,j,:) f(i-1,j,:) = f(i,j,:)
end do end do
f(i-1,wlj(n)+1,:) = f(i,wlj(n)+1,:)
f(i-1,wlj(n)+2,:) = f(i,wlj(n)+2,:)
end do end do
do n = 1,NNB do n = 1,NNB
j = nj(n) j = nj(n)
f(nfi(n)-2,j+1,:) = f(nfi(n)-2,j,:)
f(nfi(n)-1,j+1,:) = f(nfi(n)-1,j,:)
do i = nfi(n),nli(n) do i = nfi(n),nli(n)
f(i,j+1,:) = f(i,j,:) f(i,j+1,:) = f(i,j,:)
end do end do
f(nli(n)+1,j+1,:) = f(nli(n)+1,j,:)
f(nli(n)+2,j+1,:) = f(nli(n)+2,j,:)
end do end do
do n = 1,NEB do n = 1,NEB
i = ei(n) i = ei(n)
f(i+1,efj(n)-2,:) = f(i,efj(n)-2,:)
f(i+1,efj(n)-1,:) = f(i,efj(n)-1,:)
do j = efj(n),elj(n) do j = efj(n),elj(n)
f(i+1,j,:) = f(i,j,:) f(i+1,j,:) = f(i,j,:)
end do end do
f(i+1,elj(n)+1,:) = f(i,elj(n)+1,:)
f(i+1,elj(n)+2,:) = f(i,elj(n)+2,:)
end do end do
do n = 1,NSB do n = 1,NSB
j = sj(n) j = sj(n)
f(sfi(n)-2,j-1,:) = f(sfi(n)-2,j,:)
f(sfi(n)-1,j-1,:) = f(sfi(n)-1,j,:)
do i = sfi(n),sli(n) do i = sfi(n),sli(n)
f(i,j-1,:) = f(i,j,:) f(i,j-1,:) = f(i,j,:)
end do end do
f(sli(n)+1,j-1,:) = f(sli(n)+1,j,:)
f(sli(n)+2,j-1,:) = f(sli(n)+2,j,:)
end do end do
#endif
case default case default
end select end select
......
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