/usr/share/deal.II/scripts/lapack_templates.pl is in libdeal.ii-dev 6.3.1-1.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | #---------------------------------------------------------------------------
# $Id: lapack_templates.pl 21055 2010-04-30 13:40:41Z bangerth $
# Version: $Name$
#
# 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.
#
#---------------------------------------------------------------------------
#---------------------------------------------------------------------------
# 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 <base/config.h>
#include <lac/lapack_support.h>
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;
$templates .= "\n\n#ifdef HAVE_D$capname\_";
$templates .= "\ninline $type\n$name ($args)\n{\n d$name\_ ($args2);\n}\n";
$templates .= "#else\ninline $type\n$name ($args0)\n";
$templates .= "{\n Assert (false, LAPACKSupport::ExcMissing(\"d$name\"));\n}\n#endif\n";
$args =~ s/double/float/g;
$args0 =~ s/double/float/g;
$type =~ s/double/float/g;
$templates .= "\n\n#ifdef HAVE_S$capname\_";
$templates .= "\ninline $type\n$name ($args)\n{\n s$name\_ ($args2);\n}\n";
$templates .= "#else\ninline $type\n$name ($args0)\n";
$templates .= "{\n Assert (false, LAPACKSupport::ExcMissing(\"s$name\"));\n}\n#endif\n";
}
}
print "\n}\n\nDEAL_II_NAMESPACE_OPEN\n";
print "$templates\n\nDEAL_II_NAMESPACE_CLOSE\n\n#endif\n";
|