subroutine nest_init c c======================================================================= c === c This routine initializes the nesting process. === c === c ------ === c Input: === c ------ === c === c Common Blocks: === c === c /IOUNITS/ === c === c STDOUT standard output logical unit. (integer)=== c === c ------- === c Output: === c ------- === c === c Common Blocks: === c === #ifdef nest2larger c /IOUNITS/ === c === c NSTINM Name of param. input file for this run. (string) === c NSTONM Name of output log file for this run. (string) === c STDINP standard input logical unit. (integer)=== c STDOUT standard output logical unit. (integer)=== c === #endif c /NEST/ === c === c CURRTID PVM task identifier for this run. (integer) === #ifdef nest2larger c LRGTID PVM task identifier for larger grid. (integer) === #endif c === c Calls: EXITUS, LENGTH, HOPSRECV, NEST_ERRCHK === c PVM Calls: PVMFINITSEND, PVMFPACK, PVMFSEND, PVMFUNPACK, === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c #ifdef nest2larger integer bufid,ios,lenstr,recval,sbgn,send,status,testval c parameter (testval=8) c #endif c======================================================================= c Begin executable code. c======================================================================= c c----------------------------------------------------------------------- c Determine Task identifier for this run. c----------------------------------------------------------------------- c call pvmfmytid (currtid) call nest_errchk ('NEST_INIT','MyTid',currtid,1,1,1) c #ifdef nest2larger c----------------------------------------------------------------------- c Determine Task identifier for this run. c----------------------------------------------------------------------- c call pvmfparent (lrgtid) call nest_errchk ('NEST_INIT','ParentTid',lrgtid,1,1,1) c c----------------------------------------------------------------------- c Test the connection. c----------------------------------------------------------------------- c c Receive test integer value from larger domain. c call hopsrecv ('NEST_INIT',lrgtid,spts2s,bufid) call pvmfunpack (INTEGER4,recval,1,1,status) call nest_errchk ('NEST_INIT','UnPack',status,1,1,1) c c Send test integer value to larger domain. c call pvmfinitsend (PVMDATADEFAULT,bufid) call nest_errchk ('NEST_INIT','InitSend',bufid,1,1,1) call pvmfpack (INTEGER4,testval,1,1,status) call nest_errchk ('NEST_INIT','Pack',status,1,1,1) call pvmfsend (lrgtid,spts2l,status) call nest_errchk ('NEST_INIT','Send',status,1,1,1) c c Compare values. c if (testval.ne.recval) then write (stdout,900) testval,recval call exitus ('NEST_INIT') end if c c----------------------------------------------------------------------- c Receive I/O file names. c----------------------------------------------------------------------- c c Receive input file name & its length from larger domain. c call hopsrecv ('NEST_INIT',lrgtid,lnifil,bufid) call pvmfunpack (INTEGER4,lenstr,1,1,status) call nest_errchk ('NEST_INIT','UnPack',status,1,1,1) c call hopsrecv ('NEST_INIT',lrgtid,ifilnm,bufid) call pvmfunpack (STRING,nstinm,lenstr,1,status) call nest_errchk ('NEST_INIT','UnPack',status,1,1,1) c c Receive output file name & its length from larger domain. c call hopsrecv ('NEST_INIT',lrgtid,lnofil,bufid) call pvmfunpack (INTEGER4,lenstr,1,1,status) call nest_errchk ('NEST_INIT','UnPack',status,1,1,1) c call hopsrecv ('NEST_INIT',lrgtid,ofilnm,bufid) call pvmfunpack (STRING,nstonm,lenstr,1,status) call nest_errchk ('NEST_INIT','UnPack',status,1,1,1) c c Reset standard I/O units. c stdinp = 101 call length (nstinm,lenstr,sbgn,send) open (stdinp, file=nstinm(sbgn:send), status='old', iostat=ios) if (ios.ne.0) then write (stdout,910) 'input',nstinm(sbgn:send) call exitus ('NEST_INIT') end if c stdout = 103 call length (nstonm,lenstr,sbgn,send) open(stdout, file=nstonm(sbgn:send), status='unknown', iostat=ios) if (ios.ne.0) then write (stdout,910) 'output',nstonm(sbgn:send) call exitus ('NEST_INIT') end if c #endif return c 900 format (/'***Error: NEST_INIT - unable to properly exchange ', & 'test values with larger domain.'/11x,'test value: ',i10 & /11x,'received value: ',i10) 910 format (/'***Error: NEST_INIT - unable to open ',a,' file:'/11x, & 1h",a,1h") c end