From 48a9dce985fe79ec5d1cfde654c545756aa7fb1c Mon Sep 17 00:00:00 2001 From: maier Date: Fri, 8 Mar 2013 10:44:58 +0000 Subject: [PATCH] Add contrib/lapack_templates and contrib/lagrange_basis back git-svn-id: https://svn.dealii.org/trunk@28813 0785d39b-7218-0410-832d-ea1e28bc413d --- deal.II/contrib/lagrange_basis/lagrange | 61 +++++++ .../example_custom_target.cmake | 12 ++ .../lapack_templates/lapack_templates.pl | 150 ++++++++++++++++++ 3 files changed, 223 insertions(+) create mode 100644 deal.II/contrib/lagrange_basis/lagrange create mode 100644 deal.II/contrib/lapack_templates/example_custom_target.cmake create mode 100644 deal.II/contrib/lapack_templates/lapack_templates.pl diff --git a/deal.II/contrib/lagrange_basis/lagrange b/deal.II/contrib/lagrange_basis/lagrange new file mode 100644 index 0000000000..a5b644e514 --- /dev/null +++ b/deal.II/contrib/lagrange_basis/lagrange @@ -0,0 +1,61 @@ +# Maple script to compute the coefficients of the LagrangeEquidistant +# basis functions of degree p. These are used as shape functions for +# Qp elements. For higher p just change variable p in line 10. +# Call +# perl -p -e 's/ *t0 = (.*);\n/ $1/g;' lagrange_txt +# to get a c-code ready to be copied into the source codes. +# $Id$ +# Ralf Hartmann, 2001 + + p := 10: + + n_functions := p+1: + + # first compute the support points + support_points := array(0..n_functions-1): + for i from 0 to n_functions-1 do + support_points[i] := i/(n_functions-1): + od; + + poly := array(0..n_functions-1): + + for i from 0 to n_functions-1 do + # note that the interp function wants vectors indexed from + # one and not from zero. + values := array(1..n_functions): + for j from 1 to n_functions do + values[j] := 0: + od: + values[i+1] := 1: + + shifted_support_points := array (1..n_functions): + for j from 1 to n_functions do + shifted_support_points[j] := support_points[j-1]: + od: + + poly[i] := interp (shifted_support_points, values, x): + od: + + readlib(C): + writeto(lagrange_output): + printf(` case %d:\n {\n static const double x%d[%d]=\n {`, p,p,(p+1)*(p+1)): + a := array(0..n_functions-1, 0..n_functions-1): + b := array(0..n_functions-1): + # a[i,j] is the jth coefficient of the ith base function. + for i from 0 to n_functions-1 do + for j from 0 to n_functions-1 do + b[j] := coeff(poly[i], x, j): + od: + C(b[0]): + for j from 1 to n_functions-1 do + printf(`,`): + C(b[j]): + od: + if (i ${CMAKE_CURRENT_BINARY_DIR}/deal.II/lac/lapack_templates.h + ) + +ADD_CUSTOM_TARGET(lapack_templates ALL + DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/deal.II/lac/lapack_templates.h + ) diff --git a/deal.II/contrib/lapack_templates/lapack_templates.pl b/deal.II/contrib/lapack_templates/lapack_templates.pl new file mode 100644 index 0000000000..cbad825c04 --- /dev/null +++ b/deal.II/contrib/lapack_templates/lapack_templates.pl @@ -0,0 +1,150 @@ +#--------------------------------------------------------------------------- +# $Id$ +# Version: $Name$ +# +# Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2012 by the deal authors +# +# This file is subject to QPL and may not be distributed +# without copyright and license information. Please refer +# to the file deal.II/doc/license.html for the text and +# further information on this license. +# +#--------------------------------------------------------------------------- + +#--------------------------------------------------------------------------- +# This perl script translates lapack_templates.h.in to lapack_templates.h +# +# In the *.in file, every BLAS/LAPACK function which is defined for +# double precision, i.e. having a name like 'dfoo_', is expanded to +# itself plus the same function for single precision, namely +# 'sfoo_'. Additionally, a C++ function 'foo' without the prefix +# letter and the trailing underscore is generated, such that the +# fortran functions can easily be called from templates. The +# implementation of this function is modified due to the configure +# variables 'HAVE_DFOO_' and 'HAVE_DFOO_': if these are set, then the +# lapack functions 'dfoo_' and 'sfoo_' will be called, if not, an +# exception will be thrown. +# +# Therefore, in order to be able to call a LAPACK function, the +# functions have to be tested by configure. Search for the section +# "Check for LAPACK..." in deal.II/configure.in and add the functions +# 'dfoo_' and 'sfoo_' to the tests at the end of that section. +# + + +my $templates; +my $double; + + +print << 'EOT' +//--------------------------------------------------------------------------- +// +// This file was automatically generated from lapack_templates.h.in +// See blastemplates in the deal.II contrib directory +// +// Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 by the deal authors +// +// This file is subject to QPL and may not be distributed +// without copyright and license information. Please refer +// to the file deal.II/doc/license.html for the text and +// further information on this license. +// +//--------------------------------------------------------------------------- + +#ifndef __LAPACK_TEMPLATES_H +#define __LAPACK_TEMPLATES_H + +#include +#include + +extern "C" +{ +EOT + ; + +while(<>) +{ + # Write comment lines literally + if (m'^\s*//') + { + print; + next; + } + # Lines of the form 'typename functionname (...' + # where functionname is of the form d..._, + # that is a double precision LAPACK function + if (m'\s*(\w+)\s+d(\w+)_\s*\(') + { + $double = $_; + my $type = $1; + my $name = $2; + my $capname = $name; + $capname =~ tr/[a-z]/[A-Z]/; + while (<>) + { + $double .= $_; + last if (m';'); + } + my $single = $double; + $single =~ s/d$name/s$name/; + $single =~ s/double/float/g; + print $double,$single; + + $double =~ m/\(([^\)]*)/; + my $args = $1; + # The arglist for the C++ function + $args =~ s/\s+/ /g; + # The arglist handed down to the FORTRAN function + $args2 = $args; + # Fortunately, all arguments are pointers, so we can use the * + # to separate data type and argument name + $args2 =~ s/\w+\*//g; + $args2 =~ s/const//g; + $args2 =~ s/\s//g; + # The arglist of the empty C++ function + $args0 = $args; + $args0 =~ s/\*[^,]*,/\*,/g; + $args0 =~ s/\*[^,]*$/\*/g; + + # First, do the general template None of these functions is + # implemented, but they allow us to link for instance with + # long double lapack support + my $numbers = 1; + my $argst = $args0; + my $typet = $type; + while ($argst =~ s/double/number$numbers/) + { + $numbers++; + } + $typet =~ s/double/number1/g; + + $templates .= "\n\n/// Template wrapper for LAPACK functions d$name and s$name\n"; + $templates .= "template