Commit 9eb7fc96 authored by thomas.forbriger's avatar thomas.forbriger Committed by thomas.forbriger
Browse files

first test of Fortran 77 interface works

This is a legacy commit from before 2015-03-01.
It may be incomplete as well as inconsistent.
See COPYING.legacy and README.history for details.


SVN Path:     http://gpitrsvn.gpi.uni-karlsruhe.de/repos/TFSoftware/trunk
SVN Revision: 1235
SVN UUID:     67feda4a-a26e-11df-9d6e-31afc202ad0c
parent eddd8aaa
# this is <Makefile>
# ----------------------------------------------------------------------------
# $Id: Makefile,v 1.12 2002-12-23 13:54:57 forbrig Exp $
# $Id: Makefile,v 1.13 2002-12-23 16:43:38 forbrig Exp $
#
# Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
#
......@@ -68,7 +68,7 @@ LIBINSTALLPATH=$(LOCLIBDIR)
STRIPHEADER=$(addsuffix .strip,$(notdir $(HEADERS)))
# name of installed (exported) header files (these are the names in your
# include directory)
INSTHEADER=$(addprefix $(INCINSTALLPATH)/,$(HEADERS))
INSTHEADER=$(addprefix $(INCINSTALLPATH)/,$(filter-out ./tests/%,$(HEADERS)))
# if defined, empty lines are kept in comment-stripped headers
# to synchronize line numbers (necessary during library debugging)
......
......@@ -3,7 +3,7 @@
*
* ----------------------------------------------------------------------------
*
* $Id: README.changelog,v 1.19 2002-12-23 13:54:58 forbrig Exp $
* $Id: README.changelog,v 1.20 2002-12-23 16:43:39 forbrig Exp $
*
* Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
*
......@@ -21,7 +21,7 @@
/*! \page page_changelog ChangeLog (AFF)
$Id: README.changelog,v 1.19 2002-12-23 13:54:58 forbrig Exp $
$Id: README.changelog,v 1.20 2002-12-23 16:43:39 forbrig Exp $
\sa \ref page_project_status
......@@ -36,6 +36,7 @@
- aff::Array::copyin() and aff::Array::copyout() work
- introduced fortranshape.h and fortranshape.cc and herein
aff::FortranArray and aff::util::FortranShape
- first Test of Fortran 77 interface works
- \b 22/12/2002 (thof)
- started test for interface to Fortran 77 code
......@@ -92,7 +93,7 @@
/*! \page page_project_status Project status (AFF)
$Id: README.changelog,v 1.19 2002-12-23 13:54:58 forbrig Exp $
$Id: README.changelog,v 1.20 2002-12-23 16:43:39 forbrig Exp $
\sa \ref page_changelog
......@@ -252,19 +253,23 @@
<TD>does not check pathological cases</TD>
</TR>
<TR><TD>libaff/tests/f77common.inc</TD>
<TD> </TD><TD> </TD><TD> </TD>
<TD>23/12/02</TD><TD> </TD><TD> </TD>
<TD> </TD>
</TR>
<TR><TD>libaff/tests/f77interface.cc</TD>
<TD>23/12/02</TD><TD> </TD><TD>23/12/02</TD>
<TD>common block test is missing</TD>
</TR>
<TR><TD>libaff/tests/f77procs.f</TD>
<TD> </TD><TD> </TD><TD> </TD>
<TD>23/12/02</TD><TD> </TD><TD>23/12/02</TD>
<TD> </TD>
</TR>
<TR><TD>libaff/tests/f77proto.h</TD>
<TD> </TD><TD> </TD><TD> </TD>
<TD>23/12/02</TD><TD> </TD><TD>23/12/02</TD>
<TD> </TD>
</TR>
<TR><TD>libaff/tests/f77test.cc</TD>
<TD> </TD><TD> </TD><TD> </TD>
<TD>23/12/02</TD><TD> </TD><TD>23/12/02</TD>
<TD> </TD>
</TR>
</TABLE>
......
......@@ -3,7 +3,7 @@
*
* ----------------------------------------------------------------------------
*
* $Id: fortranshape.h,v 1.2 2002-12-23 14:32:04 forbrig Exp $
* $Id: fortranshape.h,v 1.3 2002-12-23 16:43:39 forbrig Exp $
* \author Thomas Forbriger
* \date 23/12/2002
*
......@@ -23,7 +23,7 @@
#define AFF_FORTRANSHAPE_H_VERSION \
"AFF_FORTRANSHAPE_H V1.0 "
#define AFF_FORTRANSHAPE_H_CVSID \
"$Id: fortranshape.h,v 1.2 2002-12-23 14:32:04 forbrig Exp $"
"$Id: fortranshape.h,v 1.3 2002-12-23 16:43:39 forbrig Exp $"
#include<aff/array.h>
......@@ -95,7 +95,7 @@ class FortranArray: private aff::util::FortranShape {
//! pointer to array base in memory
typedef typename Tarray::Tpointer Tpointer;
//! create
FortranArray(const Tarray& array, const bool& BaseOne=true):
FortranArray(Tarray array, const bool& BaseOne=true):
Tbase(array.shape(), BaseOne)
{
Trepresentation repr=array.representation();
......
# this is <Makefile>
# ----------------------------------------------------------------------------
# $Id: Makefile,v 1.7 2002-12-23 14:32:05 forbrig Exp $
# $Id: Makefile,v 1.8 2002-12-23 16:43:39 forbrig Exp $
#
# Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
#
......@@ -43,7 +43,7 @@ BINARYTEST=binarraytest
F77TEST=f77test
EXECUTABLES=$(STANDARDTEST) $(BINARYTEST) $(F77TEST)
$(addsuffix .o,$(STANDARDTEST) $(BINARYTEST)): %.o: %.cc
$(addsuffix .o,$(STANDARDTEST) $(BINARYTEST) $(F77TEST)): %.o: %.cc
$(CXX) -c -o $@ $< $(CXXFLAGS) $(CPPFLAGS) $(FLAGS)
$(STANDARDTEST): %: %.o; $(CXX) -o $@ $< $(LDFLAGS) -laff
......@@ -59,13 +59,23 @@ FC=g77
F2C=f2c
%.o: %.f
$(FC) -o $@ -c $<
$(F2C) -C++ -f -u $<
$(CXX) -c -o $@ $(<:.f=.c) $(CXXFLAGS) $(CPPFLAGS) $(FLAGS)
/bin/rm -fv $(<:.f=.c)
%.P: %.f
$(F2C) -C++ -f -P $<
-/bin/mv -v $(patsubst %.f,%.c,$<) $(patsubst %.f,%.code,$<)
$(F2C) -C++ -f -u -P -\!c $<
/bin/mv -v $(patsubst %.f,%.c,$<) $(patsubst %.f,%.code,$<)
f77test: f77test.o
$(CXX) -o $@ $< $(LDFLAGS) -laff
f77common_com.P: f77procs.f
$(F2C) -C++ -f -u -ec $<
/bin/mv -v $(patsubst %.P,%.c,$@) $@
/bin/rm -fv $(patsubst %.f,%.c,$<)
f77interface.o: f77interface.cc f77proto.h f77procs.P f77common_com.P
$(CXX) -c -o $@ $< $(CXXFLAGS) $(CPPFLAGS) $(FLAGS)
f77test: f77test.o f77procs.o f77interface.o
$(CXX) -o $@ $^ $(LDFLAGS) -laff -lf2c -lm
# ----- END OF Makefile -----
/*! \file f77interface.cc
* \brief interface functions (implementation)
*
* ----------------------------------------------------------------------------
*
* $Id: f77interface.cc,v 1.1 2002-12-23 16:43:39 forbrig Exp $
* \author Thomas Forbriger
* \date 23/12/2002
*
* interface functions (implementation)
*
* Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
*
* REVISIONS and CHANGES
* - 23/12/2002 V1.0 Thomas Forbriger
*
* ============================================================================
*/
#define AFF_F77INTERFACE_CC_VERSION \
"AFF_F77INTERFACE_CC V1.0 "
#define AFF_F77INTERFACE_CC_CVSID \
"$Id: f77interface.cc,v 1.1 2002-12-23 16:43:39 forbrig Exp $"
// include assertions
#include<aff/lib/error.h>
// include FortranArray stuff
#include<aff/fortranshape.h>
/*----------------------------------------------------------------------*/
// include interface prototypes
#include"f77proto.h"
/*----------------------------------------------------------------------*/
// get common block
// #include"f77common_com.P"
/*----------------------------------------------------------------------*/
// f2c declarations
#include "f2c.h"
#ifdef __cplusplus
extern "C" {
#endif
// include prototypes of Fortran subroutines
#include"f77procs.P"
//! essential definitions to satisfy linker
int MAIN__()
{
AFF_abort("should never be called!");
}
#ifdef __cplusplus
}
#endif
/*======================================================================*/
namespace f77interface {
//! interface function to Fortran77 subroutine fill
int fill(const aff::Array<int>& a)
{
aff::FortranArray<int> fa(a);
// that's a critical point
// we need a reinterpret cast to do that!
// for this reason we check the type size
AFF_assert((sizeof(integer)==sizeof(int)),
"ERROR (f77interface::fill): illegal type size!");
integer* pa=reinterpret_cast<integer *>(fa.pointer());
integer n1=fa.last(0);
integer n2=fa.last(1);
integer n3=fa.last(2);
integer l1=fa.dimlast(0);
integer l2=fa.dimlast(1);
integer l3=fa.dimlast(2);
return(fill_(pa, &l1, &n1, &l2, &n2, &l3, &n3));
}
} // namespace f77interface
/* ----- END OF f77interface.cc ----- */
c this is <f77procs.f>
c ----------------------------------------------------------------------------
c ($Id: f77procs.f,v 1.2 2002-12-23 14:32:05 forbrig Exp $)
c ($Id: f77procs.f,v 1.3 2002-12-23 16:43:39 forbrig Exp $)
c
c Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
c
......@@ -31,7 +31,7 @@ c
nb=n2
do i=1,n1
do j=1,n2
array(i,j)=vec1(i)+ime*vec(j)
array(i,j)=vec1(i)+ime*vec2(j)
enddo
enddo
return
......@@ -63,7 +63,7 @@ c
c
c----------------------------------------------------------------------
c
function double complex total(i)
double complex function total(i)
c
include 'f77common.inc'
c
......
......@@ -3,7 +3,7 @@
*
* ----------------------------------------------------------------------------
*
* $Id: f77proto.h,v 1.1 2002-12-23 11:44:04 forbrig Exp $
* $Id: f77proto.h,v 1.2 2002-12-23 16:43:39 forbrig Exp $
* \author Thomas Forbriger
* \date 22/12/2002
*
......@@ -18,17 +18,22 @@
*/
// include guard
#ifndef TF_F77PROTO_H_VERSION
#ifndef AFF_F77PROTO_H_VERSION
#define TF_F77PROTO_H_VERSION \
"TF_F77PROTO_H V1.0 "
#define TF_F77PROTO_H_CVSID \
"$Id: f77proto.h,v 1.1 2002-12-23 11:44:04 forbrig Exp $"
#define AFF_F77PROTO_H_VERSION \
"AFF_F77PROTO_H V1.0 "
#define AFF_F77PROTO_H_CVSID \
"$Id: f77proto.h,v 1.2 2002-12-23 16:43:39 forbrig Exp $"
namespace tf {
#include<aff/array.h>
}
namespace f77interface {
#endif // TF_F77PROTO_H_VERSION (includeguard)
int fill(const aff::Array<int>& fa);
} // namespace f77interface
#endif // AFF_F77PROTO_H_VERSION (includeguard)
/* ----- END OF f77proto.h ----- */
......@@ -3,7 +3,7 @@
*
* ----------------------------------------------------------------------------
*
* $Id: f77test.cc,v 1.2 2002-12-23 14:32:05 forbrig Exp $
* $Id: f77test.cc,v 1.3 2002-12-23 16:43:39 forbrig Exp $
* \author Thomas Forbriger
* \date 22/12/2002
*
......@@ -28,12 +28,15 @@
#define AFF_F77TEST_CC_VERSION \
"AFF_F77TEST_CC V1.0 "
#define AFF_F77TEST_CC_CVSID \
"$Id: f77test.cc,v 1.2 2002-12-23 14:32:05 forbrig Exp $"
"$Id: f77test.cc,v 1.3 2002-12-23 16:43:39 forbrig Exp $"
#include <aff/array.h>
#include <aff/fortranshape.h>
#include <aff/dump.h>
#include <aff/shaper.h>
#include <aff/subarray.h>
#include <aff/slice.h>
#include "f77proto.h"
using std::cout;
using std::endl;
......@@ -88,6 +91,20 @@ int main()
DUMP(fs2.dimlast());
cout << "fs2.offset(): " << fs2.offset() << endl;
}
/*----------------------------------------------------------------------*/
section("Pass array to Fortran via subroutine arguments:", '=');
{
// create an array
CODE(Array<int> A(Shaper(-3,3)(9)(-1,1)));
CODE(A=-55);
CODE(Array<int> B=Subarray<int>(A)(-2,2)(3,7)(0));
CODE(f77interface::fill(B));
CODE(dump_array(A));
CODE(f77interface::fill(Slice<int>(A)()(2)));
CODE(dump_array(A));
}
} // main
/* ----- END OF f77test.cc ----- */
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment