Skip to main content
  • Home
  • Development
  • Documentation
  • Donate
  • Operational login
  • Browse the archive

swh logo
SoftwareHeritage
Software
Heritage
Archive
Features
  • Search

  • Downloads

  • Save code now

  • Add forge now

  • Help

https://github.com/cran/ReacTran
06 February 2020, 06:27:10 UTC
  • Code
  • Branches (31)
  • Releases (0)
  • Visits
    • Branches
    • Releases
    • HEAD
    • refs/heads/master
    • refs/tags/1.1
    • refs/tags/1.2
    • refs/tags/1.3
    • refs/tags/1.3.1
    • refs/tags/1.3.2
    • refs/tags/1.4.1
    • refs/tags/1.4.2
    • refs/tags/1.4.3.1
    • refs/tags/R-2.10.0
    • refs/tags/R-2.10.1
    • refs/tags/R-2.11.0
    • refs/tags/R-2.11.1
    • refs/tags/R-2.12.0
    • refs/tags/R-2.12.1
    • refs/tags/R-2.12.2
    • refs/tags/R-2.13.0
    • refs/tags/R-2.13.1
    • refs/tags/R-2.13.2
    • refs/tags/R-2.14.0
    • refs/tags/R-2.14.1
    • refs/tags/R-2.14.2
    • refs/tags/R-2.15.0
    • refs/tags/R-2.15.1
    • refs/tags/R-2.15.2
    • refs/tags/R-2.15.3
    • refs/tags/R-2.9.2
    • refs/tags/R-3.0.0
    • refs/tags/R-3.0.1
    • refs/tags/R-3.0.2
    • refs/tags/R-3.0.3
    No releases to show
  • c9cdf94
  • /
  • R
  • /
  • tran.1D.R
Raw File Download
Take a new snapshot of a software origin

If the archived software origin currently browsed is not synchronized with its upstream version (for instance when new commits have been issued), you can explicitly request Software Heritage to take a new snapshot of it.

Use the form below to proceed. Once a request has been submitted and accepted, it will be processed as soon as possible. You can then check its processing state by visiting this dedicated page.
swh spinner

Processing "take a new snapshot" request ...

Permalinks

To reference or cite the objects present in the Software Heritage archive, permalinks based on SoftWare Hash IDentifiers (SWHIDs) must be used.
Select below a type of object currently browsed in order to display its associated SWHID and permalink.

  • content
  • directory
  • revision
  • snapshot
origin badgecontent badge Iframe embedding
swh:1:cnt:de1f37662c9ac8596e25012f3e7e8dd21fe27db8
origin badgedirectory badge Iframe embedding
swh:1:dir:ea81c1bd99d45a5de927f2a33db1e3540a6d20a0
origin badgerevision badge
swh:1:rev:c455f23349da640f38c0a83c7127c199e7d95430
origin badgesnapshot badge
swh:1:snp:bbc0b94b1c0463480b615c86f1ae2df3fcc700c0
Citations

This interface enables to generate software citations, provided that the root directory of browsed objects contains a citation.cff or codemeta.json file.
Select below a type of object currently browsed in order to generate citations for them.

  • content
  • directory
  • revision
  • snapshot
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Generate software citation in BibTex format (requires biblatex-software package)
Generating citation ...
Tip revision: c455f23349da640f38c0a83c7127c199e7d95430 authored by Karline Soetaert on 19 July 2009, 00:00:00 UTC
version 1.1
Tip revision: c455f23
tran.1D.R

##==============================================================================
## Transport in a one-dimensional finite difference grid
##==============================================================================

tran.1D <- function(C, C.up=C[1], C.down=C[length(C)],
     flux.up=NULL, flux.down=NULL, a.bl.up=NULL, C.bl.up=NULL,
		 a.bl.down=NULL, C.bl.down=NULL,
     D=0, v=0, AFDW=1, VF=1, A=1,
     dx, full.check = FALSE, full.output = FALSE) {


### INPUT CHECKS
  if (is.null(dx))
    stop("error: dx should be inputted ")

  N <- length(C)
  if (N == 0)
    stop("C should be a vector with numeric values")

  if (is.null(C.up))   C.up <- C[1]
  if (is.null(C.down)) C.down <- C[N]

  ## default infilling of grid parameters

  if (!is.list(AFDW)) AFDW <- list(int=AFDW)
  if (!is.list(D)) D <- list(int=D)
  if (!is.list(v)) v <- list(int=v)

  if (!is.list(VF))
    VF <- list(int=rep(VF,length.out=(N+1)),
                mid=0.5*(rep(VF,length.out=(N+1))[1:N]+
                rep(VF,length.out=(N+1))[2:(N+1)]))
  if (!is.list(A))
    A <- list(int=rep(A,length.out=(N+1)),
              mid=0.5*(rep(A,length.out=(length(C)+1))[1:N]+
              rep(A,length.out=(N+1))[2:(N+1)]))

  if (is.list(dx)) grid <- dx
  if (!is.list(dx))
    grid <- list(dx=rep(dx,length.out=N),
                 dx.aux=0.5*(c(0,rep(dx,length.out=N))+
                 c(rep(dx,length.out=N),0)))

  ## check dimensions of input arguments

  if (full.check) {

    ## check input of AFDW
    gn <- names(AFDW)
    if (! "int" %in% gn)
      stop("error: AFDW should be a list that contains 'int', the AFDW values at the interface of the grid cell ")
    if (is.null(AFDW$int))
      stop("error: AFDW is NULL, should contain (numeric) values")
    if (!is.null(AFDW$int)) {
      if (!((length(AFDW$int)==1) || (length(AFDW$int)==(N+1))))
        stop("error: AFDW should be a vector of length 1 or N+1")
    }
    if (any(AFDW$int < 0)||any(AFDW$int > 1))
	    stop("error: the AFDW should always range between 0 and 1")

    ## check input of D
    gn <- names(D)
    if (! "int" %in% gn)
      stop("error: D should be a list that contains 'int', the D values at the interface of the grid cell ")
    if (is.null(D$int))
      stop("error: D is NULL, should contain (numeric) values")
    if (!is.null(D$int)) {
      if (!((length(D$int)==1) || (length(D$int)==(N+1))))
        stop("error: D should be a vector of length 1 or N+1")
    }
    if (any(D$int < 0))
	    stop("error: the diffusion coefficient should always be positive")

    ## check input of v
    gn <- names(v)
    if (! "int" %in% gn)
      stop("error: v should be a list that contains 'int', the v values at the interface of the grid cell ")
    if (is.null(v$int))
      stop("error: the advective velocity v is NULL, should contain (numeric) values")
    if (!is.null(v$int)) {
      if (!((length(v$int)==1) || (length(v$int)==(N+1))))
        stop("error: v should be a vector of length 1 or N+1")
    }
## This constraint no longer holds I presume (filip)
##    if (any (v$int < 0) & any (v$int > 0))
##	    stop("error: the advective velocity cannot be both positive and negative within the same domain")

    ## check input of VF
    gn <- names(VF)
    if (! "int" %in% gn)
      stop("error: VF should be a list that contains 'int', the area values at the interface of the grid cell ")
    if (! "mid" %in% gn)
      stop("error: VF should be a list that contains 'mid', the area at the middle of the grid cells")
    if (is.null(VF$int) || is.null(VF$mid))
      stop("error: the volume fraction VF should contain (numeric) values")
    if (!is.null(VF$int)) {
      if (!((length(VF$int)==1) || (length(VF$int)==(N+1))))
        stop("error: VF$int should be a vector of length 1 or N+1")
    }
    if (!is.null(VF$mid)) {
      if (!((length(VF$mid)==1) || (length(VF$mid)==(N))))
        stop("error: VF$mid should be a vector of length 1 or N")
    }
    if (any(VF$int < 0) || any(VF$mid < 0) || any(VF$int > 1) ||any(VF$mid > 1))
      stop("error: the volume fraction should range between 0 and 1")

    ## check input of A
    gn <- names(A)
    if (! "int" %in% gn)
      stop("error: A should be a list that contains 'int', the area values at the interface of the grid cell ")
    if (! "mid" %in% gn)
      stop("error: A should be a list that contains 'mid', the area at the middle of the grid cells")
    if (is.null(A$int) || is.null(A$mid))
      stop("error: the surface area A is NULL, should contain (numeric) values")
    if (!is.null(A$int)) {
      if (!((length(A$int)==1) || (length(A$int)==(N+1))))
        stop("error: A$int should be a vector of length 1 or N+1")
    }
    if (!is.null(A$mid)) {
      if (!((length(A$mid)==1) || (length(A$mid)==(N))))
        stop("error: A$mid should be a vector of length 1 or N")
    }
    if (any (A$int < 0) || any (A$mid < 0))
      stop("error: the area A should always be positive")

    ## check input of grid
    gn <- names(grid)
    if (! "dx" %in% gn)
      stop("error: grid should be a list that contains 'dx' ")
    if (! "dx.aux" %in% gn)
	    stop("error: grid should be a list that contains 'dx.aux' ")
    if (is.null(grid$dx) || is.null(grid$dx.aux))
    	stop("error: the grid should be a list with (numeric) values for 'dx' and 'dx.aux' ")
    if (!is.null(grid$dx)) {
      if (!((length(grid$dx)==1) || (length(grid$dx)==N)))
        stop("error: dx should be a vector of length 1 or N")
    }
    if (!is.null(grid$dx.aux)) {
      if (!((length(grid$dx.aux)==1) || (length(grid$dx.aux)==(N+1))))
        stop("error: dx.aux should be a vector of length 1 or N+1")
    }
    if (any(grid$dx <= 0) || any(grid$dx.aux <= 0) )
    	stop("error: the grid distances dx and dx.aux should always be positive")

    ## check input of boundary layer parameters
    if (!is.null(a.bl.up) & !is.null(C.bl.up)) {
    	if (a.bl.up < 0)
        stop("error: the boundary layer transfer coefficient should be positive")
    }

    if (!is.null(a.bl.down) & !is.null(C.bl.down)) {
	    if (a.bl.down < 0)
        stop("error: the boundary layer transfer coefficient should be positive")
    }
  } # end full.check


### FUNCTION BODY: CALCULATIONS


  if (full.output) {
    ## Impose boundary flux at upper boundary when needed
    ## Default boundary condition is zero gradient
    if (! is.null (flux.up)) {
      if (v$int[1] >= 0) {
      ## advection directed downwards
        nom <- flux.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
               (1-AFDW$int[1])*v$int[1])*C[1]
        denom <- VF$int[1]*(D$int[1]/grid$dx.aux[1]+
                 AFDW$int[1]*v$int[1])
	    } else	{
      ## advection directed upwards
        nom <- flux.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
               AFDW$int[1]*v$int[1])*C[1]
        denom <- VF$int[1]*(D$int[1]/grid$dx.aux[1]+
                (1-AFDW$int[1])*v$int[1])
	    }
      C.up <- nom/denom
    }
    ## Impose boundary flux at lower boundary when needed
    ## Default boundary condition is no gradient
    if (! is.null (flux.down)) {
      if (v$int[N+1] >= 0) {
        ## advection directed downwards
	      nom <- flux.down - VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1] +
               AFDW$int[N+1]*v$int[N+1])*C[N]
        denom <- -VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1]+
                (1-AFDW$int[N+1])*v$int[N+1])
      } else {
        ## advection directed downwards
	      nom <- flux.down - VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1] +
               (1-AFDW$int[N+1])*v$int[N+1])*C[N]
        denom <- -VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1]+
                 AFDW$int[N+1]*v$int[N+1])
      }
      C.down <- nom/denom
    }

    ## when upstream boundary layer is present, calculate new C.up
    if (!is.null(a.bl.up) & !is.null(C.bl.up)) {
      if (v$int[1] >= 0)	{
        ## advection directed downwards
        nom <- a.bl.up*C.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
              (1-AFDW$int[1])*v$int[1])*C[1]
        denom <- a.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
                 AFDW$int[1]*v$int[1])
	    } else	{
        ## advection directed upwards
        nom <- a.bl.up*C.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
               AFDW$int[1]*v$int[1])*C[1]
        denom <- a.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
                (1-AFDW$int[1])*v$int[1])
	    }
      C.up <- nom/denom
    }

    ## when downstream boundary layer is present, calculate new C.up
    if (!is.null(a.bl.down) & !is.null(C.bl.down)) {
      if (v$int[N+1] >= 0)	{
        ## advection directed downwards
       nom <- a.bl.down*C.bl.down + VF$int[N+1]*(D$int[N+1]/
              grid$dx.aux[N+1] + (1-AFDW$int[N+1])*v$int[N+1])*C[N]
       denom <- a.bl.down + VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1] +
                AFDW$int[N+1]*v$int[N+1])
     	} else	{
        ## advection directed upwards
        nom <- a.bl.down*C.bl.down + VF$int[N+1]*(D$int[N+1]/
               grid$dx.aux[N+1] + AFDW$int[N+1]*v$int[N+1])*C[N]
        denom <- a.bl.down + VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1] +
                 (1-AFDW$int[N+1])*v$int[N+1])
	    }
      C.down <- nom/denom
    }

    ## Calculate diffusive part of the flux

    dif.flux <- as.vector(-VF$int*D$int*diff(c(C.up,C,C.down))/
                          grid$dx.aux)
    adv.flux <- rep(0,length.out=length(dif.flux))

    ## Add advective part of the flux if needed
      if (any (v$int > 0)) {   # advection directed downwards
       vv <- v$int
       vv[v$int<0] <- 0
	     conc <- AFDW$int*c(C.up,C)
	     if (any (AFDW$int < 1))
         conc <- conc +(1-AFDW$int)*c(C,C.down)
	     adv.flux <- adv.flux + as.vector(VF$int*vv*conc)
    }
    if (any (v$int < 0)) {   # advection directed upwards
       vv <- v$int
       vv[v$int>0] <- 0
       conc <- AFDW$int*c(C,C.down)
	     if (any (AFDW$int < 1))
         conc <- conc +(1-AFDW$int)*c(C.up,C)
	     adv.flux <- adv.flux + as.vector(VF$int*vv*conc)
    }

    flux <- dif.flux + adv.flux

  } else { # not full.output

    ## when upstream boundary layer is present, calculate new C.up
    if (!is.null(a.bl.up) & !is.null(C.bl.up))  {
      if (v$int[1] >= 0) { # advection directed downwards
        nom <- a.bl.up*C.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
               (1-AFDW$int[1])*v$int[1])*C[1]
        denom <- a.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
               AFDW$int[1]*v$int[1])
	    } else	{  # advection directed upwards
        nom <- a.bl.up*C.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
               AFDW$int[1]*v$int[1])*C[1]
        denom <- a.bl.up + VF$int[1]*(D$int[1]/grid$dx.aux[1] +
                 (1-AFDW$int[1])*v$int[1])
	    }
      C.up <- nom/denom
    }

    ## when upstream boundary layer is present, calculate new C.up
    if (!is.null(a.bl.down) & !is.null(C.bl.down)) {
      if (v$int[N+1] >= 0)	{   # advection directed downwards
        nom <- a.bl.down*C.bl.down + VF$int[N+1]*(D$int[N+1]/
               grid$dx.aux[N+1] + (1-AFDW$int[N+1])*v$int[N+1])*C[N]
        denom <- a.bl.down + VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1] +
                 AFDW$int[N+1]*v$int[N+1])
	    } else	{  # advection directed upwards
        nom <- a.bl.down*C.bl.down + VF$int[N+1]*(D$int[N+1]/
                 grid$dx.aux[N+1] + AFDW$int[N+1]*v$int[N+1])*C[N]
        denom <- a.bl.down + VF$int[N+1]*(D$int[N+1]/grid$dx.aux[N+1] +
                (1-AFDW$int[N+1])*v$int[N+1])
	    }
      C.down <- nom/denom
    }

    ## Calculate diffusive part of the flux
	  flux <- as.vector(-(VF$int)*D$int*
                      diff(c(C.up,C,C.down))/grid$dx.aux)
    ## Add advective part of the flux if needed
    if (any (v$int > 0)) {   # advection directed downwards
       vv <- v$int
       vv[v$int<0] <- 0
	     conc <- AFDW$int*c(C.up,C)
	     if (any (AFDW$int < 1))
         conc <- conc +(1-AFDW$int)*c(C,C.down)
	     flux <- flux + as.vector(VF$int*vv*conc)
    }
    if (any (v$int < 0)) {   # advection directed upwards
       vv <- v$int
       vv[v$int>0] <- 0
       conc <- AFDW$int*c(C,C.down)
	     if (any (AFDW$int < 1))
         conc <- conc +(1-AFDW$int)*c(C.up,C)
	     flux <- flux + as.vector(VF$int*vv*conc)
    }

  }

  if (! is.null (flux.up)) flux[1] <- flux.up
  if (! is.null (flux.down)) flux[N+1] <- flux.down

    
## Calculate rate of change = Flux gradient       
  dC <- -diff(A$int*flux)/A$mid/VF$mid/grid$dx

  if (!full.output){
    return (list (dC = dC,                   # Rate of change due to advective-diffusive transport in each grid cell
  					flux.up = flux[1],               # Flux across lower boundary interface; positive = IN
	  				flux.down = flux[length(flux)])) # Flux across lower boundary interface; positive = OUT

  } else {
  	return (list (dC = dC,                   # Rate of change due to advective-diffusive transport in each grid cell
	  				C.up = C.up,                     # Concentration at upper interface
		  			C.down = C.down,                 # Concentration at lower interface
			  		dif.flux = dif.flux,             # Diffusive flux across at the interface of each grid cell
				  	adv.flux = adv.flux,             # Advective flux across at the interface of each grid cell
					  flux = flux,                     # Flux across at the interface of each grid cell
  					flux.up = flux[1],               # Flux across lower boundary interface; positive = IN
	  				flux.down = flux[length(flux)])) # Flux across lower boundary interface; positive = OUT
  }

} # end tran.1D

Software Heritage — Copyright (C) 2015–2025, The Software Heritage developers. License: GNU AGPLv3+.
The source code of Software Heritage itself is available on our development forge.
The source code files archived by Software Heritage are available under their own copyright and licenses.
Terms of use: Archive access, API— Contact— JavaScript license information— Web API

back to top