f77interface.cc 4.47 KB
Newer Older
1
2
3
4
5
/*! \file f77interface.cc
 * \brief interface functions (implementation)
 * 
 * ----------------------------------------------------------------------------
 * 
thomas.forbriger's avatar
thomas.forbriger committed
6
 * $Id: f77interface.cc,v 1.7 2006/03/28 16:03:11 tforb Exp $
7
8
9
10
 * \author Thomas Forbriger
 * \date 23/12/2002
 * 
 * interface functions (implementation)
11
 *
thomas.forbriger's avatar
thomas.forbriger committed
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 * ----
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version. 
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 * ----
 *
28
 * \sa \ref page_fortran
29
30
31
32
33
 * 
 * Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt) 
 * 
 * REVISIONS and CHANGES 
 *  - 23/12/2002   V1.0   Thomas Forbriger
34
 *  - 29/12/2002   V1.1   now uses aff::subarray
35
36
 *  - 03/01/2003   V1.2   (thof)
 *                        - use aff::util::SizeCheckedCast
37
38
 *                        - FortranArray now takes container type as template
 *                          argument
39
40
41
42
 * 
 * ============================================================================
 */
#define AFF_F77INTERFACE_CC_VERSION \
43
  "AFF_F77INTERFACE_CC   V1.2"
44
#define AFF_F77INTERFACE_CC_CVSID \
thomas.forbriger's avatar
thomas.forbriger committed
45
  "$Id: f77interface.cc,v 1.7 2006/03/28 16:03:11 tforb Exp $"
46
47
48
49
50

// include assertions
#include<aff/lib/error.h>
// include FortranArray stuff
#include<aff/fortranshape.h>
51
52
#include<aff/subarray.h>
#include<aff/shaper.h>
53
#include<aff/lib/checkedcast.h>
54
55
56
57
58
59
60
61
62

/*----------------------------------------------------------------------*/

// include interface prototypes
#include"f77proto.h"

/*----------------------------------------------------------------------*/

// get common block
63
#include"f77common_com.P"
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

/*----------------------------------------------------------------------*/

// 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)
{
94
  aff::FortranArray<aff::Array<int> > fa(a);
95
  integer* pa=fa.castedpointer<integer>();
96
97
98
99
100
101
102
103
104
  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));
}

105
106
107
108
109
110
/*----------------------------------------------------------------------*/

//! fill common block through Fortran subroutine
int fillarray(const aff::Array<float>& v1,
              const aff::Array<float>& v2)
{
111
  aff::FortranArray<aff::Array<float> > fv1(v1),fv2(v2);
112
113
  real* p1=fv1.castedpointer<real>();
  real* p2=fv2.castedpointer<real>();
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
  integer n1=fv1.last(0);
  integer n2=fv2.last(0);
  return(fillarray_(p1, p2, &n1, &n2));
}

/*----------------------------------------------------------------------*/

//! read from common block through Fortran subroutine
Tcarray sums()
{
  typedef Tcarray::Tvalue Tcvalue;
  // prepare array that is large enough
  integer maxa,maxb;
  comdim_(&maxa, &maxb);
  Tcarray result(maxa);
  // prepare Fortran view
130
  aff::FortranArray<Tcarray> fa(result);
131
  complex* p=fa.castedpointer<complex>();
132
133
  integer size;
  sums_(p, &maxa, &size);
134
  return(aff::subarray(result)(size));
135
136
137
138
139
140
141
142
}

/*----------------------------------------------------------------------*/

//! create view from common
Tzarray viewcommon()
{
  typedef Tzarray::Tvalue Tzvalue;
143
  typedef aff::util::SizeCheckedCast<doublecomplex, Tzvalue> Tcast;
144
145
  integer maxa,maxb;
  comdim_(&maxa, &maxb);
146
  Tzvalue* p=Tcast::cast(f77common_.array);
147
148
149
150
151
152
153
154
  // create a shape
  aff::Strided shape(aff::Shaper(1,f77common_.na,maxa)(1,f77common_.nb,maxb));
  // create a representation
  aff::SharedHeap<Tzvalue> repr(p, shape.memory_size());
  // create array and return
  return Tzarray(shape, repr);
}

155
156
157
} // namespace f77interface

/* ----- END OF f77interface.cc ----- */