f77test.cc 7.92 KB
Newer Older
thomas.forbriger's avatar
thomas.forbriger committed
1
2
3
4
5
/*! \file f77test.cc
 * \brief test interfacing Fortran code (implementation)
 * 
 * ----------------------------------------------------------------------------
 * 
thomas.forbriger's avatar
thomas.forbriger committed
6
 * $Id: f77test.cc,v 1.12 2006-03-28 16:03:11 tforb 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
 *
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
29
30
31
 * Activate sections for testing illegal constructs by passing macros
 * ILLEGAL1, ILLEGAL2, ILLEGAL3, ILLEGAL4, ILLEGAL5 to the preprocessor. Use
 * option -DILLEGAL1 etc.
 *
32
 * \sa \ref page_fortran
thomas.forbriger's avatar
thomas.forbriger committed
33
34
35
36
37
 * 
 * Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt) 
 * 
 * REVISIONS and CHANGES 
 *  - 22/12/2002   V1.0   Thomas Forbriger
38
39
40
 *  - 29/12/2002   V1.1   (thof)
 *                        - new uses new function aff::subarray
 *                        - new uses new function aff::slice
41
42
 *  - 03/01/2003   V1.2   (thof)
 *                        - test aff::util::SizeCheckedCast
thomas.forbriger's avatar
thomas.forbriger committed
43
44
45
46
 * 
 * ============================================================================
 */

47
48
49
50
51
/*! \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
52
53
54
55
56
 * This test program gives an example of the usage of the following classes,
 * functions, and preprocessor macros:
 *   - aff::FortranArray
 *   - aff::FortranShape
 *   - aff::Array
57
 *   - aff::util::SizeCheckedCast
thomas.forbriger's avatar
thomas.forbriger committed
58
59
60
 *   - #DUMP
 *   - #CODE
 *
61
 * \sa tests/f77test.cc
62
 * \sa \ref page_fortran
63
64
65
 */

#define AFF_F77TEST_CC_VERSION \
66
  "AFF_F77TEST_CC   V1.2"
67
#define AFF_F77TEST_CC_CVSID \
thomas.forbriger's avatar
thomas.forbriger committed
68
  "$Id: f77test.cc,v 1.12 2006-03-28 16:03:11 tforb Exp $"
69
70
71
72
73

#include <aff/array.h>
#include <aff/fortranshape.h>
#include <aff/dump.h>
#include <aff/shaper.h>
74
75
#include <aff/subarray.h>
#include <aff/slice.h>
76
#include <aff/lib/checkedcast.h>
77
#include "f77proto.h"
78
79
80
81

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

83
/*----------------------------------------------------------------------*/
thomas.forbriger's avatar
thomas.forbriger committed
84

85
86
87
88
89
90
91
//! 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
92
93
}

94
95
/*======================================================================*/

96
97
98
99
/*! \brief test array interface to Fortran 77
 *
 * \sa \ref page_fortran
 */
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
127
128
129
130
131
132
133
134
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;
  }
135
136
137
138
139

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

  section("Pass array to Fortran via subroutine arguments:", '=');
  {
140
    // create an array and fill it
141
142
    CODE(Array<int> A(Shaper(-3,3)(9)(-1,1)));
    CODE(A=-55);
143
    // create a subarray view and fill this through Fortran
144
    CODE(Array<int> B=subarray(A)(-2,2)(3,7)(0));
145
    CODE(f77interface::fill(B));
146
    // dump the result
147
    CODE(dump_array(A));
148
    // do it again for a slice
149
    CODE(f77interface::fill(slice(A)()(2)));
150
151
    CODE(dump_array(A));
  }
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

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

  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
171
    CODE(subarray(Z)(2,4)=Tzvalue(-10.));
172
173
174
175
    // and dump the effect
    CODE(dump_array(Z));
    CODE(dump_array(f77interface::sums()));
  }
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

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

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

thomas.forbriger's avatar
thomas.forbriger committed
203
204
    section("Test illegal usage (only if activated through macro-definition):",
            ' ');
205
206
207
208
209
210
211
212
213
    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);
214
215
216
#ifdef ILLEGAL1
#warning intentionally compiling illegal code:
#warning direct discard of const qualifier in conversion from non-const
217
    CODE(int *ip1=fiv1.castedpointer<const int>());
218
219
220
221
#endif
#ifdef ILLEGAL2
#warning intentionally compiling illegal code:
#warning direct discard of const qualifier in conversion from const array
222
    CODE(int *ip2=fiv2.castedpointer<const int>());
223
224
225
226
#endif
#ifdef ILLEGAL3
#warning intentionally compiling illegal code:
#warning discards const in conversion (reinterpret_cast)
227
    CODE(int *ip3=fiv2.castedpointer<int>());
228
229
230
231
#endif
#ifdef ILLEGAL4
#warning intentionally compiling illegal code:
#warning direct type mismatch
232
    CODE(float *ip4=fiv1.castedpointer<int>());
233
234
235
236
#endif
#ifdef ILLEGAL5
#warning intentionally compiling illegal code:
#warning wrong type size in conversion through reinterpret_cast
237
    CODE(double *ip5=fiv1.castedpointer<double>());
238
239
240
#endif
  }

241
242
} // main

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