c *****************************************************
c
c  1D CIP-CSL2 test program
c
c    df/dt + d(uf)/dx = 0
c     * constant velocity: advection
c	2002-08-02 made
c
c *****************************************************
        INCLUDE 'PARAMETER'
        COMMON /VALUE/ YR(0:IM),RHO(0:IM)
        COMMON /NEXT/ YRN(0:IM),RHON(0:IM)
        COMMON /VELO/  YU(0:IM)
        COMMON /PARAM/ DX,DT,IEND,ISTEP,TIME

        dimension x(0:im)
c---------------------------------------------------------------------
c  file open
c                                                     netcdf - start >>>
      ix=im+1
      call ncopn1d(idf,'out1d-csl2.cdf',idn,idi,ix)
      call ncputattc(idf,'comment','1D-advection:CIP-CSL2')
      call ncdefss(idf,'t',idt,idn)
      call ncdefs1(idf,'yr',idyr,idn,idi)
      call ncdefs1(idf,'rho',idrho,idn,idi)
      nd=1

c                                                     netcdf - end   <<<
c---------------------------------------------------------------------


c       << SET INITIAL VALUE + GRAPH >>
         CALL INITIAL

            IEND = int(0.8/DT)
            TIME = 0.0

c---------------------------------------------------------------------
c                                                     netcdf - start >>>
      do i=0,im
        x(i)=dx*real(i)
      enddo

      call ncputo1(idf,idi,'x',x,ix)
c                                                     netcdf - start >>>
      istep=0
      t=istep*dt
      call ncputss(idf,idt,nd,t)
      call ncputs1(idf,idyr,nd,yr,ix)
      call ncputs1(idf,idrho,nd,rho,ix)
            mstatus=nf_sync(idf)
      nd=nd+1
c                                                     netcdf - end   <<<
c                                                     netcdf - end   <<<
c---------------------------------------------------------------------


c  <<<< STRAT CALCURATION >>>>>>

        DO 1000 ISTEP=1,IEND+1

	  CALL BOUNDARY
c        ----- advection -------
	  CALL ADVECTION
c        ----  Non-advection --- 
	  CALL NONADV


c         << SHIFT I STEP TO (I+1)STEP >>
            CALL SHIFT
	    time=time+dt
	    write(6,*) 'TIME= ',time

c---------------------------------------------------------------------
c                                                     netcdf - start >>>
      t=istep*dt
        if(mod(ISTEP-1,10).eq.0.or.ISTEP.eq.IEND) then
      call ncputss(idf,idt,nd,t)
      call ncputs1(idf,idyr,nd,yr,ix)
      call ncputs1(idf,idrho,nd,rho,ix)
            mstatus=nf_sync(idf)
      nd=nd+1
        end if
c                                                     netcdf - end   <<<
c--------------------------------------------------------------------


 1000   CONTINUE

c----------------------------------------------------------------------|
c  file close
c                                                     netcdf - start >>>
      mstatus=nf_close(idf)

c                                                     netcdf - end <<<<

        STOP
        END

C *******************************************************
        SUBROUTINE INITIAL
C  << INITIAL VALUE SETTING >
C
C *****************************************************
	INCLUDE "PARAMETER"
        INCLUDE "CSL2.ini2"

        RETURN
        END

C *******************************************************
        SUBROUTINE ADVECTION
C  << ADVECTION for Value >>
C
C *****************************************************
        INCLUDE "PARAMETER"
        INCLUDE "CSL2.adv"

        RETURN
        END

C *******************************************************
        SUBROUTINE NONADV
C  << Non-ADVECTION for Value >>
C
C *****************************************************
        INCLUDE "PARAMETER"
        INCLUDE "CSL2.non"

        RETURN
        END

C *******************************************************
        SUBROUTINE SHIFT
C
C *****************************************************
        INCLUDE "PARAMETER"
        INCLUDE "CSL2.shf"

        RETURN
        END

C *******************************************************
        SUBROUTINE BOUNDARY
C
C *****************************************************
        INCLUDE "PARAMETER"
        INCLUDE "CSL2.bou"

        RETURN
        END

c -------------- A series of NetCDF data routine :
c       Do not change,,,
c -------------------------------------------------

c======================================================================|
      subroutine ncopn1d(idf,file,idn,idi,ix)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      character*(*) file
c----------------------------------------------------------------------|

      mstatus = nf_create(file,0,idf)

      mstatus = nf_def_dim(idf,'ix',ix,idi)
      mstatus = nf_def_dim(idf,'nx', 0,idn)

      mstatus = nf_enddef(idf)

      return
      end

c======================================================================|
      subroutine ncputattc(idf,name,data_char)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      character*(*) name
      character*(*) data_char
c----------------------------------------------------------------------|

      mstatus = nf_redef(idf)
      mstatus = nf_put_att_text(idf,0,name,len(data_char),data_char)
      mstatus = nf_enddef(idf)

      return
      end

c======================================================================|
      subroutine ncdefss(idf,name,idd,idn)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      character*(*) name
c----------------------------------------------------------------------|

      mstatus = nf_redef(idf)
      mstatus = nf_def_var(idf,name,5,1,idn,idd)
      mstatus = nf_enddef(idf)

      return
      end

c======================================================================|
      subroutine ncdefs1(idf,name,idd,idn,idi)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      parameter(mrank=2)
      integer mdims(mrank)
      character*(*) name
c----------------------------------------------------------------------|

      mdims(1)=idi
      mdims(2)=idn

      mstatus = nf_redef(idf)
      mstatus = nf_def_var(idf,name,5,mrank,mdims,idd)
      mstatus = nf_enddef(idf)

      return
      end

c======================================================================|
      subroutine ncputo1(idf,idi,name,data_dbl,ix)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      character*(*) name
      dimension data_dbl(ix)
      real data(ix)
c----------------------------------------------------------------------|

      do i=1,ix
        data(i)=data_dbl(i)
      enddo

      mstatus = nf_redef(idf)
      mstatus = nf_def_var(idf,name,5,1,idi,idd)
      mstatus = nf_enddef(idf)

      mstatus=nf_put_var_real(idf,idd,data)

      return
      end

c======================================================================|
      subroutine ncputss(idf,idd,nd,data_dbl)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      real data
c----------------------------------------------------------------------|

      data=data_dbl
      mstatus=nf_put_var1_real(idf,idd,nd,data)

      return
      end

c======================================================================|
      subroutine ncputs1(idf,idd,nd,data_dbl,ix)
c======================================================================|
c----------------------------------------------------------------------|
      INCLUDE 'PARAMETER'
      parameter(mrank=2)
      dimension data_dbl(ix)
      integer mstart(mrank),mcount(mrank)
      real data(ix)
c----------------------------------------------------------------------|

      do i=1,ix
         data(i)=data_dbl(i)
      enddo

      mcount(1)=ix
      mcount(2)=1

      mstart(1)=1
      mstart(2)=nd

      mstatus=nf_put_vara_real(idf,idd,mstart,mcount,data)

      return
      end







