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.
791 lines
29 KiB
Fortran
791 lines
29 KiB
Fortran
c----------------------------------------------------------------RWALK_3D
|
|
program RWALK_3D
|
|
c-----------------------------------------------------------------------c
|
|
c Purpose: c
|
|
c RWALK_3D - Random Walk Model c
|
|
c-----------------------------------------------------------------------c
|
|
include '3duparms.cb'
|
|
include '3dpolls.cb'
|
|
include '3dgeom.cb'
|
|
include '3dmesh.cb'
|
|
include '3dpoints.cb'
|
|
include 'rise_fall.cb'
|
|
parameter (ntotal=50000000)
|
|
character fname*100,buff*100,partl*100,fltnam*100
|
|
character plmnam*100,cext*5
|
|
real r
|
|
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/
|
|
c
|
|
write(*,'(a)') '-----------------------------------------------'
|
|
write(*,'(a)') '--- ---'
|
|
write(*,'(a)') '--- 3D_RWALK Version 2.2 ---'
|
|
write(*,'(a)') '--- 06/08/96 ---'
|
|
write(*,'(a)') '--- ---'
|
|
write(*,'(a)') '--- Y.C. Wang & B. Miller ---'
|
|
write(*,'(a)') '--- Water Research Lab. U.N.S.W. ---'
|
|
write(*,'(a)') '--- Compiled with ifort 12/7/07 ---'
|
|
write(*,'(a)') '--- ---'
|
|
write(*,'(a)') '-----------------------------------------------'
|
|
|
|
c------------------------------------------------------------------
|
|
c Use Defined variables to echo where and when this program was compiled
|
|
c added to code by AF 12/8/04
|
|
c
|
|
c WRITE(*,'(2A)') 'This program was compiled in: '
|
|
c 1 ,PATH
|
|
c WRITE(*,'(2A)') ' with filename : '
|
|
c 1 ,__FILE__
|
|
c WRITE(*,'(2A)') 'It was compiled on : '
|
|
c 1 ,__DATE__
|
|
c WRITE(*,'(2A)') ' at time : '
|
|
c 1 ,__TIME__
|
|
c
|
|
c IF (INDEX
|
|
c 1 (PATH,'/wrlnmr/')
|
|
c 2 .eq.0) THEN
|
|
c PRINT *,'This is not being run from the QA area'
|
|
c ELSE
|
|
c PRINT*, 'This is being run from the QA area'
|
|
c ENDIF
|
|
c
|
|
c print *,'Running the program'
|
|
c----------------------------------------------------------------
|
|
mtot=ntotal
|
|
idir=mtot
|
|
call setcst
|
|
c
|
|
c-------open required files
|
|
c
|
|
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
|
|
c
|
|
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)
|
|
partl=fname
|
|
dimopt='10'
|
|
call askstr(' Enter RMA-2 or RMA-10 option',dimopt)
|
|
if(dimopt(1:2).eq.'10') then
|
|
fname='sydney.3dg'
|
|
call askstr(' Enter 3d geometry filename',fname)
|
|
open(9,file=fname,status='old',form='unformatted',err=10)
|
|
fname='sydney.res'
|
|
call askstr(' Enter RMA-10 velocity filename',fname)
|
|
open(2,file=fname,status='old',form='unformatted',err=10)
|
|
else
|
|
fname='sydney.geo'
|
|
call askstr(' Enter 2D geometry filename',fname)
|
|
open(9,file=fname,status='old',form='unformatted',err=10)
|
|
buff='1.0,1.0'
|
|
call askstr(' Enter scales in x and y directions',buff)
|
|
read(buff,*) xscale,yscale
|
|
fname='sydney.res'
|
|
call askstr(' Enter RMA-2 velocity filename',fname)
|
|
open(2,file=fname,status='old',form='unformatted',err=10)
|
|
endif
|
|
fname='usrparam.rw'
|
|
call askstr(' Enter user parameters filename',fname)
|
|
open(3,file=fname,status='old',form='formatted',err=10)
|
|
fname='polls'
|
|
call askstr(' Enter pollutants filename',fname)
|
|
open(4,file=fname,status='old',form='formatted',err=10)
|
|
fname='no'
|
|
call askstr(' Enter open boundary filename',fname)
|
|
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'
|
|
call askstr(' Enter input restart filename',fname)
|
|
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'
|
|
call askstr(' Enter output restart filename',fname)
|
|
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
|
|
fname='no'
|
|
CALL askstr(' Enter Floatables Bin-Dump filename',fname)
|
|
fltnam=fname
|
|
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
|
|
fbindump=.TRUE.
|
|
else
|
|
fbindump=.false.
|
|
endif
|
|
fname='no'
|
|
CALL askstr(' Enter Plumes Bin-Dump filename',fname)
|
|
plmnam=fname
|
|
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
|
|
do itemp=1,50
|
|
pbindump(itemp)=.TRUE.
|
|
enddo
|
|
else
|
|
do itemp=1,50
|
|
pbindump(itemp)=.false.
|
|
enddo
|
|
endif
|
|
c print*,plmnam,'pbindump=',pbindump(1)
|
|
fname='no'
|
|
CALL askstr(' Enter settleable particles filename',fname)
|
|
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
|
|
inquire(file=fname(1:lenstr(fname)),EXIST=existing)
|
|
if(existing) then
|
|
open(30,file=fname(1:lenstr(fname)),status='old')
|
|
close(30,status='delete')
|
|
endif
|
|
OPEN(30,FILE=fname, ACCESS='direct',
|
|
1 STATUS='new',FORM='unformatted',RECL=8, ERR=10)
|
|
settles=.TRUE.
|
|
rr=-1.0
|
|
rf=100.0
|
|
y0f=y0f*100.0/30.0
|
|
y1f=y1f*100.0/30.0
|
|
else
|
|
settles=.false.
|
|
endif
|
|
fname='no'
|
|
CALL askstr(' Enter particle tracking path filename',fname)
|
|
if(fname(1:1).ne.'n'.and.fname(1:1).ne.'N') then
|
|
inquire(file=fname(1:lenstr(fname)),EXIST=existing)
|
|
if(existing) then
|
|
open(35,file=fname(1:lenstr(fname)),status='old')
|
|
close(35,status='delete')
|
|
endif
|
|
ctmp OPEN(35,FILE=fname, ACCESS='direct',
|
|
ctmp 1 STATUS='new',FORM='unformatted',RECL=8, ERR=10)
|
|
OPEN(35,FILE=fname,
|
|
1 STATUS='new',FORM='formatted',ERR=10)
|
|
tracking=.TRUE.
|
|
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 ...'
|
|
rewind 9
|
|
read(9) np,ne
|
|
rewind 9
|
|
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)
|
|
c print *,'T90_D=',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
|
|
fname=partl(1:lenstr(partl))//'.par'
|
|
CALL askstr(' Enter particle counting filename',fname)
|
|
inquire(file=fname(1:lenstr(fname)),EXIST=existing)
|
|
if(existing) then
|
|
open(36,file=fname(1:lenstr(fname)),status='old')
|
|
close(36,status='delete')
|
|
endif
|
|
OPEN(36,FILE=fname,
|
|
1 STATUS='new',FORM='formatted', ERR=10)
|
|
|
|
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
|
|
|
|
endif
|
|
|
|
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
|
|
|
|
call getflowconditions(ia(nnsur),ia(nAvel),ia(ncord),
|
|
* ia(nao),ia(nwsel),ia(nwsl1),ia(nic),
|
|
* ia(ndhdt),ia(nnop),ia(nilst),keyf)
|
|
call getpollconditions(ia(nApol),ia(nmasp),ia(nmasA),
|
|
* NUMPARTS,max_numpsA,keyp)
|
|
if(keyf.eq.0.or.keyp.eq.0) goto 50
|
|
if(.not.restart) then
|
|
if(.not.hsteadystate) then
|
|
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
|
|
if(.not.psteadystate) then
|
|
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
|
|
inquire(file=partl(1:lenstr(partl))//'.rwd'//cext(1:2),
|
|
* EXIST=existing)
|
|
if(existing) then
|
|
open(21,file=partl(1:lenstr(partl))//'.rwd'//cext(1:2),
|
|
* 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)
|
|
inquire(file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
|
|
* EXIST=existing)
|
|
if(existing) then
|
|
open(22,file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
|
|
* status='old')
|
|
close(22,status='delete')
|
|
endif
|
|
open(22,file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
|
|
* access='direct',status='new',form='unformatted',recl=1)
|
|
inquire(file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
|
|
* EXIST=existing)
|
|
if(existing) then
|
|
open(23,file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
|
|
* status='old')
|
|
close(23,status='delete')
|
|
endif
|
|
open(23,file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
|
|
* 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)
|
|
call addoutputheader(22)
|
|
call addoutputheader(23)
|
|
close(21)
|
|
close(22)
|
|
close(23)
|
|
|
|
IF (pbindump(m)) THEN
|
|
inquire(file=plmnam(1:lenstr(plmnam))//cext(1:2),
|
|
* EXIST=existing)
|
|
if(existing) then
|
|
open(20,file=plmnam(1:lenstr(plmnam))//cext(1:2),
|
|
* status='old')
|
|
close(20,status='delete')
|
|
endif
|
|
|
|
c BMM 070810 Addition of another file type for storing the bin file data
|
|
|
|
OPEN(37,FILE=plmnam(1:lenstr(plmnam))//'-block'//cext(1:2),
|
|
1 STATUS='unknown',FORM='unformatted')
|
|
|
|
OPEN(20,FILE=plmnam(1:lenstr(plmnam))//cext(1:2),
|
|
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
|
|
|
|
IF (fbindump) THEN
|
|
inquire(file=fltnam(1:lenstr(fltnam))//cext(1:2),
|
|
* EXIST=existing)
|
|
if(existing) then
|
|
open(19,file=fltnam(1:lenstr(fltnam))//cext(1:2),
|
|
* status='old')
|
|
close(19,status='delete')
|
|
endif
|
|
OPEN(19,FILE=fltnam(1:lenstr(fltnam))//cext(1:2),
|
|
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)
|
|
ENDIF
|
|
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
|
|
if(.not.hsteadystate) then
|
|
call getflowconditions(ia(nnsur),
|
|
* ia(nBvel),ia(ncord),ia(nao),ia(nwsel),ia(nwsl1),
|
|
* ia(nic),ia(ndhdt),ia(nnop),ia(nilst),keyf)
|
|
endif
|
|
if(.not.psteadystate) then
|
|
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
|
|
if(.not.hsteadystate) then
|
|
call getflowconditions(ia(nnsur),
|
|
* ia(nAvel),ia(ncord),ia(nao),ia(nwsel),ia(nwsl1),
|
|
* ia(nic),ia(ndhdt),ia(nnop),ia(nilst),keyf)
|
|
endif
|
|
if(.not.psteadystate) then
|
|
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)
|
|
open(22,file=partl(1:lenstr(partl))//'.rwc'//cext(1:2),
|
|
* access='direct',status='old',form='unformatted',recl=1)
|
|
open(23,file=partl(1:lenstr(partl))//'.rwz'//cext(1:2),
|
|
* access='direct',status='old',form='unformatted',recl=1)
|
|
if(fbindump) then
|
|
OPEN(19,FILE=fltnam(1:lenstr(fltnam))//cext(1:2),
|
|
cdrc 1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=1)
|
|
1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=4)
|
|
endif
|
|
c print*,plmnam,'pbindump=',pbindump(m)
|
|
if(pbindump(m)) then
|
|
OPEN(20,FILE=plmnam(1:lenstr(plmnam))//cext(1:2),
|
|
crdc 1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=1)
|
|
1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=4)
|
|
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)
|
|
call outputgraphicscodes(m)
|
|
c print*,'here'
|
|
call addpointers(21)
|
|
c print*,'here2'
|
|
call addpointers(22)
|
|
call addpointers(23)
|
|
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)
|
|
if(settles) close(30)
|
|
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
|