brettm
/
3DRWALK
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Code Tidy Up

Browse Source
master
Brett Miller 5 years ago
parent 2608e8689e
commit 1f24a75037
1 changed files with 131 additions and 146 deletions
Show Stats Download Patch File Download Diff File

77
source/3drwalk.for
Unescape Escape View File

@ -2,14 +2,32 @@ c----------------------------------------------------------------RWALK_3D
program RWALK_3D
c-----------------------------------------------------------------------c
c Purpose: c
c RWALK_3D - Random Walk Model c
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
c-----------------------------------------------------------------------c
c Define each commonblock in external .cb files to ensure they are
c the same in the main block and the subroutines.
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
@ -32,47 +50,20 @@ c-----------------------------------------------------------------------c
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)') '--- 3D_RWALK v2.6 ---'
write(*,'(a)') '--- UNSW Sydney ---'
write(*,'(a)') '--- Water Research Laboratory ---'
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----------------------------------------------------------------
c Dynamic array setup. Don't change
mtot=ntotal
idir=mtot
call setcst
c
c-------open required files
c
c Filestreams used
c 21 : output stream for RWD graphics file
c 22 : output stream for RWC graphics file
c 23 : output stream for RWZ graphics file
@ -89,7 +80,9 @@ c 20 : Plume Bin Dump file
c 30 : settling particles file
c 35 : particle tracking path file
c 36 : particle counting file
c
c Read in the user paramters
WRITE(*,*) ' Enter start-stamp (yyyymmddhhmm): '
READ(*,'(A12)') start_stamp
WRITE(*,'(A18,A12,A1)') ' START STAMP is "',start_stamp,'"'
@ -169,7 +162,6 @@ c
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
@ -196,8 +188,6 @@ c print*,plmnam,'pbindump=',pbindump(1)
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.
@ -250,7 +240,6 @@ c
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
@ -671,13 +660,10 @@ c
* 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)
@ -691,10 +677,9 @@ crdc 1 ACCESS='direct',STATUS='old',FORM='unformatted',RECL=1)
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)

Write Preview
Loading…
Cancel
Save