subroutine nest_flags 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 /OPTIONS/ === c === c IOPT various switches from standard input: (integer vector)=== c IOPT(8) Number of tracers exchanged with larger domain. === c IOPT(9) Number of tracers exchanged with smaller domain. === c === c ------- === c Output: === c ------- === c === c Common Blocks === c === c /NEST/ === c === c SPVL Flag value from larger grid. (real) === c SPVS Flag value from smaller grid. (real) === #ifdef coast c T_ACT Active value of land mask over tracer === c points. (integer) === c V_ACT Active value of land mask over velocity === c points. (integer) === #endif 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,lgind,ntpass,status integer testrec(2),xrec(2) logical nok,ok c #if defined nest2larger & defined nest2smaller parameter (lgind=2) #else parameter (lgind=1) #endif c c======================================================================= c Begin executable code. c======================================================================= c #ifdef coast c----------------------------------------------------------------------- c Set up active values of land masks. c----------------------------------------------------------------------- c t_act = 1 v_act = km c #endif #ifdef nest2larger c----------------------------------------------------------------------- c Exchange flag values with larger grid. c----------------------------------------------------------------------- c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_FLAGS','InitSend',bufid,1,1,1) call pvmfpack (nstflt,spv,1,1,status) call nest_errchk ('NEST_FLAGS','Pack',status,1,1,1) call pvmfsend (lrgtid,spvl2l,status) call nest_errchk ('NEST_FLAGS','Send',status,1,1,1) c call hopsrecv ('NEST_FLAGS',lrgtid,spvl2s,bufid) call pvmfunpack (nstflt,spvl,1,1,status) call nest_errchk ('NEST_FLAGS','UnPack',status,1,1,1) c c----------------------------------------------------------------------- c Determine the number of tracers to pass to larger grid. c----------------------------------------------------------------------- c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_FLAGS','InitSend',bufid,1,1,1) call pvmfpack (INTEGER4,iopt(8),1,1,status) call nest_errchk ('NEST_FLAGS','Pack',status,1,1,1) call pvmfsend (lrgtid,ntrc2l,status) call nest_errchk ('NEST_FLAGS','Send',status,1,1,1) c call hopsrecv ('NEST_FLAGS',lrgtid,ntrc2s,bufid) call pvmfunpack (INTEGER4,ntpass,1,1,status) call nest_errchk ('NEST_FLAGS','UnPack',status,1,1,1) c nok = ntpass .eq. iopt(8) c if (.not.nok) write (stdout,900) iopt(8),'larger',ntpass c #endif #ifdef nest2smaller c----------------------------------------------------------------------- c Exchange flag values with smaller grid. c----------------------------------------------------------------------- c call hopsrecv ('NEST_FLAGS',smltid,spvl2l,bufid) call pvmfunpack (nstflt,spvs,1,1,status) call nest_errchk ('NEST_FLAGS','UnPack',status,1,1,1) c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_FLAGS','InitSend',bufid,1,1,1) call pvmfpack (nstflt,spv,1,1,status) call nest_errchk ('NEST_FLAGS','Pack',status,1,1,1) call pvmfsend (smltid,spvl2s,status) call nest_errchk ('NEST_FLAGS','Send',status,1,1,1) c c----------------------------------------------------------------------- c Determine the number of tracers to pass to smaller grid. c----------------------------------------------------------------------- c call hopsrecv ('NEST_FLAGS',smltid,ntrc2l,bufid) call pvmfunpack (INTEGER4,ntpass,1,1,status) call nest_errchk ('NEST_FLAGS','UnPack',status,1,1,1) c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_FLAGS','InitSend',bufid,1,1,1) call pvmfpack (INTEGER4,iopt(9),1,1,status) call nest_errchk ('NEST_FLAGS','Pack',status,1,1,1) call pvmfsend (smltid,ntrc2s,status) call nest_errchk ('NEST_FLAGS','Send',status,1,1,1) c # ifdef nest2larger nok = nok .and. (ntpass .eq. iopt(9)) # else nok = ntpass .eq. iopt(9) # endif c if (.not.nok) write (stdout,900) iopt(9),'smaller',ntpass c #endif c----------------------------------------------------------------------- c Make sure there is agreement on the passing of tracer data. c----------------------------------------------------------------------- c #ifdef nest2smaller xrec(1) = smltid #endif #ifdef nest2larger xrec(lgind) = lrgtid #endif c if (nok) then call nest_test (currtid,xrec,ok,testrec) if (.not. ok) write (stdout,910) else call nest_test (currtid-1,xrec,ok,testrec) end if c if (.not. (nok.and.ok) ) call exitus ('NEST_FLAGS') c return c 900 format (/'***Error: NEST_FLAGS - inconsistent number of passed ', * 'tracers'/11x,'Number tracers (current domain): ',i10 * /11x,'Number tracers (',a,' domain): ',i10) 910 format (/'***Error: NEST_FLAGS - disagreement on tracer passing', * ' in another node in the nesting chain.') c end