copyright (C) 2001 MSC-RPN COMM %%%MC2%%%
subroutine mtn_sfc (geobus,ngeop) 1,2
implicit none
integer ngeop
real geobus(ngeop)
*
#include "dynmem.cdk"
#include "topo.cdk"
#include "rec.cdk"
#include "nestpnt.cdk"
#include "partopo.cdk"
#include "yomdyn.cdk"
#include "yomdyn1.cdk"
#include "lesbus.cdk"
#include "mtn.cdk"
include 'mpif.h'
*
integer i,j,err
real zdi, zdj, zfak, xpos, ypos, zfak1, hwx, hwy, hwx1, con
real weh(1-hx-1:ldni+hx,1-hy-1:ldnj+hy)
*
*----------------------------------------------------------------------
con=1.
if( vmh_ndt.gt.1 ) con=0.
*
hwx = real(max(1,mtn_hwx))
hwy = real(max(1,mtn_hwy))
hwx1= 8.
xpos = real(mtn_xpos)
ypos = real(mtn_ypos)
*
do j=1-hy-1,ldnj+hy
do i=1-hx-1,ldni+hx
zdi = (xpos - real(i+gc_ld(1,myproc)-1))
zdj = (ypos - real(j+gc_ld(3,myproc)-1))
if (mtn_hwx.le.0) zdi = 0.
if (mtn_hwy.le.0) zdj = 0.
zfak = (zdi/hwx)**2 + (zdj/hwy)**2
zfak1= 3.1415926535*zdi/hwx1 + 3.1415926535*zdj/hwx1
if ( theocase.eq.'MTN_PINTY1'
$ .or.theocase.eq.'MTN_PINTY2') then
weh(i,j) = mtn_heigth / (zfak+1.0)
else if ( theocase.eq.'MTN_SHAER'
$ .or.theocase.eq.'NOFLOW') then
weh(i,j) = mtn_heigth *exp(-zfak) *cos(zfak1)**2
endif
end do
end do
*
call dc_topo2
(hh0f,weh,0.0,minx,maxx,miny,maxy,ldni,ldnj,hx,hy,
$ period_x,period_y,maxhh01_h,maxhh02_h,myproc.eq.0)
*
do j=1-hy-1,ldnj+hy
do i=1-hx-1,ldni+hx
hh0i(i,j,1) = con*hh0f(i,j,1)
hh0i(i,j,2) = con*hh0f(i,j,2)
end do
end do
do j=1-hy,ldnj+hy
do i=1-hx,ldni+hx
hh0 (i,j,1) = hh0i(i,j,1)
hh0 (i,j,2) = hh0i(i,j,2)
end do
end do
*
if (gnmaphy.eq.1) then
if (myproc.eq.0) print*, 'Code must be adapted for local ',
$ 'dimensions of processor - ABORT in mtn_sfc'
call mc2stop
(-1)
c if (myproc.eq.0) call inibus (geobus,ngeop,gni,gnj)
c call MPI_bcast(geonm,maxbus*2,MPI_CHARACTER,0,MPI_COMM_WORLD,err)
c call MPI_bcast(geopar,maxbus*3,MPI_INTEGER,0,MPI_COMM_WORLD,err )
c call MPI_bcast(geobus,geospc ,MPI_REAL ,0,MPI_COMM_WORLD,err )
endif
*
*----------------------------------------------------------------------
return
end