<|start_filename|>doc/computing/minimisation.html<|end_filename|>

<html><head>
<title>minimisation - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'minimisation.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2013 <NAME>   -- Copyright &copy; 2013 <NAME> &lt;arjenmarkus at sourceforge dot net&gt;
   -->
<! -- CVS: $Id: minimisation.html,v 1.2 2013/10/12 15:30:35 arjenmarkus Exp $ minimisation.n
   -->
<body><div class="doctools">
<h1 class="title">minimisation(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>minimisation - Miminisation routines</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">ROUTINES</a></li>
<li class="section"><a href="#section3">EXAMPLE</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">call newuoa((npt,x,rhobeg,rhoend,iprint,maxfun,calfun)</b></a></li>
<li><a href="#2"><b class="cmd">call bobyqa((npt,x,xl,xu,rhobeg,rhoend,iprint,maxfun,calfun)</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <i class="term">newuoa_minimisation</i> and <i class="term">bobyqa_minimisation</i> modules provide facilities
to minimise a function of one or more variables without the use of derivatives
(see <a href="http://www.damtp.cam.ac.uk/user/na/NA_papers/NA2007_03.pdf">A view of algorithms for optimization without derivatives</a>.</p>
<p>The first module provides the routine <i class="term">NEWUOA</i> which implements an unconstrained minimisation
algorithm. The second module provides the routine <i class="term">BOBYQA</i> which implements an algorithm where
the minimum of the function is sought within a given hyperblock.</p>
<p><em>Note:</em> The code was developed by <NAME>. It has been slightly adjusted so that advantage
can be taken of a number of modern Fortran features. This has led to a slightly different interface
than the original code. These are the changes:</p>
<ul class="itemized">
<li><p>Use the generic names for standard functions like <i class="term">abs</i> and <i class="term">min</i>.</p></li>
<li><p>Use an allocatable work array, so that the user is no longer responsible for this.</p></li>
<li><p>Wrap the code in a module, so that the interfaces can be checked by the compiler.</p></li>
<li><p>Use a <i class="term">kind</i> parameter instead of <i class="term">REAL*8</i>.</p></li>
<li><p>Use assumed shape arrays, so that the number of dimensions can be automatically derived from
the size of the <i class="term">X</i> array.</p></li>
<li><p>Make the subroutine that computes the value of the function to be minimised an argument,
rather than requiring a fixed name. This makes the module more flexible.</p></li>
</ul>
</div>
<div id="section2" class="section"><h2><a name="section2">ROUTINES</a></h2>
<p>There are two public routines, one in each module:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">call newuoa((npt,x,rhobeg,rhoend,iprint,maxfun,calfun)</b></a></dt>
<dd><p>This subroutine seeks the least value of a function of many variables,
by a trust region method that forms quadratic models by interpolation.
There can be some freedom in the interpolation conditions, which is
taken up by minimizing the Frobenius norm of the change to the second
derivative of the quadratic model, beginning with a zero matrix. The
arguments of the subroutine are as follows.</p>
<p>Initial values of the variables must be set in <i class="term">X(1),X(2),...,X(N)</i>. They
will be changed to the values that give the least calculated <i class="term">F</i>.</p>
<dl class="arguments">
<dt>integer <i class="arg">npt</i></dt>
<dd><p><i class="term">NPT</i> is the number of interpolation conditions. Its value must be in the
interval [<i class="term">N+2,(N+1)(N+2)/2</i>].</p></dd>
<dt>real(kind=wp), dimension(:) <i class="arg">x</i></dt>
<dd><p>Array with coordinate values. On input the initial values, on output the vector
for which the minimum function value was found.</p></dd>
<dt>real(kind=wp) <i class="arg">rhobeg, rhoend</i></dt>
<dd><p><i class="term">RHOBEG</i> and <i class="term">RHOEND</i> must be set to the initial and final values of a trust
region radius, so both must be positive with <i class="term">RHOEND&lt;=RHOBEG</i>. Typically
<i class="term">RHOBEG</i> should be about one tenth of the greatest expected change to a
variable, and <i class="term">RHOEND</i> should indicate the accuracy that is required in
the final values of the variables.</p></dd>
<dt>integer <i class="arg">iprint</i></dt>
<dd><p>The value of <i class="term">IPRINT</i> should be set to 0, 1, 2 or 3, which controls the
amount of printing. Specifically, there is no output if <i class="term">IPRINT=0</i> and
there is output only at the return if <i class="term">IPRINT=1</i>. Otherwise, each new
value of <i class="term">RHO</i> is printed, with the best vector of variables so far and
the corresponding value of the objective function. Further, each new
value of <i class="term">F</i> with its variables are output if <i class="term">IPRINT=3</i>.</p></dd>
<dt>integer <i class="arg">maxfun</i></dt>
<dd><p><i class="term">MAXFUN</i> must be set to an upper bound on the number of calls of <i class="term">CALFUN</i>.</p></dd>
<dt>subroutine <i class="arg">calfun</i></dt>
<dd><p>Subroutine <i class="term">CALFUN</i> must be provided by the user. It must set <i class="term">F</i> to
the value of the objective function for the variables <i class="term">X(1),X(2),...,X(N)</i>.</p>
<p>Its interface is:</p>
<pre class="example">
    subroutine calfun( x, f )
        import wp
        real(kind=wp), dimension(:)  :: x
        real(kind=wp)                :: f
    end subroutine calfun
</pre>
</dd>
</dl></dd>
<dt><a name="2"><b class="cmd">call bobyqa((npt,x,xl,xu,rhobeg,rhoend,iprint,maxfun,calfun)</b></a></dt>
<dd><p>This subroutine seeks the least value of a function of many variables,
by applying a trust region method that forms quadratic models by
interpolation. There is usually some freedom in the interpolation
conditions, which is taken up by minimizing the Frobenius norm of
the change to the second derivative of the model, beginning with the
zero matrix. The values of the variables are constrained by upper and
lower bounds. The arguments of the subroutine are as follows.</p>
<p>Initial values of the variables must be set in <i class="term">X(1),X(2),...,X(N)</i>. They
will be changed to the values that give the least calculated <i class="term">F</i>.</p>
<dl class="arguments">
<dt>integer <i class="arg">npt</i></dt>
<dd><p><i class="term">NPT</i> is the number of interpolation conditions. Its value must be in the
interval [<i class="term">N+2,(N+1)(N+2)/2</i>].</p></dd>
<dt>real(kind=wp), dimension(:) <i class="arg">x</i></dt>
<dd><p>Array with coordinate values. On input the initial values, on output the vector
for which the minimum function value was found.</p></dd>
<dt>real(kind=wp), dimension(:) <i class="arg">xl, xu</i></dt>
<dd><p>For <i class="term">I=1,2,...,N</i>, <i class="term">XL(I)</i> and <i class="term">XU(I)</i> must provide the lower and upper
bounds, respectively, on <i class="term">X(I)</i>. The construction of quadratic models
requires <i class="term">XL(I)</i> to be strictly less than <i class="term">XU(I)</i> for each <i class="term">I</i>. Further,
the contribution to a model from changes to the <i class="term">I</i>-th variable is
damaged severely by rounding errors if <i class="term">XU(I)-XL(I)</i> is too small.</p></dd>
<dt>real(kind=wp) <i class="arg">rhobeg, rhoend</i></dt>
<dd><p><i class="term">RHOBEG</i> and <i class="term">RHOEND</i> must be set to the initial and final values of a trust
region radius, so both must be positive with <i class="term">RHOEND</i> no greater than
<i class="term">RHOBEG</i>. Typically, <i class="term">RHOBEG</i> should be about one tenth of the greatest
expected change to a variable, while <i class="term">RHOEND</i> should indicate the
accuracy that is required in the final values of the variables. An
error return occurs if any of the differences <i class="term">XU(I)-XL(I), I=1,...,N</i>
is less than <i class="term">2*RHOBEG</i>.</p></dd>
<dt>integer <i class="arg">iprint</i></dt>
<dd><p>The value of <i class="term">IPRINT</i> should be set to 0, 1, 2 or 3, which controls the
amount of printing. Specifically, there is no output if <i class="term">IPRINT=0</i> and
there is output only at the return if <i class="term">IPRINT=1</i>. Otherwise, each new
value of <i class="term">RHO</i> is printed, with the best vector of variables so far and
the corresponding value of the objective function. Further, each new
value of <i class="term">F</i> with its variables are output if <i class="term">IPRINT=3</i>.</p></dd>
<dt>integer <i class="arg">maxfun</i></dt>
<dd><p><i class="term">MAXFUN</i> must be set to an upper bound on the number of calls of <i class="term">CALFUN</i>.</p></dd>
<dt>subroutine <i class="arg">calfun</i></dt>
<dd><p>Subroutine <i class="term">CALFUN</i> must be provided by the user. It must set <i class="term">F</i> to
the value of the objective function for the variables <i class="term">X(1),X(2),...,X(N)</i>.</p>
<p>Its interface is the same for routine <i class="term">NEWUOA</i>.</p></dd>
</dl></dd>
</dl>
</div>
<div id="section3" class="section"><h2><a name="section3">EXAMPLE</a></h2>
<p>The functon to be minimised does not need to be a straightforward mathematical function.
The only requirements are that it is continuous in its arguments and more or less smooth.</p>
<p>Here is an example of a minimisation problem that would be very difficult to solve when
derivatives are required. The problem is to find the values for the coefficients <i class="term">a</i> and
<i class="term">b</i> in the system of ordinary differential equations below that lead to a final vector
<i class="term">(x,y) = (0.5,0.25)</i> at time <i class="term">t = 1</i>:</p>
<pre class="example">
    dx/dt = - a x
    dy/dt = + a x - b y
    (x,y) = (1,0) at time t = 0
</pre>
<p>The subroutine to compute the function to be minimised is shown below. It computes the
solution at <i class="term">t = 1</i> for the above system and computes the sum of square differences with the
target vector. This sum is the function value to be minimised:</p>
<pre class="example">
! compute_diff --
!     Compute the solution and determine how close it is to the required solution
!
! Arguments:
!     param          Vector of parameters
!     f              Value of the function to be minimized
!
subroutine compute_diff( param, f )
    use bobyqa_minimisation, only: wp
    implicit none
    real(kind=wp), dimension(:) :: param
    real(kind=wp)               :: f
    integer                     :: i
    real(kind=wp), dimension(2) :: x
    real(kind=wp), dimension(2) :: dx
    real(kind=wp)               :: dt
    !
    ! Initial condition: x = [1.0, 0.0]
    ! We want x = [0.5, 0.25] at time = 1
    !
    dt   = 0.01
    x(1) = 1.0
    x(2) = 0.0
    do i = 1,100
        dx(1) = -param(1) * x(1)
        dx(2) = +param(1) * x(1) - param(2) * x(2)
        x(1)  = x(1) + dx(1) * dt
        x(2)  = x(2) + dx(2) * dt
    enddo
    f = (x(1)-0.5)**2 + (x(2)-0.25)**2
end subroutine calfun</pre>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2013 <NAME><br>
Copyright &copy; 2013 <NAME> &lt;arjenmarkus at sourceforge dot net&gt;</p>
</div>
</div></body></html>


<|start_filename|>src/datastructures/qsortarray_template.f90<|end_filename|>
!
! qsortarray_template.f90 --
!     QuickSort for arrays:
!
!     This template has to be preprocessed by defining the
!     two following macros :
!     - "_QSORTARRAY_TYPE" is the name of the derived type
!     - "_QSORTARRAY_MODULE" is the module defining the
!       derived type
!
!     Note:
!     The data that need to be sorted are stored in
!     an array. A comparison function is used to enable
!     sorting wrt different criteria.
!     The data have the generic type _QSORTARRAY_TYPE.
!
!     Note:
!     Algorithm translated from Kernighan and Pike,
!     The Practice of Programming.
!
!     $Id: qsortarray_template.f90,v 1.2 2013/12/27 11:36:01 arjenmarkus Exp $
!
! Routines and functions specific to dictionaries
!
! qsort_array --
!     Use the QuickSort algorithm to sort an array
! Arguments:
!     array      Array to be sorted
!     compare    Comparison function
!
subroutine qsort_array( array, compare )
  type ( _QSORTARRAY_TYPE ) , dimension(:) :: array
  interface
     integer function compare(f,g)
       use _QSORTARRAY_MODULE , only : _QSORTARRAY_TYPE
       type( _QSORTARRAY_TYPE ), intent(in) :: f, g
     end function compare
  end interface
  type ( _QSORTARRAY_TYPE ) , dimension(:), allocatable :: backup
  integer, dimension(:), allocatable         :: order
  integer                                    :: i
  allocate( backup(1:size(array) ) )
  allocate( order(1:size(array) ) )
  do i = 1,size(order)
     order(i) = i
  enddo
  call qsort_sort( array, order, 1, size(array), compare )
  do i = 1,size(order)
     backup(i) = array(order(i))
  enddo
  array = backup
  deallocate( backup )
  deallocate( order  )
end subroutine qsort_array
! qsort_sort --
!     Sort the array according to the QuickSort algorithm
! Arguments:
!     array      Array of data
!     order      Array holding the order
!     left       Start index
!     right      End index
!     compare    Comparison function
!
recursive subroutine qsort_sort( array, order, left, right, compare )
  type ( _QSORTARRAY_TYPE ) , dimension(:) :: array
  integer, dimension(:)         :: order
  integer                       :: left
  integer                       :: right
  interface
     integer function compare ( f , g )
       use _QSORTARRAY_MODULE, only : _QSORTARRAY_TYPE
       type(_QSORTARRAY_TYPE), intent(in) :: f, g
     end function compare
  end interface
  integer                                    :: i
  integer                                    :: last
  if ( left .ge. right ) return
  call qsort_swap( order, left, qsort_rand(left,right) )
  last = left
  do i = left+1, right
     if ( compare(array(order(i)), array(order(left)) ) .lt. 0 ) then
        last = last + 1
        call qsort_swap( order, last, i )
     endif
  enddo
  call qsort_swap( order, left, last )
  call qsort_sort( array, order, left, last-1, compare )
  call qsort_sort( array, order, last+1, right, compare )
end subroutine qsort_sort
! qsort_swap --
!     Swap two array elements
! Arguments:
!     order      Array holding the order
!     first      First index
!     second     Second index
!
subroutine qsort_swap( order, first, second )
  integer, dimension(:)         :: order
  integer                       :: first, second
  integer                       :: tmp
  tmp           = order(first)
  order(first)  = order(second)
  order(second) = tmp
end subroutine
! qsort_rand --
!     Determine a random integer number
! Arguments:
!     lower      Lowest value
!     upper      Greatest value
!
integer function qsort_rand( lower, upper )
  integer                       :: lower, upper
  real                          :: r
  call random_number( r )
  qsort_rand =  lower + nint(r * (upper-lower))
end function qsort_rand



<|start_filename|>src/strings/tokenlist.f90<|end_filename|>
! tokenlist.f90 --
!    Module for holding a list of tokens
!
! Note:
! This module builds on the tokenize module. It simply provides
! a more convenient interface.
!
! $Id: tokenlist.f90,v 1.1 2012/11/04 12:57:06 arjenmarkus Exp $
!

! tokenlists --
!    Module for holding tokenized strings
!
module tokenlists
    use tokenize

    implicit none

    private
    !
    !  Define some convenient parameters:
    !  whitespace - blanks only (gaps)
    !  tsv        - tabs (typically as separators)
    !  csv        - commas (typically as separators)
    !  quotes     - " and ' (typically as delimiters)
    !  empty      - no separators of this type
    !
    public :: token_whitespace
    public :: token_tsv
    public :: token_csv
    public :: token_quotes
    public :: token_empty

    !
    ! Data structure defining the tokenlist
    !
    type tokenlist
        logical                                     :: initialized = .false.
        type(tokenizer)                             :: tokenizer_data
        character(len=1), dimension(:), allocatable :: char
        integer, dimension(:), allocatable          :: first
        integer, dimension(:), allocatable          :: length_token
    contains
        procedure                                   :: set_tokenizer => set_tokenizer_data
        procedure                                   :: tokenize      => tokenize_string
        procedure                                   :: number        => number_tokens
        procedure                                   :: length        => length_of_token
        procedure                                   :: token         => get_token
    end type tokenlist

    !
    ! Other public items
    !
    public :: tokenlist

contains

! set_tokenizer_data
!    Initialize the tokenlist with a proper tokenizer
!
! Arguments:
!    list           The tokenlist
!    gaps           Which characters form a gap
!    separators     Which characters are separators
!    delimiters     Which characters delimit tokens
!
subroutine set_tokenizer_data( list, gaps, separators, delimiters )
    class(tokenlist), intent(inout) :: list
    character(len=*), intent(in)   :: gaps
    character(len=*), intent(in)   :: separators
    character(len=*), intent(in)   :: delimiters

    list%initialized = .true.
    call set_tokenizer( list%tokenizer_data, gaps, separators, delimiters )

end subroutine set_tokenizer_data

! tokenize_string
!    Construct a list of tokens from a string
!
! Arguments:
!    list           The tokenlist
!    string         String to tokenize
!
subroutine tokenize_string( list, string )
    class(tokenlist), intent(inout)     :: list
    character(len=*), intent(in)       :: string

    integer                            :: i
    integer                            :: idx
    integer                            :: length_token
    integer, dimension(:), allocatable :: first
    integer, dimension(:), allocatable :: length
    character(len=len(string))          :: token

    !
    ! First store the string and then determine the tokens
    !
    if ( allocated(list%char) ) then
        deallocate( list%char         )
        deallocate( list%first        )
        deallocate( list%length_token )
    endif
    allocate( list%char(len(string)) )

    do i = 1,len(string)
        list%char(i) = string(i:i)
    enddo

    allocate( first(len(string)), length(len(string)) )

    !
    ! If we do not have a tokenizer yet, use a default
    !
    if ( .not. list%initialized ) then
        list%initialized = .true.
        call list%set_tokenizer( token_whitespace, token_empty, token_quotes )
    endif

    !
    ! Now tokenize the string
    !
    idx   = 1
    token = first_token( list%tokenizer_data, string, length_token )
    do while ( length_token > -1 )
        first(idx)  = list%tokenizer_data%start_token
        length(idx) = length_token

        token = next_token( list%tokenizer_data, string, length_token )
        idx   = idx + 1
    enddo

    allocate( list%first(0:idx), list%length_token(0:idx) )

    list%first(0)              = 0
    list%first(idx)            = 0
    list%length_token(0)       = 0
    list%length_token(idx)     = 0
    list%first(1:idx-1)        = first(1:idx-1)
    list%length_token(1:idx-1) = length(1:idx-1)

    deallocate( first, length )

end subroutine tokenize_string

! number_tokens
!    Return the number of tokens
!
! Arguments:
!    list           The tokenlist
!
integer function number_tokens( list )
    class(tokenlist), intent(in) :: list

    number_tokens = size(list%length_token) - 2

end function number_tokens

! length_token
!    Return the length of a token
!
! Arguments:
!    list           The tokenlist
!    idx            Index of the token
!
integer function length_of_token( list, idx )
    class(tokenlist), intent(in) :: list
    integer, intent(in)         :: idx

    if ( idx <= 0 .or. idx >= size(list%length_token)-1 ) then
        length_of_token = 0
    else
        length_of_token = list%length_token(idx)
    endif
end function length_of_token

! get_token
!    Return the nth token (or zero-length string)
!
! Arguments:
!    list           The tokenlist
!    idx            Index of the token
!
function get_token( list, idx )
    class(tokenlist), intent(in) :: list
    integer, intent(in)         :: idx
    character(len=(list%length_token(max(0,min(size(list%length_token)-2,idx))))) :: get_token

    integer :: i, c

    if ( idx <= 0 .or. idx >= size(list%length_token)-1 ) then
        get_token = ''
    else
        do i = 1,list%length_token(idx)
            c = list%first(idx) + i - 1
            get_token(i:i) = list%char(c)
        enddo
    endif
end function get_token

end module tokenlists


<|start_filename|>chkfeatures/chk_protected_set.f90<|end_filename|>
! chk_protected_set.f90
!     Check: does the compiler allow a PROTECTED variable to be set outside its module?
!
module protected_var
    implicit none

    integer, protected :: readonly = 123
end module protected_var

program chk_protected_set
    use protected_var

    implicit none

    readonly = 0

    write( *, '(a,i0)' ) 'Reset value of the protected variable: ', readonly
    write( *, '(a,i0)' ) 'Original value:                        ', 123

    if ( readonly /= 123 ) then
        write( *, '(a)'    ) 'NOTE: this is unexoected - it defies the purpose of PROTECTED'
    else
        write( *, '(a)'    ) 'NOTE: apparently the compiler does not regard this as an error'
        write( *, '(a)'    ) '      but at run-time it is refused'
    endif
end program chk_protected_set


<|start_filename|>chkfeatures/buildscript.f90<|end_filename|>
! buildscript.f90 --
!     Auxiliary program to write the batchfile and shell script that
!     run the specific checking programs
!
program buildscript
    implicit none

    integer :: ierr, k
    integer :: label
    integer :: lunin  = 10
    integer :: lunbat = 21
    integer :: lunscr = 22

    integer :: number_features    = 0
    integer :: number_diagnostics = 0
    integer :: number_probes      = 0
    integer :: number_extensions  = 0

    character(len=80) :: line
    character(len=20) :: type_program

    open( lunin, file = 'buildscript.set', status = 'old' , iostat = ierr )

    if ( ierr /= 0 ) then
        write(*,'(a)') 'Error opening the buildscript.set file - terminating this step'
        stop
    endif

    open( lunbat, file = 'runfeatures.bat' )
    open( lunscr, file = 'runfeatures.sh' )

    write( lunbat, '(a)' ) '@echo off'
    write( lunscr, '(a)' ) '#!/bin/sh'

    label = 0

    do
        read( lunin, '(a)', iostat = ierr ) line

        if ( ierr /= 0 ) then
            exit
        endif

        !
        ! Remove "carriage return" - some compilers do not remove it
        ! automatically
        !
        k = index( line, char(13) )
        if ( k > 0 ) then
            line(k:) = ' '
        endif

        !
        ! Handle the contents
        !
        if ( line(1:1) == '#' ) then
            cycle
        endif

        if ( line == ' ' ) then
            write( lunbat, '(a,i0)'  ) ':skip', label
            write( lunscr, '(a)'     ) 'fi'
            cycle
        endif

        if ( line(1:1) == '@' ) then
            read(  lunin, * ) type_program
            select case ( type_program )
                case( 'FEATURE' )
                    number_features = number_features + 1
                case( 'DIAGNOSTIC' )
                    number_diagnostics = number_diagnostics + 1
                case( 'EXTENSION' )
                    number_extensions = number_extensions + 1
                case( 'PROBE' )
                    number_probes = number_probes + 1
                case default
                    write( *, '(2a)' ) 'Error: unknown program type - ', trim(type_program)
            end select

            write( lunbat, '(a,a)' ) 'echo .'
            write( lunscr, '(a,a)' ) 'echo .'
            write( lunbat, '(a,a)' ) 'echo Check program: ', trim(line(2:))
            write( lunscr, '(a,a)' ) 'echo Check program: ', trim(line(2:))
            write( lunbat, '(a,a)' ) 'echo -------------'
            write( lunscr, '(a,a)' ) 'echo -------------'
            write( lunbat, '(a,a)' ) 'echo .'
            write( lunscr, '(a,a)' ) 'echo .'
            write( lunbat, '(3a)'  ) 'call compile ', trim(line(2:)), ' %1 %2 %3 %4 %5 %6 %7 %8'
            write( lunscr, '(3a)' ) './compile ', trim(line(2:)), ' $1 $2 $3 $4 $5 $6 $7 $8'
            write( lunbat, '(a,a)' ) 'echo .'
            write( lunscr, '(a,a)' ) 'echo .'

            label = label + 1
            write( lunbat, '(3a,i0)' ) 'if not exist ', trim(line(2:)), '.exe goto next', label
            write( lunbat, '(2a)'    ) trim(line(2:)), '.exe'
            write( lunbat, '(a,i0)'  ) 'goto skip', label
            write( lunbat, '(a,i0)'  ) ':next', label

            write( lunscr, '(3a)'    ) 'if [ -f ', trim(line(2:)), '.exe ]; then'
            write( lunscr, '(3x,3a)' ) './', trim(line(2:)), '.exe'
            write( lunscr, '(a)'     ) 'else'
        else
            write( lunbat, '(a,a)'   ) '   echo ', trim(line)
            write( lunscr, '(3a)'    ) '   echo ''', trim(line), ''''
        endif

    enddo

    write( lunbat, '(a,i0)'  ) ':skip', label
    write( lunscr, '(a)'  ) 'fi'

    write( *, '(/,a,i0)' ) 'Number of tests to run: ', label
    write( *, '(a,i0)' )   '    Number of feature checks:                 ', number_features
    write( *, '(a,i0)' )   '    Number of diagnostic checks:              ', number_diagnostics
    write( *, '(a,i0)' )   '    Number of checks on behaviour/properties: ', number_probes
    write( *, '(a,i0)' )   '    Number of checks on compiler extensions:  ', number_extensions
end program buildscript


<|start_filename|>configure.bat<|end_filename|>
@echo off
rem configure.bat --
if @%1 == @-help goto help
if @%1 == @/help goto help
if @%1 == @-?    goto help
if @%1 == @/?    goto help
goto analyse

:help
echo Configure Flibs: identify the compiler and set the build options
echo .
echo To pick a specific compiler, use:
echo c:\> configure name options
echo Available compilers:
echo - ifort    - Intel Fortran
echo - cvf      - Compaq Visual Fortran (superseded by Intel Fortran)
echo - gfortran - GNU Fortran 90/95 compiler
echo - g95      - g95 free Fortran 90/95 compiler
echo - salford  - Salford Fortran
echo - f95      - generic Fortran 95 compiler
echo .
echo Available build options:
echo -debug
echo -normal
echo -optimise
echo .
echo Run this batch file from the central directory!
pause
goto veryend

rem
rem Identify the build options ...
rem
:analyse
cd config
if errorlevel 1 goto error
if exist config.mk del config.mk
if exist options.mk del options.mk
copy normal.mk options.mk
if @%1 == @-debug copy debug.mk options.mk
if @%1 == @-optimise copy optimise.mk options.mk
if @%2 == @-debug copy debug.mk options.mk
if @%2 == @-optimise copy optimise.mk options.mk

echo Identifying compiler ... %1
if @%1 == @ goto start
if @%1 == @ifort    goto cmp_ifort
if @%1 == @cvf      goto cmp_cvf
if @%1 == @gfortran goto cmp_gfortran
if @%1 == @g95      goto cmp_g95
if @%1 == @salford  goto cmp_salford
if @%1 == @f95      goto cmp_generic
if @%2 == @ifort    goto cmp_ifort
if @%2 == @cvf      goto cmp_cvf
if @%2 == @gfortran goto cmp_gfortran
if @%2 == @g95      goto cmp_g95
if @%2 == @salford  goto cmp_salford
if @%2 == @f95      goto cmp_generic

echo Unknown compiler: %1 - searching for known compilers instead

:start

rem -----------------------------------------------------------
rem Intel Fortran
rem -----------------------------------------------------------
rem
:cmp_ifort
ifort.exe /compile_only idc.f90
if errorlevel 1 goto after_intel

echo Compiler: Intel Fortran
copy ifortwin.mk config.mk
goto end
:after_intel

rem -----------------------------------------------------------
rem Compaq Visual Fortran
rem -----------------------------------------------------------
rem
:cmp_cvf
df.exe /compile_only idc.f90
if errorlevel 1 goto after_df

echo Compiler: Compaq Visual Fortran
copy cvf.mk config.mk
goto end
:after_df

rem -----------------------------------------------------------
rem GNU Fortran 90/95
rem -----------------------------------------------------------
rem
:cmp_gfortran
gfortran.exe -c idc.f90
if errorlevel 1 goto after_gfortran

echo Compiler: GNU Fortran 90/95
copy gfortran.mk config.mk
goto end
:after_gfortran

rem -----------------------------------------------------------
rem g95 Fortran compiler
rem -----------------------------------------------------------
rem
:cmp_g95
g95.exe -c idc.f90
if errorlevel 1 goto after_g95

echo Compiler: g95 Fortran compiler
copy g95.mk config.mk
goto end
:after_g95

rem -----------------------------------------------------------
rem Salford Ftn95
rem -----------------------------------------------------------
rem
:cmp_salford
ftn95.exe idc.f90
if errorlevel 1 goto after_salf

echo Compiler: Salford Fortran
copy salford.mk config.mk
goto end
:after_salf

rem -----------------------------------------------------------
rem Generic Fortran 95 compiler
rem -----------------------------------------------------------
rem
:cmp_generic
f95.exe idc.f90
if errorlevel 1 goto after_generic

echo Compiler: Generic Fortran 95 compiler
copy f95.mk config.mk
goto end
:after_generic

rem
rem No suitable compiler found
rem
echo No suitable compiler could be identified
goto end

:error
echo Error:
echo Subdirectory "config" not found. Please start this batch file in
the echo central directory
goto veryend

:end
cd ..
:veryend


<|start_filename|>doc/streams/textstreams.html<|end_filename|>

<html><head>
<title>text_streams - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'streams/textstreams.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2006 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: textstreams.html,v 1.2 2013/05/13 08:03:20 knystrom Exp $ text_streams.n
   -->
<body><div class="doctools">
<h1 class="title">text_streams(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>text_streams - Implement text streams</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">DATA TYPES AND ROUTINES</a></li>
<li class="section"><a href="#section3">IMPLEMENTATION NOTES</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">use text_streams</b></a></li>
<li><a href="#2"><b class="cmd">type(TEXT_STREAM)</b></a></li>
<li><a href="#3"><b class="cmd">call textstream_open( stream, lun, filename, error )</b></a></li>
<li><a href="#4"><b class="cmd">call textstream_close( stream )</b></a></li>
<li><a href="#5"><b class="cmd">call textstream_read( stream, var, ierr )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <em>text_streams</em> module defines a set of subroutines
that allow you to read an ordinary text file as if it were a &quot;stream&quot;
of words, that is, after reading one item, you can read the next
item from the same line, if there is one.</p>
<p>The module uses a buffer to store the lines in the file one by one and
list-directed reading (that is: read(lun,*)) to get the individual
items. This means that you can take advantage of (almost) all the
facilities of list-directed input to read the file piece by piece.
input</p>
<p><em>Note:</em> In Fortran 2003, the notion of &quot;streams&quot; is formalised.
This module will be superfluous with compilers supporting Fortran 2003.
Also there are a number of issues that may or may not come into play on
a particular system - see the section on <span class="sectref"><a href="#section3">IMPLEMENTATION NOTES</a></span>.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">DATA TYPES AND ROUTINES</a></h2>
<p>The module defines a single data type, TEXT_STREAM, and several
subroutines:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">use text_streams</b></a></dt>
<dd><p>The name of the module</p></dd>
<dt><a name="2"><b class="cmd">type(TEXT_STREAM)</b></a></dt>
<dd><p>Files are opened and the necessary data are kept in variables of
this type.</p></dd>
<dt><a name="3"><b class="cmd">call textstream_open( stream, lun, filename, error )</b></a></dt>
<dd><p>Open the file &quot;filename&quot; using the LU-number &quot;lun&quot;. If some error
occurs (for instance the file does not exist), the argument &quot;error&quot; is
set to true.</p>
<dl class="arguments">
<dt>type(text_stream) <i class="arg">stream</i></dt>
<dd><p>The variable by which to reference the file</p></dd>
<dt>integer, intent(in) <i class="arg">lun</i></dt>
<dd><p>The LU-number to connect the file to</p></dd>
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>The name of the file to open</p></dd>
<dt>logical, intent(out) <i class="arg">error</i></dt>
<dd><p>Argument indicating whether opening the file was successful or not.</p></dd>
</dl></dd>
<dt><a name="4"><b class="cmd">call textstream_close( stream )</b></a></dt>
<dd><p>Close the file that was opened as a stream.</p>
<dl class="arguments">
<dt>type(text_stream) <i class="arg">stream</i></dt>
<dd><p>The variable by which to reference the file</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">call textstream_read( stream, var, ierr )</b></a></dt>
<dd><p>Read a variable &quot;var&quot; from the current position in the file.</p>
<dl class="arguments">
<dt>type(text_stream) <i class="arg">stream</i></dt>
<dd><p>The variable by which to reference the file</p></dd>
<dt>(...), intent(out) <i class="arg">var</i></dt>
<dd><p>The variable to be read. It can be either a character string, a
(default) integer, a (default) real, a (default) logical or a
double-precision real. Also one- and two-dimensional arrays of these
types are supported.</p></dd>
<dt>integer, intent(out) <i class="arg">ierr</i></dt>
<dd><p>Error code (0 means no error, &gt; 0 some reading error, &lt; 0 end of file)</p></dd>
</dl></dd>
</dl>
</div>
<div id="section3" class="section"><h2><a name="section3">IMPLEMENTATION NOTES</a></h2>
<p>The module is a simple implementation of stream-based I/O. As a
consequence, it has a number of limitations:</p>
<ul class="itemized">
<li><p>The file is read using non-advancing I/O and the data are stored in a
buffer. When an item is to be read, it is read from this buffer, not
directly from the file.</p></li>
<li><p>One practical consequence is that items longer than 80 characters
(the size of the buffer) can not be read properly (well, it may be
possible, because the actual buffer is twice as long, but no guarantee
is given). Increase the parameter MAXBUF if this does not suit your
needs.</p></li>
<li><p>List-directed I/O distinguishes a number of special characters -
these are not always passed on to the caller: spaces,
apostrophes (') and quotation marks (&quot;), as well as commas and numbers
followed by an asterisk (the string 4*1 is interpreted as four times a
string or number 1). One character in particular that may cause
practical problems is the slash (/). This signifies the end of the input
but it may interfere with the end-of-line detection built into the
module.</p></li>
</ul>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2006 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>src/datastructures/generic_stack.f90<|end_filename|>
! generic_stack.f90 --
!     Implementation of a generic stack data structure
!
!     See the example/test program for the way to use it
!
!     Note:
!     This version uses Fortran 2003 fetaures like classes
!
!     Note:
!     Work in progress
!
!     $Id: generic_stack.f90,v 1.1 2012/11/27 07:36:51 arjenmarkus Exp $
!
module generic_stacks
    implicit none

    type :: generic_stack_data
        ! No data - all data must be defined in the extended classes
        integer :: dummy ! -- required by Intel Fortran 11.1
    !contains
        !procedure :: copy
    end type generic_stack_data

    type :: generic_stack
        integer :: number_used
        integer :: head
        logical :: fixed
        class(generic_stack_data), allocatable, dimension(:) :: data
    contains
        procedure :: create
        procedure :: is_empty
        procedure :: is_full
        procedure :: used_entries
        procedure :: free_entries
        procedure :: capacity
        procedure :: pop
        procedure :: push
        procedure, nopass :: copy
    end type generic_stack

contains

! copy --
!     Dummy copy routine - must be overwritten
!
subroutine copy( output, input )
    class(generic_stack_data) :: output
    class(generic_stack_data) :: input

    ! Nothing to do
end subroutine copy

! create --
!     Create (initialise) the stack
!
! Arguments:
!     this           The stack to be created (initialised)
!     capacity       Size of the stack (initial, if not fixed size)
!     fixed          Fixed size or dynamically extendable (default: true)
!
subroutine create( this, capacity, fixed )
    class(generic_stack) :: this
    integer              :: capacity
    logical, optional    :: fixed

    this%fixed = .true.
    if ( present(fixed) ) then
        this%fixed = fixed
    endif

    if ( .not. this%fixed ) then
        write(*,*) 'Error: extendable stacks not implemented yet'
    endif

    this%number_used = 0
    this%head        = 0

    ! We leave this to the concrete type!
    !    allocate( this%data(capacity) )

end subroutine create

! pop --
!     Retrieve the stack data at the top, remove it from the stack
!
! Arguments:
!     this           The stack in question
!     data           Variable that will contain the data from the top
!     success        Whether the operation was successful or not
!
subroutine pop( this, data, success )
    class(generic_stack)      :: this
    class(generic_stack_data) :: data
    logical                   :: success

    if ( this%number_used > 0 ) then
        !call data%copy( this%data(this%head) )
        call this%copy( data, this%data(this%head) )

        this%number_used = this%number_used - 1
        this%head        = this%head - 1
        if ( this%head < 1 .and. this%number_used > 0 ) then
            this%head = size(this%data)
        endif
        success = .true.
    else
        success = .false.
    endif
end subroutine pop

! push --
!     Put new data on the top of the stack
!
! Arguments:
!     this           The stack in question
!     data           Variable that contains the data to be put on the top
!     full           Whether the stack was full and data were lost
!
subroutine push( this, data, full )
    class(generic_stack)      :: this
    class(generic_stack_data) :: data
    logical                   :: full

    this%number_used = this%number_used + 1
    this%head        = this%head + 1
    if ( this%head > size(this%data) ) then
        this%head = 1
    endif

    !call this%data(this%head)%copy( data )
    call this%copy( this%data(this%head), data )

    if ( this%number_used <= size(this%data) ) then
        full = .false.
    else
        full = .true.
    endif
end subroutine push

! is_empty --
!     Returns whether the stack is empty or not
!
! Arguments:
!     this           The stack in question
!
logical function is_empty( this )
    class(generic_stack)      :: this

    is_empty = this%number_used == 0
end function is_empty

! is_full --
!     Returns whether the stack is full or not
!     (If so, adding new data will cause it to drop the oldest data)
!
! Arguments:
!     this           The stack in question
!
logical function is_full( this )
    class(generic_stack)      :: this

    is_full = this%number_used >= size(this%data)
end function is_full

! used_entries, free_entries, capacity --
!     Return various information on the stack
!
! Arguments:
!     this           The stack in question
!
integer function used_entries( this )
    class(generic_stack)      :: this

    used_entries = this%number_used
end function used_entries

integer function free_entries( this )
    class(generic_stack)      :: this

    free_entries = size(this%data) - this%number_used
end function free_entries

integer function capacity( this )
    class(generic_stack)      :: this

    capacity = size(this%data)
end function capacity

end module generic_stacks

! Simple test program
!
module mystack_type
    use generic_stacks

    type, extends(generic_stack_data) :: mystack_data
        integer :: idx
    !contains
        !procedure :: copy => copy_mystack_data
    end type mystack_data

    type, extends(generic_stack) :: mystack
        integer :: idx
    contains
        procedure :: create => create_mystack
        procedure, nopass :: copy => copy_mystack
    end type mystack

contains

subroutine copy_mystack( output, input )
    class(generic_stack_data)  :: output, input

    !
    ! Rather clumsy, I am afraid ...
    !
    select type( output )
        class is (mystack_data)
            select type( input )
                class is (mystack_data)
                    input%idx = output%idx
                class is (generic_stack_data)
                    write(*,*) 'Unknown type!'
            end select
    end select
end subroutine copy_mystack

subroutine create_mystack( this, capacity, fixed )
    class(mystack)       :: this
    integer              :: capacity
    logical, optional    :: fixed

    logical              :: fixed_

    fixed_ = .true.
    if ( present(fixed) ) then
        fixed_ = fixed
    endif

    call this%generic_stack%create( capacity, fixed_ )

    allocate( this%data(capacity) )
end subroutine create_mystack

end module mystack_type

program test_stacks
    use mystack_type

    type(mystack)      :: stack
    type(mystack_data) :: data
    logical            :: full
    logical            :: success

    call stack%create( 100, .true. )

    call stack%push( mystack_data(0,1), full )
    call stack%push( mystack_data(0,2), full  )
    call stack%push( mystack_data(0,3), full  )
    call stack%push( mystack_data(0,4), full  )

    call stack%pop( data, success )
    write(*,*) data, success

    write(*,*) stack%head
    select type (data => stack%data)
        class is (mystack_data)
            write(*,*) data(1:5)%idx
    end select

end program test_stacks


<|start_filename|>doc/funit/funit.html<|end_filename|>

<html><head>
<title>flibs/funit - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'funit/funit.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2006 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: funit.html,v 1.2 2013/05/13 08:03:15 knystrom Exp $ flibs/funit.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/funit(n) 1.1  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/funit - Unit testing</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">ROUTINES</a></li>
<li class="section"><a href="#section3">TODO</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1">runtests.bat</a></li>
<li><a href="#2">runtests.sh</a></li>
<li><a href="#3">runtests.tcl</a></li>
<li><a href="#4"><b class="cmd">call runtests( testproc )</b></a></li>
<li><a href="#5"><b class="cmd">call test( proc, text )</b></a></li>
<li><a href="#6"><b class="cmd">call assert_true( cond, text )</b></a></li>
<li><a href="#7"><b class="cmd">exists = funit_file_exists( filename )</b></a></li>
<li><a href="#8"><b class="cmd">call funit_get_lun( lun )</b></a></li>
<li><a href="#9"><b class="cmd">call funit_remove_file( filename )</b></a></li>
<li><a href="#10"><b class="cmd">call funit_make_empty_file( filename )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p><em>JUnit</em> is a well-known facility for defining and running unit
tests in Java programs. The <em>funit</em> framework was inspired by
that facility. It is not as good-looking as JUnit, by no means:</p>
<ul class="itemized">
<li><p>It has no graphical user-interface</p></li>
<li><p>As Fortran does not allow introspection, the test routines can not
be detected automatically, instead as a programmer you need to set up a
high-level routine yourself that collects all the unit tests.</p></li>
<li><p>A runtime error, like division by zero, may lead to a termination of
the program. There is no (portable) way to catch these. Instead, the
framework relies on a batch file or shell script to repeatedly start the
program until all tests are run.</p></li>
</ul>
<p>Despite these limitations, <em>funit</em> can be a great help:</p>
<ul class="itemized">
<li><p>The code to test the various components (subroutines, functions, tasks
consisting of several program units) can be combined with the program
itself, without interfering with the ordinary code.</p>
<p>This is achieved by defining a single routine (test_all, say) that runs
all the unit tests and that is called via the provided routine
<em>runtests</em>:</p>
<pre class="example">
program myprog
    ...
!
! The routine runtests will check if unit tests are requested
! If not, it will return immediately. This way we make sure
! the unit tests remain part of the program.
!
! The routine test_all runs all unit tests
! (see the dataproc_testing module)
!
    call runtests( test_all )
!
! Ordinary processing
!
    ...
end program
</pre>
<p>The routine runtests checks if there is a file &quot;funit.run&quot;. If there is
such a file, it will run the given subroutine. Otherwise it will return
and the rest of the program is executed.</p></li>
<li><p>Because the test code is incorporated in the program itself, it is less
likely that they evolve independently: changes in the argument lists of
the subroutines and functions may lead to compile errors in the test
code.</p></li>
<li><p>There is no need to set up a whole new program for testing portions of
the program.</p></li>
</ul>
<p>The source file &quot;test_funit.f90&quot; illustrates how to use the funit
framework:</p>
<ul class="itemized">
<li><p>The main program calls the routine &quot;runtests&quot; and passes it the argument
&quot;test_all&quot;, a routine defined in a module called &quot;dataproc_testing&quot;.</p></li>
<li><p>The routine &quot;test_all&quot; consists of nothing but calls to the generic
routine &quot;test&quot;:</p>
<pre class="example">
subroutine test_all
    call test( test_no_file, &quot;Read non-existent file&quot; )
    call test( test_empty_file, &quot;Read an empty file&quot; )
    call test( test_invalid_file, &quot;Read an invalid file&quot; )
    call test( test_ordinary_file, &quot;Read an ordinary file&quot; )
end subroutine test_all
</pre>
</li>
<li><p>The module includes a source file &quot;funit_test.f90&quot; which defines the
generic subroutine &quot;test&quot;, thereby creating a copy <em>local</em> to
the module. It should also define two auxiliary routines,
<em>prolog</em> and <em>epilog</em> that can be used for code that is
common to all unit tests.</p></li>
<li><p>The generic routine &quot;test&quot; checks whether a particular unit
test needs to be run (via the test number) and then runs the subroutine
that was passed as one of its arguments. One such routine looks like
this:</p>
<pre class="example">
subroutine test_no_file
    integer :: nodata
    real    :: vmean, vmin, vmax
    call funit_remove_file( 'no_such_file' )
    call write_name( 'no_such_file' )
    call open_files
    call process_data( nodata, vmean, vmax, vmin )
    call assert_true( nodata == 0, &quot;No data read&quot; )
end subroutine test_no_file
</pre>
<p>The assertion is used to check that the result is as expected.</p></li>
<li><p>The program contains some deliberate errors and the resulting
log file looks like this&quot;:</p>
<pre class="example">
Test: Read non-existent file
Test: Read an empty file
Test: Read an invalid file
forrtl: severe (59): list-directed I/O syntax error, unit 11, file c:\arjen\flibs\tests\funit\invalid_file
Image              PC        Routine            Line        Source
test_funit.exe     004151B9  Unknown               Unknown  Unknown
test_funit.exe     00415017  Unknown               Unknown  Unknown
test_funit.exe     004141F4  Unknown               Unknown  Unknown
test_funit.exe     00414629  Unknown               Unknown  Unknown
test_funit.exe     00409C05  Unknown               Unknown  Unknown
test_funit.exe     004095FB  Unknown               Unknown  Unknown
test_funit.exe     0040144B  Unknown               Unknown  Unknown
test_funit.exe     00401FE9  Unknown               Unknown  Unknown
test_funit.exe     00401A2C  Unknown               Unknown  Unknown
test_funit.exe     00401BB3  Unknown               Unknown  Unknown
test_funit.exe     0040294A  Unknown               Unknown  Unknown
test_funit.exe     0040232E  Unknown               Unknown  Unknown
test_funit.exe     0044A1E9  Unknown               Unknown  Unknown
test_funit.exe     00433519  Unknown               Unknown  Unknown
kernel32.dll       7C816D4F  Unknown               Unknown  Unknown
Incrementally linked image--PC correlation disabled.
Test: Read an ordinary file
Number of failed assertions:                    0
Number of runs needed to complete the tests:    3
</pre>
</li>
</ul>
<p>The program is run via one of the following files:</p>
<dl class="definitions">
<dt><a name="1">runtests.bat</a></dt>
<dd><p>A batch file for use under MS Windows</p></dd>
<dt><a name="2">runtests.sh</a></dt>
<dd><p>A Bourne shell script for use under UNIX/Linux or similar systems, like
Cygwin or Mingw.</p></dd>
<dt><a name="3">runtests.tcl</a></dt>
<dd><p>A Tcl program that presents a simple graphical user-interface</p></dd>
</dl>
</div>
<div id="section2" class="section"><h2><a name="section2">ROUTINES</a></h2>
<p>The module funit contains the following subroutines and functions:</p>
<dl class="definitions">
<dt><a name="4"><b class="cmd">call runtests( testproc )</b></a></dt>
<dd><p>Routine to start the unit tests. It checks if the file &quot;funit.run&quot;
exists. If so, it will call the subroutine <em>testproc</em> that was
passed. Otherwise it will simply return, so that the ordinary program
execution may continue.</p>
<p>If the subroutine testproc returns, the program stops.</p>
<dl class="arguments">
<dt>subroutine <i class="arg">testproc</i></dt>
<dd><p>Subroutine that calls the individual test routines. It takes no
arguments. It wil generally exist of a series of calls to the
routine <em>test</em> - see below.</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">call test( proc, text )</b></a></dt>
<dd><p>Routine to run the individual unit test routine (emph proc). It decides
if the test has not run yet and if so, the test routine is called.
Otherwise it is skipped.</p>
<p><em>test</em> takes care of all administrative details.</p>
<p>Note: to make it possible to use <em>private</em> unit test routines,
the source code of this subroutine is kept in a separate file,
<em>funit_test.f90</em> that should be included in an appropriate
place in the program's sources. This way, you can make it a private
routine in each module. The only public access to the unit testing
routines is then via the subroutine <em>testproc</em> that is passed to
<em>runtests</em>.</p>
<dl class="arguments">
<dt>subroutine <i class="arg">proc</i></dt>
<dd><p>Subroutine that implements an individual unit test. It takes no
arguments. Within each such subroutine the complete unit test is run.</p></dd>
<dt>character(len=*), intent(in) <i class="arg">text</i></dt>
<dd><p>Text describing the particular unit test. It is printed in the log
file.</p></dd>
</dl></dd>
<dt><a name="6"><b class="cmd">call assert_true( cond, text )</b></a></dt>
<dd><p>Routine to check that a condition is true. If not, a message is printed
in the log file and the number of failures is increased.</p>
<dl class="arguments">
<dt>logical <i class="arg">cond</i></dt>
<dd><p>The condition to be checked</p></dd>
<dt>character(len=*), intent(in) <i class="arg">text</i></dt>
<dd><p>Text describing the condition</p></dd>
</dl></dd>
<dt><a name="7"><b class="cmd">exists = funit_file_exists( filename )</b></a></dt>
<dd><p>Logical function to check that a particular file exists</p>
<dl class="arguments">
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>Name of the file to be checked</p></dd>
</dl></dd>
<dt><a name="8"><b class="cmd">call funit_get_lun( lun )</b></a></dt>
<dd><p>Subroutine to get a free LU-number</p>
<dl class="arguments">
<dt>integer, intent(out) <i class="arg">lun</i></dt>
<dd><p>Next free LU-number</p></dd>
</dl></dd>
<dt><a name="9"><b class="cmd">call funit_remove_file( filename )</b></a></dt>
<dd><p>Subroutine to remove (delete) a file</p>
<dl class="arguments">
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>Name of the file to be removed</p></dd>
</dl></dd>
<dt><a name="10"><b class="cmd">call funit_make_empty_file( filename )</b></a></dt>
<dd><p>Subroutine to make a new, empty file</p>
<dl class="arguments">
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>Name of the file to be created</p></dd>
</dl></dd>
</dl>
</div>
<div id="section3" class="section"><h2><a name="section3">TODO</a></h2>
<p>The following things are still left to do:</p>
<ul class="itemized">
<li><p>Proper inclusion of the routine <em>prolog</em> and <em>epilog</em></p></li>
<li><p>Extension of the set of assertion routines</p></li>
</ul>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2006 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>src/computing/random_permutation.f90<|end_filename|>
! random_permutation.f90 --
!     Provide routines for permuting arrays
!
!     Derived from a posting on comp.lang.fortran by <NAME>
!
!     $Id: random_permutation.f90,v 1.1 2012/12/23 10:18:12 arjenmarkus Exp $
!
module random_permutations

    implicit none

    interface randomly_permute
        module procedure randomly_permute_int
    end interface

contains

! fill_random_permutation --
!     Fill an array with randomly permuted integers from 1 to N
!
! Arguments:
!     array         Array to be filled
!
! Result:
!     The array is filled with integers 1 to N in random order.
!     It can be used to permute arrays of arbitrary type like:
!
!     call fill_random_permutation( order )
!     data = data(order)
!
subroutine fill_random_permutation( array )
    integer, dimension(:), intent(out) :: array

    integer                            :: i

    array = (/ (i, i=1,size(array)) /)

    call randomly_permute( array )
end subroutine fill_random_permutation

! randomly_permute_int --
!     Randomly permute an array of integers
!
! Arguments:
!     array         Array to be permuted
!
! Result:
!     Randomly permuted content
!
! Note:
!     The algorithm is derived from the book by Donald Knuth:
!     Adaptation of Knuth Volume 2, Algorithm 3.4.2P.
!
subroutine randomly_permute_int( array )
    integer, dimension(:), intent(inout) :: array

    integer                :: i, j, k
    integer                :: temp
    real(kind=kind(1.0d0)) :: u


    do j=size(array),2,-1

        call random_number(u)
        k = floor(j*u) + 1

        !
        ! Exchange array(k) and array(j)
        !
        temp     = array(k)
        array(k) = array(j)
        array(j) = temp

    end do

endsubroutine randomly_permute_int

endmodule random_permutations


<|start_filename|>chkfeatures/chk_type_intrinsic.f90<|end_filename|>
! chk_type_intrinsic --
!     Check: does the compiler support the Fortran 2008 syntax of type(intrinsic)?
!
!     Note: such syntax unifies the way to define variables of intrinsic and derived types.
!     This could be used for a form of generic programming
!
program chk_type_intrinsic
    implicit none

    type(integer) :: value

    value = 1
    write(*, '(a,i0)') 'Value: ', value
end program chk_type_intrinsic


<|start_filename|>src/funit/funit.f90<|end_filename|>
! DEPRECATED - see funit.f90 instead
! ftnunit.f90 --
!     Module that implements part of the "ftnunit" framework:
!     It is inspired by the well-known JUnit framework for
!     integrating unit tests in a Java application.
!
!     The module offers:
!     - a set of common utilities, such as assertion checking
!       routines
!     - a general routine to run the tests if requested
!     - resources that keep track of the status
!
!     Related files:
!     ftnunit_test.f90
!     runtests.bat
!     runtests.sh
!     runtests.tcl
!
!     $Id: funit.f90,v 1.2 2007/08/15 19:09:33 arjenmarkus Exp $
!
module ftnunit
    implicit none

    integer :: last_test         ! Last test that was started
    integer :: testno            ! Current test number
    integer :: nofails           ! Number of assertions that failed
    integer :: noruns            ! Number of runs so far

contains

! runtests --
!     Subroutine to run the tests if requested
! Arguments:
!     testproc      The test subroutine that actually runs the unit test
! Side effects:
!     The input file with data is opened at LUN 10,
!     the report file is opened at LUN 20
!
subroutine runtests( testproc )
    interface
        subroutine testproc
        end subroutine testproc
    end interface

    integer :: lun
    integer :: ierr

    last_test = 0
    nofails   = 0
    noruns    = 0
    testno    = 0

    if ( ftnunit_file_exists("ftnunit.run") ) then
        if ( ftnunit_file_exists("ftnunit.lst") ) then
            call ftnunit_get_lun( lun )
            open( lun, file = "ftnunit.lst", iostat = ierr )
            if ( ierr == 0 ) then
                read( lun, *, iostat = ierr ) last_test, nofails, noruns
                if ( ierr /= 0 ) then
                    last_test = 0
                    nofails   = 0
                    noruns    = 0
                endif
                close( lun )
            endif
        endif

        noruns = noruns + 1

        call testproc

        write(*,'(a,i5)') 'Number of failed assertions:                ', nofails
        write(*,'(a,i5)') 'Number of runs needed to complete the tests:', noruns
        call ftnunit_remove_file( "ftnunit.lst" )
        stop
    endif

end subroutine runtests

! assert_true --
!     Subroutine to check if a condition is true
! Arguments:
!     cond          Condition to be checked
!     text          Text describing the assertion
! Side effects:
!     If the assertion fails, this is reported to standard
!     output. Also, nofails is increased by one.
!
subroutine assert_true( cond, text )
    logical, intent(in)          :: cond
    character(len=*), intent(in) :: text

    if ( .not. cond ) then
        nofails = nofails + 1
        write(*,*) '    Condition "',trim(text), '" failed'
        write(*,*) '    It should have been true'
    endif
end subroutine assert_true

! ftnunit_file_exists --
!     Auxiliary function to see if a file exists
! Arguments:
!     filename      Name of the file to check
! Returns:
!     .true. if the file exists, .false. otherwise
!
logical function ftnunit_file_exists( filename )
    character(len=*), intent(in) :: filename

    inquire( file = filename, exist = ftnunit_file_exists )
end function ftnunit_file_exists

! ftnunit_get_lun --
!     Auxiliary subroutine to get a free LU-number
! Arguments:
!     lun           The value that can be used
!
subroutine ftnunit_get_lun( lun )
    integer, intent(out) :: lun

    logical       :: opend
    integer, save :: prevlun = 0

    if ( prevlun /= 0 ) then
        inquire( unit = lun, opened = opend )
        if ( .not. opend ) then
            lun = prevlun
            return
        endif
    endif

    do prevlun = 10,99
        inquire( unit = prevlun, opened = opend )
        if ( .not. opend ) then
            lun = prevlun
            return
        endif
    enddo

end subroutine ftnunit_get_lun

! ftnunit_remove_file --
!     Auxiliary subroutine to remove a file
! Arguments:
!     filename      Name of the file to be removed
!
subroutine ftnunit_remove_file( filename )
    character(len=*), intent(in) :: filename

    integer                      :: lun
    integer                      :: ierr

    call ftnunit_get_lun( lun )
    open( lun, file = filename, iostat = ierr )
    if ( ierr /= 0 ) then
        write(*,*) '    Could not open file for removal: ', trim(filename)
        nofails = nofails + 1
    else
        close( lun, status = 'delete' )
        if ( ftnunit_file_exists( filename ) ) then
            write(*,*) '    Removal of file unsuccssful: ', trim(filename)
            nofails = nofails + 1
        endif
    endif

end subroutine ftnunit_remove_file

! ftnunit_make_empty_file --
!     Auxiliary subroutine to make an empty file
! Arguments:
!     filename      Name of the file to be created
!
subroutine ftnunit_make_empty_file( filename )
    character(len=*), intent(in) :: filename

    integer                      :: lun
    integer                      :: ierr

    if ( ftnunit_file_exists( filename ) ) then
        call ftnunit_remove_file( filename )
    endif
    call ftnunit_get_lun( lun )
    open( lun, file = filename, iostat = ierr, status = 'new' )
    if ( ierr /= 0 ) then
        write(*,*) '    Failed to create empty file: ', trim(filename)
        nofails = nofails + 1
    else
        close( lun )
    endif

end subroutine ftnunit_make_empty_file

end module ftnunit


<|start_filename|>doc/funit/ftnunit.html<|end_filename|>
<! -- -*- flibs -*- doctools manpage
   -->
<html><head>
<title>flibs/ftnunit - flibs </title>
</head>
<! -- Generated from file 'ftnunit.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2009 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: ftnunit.html,v 1.4 2010/12/16 20:46:21 arjenmarkus Exp $ flibs/ftnunit.n
   -->

<body>
<h1> flibs/ftnunit(n) 1.2  &quot;flibs&quot;</h1>
<h2><a name="name">NAME</a></h2>
<p>
<p> flibs/ftnunit - Unit testing




<h2><a name="table_of_contents">TABLE OF CONTENTS</a></h2>
<p>&nbsp;&nbsp;&nbsp;&nbsp;<a href="#table_of_contents">TABLE OF CONTENTS</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#synopsis">SYNOPSIS</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#description">DESCRIPTION</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#output">OUTPUT</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#routines">ROUTINES</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#customisation">CUSTOMISATION</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#generating_tests_from_a_table">GENERATING TESTS FROM A TABLE</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#todo">TODO</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#related_work">RELATED WORK</a><br>
&nbsp;&nbsp;&nbsp;&nbsp;<a href="#copyright">COPYRIGHT</a><br>
<h2><a name="synopsis">SYNOPSIS</a></h2>
<p>
<table border=1 width=100% cellspacing=0 cellpadding=0><tr            bgcolor=lightyellow><td bgcolor=lightyellow><table 0 width=100% cellspacing=0 cellpadding=0><tr valign=top ><td ><a href="#1">runtests.bat </a></td></tr>
<tr valign=top ><td ><a href="#2">runtests.sh </a></td></tr>
<tr valign=top ><td ><a href="#3">runtests.tcl </a></td></tr>
<tr valign=top ><td ><a href="#4">ftnunitgui.tcl </a></td></tr>
<tr valign=top ><td ><a href="#5"><b class='cmd'>call runtests( testproc )</b> </a></td></tr>
<tr valign=top ><td ><a href="#6"><b class='cmd'>call runtests_init</b> </a></td></tr>
<tr valign=top ><td ><a href="#7"><b class='cmd'>call runtests_final( stop )</b> </a></td></tr>
<tr valign=top ><td ><a href="#8"><b class='cmd'>call test( proc, text, ignore )</b> </a></td></tr>
<tr valign=top ><td ><a href="#9"><b class='cmd'>call assert_true( cond, text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#10"><b class='cmd'>call assert_false( cond, text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#11"><b class='cmd'>call assert_equal( value1, value2, text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#12"><b class='cmd'>call assert_comparable( value1, value2, margin, text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#13"><b class='cmd'>call assert_inbetween( value, vmin, vmax, text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#14"><b class='cmd'>call assert_files_comparable( filename1, filename2, margin, text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#15"><b class='cmd'>exists = ftnunit_file_exists( filename )</b> </a></td></tr>
<tr valign=top ><td ><a href="#16"><b class='cmd'>call ftnunit_get_lun( lun )</b> </a></td></tr>
<tr valign=top ><td ><a href="#17"><b class='cmd'>call ftnunit_remove_file( filename )</b> </a></td></tr>
<tr valign=top ><td ><a href="#18"><b class='cmd'>call ftnunit_make_empty_file( filename )</b> </a></td></tr>
<tr valign=top ><td ><a href="#19">cmd call ftnunit_hook_test_start( text )</a></td></tr>
<tr valign=top ><td ><a href="#20">cmd call ftnunit_hook_test_stop( text )</a></td></tr>
<tr valign=top ><td ><a href="#21"><b class='cmd'>call ftnunit_hook_test_failure( text, assert_text, failure_text )</b> </a></td></tr>
<tr valign=top ><td ><a href="#22"><b class='cmd'>call ftnunit_hook_test_complete</b> </a></td></tr>
</table></td></tr></table>
<h2><a name="description">DESCRIPTION</a></h2>
<p>

<em>JUnit</em> is a well-known facility for defining and running unit
tests in Java programs. The <em>ftnunit</em> framework was inspired by
that facility. It is not as good-looking as JUnit, by no means:
<ul>
<li>
It has a simple graphical user-interface that does not group the tests.

<br><br>
<li>
As Fortran does not allow introspection, the test routines can not
be detected automatically, instead as a programmer you need to set up a
high-level routine yourself that collects all the unit tests.

<br><br>
<li>
A runtime error, like division by zero, may lead to a termination of
the program. There is no (portable) way to catch these. Instead, the
framework relies on a batch file or shell script to repeatedly start the
program until all tests are run.

</ul>

Despite these limitations, <em>ftnunit</em> can be a great help:

<ul>
<li>
The Tcl program <em>gentabletest.tcl</em> generates a complete test program based
on a simple input file (see <a href="#generating_tests_from_a_table">GENERATING TESTS FROM A TABLE</a>).

<br><br>
<li>
The code to test the various components (subroutines, functions, tasks
consisting of several program units) can be combined with the program
itself, without interfering with the ordinary code.
<br><br>
This is achieved by defining a single routine (test_all, say) that runs
all the unit tests and that is called via the provided routine
<em>runtests</em>:

<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>
program myprog
    ...
!
! The routine runtests will check if unit tests are requested
! If not, it will return immediately. This way we make sure
! the unit tests remain part of the program.
!
! The routine test_all runs all unit tests
! (see the dataproc_testing module)
!
    call runtests( test_all )
!
! Ordinary processing
!
    ...

end program
</pre></td></tr></table></p>

The routine runtests checks if there is a file &quot;ftnunit.run&quot;. If there is
such a file, it will run the given subroutine. Otherwise it will return
and the rest of the program is executed.

<br><br>
<li>
Because the test code is incorporated in the program itself, it is less
likely that they evolve independently: changes in the argument lists of
the subroutines and functions may lead to compile errors in the test
code.

<br><br>
<li>
There is no need to set up a whole new program for testing portions of
the program.

</ul>

The source file &quot;test_ftnunit.f90&quot; illustrates how to use the <em>ftnunit</em>
framework:

<ul>
<li>
The main program calls the routine &quot;runtests&quot; and passes it the argument
&quot;test_all&quot;, a routine defined in a module called &quot;dataproc_testing&quot;.

<br><br>
<li>
The routine &quot;test_all&quot; consists of nothing but calls to the generic
routine &quot;test&quot;:

<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>
subroutine test_all

    call test( test_no_file, &quot;Read non-existent file&quot; )
    call test( test_empty_file, &quot;Read an empty file&quot; )
    call test( test_invalid_file, &quot;Read an invalid file&quot; )
    call test( test_ordinary_file, &quot;Read an ordinary file&quot; )

end subroutine test_all
</pre></td></tr></table></p>

<br><br>
<li>
The module includes a source file &quot;ftnunit_test.f90&quot;. This is a remnant
of a previous version. Please ignore this.

<br><br>
<li>
The generic routine &quot;test&quot; checks whether a particular unit
test needs to be run (via the test number) and then runs the subroutine
that was passed as one of its arguments. One such routine looks like
this:

<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>
subroutine test_no_file

    integer :: nodata
    real    :: vmean, vmin, vmax

    call ftnunit_remove_file( 'no_such_file' )
    call write_name( 'no_such_file' )

    call open_files
    call process_data( nodata, vmean, vmax, vmin )

    call assert_true( nodata == 0, &quot;No data read&quot; )

end subroutine test_no_file
</pre></td></tr></table></p>

The assertion is used to check that the result is as expected.

<br><br>
<li>
The program contains some deliberate errors and the resulting
log file looks like this:

<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>
Test: Read non-existent file
Test: Read an empty file
Test: Read an invalid file
forrtl: severe (59): list-directed I/O syntax error, unit 11, file c:\arjen\flibs\tests\ftnunit\invalid_file

Image              PC        Routine            Line        Source
test_ftnunit.exe     004151B9  Unknown               Unknown  Unknown
test_ftnunit.exe     00415017  Unknown               Unknown  Unknown
test_ftnunit.exe     004141F4  Unknown               Unknown  Unknown
test_ftnunit.exe     00414629  Unknown               Unknown  Unknown
test_ftnunit.exe     00409C05  Unknown               Unknown  Unknown
test_ftnunit.exe     004095FB  Unknown               Unknown  Unknown
test_ftnunit.exe     0040144B  Unknown               Unknown  Unknown
test_ftnunit.exe     00401FE9  Unknown               Unknown  Unknown
test_ftnunit.exe     00401A2C  Unknown               Unknown  Unknown
test_ftnunit.exe     00401BB3  Unknown               Unknown  Unknown
test_ftnunit.exe     0040294A  Unknown               Unknown  Unknown
test_ftnunit.exe     0040232E  Unknown               Unknown  Unknown
test_ftnunit.exe     0044A1E9  Unknown               Unknown  Unknown
test_ftnunit.exe     00433519  Unknown               Unknown  Unknown
kernel32.dll       7C816D4F  Unknown               Unknown  Unknown

Incrementally linked image--PC correlation disabled.
Test: Read an ordinary file
Number of failed assertions:                    0
Number of runs needed to complete the tests:    3
</pre></td></tr></table></p>

</ul>

The program is run via one of the following files:

<dl>

<dt><a name="1">runtests.bat </a><dd>

A batch file for use under MS Windows
<br><br>
<dt><a name="2">runtests.sh </a><dd>

A Bourne shell script for use under UNIX/Linux or similar systems, like
Cygwin or Mingw.
<br><br>
<dt><a name="3">runtests.tcl </a><dd>

A Tcl program that presents a simple graphical user-interface
<br><br>
<dt><a name="4">ftnunitgui.tcl </a><dd>

A Tcl-based graphical user-interface that allows you to run tests one at a time

</dl>


<h2><a name="output">OUTPUT</a></h2>
<p>
When you run a program in test mode via the batch file/shell script,
it produces two output files:

<ul>

<li>
<em>runtests.log</em> contains all the output that was written to the screen.
<br><br>
<li>
<em>ftnunit.html</em> is an HTML file with a summary of the tests and a colour
encoding to indicate the test cases that succeeded or failed.

</ul>


<h2><a name="routines">ROUTINES</a></h2>
<p>
The module <em>ftnunit</em> contains the following subroutines and functions:

<dl>

<dt><a name="5"><b class='cmd'>call runtests( testproc )</b> </a><dd>

Routine to start the unit tests. It checks if the file &quot;ftnunit.run&quot;
exists. If so, it will call the subroutine <em>testproc</em> that was
passed. Otherwise it will simply return, so that the ordinary program
execution may continue.
<br><br>
If the subroutine testproc returns, the program stops, unless you have
called the subroutine <em>runtests_init</em> before <em>runtests</em>.

<br><br>
<dl>
<dt>subroutine <i class='arg'>testproc</i><dd>
Subroutine that calls the individual test routines. It takes no
arguments. It wil generally exist of a series of calls to the
routine <em>test</em> - see below.
</dl>
<br><br>

<dt><a name="6"><b class='cmd'>call runtests_init</b> </a><dd>

Routine to initialise the ftnunit system, so that you call <em>runtests</em>
more than once. To complete the tests, call <em>runtests_final</em>, as
this will print the final statistics and stop the program.
<br><br>

<br><br>
<dt><a name="7"><b class='cmd'>call runtests_final( stop )</b> </a><dd>

Routine to finalise the ftnunit system: it will print the final statistics
and stop the program, but only if the file &quot;ftnunit.run&quot; is present.

<br><br>
<dl>
<dt>logical, optional, intent(in) <i class='arg'>stop</i><dd>
If present and set to true, the routine will not stop the program.
Instead it returns and the program continues working.
</dl>
<br><br>

<dt><a name="8"><b class='cmd'>call test( proc, text, ignore )</b> </a><dd>

Routine to run the individual unit test routine (emph proc). It decides
if the test has not run yet and if so, the test routine is called.
Otherwise it is skipped.
<br><br>
<em>test</em> takes care of all administrative details.

<br><br>
<dl>
<dt>subroutine <i class='arg'>proc</i><dd>
Subroutine that implements an individual unit test. It takes no
arguments. Within each such subroutine the complete unit test is run.

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the particular unit test. It is printed in the log
file.

<br><br>
<dt>logical, optional, intent(in) <i class='arg'>ignore</i><dd>
If present and set to true, the test routine will not be actually run.
Instead it is shown as &quot;ignored&quot;. This feature is useful if the code to
be tested is not yet ready for testing.
file.
</dl>
<br><br>


<dt><a name="9"><b class='cmd'>call assert_true( cond, text )</b> </a><dd>

Routine to check that a condition is true. If not, a message is printed
in the log file and the number of failures is increased.

<br><br>
<dl>
<dt>logical <i class='arg'>cond</i><dd>
The condition to be checked

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the condition
</dl>
<br><br>


<dt><a name="10"><b class='cmd'>call assert_false( cond, text )</b> </a><dd>

Routine to check that a condition is false. If not, a message is
printed in the log file and the number of failures is increased.

<br><br>
<dl>
<dt>logical <i class='arg'>cond</i><dd>
The condition to be checked

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the condition
</dl>
<br><br>


<dt><a name="11"><b class='cmd'>call assert_equal( value1, value2, text )</b> </a><dd>

Routine to check that two logicals, two strings, or two integers are equal
or if two one-dimensional integer, logical or string arrays are equal. If not, a message is
printed, along with the values that were different.

<br><br>
<dl>
<dt>&lt;type&gt; <i class='arg'>value1</i><dd>
The first integer/logical/string value

<br><br>
<dt>&lt;type&gt; <i class='arg'>value2</i><dd>
The second integer/logical/string value

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the condition
</dl>

Or:

<br><br>
<dl>
<dt>integer [, dimension(:)] <i class='arg'>value1</i><dd>
The first integer value or array

<br><br>
<dt>integer [, dimension(:)] <i class='arg'>value2</i><dd>
The second integer value or array

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the condition
</dl>
<br><br>


<dt><a name="12"><b class='cmd'>call assert_comparable( value1, value2, margin, text )</b> </a><dd>

Routine to check that two reals are almost equal or if two one-dimensional
real arrays (single or double precision) are almost equal. If not, a message
is printed, along with the values that were different.
<br><br>
The margin is taken as a relative tolerance. Two values are
considered almost equal if:
<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>    abs( v1 - v2 ) &lt; margin * (abs(v1)+abs(v2)) / 2 </pre></td></tr></table></p>

<br><br>
<dl>
<dt>real [, dimension(:)] <i class='arg'>value1</i><dd>
The first real value or array

<br><br>
<dt>real [, dimension(:)] <i class='arg'>value2</i><dd>
The second real value or array

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the condition
</dl>
<br><br>


<dt><a name="13"><b class='cmd'>call assert_inbetween( value, vmin, vmax, text )</b> </a><dd>

Routine to check that a (single or double precision) real value lies between
two given bounds. This establishes an absolute range for the values, rather than
a relative.

<br><br>
<dl>
<dt>real <i class='arg'>value</i><dd>
The real value to be tested

<br><br>
<dt>real <i class='arg'>vmin</i><dd>
The minimum value that is allowed

<br><br>
<dt>real <i class='arg'>vmax</i><dd>
The maximum value that is allowed
</dl>
<br><br>


<dt><a name="14"><b class='cmd'>call assert_files_comparable( filename1, filename2, margin, text )</b> </a><dd>

Routine to check that two files are equal or almost equal. The files are scanned
line by line and item by item. If an item can be interpreted as a number, then
the comparison is done using a margin, otherwise the corresponding items are
considered strings and should be exactly equal.
<br><br>
A report is produced of all differing lines.
<br><br>
The margin is taken as a relative tolerance. Two numerical values are
considered almost equal if:
<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>
    abs( v1 - v2 ) &lt; margin * (abs(v1)+abs(v2)) / 2 </pre></td></tr></table></p>

<br><br>
<dl>
<dt>character(len=*) <i class='arg'>filename1</i><dd>
The name of the first file to read

<br><br>
<dt>character(len=*) <i class='arg'>filename2</i><dd>
The name of the second file to read

<br><br>
<dt>character(len=*), intent(in) <i class='arg'>text</i><dd>
Text describing the condition
</dl>
<br><br>


<dt><a name="15"><b class='cmd'>exists = ftnunit_file_exists( filename )</b> </a><dd>

Logical function to check that a particular file exists

<br><br>
<dl>
<dt>character(len=*), intent(in) <i class='arg'>filename</i><dd>
Name of the file to be checked
</dl>
<br><br>


<dt><a name="16"><b class='cmd'>call ftnunit_get_lun( lun )</b> </a><dd>

Subroutine to get a free LU-number

<br><br>
<dl>
<dt>integer, intent(out) <i class='arg'>lun</i><dd>
Next free LU-number
</dl>
<br><br>


<dt><a name="17"><b class='cmd'>call ftnunit_remove_file( filename )</b> </a><dd>

Subroutine to remove (delete) a file

<br><br>
<dl>
<dt>character(len=*), intent(in) <i class='arg'>filename</i><dd>
Name of the file to be removed
</dl>
<br><br>


<dt><a name="18"><b class='cmd'>call ftnunit_make_empty_file( filename )</b> </a><dd>

Subroutine to make a new, empty file

<br><br>
<dl>
<dt>character(len=*), intent(in) <i class='arg'>filename</i><dd>
Name of the file to be created
</dl>

</dl>




<h2><a name="customisation">CUSTOMISATION</a></h2>
<p>
The module <em>ftnunit_hooks</em> can be used to customise the output
of <em>ftnunit</em> to a certain extent. It provides four routines
that you can easily adapt to your needs:

<dl>
<dt><a name="19">cmd call ftnunit_hook_test_start( text )</a><dd>
]
Routine to signal the start of a test.

<br><br>
<dl>
<dt>string <i class='arg'>text</i><dd>
The descriptive text passed to the routine <em>test</em>.
</dl>

<dt><a name="20">cmd call ftnunit_hook_test_stop( text )</a><dd>
]
Routine to signal the end of a test.

<br><br>
<dl>
<dt>string <i class='arg'>text</i><dd>
The descriptive text passed to the routine <em>test</em>.
</dl>

<dt><a name="21"><b class='cmd'>call ftnunit_hook_test_failure( text, assert_text, failure_text )</b> </a><dd>

Routine to signal that an assertion has failed (and therefore the test).

<br><br>
<dl>
<dt>string <i class='arg'>text</i><dd>
The descriptive text passed to the routine <em>test</em>.
<br><br>
<dt>string <i class='arg'>assert_text</i><dd>
Text describing the assertion
<br><br>
<dt>string <i class='arg'>failure_text</i><dd>
The text describing the reason of the failure
</dl>

<dt><a name="22"><b class='cmd'>call ftnunit_hook_test_complete</b> </a><dd>

Routine called after the tests have been run (for instance to start and
Internet browser to view the HTML report).

</dl>

Note that the default implementation consists of empty routine.

<p>
As an example of customisation, under Windows, you could start the
default Internet browser showing the HTML file like this:

    subroutine ftnunit_hook_test_complete

        call system( &quot;ftnunit.html&quot; )

    end subroutine ftnunit_hook_test_complete

provided an association for files with extension &quot;html&quot; exists.


<h2><a name="generating_tests_from_a_table">GENERATING TESTS FROM A TABLE</a></h2>
<p>
The Tcl program &quot;gentabletest.tcl&quot; reads the test specifications from an
input file and generates a complete Fortran program. The ideas from
<NAME>'s  &quot;Toward Scientific Numerical Modeling&quot;
<a href="ftp://ftp.rta.nato.int/PubFullText/RTO/MP/RTO-MP-AVT-147/RTO-MP-AVT-147-P-17-Kleb.pdf">ftp://ftp.rta.nato.int/PubFullText/RTO/MP/RTO-MP-AVT-147/RTO-MP-AVT-147-P-17-Kleb.pdf</a>
were used for the set-up.

<p>
To do: provide a detailed description. For the moment: see <em>example.tbl</em>, including below.

<p><table><tr><td bgcolor=black>&nbsp;</td><td><pre class='sample'>
! Example of generating test code via a table
! -------------------------------------------
! The routine to be tested determines the minimum oxygen concentration
! in a river, based on the Streeter-Phelps model:
!
!    dBOD/dt = -k * BOD
!
!    dO2/dt = -k * BOD + ka * (O2sat-O2) / H
!
! where
!    BOD   - biological oxygen demand (mg O2/l)
!    O2    - oxygen concentration (mg O2/l)
!    O2sat - saturation concentration of oxygen (mg O2/l)
!    k     - decay rate of BOD (1/day)
!    ka    - reareation rate of oxygen (m/day)
!    H     - depth of the river
!
! We need boundary (initial) conditions for BOD and oxygen and
! the equations describe the concentrations of BOD and oxygen in a
! packet of water as it flows along the river.
!
! Note:
! It is a very simple model, it is not meant as a realistic
! representation.
!
! The routine simply continues the solution until a minimum is found.
! The results are: oxymin and time
!
!
! The keyword DECLARATIONS introduces the declarations we need for the
! complete generated code
!
DECLARATIONS
    use streeter_phelps
    real :: bod, oxy
    real :: k, ka, h, oxysat, dt, oxymin, time
!
! The keyword CODE introduces the code fragment required to run the
! routine or routines. The results and possible checking of error
! conditions are separated.
!
CODE
    call compute_min_oxygen( bod, oxy, k, ka, h, oxysat, dt, oxymin, time )
!
! The keyword RESULT indicates which arguments/variables hold the
! interesting results. Specify one name per line (you can not currently
! use array elements) and the allowed margin (taken as absolute, if
! followed by &quot;%&quot; as a percentage)
!
RESULT
    oxymin  0.001        ! Minimum oxygen concentration
    time    0.01%        ! Time the minimum is reached

!
! The keyword ERROR is used for a code fragment that checks if the
! routine has correctly found an error in the input (that is, some
! parameter value is out of range). The code is invoked when any of
! result variables in a table entry has the keyword ERROR instead of
! a proper value.
! Use the subroutine &quot;error&quot; to indicate the correctly reported error
! condition.
!
ERROR
    if ( time == -999.0 ) then
        call error
    endif
!
! The keyword RANGES specifies that the variables are to be taken
! from a uniform or a normal distribution. The generated program will
! simply select values at random and run the code with them. The report
! consists of the detailed output as well as a summary.
!
RANGES
    oxy   10.0   2.0  Uniform ! Name of the variable, the mean and the margin (uniform)
                              ! Normal: mean and standard deviation followed by Normal
                              ! Note: all parameters must be given!
!
! The keyword TABLE indicates the beginning of a table of input data and
! expected values. The first (non-comment) line contains the names of
! the variables as used in the code fragments and all others are the
! values expected.
!
! There are two special values:
! ? -     indicating an unknown value for result variables and a &quot;do not
!         care&quot; value for input variables
!         It is useful to generate a table that does contain the (computed)
!         results (see the file table.out) or to indicate situations
!         where one or more input variables are out of range and this
!         should lead to an error
! ERROR - indicating that the entry should cause the routine to be
!         tested to flag an error condition.
!
TABLE
dt   oxy       bod       oxysat    h         k         ka        oxymin    time
0.1  10        1         10        10        0.1       1.0       10.0      2.0
1.0  10        1         10        10        0.1       1.0       ?         ?
!
! This case is unacceptable: time step must be positive
0.0  ?         ?         ?         ?         ?         ?         ?         ERROR
1.0  0.        10        10        10        0.1       1.0       ?         ?
</pre></td></tr></table></p>

<h2><a name="todo">TODO</a></h2>
<p>
The following things are still left to do:
<ul>
<li>
Proper inclusion of the routine <em>prolog</em> and <em>epilog</em>

<br><br>
<li>
Extension of the set of assertion routines

</ul>

<h2><a name="related_work">RELATED WORK</a></h2>
<p>
There are at least two similar initiatives with regard to a unit testing
framework for Fortran:

<ul>
<li>
<a href="http://nasarb.rubyforge.org">Funit (implemented in Fortran and
Ruby)</a> by <NAME> and others

<br><br>
<li>
<a href="http://www.sourceforge.net/projects/pfunit">A framework
implemented in Fortran</a> by <NAME> and <NAME>

<br><br>
<li>
<a href="http://www.sourceforge.net/projects/fortranxunit">FRUIT
(implemented in Fortran and Ruby)</a> by <NAME>

</ul>

(Note: To avoid confusion, I have renamed my original module &quot;funit&quot; to
<em>ftnunit</em>)

<h2><a name="copyright">COPYRIGHT</a></h2>
<p>
Copyright &copy; 2009 <NAME> &lt;<EMAIL>&gt;<br>
</body></html>



<|start_filename|>doc/computing/backtrack.html<|end_filename|>

<html><head>
<title>flibs/backtracking - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'computing/backtrack.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2006 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: backtrack.html,v 1.2 2013/05/13 08:03:15 knystrom Exp $ flibs/backtracking.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/backtracking(n) 1.1  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/backtracking - Backtracking</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">ROUTINES</a></li>
<li class="section"><a href="#section3">TODO</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">call runtests( testproc )</b></a></li>
<li><a href="#2"><b class="cmd">call test( proc, text )</b></a></li>
<li><a href="#3"><b class="cmd">call assert_true( cond, text )</b></a></li>
<li><a href="#4"><b class="cmd">exists = funit_file_exists( filename )</b></a></li>
<li><a href="#5"><b class="cmd">call funit_get_lun( lun )</b></a></li>
<li><a href="#6"><b class="cmd">call funit_remove_file( filename )</b></a></li>
<li><a href="#7"><b class="cmd">call funit_make_empty_file( filename )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The module <em>Backtracking</em> implements in a general way a well-known
algorithm to solve certain combinatorial problems. The module actually
consists of a single routine that forms the framework of the algorithm
and is to be used in conjunction with a small set of user-defined
routines that implement the specific problem.</p>
<p>The backtracking technique is especially useful if you can build a
solution in stages. The classic example is the &quot;eight queens&quot; problem,
where you must place eight queens on a chess board in such a way that
none can get another in one move. A little thought shows that
each queen must be placed in its own column (or row). Placing the first
queen in the first column gives us eight possibilities. Placing the
second is only possible if it is not within the range of the first one.</p>
<p>If it is, it makes no sense to continue so we can eliminate in the
second step a whole subset of possible configurations, namely those with
the second queeen within range of the first.
We can continue building up a partial solution in this way until we
finally have eight queens on the board.</p>
<p>The idea of the module is that all the data that describe a possible
partial solution to the problem are contained in a derived type called
SOLUTION_DATA. Then the user-defined routine <em>generate</em> generates
a new set of partial solutions based on this.</p>
<p>The new set is examined to see if any is acceptable within the context
of the problem, which is done via another user-defined routine.</p>
<p>Each acceptable solution within this new step may give rise to its own
set of further solutions. This way the partial solutions are extended in
each step until finally a complete solution is found.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">ROUTINES</a></h2>
<p>The module backtracking contains</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">call runtests( testproc )</b></a></dt>
<dd><p>Routine to start the unit tests. It checks if the file &quot;funit.run&quot;
exists. If so, it will call the subroutine <em>testproc</em> that was
passed. Otherwise it will simply return, so that the ordinary program
execution may continue.</p>
<p>If the subroutine testproc returns, the program stops.</p>
<dl class="arguments">
<dt>subroutine <i class="arg">testproc</i></dt>
<dd><p>Subroutine that calls the individual test routines. It takes no
arguments. It wil generally exist of a series of calls to the
routine <em>test</em> - see below.</p></dd>
</dl></dd>
<dt><a name="2"><b class="cmd">call test( proc, text )</b></a></dt>
<dd><p>Routine to run the individual unit test routine (emph proc). It decides
if the test has not run yet and if so, the test routine is called.
Otherwise it is skipped.</p>
<p><em>test</em> takes care of all administrative details.</p>
<p>Note: to make it possible to use <em>private</em> unit test routines,
the source code of this subroutine is kept in a separate file,
<em>funit_test.f90</em> that should be included in an appropriate
place in the program's sources. This way, you can make it a private
routine in each module. The only public access to the unit testing
routines is then via the subroutine <em>testproc</em> that is passed to
<em>runtests</em>.</p>
<dl class="arguments">
<dt>subroutine <i class="arg">proc</i></dt>
<dd><p>Subroutine that implements an individual unit test. It takes no
arguments. Within each such subroutine the complete unit test is run.</p></dd>
<dt>character(len=*), intent(in) <i class="arg">text</i></dt>
<dd><p>Text describing the particular unit test. It is printed in the log
file.</p></dd>
</dl></dd>
<dt><a name="3"><b class="cmd">call assert_true( cond, text )</b></a></dt>
<dd><p>Routine to check that a condition is true. If not, a message is printed
in the log file and the number of failures is increased.</p>
<dl class="arguments">
<dt>logical <i class="arg">cond</i></dt>
<dd><p>The condition to be checked</p></dd>
<dt>character(len=*), intent(in) <i class="arg">text</i></dt>
<dd><p>Text describing the condition</p></dd>
</dl></dd>
<dt><a name="4"><b class="cmd">exists = funit_file_exists( filename )</b></a></dt>
<dd><p>Logical function to check that a particular file exists</p>
<dl class="arguments">
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>Name of the file to be checked</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">call funit_get_lun( lun )</b></a></dt>
<dd><p>Subroutine to get a free LU-number</p>
<dl class="arguments">
<dt>integer, intent(out) <i class="arg">lun</i></dt>
<dd><p>Next free LU-number</p></dd>
</dl></dd>
<dt><a name="6"><b class="cmd">call funit_remove_file( filename )</b></a></dt>
<dd><p>Subroutine to remove (delete) a file</p>
<dl class="arguments">
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>Name of the file to be removed</p></dd>
</dl></dd>
<dt><a name="7"><b class="cmd">call funit_make_empty_file( filename )</b></a></dt>
<dd><p>Subroutine to make a new, empty file</p>
<dl class="arguments">
<dt>character(len=*), intent(in) <i class="arg">filename</i></dt>
<dd><p>Name of the file to be created</p></dd>
</dl></dd>
</dl>
</div>
<div id="section3" class="section"><h2><a name="section3">TODO</a></h2>
<p>The following things are still left to do:</p>
<ul class="itemized">
<li><p>Proper inclusion of the routine <em>prolog</em> and <em>epilog</em></p></li>
<li><p>Extension of the set of assertion routines</p></li>
</ul>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2006 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>doc/strings/textstr.html<|end_filename|>

<html><head>
<title>flibs/strings - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'textstr.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2013 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: textstr.html,v 1.3 2013/10/06 11:37:57 arjenmarkus Exp $ flibs/strings.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/strings(n) 1.1  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/strings - Manipulate and store strings</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">DATA TYPES</a></li>
<li class="section"><a href="#section3">ROUTINES</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">type(TEXT_STRING)</b></a></li>
<li><a href="#2"><b class="cmd">type(MULITLINE_TEXT)</b></a></li>
<li><a href="#3"><b class="cmd">use edit_text</b></a></li>
<li><a href="#4"><b class="cmd">call edit_delete( string, pos, length )</b></a></li>
<li><a href="#5"><b class="cmd">call edit_insert( string, pos, substring )</b></a></li>
<li><a href="#6"><b class="cmd">use singleline_text</b></a></li>
<li><a href="#7"><b class="cmd">length = txt_length( text )</b></a></li>
<li><a href="#8"><b class="cmd">call txt_cleanup( text )</b></a></li>
<li><a href="#9"><b class="cmd">pos = txt_index( text, substring, back )</b></a></li>
<li><a href="#10"><b class="cmd">call txt_from_string( text, string )</b></a></li>
<li><a href="#11"><b class="cmd">call txt_from_string( text, string )</b></a></li>
<li><a href="#12"><b class="cmd">call txt_read_from_file( lun, text, eof )</b></a></li>
<li><a href="#13"><b class="cmd">call txt_write_to_file( lun, text )</b></a></li>
<li><a href="#14"><b class="cmd">call txt_delete( text, pos, length )</b></a></li>
<li><a href="#15"><b class="cmd">call txt_insert( text, pos, substring )</b></a></li>
<li><a href="#16"><b class="cmd">use multiline_text</b></a></li>
<li><a href="#17"><b class="cmd">length = mltxt_length( text )</b></a></li>
<li><a href="#18"><b class="cmd">length = mltxt_number( text )</b></a></li>
<li><a href="#19"><b class="cmd">call mltxt_cleanup( text )</b></a></li>
<li><a href="#20"><b class="cmd">call mltxt_insert( text, pos, line )</b></a></li>
<li><a href="#21"><b class="cmd">call mltxt_delete( text, first, last )</b></a></li>
<li><a href="#22"><b class="cmd">call mltxt_get( text, pos, line )</b></a></li>
<li><a href="#23"><b class="cmd">call mltxt_read_file( filename, text, error )</b></a></li>
<li><a href="#24"><b class="cmd">call mltxt_write_file( text, filename, error )</b></a></li>
<li><a href="#25"><b class="cmd">use multiline_text_functions</b></a></li>
<li><a href="#26"><b class="cmd">call mltxt_iterate( text, filter, first, last )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The file <em>textstr.f90</em> contains three fairly small modules,
designed for simple text manipulation and storage:</p>
<ul class="itemized">
<li><p><em>edit_text</em> for simple editing of text strings.</p></li>
<li><p><em>singleline_text</em> for storing a string of arbitrary length.</p></li>
<li><p><em>multiline_text</em> for storing a set of strings of arbitrary
length, for instance a text file.</p></li>
</ul>
<p>The facilities offered by these modules are geared to storage and
some basic manipulations. They are not meant to be a complete module for
arbitrary-length strings.
hence the module.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">DATA TYPES</a></h2>
<p>The modules <em>singleline_text</em> and <em>multiline_text</em>
each a suitable derived type:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">type(TEXT_STRING)</b></a></dt>
<dd><p>Type to hold a string of arbitrary length.</p></dd>
<dt><a name="2"><b class="cmd">type(MULITLINE_TEXT)</b></a></dt>
<dd><p>Type to hold a set of strings of arbitrary length.</p></dd>
</dl>
</div>
<div id="section3" class="section"><h2><a name="section3">ROUTINES</a></h2>
<p>The module <em>edit_text</em> contains the following routines:</p>
<dl class="definitions">
<dt><a name="3"><b class="cmd">use edit_text</b></a></dt>
<dd><p>To import the subroutines, use this module.</p></dd>
<dt><a name="4"><b class="cmd">call edit_delete( string, pos, length )</b></a></dt>
<dd><p>Delete a substring from a string.</p>
<dl class="arguments">
<dt>character(len=*), intent(inout) <i class="arg">string</i></dt>
<dd><p>String to be modified</p></dd>
<dt>integer, intent(in) <i class="arg">pos</i></dt>
<dd><p>Position of the first character to be deleted</p></dd>
<dt>integer, intent(in) <i class="arg">length</i></dt>
<dd><p>Length of the substring to be deleted</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">call edit_insert( string, pos, substring )</b></a></dt>
<dd><p>Insert a substring into a string.</p>
<dl class="arguments">
<dt>character(len=*), intent(inout) <i class="arg">string</i></dt>
<dd><p>String to be modified</p></dd>
<dt>integer, intent(in) <i class="arg">pos</i></dt>
<dd><p>Position after which to insert the substring (use 0
to insert it before the string)</p></dd>
<dt>character(len=*), intent(in) <i class="arg">substring</i></dt>
<dd><p>Subtring to be inserted</p></dd>
</dl></dd>
</dl>
<p>The module <em>singleline_text</em> contains the following routines:</p>
<dl class="definitions">
<dt><a name="6"><b class="cmd">use singleline_text</b></a></dt>
<dd><p>To import the subroutines, use this module.</p></dd>
<dt><a name="7"><b class="cmd">length = txt_length( text )</b></a></dt>
<dd><p>Return the length of the text. As this is a <em>pure</em> function, you
cna use it to define temporary strings of the correct length.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(in) <i class="arg">text</i></dt>
<dd><p>Text string to be examined</p></dd>
</dl></dd>
<dt><a name="8"><b class="cmd">call txt_cleanup( text )</b></a></dt>
<dd><p>Clean up the storage for a previous text string.
The result is an empty string.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(inout) <i class="arg">text</i></dt>
<dd><p>Text string to be examined</p></dd>
</dl></dd>
<dt><a name="9"><b class="cmd">pos = txt_index( text, substring, back )</b></a></dt>
<dd><p>Return the index (position) of a substring in the text.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(in) <i class="arg">text</i></dt>
<dd><p>Text string to be examined</p></dd>
<dt>character(len=*), intent(in) <i class="arg">substring</i></dt>
<dd><p>Substring to be found</p></dd>
<dt>logical, optional, intent(in) <i class="arg">back</i></dt>
<dd><p>Search from the start (.false.) or from the back (.true.)</p></dd>
</dl></dd>
<dt><a name="10"><b class="cmd">call txt_from_string( text, string )</b></a></dt>
<dd><p>Store a string in a text_string type. Trailing blanks
in the original string are explicitly stored.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(inout) <i class="arg">text</i></dt>
<dd><p>Text string to be created/filled</p></dd>
<dt>character(len=*), intent(in) <i class="arg">string</i></dt>
<dd><p>Ordinary string to be copied into the text string</p></dd>
</dl></dd>
<dt><a name="11"><b class="cmd">call txt_from_string( text, string )</b></a></dt>
<dd><p>Store the contents of a text_string type in an ordinary string.
If the string is too short, the result will be a truncated string.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(in) <i class="arg">text</i></dt>
<dd><p>Text string to be copied</p></dd>
<dt>character(len=*), intent(out) <i class="arg">string</i></dt>
<dd><p>Ordinary string to be filled</p></dd>
</dl></dd>
<dt><a name="12"><b class="cmd">call txt_read_from_file( lun, text, eof )</b></a></dt>
<dd><p>Read a text string from a file (one complete line).</p>
<dl class="arguments">
<dt>integer, intent(in) <i class="arg">lun</i></dt>
<dd><p>The LU-number of the file</p></dd>
<dt>type(TEXT_STRING), intent(out) <i class="arg">text</i></dt>
<dd><p>Text string to be created/filled</p></dd>
<dt>logical, intent(out) <i class="arg">eof</i></dt>
<dd><p>Indicates whether end-of-file was reached or not</p></dd>
</dl></dd>
<dt><a name="13"><b class="cmd">call txt_write_to_file( lun, text )</b></a></dt>
<dd><p>Write a text string to a file (as one complete line).</p>
<dl class="arguments">
<dt>integer, intent(in) <i class="arg">lun</i></dt>
<dd><p>The LU-number of the file</p></dd>
<dt>type(TEXT_STRING), intent(in) <i class="arg">text</i></dt>
<dd><p>Text string to be written</p></dd>
</dl></dd>
<dt><a name="14"><b class="cmd">call txt_delete( text, pos, length )</b></a></dt>
<dd><p>Delete a substring from a text string.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(inout) <i class="arg">text</i></dt>
<dd><p>Text string to be modified</p></dd>
<dt>integer, intent(in) <i class="arg">pos</i></dt>
<dd><p>Position of the first character to be deleted</p></dd>
<dt>integer, intent(in) <i class="arg">length</i></dt>
<dd><p>Length of the substring to be deleted</p></dd>
</dl></dd>
<dt><a name="15"><b class="cmd">call txt_insert( text, pos, substring )</b></a></dt>
<dd><p>Insert a substring into a string.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(inout) <i class="arg">text</i></dt>
<dd><p>String to be modified</p></dd>
<dt>integer, intent(in) <i class="arg">pos</i></dt>
<dd><p>Position after which to insert the substring (use 0
to insert it before the string)</p></dd>
<dt>character(len=*), intent(in) <i class="arg">substring</i></dt>
<dd><p>Subtring to be inserted</p></dd>
</dl></dd>
</dl>
<p>The module <em>multiline_text</em> contains the following routines:</p>
<dl class="definitions">
<dt><a name="16"><b class="cmd">use multiline_text</b></a></dt>
<dd><p>To import the subroutines, use this module.</p></dd>
<dt><a name="17"><b class="cmd">length = mltxt_length( text )</b></a></dt>
<dd><p>Return the maximum length of all text strings stored. Useful to define
temporary strings.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(in) <i class="arg">text</i></dt>
<dd><p>Multiline text to be examined</p></dd>
</dl></dd>
<dt><a name="18"><b class="cmd">length = mltxt_number( text )</b></a></dt>
<dd><p>Return the number of text strings stored.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(in) <i class="arg">text</i></dt>
<dd><p>Multiline text to be examined</p></dd>
</dl></dd>
<dt><a name="19"><b class="cmd">call mltxt_cleanup( text )</b></a></dt>
<dd><p>Cleans up a multiline text - all text strings are deleted
temporary strings.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(in) <i class="arg">text</i></dt>
<dd><p>Multiline text to be cleaned up</p></dd>
</dl></dd>
<dt><a name="20"><b class="cmd">call mltxt_insert( text, pos, line )</b></a></dt>
<dd><p>Inserts a text string or an ordinary string as a new line of text after
the given position.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(inout) <i class="arg">text</i></dt>
<dd><p>Multiline text to be modified</p></dd>
<dt>integer, intent(in) <i class="arg">pos</i></dt>
<dd><p>Position after which to insert the new line (use 0
to make it the first line)</p></dd>
<dt>(...), intent(in) <i class="arg">line</i></dt>
<dd><p>Ordinary string, text_string or multine_text variable holding the text that will be
inserted.</p></dd>
</dl></dd>
<dt><a name="21"><b class="cmd">call mltxt_delete( text, first, last )</b></a></dt>
<dd><p>Delete the line at the given positions.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(inout) <i class="arg">text</i></dt>
<dd><p>Multiline text to be modified</p></dd>
<dt>integer, intent(in) <i class="arg">first</i></dt>
<dd><p>Position of the first line to be removed.</p></dd>
<dt>integer, intent(in) <i class="arg">last</i></dt>
<dd><p>Position of the last line to be removed (optional, defaults to the first line).</p></dd>
</dl></dd>
<dt><a name="22"><b class="cmd">call mltxt_get( text, pos, line )</b></a></dt>
<dd><p>Return a pointer (!) to the line at the given position.
Note: no copy is made, but a pointer is returned. This means you can
change the line of text via this pointer.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(inout) <i class="arg">text</i></dt>
<dd><p>Multiline text to be examined</p></dd>
<dt>integer, intent(in) <i class="arg">pos</i></dt>
<dd><p>Position of the line to be returned</p></dd>
<dt>type(TEXT_STRING), pointer <i class="arg">line</i></dt>
<dd><p>Variable that will <em>point</em> to the line of text</p></dd>
</dl></dd>
<dt><a name="23"><b class="cmd">call mltxt_read_file( filename, text, error )</b></a></dt>
<dd><p>Read an entire file into a multiline text variable.</p>
<dl class="arguments">
<dt>characer(len=*), intent(in) <i class="arg">lun</i></dt>
<dd><p>The name of the file to be read</p></dd>
<dt>type(TEXT_STRING), intent(out) <i class="arg">text</i></dt>
<dd><p>Text string to be created/filled</p></dd>
<dt>logical, intent(out) <i class="arg">error</i></dt>
<dd><p>Indicates whether an error occurred or not</p></dd>
</dl></dd>
<dt><a name="24"><b class="cmd">call mltxt_write_file( text, filename, error )</b></a></dt>
<dd><p>Write a multiline text variable to a file.</p>
<dl class="arguments">
<dt>type(TEXT_STRING), intent(out) <i class="arg">text</i></dt>
<dd><p>Text string to be created/filled</p></dd>
<dt>characer(len=*), intent(in) <i class="arg">lun</i></dt>
<dd><p>The name of the file to be written</p></dd>
<dt>logical, intent(out) <i class="arg">error</i></dt>
<dd><p>Indicates whether an error occurred or not</p></dd>
</dl></dd>
</dl>
<p>The file <em>textstr_func.f90</em> contains a single module, multiple_line_text_functions,
designed for filtering multiline text:</p>
<dl class="definitions">
<dt><a name="25"><b class="cmd">use multiline_text_functions</b></a></dt>
<dd><p>To import the subroutines, use this module.</p></dd>
<dt><a name="26"><b class="cmd">call mltxt_iterate( text, filter, first, last )</b></a></dt>
<dd><p>Manipulate the contents of a multiline text variable via a user-defined subroutine or object (filter).
Each line within the range is visited once. Lines that get inserted along the way are not examined.</p>
<dl class="arguments">
<dt>type(MULTILINE_TEXT), intent(in) <i class="arg">text</i></dt>
<dd><p>Multiline text to be examined and possibly changed</p></dd>
<dt>subroutine/object filter <i class="arg">filter</i></dt>
<dd><p>Subroutine or object that defines the filter - see below</p></dd>
<dt>integer, intent(in) first <i class="arg">first</i></dt>
<dd><p>The first line to be examined (defaults to 1)</p></dd>
<dt>integer, intent(in) first <i class="arg">last</i></dt>
<dd><p>The last line to be examined (defaults to the last line in the variable <i class="term">text</i>)</p></dd>
</dl>
<p>The subroutine <i class="term">filter</i> has the following interface:</p>
<pre class="example">
    subroutine filter( pos, string, action, text_str, mltxt_str )
        integer, intent(in)          :: pos
        character(len=*), intent(in) :: string
        integer                      :: action
        type(text_string)            :: text_str
        type(multiline_text)         :: mltxt_str
    end subroutine filter
</pre>
<p>where:</p>
<ul class="itemized">
<li><p><i class="term">pos</i> is the current line number</p></li>
<li><p><i class="term">string</i> is the entire text of that line</p></li>
<li><p><i class="term">action</i> is the action to take:</p>
<ul class="itemized">
<li><p><i class="term">mltxt_insert_after_text</i>: insert the contents of the <i class="term">text_str</i> variable after the current line.</p></li>
<li><p><i class="term">mltxt_insert_after_mltxt</i>: insert the contents of the <i class="term">mltxt_str</i> variable after the current line.</p></li>
<li><p><i class="term">mltxt_insert_before_text</i>: insert the contents of the <i class="term">text_str</i> variable before the current line.</p></li>
<li><p><i class="term">mltxt_insert_before_mltxt</i>: insert the contents of the <i class="term">mltxt_str</i> variable before the current line.</p></li>
<li><p><i class="term">mltxt_delete_current</i>: delete the current line</p></li>
<li><p><i class="term">mltxt_replace_text</i>: replace the contents of the current line by that of <i class="term">text_str</i></p></li>
<li><p><i class="term">mltxt_replace_mltxt</i>: replace the contents of the current line by that of <i class="term">mltxt_str</i></p></li>
<li><p><i class="term">mltxt_exit</i>: break off the loop</p></li>
<li><p><i class="term">mltxt_continue</i>: continue with the next line (nothing is changed or added)</p></li>
</ul>
</li>
</ul></dd>
</dl>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2013 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>doc/computing/select_precision.html<|end_filename|>

<html><head>
<title>select_precision - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'computing/select_precision.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2008 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: select_precision.html,v 1.2 2013/05/13 08:03:15 knystrom Exp $ select_precision.n
   -->
<body><div class="doctools">
<h1 class="title">select_precision(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>select_precision - Select the precision for real variables</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The auxiliary <i class="term">select_precision</i> module defines three parameters
by which you can select the precision for real variables and constants:</p>
<ul class="itemized">
<li><p><i class="term">sp</i> - Single precision</p></li>
<li><p><i class="term">dp</i> - Double precision (the real kind whose precision is larger
than that of single precision)</p></li>
<li><p><i class="term">wp</i> - Working precision. If you consistently use <i class="term">wp</i> as the
kind for your real variables and constants, then switching between
single and double precision is merely a matter of setting <i class="term">wp</i> to
either <i class="term">sp</i> or <i class="term">dp</i> in this module and recompiling.</p></li>
</ul>
<p><em>Note:</em> One of the pitfalls in using double precision is that
literal constants, such as <i class="term">1.2345678901234567890</i> are not
automatically interpreted as double precision. You need to specify the
kind explicitly: <i class="term">1.2345678901234567890_wp</i> will define the
constant in the working precision.</p>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2008 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>doc/reporting/m_logger.html<|end_filename|>

<html><head>
<title>flibs/m_vfile - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'reporting/m_logger.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2008 <NAME> <EMAIL>   -- Copyright &copy; 2008 <NAME> <EMAIL>
   -->
<! -- CVS: $Id: m_logger.html,v 1.3 2013/05/13 08:03:20 knystrom Exp $ flibs/m_vfile.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/m_vfile(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/m_vfile - Manage log files</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">OVERVIEW</a></li>
<li class="section"><a href="#section3">STATIC METHODS</a></li>
<li class="section"><a href="#section4">TODO</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="method">log_startup</b> ( <i class="arg">log_file</i> <span class="opt">?, append?</span> )</a></li>
<li><a href="#2"><b class="method">log_shutdown</b> ( )</a></li>
<li><a href="#3"><b class="method">log_msg</b> ( <i class="arg">msg</i> )</a></li>
<li><a href="#4"><b class="method">log_delimiter</b> ( <span class="opt">?level?</span> )</a></li>
<li><a href="#5"><b class="method">log_isinitialized</b> ( ) result ( isinitialized )</a></li>
<li><a href="#6"><b class="method">log_configure</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></li>
<li><a href="#7"><b class="method">log_configure</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></li>
<li><a href="#8"><b class="method">log_configure</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></li>
<li><a href="#9"><b class="method">log_cget</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></li>
<li><a href="#10"><b class="method">log_cget</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></li>
<li><a href="#11"><b class="method">log_cget</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The module <em>m_logger</em> provides static methods to manage a log file,
which is an execution report of the program.</p>
<p>Note that this module, from 2012 onwards, relies on the Fortran 2008 feature
NEWUNIT. The advantage of this feature is that the log file can be opened with
a logical unit number that is guaranteed not to interfer with any other
unit number in the program.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">OVERVIEW</a></h2>
<p>The goal of this component is to provide a way to write messages
both on standard output and on a log file, so that a trace
of the execution can be read by the user after the execution.
The module m_logger therefore provides static methods to</p>
<ul class="itemized">
<li><p>connect a file to the logger,</p></li>
<li><p>configure the logging process, for example disable the standard
output messages,</p></li>
<li><p>log messages.</p></li>
</ul>
<p>The logger must be started up with &quot;log_startup()&quot; and shut down
with &quot;log_shutdown()&quot;.
The static method &quot;log_startup&quot; takes the log file name as first argument :
it main purpose is to connect the logger to the file.
The messages are sent to the logger with the static method &quot;log_msg&quot;.
In the following example, extracted from the unit tests of m_logger
provided with the project, one connects the file &quot;test_m_logger.log&quot; to the
logger, send several messages and shut down the logging system.</p>
<pre class="example">
      call log_startup ( 'test_m_logger.log' )
      call log_msg ( 'First message' )
      call log_msg ( 'Second message' )
      call log_shutdown ()
</pre>
<p>By default, the logging is done both on file and on standard output.
The user may want to configure the behaviour of the logger so that message
are not written on standard output.
The static method &quot;log_configure(option,value)&quot; is the central point to configure the
logger. It takes a character &quot;option&quot; string and a &quot;value&quot; as arguments.
In the following example, one selectively writes
messages on standard output or on file, or both.</p>
<pre class="example">
      call log_startup ( 'test_m_logger.log' )
      call log_configure ( &quot;writeonstdout&quot; , .false. )
      call log_msg( 'This message is written only on file' )
      call log_configure ( &quot;writeonlogfile&quot; , .false. )
      call log_msg( 'This message is written nowhere' )
      call log_configure ( &quot;writeonstdout&quot; , .true. )
      call log_msg( 'This message is written only on screen' )
      call log_configure ( &quot;writeonlogfile&quot; , .true. )
      call log_msg( 'This message is written both on screen and on file' )
      call log_shutdown ()
</pre>
</div>
<div id="section3" class="section"><h2><a name="section3">STATIC METHODS</a></h2>
<dl class="definitions">
<dt><a name="1"><b class="method">log_startup</b> ( <i class="arg">log_file</i> <span class="opt">?, append?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">log_file</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in), optional ::</b> <i class="arg">append</i></dt>
<dd></dd>
</dl>
<p>Initialises the logging management and connect it to the
given <i class="arg">filename</i>.
If <i class="arg">append</i> is present and true, then the logger appends the messages
to the end of the log file.
If <i class="arg">append</i> is present and false, then the initialization of the
logger overwrites the messages of the previous logging session.
If <i class="arg">append</i> is not provided, the default value is append=.true.</p></dd>
<dt><a name="2"><b class="method">log_shutdown</b> ( )</a></dt>
<dd><p>Shutdown the logging management.</p></dd>
<dt><a name="3"><b class="method">log_msg</b> ( <i class="arg">msg</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">msg</i></dt>
<dd></dd>
</dl>
<p>Log the given character string <i class="arg">msg</i> to the logging units.
If the logging to standard output is enabled, writes the message
on standard output.
If the logging to the log file is enabled, writes the message
into the log file.
Before outputting directly the message string, the string is
trimmed, that is to say that all trailing blanks are removed from
the string.
If the time stamp option is enabled, a time stamp with
format &quot;year-month-day hh:mm:ss&quot; is inserted before the message.</p></dd>
<dt><a name="4"><b class="method">log_delimiter</b> ( <span class="opt">?level?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer , intent(in), optional ::</b> <i class="arg">level</i></dt>
<dd></dd>
</dl>
<p>Log a delimiter of given level.
Available values for level are : LOG_LEVEL_VOLUME,
LOG_LEVEL_CHAPTER, LOG_LEVEL_SECTION, LOG_LEVEL_SUBSECTION
If level is not provided, the default value for level is LOG_LEVEL_VOLUME.</p></dd>
<dt><a name="5"><b class="method">log_isinitialized</b> ( ) result ( isinitialized )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">logical ::</b> <i class="arg">isinitialized</i></dt>
<dd></dd>
</dl>
<p>Returns true if the logger is allready initialized.
Note: that method may be useful in the case where several components
use the logger and both contain a call to log_startup.</p></dd>
<dt><a name="6"><b class="method">log_configure</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">option</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Set the logical static <i class="arg">option</i> of the component to <i class="arg">value</i>.
The <i class="arg">option</i> may be one of the following.</p>
<ul class="itemized">
<li><p><i class="arg">option</i> = &quot;timestamp&quot; :
Disable or enable the insertion of time stamps.
If the time stamp option is enabled, a time stamp with
format &quot;year-month-day hh:mm:ss&quot; is inserted before the message.</p></li>
<li><p><i class="arg">option</i> = &quot;writeonstdout&quot; :
Disable or enable the writing on standard output.</p></li>
<li><p><i class="arg">option</i> = &quot;writeonlogfile&quot; :
Disable or enable the writing on log file.</p></li>
<li><p><i class="arg">option</i> = &quot;stoponerror&quot; :
Configure the behaviour of the component whenever an
error is met.
If stoponerror is true, then the execution stops if an error is encountered.
If stoponerror is false, then the execution continues if an error is encountered.
In both cases, a message is displayed on standard output.</p></li>
</ul></dd>
<dt><a name="7"><b class="method">log_configure</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">option</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(in) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Configure the integer static option of the component.
The <i class="arg">option</i> may be one of the following.</p>
<ul class="itemized">
<li><p><i class="arg">option</i> = &quot;logfileunit&quot; :
Force the logical unit for logging to be <i class="arg">value</i>.
Use this feature with caution, since the original
logical unit is lost.</p></li>
</ul></dd>
<dt><a name="8"><b class="method">log_configure</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">option</i></dt>
<dd></dd>
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Set the character static &quot;option&quot; of the component to &quot;value&quot;.
The &quot;option&quot; may be one of the following.</p>
<ul class="itemized">
<li><p><i class="arg">option</i> = &quot;level_string_volume&quot;
Set the string used for volume delimiter.</p></li>
<li><p><i class="arg">option</i> = &quot;level_string_chapter&quot;
Set the string used for chapter delimiter.</p></li>
<li><p><i class="arg">option</i> = &quot;level_string_section&quot;
Set the string used for section delimiter.</p></li>
<li><p><i class="arg">option</i> = &quot;level_string_subsection&quot;
Set the string used for subsection delimiter.</p></li>
</ul></dd>
<dt><a name="9"><b class="method">log_cget</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">option</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Get the logical static &quot;option&quot; of the component.
The <i class="arg">option</i> may be one of the following.</p>
<ul class="itemized">
<li><p><i class="arg">option</i> = &quot;timestamp&quot; :
Current value of the option to enable / disable insertion of time stamps.</p></li>
<li><p><i class="arg">option</i> = &quot;writeonstdout&quot; :
Current value of the option to enable / disable writing on standard output.</p></li>
<li><p><i class="arg">option</i> = &quot;writeonlogfile&quot; :
Current value of the option to enable / disable writing on log file.</p></li>
<li><p><i class="arg">option</i> = &quot;stoponerror&quot; :
Current value of the option to enable / disable stopping when an error is met.</p></li>
</ul></dd>
<dt><a name="10"><b class="method">log_cget</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">option</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(in) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Get the integer static &quot;option&quot; of the component.</p>
<ul class="itemized">
<li><p><i class="arg">option</i> = &quot;logfileunit&quot; :
Current logical unit connected to the logging system.</p></li>
</ul></dd>
<dt><a name="11"><b class="method">log_cget</b> ( <i class="arg">option</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character ( len = * ) , intent(in) ::</b> <i class="arg">option</i></dt>
<dd></dd>
<dt><b class="type">character ( len = * ) , intent(out) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Get the character static &quot;option&quot; of the component.
The &quot;option&quot; may be one of the following.</p>
<ul class="itemized">
<li><p><i class="arg">option</i> = &quot;level_string_volume&quot;
Get the string used for volume delimiter.</p></li>
<li><p><i class="arg">option</i> = &quot;level_string_chapter&quot;
Get the string used for chapter delimiter.</p></li>
<li><p><i class="arg">option</i> = &quot;level_string_section&quot;
Get the string used for section delimiter.</p></li>
<li><p><i class="arg">option</i> = &quot;level_string_subsection&quot;
Get the string used for subsection delimiter.</p></li>
</ul></dd>
</dl>
</div>
<div id="section4" class="section"><h2><a name="section4">TODO</a></h2>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2008 <NAME> <EMAIL><br>
Copyright &copy; 2008 <NAME> <EMAIL></p>
</div>
</div></body></html>

<|start_filename|>doc/platform/m_platform.html<|end_filename|>

<html><head>
<title>flibs/m_platform - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'platform/m_platform.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2008 <NAME> &lt;<EMAIL>&gt;   -- Copyright &copy; 2008 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: m_platform.html,v 1.4 2013/05/13 08:03:19 knystrom Exp $ flibs/m_platform.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/m_platform(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/m_platform - Platform-dependent routines and features</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">OVERVIEW</a>
<ul>
<li class="subsection"><a href="#subsection1">Pre-processing macros</a></li>
<li class="subsection"><a href="#subsection2">Compile</a></li>
<li class="subsection"><a href="#subsection3">Operating System dependency</a></li>
<li class="subsection"><a href="#subsection4">System fortran extension</a></li>
<li class="subsection"><a href="#subsection5">Environment variables extension</a></li>
<li class="subsection"><a href="#subsection6">Change directory fortran extension</a></li>
<li class="subsection"><a href="#subsection7">File stat fortran extension</a></li>
<li class="subsection"><a href="#subsection8">Example of compiler settings</a></li>
</ul>
</li>
<li class="section"><a href="#section3">ROUTINES</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">use m_platform</b></a></li>
<li><a href="#2"><b class="cmd">platform_system</b> (<i class="arg">command</i> <span class="opt">?, status?</span>)</a></li>
<li><a href="#3"><b class="cmd">platform_get_os()</b> result ( currentos )</a></li>
<li><a href="#4"><b class="cmd">platform_osstring</b> (<i class="arg">currentos</i>)</a></li>
<li><a href="#5"><b class="cmd">platform_get_platform()</b> result ( currentplatform )</a></li>
<li><a href="#6"><b class="cmd">platform_platformstring</b> (<i class="arg">currentplatform</i>)</a></li>
<li><a href="#7"><b class="cmd">platform_get_environment_variable</b> ( <i class="arg">envvar</i> <i class="arg">, value</i>)</a></li>
<li><a href="#8"><b class="cmd">platform_cd</b> ( <i class="arg">dirname</i> <span class="opt">?, status?</span>)</a></li>
<li><a href="#9"><b class="cmd">platform_stat</b> ( <i class="arg">filename</i> <i class="arg">, statarray</i> <span class="opt">?, status?</span>)</a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <em>m_platform</em> module contains parameters to identify the
platform the program is running on and provides 
several routines to interact with the operating system.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">OVERVIEW</a></h2>
<p>The goal is to make the client source code as independent as possible
from the particular environment, that is</p>
<ul class="itemized">
<li><p>independent from the operating system, so that the 
binaries can be used under Windows, Linux or any other
specific OS without modifying the source code,</p></li>
<li><p>independent from the fortran compiler, so that the 
binaries can be generated with gfortran Intel Fortran, Absoft,
or any other specific compiler without modifying the source code.</p></li>
</ul>
<p>For instance, the <em>m_platform</em> module provides the 
following features :</p>
<ul class="itemized">
<li><p>The parameter PLATFORM_OS identifies the operating system and the
parameter PLATFORM_PLATFORM identifies the general category.</p></li>
<li><p>The subroutine platform_system() hides the platform-specific details of
running an external command or program.</p></li>
</ul>
<p>The function platform_get_os() returns an integer which identifies
the operating system and the function platform_get_platform() identifies
the general category.
For example, the file separator is different on windows (&quot;\&quot;),
unix (&quot;/&quot;) and Mac (&quot;:&quot;). In the following example, extracted from the
m_vfile module included with flibs, the platform_get_platform()
function is used to configure the separator for the current platform.</p>
<pre class="example">
     use m_platform, only : &amp;
       platform_get_platform , &amp;
       PLATFORM_PLATFORM_WINDOWS ,&amp;
       PLATFORM_PLATFORM_UNIX , &amp;
       PLATFORM_PLATFORM_MAC
     integer :: platform
     character (len=1) :: VFILE_PLATFORM_SEPARATOR
     platform = platform_get_platform ()
     select case ( platform )
     case ( PLATFORM_PLATFORM_WINDOWS )
       VFILE_PLATFORM_SEPARATOR = VFILE_PLATFORM_SEPARATOR_WINDOWS
     case ( PLATFORM_PLATFORM_UNIX )
       VFILE_PLATFORM_SEPARATOR = VFILE_PLATFORM_SEPARATOR_UNIX
     case ( PLATFORM_PLATFORM_MAC )
       VFILE_PLATFORM_SEPARATOR = VFILE_PLATFORM_SEPARATOR_MAC
     case default
       print *, &quot;I come from Vega.&quot;
       return
     end select
</pre>
<p>The subroutine platform_system() allows to execute an external program at the 
   system level. This routine is generally provided by the fortran compiler as an
   extension to standard fortran. But some compilers provide the feature
   as a subroutine (for example gfortran), while other compilers provide the 
   feature as a function (for example Intel Fortran). In the following example,
   one execute a Monte-Carlo simulation with no dependency on the specific 
   compiler.</p>
<pre class="example">
      use m_platform, only platform_system
      call platform_system ( &quot;montecarlo.exe&quot; , status )
</pre>
<p>This is a sketch of available routines :</p>
<ul class="itemized">
<li><p>platform_system                       Executes an external command on the system</p></li>
<li><p>platform_get_os                       Returns the current operating system</p></li>
<li><p>platform_get_platform                 Returns the current platform</p></li>
<li><p>platform_get_environment_variable     Get to one environment variable</p></li>
<li><p>platform_cd                           Change the system current directory</p></li>
<li><p>platform_stat                         Get status of a file</p></li>
</ul>
<div id="subsection1" class="subsection"><h3><a name="subsection1">Pre-processing macros</a></h3>
<p>The source code of m_platform is based on pre-processing macro,
which must be configured for the specific couple (OS,compiler) at use.
With most compilers, defining a pre-processing macro simply
consists in enabling the pre-processing with a specific
option and adding &quot;-D&lt;macro&gt;&quot; options on the command-line.</p>
<p>The only mandatory pre-processing macro which must be defined is
the _PLATFORM_OS_&lt;your OS&gt; macro.
Optionnaly, other pre-processing macros may be defined so that
the client code may access to additionnal features.
If a feature is used and the associated macros have not
been defined, the &quot;status&quot; integer of the associated routine
will have the value PLATFORM_ERROR_UNDEFINED_SERVICE.</p>
</div>
<div id="subsection2" class="subsection"><h3><a name="subsection2">Compile</a></h3>
<p>The &quot;make&quot; directory provided with flibs should help the 
use to compile m_platform. The &quot;make/makefile&quot; contains all the 
makefiles necessary for the project, include specific settings
for several compilers. the &quot;make/visualstudio&quot; directory include 
all projects .nfproj and solutions .sln files necessary to 
compile the project with Intel Fortran 8 and Visual Studio 2003.</p>
</div>
<div id="subsection3" class="subsection"><h3><a name="subsection3">Operating System dependency</a></h3>
<p>The m_platform module <em>must</em> be informed of the specific OS for which
it is compiled. One of the following pre-processing macros <em>must</em> be
defined to set the spefic OS at use :</p>
<ul class="itemized">
<li><p>_PLATFORM_OS_WINDOWS_95</p></li>
<li><p>_PLATFORM_OS_WINDOWS_NT</p></li>
<li><p>_PLATFORM_OS_MAC</p></li>
<li><p>_PLATFORM_OS_SUN</p></li>
<li><p>_PLATFORM_OS_LINUX</p></li>
<li><p>_PLATFORM_OS_UNIX</p></li>
</ul>
</div>
<div id="subsection4" class="subsection"><h3><a name="subsection4">System fortran extension</a></h3>
<p>The SYSTEM fortran extension allows to execute an external program.
Depending on the compiler, the SYSTEM fortran extension is provided
as a subroutine or a function. The m_platform module <em>may</em> be informed
of the particular version of the SYSTEM extension at use and one
of the following pre-processing macro must be defined :</p>
<ul class="itemized">
<li><p>_PLATFORM_SYSTEM_SUBROUTINE</p></li>
<li><p>_PLATFORM_SYSTEM_FUNCTION</p></li>
</ul>
<p>See in your compiler manual for the specific settings.
 For example, this is a short list of compilers and the
 SYSTEM provided :</p>
<ul class="itemized">
<li><p>function : Intel Fortran, g95.</p></li>
<li><p>subroutine : gfortran,</p></li>
</ul>
</div>
<div id="subsection5" class="subsection"><h3><a name="subsection5">Environment variables extension</a></h3>
<p>The fortran 2003 standard introduces a standard way of accessing
 to the environment variables. Older compilers does not match
 that standard but provide extensions to access to environment variables.
 To inform the m_platform module of the particular environment
 variable extension, one of the following pre-processing macro <em>may</em>
 be defined :</p>
<ul class="itemized">
<li><p>_PLATFORM_INTEL_FORTRAN_PORTABILITY_ROUTINES</p></li>
<li><p>_PLATFORM_FORTRAN_2003</p></li>
</ul>
</div>
<div id="subsection6" class="subsection"><h3><a name="subsection6">Change directory fortran extension</a></h3>
<p>Depending on the compiler, the &quot;CHDIR&quot; fortran extension is provided
as a subroutine or a function.
To inform the m_platform module of the particular CHDIR extension,
one of the following pre-processing macro <em>may</em> be defined :</p>
<ul class="itemized">
<li><p>_PLATFORM_CHDIR_SUBROUTINE</p></li>
<li><p>_PLATFORM_CHDIR_FUNCTION</p></li>
</ul>
<p>See in your manual for the specific settings.
For example, this is a short list of compilers and their particular
CHDIR provided :</p>
<ul class="itemized">
<li><p>function : Intel Fortran, g95, gfortran</p></li>
<li><p>subroutine : gfortran</p></li>
</ul>
</div>
<div id="subsection7" class="subsection"><h3><a name="subsection7">File stat fortran extension</a></h3>
<p>Depending on the compiler, the &quot;STAT&quot; fortran extension is
provided as a subroutine or a function.
For example, this is a short list of compilers and their particular
STAT provided :</p>
<ul class="itemized">
<li><p>function : Intel Fortran, g95</p></li>
<li><p>subroutine : gfortran</p></li>
</ul>
<p>To inform the m_platform module of the particular STAT extension,
one of the following pre-processing macro <em>may</em> be defined :</p>
<ul class="itemized">
<li><p>_PLATFORM_STAT_SUBROUTINE</p></li>
<li><p>_PLATFORM_STAT_FUNCTION</p></li>
</ul>
</div>
<div id="subsection8" class="subsection"><h3><a name="subsection8">Example of compiler settings</a></h3>
<p>This is an abstract of all pre-processing macros for several compilers.</p>
<p>Compiler : <em>gfortran</em></p>
<ul class="itemized">
<li><p>_PLATFORM_FORTRAN_2003</p></li>
<li><p>_PLATFORM_CHDIR_SUBROUTINE</p></li>
<li><p>_PLATFORM_STAT_SUBROUTINE</p></li>
<li><p>_PLATFORM_SYSTEM_SUBROUTINE</p></li>
</ul>
<p>Compiler : <em>Intel Fortran</em></p>
<ul class="itemized">
<li><p>_PLATFORM_INTEL_FORTRAN_PORTABILITY_ROUTINES</p></li>
<li><p>_PLATFORM_CHDIR_FUNCTION</p></li>
<li><p>_PLATFORM_STAT_FUNCTION</p></li>
<li><p>_PLATFORM_SYSTEM_FUNCTION</p></li>
</ul>
<p>Compiler : <em>g95</em></p>
<ul class="itemized">
<li><p>_PLATFORM_FORTRAN_2003</p></li>
<li><p>_PLATFORM_CHDIR_FUNCTION</p></li>
<li><p>_PLATFORM_STAT_FUNCTION</p></li>
<li><p>_PLATFORM_SYSTEM_FUNCTION</p></li>
</ul>
</div>
</div>
<div id="section3" class="section"><h2><a name="section3">ROUTINES</a></h2>
<p>The module contains the following routines.</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">use m_platform</b></a></dt>
<dd><p>To import the subroutines, use this module.</p></dd>
<dt><a name="2"><b class="cmd">platform_system</b> (<i class="arg">command</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*) ::</b> <i class="arg">command</i></dt>
<dd></dd>
<dt><b class="type">integer, intent ( out ), optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Run an external command or program, optionally retrieving the status of
that command. Under Windows the &quot;call system&quot; may generate the display of a console.
Optional argument <i class="arg">status</i> contains the execution status. 
Notice that the information contained
in it is not very reliable - some systems do not give any information.
The <i class="arg">command</i> to run is quite likely platform-dependent.</p></dd>
<dt><a name="3"><b class="cmd">platform_get_os()</b> result ( currentos )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer ::</b> <i class="arg">currentos</i></dt>
<dd></dd>
</dl>
<p>Return the type of operating system, one of:
PLATFORM_OS_WINDOWS_95, PLATFORM_OS_WINDOWS_NT,
PLATFORM_OS_MACOS, PLATFORM_OS_SUNOS, PLATFORM_OS_LINUX,
PLATFORM_OS_UNIX.
The actual integer value should not be used directly ; instead, it
should be compared against the PLATFORM_OS_* public variables.</p></dd>
<dt><a name="4"><b class="cmd">platform_osstring</b> (<i class="arg">currentos</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(out) ::</b> <i class="arg">currentos</i></dt>
<dd></dd>
</dl>
<p>Returns a string containing the current operating system running on the current machine,
one of &quot;Windows 95&quot;, &quot;Windows NT&quot;, &quot;MacOS&quot;, &quot;SunOS&quot;, 
&quot;Linux&quot; or &quot;Unix&quot;.</p></dd>
<dt><a name="5"><b class="cmd">platform_get_platform()</b> result ( currentplatform )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer ::</b> <i class="arg">currentplatform</i></dt>
<dd></dd>
</dl>
<p>Return the category of platform, one of:
PLATFORM_PLATFORM_WINDOWS, PLATFORM_PLATFORM_MAC, PLATFORM_PLATFORM_UNIX
The actual integer value should not be used directly ; instead, it
should be compared against the PLATFORM_PLATFORM_* public variables.</p></dd>
<dt><a name="6"><b class="cmd">platform_platformstring</b> (<i class="arg">currentplatform</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(out) ::</b> <i class="arg">currentplatform</i></dt>
<dd></dd>
</dl>
<p>Returns a string containing the current platform running on the current machine,
one of &quot;Windows&quot;, &quot;Mac&quot;, &quot;Unix&quot;.</p></dd>
<dt><a name="7"><b class="cmd">platform_get_environment_variable</b> ( <i class="arg">envvar</i> <i class="arg">, value</i>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*) ::</b> <i class="arg">envvar</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) ::</b> <i class="arg">value</i></dt>
<dd></dd>
</dl>
<p>Retrieve the value of the environment variable <i class="arg">envvar</i>. There is no indication of
whether the variable indeed exists and it is up to the calling program
to provide a string argument sufficiently long to hold the value.
The environment variable <i class="arg">envvar</i> is case-sensitive on
some platforms, case-insensitive on others. This is entirely up to the
platform.
As the underlying routines give no indication of the existence 
of the environment variable, it is probably best to
fill the <i class="arg">value</i> with a known value first (like: &quot;????&quot;) 
to check it.</p></dd>
<dt><a name="8"><b class="cmd">platform_cd</b> ( <i class="arg">dirname</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">dirname</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Change working directory to <i class="arg">dirname</i>. 
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return</p></dd>
<dt><a name="9"><b class="cmd">platform_stat</b> ( <i class="arg">filename</i> <i class="arg">, statarray</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, dimension (1:13) , intent(out)  ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Get status of the file <i class="arg">filename</i> and fills the array <i class="arg">statarray</i>
with the following content.</p>
<ul class="itemized">
<li><p>statarray(1) Device ID</p></li>
<li><p>statarray(2) Inode number</p></li>
<li><p>statarray(3) File mode</p></li>
<li><p>statarray(4) Number of links</p></li>
<li><p>statarray(5) Owner's uid</p></li>
<li><p>statarray(6) Owner's gid</p></li>
<li><p>statarray(7) ID of device containing directory entry for file (0 if not available)</p></li>
<li><p>statarray(8) File size (bytes)</p></li>
<li><p>statarray(9) Last access time</p></li>
<li><p>statarray(10) Last modification time</p></li>
<li><p>statarray(11) Last file status change time</p></li>
<li><p>statarray(12) Preferred I/O block size (-1 if not available)</p></li>
<li><p>statarray(13) Number of blocks allocated (-1 if not available)</p></li>
</ul>
<p>If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return</p></dd>
</dl>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2008 <NAME> &lt;<EMAIL>&gt;<br>
Copyright &copy; 2008 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>chkfeatures/chk_opentwice.f90<|end_filename|>
! chk_opentwice.f90 --
!     Check: does the compiler support opening the same file on two different units?
!
!     Note: this is an extension to the standard
!
program chk_opentwice
    implicit none

    integer :: i, ierr
    integer :: value1
    integer :: value2
    integer :: lun1 = 10
    integer :: lun2 = 20
    logical :: opened


    !
    ! First create a file that we can read
    !
    open( lun1, file = 'chk_opentwice.inp' )
    write( lun1, '(i0)' ) (i ,i=1,10)
    close( lun1 )

    !
    ! Now open it on lun1 and read the third number
    !
    open( lun1, file = 'chk_opentwice.inp' )
    read( lun1, * ) (value1 , i=1,3)

    !
    ! Now open it again on lun2 and read a single value
    !
    open( lun2, file = 'chk_opentwice.inp', iostat = ierr )

    if ( ierr /= 0 ) then
        write( *, '(a)' ) 'Error opening the file again - extension not supported'
        stop
    endif

    !
    ! If all went well, try reading via both LU-numbers
    !
    read( lun2, * ) value2

    read( lun1, *, iostat = ierr ) value1 ! Expecting the value 4, if the extension is supported

    !
    ! Is the file still open on lun1?
    !
    inquire( lun1, opened = opened )

    if ( opened ) then
        write( *, '(a)'    ) 'File could be opened independently on a second unit'
        write( *, '(a,i0)' ) '    Value from the second unit: ', value2
        if ( value2 == 1 ) then
            write( *, '(a,i0)' ) '    Value is 1, as expected'
        else
            write( *, '(a,i0)' ) '    BUT: value should have been 1!'
        endif
        if ( ierr /= 0 ) then
            write( *, '(a,i0)' ) '    BUT: reading the file on the first unit gave an error!'
        elseif ( value1 /= 4 ) then
            write( *, '(a,i0)' ) '    BUT: reading the file on the first unit gave an unexpected value!'
            write( *, '(a,i0)' ) '         value read:       ', value1
            write( *, '(a,i0)' ) '         should have been: ', 4
        else
            write( *, '(a,i0)' ) '    Value from the first unit: ', value1
            write( *, '(a,i0)' ) '    Value is 4, as expected'
            write( *, '(a)'    ) 'The extension is supported'
        endif
    else
        write( *, '(a)'    ) 'File can NOT be opened independently on a second unit'
    endif
end program chk_opentwice


<|start_filename|>tests/reporting/test_m_logger.f90<|end_filename|>
! test_logging.f90 --
!     Small test program for the report module
!
!     $Id: test_m_logger.f90,v 1.2 2012/11/27 07:36:53 arjenmarkus Exp $
!
program test_logging
  use m_logger
  implicit none

  integer :: logunit, i

  integer, pointer :: stop_program => null()

  !
  ! Initialize the log file with append disabled.
  !
  call log_startup( 'test_m_logger.log', append=.false.)
  call log_configure ( "timestamp" , .true. )
  call log_msg( 'First message' )
  call log_msg( 'Second message' )
  call log_shutdown ()
  !
  ! Messages will be appended
  !
  call log_startup( 'test_m_logger.log' )
  call log_configure ( "timestamp" , .false. )
  call log_msg( 'Second part: no timestamp' )
  call log_msg( 'First message' )
  call log_msg( 'Second message' )
  !
  ! Add delimiter to structure the log file
  !
  call log_delimiter( LOG_LEVEL_VOLUME )
  call log_msg( 'Volume title' )
  call log_delimiter( LOG_LEVEL_CHAPTER )
  call log_msg( 'Chapter title' )
  call log_delimiter( LOG_LEVEL_SECTION )
  call log_msg( 'Section title' )
  call log_delimiter( LOG_LEVEL_SUBSECTION )
  call log_msg( 'Subsection title' )
  !
  ! Get the log unit and write directly to the logfile
  !
  call log_cget ( "logfileunit" , logunit)
  write ( logunit , "(A)") "This is my manually written message, written only on file"
  !
  ! Enable / disable writing on file/standard output
  !
  call log_configure ( "writeonstdout" , .false. )
  call log_msg( 'This message is written only on file' )
  call log_configure ( "writeonlogfile" , .false. )
  call log_msg( 'This message is written nowhere' )
  call log_configure ( "writeonstdout" , .true. )
  call log_msg( 'This message is written only on screen' )
  call log_configure ( "writeonlogfile" , .true. )
  call log_msg( 'This message is written both on screen and on file' )
  call log_shutdown ()
  !
  ! Check that we cannot init two times.
  !
  call log_configure ( "stoponerror" , .false. )
  call log_startup( 'test_m_logger2.log' )
  call log_startup( 'test_m_logger2.log' )
  call log_shutdown ()

  !
  ! Abort the program to test that the log file is properly flushed
  !
  call log_startup( 'test_m_logger.log', append = .true. )
  call log_msg( 'Before expressly aborting the program' )
  write( *, '(a)' ) ' '
  write( *, '(a)' ) 'Warning: the program will abort now - this is intentional'
  write( *, '(a)' ) 'On some systems an error or even a trace back will be printed,'
  write( *, '(a)' ) 'on others you may invited to use the debugger to see what went wrong'
  write( *, '(a)' ) ' '
  write( *, '(a)' ) 'Check that the log file "test_m_logger.log" is complete, whereas the'
  write( *, '(a)' ) 'file "test_m_logger.out" is not'

  open( 10, file = 'test_m_logger.out' )
  do i = 1,100
      write( 10, * ) 'This file is supposed to be truncated - hopefully it is'
  enddo
  stop_program = 10 ! Uninitialised pointer - it will cause the program to fail
  write( 10, * ) 'Value: ', stop_program
  write( 10, * ) 'End of program'
  call log_msg( 'Program aborted - this will not appear in the log' )

end program test_logging


<|start_filename|>doc/computing/unsigned.html<|end_filename|>

<html><head>
<title>unsigned_integers - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'computing/unsigned.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2010 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: unsigned.html,v 1.1 2012/01/22 19:52:33 arjenmarkus Exp $ unsigned_integers.n
   -->
<body><div class="doctools">
<h1 class="title">unsigned_integers(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>unsigned_integers - Implement operations with unsigned integers</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">use unsigned_integers</b></a></li>
<li><a href="#2"><b class="cmd">c = a .udiv. b</b></a></li>
<li><a href="#3"><b class="cmd">compare = a .ult. b</b></a></li>
<li><a href="#4"><b class="cmd">string = to_string( a )</b></a></li>
<li><a href="#5"><b class="cmd">a = to_unsigned( string )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <em>unsigned_integers</em> module provides a number of operations that emulate
unsigned integers in Fortran. For some applications unsigned integers are very useful.
The module uses <em>ordinary</em> integers as the basic data type and adds only those
operations that differ between signed and unsigned integers:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">use unsigned_integers</b></a></dt>
<dd><p>The name of the module. The module does not use any others.</p></dd>
<dt><a name="2"><b class="cmd">c = a .udiv. b</b></a></dt>
<dd><p>Division with <em>a</em> and <em>b</em> interpreted as unsigned integers.
(Both should be declared as ordinary integers!)</p></dd>
<dt><a name="3"><b class="cmd">compare = a .ult. b</b></a></dt>
<dd><p>Compare two &quot;unsigned&quot; integers and return the result as a logical.
The result is true if <em>a</em> is smaller than <em>b</em>.</p>
<p>Similarly: <em>.ule.</em>, <em>.ugt.</em> and <em>.uge.</em> are the unsigned equivalents of
<em>.le.</em>, <em>.gt.</em> and <em>.ge.</em>.</p></dd>
<dt><a name="4"><b class="cmd">string = to_string( a )</b></a></dt>
<dd><p>Return a string representing the &quot;unsigned&quot; integer <em>a</em>.</p></dd>
<dt><a name="5"><b class="cmd">a = to_unsigned( string )</b></a></dt>
<dd><p>Return an &quot;unsigned&quot; integer from a string. (Accepts &quot;-1&quot; and &quot;2147483648&quot; represent the
unsigned value 2147483648.</p></dd>
</dl>
<p>All other operations, including left and right bit shifts (in Fortran), give the same results
for unsigned integers as for signed integers, so that you can safely use the standard operations.
The only caveat is that this presumes two's-complement integers, but those are ubiquitous.</p>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2010 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>tests/funit/test_ftnunit.f90<|end_filename|>
! test_ftnunit.f90 --
!     Program to demonstrate the use of the "ftnunit" framework:
!     It is inspired by the well-known JUnit framework for
!     integrating unit tests in a Java application.
!
!     The program that is being tested is built from three
!     subroutines:
!     - open_files
!     - process_data
!     - report_results
!     The idea is simple:
!     Read a file with data (one number per line) and
!     report some basic statistics.
!
!     While it is a small program, so that it could easily
!     do without separate routines, splitting it into routines
!     makes setting up unit tests much easier.
!
!     The unit tests consist of:
!     1. Try to read a non-existing data file
!     2. Try to read an empty data file
!     3. Try to read a file that does not just contain numbers
!     4. Read a regular file with numbers
!
!     To illustrate the way run-time errors are handled via
!     the framework, some of these tests result in runtime errors
!
!     $Id: test_ftnunit.f90,v 1.8 2012/03/13 13:01:37 arjenmarkus Exp $
!
module data_processing
    implicit none

contains

! open_files --
!     Subroutine to read the file names and open them
! Arguments:
!     None
! Side effects:
!     The input file with data is opened at LUN 10,
!     the report file is opened at LUN 20
!
subroutine open_files
    character(len=40) :: infile
    integer           :: ierr

    open( 10, file = 'test_ftnunit.inp' )
    open( 20, file = 'test_ftnunit.out' )
    read( 10, '(a)' ) infile
    close( 10 )

    open( 11, file = infile, status = 'old', iostat = ierr )

    if ( ierr /= 0 ) then
        write( 20, * ) 'Input file could not be opened:'
        write( 20, * ) '    ', infile
        write( 20, * ) 'Stopping the program'
        stop
    endif
end subroutine

! process_data --
!     Subroutine to read the data file and produce the statistics
! Arguments:
!     nodata            Number of data
!     vmean             Mean value
!     vmin              Minimum value
!     vmax              Maximum value
!
subroutine process_data( nodata, vmean, vmin, vmax )
    integer, intent(out)  :: nodata
    real, intent(out)     :: vmean
    real, intent(out)     :: vmin
    real, intent(out)     :: vmax

    real                  :: value

    nodata = 0
    vmean  = 0.0
    vmin   = 0.0
    vmax   = 0.0

    !
    ! This loop will fail with invalid data
    !
    do
        read( 11, *, end = 900 ) value

        if ( nodata == 0 ) then
            vmin = value
            vmax = value
        else
            vmin = min( vmin, value )
            vmax = max( vmax, value )
        endif

        nodata = nodata + 1
        vmean  = vmean  + value

    enddo

900 continue
    vmean = vmean / nodata  ! This will fail with an empty file
end subroutine

! report_results --
!     Subroutine to write the output
! Arguments:
!     nodata            Number of data
!     vmean             Mean value
!     vmin              Minimum value
!     vmax              Maximum value
!
subroutine report_results( nodata, vmean, vmin, vmax )
    integer, intent(in)  :: nodata
    real, intent(in)     :: vmean
    real, intent(in)     :: vmin
    real, intent(in)     :: vmax

    if ( nodata > 0 ) then
        write( 20, '(a,i5)'    ) 'Number of data: ', nodata
        write( 20, '(a,f10.5)' ) 'Mean value:     ', vmean
        write( 20, '(a,f10.5)' ) 'Minimum value:  ', vmin
        write( 20, '(a,f10.5)' ) 'Maximum value:  ', vmax
    else
        write( 20, '(a,i5)' ) 'The file was empty - no data were read'
    endif
    close( 20 )
end subroutine

end module data_processing


! dataproc_testing --
!     Module for defining the unit tests
!
!     Expected routines:
!     - prolog: common code for preparing the unit tests
!     - epilog: common code for cleaning up the unit tests
!     - test: use the appropriate include file
!     - test_all (or a similar name): run the individual tests
!
!     All other routines form individual unit tests
!
module dataproc_testing
    use ftnunit
    use data_processing
    implicit none
    private                 ! This is needed to make sure we can easily
    public :: test_all      ! use several such modules. The only external
                            ! names are "test_all" and "test_extra"
    public :: test_extra

    character(len=40) :: datafile
contains

subroutine prolog
    ! Nothing in this case
end subroutine prolog

subroutine epilog
    ! Remove the data file
    call ftnunit_remove_file( datafile )
end subroutine epilog


! test_all --
!     Routine that simply runs all unit tests via the
!     general routine "test"
! Arguments:
!     None
!
subroutine test_all

    call test( test_no_file, "Read non-existent file" )
    call test( test_empty_file, "Read an empty file" )
    call test( test_program_stop, "Stop the program - and expect it to stop" )
    call test( test_program_does_not_stop, "Stop the program - but it does not" )
    call test( test_invalid_file, "Read an invalid file" )
    call test( test_ordinary_file, "Read an ordinary file" )
    call test( test_compare_files, "Comparing two files" )
end subroutine test_all

subroutine test_extra
    call test( test_ignored_test, "Test is skipped", .true. )
    call test( test_deliberate_failure, "Test fails deliberately" )
    call test( test_compare_reals, "Comparing real numbers" )
    call test( test_deliberate_stop, "Expected stop" )

end subroutine test_extra

! write_name --
!     Small auxiliary routine (write the file with the file name)
! Arguments:
!     name         Name of the file
! Side effects:
!     Store the name in the datafile variable, so that it
!     can later be removed.
!
subroutine write_name( name )
    character(len=*) :: name

    open(  11, file = 'test_ftnunit.inp' )
    write( 11, '(a)' ) name
    close( 11 )

    datafile = name
end subroutine write_name

! test_no_file --
!     Test: try to read a file that does not exist
! Arguments:
!     None
!
subroutine test_no_file

    integer :: nodata
    real    :: vmean, vmin, vmax

    call ftnunit_remove_file( 'no_such_file' )
    call write_name( 'no_such_file' )

    call open_files
    call process_data( nodata, vmean, vmax, vmin )

    call assert_true( nodata == 0, "No data read" )

end subroutine test_no_file

! test_empty_file --
!     Test: try to read a file that is empty
! Arguments:
!     None
!
subroutine test_empty_file

    integer :: nodata
    real    :: vmean, vmin, vmax

    call ftnunit_make_empty_file( 'empty_file' )
    call write_name( 'empty_file' )

    call open_files
    call process_data( nodata, vmean, vmax, vmin )

    call assert_true( nodata == 0, "No data read" )

end subroutine test_empty_file

! test_program_stop --
!     Test: the test indicates the program should stop -
!     this is to be expected and it must be recorded as such
! Arguments:
!     None
!
subroutine test_program_stop

    call expect_program_stop

    !
    ! Typical situation:
    ! The program stops because it has detected a fatal
    ! error of some kind
    ! The ftnunit framework should report this as OK
    !
    stop

end subroutine test_program_stop

! test_program_does_not_stop --
!     Test: the test indicates the program should stop -
!     but it does not - this should be recorded as a failure
! Arguments:
!     None
!
subroutine test_program_does_not_stop

    call expect_program_stop

end subroutine test_program_does_not_stop

! test_invalid_file --
!     Test: try to read a file that is not valid
! Arguments:
!     None
!
subroutine test_invalid_file

    integer :: nodata
    real    :: vmean, vmin, vmax

    open( 11, file = 'invalid_file' )
    write( 11, '(f10.3)' ) 1.0, 2.0, 3.0, 4.0
    write( 11, '(a)' ) 'AAAA'
    write( 11, '(f10.3)' ) 5.0, 6.0, 7.0, 8.0
    close( 11 )

    call write_name( 'invalid_file' )

    call open_files
    call process_data( nodata, vmean, vmax, vmin )

    call assert_true( nodata == 0, "No data read" )

end subroutine test_invalid_file

! test_ordinary_file --
!     Test: try to read a valid file and check the results
! Arguments:
!     None
!
subroutine test_ordinary_file

    integer :: nodata
    real    :: vmean, vmin, vmax

    open( 11, file = 'valid_file' )
    write( 11, '(f10.3)' ) 1.0, 2.0, 3.0, 4.0
    write( 11, '(f10.3)' ) 5.0, 6.0, 7.0, 8.0
    close( 11 )

    call write_name( 'valid_file' )

    call open_files
    call process_data( nodata, vmean, vmin, vmax )
    call report_results( nodata, vmean, vmin, vmax )

    call assert_true( nodata == 8, "All data are read correctly" )
    call assert_true( vmean  == 4.5, "Correct mean value" )
    call assert_true( vmin   == 1.0, "Correct minimum value" )
    call assert_true( vmax   == 8.0, "Correct maximum value" )

end subroutine test_ordinary_file


! test_compare_files --
!     Test: compare two files (with some tolerance for numerical values)
! Arguments:
!     None
!
subroutine test_compare_files

    open( 11, file = 'test1.out' )
    open( 12, file = 'test2.out' )

    write( 11, '(a)' ) 'Line 1 is the same in both files'
    write( 12, '(a)' ) 'Line 1 is the same in both files'
    write( 11, '(a)' ) 'Line 2 differs'
    write( 12, '(a)' ) 'Line 2 differs ...'
    write( 11, '(a)' ) 'Line 3 differs only slightly: pi = 3.1415926 ...'
    write( 12, '(a)' ) 'Line 3 differs only slightly: pi = 3.1415927 ...'
    write( 11, '(a)' ) 'Line 4 differs significantly: pi = 3.1415926 ...'
    write( 12, '(a)' ) 'Line 4 differs significantly: pi = 3.1       ...'

    close( 11 )
    close( 12 )

    call assert_files_comparable( 'test1.out', 'test2.out', 'Files should be equal' )

end subroutine test_compare_files


! test_compare_reals --
!     Test: compare real values
! Arguments:
!     None
!
subroutine test_compare_reals
    integer, parameter :: dp = kind(1.0d0)

    real               :: value
    real               :: vmin
    real               :: vmax
    real(kind=dp)      :: dvalue
    real(kind=dp)      :: dvmin
    real(kind=dp)      :: dvmax

    vmin  = 1.0
    vmax  = 1.01
    value = 2.0
    dvmin  = 1.0_dp
    dvmax  = 1.01_dp
    dvalue = 2.0_dp

    call assert_inbetween( value,  vmin,  vmax,  "Value slightly larger than 1" )
    call assert_inbetween( dvalue, dvmin, dvmax, "Double-precision value slightly larger than 1" )

end subroutine test_compare_reals


! test_ignore_test --
!     Test: only check that ignored tests are treated correctly
! Arguments:
!     None
!
subroutine test_ignored_test

    call assert_true( .false.,  "This test should NOT be run" )

end subroutine test_ignored_test


! test_deliberate_failure --
!     Test: deliberate failure - check HTML formatting after ignored test
! Arguments:
!     None
! Note:
!     Should be run after test_ignore_test!
!
subroutine test_deliberate_failure

    call assert_true( .false.,  "Deliberate failure" )

    if ( assertions_failed() ) then
        call assertion_report( "Deliberate failure occurred" )
    endif

end subroutine test_deliberate_failure


! test_deliberate_stop --
!     Test: deliberate stop - this should not be marked as a failure
! Arguments:
!     None
!
subroutine test_deliberate_stop

    call expect_program_stop
    stop

end subroutine test_deliberate_stop


end module dataproc_testing

! program ---
!     Main program:
!     Do the ordinary processing and run the unit tests
!
program dataproc
    use ftnunit
    use data_processing
    use dataproc_testing ! Module with specific unit tests

    implicit none

    integer :: nodata
    real    :: vmean, vmin, vmax

!
! The routine runtests will check if unit tests are requested
! If not, it will return immediately. This way we make sure
! the unit tests remain part of the program.
!
! The routine test_all runs all unit tests
! (see the dataproc_testing module)
!
    call runtests_init
    call runtests( test_all )
    call runtests( test_extra )
    call runtests_final

!
! Ordinary processing
!
    write(*,*) 'Ordinary processing ...'
    call open_files
    call process_data( nodata, vmean, vmin, vmax )
    call report_results( nodata, vmean, vmin, vmax )

end program


<|start_filename|>config/ifort.mk<|end_filename|>
# Options for Intel Fortran - Linux
#
SPACE	=	\

SEP	=	/

FC	=	ifort
FFLAGS_NORMAL	=	-c
FFLAGS_DEBUG	=	-c -g
FFLAGS_OPTIMISE	=	-c -fast

LD	=	ifort
LDFLAGS_NORMAL	=	
LDFLAGS_DEBUG	=	-g
LDFLAGS_OPTIMISE	=	
LDOUTPUT	=	-o $@

LIB	=	ar r

OBJEXT	=	.o
EXEEXT	=	
MODEXT	=	.mod

DELETE	=	rm -f


<|start_filename|>src/odbc/fodbc.f90<|end_filename|>
! fodbc.90 --
!     Fortran interface to ODBC
!
!     $Id: fodbc.f90,v 1.11 2013/03/05 12:05:13 arjenmarkus Exp $
!
!     TODO:
!     - odbc_prepare_select: more robust method to compute the string length needed
!                            split up because of extra_clause
!
module odbc_types
    implicit none

    integer, parameter         :: dp = kind(1.0d0)

    integer, parameter         :: ODBC_INT     = 1
    integer, parameter         :: ODBC_REAL    = 2
    integer, parameter         :: ODBC_DOUBLE  = 3
    integer, parameter         :: ODBC_CHAR    = 4
    integer, parameter         :: ODBC_BINARY  = -3 ! For BLOBs - SQL_VARBINARY

    !
    ! Note: these must be kept in sync with the C code!
    !
    integer, parameter         :: ODBC_NO_BLOB_SUPPORT = -1 ! BLOBs: no support
    integer, parameter         :: ODBC_PLAIN_BYTES     =  0 ! BLOBs: BLOB(..) and raw bytes returned
    integer, parameter         :: ODBC_POSTGRESQL_HEX  =  1 ! BLOBs: BYTEA and hexadecimal string returned

    integer, parameter         :: ODBC_ROW     = 100
    integer, parameter         :: ODBC_ERRCODE = 999

    character(len=40), parameter :: ODBC_MSACCESS   = "MicroSoft Access Driver (*.mdb)"
    character(len=40), parameter :: ODBC_MSEXCEL    = "MicroSoft Excel Driver (*.xls)"
    character(len=40), parameter :: ODBC_SQLITE3    = "SQLite3 ODBC Driver"
    character(len=40), parameter :: ODBC_POSTGRESQL = "PostGreSQL Driver"

    type ODBC_STATEMENT
        integer, dimension(2)   :: stmt_handle
        integer                 :: blob_type
    end type ODBC_STATEMENT

    type ODBC_DATABASE
        integer, dimension(2)   :: db_handle   = 0
        integer, dimension(2)   :: stmt_handle = 0 ! For querying table names
        integer                 :: blob_type   = ODBC_PLAIN_BYTES
        integer                 :: error
        character(len=80)       :: errmsg
    end type ODBC_DATABASE

    type ODBC_BLOB
        integer                            :: set_size    = 0 ! Size as set via odbc_column_props
        integer                            :: actual_size = 0 ! Size in bytes of the actual data
        integer, dimension(:), allocatable :: data            ! Using an integer array as convenient storage
    end type ODBC_BLOB

    type ODBC_COLUMN
        character(len=40)       :: name     = ' '
        character(len=40)       :: type     = ' '
        character(len=40)       :: function = ' '
        integer                 :: type_set
        integer                 :: int_value
        real(kind=dp)           :: double_value
        character(len=80)       :: char_value
        type(ODBC_BLOB)         :: blob_value
    end type ODBC_COLUMN
end module odbc_types

module odbc
    use odbc_types

    implicit none

    private :: typename
    private :: column_func
    private :: stringtof
    private :: stringtoc

    interface odbc_open
        module procedure odbc_open_dsn
        module procedure odbc_open_file
    end interface

    interface odbc_errmsg
        module procedure odbc_errmsg_db
        module procedure odbc_errmsg_stmt
    end interface

    interface odbc_errmsg_print
        module procedure odbc_errmsg_print_db
        module procedure odbc_errmsg_print_stmt
    end interface

   !
   ! Convenient interfaces
   !
   interface odbc_set_column
      module procedure odbc_set_column_int
      module procedure odbc_set_column_real
      module procedure odbc_set_column_double
      module procedure odbc_set_column_char
      module procedure odbc_set_column_blob
   end interface
   interface odbc_get_column
      module procedure odbc_get_column_int
      module procedure odbc_get_column_real
      module procedure odbc_get_column_double
      module procedure odbc_get_column_char
      module procedure odbc_get_column_blob
   end interface

contains

! typename --
!    Construct the type and attributes of a column
!    in a new table
! Arguments:
!    column        Column information
!    primary       Name of the primary key
!
character(len=40) function typename( column, primary, blob_type )
   type(ODBC_COLUMN), intent(in) :: column
   character(len=*), intent(in)  :: primary
   integer, intent(in)           :: blob_type

   if ( column%type(1:4) == 'BLOB' .and. blob_type == ODBC_POSTGRESQL_HEX ) then
       typename = 'BYTEA'
   else if ( column%name .ne. primary ) then
      typename = column%type
   else
      !write( typename, '(2a)' ) trim(column%type), ' primary key'
      typename = trim(column%type) // ' primary key'
   endif

end function typename


! column_func --
!    Construct the name and function of a column
!    in a new table
! Arguments:
!    column        Column information
!
character(len=80) function column_func( column )
   type(ODBC_COLUMN), intent(in) :: column

   if ( column%function .ne. ' ' ) then
      column_func = trim(column%function) // '(' // trim(column%name) // ')'
   else
      column_func = column%name
   endif

end function column_func


! stringtof --
!    Convert a C string to Fortran
! Arguments:
!    string        String to be converted
!
subroutine stringtof( string )
   character(len=*) :: string

   integer          :: last
   last = index( string, char(0) )
   if ( last .gt. 0 ) then
      string(last:) = ' '
   endif

end subroutine stringtof


! stringtoc --
!    Convert a Fortran string to C
! Arguments:
!    string        String to be converted
! Note:
!    It is assumed that the last character
!    is a space. As this is a private
!    routine, this should have been taken
!    care of in the caller.
!
subroutine stringtoc( string )
   character(len=*) :: string

   integer          :: last

   last = 1 + len_trim(string)
   string(last:last) = char(0)

end subroutine stringtoc


! odbc_column_props --
!    Convenience routine to set the properties of a column
! Arguments:
!    column        Column structure
!    name          Name of the column
!    type          Type of the column
!    length        Length if a string
! Side effects:
!    Fields in column filled
!
subroutine odbc_column_props( column, name, type, length )
   type(ODBC_COLUMN), intent(inout) :: column
   character(len=*), intent(in)       :: name
   integer, intent(in)                :: type
   integer, intent(in), optional      :: length

   integer                            :: length_
   character(len=40)                  :: type_expr

   length_ = 20
   if ( present(length) ) then
      length_ = length
   endif

   column%name     = name
   column%type_set = type

   select case ( type )
   case (ODBC_INT)
      column%type = 'INT'
   case (ODBC_REAL)
      column%type = 'FLOAT'
   case (ODBC_DOUBLE)
      column%type = 'DOUBLE'
   case (ODBC_CHAR)
      write( column%type, '(a,i0,a)' ) 'CHAR(', length_, ')'
   case (ODBC_BINARY)
      write( column%type, '(a,i0,a)' ) 'BLOB(', length_, ')'
      column%blob_value%set_size = length_
   case default
      column%type = 'UNKNOWN!'
   end select

end subroutine odbc_column_props


! odbc_column_query --
!    Convenience routine to query a column or a function of that column
! Arguments:
!    column        Column structure
!    name          Name of the column
!    type          Type of the column
!    length        Length if a string (optional)
!    function      Name of the function to apply (if any)
! Side effects:
!    Fields in column filled
!
subroutine odbc_column_query( column, name, type, length, function )
   type(ODBC_COLUMN), intent(inout)     :: column
   character(len=*), intent(in)           :: name
   integer, intent(in)                    :: type
   integer, intent(in), optional          :: length
   character(len=*), intent(in), optional :: function

   column%function = ' '
   if ( present(function) ) then
      column%function = function
   endif
   if ( present(length) ) then
      call odbc_column_props( column, name, type, length )
   else
      call odbc_column_props( column, name, type )
   endif

end subroutine odbc_column_query


! odbc_set_column_int    --
! odbc_set_column_real   --
! odbc_set_column_double --
! odbc_set_column_char   --
! odbc_set_column_blob   --
!    Convenience routines to set the value of a column
! Arguments:
!    column        Column structure
!    value         The value to be set
! Side effects:
!    Appropriate value field in column set
!
subroutine odbc_set_column_int( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   integer, intent(in)                :: value

   column%int_value = value
   column%type_set  = ODBC_INT
end subroutine odbc_set_column_int

subroutine odbc_set_column_real( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   real, intent(in)                 :: value

   column%double_value = value
   column%type_set  = ODBC_DOUBLE
end subroutine odbc_set_column_real

subroutine odbc_set_column_double( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   real(kind=dp), intent(in)        :: value

   column%double_value = value
   column%type_set  = ODBC_DOUBLE
end subroutine odbc_set_column_double

subroutine odbc_set_column_char( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   character(len=*), intent(in)     :: value

   column%char_value = value
   column%type_set  = ODBC_CHAR
end subroutine odbc_set_column_char

subroutine odbc_set_column_blob( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   type(ODBC_BLOB), intent(in)      :: value

   if ( allocated(column%blob_value%data) ) then
       deallocate( column%blob_value%data )
   endif

   allocate( column%blob_value%data(size(value%data)) )
   if ( value%actual_size <= 0 ) then
       column%blob_value%actual_size = 4 * size(value%data)
   else
       column%blob_value%actual_size = value%actual_size
   endif
   column%blob_value%data        = value%data
   column%type_set               = ODBC_BINARY
end subroutine odbc_set_column_blob


! odbc_get_column_int    --
! odbc_get_column_real   --
! odbc_get_column_double --
! odbc_get_column_char   --
! odbc_get_column_blob   --
!    Convenience routines to get the value of a column
! Arguments:
!    column        Column structure
!    value         Value on return
! Side effects:
!    Value argument will be set
! Note:
!    No attempt is made to convert the value
!    to the requested value. You will have to
!    check this yourself
!
subroutine odbc_get_column_int( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   integer, intent(out)             :: value

   value = column%int_value
end subroutine odbc_get_column_int

subroutine odbc_get_column_real( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   real, intent(out)                :: value

   value = column%double_value
end subroutine odbc_get_column_real

subroutine odbc_get_column_double( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   real(kind=dp), intent(out)       :: value

   value = column%double_value
end subroutine odbc_get_column_double

subroutine odbc_get_column_char( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   character(len=*), intent(out)    :: value

   value = column%char_value
end subroutine odbc_get_column_char

subroutine odbc_get_column_blob( column, value )
   type(ODBC_COLUMN), intent(inout) :: column
   type(ODBC_BLOB), intent(out)     :: value

   if ( allocated(value%data) ) then
       deallocate( value%data )
   endif

   allocate( value%data(column%blob_value%actual_size) )
   value%actual_size = column%blob_value%actual_size
   value%data        = column%blob_value%data(1:column%blob_value%actual_size)
end subroutine odbc_get_column_blob


! odbc_open_dsn --
!     Open the database connection based on the DSN name
!
! Arguments:
!     dsnname       Name of the data source
!     db            Database connection
!
subroutine odbc_open_dsn( dsnname, db )

    character(len=*), intent(in)     :: dsnname
    type(odbc_database), intent(out) :: db

    character(len=len(dsnname)+20)   :: connection_string

    connection_string = "DSN=" // trim(dsnname) // ";"

    call odbc_connect( connection_string, db )
end subroutine odbc_open_dsn


! odbc_open_file --
!     Open the database connection based on the name of a file
!     and the driver that should be used
!
! Arguments:
!     filename      Name of the database file
!     driver        Name of the driver
!     db            Database connection
!
subroutine odbc_open_file( filename, driver, db )

    character(len=*), intent(in)     :: filename
    character(len=*), intent(in)     :: driver
    type(odbc_database), intent(out) :: db

    character(len=len(filename)+len(driver)+100)   :: connection_string

    select case (driver)
        case (odbc_msaccess, odbc_msexcel)
            connection_string = "DRIVER={" // trim(driver) // "};" // &
                "DBQ=" // trim(filename) // ";Uid=Admin;Pwd=;"
            db%blob_type = ODBC_NO_BLOB_SUPPORT
        case (odbc_sqlite3)
            connection_string = "DRIVER={" // trim(driver) // "};" // &
                "Database=" // trim(filename) // ";"
            db%blob_type = ODBC_NO_BLOB_SUPPORT
        case (odbc_postgresql)
            connection_string = "DRIVER={" // trim(driver) // "};" // &
                "Database=" // trim(filename) // ";"
            db%blob_type = ODBC_POSTGRESQL_HEX
        case default
            db%errmsg = "Unknown driver: " // trim(driver)
            db%blob_type = ODBC_NO_BLOB_SUPPORT
            db%error  = -1
            return
    end select

    call odbc_connect( connection_string, db )

end subroutine odbc_open_file


! odbc_connect --
!     Open the database connection based on the connection string
!
! Arguments:
!     connection_string    Full connection string
!     db                   Database connection
!
subroutine odbc_connect( connection_string, db )

    character(len=*), intent(in)            :: connection_string
    type(odbc_database), intent(out)        :: db

    character(len=len(connection_string)+1) :: connectc

    interface
        integer function odbc_connect_c( connectc, db_handle )
            character(len=*)      :: connectc
            integer, dimension(*) :: db_handle
        end function odbc_connect_c
    end interface

    db%db_handle   = 0
    db%error       = 0
    db%errmsg       = ' '

    connectc = connection_string
    call stringtoc( connectc )

    db%error = odbc_connect_c( connectc, db%db_handle )

end subroutine odbc_connect


! odbc_close --
!     Close the database connection
!
! Arguments:
!     db                   Database connection
!
subroutine odbc_close( db )
    type(odbc_database), intent(out)        :: db

    interface
        integer function odbc_close_c( db_handle, stmt_handle )
            integer, dimension(*) :: db_handle
            integer, dimension(*) :: stmt_handle
        end function odbc_close_c
    end interface

    db%error = odbc_close_c( db%db_handle, db%stmt_handle )

end subroutine odbc_close


! odbc_set_blob_type --
!    Set the type of BLOB support
! Arguments:
!    db            Connection to the database
!    blob_type     Type of BLOB support
!
subroutine odbc_set_blob_type( db, blob_type )
   type(odbc_database) :: db
   integer, intent(in) :: blob_type

   db%blob_type = blob_type
end subroutine odbc_set_blob_type


! odbc_error --
!    Return the last error code
! Arguments:
!    db            Connection to the database
! Returns:
!    Last ODBC error code for this database
!
logical function odbc_error( db )
   type(odbc_database) :: db

   odbc_error = db%error .ne. 0
end function odbc_error


! odbc_errmsg_print_db --
!    Print the last error message(s)
! Arguments:
!    db            Connection to the database
!    lun           (Optional) LU-number to write to
!
subroutine odbc_errmsg_print_db( db, lun )
    type(odbc_database) :: db
    integer, optional   :: lun

    interface
        integer function odbc_get_diagnostics_c( handle, type, idx, state, text )
            integer, dimension(*) :: handle
            integer               :: type
            integer               :: idx
            character(len=*)      :: state
            character(len=*)      :: text
        end function odbc_get_diagnostics_c
    end interface

    integer           :: rc
    integer           :: i
    character(len=10) :: state
    character(len=80) :: text

    do i = 1,10
        rc = odbc_get_diagnostics_c( db%db_handle, 0, i, state, text )

        if ( rc /= 0 ) exit

        call stringtof( state )
        call stringtof( text )

        if ( present(lun) ) then
            write( lun, *) state, trim(text)
        else
            write(*,*) state, trim(text)
        endif
    enddo

end subroutine odbc_errmsg_print_db


! odbc_errmsg_print_stmt --
!    Print the last error message (TODO)
! Arguments:
!    stmt          Prepared statement
!    lun           (Optional) LU-number to write to
!
subroutine odbc_errmsg_print_stmt( stmt, lun )
    type(odbc_statement) :: stmt
    integer, optional   :: lun

    interface
        integer function odbc_get_diagnostics_c( handle, type, idx, state, text )
            integer, dimension(*) :: handle
            integer               :: type
            integer               :: idx
            character(len=*)      :: state
            character(len=*)      :: text
        end function odbc_get_diagnostics_c
    end interface

    integer           :: rc
    integer           :: i
    character(len=10) :: state
    character(len=80) :: text

    do i = 1,10
        rc = odbc_get_diagnostics_c( stmt%stmt_handle, 1, i, state, text )

        if ( rc /= 0 ) exit

        call stringtof( state )
        call stringtof( text )

        if ( present(lun) ) then
            write( lun, *) state, trim(text)
        else
            write(*,*) state, trim(text)
        endif
    enddo

end subroutine odbc_errmsg_print_stmt


! odbc_errmsg_db --
!    Return the last error message
! Arguments:
!    db            Connection to the database
!
function odbc_errmsg_db( db ) result( text )
    type(odbc_database) :: db
    character(len=80)   :: text

    interface
        integer function odbc_get_diagnostics_c( handle, type, idx, state, text )
            integer, dimension(*) :: handle
            integer               :: type
            integer               :: idx
            character(len=*)      :: state
            character(len=*)      :: text
        end function odbc_get_diagnostics_c
    end interface

    integer           :: rc
    integer           :: i
    character(len=10) :: state

    if ( db%errmsg /= ' ' ) then
        text = db%errmsg
        return
    else
        rc = odbc_get_diagnostics_c( db%db_handle, 0, 1, state, text )
        call stringtof( text )
    endif

end function odbc_errmsg_db


! odbc_errmsg_stmt --
!    Return the last error message
! Arguments:
!    stmt          Prepared statement
!
function odbc_errmsg_stmt( stmt ) result( text )
    type(odbc_statement) :: stmt
    character(len=80)    :: text

    interface
        integer function odbc_get_diagnostics_c( handle, type, idx, state, text )
            integer, dimension(*) :: handle
            integer               :: type
            integer               :: idx
            character(len=*)      :: state
            character(len=*)      :: text
        end function odbc_get_diagnostics_c
    end interface

    integer           :: rc
    integer           :: i
    character(len=10) :: state

    rc = odbc_get_diagnostics_c( stmt%stmt_handle, 1, i, state, text )
    call stringtof( text )

end function odbc_errmsg_stmt


! odbc_get_data_source --
!     Get the first or the next data source name
!
! Arguments:
!     next                 Get next data source?
!     dsnname              Data source name
!     description          Description of the data source
!     success              Whether we had success or not
!                          (if not, no source was returned)
!
subroutine odbc_get_data_source( next, dsnname, description, success )
    logical, intent(in)                :: next
    character(len=*), intent(out)      :: dsnname
    character(len=*), intent(out)      :: description
    logical, intent(out)               :: success

    interface
        integer function odbc_get_data_source_c( direction, dsnname, description )
            integer               :: direction
            character(len=*)      :: dsnname
            character(len=*)      :: description
        end function odbc_get_data_source_c
    end interface

    integer :: direction
    integer :: error

    direction = merge( 1, 0, next )
    error = odbc_get_data_source_c( direction, dsnname, description )

    if ( error == 0 ) then
        success = .true.
        call stringtof( dsnname )
        call stringtof( description )
    else
        success = .false.
        dsnname = ' '
        description = ' '
    endif

end subroutine odbc_get_data_source


! odbc_get_driver --
!     Get the first or the next installed driver
!
! Arguments:
!     next                 Get next driver
!     driver               Driver name
!     description          Description/attributes of the driver
!     success              Whether we had success or not
!                          (if not, no source was returned)
!
subroutine odbc_get_driver( next, driver, description, success )
    logical, intent(in)                :: next
    character(len=*), intent(out)      :: driver
    character(len=*), intent(out)      :: description
    logical, intent(out)               :: success

    interface
        integer function odbc_get_driver_c( direction, driver, description )
            integer               :: direction
            character(len=*)      :: driver
            character(len=*)      :: description
        end function odbc_get_driver_c
    end interface

    integer :: direction
    integer :: error

    direction = merge( 1, 0, next )
    error = odbc_get_driver_c( direction, driver, description )

    if ( error == 0 ) then
        success = .true.
        call stringtof( driver )
        call stringtof( description )
    else
        success     = .false.
        driver      = ' '
        description = ' '
    endif

end subroutine odbc_get_driver


! odbc_do --
!    Run a single SQL command
! Arguments:
!    db            Structure for the database
!    command       Complete SQL command
! Side effects:
!    Whatever effects the command has. Note
!    that no output is reported back to the
!    caller (except for error codes and
!    messages if any)
!    longer be accessed
!
subroutine odbc_do( db, command )
   type(ODBC_DATABASE) :: db
   character(len=*)    :: command

   interface
      integer function odbc_do_c( handle, command, errmsg )
         integer, dimension(*) :: handle
         character(len=*)      :: command
         character(len=*)      :: errmsg
      end function odbc_do_c
   end interface

   character(len=len(command)+1) :: commandc
   integer                       :: k

   commandc = command
   call stringtoc( commandc )

   db%errmsg = ' '
   db%error  = odbc_do_c( db%db_handle, commandc, db%errmsg )

end subroutine odbc_do


! odbc_begin --
!    Start a transaction on the given database
! Arguments:
!    db            Structure for the database
! Note:
!    Should be accompanied by a call to either
!    odbc_commit or odbc_rollback
!
subroutine odbc_begin( db )
   type(ODBC_DATABASE) :: db

   call odbc_do( db, "BEGIN TRANSACTION" )

end subroutine odbc_begin


! odbc_commit --
!    Commits a transaction on the given database
! Arguments:
!    db            Structure for the database
! Note:
!    Accompanies odbc_begin
!
subroutine odbc_commit( db )
   type(ODBC_DATABASE) :: db

   call odbc_do( db, "COMMIT TRANSACTION" )

end subroutine odbc_commit


! odbc_rollback --
!    Rolls back any changes to the database since the last commit
! Arguments:
!    db            Structure for the database
! Note:
!    Accompanies odbc_begin
!
subroutine odbc_rollback( db )
   type(ODBC_DATABASE) :: db

   call odbc_do( db, "ROLLBACK" )

end subroutine odbc_rollback


! odbc_get_table_name --
!     Get information on the first or the next table
!
! Arguments:
!     db                   Database to query
!     next                 Get next driver
!     table                Table name
!     description          Array of strings describing the table
!                          (the first 5 elements are filled)
!     success              Whether we had success or not
!                          (if not, no source was returned)
!
subroutine odbc_get_table_name( db, next, table, description, success )
    type(odbc_database), intent(inout)          :: db
    logical, intent(in)                         :: next
    character(len=*), intent(out)               :: table
    character(len=*), dimension(:), intent(out) :: description
    logical, intent(out)                        :: success

    interface
        integer function odbc_get_table_name_c( db, stmt, direction, &
                nstrings, description )
            integer, dimension(*)          :: db
            integer, dimension(*)          :: stmt
            integer                        :: direction
            integer                        :: nstrings
            character(len=*), dimension(*) :: description
        end function odbc_get_table_name_c
    end interface

    integer :: direction
    integer :: error
    integer :: nstrings
    integer :: i

    if ( size(description) < 5 ) then
        db%error  = -1
        db%errmsg = 'Too few elements in description array'
        return
    endif

    direction   = merge( 1, 0, next )
    nstrings    = size(description)
    table       = ' '
    description = ' '
    error = odbc_get_table_name_c( db%db_handle, db%stmt_handle, direction, &
                nstrings, description )

    if ( error == 0 ) then
        success = .true.
        do i = 1,nstrings
            call stringtof( description(i) )
        enddo
        table = description(3)
    else
        success     = .false.
        table       = ' '
        description = ' '
    endif

end subroutine odbc_get_table_name


! odbc_query_table --
!    Retrieve the column names and types from a table
! Arguments:
!    db            Structure for the database
!    tablename     Name of the table
!    columns       Columns (allocated array)
! Side effects:
!    The columns array is allocated and filled
! Note:
!    On entry the columns argument must not be
!    associated. On exit, it will point to a
!    freshly allocated array of column names/types
!
subroutine odbc_query_table( db, tablename, columns )
   type(ODBC_DATABASE)                       :: db
   character(len=*)                          :: tablename
   type(ODBC_COLUMN), dimension(:), pointer  :: columns     ! On return: actual columns!

   type(ODBC_STATEMENT)                      :: stmt
   character(len=20+len(tablename))          :: command

   write( command, '(3a)' ) 'select * from ',tablename, ';'

   !
   ! Note, we must free the columns, but we can not be sure
   ! they are no longer used. So simply disassociate.
   if ( associated(columns) ) then
      nullify( columns )
   endif
   call odbc_prepare( db, command, stmt, columns )
   call odbc_finalize( stmt )

end subroutine odbc_query_table


! odbc_delete_table --
!    Delete a table
! Arguments:
!    db            Structure for the database
!    tablename     Name of the table to be deleted
! Note:
!    The table can not be recovered, unless this
!    is part of a transaction
!
subroutine odbc_delete_table( db, tablename )
   type(ODBC_DATABASE) :: db
   character(len=*)      :: tablename

   character(len=20+len(tablename)) :: command

   write( command, "(2A)" ) "DELETE TABLE ", tablename
   call odbc_do( db, command )

end subroutine odbc_delete_table


! odbc_create_table --
!    Create a new table
! Arguments:
!    db            Structure for the database
!    tablename     Name of the table
!    columns       Properties of the columns
!    primary       Name of the primary key (if any)
! Side effects:
!    The new table is created
!
subroutine odbc_create_table( db, tablename, columns, primary )
   type(ODBC_DATABASE)              :: db
   character(len=*)                   :: tablename
   type(ODBC_COLUMN), dimension(:)  :: columns
   character(len=*), optional         :: primary

   character(len=20+80*size(columns)) :: command
   character(len=40)                  :: primary_
   integer                            :: i
   integer                            :: ncols

   primary_ = ' '
   if ( present(primary) ) then
      primary_ = primary
   endif

   ncols = size(columns)
   write( command, '(100a)' ) 'create table ', tablename, ' (', &
      ( trim(columns(i)%name), ' ', trim(typename(columns(i), primary_,db%blob_type)), ', ', &
           i = 1,ncols-1 ), &
      trim(columns(ncols)%name), ' ', trim(typename(columns(ncols),primary_,db%blob_type)), ')'

   call odbc_do( db, command )
end subroutine odbc_create_table


! odbc_prepare_select --
!    Prepare a selection of data from the database
! Arguments:
!    db            Structure for the database
!    tablename     Name of the table
!    columns       Columns to be returned
!    stmt          Prepared statement (returned)
!    extra_clause  Extra clause for SELECT statement (appended)
! Side effects:
!    A new selection is prepared
!
subroutine odbc_prepare_select( db, tablename, columns, stmt, extra_clause )
    type(ODBC_DATABASE)                       :: db
    character(len=*)                          :: tablename
    type(ODBC_COLUMN), dimension(:), pointer  :: columns     ! On return: actual columns!
    character(len=*), optional                :: extra_clause
    type(ODBC_STATEMENT), intent(out)         :: stmt

    character(len=20+80*size(columns))        :: command
    integer                                   :: nocols
    integer                                   :: i

    interface
        subroutine odbc_exec_c( handle, rc )
            integer, dimension(*) :: handle
            integer               :: rc
        end subroutine odbc_exec_c
    end interface

    !
    ! Prepare the select statement for this table
    !
    ! TODO: expand the syntax!!
    !
    nocols = size(columns)
    write( command, '(100a)' ) 'select ', &
        (trim(column_func(columns(i))), ',', i = 1,nocols-1), &
         trim(column_func(columns(nocols))), &
        ' from ', trim(tablename)

    !
    ! Hm, appending a string of arbitrary length is tricky ...
    !
    if ( present(extra_clause) ) then
        command = trim(command) // ' ' // extra_clause
    endif

    command = trim(command) // ';'

    call stringtoc( command )
    call odbc_prepare( db, command, stmt, columns )
    call odbc_exec_c( stmt%stmt_handle, db%error )
    stmt%blob_type = db%blob_type

end subroutine odbc_prepare_select


! odbc_insert --
!    Insert a row into the given table
! Arguments:
!    db            Structure for the database
!    tablename     Name of the table
!    columns       Columns whose value is to be inserted
! Side effects:
!    A new row is written to the database
!
subroutine odbc_insert( db, tablename, columns )
    type(ODBC_DATABASE)                       :: db
    character(len=*)                          :: tablename
    type(ODBC_COLUMN), dimension(:), target   :: columns
    character(len=20+80*size(columns))        :: command

    type(ODBC_COLUMN), dimension(:), pointer  :: prepared_columns
    type(ODBC_STATEMENT)                      :: stmt
    integer                                   :: i
    integer                                   :: rc
    integer, save                             :: indicator

    character (len=10+40*size(columns))       :: string

    interface
        subroutine odbc_errmsg_c( handle, errmsg )
            integer, dimension(*) :: handle
            character(len=*)      :: errmsg
        end subroutine odbc_errmsg_c
    end interface

    interface
        integer function odbc_bind_param_int_c( handle, colidx, value, indicator )
            integer, dimension(*) :: handle
            integer               :: colidx
            integer               :: value
            integer               :: indicator
        end function odbc_bind_param_int_c
    end interface

    interface
        integer function odbc_bind_param_double_c( handle, colidx, value, indicator )
            use odbc_types
            integer, dimension(*) :: handle
            integer               :: colidx
            real(kind=dp)         :: value
            integer               :: indicator
        end function odbc_bind_param_double_c
    end interface

    interface
        integer function odbc_bind_param_text_c( handle, colidx, value, indicator )
            integer, dimension(*) :: handle
            integer               :: colidx
            character(len=*)      :: value
            integer               :: indicator
        end function odbc_bind_param_text_c
    end interface

    interface
        integer function odbc_bind_param_blob_c( handle, colidx, value, size_value, indicator, blob_type )
            integer, dimension(*) :: handle
            integer               :: colidx
            integer, dimension(*) :: value
            integer               :: size_value
            integer               :: indicator
            integer               :: blob_type
        end function odbc_bind_param_blob_c
    end interface

    interface
        subroutine odbc_exec_c( handle, rc )
            integer, dimension(*) :: handle
            integer               :: rc
        end subroutine odbc_exec_c
    end interface

    !
    ! Prepare the insert statement for this table
    !
    i = 0
    string = '('//trim(columns(1)%name)
    do i = 2,size(columns)
       string = trim(string)//','//trim(columns(i)%name)
    end do
    string = trim(string) //') '

    write( command, '(100a)' ) 'insert into ', trim(tablename),trim(string), ' values(', &
       ('?,', i = 1,size(columns)-1), '?);'

    call stringtoc( command )
    prepared_columns => columns
    call odbc_prepare( db, command, stmt, prepared_columns )

    !
    ! Bind the values
    !
    do i = 1,size(columns)

       select case (columns(i)%type_set)
           case (ODBC_INT)
               rc = odbc_bind_param_int_c( stmt%stmt_handle, i, columns(i)%int_value, indicator )
           case (ODBC_REAL, ODBC_DOUBLE)
               rc = odbc_bind_param_double_c( stmt%stmt_handle, i, columns(i)%double_value, indicator )
           case (ODBC_CHAR)
               call stringtoc( columns(i)%char_value )
               columns(i)%int_value = len_trim(columns(i)%char_value)
               rc = odbc_bind_param_text_c( stmt%stmt_handle, i, columns(i)%char_value, &
                        columns(i)%int_value )
           case (ODBC_BINARY)
               rc = odbc_bind_param_blob_c( stmt%stmt_handle, i, columns(i)%blob_value%data, &
                        size(columns(i)%blob_value%data), columns(i)%blob_value%actual_size, db%blob_type )
        end select
        if ( rc .ne. 0 ) then
           db%error = rc
           call odbc_errmsg_c( db%db_handle, db%errmsg )
           call stringtof( db%errmsg )
        endif
    enddo

    !
    ! Actually perform the insert command
    !
    call odbc_exec_c( stmt%stmt_handle, rc )

    if ( rc /= 0 ) then
        db%errmsg = odbc_errmsg_stmt( stmt )
    endif
    db%error = rc
    call odbc_finalize( stmt )
end subroutine odbc_insert


! odbc_next_row --
!    Gets the next row of data from a selection
! Arguments:
!    stmt          Prepared statement
!    columns       Columns to be returned
!    finished      Indicates there are no more data
!
subroutine odbc_next_row( stmt, columns, finished )
    type(ODBC_STATEMENT)            :: stmt
    type(ODBC_COLUMN), dimension(:) :: columns
    logical                         :: finished

    interface
        integer function odbc_column_int_c( handle, colidx, value, indicator )
            integer, dimension(*) :: handle
            integer               :: colidx
            integer               :: value
            integer               :: indicator
        end function odbc_column_int_c
    end interface

    interface
        integer function odbc_column_double_c( handle, colidx, value, indicator )
            use odbc_types
            integer, dimension(*) :: handle
            integer               :: colidx
            real(kind=dp)         :: value
            integer               :: indicator
        end function odbc_column_double_c
    end interface

    interface
        integer function odbc_column_text_c( handle, colidx, value, indicator )
            integer, dimension(*) :: handle
            integer               :: colidx
            character(len=*)      :: value
            integer               :: indicator
        end function odbc_column_text_c
    end interface

    interface
        integer function odbc_column_blob_c( handle, colidx, value, size_value, indicator, blob_type )
            integer, dimension(*) :: handle
            integer               :: colidx
            integer, dimension(*) :: value
            integer               :: size_value
            integer               :: indicator
            integer               :: blob_type
        end function odbc_column_blob_c
    end interface

    integer                           :: rc
    integer                           :: i
    integer, save                     :: indicator

    call odbc_step( stmt, rc )

    if ( rc .eq. ODBC_ROW ) then
        finished = .false.

        !
        ! Get the values
        !
        ! TODO: check validity of "type_set"
        !
        do i = 1,size(columns)
            select case (columns(i)%type_set)
                case (ODBC_INT)
                    rc = odbc_column_int_c( stmt%stmt_handle, i, columns(i)%int_value, indicator )
                case (ODBC_REAL,ODBC_DOUBLE)
                    rc = odbc_column_double_c( stmt%stmt_handle, i, columns(i)%double_value, indicator  )
                case (ODBC_CHAR)
                    rc = odbc_column_text_c( stmt%stmt_handle, i, columns(i)%char_value, indicator  )
                    call stringtof( columns(i)%char_value )
                case (ODBC_BINARY)
                    if ( allocated(columns(i)%blob_value%data) ) then
                        if ( size(columns(i)%blob_value%data) /= columns(i)%blob_value%set_size ) then
                            deallocate( columns(i)%blob_value%data )
                            allocate( columns(i)%blob_value%data(columns(i)%blob_value%set_size) )
                        endif
                    else
                        allocate( columns(i)%blob_value%data(columns(i)%blob_value%set_size) )
                    endif
                    rc = odbc_column_blob_c( stmt%stmt_handle, i, columns(i)%blob_value%data, &
                             columns(i)%blob_value%set_size, indicator, stmt%blob_type )
                    if (rc == 0 ) then
                        columns(i)%blob_value%actual_size = (indicator+3)/4
                    else
                        columns(i)%blob_value%actual_size = 0
                    endif
            end select
            ! if ( rc .ne. 0 ) then
            !    db%error = rc
            !    call odbc_errmsg_c( db%db_handle, db%errmsg )
            !    call stringtof( db%errmsg )
            ! endif
        enddo
    else
        finished = .true.
    endif

end subroutine odbc_next_row


! odbc_prepare --
!    Reset the prepared SQL statement so that it can
!    be used again
! Arguments:
!    stmt          Handle to the prepared statement
!
subroutine odbc_prepare( db, command, stmt, columns )
    type(ODBC_DATABASE), intent(inout)        :: db
    character(len=*), intent(in)              :: command
    type(ODBC_STATEMENT), intent(out)         :: stmt
    type(ODBC_COLUMN), dimension(:), pointer  :: columns     ! On return: actual columns!

    interface
       integer function odbc_prepare_c( db, command, stmt )
          integer, dimension(*) :: db
          character(len=*)      :: command
          integer, dimension(*) :: stmt
       end function odbc_prepare_c
    end interface

    interface
       subroutine odbc_column_count_c( handle, count )
          integer, dimension(*) :: handle
          integer               :: count
       end subroutine odbc_column_count_c
    end interface

    interface
       subroutine odbc_column_name_type_c( handle, colidx, name, type )
          integer, dimension(*) :: handle
          integer               :: colidx
          character(len=*)      :: name
          character(len=*)      :: type
       end subroutine odbc_column_name_type_c
    end interface

    integer                                     :: count
    integer                                     :: i
    character(len=len(command)+1)               :: commandc

    commandc = command
    call stringtoc( commandc )
    db%error = odbc_prepare_c( db%db_handle, commandc, stmt%stmt_handle )
    stmt%blob_type = db%blob_type

    if ( db%error .eq. 0 ) then
        if ( associated(columns) ) return ! Assumption: they are already known

        call odbc_column_count_c( stmt%stmt_handle, count )

        allocate( columns(1:count) )

        do i = 1,count
            call odbc_column_name_type_c( stmt%stmt_handle, i, &
                columns(i)%name, columns(i)%type )
            call stringtof( columns(i)%name )
            call stringtof( columns(i)%type )

            select case (columns(i)%type(1:4) )
                case( 'INT ', 'INTE' )
                    columns(i)%type_set = ODBC_INT
                case( 'FLOA', 'DOUB' )
                    columns(i)%type_set = ODBC_DOUBLE
                case( 'CHAR', 'VARC' )
                    columns(i)%type_set = ODBC_CHAR
                case( 'BLOB' )
                    columns(i)%type_set = ODBC_BINARY
            end select

        enddo
    else
        call odbc_errmsg_c( db%db_handle, db%errmsg )
    endif

end subroutine odbc_prepare


! odbc_finalize --
!    Finalize the prepared SQL statement
! Arguments:
!    stmt          Handle to the prepared statement
!
subroutine odbc_finalize( stmt )
   type(ODBC_STATEMENT) :: stmt

   call odbc_finalize_c( stmt%stmt_handle )

end subroutine odbc_finalize


! odbc_step --
!    Run the prepared SQL statement
! Arguments:
!    stmt          Handle to the prepared statement
!    completion    Return code, indicating if the command is complete or
!                  not (ODBC_DONE, ODBC_MISUSE or ODBC_ERROR)
!
subroutine odbc_step( stmt, completion )
   type(ODBC_STATEMENT)                      :: stmt
   integer, intent(out)                        :: completion

   interface
      subroutine odbc_step_c( stmt, completion )
         integer, dimension(*) :: stmt
         integer               :: completion
      end subroutine odbc_step_c
   end interface

   call odbc_step_c( stmt%stmt_handle, completion )

end subroutine odbc_step

end module


<|start_filename|>doc/reporting/m_exception.html<|end_filename|>

<html><head>
<title>flibs/m_exception - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'reporting/m_exception.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2008 <NAME> <EMAIL>   -- Copyright &copy; 2008 <NAME> <EMAIL>
   -->
<! -- CVS: $Id: m_exception.html,v 1.3 2013/05/13 08:03:19 knystrom Exp $ flibs/m_exception.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/m_exception(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/m_exception - Manage exceptions</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">OVERVIEW</a>
<ul>
<li class="subsection"><a href="#subsection1">Simple use-case</a></li>
<li class="subsection"><a href="#subsection2">Controlling the execution</a></li>
<li class="subsection"><a href="#subsection3">Controlling output</a></li>
<li class="subsection"><a href="#subsection4">Pseudo-catch</a></li>
</ul>
</li>
<li class="section"><a href="#section3">ROUTINES</a></li>
<li class="section"><a href="#section4">TODO</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="method">exception_raiseFatalError</b> ( <i class="arg">message</i> )</a></li>
<li><a href="#2"><b class="method">exception_raiseError</b> ( <i class="arg">message</i> )</a></li>
<li><a href="#3"><b class="method">exception_raiseWarning</b> ( <i class="arg">message</i> )</a></li>
<li><a href="#4"><b class="method">exception_raiseInformation</b> ( <i class="arg">message</i> )</a></li>
<li><a href="#5"><b class="method">exception_raiseFailure</b> ( <i class="arg">message</i> )</a></li>
<li><a href="#6"><b class="method">exception_setstoponerror</b> ( <i class="arg">stoponerror</i> )</a></li>
<li><a href="#7"><b class="method">exception_initcounter</b> ( )</a></li>
<li><a href="#8"><b class="method">exception_getcounter</b> ( )</a></li>
<li><a href="#9"><b class="method">exception_report</b> ( )</a></li>
<li><a href="#10"><b class="method">exception_setlogunit</b> ( <i class="arg">unitnumber</i> )</a></li>
<li><a href="#11"><b class="method">exception_getlogunit</b> ( ) result ( logunit )</a></li>
<li><a href="#12"><b class="method">exception_logactive</b> ( <i class="arg">bool</i> )</a></li>
<li><a href="#13"><b class="method">exception_islogactive</b> ( ) result ( islogactive )</a></li>
<li><a href="#14"><b class="method">exception_catch</b> ( <i class="arg">callback</i> <i class="arg">, status</i> ) result ( islogactive )</a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>Provides services to generate different levels of exceptions
and display the message of the exception.
Five levels of exceptions can be generated, from the lowest
to the highest level :</p>
<ul class="itemized">
<li><p>information, warning : just print a message and continue</p></li>
<li><p>error, fatal_error and failure : prints a message and stop the execution</p></li>
</ul>
</div>
<div id="section2" class="section"><h2><a name="section2">OVERVIEW</a></h2>
<div id="subsection1" class="subsection"><h3><a name="subsection1">Simple use-case</a></h3>
<p>Suppose that one would like to compute the square root of one
real value. The &quot;compute_sqrt&quot; function takes one positive real argument,
and if the argument is negative, one cannot compute the square root so
that one would generate an error. In the following example, extracted from the
unit tests included in the project, one uses the static method &quot;exception_raiseError&quot;
to display a user-friendly message and stop the execution of the program</p>
<pre class="example">
    function compute_sqrt ( value ) result ( root )
      use m_exception
      implicit none
      real, intent(in) :: value
      real :: root
      if ( value &lt; 0. ) then
        call exception_raiseError ( &quot;Value is negative in compute_sqrt&quot; )
      else 
        root = sqrt ( value )
      endif
   end function compute_sqrt
   real :: root
   root = compute_sqrt ( -1. )
</pre>
<p>In the previous example, the standard output is written so that the
 following message appears on screen.</p>
<pre class="example">
   Error.
   Message: Value is negative in compute_sqrt
</pre>
</div>
<div id="subsection2" class="subsection"><h3><a name="subsection2">Controlling the execution</a></h3>
<p>The client code can control the behaviour of the component each time
 an exception is raised.
 The default behaviour is to stop the execution. This can be modified
 by calling &quot;exception_setstoponerror&quot; in order to continue the execution,
 even if error, fatal error or failure exceptions are raised.</p>
<p>In the following example, the static method &quot;exception_setstoponerror&quot; is 
   called so that an error does not interrupt the execution.</p>
<pre class="example">
   call exception_setstoponerror ( .false. )
   call exception_raiseError ( &quot;There is an error, but the execution will continue.&quot; )
</pre>
</div>
<div id="subsection3" class="subsection"><h3><a name="subsection3">Controlling output</a></h3>
<p>The default behaviour is to write messages onto the standard output
   each time an exception is raised.
   This can be modified in two ways.</p>
<ul class="itemized">
<li><p>the first possibility is to disable the writing of the messages 
     with &quot;exception_logactive&quot;. This feature might be useful in the case
     where a component has known bugs but generates lots of unwanted
     exceptions messages.</p></li>
<li><p>the second possibility is to connect the component to an existing unit
     with &quot;exception_setlogunit&quot;, so that the messages are written
     on the given logical unit number. 
     This allows for example to write on an existing log file, may be the log 
     file manage by the m_logger component included in the project.</p></li>
</ul>
<p>In the following example, the client code first disables all output,
   set &quot;stoponerror&quot; to false and generates an error which is not displayed
   and does not interrupt the execution.</p>
<pre class="example">
   call exception_setstoponerror ( .false. )
   call exception_logactive ( .false. )
   call exception_raiseError ( &quot;This message will not be displayed and the execution will continue.&quot; )
   call exception_logactive ( .true. )
   call exception_raiseError ( &quot;This message WILL be displayed and the execution will continue.&quot; )
</pre>
<p>In the following example, the client code connect the m_exception component to 
   an existing unit so that the exception messages are written onto a client log file.</p>
<pre class="example">
     log_fileunit = 12
     call exception_setstoponerror ( .false. )
     open ( log_fileunit , FILE= &quot;log_file.log&quot; )
     call exception_setlogunit ( log_fileunit )
     call exception_raiseError ( &quot;This message will be written in log_file.log and the execution will continue.&quot; )
     call exception_setlogunit ( 0 )
     call exception_raiseError ( &quot;This message will be written on standard output and the execution will continue.&quot; )
     close ( log_fileunit )
</pre>
<p>In the following example, the client code connects the m_exception component to 
   the logfile manage by m_logger. This way, the exception messages are collected in the 
   unique log file of the client code.</p>
<pre class="example">
     call log_startup ( &quot;log_file.log&quot; , append=.true. )
     call log_cget ( &quot;logfileunit&quot; , log_fileunit )
     call exception_setstoponerror ( .false. )
     call exception_setlogunit ( log_fileunit )
     call exception_raiseError ( &quot;This message will be written in log_file.log and the execution will continue.&quot; )
     call log_shutdown ()
</pre>
</div>
<div id="subsection4" class="subsection"><h3><a name="subsection4">Pseudo-catch</a></h3>
<p>The client code can use a pseudo-catch system which provides
a simple way to manage exceptions which are raised at a lower
level in the call stack. This allows to provide special
treatments when exceptions are generated, without modifiying
all lower level subroutines/function, but just by inserting
exception management when needed.
Suppose that you have a subroutine which source code is the following.</p>
<pre class="example">
     subroutine yoursubroutine ()
       use m_exception, only : exception_raiseFatalError
       implicit none
       [...]
       call exception_raiseFatalError ( &quot;Wrong blabla in yoursubroutine&quot; )
       [...]
     end subroutine yoursubroutine
</pre>
<p>When calling the subroutine &quot;yoursubroutine&quot;, one may wonder if exceptions
   have been generated so that these errors may be processed, or not.
   One can use the &quot;exception_catch&quot; service to compute the status 
   of one subroutine and manage that status.</p>
<pre class="example">
     use m_exception, only : exception_catch, &amp;
         EXCEPTION_INFORMATION, &amp;
         EXCEPTION_WARNING &amp;
         EXCEPTION_ERROR &amp;
         EXCEPTION_FATAL_ERROR &amp;
         EXCEPTION_FAILURE
     integer :: status
     call exception_catch ( yoursubroutine , status )
     select case ( status )
     case ( EXCEPTION_INFORMATION )
        write(6,*) &quot;Information&quot;
     case ( EXCEPTION_WARNING )
        write(6,*) &quot;Warning&quot;
     case ( EXCEPTION_ERROR , EXCEPTION_FATAL_ERROR , EXCEPTION_FAILURE )
        write(6,*) &quot;Fatal error&quot;
     case default
        write(6,*) &quot;No problem, continue.&quot;
     end select
</pre>
</div>
</div>
<div id="section3" class="section"><h2><a name="section3">ROUTINES</a></h2>
<dl class="definitions">
<dt><a name="1"><b class="method">exception_raiseFatalError</b> ( <i class="arg">message</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>Generates a fatal error message and stops the execution.</p></dd>
<dt><a name="2"><b class="method">exception_raiseError</b> ( <i class="arg">message</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>Generates an error message and stops the execution.</p></dd>
<dt><a name="3"><b class="method">exception_raiseWarning</b> ( <i class="arg">message</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>Generates a warning message.</p></dd>
<dt><a name="4"><b class="method">exception_raiseInformation</b> ( <i class="arg">message</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>Generates an information message.</p></dd>
<dt><a name="5"><b class="method">exception_raiseFailure</b> ( <i class="arg">message</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>Generates a failure message and stops the execution</p></dd>
<dt><a name="6"><b class="method">exception_setstoponerror</b> ( <i class="arg">stoponerror</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">logical, intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>If <i class="arg">stoponerror</i> is true, then when an error, a fatal_error or a failure
is generated, then stop the execution.
If <i class="arg">stoponerror</i> is false, then the same exceptions do not stop the
execution.</p></dd>
<dt><a name="7"><b class="method">exception_initcounter</b> ( )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">logical, intent(in) ::</b> <i class="arg">message</i></dt>
<dd></dd>
</dl>
<p>Reset to 0 all the exceptions counters.</p></dd>
<dt><a name="8"><b class="method">exception_getcounter</b> ( )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer, dimension(1:EXCEPTION_SIZE), intent(out) ::</b> <i class="arg">counter</i></dt>
<dd></dd>
</dl>
<p>Returns an array of size EXCEPTION_SIZE indicating the number
of exceptions of each type. The value of <i class="arg">excepcounters ( iexcept )</i>
is the total number of exceptions of type #iexcept generated since the begining 
of the execution. The possible values for iexcept are the following.</p>
<ul class="itemized">
<li><p>counter ( EXCEPTION_INFORMATION ) : total number of information exceptions raised</p></li>
<li><p>counter ( EXCEPTION_WARNING ) : total number of warning exceptions raised</p></li>
<li><p>counter ( EXCEPTION_ERROR ) : total number of error exceptions raised</p></li>
<li><p>counter ( EXCEPTION_FATAL_ERROR ) : total number of fatal error exceptions raised</p></li>
<li><p>counter ( EXCEPTION_FAILURE ) : total number of failure exceptions raised</p></li>
</ul></dd>
<dt><a name="9"><b class="method">exception_report</b> ( )</a></dt>
<dd><p>Writes on the current exception unit number a report
which details the number of exceptions of all types
since the begining of the execution or the last reset of
all counters.</p></dd>
<dt><a name="10"><b class="method">exception_setlogunit</b> ( <i class="arg">unitnumber</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer, intent(in) ::</b> <i class="arg">unitnumber</i></dt>
<dd></dd>
</dl>
<p>Set the unit number onto which the messages are output.
If the unitnumber is 0, the messages are written
to the standard output (unit *).</p></dd>
<dt><a name="11"><b class="method">exception_getlogunit</b> ( ) result ( logunit )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer ::</b> <i class="arg">logunit</i></dt>
<dd></dd>
</dl>
<p>Returns the unit number onto which the messages are output,
if enabled or 0 if the feature is disabled.</p></dd>
<dt><a name="12"><b class="method">exception_logactive</b> ( <i class="arg">bool</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">logical, intent(in) ::</b> <i class="arg">bool</i></dt>
<dd></dd>
</dl>
<p>If the boolean argument <i class="arg">bool</i> is true, enable the logging 
of the exceptions messages.
If the boolean argument <i class="arg">bool</i> is false, disable the logging
of the exceptions messages.</p></dd>
<dt><a name="13"><b class="method">exception_islogactive</b> ( ) result ( islogactive )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">logical ::</b> <i class="arg">islogactive</i></dt>
<dd></dd>
</dl>
<p>Returns .true. if the current exception messages are written,
either on standard output or into a log file.</p></dd>
<dt><a name="14"><b class="method">exception_catch</b> ( <i class="arg">callback</i> <i class="arg">, status</i> ) result ( islogactive )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">integer, intent(out) ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<pre class="example">
    interface interfacecallback
       subroutine callback ()
       end subroutine callback
    end interface interfacecallback
</pre>
<p>Calls the given subroutine <i class="arg">callback</i> and set <i class="arg">status</i> as an 
the integer associated with last exception, higher level, code or 0 if no exception
was raised.
Caution : the internal algorithm is based on the exception counters,
which implies that any call to exception_initcounter in the client
code can result in a wrong status.</p></dd>
</dl>
</div>
<div id="section4" class="section"><h2><a name="section4">TODO</a></h2>
<ul class="itemized">
<li><p>design a more powerful exception management system, which manages exceptions
through the call stack.</p></li>
</ul>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2008 <NAME> <EMAIL><br>
Copyright &copy; 2008 <NAME> <EMAIL></p>
</div>
</div></body></html>

<|start_filename|>doc/filedir/m_vfile.html<|end_filename|>

<html><head>
<title>flibs/m_vfile - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'filedir/m_vfile.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2008 <NAME> <EMAIL>   -- Copyright &copy; 2008 <NAME> <EMAIL>
   -->
<! -- CVS: $Id: m_vfile.html,v 1.3 2013/05/13 08:03:15 knystrom Exp $ flibs/m_vfile.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/m_vfile(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/m_vfile - Processing files</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">OVERVIEW</a>
<ul>
<li class="subsection"><a href="#subsection1">Portability</a></li>
<li class="subsection"><a href="#subsection2">How to use it</a></li>
<li class="subsection"><a href="#subsection3">Error management</a></li>
<li class="subsection"><a href="#subsection4">Intel Fortran portability</a></li>
<li class="subsection"><a href="#subsection5">RENAME and GETCWD fortran extension</a></li>
<li class="subsection"><a href="#subsection6">Dynamic or static buffer</a></li>
<li class="subsection"><a href="#subsection7">Preprocessing</a></li>
<li class="subsection"><a href="#subsection8">Example of compiler settings</a></li>
</ul>
</li>
<li class="section"><a href="#section3">METHODS</a></li>
<li class="section"><a href="#section4">STATIC METHODS</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="method">vfile_rootname</b> ( <i class="arg">filename</i>) result ( rootname )</a></li>
<li><a href="#2"><b class="method">vfile_rootname</b> ( <i class="arg">filename</i>) result ( rootname )</a></li>
<li><a href="#3"><b class="method">vfile_extension</b> ( <i class="arg">filename</i>) result ( extension )</a></li>
<li><a href="#4"><b class="method">vfile_extension</b> ( <i class="arg">filename</i>) result ( extension )</a></li>
<li><a href="#5"><b class="method">vfile_tail</b> ( <i class="arg">filename</i>) result ( filetail )</a></li>
<li><a href="#6"><b class="method">vfile_tail</b> ( <i class="arg">filename</i>) result ( filetail )</a></li>
<li><a href="#7"><b class="method">vfile_dirname</b> ( <i class="arg">filename</i>) result ( dirname )</a></li>
<li><a href="#8"><b class="method">vfile_dirname</b> ( <i class="arg">filename</i>) result ( dirname )</a></li>
<li><a href="#9"><b class="method">vfile_first_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></li>
<li><a href="#10"><b class="method">vfile_first_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></li>
<li><a href="#11"><b class="method">vfile_last_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></li>
<li><a href="#12"><b class="method">vfile_last_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></li>
<li><a href="#13"><b class="method">vfile_join</b> ( <i class="arg">dirname</i> <i class="arg">filename</i>) result ( fullname )</a></li>
<li><a href="#14"><b class="method">vfile_join</b> ( <i class="arg">dirname</i> <i class="arg">, filename</i>) result ( fullname )</a></li>
<li><a href="#15"><b class="method">vfile_add_extension</b> ( <i class="arg">filename</i> <i class="arg">, extension</i> ) result ( newname )</a></li>
<li><a href="#16"><b class="method">vfile_separator</b> ( ) result ( separator )</a></li>
<li><a href="#17"><b class="method">vfile_pwd</b> ( <i class="arg">pwd</i> <span class="opt">?, status?</span> )</a></li>
<li><a href="#18"><b class="method">vfile_exists</b> ( <i class="arg">filename</i> ) result ( exists )</a></li>
<li><a href="#19"><b class="method">vfile_exists</b> ( <i class="arg">filename</i> ) result ( exists )</a></li>
<li><a href="#20"><b class="method">vfile_rename</b> ( <i class="arg">filename</i> <i class="arg">, newfn</i> <span class="opt">?, status?</span> )</a></li>
<li><a href="#21"><b class="method">vfile_rename</b> ( <i class="arg">filename</i> <i class="arg">, newfn</i> <span class="opt">?, status?</span> )</a></li>
<li><a href="#22"><b class="method">vfile_copy</b> ( <i class="arg">filename</i> <i class="arg">, targetfn</i> <span class="opt">?, status?</span> <span class="opt">?, mode?</span> <span class="opt">?, force?</span> <span class="opt">?, trimline?</span> )</a></li>
<li><a href="#23"><b class="method">vfile_copy</b> ( <i class="arg">filename</i> <i class="arg">, targetfn</i> <span class="opt">?, status?</span> <span class="opt">?, mode?</span> <span class="opt">?, force?</span> <span class="opt">?, trimline?</span> )</a></li>
<li><a href="#24"><b class="method">vfile_delete</b> ( <i class="arg">filename</i> <span class="opt">?, force?</span> <span class="opt">?, status?</span> )</a></li>
<li><a href="#25"><b class="method">vfile_delete</b> ( <i class="arg">filename</i> <span class="opt">?, force?</span> <span class="opt">?, status?</span> )</a></li>
<li><a href="#26"><b class="method">vfile_isdirectory</b> ( <i class="arg">filename</i>) result ( isdirectory )</a></li>
<li><a href="#27"><b class="method">vfile_isdirectory</b> ( <i class="arg">filename</i>) result ( isdirectory )</a></li>
<li><a href="#28"><b class="method">vfile_isfile</b> ( <i class="arg">filename</i>) result ( isfile )</a></li>
<li><a href="#29"><b class="method">vfile_isfile</b> ( <i class="arg">filename</i>) result ( isfile )</a></li>
<li><a href="#30"><b class="method">vfile_size</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_size )</a></li>
<li><a href="#31"><b class="method">vfile_size</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_size )</a></li>
<li><a href="#32"><b class="method">vfile_atime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_atime )</a></li>
<li><a href="#33"><b class="method">vfile_atime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_atime )</a></li>
<li><a href="#34"><b class="method">vfile_mtime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_mtime )</a></li>
<li><a href="#35"><b class="method">vfile_mtime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_mtime )</a></li>
<li><a href="#36"><b class="method">vfile_normalize</b> ( <i class="arg">filename</i> ) result ( vfile_normalize )</a></li>
<li><a href="#37"><b class="method">vfile_normalize</b> ( <i class="arg">filename</i> ) result ( vfile_normalize )</a></li>
<li><a href="#38"><b class="method">vfile_find</b> ( <span class="opt">?basedir?</span> ) result ( listOfFiles )</a></li>
<li><a href="#39"><b class="method">vfile_find</b> ( <i class="arg">basedir</i> ) result ( listOfFiles )</a></li>
<li><a href="#40"><b class="method">vfile_find</b> ( <span class="opt">?basedir?</span> <i class="arg">, filtercmd</i> ) result ( listOfFiles )</a></li>
<li><a href="#41"><b class="method">vfile_find</b> ( <i class="arg">basedir</i> <i class="arg">, filtercmd</i> ) result ( listOfFiles )</a></li>
<li><a href="#42"><b class="method">vfile_findbypattern</b> ( <span class="opt">?basedir?</span> <i class="arg">, pattern</i> ) result ( listOfFiles )</a></li>
<li><a href="#43"><b class="method">vfile_findbypattern</b> ( <span class="opt">?basedir?</span> <i class="arg">, pattern</i> ) result ( listOfFiles )</a></li>
<li><a href="#44"><b class="method">vfile_listfiles</b> ( <span class="opt">?directory?</span> <span class="opt">?, filetypes?</span> <span class="opt">?, pattern?</span> <span class="opt">?, tails?</span>) result ( listOfFiles )</a></li>
<li><a href="#45"><b class="method">vfile_listfiles</b> ( <i class="arg">directory</i> <span class="opt">?, filetypes?</span> <span class="opt">?, pattern?</span> <span class="opt">?, tails?</span>) result ( listOfFiles )</a></li>
<li><a href="#46"><b class="method">vfile_type</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( filetype )</a></li>
<li><a href="#47"><b class="method">vfile_type</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( filetype )</a></li>
<li><a href="#48"><b class="method">vfile_split</b> ( <i class="arg">filename</i>) result ( listOfComponents )</a></li>
<li><a href="#49"><b class="method">vfile_split</b> ( <i class="arg">filename</i>) result ( listOfComponents )</a></li>
<li><a href="#50"><b class="method">vfile_touch</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></li>
<li><a href="#51"><b class="method">vfile_touch</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></li>
<li><a href="#52"><b class="method">vfile_pathtype</b> ( <i class="arg">filename</i>) result ( pathtype )</a></li>
<li><a href="#53"><b class="method">vfile_pathtype</b> ( <i class="arg">filename</i>) result ( pathtype )</a></li>
<li><a href="#54"><b class="method">vfile_nativename</b> ( <i class="arg">filename</i>) result ( nativename )</a></li>
<li><a href="#55"><b class="method">vfile_nativename</b> ( <i class="arg">filename</i>) result ( nativename )</a></li>
<li><a href="#56"><b class="method">vfile_mkdir</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></li>
<li><a href="#57"><b class="method">vfile_mkdir</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></li>
<li><a href="#58"><b class="method">vfile_open</b> ( <i class="arg">filename</i> <span class="opt">?, fileunit?</span> <span class="opt">?, iostat?</span> <span class="opt">?, status?</span> <span class="opt">?, access?</span> <span class="opt">?, form?</span> <span class="opt">?, recl?</span> <span class="opt">?, blank?</span> <span class="opt">?, position?</span> <span class="opt">?, action?</span> <span class="opt">?, delim?</span> <span class="opt">?, pad?</span>) result ( fileunit_real )</a></li>
<li><a href="#59"><b class="method">vfile_open</b> ( <i class="arg">filename</i> <span class="opt">?, fileunit?</span> <span class="opt">?, iostat?</span> <span class="opt">?, status?</span> <span class="opt">?, access?</span> <span class="opt">?, form?</span> <span class="opt">?, recl?</span> <span class="opt">?, blank?</span> <span class="opt">?, position?</span> <span class="opt">?, action?</span> <span class="opt">?, delim?</span> <span class="opt">?, pad?</span>) result ( fileunit_real )</a></li>
<li><a href="#60"><b class="method">vfile_startup</b> ()</a></li>
<li><a href="#61"><b class="method">vfile_shutdown</b> ()</a></li>
<li><a href="#62"><b class="method">vfile_set_stoponerror</b> ( <i class="arg">stoponerror</i> )</a></li>
<li><a href="#63"><b class="method">vfile_tempdir</b> () result ( tempdir )</a></li>
<li><a href="#64"><b class="method">vfile_tempfile</b> result ( tempfile )</a></li>
<li><a href="#65"><b class="method">vfile_volumes</b> result ( listofvolumes )</a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The module <em>m_vfile</em> provides OO services to process files and directories.
This component is based on a dynamic strings so that the
file or directory name may be defined with no limit in the
number of characters.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">OVERVIEW</a></h2>
<p>This component allows to manage the file system, by providing 
   services to create, move and destroy files and directories, and 
   to get informations about files and directories.
   The services provided are based either on standard fortran,
   or on fortran extensions.</p>
<div id="subsection1" class="subsection"><h3><a name="subsection1">Portability</a></h3>
<p>One of the main interest of this component is to separate
   the client-side application from platform-specific file 
   management or from compiler-specific fortran extensions.</p>
<p>This separation is possible because m_vfile
   deals for the platform directly, by using the m_platform
   module. This allows to design a client source code which 
   portable on several operating systems (for example windows,
   linux) without any change. For example, the several file 
   separators used on the various operating systems are taken
   into account internally : &quot;/&quot; on linux systems, &quot;\&quot; on 
   windows systems and &quot;:&quot; on Mac OS.</p>
<p>The portability is also ensured with respect to the 
   fortran compiler used to create the executable.
   All fortran compilers provide commands to rename the files
   or get the working directory. But not all fortran compilers
   define these commands the same way : some provide subroutines,
   some provide functions, etc... The current component can 
   be configured at compile-time with pre-processing commands.
   This allows to configure the component with compiler 
   specific settings, to make so that the component know
   what features your particular compiler knows about.</p>
<p>&lt;your application&gt; &gt; m_vfile (operating system , fortran compiler) &gt; m_platform (operating system , fortran compiler)</p>
</div>
<div id="subsection2" class="subsection"><h3><a name="subsection2">How to use it</a></h3>
<p>Before using the services provided by m_vfile, the client
   code must call vfile_startup which initializes platform-specific 
   commands. After using these services, the client code should call
   vfile_shutdown.</p>
<p>The commands vfile_delete, vfile_copy, vfile_rename
   allow to delete, copy and rename files or directories.
   To inquire about a file or directory, one can use 
   vfile_exists or vfile_isdirectory.</p>
<p>In the following example, one creates a new file with vfile_touch,
   rename that file and finally delete it.</p>
<pre class="example">
     call vfile_startup ()
     call vstring_new ( file , &quot;foo.txt&quot; )
     call vfile_touch ( file )
     call vfile_rename ( file , &quot;toto.txt&quot; )
     call vfile_delete ( file )
     call vstring_free ( file )
     call vfile_shutdown ()
</pre>
<p>The component makes no differences between file names 
   and directory names, except for methods which are specific 
   for file or for directory.</p>
<p>The vfile_separator method returns the platform-specific character 
   used on the current operating system.</p>
<p>The commands vfile_nativename , vfile_normalize , vfile_pathtype
   provide ways to manage file names and paths.
   The vfile_nativename function returns the platform-specific name of the file. 
   The vfile_pathtype command returns one of VFILE_PATHTYPE_ABSOLUTE, 
   VFILE_PATHTYPE_RELATIVE, VFILE_PATHTYPE_VOLUMERELATIVE which correspond to 
   the current file. The VFILE_PATHTYPE_VOLUMERELATIVE only exist on 
   windows. The vfile_normalize command returns a unique normalized 
   path representation for the file-system object (file, directory, link, 
   etc), whose string value can be used as a unique identifier for it.</p>
<p>The vfile_split and vfile_join services allows to separate
   or concatenate the components of a file. This can be useful
   when dealing with relative file or directories.
   The vfile_split command splits a file into pieces each time 
   the platform-specific separator is found.
   The vfile_join command concatenate a list of strings with 
   the platform-specific separator and returns the concatenated
   file name.</p>
<p>In the following example, extracted from the unit tests included in flibs,
   the file &quot;declaration.txt&quot; is first normalized, so that the normalized 
   dynamic string may have the value
   &quot;/home/bill/flibs/tests/filedir/declaration.txt&quot; under Windows 
   or &quot;C:/workbench/flibs/tests/filedir/declaration.txt&quot; under Linux.
   Then the file name is split into a list of strings, for example &quot;home&quot;,
   &quot;bill&quot;, &quot;flibs&quot;, &quot;tests&quot;, &quot;filedir&quot;, &quot;declaration.txt&quot;.
   The number of strings in the list is then computed with the method 
   vstrlist_length.</p>
<pre class="example">
     use m_vstring
     use m_vstringlist
     use m_vfile
     type ( t_vstring ) :: normalized
     type ( t_vstringlist ) :: listOfFiles
     integer :: numberOfStrings
     normalized = vfile_normalize ( &quot;declaration.txt&quot; )
     listOfFiles = vfile_split ( normalized )
     numberOfStrings = vstrlist_length ( listOfFiles )
</pre>
<p>One particularly useful command when dealing with files is 
   vfile_findbypattern. The command takes a string as an input
   file pattern. It then computes the list of all files which
   match that pattern. The string matching system is based on 
   the vstring_match method of the m_vstring module.</p>
<p>In the following example, extracted again from the unit tests
   of flibs, one computes the list of files in the directory &quot;testfindbypattern&quot;
   matching the pattern &quot;*dec*.txt&quot;.</p>
<pre class="example">
     type ( t_vstringlist ) :: listOfFiles
     listOfFiles = vfile_findbypattern ( &quot;testfindbypattern&quot; , pattern = &quot;*dec*.txt&quot; )
</pre>
</div>
<div id="subsection3" class="subsection"><h3><a name="subsection3">Error management</a></h3>
<p>The file management may raise errors, for example when the 
   user want to rename a file which does not exist.
   Many of the provided commands have an optional integer output 
   argument &quot;status&quot; which is zero when no error occurred 
   and non-zero in case of error.
   If the status argument is not provided and an error is generated,
   then the program stops and a message is displayed on standard 
   output.
   These are the public error flags that the current component may generate :</p>
<pre class="example">
     VFILE_ERROR_OK
     VFILE_ERROR_UNABLE_TO_OPEN_SOURCE
     VFILE_ERROR_UNABLE_TO_OPEN_TARGET
     VFILE_ERROR_UNABLE_TO_WRITE_TARGET
     VFILE_ERROR_SOURCE_FILE_DOES_NOT_EXIST
</pre>
</div>
<div id="subsection4" class="subsection"><h3><a name="subsection4">Intel Fortran portability</a></h3>
<p>Several methods of this component are based on Fortran extensions,
which requires compiler-specific settings.
For Intel Fortran compiler, the current implementation was based on
IFPORT.F90 file in the Intel release for details on the interfaces provided.
If the client code use these routines, it must define the pre-processing
macro _VFILE_INTEL_FORTRAN_PORTABILITY_ROUTINES</p>
</div>
<div id="subsection5" class="subsection"><h3><a name="subsection5">RENAME and GETCWD fortran extension</a></h3>
<p>Depending on the compiler, the &quot;RENAME&quot; fortran extension is
provided as a subroutine or a function.
For example, this is a short list of compilers and their particular
RENAME provided :</p>
<ul class="itemized">
<li><p>function : Intel Fortran, g95</p></li>
<li><p>subroutine : gfortran</p></li>
</ul>
<p>To inform the m_vfile module of the particular RENAME extension, 
one of the following pre-processing macro must be defined :</p>
<ul class="itemized">
<li><p>_VFILE_RENAME_FUNCTION</p></li>
<li><p>_VFILE_RENAME_SUBROUTINE</p></li>
</ul>
<p>The same situation happens with the GETCWD fortran extension. 
To inform the m_vfile module of the particular GETCWD extension, 
one of the following pre-processing macro must be defined :</p>
<ul class="itemized">
<li><p>_VFILE_GETCWD_FUNCTION</p></li>
<li><p>_VFILE_GETCWD_SUBROUTINE</p></li>
</ul>
</div>
<div id="subsection6" class="subsection"><h3><a name="subsection6">Dynamic or static buffer</a></h3>
<p>The internal algorithms provided by m_vstrings are based on
basic fortran character strings. In several situations, the
dynamic vstring has to be converted into a basic fortran character
buffer string, which size has to be given explicitly in the source
code, with &quot;character ( len = &lt;something&gt;)&quot; statement.
Two solutions are provided, and the user can define the pre-processing macro
_VFILE_STATIC_BUFFER to configure that :</p>
<ul class="itemized">
<li><p>the first solution is to set the size of the buffer statically,
to a constant integer value VSTRING_BUFFER_SIZE.</p></li>
<li><p>the second solution is to compute the size
of the buffer dynamically, with the fortran 90 len = vstring_length(this)
statement.</p></li>
</ul>
<p>If the _VFILE_STATIC_BUFFER is defined, then character strings of
constant size are used as buffers.
If the _VFILE_STATIC_BUFFER is not defined (which is the default),
then character strings of dynamic size are used as buffers.
The second solution is more efficient, because the strings are not
oversized or undersized, depending on the real number of characters
in the dynamic string. But the feature may not be provided
by the compiler at hand. For example, problems with the dynamic
length character string have been experienced with Intel Fortran 8.</p>
</div>
<div id="subsection7" class="subsection"><h3><a name="subsection7">Preprocessing</a></h3>
<p>The following preprocessing macro must be considered :</p>
<ul class="itemized">
<li><p>_VFILE_STATIC_BUFFER : see  the section &quot;Dynamic or static buffer&quot;</p></li>
<li><p>_VFILE_RENAME_FUNCTION or _VFILE_RENAME_SUBROUTINE : see the section &quot;RENAME and GETCWD fortran extension&quot;</p></li>
<li><p>_VFILE_GETCWD_FUNCTION or _VFILE_GETCWD_SUBROUTINE : see the section &quot;RENAME and GETCWD fortran extension&quot;</p></li>
</ul>
</div>
<div id="subsection8" class="subsection"><h3><a name="subsection8">Example of compiler settings</a></h3>
<p>This is an abstract of all macros for several compilers.</p>
<p>Compiler : <em>Intel Fortran V8.0</em></p>
<ul class="itemized">
<li><p>_VFILE_INTEL_FORTRAN_PORTABILITY_ROUTINES</p></li>
<li><p>_VFILE_RENAME_FUNCTION</p></li>
<li><p>_VFILE_STATIC_BUFFER</p></li>
<li><p>_VFILE_GETCWD_FUNCTION</p></li>
</ul>
<p>Compiler : <em>g95</em></p>
<ul class="itemized">
<li><p>_VFILE_RENAME_FUNCTION</p></li>
<li><p>_VFILE_GETCWD_FUNCTION</p></li>
</ul>
<p>Compiler : <em>gfortran</em></p>
<ul class="itemized">
<li><p>_VFILE_RENAME_SUBROUTINE</p></li>
<li><p>_VFILE_GETCWD_SUBROUTINE</p></li>
</ul>
</div>
</div>
<div id="section3" class="section"><h2><a name="section3">METHODS</a></h2>
<dl class="definitions">
<dt><a name="1"><b class="method">vfile_rootname</b> ( <i class="arg">filename</i>) result ( rootname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ) , intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">rootname</i></dt>
<dd></dd>
</dl>
<p>Returns the name without the extension (if any), that is, 
The part of the name _before_ the last &quot;.&quot; in <i class="arg">filename</i> or the whole name
if no &quot;.&quot; is present in <i class="arg">filename</i>. 
Example : if filename is &quot;declaration.txt&quot;, the file root name is &quot;declaration&quot;.</p></dd>
<dt><a name="2"><b class="method">vfile_rootname</b> ( <i class="arg">filename</i>) result ( rootname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">rootname</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="3"><b class="method">vfile_extension</b> ( <i class="arg">filename</i>) result ( extension )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">extension</i></dt>
<dd></dd>
</dl>
<p>Returns the extension (if any), that is the part of the name 
<em>after</em> and including the last &quot;.&quot; or empty if none
present. Example : if filename is &quot;declaration.txt&quot;, the file extension is &quot;.txt&quot;.</p></dd>
<dt><a name="4"><b class="method">vfile_extension</b> ( <i class="arg">filename</i>) result ( extension )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">extension</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="5"><b class="method">vfile_tail</b> ( <i class="arg">filename</i>) result ( filetail )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">filetail</i></dt>
<dd></dd>
</dl>
<p>Returns all of the characters in name after the last directory separator.
If <i class="arg">filename</i> contains no separators then returns <i class="arg">filename</i>.
Example : if filename is &quot;dir1/declaration.txt&quot;, the file tail is &quot;declaration.txt&quot;.</p></dd>
<dt><a name="6"><b class="method">vfile_tail</b> ( <i class="arg">filename</i>) result ( filetail )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">filetail</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="7"><b class="method">vfile_dirname</b> ( <i class="arg">filename</i>) result ( dirname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">dirname</i></dt>
<dd></dd>
</dl>
<p>Return the directory, that is, the part of the name <em>before</em> 
the last directory separator.
Example : if filename is &quot;dir1/declaration.txt&quot;, the directory name 
is &quot;dir1&quot;.</p></dd>
<dt><a name="8"><b class="method">vfile_dirname</b> ( <i class="arg">filename</i>) result ( dirname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">dirname</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="9"><b class="method">vfile_first_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">sepindex</i></dt>
<dd></dd>
</dl>
<p>Returns the index of the first separator in the given filename
or 0 if there is no separator in the given file name.</p></dd>
<dt><a name="10"><b class="method">vfile_first_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">sepindex</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="11"><b class="method">vfile_last_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">sepindex</i></dt>
<dd></dd>
</dl>
<p>Returns the index of the last separator in the given filename
or 0 if there is no separator in the given file name.</p></dd>
<dt><a name="12"><b class="method">vfile_last_separator_index</b> ( <i class="arg">filename</i>) result ( sepindex )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">sepindex</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="13"><b class="method">vfile_join</b> ( <i class="arg">dirname</i> <i class="arg">filename</i>) result ( fullname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">dirname</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">fullname</i></dt>
<dd></dd>
</dl>
<p>Join the current file with the given file name,
using the platform-specific separator as the joining character.
The result is always canonical for the current platform: / for
Unix and Windows, and : for Macintosh.
If a particular name is relative, then it will be joined to the previous
file name argument. Otherwise, any earlier arguments will be discarded,
and joining will proceed from the current argument.</p></dd>
<dt><a name="14"><b class="method">vfile_join</b> ( <i class="arg">dirname</i> <i class="arg">, filename</i>) result ( fullname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">dirname</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">fullname</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="15"><b class="method">vfile_add_extension</b> ( <i class="arg">filename</i> <i class="arg">, extension</i> ) result ( newname )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">extension</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">newname</i></dt>
<dd></dd>
</dl>
<p>Return a new file name with the given extension concatenated.
If the given file name ends with a dot and the given extension begins
with a dot, only one dot is kept.
Note that the extension of one file begins with a dot : &quot;.txt&quot; is a file
extension while &quot;txt&quot; is not.</p></dd>
<dt><a name="16"><b class="method">vfile_separator</b> ( ) result ( separator )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">separator</i></dt>
<dd></dd>
</dl>
<p>Return the native separator for the current platform
The separator depends on the platform :</p>
<ul class="itemized">
<li><p>&quot;/&quot; on Unix, Linux systems,</p></li>
<li><p>&quot;\&quot; on Windows systems,</p></li>
<li><p>&quot;:&quot; on Macintosh.</p></li>
</ul></dd>
<dt><a name="17"><b class="method">vfile_pwd</b> ( <i class="arg">pwd</i> <span class="opt">?, status?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">pwd</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Returns the name of the current directory by using the fortran
extension GETCWD.
The separator used here is the platform-independent &quot;/&quot;.</p></dd>
<dt><a name="18"><b class="method">vfile_exists</b> ( <i class="arg">filename</i> ) result ( exists )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical ::</b> <i class="arg">exists</i></dt>
<dd></dd>
</dl>
<p>Returns .true. if file name exists, .false. otherwise.</p></dd>
<dt><a name="19"><b class="method">vfile_exists</b> ( <i class="arg">filename</i> ) result ( exists )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical ::</b> <i class="arg">exists</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="20"><b class="method">vfile_rename</b> ( <i class="arg">filename</i> <i class="arg">, newfn</i> <span class="opt">?, status?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">newfn</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Renames the file ofdln to newfn by using the RENAME fortran extension.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.</p></dd>
<dt><a name="21"><b class="method">vfile_rename</b> ( <i class="arg">filename</i> <i class="arg">, newfn</i> <span class="opt">?, status?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">newfn</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">newfn</i> as a character string.</p></dd>
<dt><a name="22"><b class="method">vfile_copy</b> ( <i class="arg">filename</i> <i class="arg">, targetfn</i> <span class="opt">?, status?</span> <span class="opt">?, mode?</span> <span class="opt">?, force?</span> <span class="opt">?, trimline?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">targetfn</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in), optional ::</b> <i class="arg">mode</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) , optional ::</b> <i class="arg">force</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) , optional ::</b> <i class="arg">trimline</i></dt>
<dd></dd>
</dl>
<p>Copy the ascii file ofdln to targetfn.
If the source file does not exists, generates an error.
If the target file allready exists and force option is undefined
or defined to false, generates an error.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return</p>
<ul class="itemized">
<li><p>status = 1 when one was unable to open the source file</p></li>
<li><p>status = 2 when one was unable to open the target file</p></li>
<li><p>status = 3 when there was a problem while writing the target file</p></li>
<li><p>status = 4 when the source file does not exist</p></li>
</ul>
<p>If <i class="arg">mode</i> is not supplied or supplied and equals to &quot;system&quot;, then 
the copy is made using an operating system command.
If <i class="arg">mode</i> is supplied and equals to &quot;ascii&quot;, then the copy is made using standard
fortran.
The <i class="arg">force</i> option is available only in &quot;ascii&quot; mode. 
If <i class="arg">force</i> is supplied and true, if the target file allready exists, delete it before
making the copy. 
The <i class="arg">trimline</i> option is available only in &quot;ascii&quot; mode. 
If <i class="arg">trimline</i> is supplied and true, or not supplied, the lines of 
the file copy are trimmed.
If <i class="arg">trimline</i> is supplied and false, the number of columns in the file copy are all
of maximum possible length.</p>
<p>The &quot;ascii&quot; mode may not behave as expected :</p>
<ul class="itemized">
<li><p>The maximum number of columns in the source filename is 1000.</p></li>
<li><p>After execution, the target file is not an exact copy of the source file.
Because of the fortran format used, all the lines of the target file are of length 1000 :
blank spaces are appended at the end of the string.</p></li>
</ul></dd>
<dt><a name="23"><b class="method">vfile_copy</b> ( <i class="arg">filename</i> <i class="arg">, targetfn</i> <span class="opt">?, status?</span> <span class="opt">?, mode?</span> <span class="opt">?, force?</span> <span class="opt">?, trimline?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">targetfn</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in), optional ::</b> <i class="arg">mode</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) , optional ::</b> <i class="arg">force</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) , optional ::</b> <i class="arg">trimline</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">targetfn</i> as a character string.</p></dd>
<dt><a name="24"><b class="method">vfile_delete</b> ( <i class="arg">filename</i> <span class="opt">?, force?</span> <span class="opt">?, status?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) , optional ::</b> <i class="arg">force</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Removes the file or directory <i class="arg">filename</i>. 
Non-empty directories will be removed only if the <i class="arg">force</i> option is specified.
If <i class="arg">force</i> is supplied and true, forces to delete the directory, even if it is empty.
If <i class="arg">force</i> is not supplied or supplied and false, the directory is not deleted if it is empty.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.</p></dd>
<dt><a name="25"><b class="method">vfile_delete</b> ( <i class="arg">filename</i> <span class="opt">?, force?</span> <span class="opt">?, status?</span> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in) , optional ::</b> <i class="arg">force</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="26"><b class="method">vfile_isdirectory</b> ( <i class="arg">filename</i>) result ( isdirectory )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical ::</b> <i class="arg">isdirectory</i></dt>
<dd></dd>
</dl>
<p>Returns .true. if file name is a directory, .false. otherwise.</p></dd>
<dt><a name="27"><b class="method">vfile_isdirectory</b> ( <i class="arg">filename</i>) result ( isdirectory )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical ::</b> <i class="arg">isdirectory</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="28"><b class="method">vfile_isfile</b> ( <i class="arg">filename</i>) result ( isfile )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical ::</b> <i class="arg">isfile</i></dt>
<dd></dd>
</dl>
<p>Returns .true. if file name is a file, .false. otherwise.</p></dd>
<dt><a name="29"><b class="method">vfile_isfile</b> ( <i class="arg">filename</i>) result ( isfile )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">logical ::</b> <i class="arg">isfile</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="30"><b class="method">vfile_size</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_size )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">vfile_size</i></dt>
<dd></dd>
</dl>
<p>Returns .true. if file name is a file, .false. otherwise.
Returns an integer giving the size of file name in bytes. 
If the file doesn't exist or its size cannot be queried then an error is generated.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.</p></dd>
<dt><a name="31"><b class="method">vfile_size</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_size )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">vfile_size</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="32"><b class="method">vfile_atime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_atime )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">vfile_atime</i></dt>
<dd></dd>
</dl>
<p>Returns an integer representing the time at which file name was last accessed.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.</p></dd>
<dt><a name="33"><b class="method">vfile_atime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_atime )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">vfile_atime</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="34"><b class="method">vfile_mtime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_mtime )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">vfile_mtime</i></dt>
<dd></dd>
</dl>
<p>Returns an integer representing the time at which file name was last modified.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.</p></dd>
<dt><a name="35"><b class="method">vfile_mtime</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( vfile_mtime )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">vfile_mtime</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="36"><b class="method">vfile_normalize</b> ( <i class="arg">filename</i> ) result ( vfile_normalize )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">vfile_normalize</i></dt>
<dd></dd>
</dl>
<p>Returns a unique normalized path representation for the
file-system object (file, directory, link, etc), whose string
value can be used as a unique identifier for it. A normalized path
is an absolute path which has all '../', './' removed. Also it is one which
is in the ``standard'' format for the native platform.
On Windows or Mac, any platform-specific separator in the path
is replaced by the platform-independent separator &quot;/&quot;.
On Windows it also means we want the long form with that form's
case-dependence (which gives us a unique, case-dependent path).</p></dd>
<dt><a name="37"><b class="method">vfile_normalize</b> ( <i class="arg">filename</i> ) result ( vfile_normalize )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">vfile_normalize</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="38"><b class="method">vfile_find</b> ( <span class="opt">?basedir?</span> ) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in), optional ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<p>An implementation of the unix command find.
Returns a list of files or directories which are located in the
given basedir directory, and, recursively, in all sub-directories.
Each file in the resulting list has a path relative to the given
basedir directory.
If <i class="arg">basedir</i> is provided, this is the name of the base directory into which the search is done.
If <i class="arg">basedir</i> is not provided, the current directory is used by default.</p></dd>
<dt><a name="39"><b class="method">vfile_find</b> ( <i class="arg">basedir</i> ) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">basedir</i> as a character string.</p></dd>
<dt><a name="40"><b class="method">vfile_find</b> ( <span class="opt">?basedir?</span> <i class="arg">, filtercmd</i> ) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in), optional ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<pre class="example">
    interface
       function filtercmd ( filename ) result ( keepfile )
         use m_vstring, only : t_vstring
         type ( t_vstring ), intent(in) :: filename
         logical :: keepfile
       end function filtercmd
    end interface</pre>
<p>An implementation of the unix command find.
Returns a list of files or directories which are located in the
given basedir directory, and, recursively, in all sub-directories.
Each file in the resulting list has a path relative to the given
basedir directory.
If <i class="arg">basedir</i> is provided, this is the name of the base directory into which the search is done.
If <i class="arg">basedir</i> is not provided, the current directory is used by default.
The <i class="arg">filtercmd</i> command, if provided, is interpreted as a command prefix and 
one argument is passed to it, the name of the file or directory find is currently
looking at. Note that this name is not fully qualified. It has to be joined it with
the result of pwd to get an absolute filename. The result of filtercmd is a boolean value
that indicates if the current file should be included in the list of interesting files.</p></dd>
<dt><a name="41"><b class="method">vfile_find</b> ( <i class="arg">basedir</i> <i class="arg">, filtercmd</i> ) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<pre class="example">
    interface
       function filtercmd ( filename ) result ( keepfile )
         use m_vstring, only : t_vstring
         type ( t_vstring ), intent(in) :: filename
         logical :: keepfile
       end function filtercmd
    end interface</pre>
<p>Same as previous but with <i class="arg">basedir</i> as a character string.</p></dd>
<dt><a name="42"><b class="method">vfile_findbypattern</b> ( <span class="opt">?basedir?</span> <i class="arg">, pattern</i> ) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in), optional ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">pattern</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<p>Returns a list of files which match the given pattern.
Internally, this command is based on vfile_find, with a particular filter command applied.
If <i class="arg">basedir</i> is provided, this is the name of the base directory into which the search is done.
If <i class="arg">basedir</i> is not provided, the current directory is used by default.
The <i class="arg">pattern</i> is the pattern for the file names (like: *.f90) against which 
each file name is compared. The method used for string matching 
is vstring_match, so that all features available is vstring_match are 
available in vfile_findbypattern.</p></dd>
<dt><a name="43"><b class="method">vfile_findbypattern</b> ( <span class="opt">?basedir?</span> <i class="arg">, pattern</i> ) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in), optional ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">pattern</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">basedir</i> and <i class="arg">pattern</i> as a character string.</p></dd>
<dt><a name="44"><b class="method">vfile_listfiles</b> ( <span class="opt">?directory?</span> <span class="opt">?, filetypes?</span> <span class="opt">?, pattern?</span> <span class="opt">?, tails?</span>) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in), optional ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ), intent(in), optional ::</b> <i class="arg">pattern</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ), intent(in), optional ::</b> <i class="arg">pattern</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in), optional ::</b> <i class="arg">tails</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<p>Returns a list of files in one directory.
Only the file tails are in the list.
If <i class="arg">directory</i> is provided, the directory into which the list is to be computed.
If <i class="arg">directory</i> is not provided, the current directory is used and only the file names are file tails.
If <i class="arg">directory</i> is provided, the computed files names are relative and begin with the given 
directory (following the template directory/filetail).
If <i class="arg">filetypes</i> is provided, only list files or directories which match filetypes,
with d (directory), f (plain file).
If <i class="arg">filetypes</i> is not provided, the filetypes &quot;d&quot; , &quot;f&quot; list is used.
If <i class="arg">pattern</i> is provided, only list files which match the given pattern.
If <i class="arg">pattern</i> is not provided, the &quot;*&quot; pattern is used.
The vstring_match command is used to compare the file against the pattern so that
all the pattern types available in vstring_match are available in vfile_listfiles.
If <i class="arg">tails</i> is provided and true, only return the part of each file found 
which follows the last directory named in directory.
Thus the statement</p>
<pre class="example">
listoffiles = vfile_listfile ( tails = .true. , directory = directory , pattern = &quot;*&quot; )
</pre>
<p>is equivalent to</p>
<pre class="example">
call vfile_pwd ( cwd )
call vstrplatform_cd ( directory )
listoffiles = vfile_listfile ( tails = .true. , pattern = &quot;*&quot; )
call vstrplatform_cd ( cwd )
</pre>
<p>If <i class="arg">tails</i> is provided and false, or not provided, the files are left as specified by the
directory argument.</p></dd>
<dt><a name="45"><b class="method">vfile_listfiles</b> ( <i class="arg">directory</i> <span class="opt">?, filetypes?</span> <span class="opt">?, pattern?</span> <span class="opt">?, tails?</span>) result ( listOfFiles )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">basedir</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ), intent(in), optional ::</b> <i class="arg">pattern</i></dt>
<dd></dd>
<dt><b class="type">character(len=*), intent(in), optional ::</b> <i class="arg">pattern</i></dt>
<dd></dd>
<dt><b class="type">logical, intent(in), optional ::</b> <i class="arg">tails</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfFiles</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">directory</i> and <i class="arg">pattern</i> as a character string.</p></dd>
<dt><a name="46"><b class="method">vfile_type</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( filetype )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(out), optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">filetype</i></dt>
<dd></dd>
</dl>
<p>Returns a string giving the type of file name, which will be one of &quot;file&quot; or &quot;directory&quot;.
If <i class="arg">status</i> is provided and the file type could be computed,
the status is set to 0.
If <i class="arg">status</i> is provided and the file type could not be computed,
the status is set to VFILE_ERROR_UNKNOWN_FILE_TYPE.
If <i class="arg">status</i> is not provided and the file type could not be computed,
an error is generated.</p></dd>
<dt><a name="47"><b class="method">vfile_type</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>) result ( filetype )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(out), optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">filetype</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="48"><b class="method">vfile_split</b> ( <i class="arg">filename</i>) result ( listOfComponents )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfComponents</i></dt>
<dd></dd>
</dl>
<p>Returns a list of strings where elements are the path components in name.</p></dd>
<dt><a name="49"><b class="method">vfile_split</b> ( <i class="arg">filename</i>) result ( listOfComponents )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listOfComponents</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="50"><b class="method">vfile_touch</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Implementation of touch. Alter the atime and mtime of the specified files. 
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.
If <i class="arg">status</i> is not provided and the process could not be done,
an error is generated.</p></dd>
<dt><a name="51"><b class="method">vfile_touch</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="52"><b class="method">vfile_pathtype</b> ( <i class="arg">filename</i>) result ( pathtype )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">pathtype</i></dt>
<dd></dd>
</dl>
<p>Returns one of VFILE_PATHTYPE_ABSOLUTE, VFILE_PATHTYPE_RELATIVE, VFILE_PATHTYPE_VOLUMERELATIVE. 
If <i class="arg">filename</i> refers to a specific file on a specific volume, the path
type will be absolute. If <i class="arg">filename</i> refers to a file relative to the current
working directory, then the path type will be relative. If name refers to
a file relative to the current working directory on a specified volume, or to
a specific file on the current working volume, then the path type is volumerelative.</p>
<p>Examples :</p>
<ul class="itemized">
<li><p>&quot;.&quot; is relative on all platforms</p></li>
<li><p>&quot;..&quot; is relative on all platforms</p></li>
<li><p>&quot;/&quot; is absolute on Linux/Unix</p></li>
<li><p>&quot;C:/&quot; is absolute on Windows (if the C:/ exists)</p></li>
<li><p>&quot;/&quot; is volumerelative on windows and refers to the current volume (for example C:/)</p></li>
<li><p>&quot;toto.txt&quot; is relative on all platforms</p></li>
<li><p>&quot;./toto.txt&quot; is relative on all platforms</p></li>
</ul></dd>
<dt><a name="53"><b class="method">vfile_pathtype</b> ( <i class="arg">filename</i>) result ( pathtype )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">pathtype</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="54"><b class="method">vfile_nativename</b> ( <i class="arg">filename</i>) result ( nativename )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">( t_vstring ) ::</b> <i class="arg">nativename</i></dt>
<dd></dd>
</dl>
<p>Returns the platform-specific name of the file. 
filename is useful if the filename is needed to pass to a platform-specific
call, such as the execution of a system command under Windows or
AppleScript on the Macintosh.</p></dd>
<dt><a name="55"><b class="method">vfile_nativename</b> ( <i class="arg">filename</i>) result ( nativename )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">( t_vstring ) ::</b> <i class="arg">nativename</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="56"><b class="method">vfile_mkdir</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Create a directory.
If <i class="arg">status</i> is supplied, it contains 0 on success or nonzero error code
upon return.
If <i class="arg">status</i> is not provided and the process could not be done,
an error is generated.</p></dd>
<dt><a name="57"><b class="method">vfile_mkdir</b> ( <i class="arg">filename</i> <span class="opt">?, status?</span>)</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
<dt><a name="58"><b class="method">vfile_open</b> ( <i class="arg">filename</i> <span class="opt">?, fileunit?</span> <span class="opt">?, iostat?</span> <span class="opt">?, status?</span> <span class="opt">?, access?</span> <span class="opt">?, form?</span> <span class="opt">?, recl?</span> <span class="opt">?, blank?</span> <span class="opt">?, position?</span> <span class="opt">?, action?</span> <span class="opt">?, delim?</span> <span class="opt">?, pad?</span>) result ( fileunit_real )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">fileunit</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">action</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">access</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">form</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">blank</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">position</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">delim</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">pad</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(in) , optional ::</b> <i class="arg">recl</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(out) , optional ::</b> <i class="arg">iostat</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">fileunit_real</i></dt>
<dd></dd>
</dl>
<p>Open a file and returns the unit associated with the opened file.
The command is based on fortran intrinsic &quot;open&quot;.
If the optional argument fileunit is provided, it is used to
open the file.
If not provided, a file unit is automatically computed
on the base of currently free logical units.</p>
<p>Note:</p>
<p>All the options of the intrinsic &quot;open&quot; are provided
with the same behaviour and default values, with some exceptions.</p>
<ul class="itemized">
<li><p>The file name is mandatory in vfile_open,
even if the &quot;file=&quot; specifier is not mandatory in fortran &quot;open&quot;.
This behaviour allows the fortran to manage a status=&quot;scratch&quot;
specifier, which provides a way to manage for temporary
files internally. Instead, the m_vfile component provides the
vfile_tempfile service.</p></li>
<li><p>The &quot;err=&quot; option with an error label as argument is not
provided. The client code may use the iostat option instead.</p></li>
</ul></dd>
<dt><a name="59"><b class="method">vfile_open</b> ( <i class="arg">filename</i> <span class="opt">?, fileunit?</span> <span class="opt">?, iostat?</span> <span class="opt">?, status?</span> <span class="opt">?, access?</span> <span class="opt">?, form?</span> <span class="opt">?, recl?</span> <span class="opt">?, blank?</span> <span class="opt">?, position?</span> <span class="opt">?, action?</span> <span class="opt">?, delim?</span> <span class="opt">?, pad?</span>) result ( fileunit_real )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">character(len=*), intent(in) ::</b> <i class="arg">filename</i></dt>
<dd></dd>
<dt><b class="type">integer, intent(out) , optional ::</b> <i class="arg">fileunit</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">action</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">status</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">access</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">form</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">blank</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">position</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">delim</i></dt>
<dd></dd>
<dt><b class="type">character(len=*) , intent(in) , optional ::</b> <i class="arg">pad</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(in) , optional ::</b> <i class="arg">recl</i></dt>
<dd></dd>
<dt><b class="type">integer , intent(out) , optional ::</b> <i class="arg">iostat</i></dt>
<dd></dd>
<dt><b class="type">integer ::</b> <i class="arg">fileunit_real</i></dt>
<dd></dd>
</dl>
<p>Same as previous but with <i class="arg">filename</i> as a character string.</p></dd>
</dl>
</div>
<div id="section4" class="section"><h2><a name="section4">STATIC METHODS</a></h2>
<dl class="definitions">
<dt><a name="60"><b class="method">vfile_startup</b> ()</a></dt>
<dd><p>Initialize module internal state.
This routine must be called once before calling any method of the module.</p></dd>
<dt><a name="61"><b class="method">vfile_shutdown</b> ()</a></dt>
<dd><p>Shutdown module internal state.</p></dd>
<dt><a name="62"><b class="method">vfile_set_stoponerror</b> ( <i class="arg">stoponerror</i> )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">logical , intent(in) ::</b> <i class="arg">stoponerror</i></dt>
<dd></dd>
</dl>
<p>Configure the behaviour of the component whenever an
error is met.
If <i class="arg">stoponerror</i> is true, then the execution stops if an error is encountered.
If <i class="arg">stoponerror</i> is false, then the execution continues if an error is encountered.
In both cases, a message is displayed on standard output.</p></dd>
<dt><a name="63"><b class="method">vfile_tempdir</b> () result ( tempdir )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">tempdir</i></dt>
<dd></dd>
</dl>
<p>Returns the temporary directory for the current platform.
The command returns the path of a directory where the caller can
place temporary files, such as &quot;/tmp&quot; on Unix systems.
The algorithm we use to find the correct directory is as follows:</p>
<ol class="enumerated">
<li><p>The directory named in the TMPDIR environment variable.</p></li>
<li><p>The directory named in the TEMP environment variable.</p></li>
<li><p>The directory named in the TMP environment variable.</p></li>
<li><p>A platform specific location:</p>
<ul class="itemized">
    
<li><p>Windows
    &quot;C:\TEMP&quot;, &quot;C:\TMP&quot;, &quot;\TEMP&quot;, and &quot;\TMP&quot; are tried in that order.
    (classic) Macintosh
    The TRASH_FOLDER environment variable is used. filename is most likely not correct.</p></li>
<li><p>Unix
    The directories &quot;/tmp&quot;, &quot;/var/tmp&quot;, and &quot;/usr/tmp&quot; are tried in that order.</p></li>
</ul>
</li>
</ol></dd>
<dt><a name="64"><b class="method">vfile_tempfile</b> result ( tempfile )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstring ) ::</b> <i class="arg">tempfile</i></dt>
<dd></dd>
</dl>
<p>Returns the name of a temporary file name suitable for writing to. 
The <i class="arg">tempfile</i> name is unique, and the file will be writable and
contained in the appropriate system specific temp directory.</p></dd>
<dt><a name="65"><b class="method">vfile_volumes</b> result ( listofvolumes )</a></dt>
<dd><dl class="arguments">
<dt><b class="type">type ( t_vstringlist ) ::</b> <i class="arg">listofvolumes</i></dt>
<dd></dd>
</dl>
<p>Returns the absolute paths to the volumes mounted on the 
system, as a proper string list.
On UNIX, the command will always return &quot;/&quot;, since all filesystems are
locally mounted.
On Windows, it will return a list of the available
local drives (e.g. {a:/ c:/}).</p>
<p>Note:</p>
<p>With Intel Fortran, the portability routines provide the &quot;GETDRIVESQQ&quot; function,
which returns the list of current drive as a 26 letters string.</p></dd>
</dl>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2008 <NAME> <EMAIL><br>
Copyright &copy; 2008 <NAME> <EMAIL></p>
</div>
</div></body></html>

<|start_filename|>src/reporting/m_exception.f90<|end_filename|>
!
! m_exception --
!
!   Provides services to generate different levels of exceptions
!   and display the message of the exception.
!   Five levels of exceptions can be generated, from the lowest 
!   to the highest level :
!   - information, warning : just print a message and continue
!   - error, fatal_error and failure : prints a message and stop the execution
!
! OVERVIEW
!
!   Simple use-case
!
!   Suppose that one would like to compute the square root of one 
!   real value. The "compute_sqrt" function takes one positive real argument,
!   and if the argument is negative, one cannot compute the square root so 
!   that one would generate an error. In the following example, extracted from the 
!   unit tests included in the project, one uses the static method "exception_raiseError" 
!   to display a user-friendly message and stop the execution of the program
! 
!    function compute_sqrt ( value ) result ( root )
!      use m_exception
!      implicit none
!      real, intent(in) :: value
!      real :: root
!      if ( value < 0. ) then
!        call exception_raiseError ( "Value is negative in compute_sqrt" )
!      else 
!        root = sqrt ( value )
!      endif
!   end function compute_sqrt
!
!   real :: root
!   root = compute_sqrt ( -1. )
! 
!   In the previous example, the standard output is written so that the 
!   following message appears on screen :
!
!   Error.
!   Message: Value is negative in compute_sqrt
!
!   Controlling the execution
! 
!   The client code can control the behaviour of the component each time 
!   an exception is raised.
!   The default behaviour is to stop the execution. This can be modified
!   by calling "exception_setstoponerror" in order to continue the execution,
!   even if error, fatal error or failure exceptions are raised.
!
!   In the following example, the static method "exception_setstoponerror" is 
!   called so that an error does not interrupt the execution.
!
!   call exception_setstoponerror ( .false. )
!   call exception_raiseError ( "There is an error, but the execution will continue." )
!
! Controlling output
!
!   The default behaviour is to write messages onto the standard output
!   each time an exception is raised.
!   This can be modified in two ways :
!   * the first possibility is to disable the writing of the messages 
!     with "exception_logactive". This feature might be useful in the case
!     where a component has known bugs but generates lots of unwanted
!     exceptions messages.
!   * the second possibility is to connect the component to an existing unit
!     with "exception_setlogunit", so that the messages are written
!     on the given logical unit number. 
!     This allows for example to write on an existing log file, may be the log 
!     file manage by the m_logger component included in the project.
!
!   In the following example, the client code first disables all output,
!   set "stoponerror" to false and generates an error which is not displayed
!   and does not interrupt the execution.
!
!   call exception_setstoponerror ( .false. )
!   call exception_logactive ( .false. )
!   call exception_raiseError ( "This message will not be displayed and the execution will continue." )
!   call exception_logactive ( .true. )
!   call exception_raiseError ( "This message WILL be displayed and the execution will continue." )
!
!   In the following example, the client code connects the m_exception component to 
!   an existing unit so that the exception messages are written onto a client log file.
!
!     log_fileunit = 12
!     call exception_setstoponerror ( .false. )
!     open ( log_fileunit , FILE= "log_file.log" )
!     call exception_setlogunit ( log_fileunit )
!     call exception_raiseError ( "This message will be written in log_file.log and the execution will continue." )
!     call exception_setlogunit ( 0 )
!     call exception_raiseError ( "This message will be written on standard output and the execution will continue." )
!     close ( log_fileunit )
!
!   In the following example, the client code connects the m_exception component to 
!   the logfile manage by m_logger. This way, the exception messages are collected in the 
!   unique log file of the client code.
!
!     call log_startup ( "log_file.log" , append=.true. )
!     call log_cget ( "logfileunit" , log_fileunit )
!     call exception_setstoponerror ( .false. )
!     call exception_setlogunit ( log_fileunit )
!     call exception_raiseError ( "This message will be written in log_file.log and the execution will continue." )
!     call log_shutdown ()
!
! Pseudo-catch
!
!   The client code can use a pseudo-catch system which provides
!   a simple way to manage exceptions which are raised at a lower 
!   level in the call stack. This allows to provide special 
!   treatments when exceptions are generated, without modifiying
!   all lower level subroutines/function, but just by inserting 
!   exception management when needed.
!   Suppose that you have a subroutine which source code is :
!     subroutine yoursubroutine ()
!       use m_exception, only : exception_raiseFatalError
!       implicit none
!       [...]
!       call exception_raiseFatalError ( "Wrong blabla in yoursubroutine" )
!       [...]
!     end subroutine yoursubroutine
!   When calling the subroutine "yoursubroutine", one may wonder if exceptions
!   have been generated so that these errors may be processed, or not.
!   One can use the "exception_catch" service to compute the status 
!   of one subroutine and manage that status :
!     use m_exception, only : exception_catch, &
!         EXCEPTION_INFORMATION, &
!         EXCEPTION_WARNING &
!         EXCEPTION_ERROR &
!         EXCEPTION_FATAL_ERROR &
!         EXCEPTION_FAILURE
!     integer :: status
!     call exception_catch ( yoursubroutine , status )
!     select case ( status )
!     case ( EXCEPTION_INFORMATION )
!        write(6,*) "Information"
!     case ( EXCEPTION_WARNING )
!        write(6,*) "Warning"
!     case ( EXCEPTION_ERROR , EXCEPTION_FATAL_ERROR , EXCEPTION_FAILURE )
!        write(6,*) "Fatal error"
!     case default
!        write(6,*) "No problem, continue."
!     end select
!
! TODO
!   - design a more powerful exception management system, which manages exceptions
!   through the call stack
!
! Copyright (c) 2008 <NAME>
!
! $Id: m_exception.f90,v 1.5 2013/05/13 08:03:21 knystrom Exp $
!
module m_exception
  implicit none
  private
  !
  ! Public methods
  !
  public :: exception_getcounter
  public :: exception_getlogunit
  public :: exception_initcounter
  public :: exception_islogactive
  public :: exception_logactive
  public :: exception_raiseError
  public :: exception_raiseFailure
  public :: exception_raiseFatalError
  public :: exception_raiseInformation
  public :: exception_raiseWarning
  public :: exception_report
  public :: exception_setlogunit
  public :: exception_setstoponerror
  public :: exception_catch
  !
  ! Tags to manage error
  !
  integer, parameter, public :: EXCEPTION_OK = 0
  integer, parameter, public :: EXCEPTION_INFORMATION = 1
  integer, parameter, public :: EXCEPTION_WARNING = 2
  integer, parameter, public :: EXCEPTION_ERROR = 3
  integer, parameter, public :: EXCEPTION_FATAL_ERROR = 4
  integer, parameter, public :: EXCEPTION_FAILURE = 5
  integer, parameter, public :: EXCEPTION_SIZE = 5
  !
  ! Set to true to stop the execution after a stoping error.
  !
  logical :: exception_stoponerror = .true.
  !
  ! Counters for the different levels of errors
  !
  integer :: exception_nbinformation = 0
  integer :: exception_nbwarning = 0
  integer :: exception_nberror = 0
  integer :: exception_nbfatalerror = 0
  integer :: exception_nbfailure = 0
  !
  ! Maximum number of characters in a message generated by the exception
  !
  integer , parameter :: EXCEPTION_MAXIMUM_LENGTH = 500
  !
  ! Set exception_log_active to true to activate the exception logging
  ! to the unit # exception_log_unit
  !
  integer :: exception_log_unit = 0
  logical :: exception_log_unit_active = .false.
  !
  ! Set exception_log_active to true to display the exception messages
  !
  logical :: exception_log_active = .true.
contains
  !
  ! exception_raiseFatalError --
  !   Generates a fatal error message and stops the execution.
  !
  subroutine exception_raiseFatalError ( message )
    character(len=*), intent(in) :: message
    exception_nbfatalerror = exception_nbfatalerror + 1
    call exception_print(EXCEPTION_FATAL_ERROR, message )
    call exception_stop ()
  end subroutine exception_raiseFatalError
  !
  ! exception_raiseError --
  !   Generates an error message and stops the execution
  !
  subroutine exception_raiseError ( message )
    character(len=*), intent(in) :: message
    exception_nberror = exception_nberror + 1
    call exception_print(EXCEPTION_ERROR, message )
    call exception_stop ()
  end subroutine exception_raiseError
  !
  ! exception_raiseWarning --
  !   Generates a warning message
  !
  subroutine exception_raiseWarning ( message )
    character(len=*), intent(in) :: message
    exception_nbwarning = exception_nbwarning + 1
    call exception_print(EXCEPTION_WARNING, message )
  end subroutine exception_raiseWarning
  !
  ! exception_raiseInformation --
  !   Generates an information message.
  !
  subroutine exception_raiseInformation ( message )
    character(len=*), intent(in) :: message
    exception_nbinformation = exception_nbinformation + 1
    call exception_print(EXCEPTION_INFORMATION, message )
  end subroutine exception_raiseInformation
  !
  ! exception_raiseFailure --
  !   Generates a failure message and stops the execution
  !
  subroutine exception_raiseFailure ( message )
    character(len=*), intent(in) :: message
    exception_nbfailure = exception_nbfailure + 1
    call exception_print(EXCEPTION_FAILURE, message )
    call exception_stop ()
  end subroutine exception_raiseFailure
  !
  ! exception_print --
  !   Prints a message on the standard output about 
  !   the current exception type, the origin of the error and the 
  !   message of the error.
  ! Arguments :
  !   exceptionCode : an integer exception code between : EXCEPTION_INFORMATION,
  !     EXCEPTION_WARNING, EXCEPTION_ERROR, EXCEPTION_FATAL_ERROR, EXCEPTION_FAILURE
  !   origin : the name of the element generating the exception
  !   message : a message to display
  !
  subroutine exception_print ( exceptionCode , message )
    integer, intent(in) :: exceptionCode
    character(len=*), intent(in) :: message
    character ( len = EXCEPTION_MAXIMUM_LENGTH ) :: msg
    select case (exceptionCode)
    case (EXCEPTION_INFORMATION)
       write ( msg , * ) "Information."
    case (EXCEPTION_WARNING)
       write(msg,*) "Warning."
    case (EXCEPTION_ERROR)
       write(msg,*) "Error."
    case (EXCEPTION_FATAL_ERROR)
       write(msg,*) "Fatal error."
    case (EXCEPTION_FAILURE)
       write(msg,*) "Failure."
    case default
       write(msg,*) "Bad value for the exception code."
    end select
    call exception_logmsg ( msg )
    write(msg,*) "Message: ", trim(message)
    call exception_logmsg ( msg )
  end subroutine exception_print
  !
  ! exception_stop --
  !   Stop the execution after an exception has been raised.
  ! Note :
  !   In debug mode, put a breakpoint here allows to see the exception
  !   before stopping.
  !
  subroutine exception_stop ()
    if ( exception_stoponerror ) then
       STOP
    endif
  end subroutine exception_stop
  !
  ! exception_setstoponerror --
  !   Configure the component to manage the behaviour when an exception 
  !   is generated.
  ! Arguments :
  !   stoponerror : if true, then when an error, a fatal_error or a failure
  !     is generated, then stop the execution.
  !     If .false., then the same kinds of exceptions do not stop the 
  !     execution
  !
  subroutine exception_setstoponerror ( stoponerror )
    logical, intent(in) :: stoponerror
    exception_stoponerror = stoponerror
  end subroutine exception_setstoponerror
  !
  ! exception_logmsg --
  !   Write the given message onto the default unit.
  !
  subroutine exception_logmsg ( message )
    character(len=*), intent(in) :: message
    if ( exception_log_active ) then
       if ( exception_log_unit_active ) then
          write(exception_log_unit,*) trim(message)
       else
          write(*,*) trim(message)
       endif
    endif
  end subroutine exception_logmsg
  !
  ! exception_initcounter --
  !   Reset to 0 all the exceptions counters
  !
  subroutine exception_initcounter ()
    exception_nbinformation = 0
    exception_nbwarning = 0
    exception_nberror = 0
    exception_nbfatalerror = 0
    exception_nbfailure = 0
  end subroutine exception_initcounter
  !
  ! exception_getcounter --
  !   Returns an array of size EXCEPTION_SIZE indicating the number
  !   of type of exceptions.
  ! Arguments :
  !   excepcounters ( 1:EXCEPTION_SIZE) : array of integers
  !     excepcounters ( iexcept ) is the total number of exceptions
  !     of type #iexcept generated since the begining of the execution.
  !     The possible values for iexcept are the following.
  !     - counter ( EXCEPTION_INFORMATION ) : total number of information exceptions raised
  !     - counter ( EXCEPTION_WARNING ) : total number of warning exceptions raised
  !     - counter ( EXCEPTION_ERROR ) : total number of error exceptions raised
  !     - counter ( EXCEPTION_FATAL_ERROR ) : total number of fatal error exceptions raised
  !     - counter ( EXCEPTION_FAILURE ) : total number of failure exceptions raised
  !
  subroutine exception_getcounter ( counter )
    integer, dimension(1:EXCEPTION_SIZE), intent(out) :: counter
    counter ( EXCEPTION_INFORMATION ) = exception_nbinformation
    counter ( EXCEPTION_WARNING ) = exception_nbwarning
    counter ( EXCEPTION_ERROR ) = exception_nberror
    counter ( EXCEPTION_FATAL_ERROR ) = exception_nbfatalerror
    counter ( EXCEPTION_FAILURE ) = exception_nbfailure
  end subroutine exception_getcounter
  !
  ! exception_report --
  !   Writes on the current exception unit number a report
  !   which details the number of exceptions of all types
  !   since the begining of the execution or the last reset of
  !   all counters.
  !
  subroutine exception_report ()
    character ( len = 300 ) :: message
    call exception_logmsg ( "Exception report" )
    write ( message , * ) "Number of informations :" , exception_nbinformation
    call exception_logmsg ( message )
    write ( message , * ) "Number of warnings :" , exception_nbwarning
    call exception_logmsg ( message )
    write ( message , * ) "Number of errors :" , exception_nberror
    call exception_logmsg ( message )
    write ( message , * ) "Number of fatal errors :" , exception_nbfatalerror
    call exception_logmsg ( message )
    write ( message , * ) "Number of failures :" , exception_nbfailure
    call exception_logmsg ( message )
  end subroutine exception_report
  !
  ! exception_setlogunit --
  !   Set the unit number onto which the messages are output.
  !   If the unitnumber is 0, the messages are written
  !   to the standard output (unit *).
  ! Arguments :
  !   unitnumber : the unit number
  !
  subroutine exception_setlogunit ( unitnumber )
    integer, intent(in) :: unitnumber
    if ( unitnumber == 0 ) then
       exception_log_unit_active = .false.
       exception_log_unit = unitnumber
    else
       exception_log_unit_active = .true.
       exception_log_unit = unitnumber
    endif
  end subroutine exception_setlogunit
  !
  ! exception_getlogunit --
  !   Returns the positive unit number onto which the messages are output,
  !   if enabled or a negative integer if the feature is disabled.
  ! Arguments :
  !   
  !
  function exception_getlogunit ( ) result ( logunit )
    integer :: logunit
    logunit = exception_log_unit
  end function exception_getlogunit
  !
  ! exception_logactive --
  !   If the boolean argument bool is true, enable the logging 
  !   of the exceptions messages.
  !   If the boolean argument bool is false, disable the logging 
  !   of the exceptions messages.
  ! Arguments :
  !   bool : if true, active the logging of the messages
  !
  subroutine exception_logactive ( bool )
    logical, intent(in) :: bool
    exception_log_active = bool
  end subroutine exception_logactive
  !
  ! exception_islogactive --
  !   Returns .true. if the current exception messages are written,
  !   either on standard output or into a log file.
  !
  function exception_islogactive ( ) result ( islogactive )
    logical :: islogactive
    islogactive = exception_log_active
  end function exception_islogactive
  !
  ! exception_catch --
  !   Calls the given subroutine and returns the integer associated 
  !   with last exception, higher level, code or 0 if no exception
  !   was raised.
  ! Argument :
  !   callback : the subroutine to call back
  !   status : the integer corresponding to the last exception, if any.
  ! Caution !
  !   The internal algorithm is based on the exception counters,
  !   which implies that any call to exception_initcounter in the client
  !   code can result in a wrong status.
  !
  subroutine exception_catch ( callback , status )
    interface interfacecallback
       subroutine callback ()
       end subroutine callback
    end interface interfacecallback
    integer, intent(out) :: status
    integer, dimension(1:EXCEPTION_SIZE) :: counter_before
    integer, dimension(1:EXCEPTION_SIZE) :: counter_after
    integer :: exception_code
    !
    ! Get the counters before
    !
    call exception_getcounter ( counter_before )
    !
    ! Call the callback
    !
    call callback ()
    !
    ! Get the counters after
    !
    call exception_getcounter ( counter_after )
    !
    ! Compare before / after and set the corresponding status.
    !
    ! Process the loop, from the highest level of exception to the lowest.
    status = EXCEPTION_OK
    do exception_code = EXCEPTION_SIZE , 1 , -1
       if ( counter_after ( exception_code ) > counter_before ( exception_code ) ) then
          status = exception_code
          exit
       endif
    enddo
  end subroutine exception_catch
end module m_exception



<|start_filename|>doc/datastructures/binarytree.html<|end_filename|>

<html><head>
<title>flibs/binarytree - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'datastructures/binarytree.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2005 <NAME> &lt;<EMAIL>&gt;
   -->
<! -- CVS: $Id: binarytree.html,v 1.2 2013/05/13 08:03:15 knystrom Exp $ flibs/binarytree.n
   -->
<body><div class="doctools">
<h1 class="title">flibs/binarytree(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>flibs/binarytree - Linked lists</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">ROUTINES</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">call btree_create( btree, data)</b></a></li>
<li><a href="#2"><b class="cmd">call btree_destroy(btree )</b></a></li>
<li><a href="#3"><b class="cmd">count = btree_count( btree )</b></a></li>
<li><a href="#4"><b class="cmd">child =&gt; btree_child_node( node, right )</b></a></li>
<li><a href="#5"><b class="cmd">call btree_append_data( node, data, right )</b></a></li>
<li><a href="#6"><b class="cmd">call btree_append_subtree( node, subtree, right )</b></a></li>
<li><a href="#7"><b class="cmd">call btree_remove_subtree( node, subtree, right )</b></a></li>
<li><a href="#8"><b class="cmd">data = btree_get_data( node )</b></a></li>
<li><a href="#9"><b class="cmd">call btree_put_data( node, data )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <em>binarytree.f90</em> source file allows you to implement
<em>binary trees</em> of any (derived) type without having to edit
the supplied source code. (The resulting binary tree is <em>not</em>
balanced, that would require a method of ordering the data.) To achieve
genericty, a simple technique is used, which is best illustrated by an
example:</p>
<pre class="example">
module MYDATA_MODULE
type MYDATA
    character(len=20) :: string
end type MYDATA
end module
module MYDATA_BTREES
    use MYDATA_MODULE, TREE_DATA =&gt; MYDATA
    include &quot;binarytree.f90&quot;
end module MYDATA_BTREES
</pre>
<p>The above code defines a module <em>MYDATA_MODULE</em> with the derived
type that is to be stored in the binary trees. The name of that
derived type can be anything.</p>
<p>It also defines a module <em>MYDATA_BTREES</em> which will be the module
that holds the functionality to use binary trees:</p>
<ul class="itemized">
<li><p>The module <em>MYDATA_MODULE</em> is <em>used</em>, but the derived type
<em>MYDATA</em> is renamed to the (fixed) name <em>LIST_DATA</em>. (This
is the name used in the generic source file.)</p></li>
<li><p>The source code for the actual routines is simply included via the
INCLUDE statement.</p></li>
<li><p>Nothing more is required, we can close the source text for the module.</p></li>
</ul>
<p>To use a single type of binary trees in a program, we can just use the
MYDATA_BTREES module. If you need more than one type of data in binary
trees, then apply the same renaming trick on using the specific binary
trees modules.</p>
<p>In fact the example in the source file &quot;two_lists.f90&quot; shows the general
technique of how to accomplish this for linked lists. The same applies
to binary trees.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">ROUTINES</a></h2>
<p>The source file <em>binarytree.f90</em> provides the following
routines:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">call btree_create( btree, data)</b></a></dt>
<dd><p>Create a new tree with the given data associated to the root.
The data are copied and stored in that root.</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">btree</i></dt>
<dd><p>The variable that will be used for accessing the tree's root</p></dd>
<dt>type(TREE_DATA), intent(in) <i class="arg">data</i></dt>
<dd><p>The data to be stored in the root</p></dd>
</dl></dd>
<dt><a name="2"><b class="cmd">call btree_destroy(btree )</b></a></dt>
<dd><p>Destroy the tree. All nodes contained in it will be destroyed as
well.</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">btree</i></dt>
<dd><p>The list to be destroyed</p></dd>
</dl></dd>
<dt><a name="3"><b class="cmd">count = btree_count( btree )</b></a></dt>
<dd><p>Function to return the number of nodes in the tree.</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">btree</i></dt>
<dd><p>The tree in question</p></dd>
</dl></dd>
<dt><a name="4"><b class="cmd">child =&gt; btree_child_node( node, right )</b></a></dt>
<dd><p>Function to return the left or right child node of a given node in the
tree. As each node is itself a tree, you can traverse the tree by
repeatedly using this function on the result.</p>
<p>Note: it returns a <em>pointer</em> to the child node,
so you must use <em>=&gt;</em>.</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">node</i></dt>
<dd><p>The (parent) node in a tree or the root of a tree</p></dd>
<dt>logical <i class="arg">right</i></dt>
<dd><p>Whether to return the right (.true.) or the left (.false.) child node.</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">call btree_append_data( node, data, right )</b></a></dt>
<dd><p>Append a new node to the left or right to the given node. (Note that no
balancing is taken care of). If the node already has a child node,
nothing is done.</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">node</i></dt>
<dd><p>The node in the tree that should get a child node</p></dd>
<dt>type(TREE_DATA), intent(in) <i class="arg">data</i></dt>
<dd><p>The data to be stored in the child node</p></dd>
<dt>logical <i class="arg">right</i></dt>
<dd><p>Whether to append on the right (.true.) or the left (.false.) side.</p></dd>
</dl></dd>
<dt><a name="6"><b class="cmd">call btree_append_subtree( node, subtree, right )</b></a></dt>
<dd><p>Append a subtree to the left or right to the given node.
If the node already has a child node, nothing is done. (Note: the
subtree is referred to, not copied!)</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">node</i></dt>
<dd><p>The node in the tree that should get a child node</p></dd>
<dt>type(BINARY_TREE), pointer <i class="arg">subtree</i></dt>
<dd><p>The tree to be appended as the child node</p></dd>
<dt>logical <i class="arg">right</i></dt>
<dd><p>Whether to append on the right (.true.) or the left (.false.) side.</p></dd>
</dl></dd>
<dt><a name="7"><b class="cmd">call btree_remove_subtree( node, subtree, right )</b></a></dt>
<dd><p>Remove a subtree to the left or right to the given node.
A pointer to the subtree is returned in the &quot;subtree&quot; argument, so that
this can be destroyed or used independently of the original tree.</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">node</i></dt>
<dd><p>The element in the list after which to insert a new one.</p></dd>
<dt>type(BINARY_TREE), pointer <i class="arg">subtree</i></dt>
<dd><p>The subtree that was removeds the child node</p></dd>
<dt>logical <i class="arg">right</i></dt>
<dd><p>Whether to remove on the right (.true.) or the left (.false.) side.</p></dd>
</dl></dd>
<dt><a name="8"><b class="cmd">data = btree_get_data( node )</b></a></dt>
<dd><p>Return the data belonging to a node</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">node</i></dt>
<dd><p>The node of the tree in question</p></dd>
</dl></dd>
<dt><a name="9"><b class="cmd">call btree_put_data( node, data )</b></a></dt>
<dd><p>Put new data at a given node</p>
<dl class="arguments">
<dt>type(BINARY_TREE), pointer <i class="arg">node</i></dt>
<dd><p>The node of the tree in question</p></dd>
<dt>type(TREE_DATA), intent(in) <i class="arg">data</i></dt>
<dd><p>The data to be stored in the node</p></dd>
</dl></dd>
</dl>
<p>Notes:</p>
<ul class="itemized">
<li><p>The binary trees can only store data of the same derived type. In
that sense the code is not generic.</p></li>
<li><p>Currently, the trees can only store derived types that do not require
an explicit destruction. If you want to store a derived type with
pointers to allocated memory, you can do that however, by supplying an
assignment operator. This would lead to a memory leak though. It is best
to wait for a next version that will allow such derived types to be
stored.</p></li>
</ul>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2005 <NAME> &lt;<EMAIL>&gt;</p>
</div>
</div></body></html>

<|start_filename|>config/ifortwin.mk<|end_filename|>
# Options for Intel Fortran - Windows
#
SPACE	=	\

SEP	=	/

FC	=	ifort
FFLAGS_NORMAL	=	/c
FFLAGS_DEBUG	=	/c /debug
FFLAGS_OPTIMISE	=	/c /fast

LD	=	ifort
LDFLAGS_NORMAL	=	
LDFLAGS_DEBUG	=	/debug
LDFLAGS_OPTIMISE	=	/fast
LDOUTPUT	=	/exe:$@

LIB	=	lib

OBJEXT	=	.obj
EXEEXT	=	.exe
MODEXT	=	.mod

DELETE	=	del /q


<|start_filename|>src/datastructures/sorting.f90<|end_filename|>
! sorting.f90 --
!     QuickSort for arrays:
!
!     See the example/test program for the way to use this
!
!     IMPORTANT NOTE:
!     --------------
!     This file is deprecated in favour of "qsortarray_template.f90"
!     Please use this file and its test program.
!
!     The reason is that there are several interface issues
!     (the need for a use statement when defining the interface to
!     the comparison function). The current file does not even
!     compile properly.
!
!     Note:
!     The data that need to be sorted are stored in
!     an array. A comparison function is used to enable
!     sorting wrt different criteria.
!     The data have the generic type SORT_DATA.
!
!     Note:
!     Algorithm translated from Kernighan and Pike,
!     The Practice of Programming.
!
!     $Id: sorting.f90,v 1.4 2010/06/16 07:36:18 arjenmarkus Exp $
!

!
! Routines and functions specific to dictionaries
!

! qsort_array --
!     Use the QuickSort algorithm to sort an array
! Arguments:
!     array      Array to be sorted
!     compare    Comparison function
!
subroutine qsort_array( array, compare )
    type(SORT_DATA), dimension(:) :: array

    interface
        integer function compare(f,g)
            type(SORT_DATA) :: f, g
        end function compare
    end interface

    type(SORT_DATA), dimension(:), allocatable :: backup
    integer, dimension(:), allocatable         :: order
    integer                                    :: i

    allocate( backup(1:size(array)) )
    allocate( order(1:size(array)) )

    do i = 1,size(order)
        order(i) = i
    enddo

    call qsort_sort( array, order, 1, size(array), compare )

    do i = 1,size(order)
        backup(i) = array(order(i))
    enddo

    array = backup

    deallocate( backup )
    deallocate( order  )

end subroutine qsort_array

! qsort_sort --
!     Sort the array according to the QuickSort algorithm
! Arguments:
!     array      Array of data
!     order      Array holding the order
!     left       Start index
!     right      End index
!     compare    Comparison function
!
recursive subroutine qsort_sort( array, order, left, right, compare )
    type(SORT_DATA), dimension(:) :: array
    integer, dimension(:)         :: order
    integer                       :: left
    integer                       :: right

    interface
        integer function compare(f,g)
            type(SORT_DATA) :: f, g
        end function compare
    end interface

    integer                                    :: i
    integer                                    :: last

    if ( left .ge. right ) return

    call qsort_swap( order, left, qsort_rand(left,right) )
    last = left

    do i = left+1, right
        if ( compare(array(order(i)), array(order(left)) ) .lt. 0 ) then
            last = last + 1
            call qsort_swap( order, last, i )
        endif
    enddo

    call qsort_swap( order, left, last )

    call qsort_sort( array, order, left, last-1, compare )
    call qsort_sort( array, order, last+1, right, compare )

end subroutine qsort_sort

! qsort_swap --
!     Swap two array elements
! Arguments:
!     order      Array holding the order
!     first      First index
!     second     Second index
!
subroutine qsort_swap( order, first, second )
    integer, dimension(:)         :: order
    integer                       :: first, second

    integer                       :: tmp

    tmp           = order(first)
    order(first)  = order(second)
    order(second) = tmp
end subroutine

! qsort_rand --
!     Determine a random integer number
! Arguments:
!     lower      Lowest value
!     upper      Greatest value
!
integer function qsort_rand( lower, upper )
    integer                       :: lower, upper

    real                          :: r

    call random_number( r )
    qsort_rand =  lower + nint(r * (upper-lower))
end function qsort_rand

>>>>>>> 1.3


<|start_filename|>doc/computing/traverse_grid.html<|end_filename|>

<html><head>
<title>traverse_grid - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'traverse_grid.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2013 <NAME> &lt;arjenmarkus at sourceforge dot net&gt;
   -->
<! -- CVS: $Id: traverse_grid.html,v 1.1 2013/06/30 09:44:18 arjenmarkus Exp $ traverse_grid.n
   -->
<body><div class="doctools">
<h1 class="title">traverse_grid(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>traverse_grid - Traverse an N-dimensional grid of points</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">ROUTINES</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">call traverse%init( dimensions, max_index )</b></a></li>
<li><a href="#2"><b class="cmd">call traverse%init( max_index )</b></a></li>
<li><a href="#3"><b class="cmd">call coordinates%init( max_index, range )</b></a></li>
<li><a href="#4"><b class="cmd">call coordinates%init( max_index, range )</b></a></li>
<li><a href="#5"><b class="cmd">call sampler%init( max_index, range )</b></a></li>
<li><a href="#6"><b class="cmd">call object%reset</b></a></li>
<li><a href="#7"><b class="cmd">indices = object%indices()</b></a></li>
<li><a href="#8"><b class="cmd">coords = object%coords()</b></a></li>
<li><a href="#9"><b class="cmd">call object%next( indices )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <i class="term">traverse_grid</i> module defines three types with accompanying routines
to traverse a block of grid points through N-dimensional space. The types
have different purposes:</p>
<ul class="itemized">
<li><p>Objects of the type <i class="term">grid_traversing</i> can be used to traverse a grid along all the grid points.
These objects use integer coordinates only.</p></li>
<li><p>The type <i class="term">grid_coordinates</i> traverses a grid along the same grid points
but you can convert the indices to (real) coordinates of the midpoints.</p></li>
<li><p>The type <i class="term">grid_sampler</i> is meant to sample the grid points in a quasi-random way.
It is useful as an alternative to Monte Carlo, because the selected points are more uniformly
distributed. (See the test program for an example.)</p></li>
</ul>
<p>The idea is that the N-dimensional space in question is split up into rectangular cells
with indices running from 0 up to but not including a maximum value. This maximum can
differ per dimension.</p>
<p>Traversing such a grid, for instance a 4 by 3 grid, gives the following ordering of the
points;</p>
<pre class="example">
    2| 9  10  11  12
    1| 5   6   7   8
    0| 1   2   3   4
     +---+---+---+---+
       0   1   2   3
</pre>
<p>That is, the grid points are visited in the shown order, with indices (0,0), (1,0), ...
(0,1), (0,2), ..., (3,2).</p>
<p>All three types can return the raw indices, but the <i class="term">grid_coordinates</i> and <i class="term">grid_sampler</i>
types can also return the actual coordinates (real numbers).</p>
<p>The <i class="term">grid_sampler</i> type samples the grid points using steps of the size of a prime,
so that the whole space is effectively covered in a fairly small number of samples.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">ROUTINES</a></h2>
<p>Each type contains a number of methods:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">call traverse%init( dimensions, max_index )</b></a></dt>
<dd><p>Initialise a <i class="term">grid_traversing</i> object with uniform dimensions, that is, each
index runs from 0 to <i class="term">max_index-1</i>.</p>
<dl class="arguments">
<dt>integer <i class="arg">dimensions</i></dt>
<dd><p>The number of dimensions</p></dd>
<dt>integer <i class="arg">max_index</i></dt>
<dd><p>The maximum index for each dimension (actually the index runs up to that value, but
does not reach it)</p></dd>
</dl></dd>
<dt><a name="2"><b class="cmd">call traverse%init( max_index )</b></a></dt>
<dd><p>Initialise a <i class="term">grid_traversing</i> object with different dimensions, that is,
index i runs from 0 to <i class="term">max_index(i)-1</i>.</p>
<dl class="arguments">
<dt>integer, dimension(:) <i class="arg">max_index</i></dt>
<dd><p>The maximum index per dimension. The number of dimensions is equal to the size
of the array.</p></dd>
</dl></dd>
<dt><a name="3"><b class="cmd">call coordinates%init( max_index, range )</b></a></dt>
<dd><p>Initialise a <i class="term">grid_coordinates</i> object with uniform dimensions, that is, each
index runs from 0 to <i class="term">max_index-1</i>. The <i class="term">range</i> argument contains the
minimum and maximum values of the coordinates. The number of dimensions is equal
to the second dimension of <i class="term">range</i> (that is, <i class="term">size(range,2)</i>).</p>
<dl class="arguments">
<dt>integer <i class="arg">max_index</i></dt>
<dd><p>The maximum index for each dimension (actually the index runs up to that value, but
does not reach it)</p></dd>
<dt>real(kind=wp), dimension(2,:) <i class="arg">range</i></dt>
<dd><p>The minimum (<i class="term">range(1,:)</i>) and the maximum (<i class="term">range(2,:)</i>) coordinate per dimension.
This is used to determine the midpoint coordinates of a cell.</p></dd>
</dl></dd>
<dt><a name="4"><b class="cmd">call coordinates%init( max_index, range )</b></a></dt>
<dd><p>Initialise a <i class="term">grid_coordinates</i> object with uniform dimensions, that is,
index i runs from 0 to <i class="term">max_index(i)-1</i>. The <i class="term">range</i> argument contains the
minimum and maximum values of the coordinates. The number of dimensions is equal
to the second dimension of <i class="term">range</i> (that is, <i class="term">size(range,2)</i>), but the
size of <i class="term">max_index</i> should be equal to that.</p>
<dl class="arguments">
<dt>integer, dimension(:) <i class="arg">max_index</i></dt>
<dd><p>The maximum index per dimension</p></dd>
<dt>real(kind=wp), dimension(2,:) <i class="arg">range</i></dt>
<dd><p>The minimum (<i class="term">range(1,:)</i>) and the maximum (<i class="term">range(2,:)</i>) coordinate per dimension.</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">call sampler%init( max_index, range )</b></a></dt>
<dd><p>Initialise a <i class="term">grid_sampler</i> object, analogous to the initialisation of a
<i class="term">grid_coordinates</i> object. Both variants are allowed.</p></dd>
<dt><a name="6"><b class="cmd">call object%reset</b></a></dt>
<dd><p>Resets the current point in a <i class="term">grid_traversing</i>, <i class="term">grid_coordinates</i> or
<i class="term">grid_sampler</i> object to the point with indices all zero.</p></dd>
<dt><a name="7"><b class="cmd">indices = object%indices()</b></a></dt>
<dd><p>Returns the indices of the current point in a <i class="term">grid_traversing</i>, <i class="term">grid_coordinates</i> or
<i class="term">grid_sampler</i> object. The receiving variable must be an array of the correct dimension.</p></dd>
<dt><a name="8"><b class="cmd">coords = object%coords()</b></a></dt>
<dd><p>Returns the coordinates of the current point in a <i class="term">grid_coordinates</i> or
<i class="term">grid_sampler</i> object. The receiving variable must be an array of the correct dimension.</p></dd>
<dt><a name="9"><b class="cmd">call object%next( indices )</b></a></dt>
<dd><p>Determine the next point for a <i class="term">grid_traversing</i>, <i class="term">grid_coordinates</i> or
<i class="term">grid_sampler</i> object. The argument <i class="term">indices</i> will contain the indices of this
new point.</p>
<dl class="arguments">
<dt>integer, dimension(:), optional <i class="arg">indices</i></dt>
<dd><p>The indices for the new point.</p></dd>
</dl></dd>
</dl>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2013 <NAME> &lt;arjenmarkus at sourceforge dot net&gt;</p>
</div>
</div></body></html>


<|start_filename|>doc/computing/libdate.html<|end_filename|>

<html><head>
<title>libdate - flibs</title>
<style type="text/css"><!--
    HTML {
	background: 	#FFFFFF;
	color: 		black;
    }
    BODY {
	background: 	#FFFFFF;
	color:	 	black;
    }
    DIV.doctools {
	margin-left:	10%;
	margin-right:	10%;
    }
    DIV.doctools H1,DIV.doctools H2 {
	margin-left:	-5%;
    }
    H1, H2, H3, H4 {
	margin-top: 	1em;
	font-family:	sans-serif;
	font-size:	large;
	color:		#005A9C;
	background: 	transparent;
	text-align:		left;
    }
    H1.title {
	text-align: center;
    }
    UL,OL {
	margin-right: 0em;
	margin-top: 3pt;
	margin-bottom: 3pt;
    }
    UL LI {
	list-style: disc;
    }
    OL LI {
	list-style: decimal;
    }
    DT {
	padding-top: 	1ex;
    }
    UL.toc,UL.toc UL, UL.toc UL UL {
	font:		normal 12pt/14pt sans-serif;
	list-style:	none;
    }
    LI.section, LI.subsection {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding: 	0em;
    }
    PRE {
	display: 	block;
	font-family:	monospace;
	white-space:	pre;
	margin:		0%;
	padding-top:	0.5ex;
	padding-bottom:	0.5ex;
	padding-left:	1ex;
	padding-right:	1ex;
	width:		100%;
    }
    PRE.example {
	color: 		black;
	background: 	#f5dcb3;
	border:		1px solid black;
    }
    UL.requirements LI, UL.syntax LI {
	list-style: 	none;
	margin-left: 	0em;
	text-indent:	0em;
	padding:	0em;
    }
    DIV.synopsis {
	color: 		black;
	background: 	#80ffff;
	border:		1px solid black;
	font-family:	serif;
	margin-top: 	1em;
	margin-bottom: 	1em;
    }
    UL.syntax {
	margin-top: 	1em;
	border-top:	1px solid black;
    }
    UL.requirements {
	margin-bottom: 	1em;
	border-bottom:	1px solid black;
    }
--></style>
</head>
<! -- Generated from file 'libdate.man' by tcllib/doctools with format 'html'
   -->
<! -- Copyright &copy; 2008 <NAME> &lt;arjan dot van dijk at rivm dot nl&gt;   -- Copyright &copy; 2008 <NAME> &lt;arjenmarkus at sourceforge dot net&gt;
   -->
<! -- CVS: $Id: libdate.html,v 1.4 2013/06/30 09:44:18 arjenmarkus Exp $ libdate.n
   -->
<body><div class="doctools">
<h1 class="title">libdate(n) 1.0  &quot;flibs&quot;</h1>
<div id="name" class="section"><h2><a name="name">Name</a></h2>
<p>libdate - Manipulating date/time information</p>
</div>
<div id="toc" class="section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="toc">
<li class="section"><a href="#toc">Table Of Contents</a></li>
<li class="section"><a href="#synopsis">Synopsis</a></li>
<li class="section"><a href="#section1">Description</a></li>
<li class="section"><a href="#section2">DERIVED TYPES AND ROUTINES</a></li>
<li class="section"><a href="#section3">ACKNOWLEDGEMENTS</a></li>
<li class="section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="synopsis">
<ul class="syntax">
<li><a href="#1"><b class="cmd">type(DATETYPE) date</b></a></li>
<li><a href="#2"><b class="cmd">type(JULIANDATETYPE) julian</b></a></li>
<li><a href="#3"><b class="cmd">relational operators</b></a></li>
<li><a href="#4"><b class="cmd">newdate = basedate + timestep</b></a></li>
<li><a href="#5"><b class="cmd">newdate = basedate - timestep</b></a></li>
<li><a href="#6"><b class="cmd">newstep = factor * timestep</b></a></li>
<li><a href="#7"><b class="cmd">newstep = timestep * factor</b></a></li>
<li><a href="#8"><b class="cmd">timelag_in_days = timelag( date1, date2 )</b></a></li>
<li><a href="#9"><b class="cmd">seconds = delayseconds( timestep )</b></a></li>
<li><a href="#10"><b class="cmd">isleap = leapyear( date )</b></a></li>
<li><a href="#11"><b class="cmd">daynumber = doy( date )</b></a></li>
<li><a href="#12"><b class="cmd">earlier = mindate( date1, date2 )</b></a></li>
<li><a href="#13"><b class="cmd">later = maxdate( date1, date2 )</b></a></li>
<li><a href="#14"><b class="cmd">call format_date( date, pattern, datestring )</b></a></li>
<li><a href="#15"><b class="cmd">call scan_date( pattern, string, date, error )</b></a></li>
<li><a href="#16"><b class="cmd">julian = date2julian( date )</b></a></li>
<li><a href="#17"><b class="cmd">date = julian2date( julian )</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="section"><h2><a name="section1">Description</a></h2>
<p>The <i class="term">libdate</i> module defines a derived type and several functions
and subroutines to deal with date/time information:</p>
<ul class="itemized">
<li><p>Store date and time in the form of year, month, day, hour, minute</p></li>
<li><p>Compare dates</p></li>
<li><p>Basic arithmetic</p></li>
<li><p>Formatting date and time as a string based on a pattern</p></li>
</ul>
<p><em>Note:</em> Timezones and seconds are <em>not</em> taken into account.
Also, there are no provisions to take care of the various historical
introductions of the Gregorian calendar.</p>
</div>
<div id="section2" class="section"><h2><a name="section2">DERIVED TYPES AND ROUTINES</a></h2>
<p>The module <i class="term">libdate</i> defines two separate derived types, DATETYPE
and JULIANDATETYPE, though this second type is mainly meant for internal
use:</p>
<dl class="definitions">
<dt><a name="1"><b class="cmd">type(DATETYPE) date</b></a></dt>
<dd><p>This type has the following fields: year, month, day, hour, minute, in
that order, so that <i class="term">thisdate = datetype( 2007, 1, 29, 17, 0)</i>
defines a date 29 january 2007 and a time 17:00.</p>
<p>A duration is expressed in days, hours and minutes:
<i class="term">period = datetype( 0, 0, 2, 1, 0)</i> means a period of 2 days and
and 1 hour. (When adding a duration to a date/time the month and year
fields are ignored, as they are not additive).</p></dd>
<dt><a name="2"><b class="cmd">type(JULIANDATETYPE) julian</b></a></dt>
<dd><p>Julian dates are used internally to make the computations easier. You
should not need to use them explicitly, unless you want to implement
new functionality.</p></dd>
</dl>
<p>The following functions, subroutines and operators are available:</p>
<dl class="definitions">
<dt><a name="3"><b class="cmd">relational operators</b></a></dt>
<dd><p>You can compare two dates using the standard operators
<i class="term">.EQ.</i>, <i class="term">.NE.</i>, <i class="term">.GE.</i>, <i class="term">.GT.</i>, <i class="term">.LE.</i>,
<i class="term">.LT.</i>, with conventional meaning</p></dd>
<dt><a name="4"><b class="cmd">newdate = basedate + timestep</b></a></dt>
<dd><p>Add a duration to a date. The second date/time is considered to be the
duration.</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">basedate</i></dt>
<dd><p>The base date/time to which the duration is to be added.</p></dd>
<dt>type(DATETYPE) <i class="arg">timestep</i></dt>
<dd><p>The duration that will be added. Only the day, hour and minute fields
are considered.</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">newdate = basedate - timestep</b></a></dt>
<dd><p>Subtract a duration from a date. The second date/time is considered to
be the duration.</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">basedate</i></dt>
<dd><p>The base date/time from which the duration is to be subtracted.</p></dd>
<dt>type(DATETYPE) <i class="arg">timestep</i></dt>
<dd><p>The duration that will be subtracted. Only the day, hour and minute
fields are considered.</p></dd>
</dl></dd>
<dt><a name="6"><b class="cmd">newstep = factor * timestep</b></a></dt>
<dd><p>Multiply a timestep by a real or integer factor. For the timestep,
only the day, hour and minute are considered.</p>
<dl class="arguments">
<dt>integer/real <i class="arg">factor</i></dt>
<dd><p>Factor to be applied</p></dd>
<dt>type(DATETYPE) <i class="arg">timestep</i></dt>
<dd><p>The duration that will be scaled.</p></dd>
</dl></dd>
<dt><a name="7"><b class="cmd">newstep = timestep * factor</b></a></dt>
<dd><p>Multiply a timestep by a real or integer factor. For the timestep,
only the day, hour and minute are considered. (The order of teh
arguments is reversed).</p></dd>
<dt><a name="8"><b class="cmd">timelag_in_days = timelag( date1, date2 )</b></a></dt>
<dd><p>Compute the time difference between two dates. Return the value in days.</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date1</i></dt>
<dd><p>First date</p></dd>
<dt>type(DATETYPE) <i class="arg">date2</i></dt>
<dd><p>Second date. If this date is earlier than the first date, the difference
is positive.</p></dd>
</dl></dd>
<dt><a name="9"><b class="cmd">seconds = delayseconds( timestep )</b></a></dt>
<dd><p>Compute the number of seconds in a timestep</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">timestep</i></dt>
<dd><p>Timestep to be converted to seconds</p></dd>
</dl></dd>
<dt><a name="10"><b class="cmd">isleap = leapyear( date )</b></a></dt>
<dd><p>Determine if the year in the date structure is a leap year or not</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date</i></dt>
<dd><p>Date/time to be considered (only the year is of interest of course).</p></dd>
</dl></dd>
<dt><a name="11"><b class="cmd">daynumber = doy( date )</b></a></dt>
<dd><p>Compute the day of the year</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date</i></dt>
<dd><p>Date/time to be considered.</p></dd>
</dl></dd>
<dt><a name="12"><b class="cmd">earlier = mindate( date1, date2 )</b></a></dt>
<dd><p>Return the earlier of the two dates</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date1</i></dt>
<dd><p>First date/time to be considered.</p></dd>
<dt>type(DATETYPE) <i class="arg">date2</i></dt>
<dd><p>Second date/time to be considered.</p></dd>
</dl></dd>
<dt><a name="13"><b class="cmd">later = maxdate( date1, date2 )</b></a></dt>
<dd><p>Return the later of the two dates</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date1</i></dt>
<dd><p>First date/time to be considered.</p></dd>
<dt>type(DATETYPE) <i class="arg">date2</i></dt>
<dd><p>Second date/time to be considered.</p></dd>
</dl></dd>
<dt><a name="14"><b class="cmd">call format_date( date, pattern, datestring )</b></a></dt>
<dd><p>Format a date according to a pattern.</p>
<p>The pattern may contain any of the following format codes:</p>
<ul class="itemized">
<li><p><i class="term">dd</i> - Day of month (&quot;01&quot; for instance)</p></li>
<li><p><i class="term">ds</i> - Day of month (&quot;1&quot; for instance, s for space)</p></li>
<li><p><i class="term">DDD</i> - Day of the year</p></li>
<li><p><i class="term">HH</i> - Hour (00-23)</p></li>
<li><p><i class="term">HS</i> - Hour (0-23)</p></li>
<li><p><i class="term">mm</i> - Month (&quot;01&quot; for january)</p></li>
<li><p><i class="term">ms</i> - Month (&quot;1&quot; for january, s for space)</p></li>
<li><p><i class="term">MM</i> - Minutes within the hour (00-59)</p></li>
<li><p><i class="term">MS</i> - Minutes within the hour (0-59)</p></li>
<li><p><i class="term">YY</i> - Year without the century</p></li>
<li><p><i class="term">yyyy</i> - Year with the century</p></li>
</ul>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date</i></dt>
<dd><p>Date to be converted</p></dd>
<dt>character(len=*) <i class="arg">pattern</i></dt>
<dd><p>String containing the format pattern</p></dd>
<dt>character(len=*) <i class="arg">datestring</i></dt>
<dd><p>String containing the result. The contents will not be longer
than the pattern.</p></dd>
</dl></dd>
<dt><a name="15"><b class="cmd">call scan_date( pattern, string, date, error )</b></a></dt>
<dd><p>Scan a string and extract the date/time information according to the given pattern.</p>
<p>The pattern may contain any of the following format codes:</p>
<ul class="itemized">
<li><p><i class="term">dd</i> - Day of month (&quot;01&quot; for instance)</p></li>
<li><p><i class="term">ds</i> - Day of month (&quot;1&quot; for instance, s for space)</p></li>
<li><p><i class="term">HH</i> - Hour (00-23)</p></li>
<li><p><i class="term">HS</i> - Hour (0-23)</p></li>
<li><p><i class="term">mm</i> - Month (&quot;01&quot; for january)</p></li>
<li><p><i class="term">ms</i> - Month (&quot;1&quot; for january, s for space)</p></li>
<li><p><i class="term">MM</i> - Minutes within the hour (00-59)</p></li>
<li><p><i class="term">MS</i> - Minutes within the hour (0-59)</p></li>
<li><p><i class="term">YY</i> - Year without the century (two digits)</p></li>
<li><p><i class="term">yyyy</i> - Year with the century (one to four digits)</p></li>
<li><p><i class="term">(space)</i> - Skip one or more spaces in the string to be scanned</p></li>
<li><p><i class="term">?</i> - Skip exactly one character in the string to be scanned</p></li>
<li><p>(any other character) - Character in the format string and the string to be scanned must match</p></li>
</ul>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date</i></dt>
<dd><p>Date to be converted</p></dd>
<dt>character(len=*) <i class="arg">pattern</i></dt>
<dd><p>String containing the format pattern</p></dd>
<dt>character(len=*) <i class="arg">datestring</i></dt>
<dd><p>String containing the result. The contents will not be longer
than the pattern.</p></dd>
</dl></dd>
<dt><a name="16"><b class="cmd">julian = date2julian( date )</b></a></dt>
<dd><p>Convert a date/time structure to Julian date. Mainly for internal use.</p>
<dl class="arguments">
<dt>type(DATETYPE) <i class="arg">date</i></dt>
<dd><p>Date/time structure to be converted.</p></dd>
</dl></dd>
<dt><a name="17"><b class="cmd">date = julian2date( julian )</b></a></dt>
<dd><p>Convert a Julian date to a date/time structure. Mainly for internal use.</p>
<dl class="arguments">
<dt>type(JULIANDATETYPE) <i class="arg">julian</i></dt>
<dd><p>Julian date to be converted.</p></dd>
</dl></dd>
</dl>
</div>
<div id="section3" class="section"><h2><a name="section3">ACKNOWLEDGEMENTS</a></h2>
<p>This module was written and contributed by <NAME>. Small
modifications and the addition of the <i class="term">format_date</i> routine by
<NAME>.</p>
</div>
<div id="copyright" class="section"><h2><a name="copyright">Copyright</a></h2>
<p>Copyright &copy; 2008 <NAME> &lt;arjan dot van dijk at rivm dot nl&gt;<br>
Copyright &copy; 2008 <NAME> &lt;arjenmarkus at sourceforge dot net&gt;</p>
</div>
</div></body></html>