copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r wtopo *subroutine wtopo ( topo_l, ni, nj, donut ) 1 implicit none * integer ni,nj,donut real topo_l(ni,nj,2) ** #include "lcldim.cdk"
#include "yomdyn1.cdk"
#include "partopo.cdk"
#include "lun.cdk"
* integer i,ii,j,jj,k,iproc,cnt,i0,in,j0,jn,donutx real wk2(ni*nj) * *---------------------------------------------------------------------- * donutx = -1 if (donut.gt.0) donutx = donut + 1 * if (donut.le.0) then do j=0,npey-1 do i=0,npex-1 iproc = j*npex + i call bmf_write ( gc_ld2(5,iproc),'HALO',1,1,1, $ 1,1,1,1,1,1,0,0,0,0,40,0,1,donut ) end do end do else iproc=0 do i=0,3 call bmf_write ( gc_ld2(5,iproc)+i,'HALO',1,1,1, $ 1,1,1,1,1,1,0,0,0,0,40,0,1,donut ) end do endif * do 110 k=1,2 * if (donut.le.0) then * do j=0,npey-1 do i=0,npex-1 iproc = j*npex + i i0 = gc_ld2(1,iproc) - hx*max(0,1-i) + hx in = gc_ld2(1,iproc) + gc_ld2(2,iproc) - 1 $ + hx*max(0,i-npex+2) + hx + 1 j0 = gc_ld2(3,iproc) - hx*max(0,1-j) + hx jn = gc_ld2(3,iproc) + gc_ld2(4,iproc) - 1 $ + hx*max(0,j-npey+2) + hx + 1 cnt = 0 do jj = j0, jn do ii = i0, in cnt = cnt+1 wk2(cnt)= topo_l(ii,jj,k) end do end do call bmf_write ( gc_ld2(5,iproc), 'MX ',in-i0+1,1,in-i0+1, $ jn-j0+1,1,jn-j0+1,2,k,k,0,0,0,0,41,0,cnt,wk2 ) end do end do * else * cnt = 0 do j = 1, donutx do i = 1, ni cnt = cnt+1 wk2(cnt)= topo_l(i,j,k) end do end do call bmf_write ( gc_ld2(5,0) , 'MX ',ni,1,ni,donutx,1,donutx, $ 2,k,k,0,0,0,0,41,0,cnt,wk2 ) cnt = 0 do j = nj-donutx+1,nj do i = 1, ni cnt = cnt+1 wk2(cnt)= topo_l(i,j,k) end do end do call bmf_write ( gc_ld2(5,0)+1, 'MX ',ni,1,ni,donutx,1,donutx, $ 2,k,k,0,0,0,0,41,0,cnt,wk2 ) cnt = 0 do j = donutx,nj-donutx+1 do i = 1, donutx cnt = cnt+1 wk2(cnt)= topo_l(i,j,k) end do end do call bmf_write ( gc_ld2(5,0)+2, 'MX ', donutx,1,donutx, $ nj-2*donutx+2,1,nj-2*donutx+2,2,k,k, $ 0,0,0,0,41,0,cnt,wk2 ) cnt = 0 do j = donutx,nj-donutx+1 do i = ni-donutx+1,ni cnt = cnt+1 wk2(cnt)= topo_l(i,j,k) end do end do call bmf_write ( gc_ld2(5,0)+3, 'MX ', donutx,1,donutx, $ nj-2*donutx+2,1,nj-2*donutx+2,2,k,k, $ 0,0,0,0,41,0,cnt,wk2 ) * endif * 110 continue *---------------------------------------------------------------------- return end