f77test.cc 7.2 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.11 2003-01-03 17:28:45 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
13
14
15
 * Activate sections for testing illegal constructs by passing macros
 * ILLEGAL1, ILLEGAL2, ILLEGAL3, ILLEGAL4, ILLEGAL5 to the preprocessor. Use
 * option -DILLEGAL1 etc.
 *
16
 * \sa \ref page_fortran
thomas.forbriger's avatar
thomas.forbriger committed
17
18
19
20
21
 * 
 * Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt) 
 * 
 * REVISIONS and CHANGES 
 *  - 22/12/2002   V1.0   Thomas Forbriger
22
23
24
 *  - 29/12/2002   V1.1   (thof)
 *                        - new uses new function aff::subarray
 *                        - new uses new function aff::slice
25
26
 *  - 03/01/2003   V1.2   (thof)
 *                        - test aff::util::SizeCheckedCast
thomas.forbriger's avatar
thomas.forbriger committed
27
28
29
30
 * 
 * ============================================================================
 */

31
32
33
34
35
/*! \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
36
37
38
39
40
 * This test program gives an example of the usage of the following classes,
 * functions, and preprocessor macros:
 *   - aff::FortranArray
 *   - aff::FortranShape
 *   - aff::Array
41
 *   - aff::util::SizeCheckedCast
thomas.forbriger's avatar
thomas.forbriger committed
42
43
44
 *   - #DUMP
 *   - #CODE
 *
45
 * \sa tests/f77test.cc
46
 * \sa \ref page_fortran
47
48
49
 */

#define AFF_F77TEST_CC_VERSION \
50
  "AFF_F77TEST_CC   V1.2"
51
#define AFF_F77TEST_CC_CVSID \
52
  "$Id: f77test.cc,v 1.11 2003-01-03 17:28:45 forbrig Exp $"
53
54
55
56
57

#include <aff/array.h>
#include <aff/fortranshape.h>
#include <aff/dump.h>
#include <aff/shaper.h>
58
59
#include <aff/subarray.h>
#include <aff/slice.h>
60
#include <aff/lib/checkedcast.h>
61
#include "f77proto.h"
62
63
64
65

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

67
/*----------------------------------------------------------------------*/
thomas.forbriger's avatar
thomas.forbriger committed
68

69
70
71
72
73
74
75
//! 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
76
77
}

78
79
/*======================================================================*/

80
81
82
83
/*! \brief test array interface to Fortran 77
 *
 * \sa \ref page_fortran
 */
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
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;
  }
119
120
121
122
123

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

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

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

  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
155
    CODE(subarray(Z)(2,4)=Tzvalue(-10.));
156
157
158
159
    // and dump the effect
    CODE(dump_array(Z));
    CODE(dump_array(f77interface::sums()));
  }
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

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

  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);
186

thomas.forbriger's avatar
thomas.forbriger committed
187
188
    section("Test illegal usage (only if activated through macro-definition):",
            ' ');
189
190
191
192
193
194
195
196
197
    CODE(Array<int> iv1(1));
    CODE(ConstArray<int> iv2(iv1));
    CODE(FortranArray<Array<int> > fiv1(iv1));
    CODE(FortranArray<ConstArray<int> > fiv2(iv2));
    CODE(iv1(1)=50);
    CODE(cout << iv1(1) << ", " << iv2(1) << endl);
    CODE(int *iv1p=fiv1.pointer());
    CODE(const int *iv2p=fiv2.pointer());
    CODE(cout << *iv1p << ", " << *iv2p << endl);
198
199
200
#ifdef ILLEGAL1
#warning intentionally compiling illegal code:
#warning direct discard of const qualifier in conversion from non-const
201
    CODE(int *ip1=fiv1.castedpointer<const int>());
202
203
204
205
#endif
#ifdef ILLEGAL2
#warning intentionally compiling illegal code:
#warning direct discard of const qualifier in conversion from const array
206
    CODE(int *ip2=fiv2.castedpointer<const int>());
207
208
209
210
#endif
#ifdef ILLEGAL3
#warning intentionally compiling illegal code:
#warning discards const in conversion (reinterpret_cast)
211
    CODE(int *ip3=fiv2.castedpointer<int>());
212
213
214
215
#endif
#ifdef ILLEGAL4
#warning intentionally compiling illegal code:
#warning direct type mismatch
216
    CODE(float *ip4=fiv1.castedpointer<int>());
217
218
219
220
#endif
#ifdef ILLEGAL5
#warning intentionally compiling illegal code:
#warning wrong type size in conversion through reinterpret_cast
221
    CODE(double *ip5=fiv1.castedpointer<double>());
222
223
224
#endif
  }

225
226
} // main

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