You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

800 lines
30 KiB
Plaintext

5 years ago
c----------------------------------------------------------------RWALK_3D
program RWALK_3D
c-----------------------------------------------------------------------c
c Purpose: c
5 years ago
c RWALK_3D - Random Walk Model
c
c History
c Originally written for the Sydney Deepwater Outfall
c Original version written by Brett Miller
c Updated by You Cong Wang circa 1996 (version 2.2)
c Used between 1996 and 2007 on many studies (up to Burwood)
c 2019 Modifications
c Starting with Version 2.5 (last used on Burwood Beach)
c Modifications to read RMA lastest file formats
c
c Planned modifications
c Modify to make use of Fortran 2000 dynamic arrays
c Modify to use class structure variables to improve readability
5 years ago
c-----------------------------------------------------------------------c
5 years ago
c Define each commonblock in external .cb files to ensure they are
c the same in the main block and the subroutines.
5 years ago
include '3duparms.cb'
include '3dpolls.cb'
include '3dgeom.cb'
include '3dmesh.cb'
include '3dpoints.cb'
include 'rise_fall.cb'
5 years ago
parameter (ntotal=250000000)
5 years ago
character fname*100,buff*100,partl*100,fltnam*100
cBMM2019
character header*1000
cBMM2019
character gridfname*100
integer gridnumber
common /bmhack/gridfname,gridnumber
5 years ago
character plmnam*100,cext*5
real r
5 years ago
integer t,NUMPARTS,max_numps,v_time
logical flipflag,restout,existing
integer numxx(50),numyy(50),numzz(50),resxyy(50),reszz(50)
real goee(50),gonn(50),gass(50),gacc(50),dimxyy(50),dimzz(50)
common /mgird/goee,gonn,gass,gacc,numxx,numyy,numzz,dimxyy,
* dimzz,resxyy,reszz
common /dbsys/numa,next,idir,ipp(3)
common /etype/inode(4)
common /randm/isd, isd1
common /iolist/ntm,ntr,nin,not,nsp,nfl,nt7,nt8,nt9,nt10,
* nt11,nt12,nt13,nt14,nt15,nt16,nt17,nt18,nt19
common mtot,npp,ia(ntotal)
integer isd, isd1
integer ADAY,AYEAR,AMONTH,ATIME,EGDS,EGDF
data inode/10,15,20,13/
data isd/0/, isd1/0/
data y0f/10.6/, y1f/-11.34/, y0r/1.5951/, y1r/-0.97525/
data rf/30.0/, rr/5.0/
5 years ago
5 years ago
write(*,'(a)') '-----------------------------------------------'
5 years ago
write(*,'(a)') '--- 3D_RWALK v2.6 ---'
write(*,'(a)') '--- UNSW Sydney ---'
write(*,'(a)') '--- Water Research Laboratory ---'
5 years ago
write(*,'(a)') '-----------------------------------------------'
5 years ago
c Dynamic array setup. Don't change
5 years ago
mtot=ntotal
idir=mtot
call setcst
5 years ago
c Filestreams used
5 years ago
c 21 : output stream for RWD graphics file
c 22 : output stream for RWC graphics file
c 23 : output stream for RWZ graphics file
c 9 : geometry file
c 2 : RMA10 velocity file
c 3 : input user parameters file
c 4 : input pollutants file
c 7 : input open-boundary file
c 8 : input hard-boundary file
c 10 : input restart file
c 11 : output restart file
c 19 : Floatable Bin Dump file
c 20 : Plume Bin Dump file
c 30 : settling particles file
c 35 : particle tracking path file
c 36 : particle counting file
5 years ago
c Read in the user paramters
WRITE(*,*) ' Enter start-stamp (yyyymmddhhmm): '
READ(*,'(A12)') start_stamp
WRITE(*,'(A18,A12,A1)') ' START STAMP is "',start_stamp,'"'
WRITE(*,*)
fname='920820'
call askstr(' Enter output graphics filename',fname)
5 years ago
partl=fname
gridfname=fname
gridnumber=1
5 years ago
dimopt='10'
5 years ago
call askstr(' Enter RMA-2 or RMA-10 option',dimopt)
5 years ago
if(dimopt(1:2).eq.'10') then
fname='bub003.3dg'
5 years ago
call askstr(' Enter 3d geometry filename',fname)
cBM2019 update for OUTBN3GE format
c open(9,file=fname,status='old',form='unformatted',err=10)
OPEN(9,FILE=fname,STATUS='old',FORM='BINARY',err=10)
READ(9) header ! Skip the 1000 character header
cBM2019 fname='sydney.res'
fname='bub007.rma'
5 years ago
call askstr(' Enter RMA-10 velocity filename',fname)
cBM2019 open(2,file=fname,status='old',form='unformatted',err=10)
cBM2019 update for OUTBNRMA format
OPEN(2,FILE=fname,STATUS='old',FORM='BINARY',err=10)
READ(2) header ! Skip the 1000 character header
5 years ago
else
5 years ago
fname='sydney.geo'
call askstr(' Enter 2D geometry filename',fname)
open(9,file=fname,status='old',form='unformatted',err=10)
5 years ago
buff='1.0,1.0'
5 years ago
call askstr(' Enter scales in x and y directions',buff)
5 years ago
read(buff,*) xscale,yscale
5 years ago
fname='sydney.res'
call askstr(' Enter RMA-2 velocity filename',fname)
open(2,file=fname,status='old',form='unformatted',err=10)
5 years ago
endif
5 years ago
fname='usrparam.rw'
5 years ago
call askstr(' Enter user parameters filename',fname)
open(3,file=fname,status='old',form='formatted',err=10)
5 years ago
fname='polls'
5 years ago
call askstr(' Enter pollutants filename',fname)
open(4,file=fname,status='old',form='formatted',err=10)
5 years ago
fname='no'
5 years ago
call askstr(' Enter open boundary filename',fname)
5 years ago
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
open(7,file=fname,status='old',form='formatted',err=10)
rewind 7
openbd=.true.
else
openbd=.false.
endif
fname='no'
5 years ago
call askstr(' Enter input restart filename',fname)
5 years ago
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
open(10,file=fname,status='unknown',form='unformatted',err=10)
restart=.true.
else
restart=.false.
endif
fname='no'
5 years ago
call askstr(' Enter output restart filename',fname)
5 years ago
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
open(11,file=fname,status='unknown',form='unformatted',err=10)
restout=.true.
else
restout=.false.
endif
5 years ago
fname='no'
CALL askstr(' Enter Floatables Bin-Dump filename',fname)
5 years ago
fltnam=fname
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
5 years ago
fbindump=.TRUE.
5 years ago
else
fbindump=.false.
endif
5 years ago
fname='no'
CALL askstr(' Enter Plumes Bin-Dump filename',fname)
5 years ago
plmnam=fname
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
5 years ago
do itemp=1,50
pbindump(itemp)=.TRUE.
enddo
5 years ago
else
5 years ago
do itemp=1,50
pbindump(itemp)=.false.
enddo
5 years ago
endif
5 years ago
fname='no'
CALL askstr(' Enter settleable particles filename',fname)
5 years ago
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
5 years ago
inquire(file=fname(1:lenstr(fname)),EXIST=existing)
5 years ago
if(existing) then
5 years ago
open(30,file=fname(1:lenstr(fname)),status='old')
5 years ago
close(30,status='delete')
endif
5 years ago
OPEN(30,FILE=fname, ACCESS='direct',
1 STATUS='new',FORM='unformatted',RECL=8, ERR=10)
settles=.TRUE.
5 years ago
rr=-1.0
rf=100.0
y0f=y0f*100.0/30.0
y1f=y1f*100.0/30.0
else
settles=.false.
endif
5 years ago
fname='no'
CALL askstr(' Enter particle tracking path filename',fname)
5 years ago
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
5 years ago
inquire(file=fname(1:lenstr(fname)),EXIST=existing)
5 years ago
if(existing) then
5 years ago
open(35,file=fname(1:lenstr(fname)),status='old')
5 years ago
close(35,status='delete')
endif
5 years ago
OPEN(35,FILE=fname,
1 STATUS='new',FORM='formatted',ERR=10)
tracking=.TRUE.
5 years ago
else
tracking=.false.
endif
goto 20
10 len0=lnblnk(fname)
write(6,'(a)') '*** File: '''//fname(1:len0)//''' not found ***'
stop
c
c-------read data
c
20 write(*,'(/a/)') 'Loading the user parameters ...'
call getusrparams
print *,'plumeonly,floatableonly=',plumeonly,floatableonly
call echoallparameters
write(*,'(/a/)') 'Loading the geometry of FE mesh ...'
5 years ago
rewind 9
cBM2019
read(9) header
5 years ago
read(9) np,ne
cBM2019
5 years ago
rewind 9
read(9) header
5 years ago
call defini('nop ',nnop ,10,ne+4)
call defini('ilst',nilst,1,ne/2+4)
call defini('imat',nimat,1,ne/2+4)
call definr('cord',ncord,3,7*np) !leave more space for 2D case
call definr('ao ',nao ,2,7*np+12)
call defini('nsur',nnsur,1,np*7/2+12)
call definr('widt',nwidt,1,np*7+12)
c BMM extra line for diffusivities
call definr('difs',ndifs,2,ne+4)
print *,'np=',np,npm,ne
call getgeometry(ia(ncord),ia(nnop),ia(nnsur),ia(nimat),
& ia(nwidt),ia(nao),ia(nilst),ia(ndifs))
print *,'np=',np,npm,ne
call refinr('cord',ncord,3,np+800) !leave some space for polygon
call refinr('ao ',nao ,2,np+4)
call refini('nsur',nnsur,1,np/2+4)
call refinr('widt',nwidt,1,np+4)
call refinr('difs',ndifs,2,ne+4)
c
c-------calculate the day of year DAYOFY
c
if(dieoffc) then
READ(start_stamp,'(I4,2I2,I4)') ISY, ISM, ISD, IST
RMIN=-outputTS/60
CALL TINC2(IST,ISD,ISM,ISY,ATIME,ADAY,AMONTH,AYEAR,RMIN,IER,0)
call gdate(1,AMONTH,ADAY,AYEAR,IDWK,IDYR,IDMON,EGDF,IER,0)
call gdate(1,1,1,AYEAR,IDWK,IDYR,IDMON,EGDS,IER,0)
DAYOFY=EGDF-EGDS+1
TOFDAY=int(ATIME/100)+mod(ATIME,100)/60.0
call DIEOFFS(0.0,DAYOFY,T90_D)
T90_D=3600.0*T90_D
endif
print *,'Euler=',euler
call defini('nply',nnply,2,1000)
call defini('nump',nnump,1,10000)
call getareaparams(ia(nnply),ia(nnump),ia(ncord),np,no_poly,
& nlengthp)
print *,'no_poly,nlengthp=',no_poly,nlengthp
call refini('nump',nnump,1,nlengthp)
call refini('nply',nnply,2,no_poly)
call defini('no_p',nno_p,1,no_poly)
call definr('ppm ',nppm ,1,no_poly)
c
c-------create an array storing number of particles in specified area with
c time tag
c
mlp=tot_dead_age/3600+2
call defini('nopt',nnopt,no_poly,mlp)
if(p_count) then
5 years ago
fname=partl(1:lenstr(partl))//'.par'
CALL askstr(' Enter particle counting filename',fname)
inquire(file=fname(1:lenstr(fname)),EXIST=existing)
5 years ago
if(existing) then
5 years ago
open(36,file=fname(1:lenstr(fname)),status='old')
5 years ago
close(36,status='delete')
endif
5 years ago
OPEN(36,FILE=fname,
1 STATUS='new',FORM='formatted', ERR=10)
5 years ago
write(36,'(a)') ' Start_stamp='//start_stamp
write(36,'(a,i15)') ' outputTS=',outputTS
write(36,'(a,i15)') 'tot_dead_age=',tot_dead_age
write(36,'(a,i15)') 'No. of Areas=',no_poly
5 years ago
endif
5 years ago
write(*,'(/a/)') 'Loading the pollutant windows ...'
read(4,*) poll_type,num_pollwins
call definr('pwin',npwin,4,num_pollwins)
call definr('masA',nmasA,1,num_pollwins)
call getpollwins(ia(npwin),ia(nmasA))
c
c-------divide FE elements into blocks
c
nx=2
ny=5
nz=1
nxyz=nx*ny*nz
call defini('ityp',nityp,1,ne)
call definr('ebox',nebox,6,ne)
call definr('egrp',negrp,6,nxyz)
call defini('nbeg',nnbeg,1,nxyz)
call defini('nend',nnend,1,nxyz)
call defini('nelg',nnelg,3,ne)
call definr('egps',negps,6,2000)
call defini('nbb ',nnbb ,1,2000)
call defini('nee ',nnee ,1,2000)
call defini('nblk',nnblk,2,2000)
call defini('nelb',nnelb,1,1)
call blocks(nx,ny,nz,np,ne,ia(nnop),ia(ncord),nxyz,ia(negrp),
* ia(nnbeg),ia(nnend),ia(nnelg),ia(nnbb),ia(nnee),ia(nnelb),
* ia(nnblk),ia(negps),ia(nityp),ia(nebox),m,num)
call refini('nelb',nnelb,1,num)
call delete('nelg')
call delete('nbeg')
call delete('nend')
call refinr('egrp',negrp,6,nxyz)
call refinr('egps',negps,6,m)
call refini('nbb ',nnbb ,1,m)
call refini('nee ',nnee ,1,m)
call refini('nblk',nnblk,2,m)
call locate('nelb',nnelb,mlt,num)
c
c-------read open boundaries
c
if(openbd) then
read(7,*) no_open
call definr('opbd',nopbd,4,no_open)
call getopenbound(no_open,ia(nopbd))
endif
call bcname
c
c-------setup boundary conditions
c
c
c-------main program loop
c
write(*,*) 'Start the walking ...'
no_settles=1
NUMPARTS=0
max_numpsA=0
max_numpsB=0
write(*,'(/a/)') 'Loading velocity field ...'
call definr('Avel',nAvel,3,np)
call definr('Bvel',nBvel,3,np)
call definr('vel ',nvel ,3,np)
call definr('dudt',ndudt,3,np)
call definr('dhdt',ndhdt,1,np)
call definr('wsel',nwsel,1,np)
call definr('wsl1',nwsl1,1,np)
call defini('ic ',nic ,1,np/2+4)
call definr('Apol',nApol,4,num_pollwins)
call definr('Bpol',nBpol,4,num_pollwins)
call definr('poll',npoll,4,num_pollwins)
call definr('pdot',npdot,1,num_pollwins)
call definr('masp',nmasp,1,num_pollwins)
call clearr(ia(npdot),1,num_pollwins)
call clearr(ia(ndhdt),1,np)
c
c-------initialise dudt(3,np)
c
if(.not.Euler) then
call clearr(ia(ndudt),3,np)
endif
c
c-------skip the first pollutant release for hot start
c
if(.not.psteadystate.and.restart) then
call getpollconditions(ia(nApol),ia(nmasp),ia(nmasA),
* NUMPARTS,max_numpsA,keyp)
if(keyp.eq.0) goto 50
endif
5 years ago
call getflowconditions(ia(nnsur),ia(nAvel),ia(ncord),
5 years ago
* ia(nao),ia(nwsel),ia(nwsl1),ia(nic),
* ia(ndhdt),ia(nnop),ia(nilst),keyf)
5 years ago
call getpollconditions(ia(nApol),ia(nmasp),ia(nmasA),
5 years ago
* NUMPARTS,max_numpsA,keyp)
if(keyf.eq.0.or.keyp.eq.0) goto 50
if(.not.restart) then
5 years ago
if(.not.hsteadystate) then
5 years ago
call getflowconditions(ia(nnsur),
* ia(nBvel),ia(ncord),ia(nao),ia(nwsel),ia(nwsl1),
* ia(nic),ia(ndhdt),ia(nnop),ia(nilst),keyf)
if(keyf.eq.0) goto 50
else
nBvel=nAvel
endif
5 years ago
if(.not.psteadystate) then
5 years ago
call getpollconditions(ia(nBpol),ia(nmasp),ia(nmasA),
* NUMPARTS,max_numpsB,keyp)
if(keyp.eq.0) goto 50
else
nBpol=nApol
max_numpsB=max_numpsA
endif
endif
flipflag=.FALSE.
max_numps=max(max_numpsA,max_numpsB)
print *,'no_grids=',no_grids
do m=1,no_grids
if(no_grids.eq.1) then
cext=' '
else
write(cext,'(i2.2)') m
endif
5 years ago
inquire(file=partl(1:lenstr(partl))//'.rwd'//cext(1:2),
5 years ago
* EXIST=existing)
if(existing) then
5 years ago
open(21,file=partl(1:lenstr(partl))//'.rwd'//cext(1:2),
5 years ago
* status='old')
close(21,status='delete')
endif
open(21,file=partl(1:lenstr(partl))//'.rwd'//cext(1:2),
* access='direct',status='new',form='unformatted',recl=1)
5 years ago
inquire(file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
5 years ago
* EXIST=existing)
if(existing) then
5 years ago
open(22,file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
5 years ago
* status='old')
close(22,status='delete')
endif
5 years ago
open(22,file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
5 years ago
* access='direct',status='new',form='unformatted',recl=1)
5 years ago
inquire(file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
5 years ago
* EXIST=existing)
if(existing) then
5 years ago
open(23,file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
5 years ago
* status='old')
close(23,status='delete')
endif
5 years ago
open(23,file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
5 years ago
* access='direct',status='new',form='unformatted',recl=1)
goE=goee(m)
goN=gonn(m)
gaS=gass(m)
gaC=gacc(m)
numX=numxx(m)
numY=numyy(m)
numZ=numzz(m)
dimXY=dimxyy(m)
dimZ=dimzz(m)
resXY=resxyy(m)
resZ=reszz(m)
call addoutputheader(21)
5 years ago
call addoutputheader(22)
call addoutputheader(23)
5 years ago
close(21)
close(22)
close(23)
5 years ago
IF (pbindump(m)) THEN
inquire(file=plmnam(1:lenstr(plmnam))//cext(1:2),
5 years ago
* EXIST=existing)
if(existing) then
5 years ago
open(20,file=plmnam(1:lenstr(plmnam))//cext(1:2),
5 years ago
* status='old')
close(20,status='delete')
endif
c BMM 070810 Addition of another file type for storing the bin file data
5 years ago
OPEN(37,FILE=plmnam(1:lenstr(plmnam))//'-block'//cext(1:2),
1 STATUS='unknown',FORM='unformatted')
5 years ago
5 years ago
OPEN(20,FILE=plmnam(1:lenstr(plmnam))//cext(1:2),
5 years ago
cdrc 1 ACCESS='direct',STATUS='new',FORM='unformatted',RECL=1)
1 ACCESS='direct',STATUS='new',FORM='unformatted',RECL=4)
r=FLOAT(numX*resXY)
WRITE(20,REC=1) r
r=FLOAT(numY*resXY)
WRITE(20,REC=2) r
r=FLOAT(numZ*resZ)
WRITE(20,REC=3) r
r=float(4+maxoutputs)
WRITE(20,REC=3) int(r)
WRITE(20,REC=4) 0.0
WRITE(20,REC=4+maxoutputs) 0.0
close(20)
ENDIF
5 years ago
5 years ago
IF (fbindump) THEN
inquire(file=fltnam(1:lenstr(fltnam))//cext(1:2),
5 years ago
* EXIST=existing)
if(existing) then
5 years ago
open(19,file=fltnam(1:lenstr(fltnam))//cext(1:2),
5 years ago
* status='old')
close(19,status='delete')
endif
5 years ago
OPEN(19,FILE=fltnam(1:lenstr(fltnam))//cext(1:2),
5 years ago
cdrc 1 ACCESS='direct',STATUS='new',FORM='unformatted',RECL=1)
1 ACCESS='direct',STATUS='new',FORM='unformatted',RECL=4)
r=FLOAT(numX*resXY)
WRITE(19,REC=1) r
r=FLOAT(numY*resXY)
WRITE(19,REC=2) r
r=float(4+maxoutputs)
WRITE(19,REC=3) r
WRITE(19,REC=4) 0.0
WRITE(19,REC=4+maxoutputs) 0.0
close(19)
5 years ago
ENDIF
5 years ago
enddo
if(settles) write(30,rec=1) no_settles,mass_pp
if(restart) then
rewind 10
read(10) NUMPARTS
endif
call defini('prtI',nprtI,1,NUMPARTS+1)
call definr('prtE',nprtE,1,NUMPARTS+1)
call definr('prtN',nprtN,1,NUMPARTS+1)
call definr('prtZ',nprtZ,1,NUMPARTS+1)
call definr('prtM',nprtM,1,NUMPARTS+1)
call definr('prtA',nprtA,1,NUMPARTS+1)
call definr('prtV',nprtV,1,NUMPARTS+1)
c
c-------read data for restart
c
if(restart) then
call inputRS(NUMPARTS,max_numps,ia(nprtI),ia(nprtE),
* ia(nprtN),ia(nprtZ),ia(nprtM),ia(nprtA),ia(nprtV),ia(nBvel),
* ia(nwsl1),ia(nBpol),ia(nmasA))
flipflag=.true.
endif
v_time=0 !sum of dtnew until newcondTS
t_p=0 !sum of time until termination
do i=1,maxoutputs
t=0
c
c----------estimate the maximum number of particles released
c
max_num=max_numps+NUMPARTS
call refini('prtI',nprtI,1,max_num)
call refinr('prtE',nprtE,1,max_num)
call refinr('prtN',nprtN,1,max_num)
call refinr('prtZ',nprtZ,1,max_num)
call refinr('prtM',nprtM,1,max_num)
call refinr('prtA',nprtA,1,max_num)
call refinr('prtV',nprtV,1,max_num)
c
c----------unsteady case
c
if(.not.hsteadystate.or.(.not.psteadystate)) then
30 if(flipflag) then
call walkem(ia(ncord),ia(nnop),ia(nityp),ia(nebox),
* ia(nBvel),ia(nAvel),ia(nvel),ia(ndudt),ia(nao),nxyz,
* ia(negrp),ia(negps),ia(nnblk),ia(nnelb),ia(nnbb),
* ia(nnee),ia(nBpol),ia(nApol),ia(npoll),ia(npdot),
* ia(nmasp),ia(npwin),ia(nprtE),ia(nprtN),ia(nprtZ),
* ia(nprtI),ia(nprtM),ia(nprtA),ia(nprtV),ia(nopbd),
* no_open,NUMPARTS,t,t_p,v_time,ia(ndifs))
if(v_time.eq.newcondTS) then
v_time=0
5 years ago
if(.not.hsteadystate) then
5 years ago
call getflowconditions(ia(nnsur),
* ia(nBvel),ia(ncord),ia(nao),ia(nwsel),ia(nwsl1),
* ia(nic),ia(ndhdt),ia(nnop),ia(nilst),keyf)
endif
5 years ago
if(.not.psteadystate) then
5 years ago
call getpollconditions(ia(nBpol),ia(nmasp),
* ia(nmasA),NUMPARTS,max_numpsB,keyp)
endif
flipflag=.FALSE.
if(max_numps.lt.max_numpsB) then
max_num=max_num + max_numpsB - max_numps
max_numps=max_numpsB
call refini('prtI',nprtI,1,max_num)
call refinr('prtE',nprtE,1,max_num)
call refinr('prtN',nprtN,1,max_num)
call refinr('prtZ',nprtZ,1,max_num)
call refinr('prtM',nprtM,1,max_num)
call refinr('prtA',nprtA,1,max_num)
call refinr('prtV',nprtV,1,max_num)
endif
endif
else
call walkem(ia(ncord),ia(nnop),ia(nityp),ia(nebox),
* ia(nAvel),ia(nBvel),ia(nvel),ia(ndudt),ia(nao),nxyz,
* ia(negrp),ia(negps),ia(nnblk),ia(nnelb),ia(nnbb),
* ia(nnee),ia(nApol),ia(nBpol),ia(npoll),ia(npdot),
* ia(nmasp),ia(npwin),ia(nprtE),ia(nprtN),ia(nprtZ),
* ia(nprtI),ia(nprtM),ia(nprtA),ia(nprtV),ia(nopbd),
* no_open,NUMPARTS,t,t_p,v_time,ia(ndifs))
if(v_time.eq.newcondTS) then
v_time=0
5 years ago
if(.not.hsteadystate) then
5 years ago
call getflowconditions(ia(nnsur),
* ia(nAvel),ia(ncord),ia(nao),ia(nwsel),ia(nwsl1),
* ia(nic),ia(ndhdt),ia(nnop),ia(nilst),keyf)
endif
5 years ago
if(.not.psteadystate) then
5 years ago
call getpollconditions(ia(nApol),ia(nmasp),
* ia(nmasA),NUMPARTS,max_numpsA,keyp)
endif
flipflag=.TRUE.
if(max_numps.lt.max_numpsA) then
max_num=max_num + max_numpsA - max_numps
max_numps=max_numpsA
call refini('prtI',nprtI,1,max_num)
call refinr('prtE',nprtE,1,max_num)
call refinr('prtN',nprtN,1,max_num)
call refinr('prtZ',nprtZ,1,max_num)
call refinr('prtM',nprtM,1,max_num)
call refinr('prtA',nprtA,1,max_num)
call refinr('prtV',nprtV,1,max_num)
endif
endif
endif
if(t.lt.outputTS) then
if(.not.hsteadystate.and.keyf.eq.0) goto 35
if(.not.psteadystate.and.keyp.eq.0) goto 35
goto 30
endif
c
c----------steady-state case
c
else
call walkem(ia(ncord),ia(nnop),ia(nityp),ia(nebox),
* ia(nAvel),ia(nAvel),ia(nAvel),ia(ndudt),ia(nao),nxyz,
* ia(negrp),ia(negps),ia(nnblk),ia(nnelb),ia(nnbb),
* ia(nnee),ia(nApol),ia(nApol),ia(nApol),ia(npdot),
* ia(nmasp),ia(npwin),ia(nprtE),ia(nprtN),ia(nprtZ),
* ia(nprtI),ia(nprtM),ia(nprtA),ia(nprtV),ia(nopbd),
* no_open,NUMPARTS,t,t_p,v_time,ia(ndifs))
endif
c
c----------output graphics
c
35 call refini('prtI',nprtI,1,NUMPARTS)
call refinr('prtE',nprtE,1,NUMPARTS)
call refinr('prtN',nprtN,1,NUMPARTS)
call refinr('prtZ',nprtZ,1,NUMPARTS)
call refinr('prtM',nprtM,1,NUMPARTS)
call refinr('prtA',nprtA,1,NUMPARTS)
call refinr('prtV',nprtV,1,NUMPARTS)
if(.not.settles.and.t.eq.outputTS) then
do m=1,no_grids
if(no_grids.eq.1) then
cext=' '
else
write(cext,'(i2.2)') m
endif
open(21,file=partl(1:lenstr(partl))//'.rwd'//cext(1:2),
* access='direct',status='old',form='unformatted',recl=1)
5 years ago
open(22,file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
5 years ago
* access='direct',status='old',form='unformatted',recl=1)
5 years ago
open(23,file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
5 years ago
* access='direct',status='old',form='unformatted',recl=1)
if(fbindump) then
5 years ago
OPEN(19,FILE=fltnam(1:lenstr(fltnam))//cext(1:2),
1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=4)
5 years ago
endif
if(pbindump(m)) then
5 years ago
OPEN(20,FILE=plmnam(1:lenstr(plmnam))//cext(1:2),
1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=4)
5 years ago
endif
goE=goee(m)
goN=gonn(m)
gaS=gass(m)
gaC=gacc(m)
numX=numxx(m)
numY=numyy(m)
numZ=numzz(m)
dimXY=dimxyy(m)
dimZ=dimzz(m)
resXY=resxyy(m)
resZ=reszz(m)
5 years ago
5 years ago
call outputgraphicscodes(m)
c call addpointers(21)
c call addpointers(22)
c call addpointers(23)
5 years ago
close(21)
close(22)
close(23)
if(fbindump) close(19)
if(pbindump(m)) close(20)
enddo
endif
if(.not.hsteadystate.and.keyf.eq.0) goto 40
if(.not.psteadystate.and.keyp.eq.0) goto 40
enddo
40 if(settles) write(30,rec=1) no_settles,mass_pp
call bcname
c
c-------output restart file
c
if(restout) then
if(hsteadystate.and.psteadystate) then
call outputRS(NUMPARTS,max_numps,ia(nprtI),ia(nprtE),
* ia(nprtN),ia(nprtZ),ia(nprtM),ia(nprtA),ia(nprtV),ia(nAvel),
* ia(nwsl1),ia(nApol),ia(nmasA))
elseif(flipflag) then
call outputRS(NUMPARTS,max_numps,ia(nprtI),ia(nprtE),
* ia(nprtN),ia(nprtZ),ia(nprtM),ia(nprtA),ia(nprtV),ia(nAvel),
* ia(nwsl1),ia(nApol),ia(nmasA))
else
call outputRS(NUMPARTS,max_numps,ia(nprtI),ia(nprtE),
* ia(nprtN),ia(nprtZ),ia(nprtM),ia(nprtA),ia(nprtV),ia(nBvel),
* ia(nwsl1),ia(nBpol),ia(nmasA))
endif
endif
50 close(2)
close(3)
close(4)
close(9)
if(restart) close(10)
if(restout) close(11)
5 years ago
if(settles) close(30)
5 years ago
stop
end
c----------------------------------------------------------------outputRS
subroutine outputRS(NUMPARTS,max_numps,partI,partE,partN,partZ,
* partM,partA,partV,vel,wsel1,poll,masspA)
c-----------------------------------------------------------------------c
c Purpose: c
c To output neccessary data for restart. c
c-----------------------------------------------------------------------c
include '3dpolls.cb'
include '3dmesh.cb'
integer NUMPARTS,max_numps,i,j
integer partI(1)
real partE(1),partN(1),partZ(1),partM(1),partA(1),partV(1)
real poll(4,1),vel(3,1),wsel1(1),masspA(1)
c
rewind 11
write(11) NUMPARTS,max_numps,(partI(i),i=1,NUMPARTS),(partE(i),
1 i=1,NUMPARTS),(partN(i),i=1,NUMPARTS),(partZ(i),i=1,
2 NUMPARTS),(partM(i),i=1,NUMPARTS),(partA(i),i=1,
3 NUMPARTS),(partV(i),i=1,NUMPARTS),((vel(j,i),j=1,3),
4 wsel1(i),i=1,np),((poll(j,i),j=1,4),i=1,num_pollwins),
5 (masspA(i),i=1,num_pollwins)
return
end
c-----------------------------------------------------------------inputRS
subroutine inputRS(NUMPARTS,max_numps,partI,partE,partN,partZ,
* partM,partA,partV,vel,wsel1,poll,masspA)
c-----------------------------------------------------------------------c
c Purpose: c
c To input neccessary data for restart. c
c-----------------------------------------------------------------------c
include '3dpolls.cb'
include '3dmesh.cb'
integer NUMPARTS,max_numps,i,j
integer partI(1)
real partE(1),partN(1),partZ(1),partM(1),partA(1),partV(1)
real poll(4,1),vel(3,1),wsel1(1),masspA(1)
c
rewind 10
read(10) NUMPARTS,max_numps,(partI(i),i=1,NUMPARTS),(partE(i),
1 i=1,NUMPARTS),(partN(i),i=1,NUMPARTS),(partZ(i),i=1,
2 NUMPARTS),(partM(i),i=1,NUMPARTS),(partA(i),i=1,
3 NUMPARTS),(partV(i),i=1,NUMPARTS),((vel(j,i),j=1,3),
4 wsel1(i),i=1,np),((poll(j,i),j=1,4),i=1,num_pollwins),
5 (masspA(i),i=1,num_pollwins)
return
end