copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r rsdata *subroutine rsdata (levels,lnk,iun,nomvar,idatev,ip3,nv,donut) 12,1 * implicit none integer lnk,iun,idatev,ip3,levels(lnk),donut character*4 nomvar,nv ** #include "rec.cdk"
#include "grd.cdk"
#include "lcldim.cdk"
#include "hinterpo.cdk"
#include "partopo.cdk"
* character*1 typvar character*8 etiket integer ip2,i,ii,j,jj,k,err_rdh,cnt,s_rdhint,iproc,i0,in,j0,jn, $ donutx external s_rdhint real wk1(Grd_ni,Grd_nj),wk2(Grd_ni*Grd_nj) *---------------------------------------------------------------------- * etiket = ' ' typvar = ' ' ip2 = -1 donutx = -1 if (donut.gt.0) donutx = donut + 1 * do 110 k=1,lnk * err_rdh = s_rdhint
(wk1,xpx,ypx,Grd_ni,Grd_nj,nomvar,idatev, $ levels(k),ip2,ip3,etiket,typvar,.false.,hint_ntr,iun,6) if (err_rdh.lt.0) goto 500 * 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)= wk1(ii,jj) end do end do c call bmf_write ( gc_ld2(5,iproc), nomvar,cnt,1,cnt, c $ 1,1,1,lnk,k,k,0,0,0,0,41,0,cnt,wk2 ) call bmf_write ( gc_ld2(5,iproc), nomvar,in-i0+1,1,in-i0+1, $ jn-j0+1,1,jn-j0+1,lnk,k,k,0,0,0,0,41,0,cnt,wk2 ) end do end do * else * cnt = 0 do j = 1, donutx do i = 1, Grd_ni cnt = cnt+1 wk2(cnt)= wk1(i,j) end do end do call bmf_write ( gc_ld2(5,0), nomvar,Grd_ni,1,Grd_ni, $ donutx,1,donutx,lnk,k,k,0,0,0,0,41,0,cnt,wk2 ) cnt = 0 do j = Grd_nj-donutx+1,Grd_nj do i = 1, Grd_ni cnt = cnt+1 wk2(cnt)= wk1(i,j) end do end do call bmf_write ( gc_ld2(5,0)+1,nomvar,Grd_ni,1,Grd_ni, $ donutx,1,donutx,lnk,k,k,0,0,0,0,41,0,cnt,wk2 ) cnt = 0 do j = donutx,Grd_nj-donutx+1 do i = 1, donutx cnt = cnt+1 wk2(cnt)= wk1(i,j) end do end do call bmf_write ( gc_ld2(5,0)+2, nomvar, donutx,1,donutx, $ Grd_nj-2*donutx+2,1,Grd_nj-2*donutx+2,lnk,k,k, $ 0,0,0,0,41,0,cnt,wk2 ) cnt = 0 do j = donutx,Grd_nj-donutx+1 do i = Grd_ni-donutx+1,Grd_ni cnt = cnt+1 wk2(cnt)= wk1(i,j) end do end do call bmf_write ( gc_ld2(5,0)+3, nomvar, donutx,1,donutx, $ Grd_nj-2*donutx+2,1,Grd_nj-2*donutx+2,lnk,k,k, $ 0,0,0,0,41,0,cnt,wk2 ) * endif * 110 continue * nv = nomvar * *---------------------------------------------------------------------- 500 return end