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 		 