f77test.cc 6.6 KB
Newer Older
thomas.forbriger's avatar
thomas.forbriger committed
1
2
3
4
5
/*! \file f77test.cc
 * \brief test interfacing Fortran code (implementation)
 * 
 * ----------------------------------------------------------------------------
 * 
6
 * $Id: f77test.cc,v 1.8 2003-01-03 16:56:49 forbrig Exp $
thomas.forbriger's avatar
thomas.forbriger committed
7
8
9
10
 * \author Thomas Forbriger
 * \date 22/12/2002
 * 
 * test interfacing Fortran code (implementation)
11
12
 *
 * \sa \ref page_fortran
thomas.forbriger's avatar
thomas.forbriger committed
13
14
15
16
17
 * 
 * Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt) 
 * 
 * REVISIONS and CHANGES 
 *  - 22/12/2002   V1.0   Thomas Forbriger
18
19
20
 *  - 29/12/2002   V1.1   (thof)
 *                        - new uses new function aff::subarray
 *                        - new uses new function aff::slice
21
22
 *  - 03/01/2003   V1.2   (thof)
 *                        - test aff::util::SizeCheckedCast
thomas.forbriger's avatar
thomas.forbriger committed
23
24
25
26
 * 
 * ============================================================================
 */

27
28
29
30
31
/*! \example tests/f77test.cc
 *
 * Passing arrays to Fortran 77 code and retrieving array structures
 * from Fortran 77 common blocks.
 *
thomas.forbriger's avatar
thomas.forbriger committed
32
33
34
35
36
 * This test program gives an example of the usage of the following classes,
 * functions, and preprocessor macros:
 *   - aff::FortranArray
 *   - aff::FortranShape
 *   - aff::Array
37
 *   - aff::util::SizeCheckedCast
thomas.forbriger's avatar
thomas.forbriger committed
38
39
40
 *   - #DUMP
 *   - #CODE
 *
41
 * \sa tests/f77test.cc
42
 * \sa \ref page_fortran
43
44
45
 */

#define AFF_F77TEST_CC_VERSION \
46
  "AFF_F77TEST_CC   V1.2"
47
#define AFF_F77TEST_CC_CVSID \
48
  "$Id: f77test.cc,v 1.8 2003-01-03 16:56:49 forbrig Exp $"
49
50
51
52
53

#include <aff/array.h>
#include <aff/fortranshape.h>
#include <aff/dump.h>
#include <aff/shaper.h>
54
55
#include <aff/subarray.h>
#include <aff/slice.h>
56
#include <aff/lib/checkedcast.h>
57
#include "f77proto.h"
58
59
60
61

using std::cout;
using std::endl;
using namespace aff;
thomas.forbriger's avatar
thomas.forbriger committed
62

63
/*----------------------------------------------------------------------*/
thomas.forbriger's avatar
thomas.forbriger committed
64

65
66
67
68
69
70
71
//! print headline
void section(const char* s, const char l='-')
{
  cout << endl << s << endl;
  const char* p=s;
  while (*p) { cout << l; ++p; }
  cout << endl;
thomas.forbriger's avatar
thomas.forbriger committed
72
73
}

74
75
/*======================================================================*/

76
77
78
79
/*! \brief test array interface to Fortran 77
 *
 * \sa \ref page_fortran
 */
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
int main()
{
  cout << AFF_F77TEST_CC_VERSION << endl;
  cout << AFF_F77TEST_CC_CVSID << endl;

  // First we test the shape class that should support passing arrays to
  // Fortran 77 functions
  section("FortranShape:", '=');
  {
    section("Full Layout");
    // we create a test array with known Fortran layout
    CODE(Strided strided(Shaper(1,10,20)(1,5,10)(1,30)(20)));
    // dump this shape
    DUMP(strided);
    // create Fortran shape from this (should be identical to known)
    CODE(aff::util::FortranShape fs1(strided));
    // and dump this
    DUMP(fs1.first());
    DUMP(fs1.last());
    DUMP(fs1.dimlast());
    cout << "fs1.offset(): " << fs1.offset() << endl;

    section("Sliced Subshape");
    // now take shape of a subarray
    CODE(Strided subshape(strided));
    CODE(subshape.shrink(0,2).shrink(1,3,5).shrink(3,10,20));
    CODE(subshape.collapse(2,15));
    // create Fortran shape from this
    CODE(aff::util::FortranShape fs2(subshape));
    // and dump this
    DUMP(fs2.first());
    DUMP(fs2.last());
    DUMP(fs2.dimlast());
    cout << "fs2.offset(): " << fs2.offset() << endl;
  }
115
116
117
118
119

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

  section("Pass array to Fortran via subroutine arguments:", '=');
  {
120
    // create an array and fill it
121
122
    CODE(Array<int> A(Shaper(-3,3)(9)(-1,1)));
    CODE(A=-55);
123
    // create a subarray view and fill this through Fortran
124
    CODE(Array<int> B=subarray(A)(-2,2)(3,7)(0));
125
    CODE(f77interface::fill(B));
126
    // dump the result
127
    CODE(dump_array(A));
128
    // do it again for a slice
129
    CODE(f77interface::fill(slice(A)()(2)));
130
131
    CODE(dump_array(A));
  }
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

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

  section("Access to common block:", '=');
  {
    // prepare to vectors to pass to fillarray
    CODE(Array<float> v1(5));
    CODE(Array<float> v2(3));
    CODE(for(int i=v1.f(0); i<=v1.l(0); i++) { v1(i)=2.*i; });
    CODE(for(int i=v2.f(0); i<=v2.l(0); i++) { v2(i)=.5*i; });
    // fill common block through Fortran 77 subroutine
    CODE(f77interface::fillarray(v1, v2));
    // get a view on the common block and dump it
    CODE(f77interface::Tzarray Z(f77interface::viewcommon()));
    CODE(dump_array(Z));
    // call Fortran subroutine sum and dump result
    CODE(dump_array(f77interface::sums()));
    CODE(typedef f77interface::Tzarray::Tvalue Tzvalue);
    // write directly to common block through a subarray
151
    CODE(subarray(Z)(2,4)=Tzvalue(-10.));
152
153
154
155
    // and dump the effect
    CODE(dump_array(Z));
    CODE(dump_array(f77interface::sums()));
  }
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208

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

  section("Size-checked casts:", '=');
  {
    CODE(typedef std::complex<int> Ticvalue);
    CODE(typedef std::complex<float> Tcvalue);
    CODE(Array<Ticvalue> v1(1));
    CODE(ConstArray<Ticvalue> v2(v1));
    CODE(FortranArray<Array<Ticvalue> > fv1(v1));
    CODE(FortranArray<ConstArray<Ticvalue> > fv2(v2));
    CODE(v1(1)=Ticvalue(3,7));
    CODE(cout << v1(1) << ", " << v2(1) << endl);
    CODE(Ticvalue *icp=fv1.castedpointer<Ticvalue>());
    CODE(*icp=Ticvalue(35,60));
    CODE(cout << v1(1) << ", " << v2(1) << endl);
    CODE(const Ticvalue *cicp1=fv1.castedpointer<const Ticvalue>());
    CODE(const Ticvalue *cicp2=fv2.castedpointer<const Ticvalue>());
    CODE(cout << *cicp1 << ", " << *cicp2 << endl);
    section("That's dangerous:",' ');
    CODE(Tcvalue *cp=fv1.castedpointer<Tcvalue>());
    CODE(*cp=Ticvalue(35,60));
    CODE(cout << v1(1) << ", " << v2(1) << endl);
    CODE(double *dp=fv1.castedpointer<double>());
    CODE(*dp=35.e12);
    CODE(cout << v1(1) << ", " << v2(1) << endl);
#ifdef ILLEGAL1
#warning intentionally compiling illegal code:
#warning direct discard of const qualifier in conversion from non-const
    CODE(Ticvalue *ip1=fv1.castedpointer<const Ticvalue>());
#endif
#ifdef ILLEGAL2
#warning intentionally compiling illegal code:
#warning direct discard of const qualifier in conversion from const array
    CODE(Ticvalue *ip2=fv2.castedpointer<const Ticvalue>());
#endif
#ifdef ILLEGAL3
#warning intentionally compiling illegal code:
#warning discards const in conversion (reinterpret_cast)
    CODE(Ticvalue *ip3=fv2.castedpointer<Ticvalue>());
#endif
#ifdef ILLEGAL4
#warning intentionally compiling illegal code:
#warning direct type mismatch
    CODE(float *ip4=fv1.castedpointer<Ticvalue>());
#endif
#ifdef ILLEGAL5
#warning intentionally compiling illegal code:
#warning wrong type size in conversion through reinterpret_cast
    CODE(float *ip5=fv1.castedpointer<float>());
#endif
  }

209
210
} // main

thomas.forbriger's avatar
thomas.forbriger committed
211
/* ----- END OF f77test.cc ----- */