subroutine nest_domain c c======================================================================= c === c This routine exchanges the domain data between nested runs. === c === c ------ === c Input: === c ------ === c === c Common Blocks === c === c /NEST/ === c === c CURRTID PVM task identifier for this run. (integer) === c LRGTID PVM task identifier for larger grid. (integer) === c SMLTID PVM task identifier for smaller grid. (integer) === c === c ------- === c Output: === c ------- === c === c Common Blocks === c === c /NEST/ === c === c I_LL_S Lower left corner of smaller grid in === c current grid. (integer) === c I_UR_S Upper right corner of smaller grid in === c current grid. (integer) === c J_LL_S Lower left corner of smaller grid in === c current grid. (integer) === c J_UR_L Upper right corner of current grid in === c larger grid. (integer) === c J_UR_S Upper right corner of smaller grid in === c current grid. (integer) === c NXLC Number of x-grid points in larger domain === c covered by current domain. (integer) === c NXS Number of x-grid points in smaller grid. (integer) === c NYLC Number of y-grid points in larger domain === c covered by current domain. (integer) === c NYS Number of y-grid points in smaller grid. (integer) === c === c Calls: EXITUS, HOPSRECV, NEST_ERRCHK === c PVM Calls: PVMFINITSEND, PVMFPACK, PVMFSEND, PVMFUNPACK, === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer bufid,ix,jy,lgind,nlvol,nsvol,nvol,status,xcoord #ifdef nest2larger * ,i_ll_l,i_ur_l,j_ll_l,j_ur_l,nxl,nyl #endif #if defined nest_ext2lrgr | defined nest_ext2smlr integer nlpal,npal,nspal logical pok #endif integer iinfo(3),testrec(2),xrec(2) logical ok,vok FLOAT * finfo(7),x,xgridx,xgridy,xrlatd,xrlngd,xthetad,y FLOAT * cenlat,cenlon,xdelx,xdely c #if defined nest2larger & defined nest2smaller parameter (lgind=2) #else parameter (lgind=1) #endif c c======================================================================= c Begin executable code. c======================================================================= c #ifdef nest2larger c----------------------------------------------------------------------- c Send coordinate data to larger domain. c----------------------------------------------------------------------- c iinfo(1) = imt iinfo(2) = jmt iinfo(3) = coord c finfo(1) = gridx finfo(2) = gridy finfo(3) = rlngd finfo(4) = rlatd finfo(5) = delx finfo(6) = dely finfo(7) = thetad c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_DOMAIN','InitSend',bufid,1,1,1) call pvmfpack (INTEGER4,iinfo,3,1,status) call nest_errchk ('NEST_DOMAIN','Pack',status,1,1,1) call pvmfsend (lrgtid,idom2l,status) call nest_errchk ('NEST_DOMAIN','Send',status,1,1,1) c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_DOMAIN','InitSend',bufid,1,1,1) call pvmfpack (nstflt,finfo,7,1,status) call nest_errchk ('NEST_DOMAIN','Pack',status,1,1,1) call pvmfsend (lrgtid,rdom2l,status) call nest_errchk ('NEST_DOMAIN','Send',status,1,1,1) c c----------------------------------------------------------------------- c Receive coordinate data from larger domain. c----------------------------------------------------------------------- c call hopsrecv ('NEST_DOMAIN',lrgtid,idom2s,bufid) call pvmfunpack (INTEGER4,iinfo,3,1,status) call nest_errchk ('NEST_DOMAIN','UnPack',status,1,1,1) c call hopsrecv ('NEST_DOMAIN',lrgtid,rdom2s,bufid) call pvmfunpack (nstflt,finfo,7,1,status) call nest_errchk ('NEST_DOMAIN','UnPack',status,1,1,1) c nxl = iinfo(1) nyl = iinfo(2) xcoord = iinfo(3) c xgridx = finfo(1) xgridy = finfo(2) xrlngd = finfo(3) xrlatd = finfo(4) xdelx = finfo(5) xdely = finfo(6) xthetad = finfo(7) c c----------------------------------------------------------------------- c Compute locations of current grid corners in larger domain. c----------------------------------------------------------------------- c x = FLoaT(imtp1)*p5 y = FLoaT(jmtp1)*p5 call xy2ll (x,y,coord,imt,jmt,gridx,gridy,rlngd,rlatd,delx, & dely,thetad,cenlon,cenlat) call ll2xy (cenlon,cenlat,xcoord,nxl,nyl,xgridx,xgridy,xrlngd, * xrlatd,xdelx,xdely,xthetad,x,y) c ix = nint(x) jy = nint(y-r6) c i_ll_l = ix - nint(FLoaT(imt+1)*r6) + 1 j_ll_l = jy - nint(FLoaT(jmt)*r6) + 1 c i_ur_l = ix + nint(FLoaT(imt+1)*r6) - 1 j_ur_l = jy + nint(FLoaT(jmt)*r6) - 1 c nxlc = i_ur_l - i_ll_l + 1 nylc = j_ur_l - j_ll_l + 1 c #endif #ifdef nest2smaller c----------------------------------------------------------------------- c Receive coordinate data from smaller domain. c----------------------------------------------------------------------- c call hopsrecv ('NEST_DOMAIN',smltid,idom2l,bufid) call pvmfunpack (INTEGER4,iinfo,3,1,status) call nest_errchk ('NEST_DOMAIN','UnPack',status,1,1,1) c call hopsrecv ('NEST_DOMAIN',smltid,rdom2l,bufid) call pvmfunpack (nstflt,finfo,7,1,status) call nest_errchk ('NEST_DOMAIN','UnPack',status,1,1,1) c nxs = iinfo(1) nys = iinfo(2) xcoord = iinfo(3) c xgridx = finfo(1) xgridy = finfo(2) xrlngd = finfo(3) xrlatd = finfo(4) xdelx = finfo(5) xdely = finfo(6) xthetad = finfo(7) c c c----------------------------------------------------------------------- c Send coordinate data to smaller domain. c----------------------------------------------------------------------- c iinfo(1) = imt iinfo(2) = jmt iinfo(3) = coord c finfo(1) = gridx finfo(2) = gridy finfo(3) = rlngd finfo(4) = rlatd finfo(5) = delx finfo(6) = dely finfo(7) = thetad c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_DOMAIN','InitSend',bufid,1,1,1) call pvmfpack (INTEGER4,iinfo,3,1,status) call nest_errchk ('NEST_DOMAIN','Pack',status,1,1,1) call pvmfsend (smltid,idom2s,status) call nest_errchk ('NEST_DOMAIN','Send',status,1,1,1) c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_DOMAIN','InitSend',bufid,1,1,1) call pvmfpack (nstflt,finfo,7,1,status) call nest_errchk ('NEST_DOMAIN','Pack',status,1,1,1) call pvmfsend (smltid,rdom2s,status) call nest_errchk ('NEST_DOMAIN','Send',status,1,1,1) c c----------------------------------------------------------------------- c Compute locations of smaller grid corners in current domain. c----------------------------------------------------------------------- c x = FLoaT(nxs+1)*p5 y = FLoaT(nys+1)*p5 call xy2ll (x,y,xcoord,nxs,nys,xgridx,xgridy,xrlngd,xrlatd,xdelx, & xdely,xthetad,cenlon,cenlat) call ll2xy (cenlon,cenlat,coord,imt,jmt,gridx,gridy,rlngd, * rlatd,delx,dely,thetad,x,y) c c ix = nint(x) jy = nint(y-r6) c i_ll_s = ix - nint(FLoaT(nxs+1)*r6) + 1 j_ll_s = jy - nint(FLoaT(nys)*r6) + 1 c i_ur_s = ix + nint(FLoaT(nxs+1)*r6) - 1 j_ur_s = jy + nint(FLoaT(nys)*r6) - 1 c nxcs = i_ur_s - i_ll_s + 1 nycs = j_ur_s - j_ll_s + 1 c #endif c----------------------------------------------------------------------- c Make sure enough space was reserved for passing data. c----------------------------------------------------------------------- c #ifdef nest2larger nlvol = max( nxlc*nylc, imt, jmt ) * km # else nlvol = 0 #endif c #ifdef nest2smaller nsvol = max( nxcs*nycs, nxs, nys ) * km # else nsvol = 0 #endif c nvol = max( nlvol, nsvol ) vok = nvol .le. xmdat c #if defined nest_ext2lrgr | defined nest_ext2smlr # if defined nest2larger & defined nest_ext2lrgr nlpal = imt*jmt # else nlpal = 0 # endif # if defined nest2smaller & defined nest_ext2smlr nspal = nxs*nys # else nspal = 0 # endif npal = max( nlpal, nspal ) pok = npal .le. xmndat c #endif #ifdef nest2smaller xrec(1) = smltid #endif #ifdef nest2larger xrec(lgind) = lrgtid #endif c #if !defined nest_ext2lrgr & !defined nest_ext2smlr if (vok) then call nest_test (currtid,xrec,ok,testrec) if (.not. ok) write (stdout,900) else write (stdout,910) xmdat,nvol call nest_test (currtid-1,xrec,ok,testrec) end if c if (.not. (vok.and.ok) ) call exitus ('NEST_DOMAIN') #else if (vok.and.pok) then call nest_test (currtid,xrec,ok,testrec) if (.not. ok) write (stdout,900) else if (.not.vok) write (stdout,910) xmdat,nvol if (.not.pok) write (stdout,920) xmndat,npal call nest_test (currtid-1,xrec,ok,testrec) end if c if (.not. (vok.and.ok.and.pok) ) call exitus ('NEST_DOMAIN') #endif c return c 900 format (/'***Error: NEST_DOMAIN - insufficient space in ', * 'another node in nesting chain.') 910 format (/'***Error: NEST_DOMAIN - insufficient space for ', * 'passing data.'/11x,'XMDAT = ',i10/11x,'Required space: ' * ,i10/11x,'Change param.h, recompile and rerun.') #if defined nest_ext2lrgr | defined nest_ext2smlr 920 format (/'***Error: NEST_DOMAIN - insufficient space for ', * 'passing data.'/11x,'XMNDAT = ',i10/11x,'Required space: ' * ,i10/11x,'Change param.h, recompile and rerun.') #endif c end