copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
*
subroutine glb_bound (wall,slab) 1,22
implicit none
*
logical wall,slab
#
#include "dynmem.cdk"
#include "bcsdim.cdk"
#include "bcsmem.cdk"
#include "nestpnt.cdk"
#include "partopo.cdk"
#include "levels.cdk"
*
integer n,ofn,ofw,ofe,id,indn,indw,inde
real wk1(dim3d)
*
*----------------------------------------------------------------------
*
if (north+south+east+west.eq.0) goto 9988
*
* Update exterior halo
*
ofn = (bcs_in-bcs_is)/gnk
ofw = (bcs_iw-bcs_in)/gnk
ofe = (bcs_ie-bcs_iw)/gnk
indn = bcs_in + ofn
indw = bcs_iw + ofn + ofw
inde = bcs_ie + ofn + ofw + ofe
*
if (wall) then
call mirror
else
*
call filbo (ppp,bcs_pp,bcs_pp(indn),bcs_pp(indw),bcs_pp(inde),
$ "q",minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk+1)
call filbo
$ (uup,bcs_uu,bcs_uu(bcs_in),bcs_uu(bcs_iw),bcs_uu(bcs_ie),"u",
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk)
call filbo
$ (vvp,bcs_vv,bcs_vv(bcs_in),bcs_vv(bcs_iw),bcs_vv(bcs_ie),"v",
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk)
call filbo
$ (wwp,bcs_ww,bcs_ww(bcs_in),bcs_ww(bcs_iw),bcs_ww(bcs_ie),"q",
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk)
call filbo
$ (bbp,bcs_bb,bcs_bb(bcs_in),bcs_bb(bcs_iw),bcs_bb(bcs_ie),"q",
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk)
call filbo
$ (hup,bcs_hu,bcs_hu(bcs_in),bcs_hu(bcs_iw),bcs_hu(bcs_ie),"q",
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk)
do n=1,ntr
id = (n-1)*bcs_sz+1
call filbo (trp(1-hx,1-hy,1,n),bcs_tr(id),bcs_tr(id+bcs_in-1),
$ bcs_tr(id+bcs_iw-1),bcs_tr(id+bcs_ie-1),"q",
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,
$ minxw,maxxw,minyw,maxyw,gnk)
enddo
*
endif
*
* **** Horizontal blending (gravity wave absorber) ****
*
* hblen_x: # of points for blending along x (west and east )
* hblen_y: # of points for blending along y (south and north)
*
if ((hblen_x.gt.0).or.(hblen_y.gt.0)) then
*
call nesajr ( ppp,bcs_pp,bcs_pp(indn),bcs_pp(indw),bcs_pp(inde),
$ minx,maxx,miny,maxy,minxs,maxxs,minys,maxys,minxw,
$ maxxw,minyw,maxyw,gnk+1,1,1 )
call nesajr ( uup,bcs_uu,bcs_uu(bcs_in),bcs_uu(bcs_iw),
$ bcs_uu(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk,0,1 )
call nesajr ( vvp,bcs_vv,bcs_vv(bcs_in),bcs_vv(bcs_iw),
$ bcs_vv(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk,1,0 )
call nesajr ( wwp,bcs_ww,bcs_ww(bcs_in),bcs_ww(bcs_iw),
$ bcs_ww(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk,1,1 )
call nesajr ( bbp,bcs_bb,bcs_bb(bcs_in),bcs_bb(bcs_iw),
$ bcs_bb(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk,1,1 )
call nesajr ( hup,bcs_hu,bcs_hu(bcs_in),bcs_hu(bcs_iw),
$ bcs_hu(bcs_ie),minx,maxx,miny,maxy,minxs,maxxs,
$ minys,maxys,minxw,maxxw,minyw,maxyw,gnk,1,1 )
do n=1,ntr
id = (n-1)*bcs_sz+1
call nesajr (trp(1-hx,1-hy,1,n),bcs_tr(id),bcs_tr(id+bcs_in-1),
$ bcs_tr(id+bcs_iw-1),bcs_tr(id+bcs_ie-1),minx,maxx,miny,maxy,
$ minxs,maxxs,minys,maxys,minxw,maxxw,minyw,maxyw,gnk,1,1)
end do
*
endif
*
* **** Vetical blending (gravity wave absorber) ****
*
* * Le pilotage vertical des variables uu,vv,bb,pp,hu,ww tel que
* * decrit par les relation (4.2.1)-(4.2.2). La variable grspng
* * controle l'epaisseur de la zone de pilotage verticale, elle est
* * exprimee en km. Cette variable est passee en "common block" dans
* * nestz.cdk.
*
9988 if (gnpilver.gt.0) then
call davvert6 (uup,uuntt,minx,maxx,miny,maxy,gnk,zm,
$ gnpilver,grpilver)
call davvert6 (vvp,vvntt,minx,maxx,miny,maxy,gnk,zm,
$ gnpilver,grpilver)
call davvert6 (wwp,wwntt,minx,maxx,miny,maxy,gnk,zt,
$ gnpilver,grpilver)
call davvert6 (bbp,bbntt,minx,maxx,miny,maxy,gnk,ztr,
$ gnpilver,grpilver)
*
* en general le pilotage de la pression n'est pas necessaire
*
c call davvert6 (ppp(minx,miny,1),ppntt(minx,miny,1),
c $ minx,maxx,miny,maxy,gnk,zm,
c $ gnpilver,grpilver)
*
call davvert6 (hup,huntt,minx,maxx,miny,maxy,gnk,ztr,
$ gnpilver,grpilver)
endif
*
if (gnpvw.gt.0) then
do n=1,dim3d
wk1(n) = 0.
end do
call davvert6 (wwp,wk1 ,minx,maxx,miny,maxy,gnk,zt,
$ gnpvw,grpilver)
endif
*
if (slab) call slabsym
*----------------------------------------------------------------------
return
end