C ********************************************************************** c * * c * * program advectio c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/xcoord/x(500) common/res/cnew(500) common/old_data/cold(500) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basict/dt,ntstep common/basics/u,jpersv common/bconc/cmax common/b_cour/Cr common/bsave/jsave common/btop/xtop c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- call b_data() call b_out() call datagrid() call initial() call solvadvc() end C ********************************************************************** c * * c * * subroutine b_data () c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basict/dt,ntstep common/basics/u,jpersv common/bconc/cmax common/btop/xtop c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- open (10,file='c:\numerics\b_data.dat',status='old') c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,11) ncolum 11 format(1x,i5) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,12) dx 12 format(1x,f10.3) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,13) ntstep 13 format(1x,i5) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,14) dt 14 format(1x,f10.3) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,15) u 15 format(1x,f10.3) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,16) jpersv 16 format(1x,i5) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- read (10,17) cmax 17 format(1x,f10.3) read (10,18) xtop 18 format(1x,f10.2) close (10) return end C ********************************************************************** c * * c * * subroutine b_out () c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basict/dt,ntstep common/basics/u,jpersv common/bconc/cmax common/b_cour/Cr common/btop/xtop c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- open (10,file='c:\numerics\b_out.dat',status='unknown') c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,11) ncolum 11 format(1x,' ncolum=',i5) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,12) dx 12 format(1x,' dx=',f10.3) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,13) ntstep 13 format(1x, ' ntstep=',i5) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,14) dt 14 format(1x,' dt= ',f10.3) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,15) u 15 format(1x,' u= ',f10.3) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,16) jpersv 16 format(1x, ' jpersv=',i5) write (10,18) xtop 18 format(1x,' xtop=',f10.2) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- write (10,17) cmax 17 format(1x, ' cmax=',f10.3) write (10,20) cr 20 format (1x, ' Courant number=', f7.3 ) close (10) return end C ********************************************************************** c * * c * * subroutine datagrid () c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/xcoord/x(500) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- x(1)=0. c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- do 10 i=2,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- x(i)=x(i-1)+dx 10 continue return end C ********************************************************************** c * * c * * subroutine initial () c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/xcoord/x(500) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum common/bconc/cmax common/old_data/cold(500) common/btop/xtop c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- c xtop=10. xmax=2.*xtop do 35 i=1,ncolum c xx=x(i) if ( x(i).lt.xtop) then cold(i)=(x(i)/xtop)*cmax c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- elseif ( x(i).le.xmax) then cold(i)=(1.-x(i)/xmax)*cmax else cold(i)=0. endif c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- 35 continue return end c ********************************************************************** c * * c * * subroutine solvadvc() c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/xcoord/x(500) common/res/cnew(500) common/old_data/cold(500) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basict/dt,ntstep common/basics/u,jpersv common/bconc/cmax common/b_cour/Cr common/bsave/jsave c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- t=0. c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- do 10 j=1,ntstep t=t+dt c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- call saveadvc(t,j) 10 continue return end C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- c ********************************************************************** c * * c * * subroutine saveadvc(t,j) c * * c * * C ********************************************************************** implicit double precision (a-h,o-z) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/xcoord/x(500) common/res/cnew(500) c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basicx/dx,ncolum c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- common/basict/dt,ntstep common/basics/u,jpersv common/bsave/jsave C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- CHARACTER*3 JCHAR CHARACTER*24 NFILES,NFILET C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- ITHLP1=J/JPERSV ITHELP=J-ITHLP1*JPERSV C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- IF (ITHELP.EQ.0) THEN C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- JSAVE=JSAVE+1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- OPEN(84,FILE='C:\FORCHRES\SCRATCH.DAT',STATUS='UNKNOWN') WRITE (84,174) JSAVE 174 FORMAT(1X,I3) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- CLOSE (84) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- OPEN(84,FILE='C:\FORCHRES\SCRATCH.DAT',STATUS='UNKNOWN') C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- READ(84,175) JCHAR 175 FORMAT(1X,A3) CLOSE (84) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- NFILEs='C:\numerics\advctres'//'.'//JCHAR C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- OPEN (85,FILE=NFILES,STATUS='UNKNOWN') WRITE (85,189) T 189 FORMAT(1X,'TIME=',F10.2) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- DO 176 I=1,ncolum C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- WRITE(85,177)I,X(I),cnew(i) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- 177 FORMAT(1X,I7,2F10.3) C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- 176 CONTINUE close (85) endif return end