TF++, Miscellaneous classes and modules in C++:
tests/fortranF77.f

You will find and example for the module fortranio in tests/fortraniotest.cc and tests/fortranF77.f.

See also
tfxx::fortranio::FortranBinInput
tfxx::fortranio::FortranBinOutput
FORTRAN I/O functions
TEST: Fortran I/O and byte swapping.
1 c this is <fortranF77.f>
2 c ----------------------------------------------------------------------------
3 c
4 c Copyright (c) 2002 by Thomas Forbriger (IMG Frankfurt)
5 c
6 c Fortran part of the Fortran I/O test routines
7 c
8 c ----
9 c This program is free software; you can redistribute it and/or modify
10 c it under the terms of the GNU General Public License as published by
11 c the Free Software Foundation; either version 2 of the License, or
12 c (at your option) any later version.
13 c
14 c This program is distributed in the hope that it will be useful,
15 c but WITHOUT ANY WARRANTY; without even the implied warranty of
16 c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 c GNU General Public License for more details.
18 c
19 c You should have received a copy of the GNU General Public License
20 c along with this program; if not, write to the Free Software
21 c Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
22 c ----
23 c
24 c REVISIONS and CHANGES
25 c 15/11/2002 V1.0 Thomas Forbriger
26 c 20/11/2002 V1.1 passed tests on AIX and Intel Linux
27 c
28 c ============================================================================
29 c
30  program fortranf77
31 c
32  character*(*) version
33  parameter(version=
34  & 'FORTRANF77 V1.0 Fortran I/O test routines')
35  character*(*) FORTRANF77_CVS_ID
36 c
37 c
38  logical optread,optwrite
39  character*80 filename
40  integer lu
41  parameter(lu=10)
42  integer imagic
43  character*4 cmagic
44  parameter(cmagic='ABCD')
45  integer inmagic
46  character*4 incmagic
47  equivalence(inmagic, incmagic)
48 c
49  integer nval, i, mval
50  parameter(mval=10)
51  integer val1(mval),val2(mval)
52  double precision dval(mval)
53  integer*8 llint
54  integer*4 lint
55  double complex dcplx
56  complex scplx
57 c
58  integer icpu, imatch
59 c commandline
60  integer maxopt, lastarg, iargc
61  character*80 argument
62  parameter(maxopt=4)
63  character*2 optid(maxopt)
64  character*80 optarg(maxopt)
65  logical optset(maxopt), opthasarg(maxopt)
66 c debugging
67  logical debug, verbose
68 c here are the keys to our commandline options
69  data optid/2h-d, 2h-v, 2h-r, 2h-w/
70  data opthasarg/2*.false.,2*.true./
71  data optarg/2*1h-,2*4hjunk/
72 c
73 c------------------------------------------------------------------------------
74 c basic information
75 c
76 c
77  argument=' '
78  if (iargc().eq.1) call getarg(1, argument)
79  if ((argument(1:5).eq.'-help').or.(iargc().lt.2)) then
80  print *,version
81  print *,'Usage: fortranF77 -r file|-w file [-v]'
82  print *,' or: fortranF77 -help'
83  if (argument(1:5).ne.'-help')
84  & stop 'ERROR: wrong number of arguments'
85  print *,' '
86  print *,'-v be verbose'
87  print *,'-r file read from file created by fortraniotest'
88  print *,'-w file write file to be read by fortraniotest'
89  print *,' '
90  print *,fortranf77_cvs_id
91  stop
92  endif
93 c
94 c------------------------------------------------------------------------------
95 c read command line arguments
96 c
97  call tf_cmdline(1, lastarg, maxopt, optid,
98  & optarg, optset, opthasarg)
99  debug=optset(1)
100  verbose=optset(2)
101  optread=optset(3)
102  optwrite=optset(4)
103  if (optread) then
104  optwrite=.false.
105  filename=optarg(3)
106  elseif (optwrite) then
107  filename=optarg(4)
108  else
109  stop 'ERROR: you must either set -r or -w!'
110  endif
111 c
112 c------------------------------------------------------------------------------
113 c go
114  if (verbose) then
115  print *,' '
116  print *,version
117  print *,fortranf77_cvs_id
118  print *,' '
119  endif
120 c
121  if (optread) then
122  if (verbose) then
123  print *,'reading from ',filename(1:index(filename,' ')-1)
124  endif
125  open(lu, file=filename, form='unformatted',
126  & status='old', err=96)
127  read(lu, err=95, end=94) inmagic
128  call tf_bytesex(cmagic, inmagic, icpu, imatch)
129  print *,'read magic number: ''',incmagic,', ',inmagic,''''
130  if (icpu.eq.1) then
131  print *,' I''m running on Intel'
132  elseif (icpu.eq.2) then
133  print *,' I''m running on Motorola'
134  else
135  print *,' I don''t know this CPU model'
136  stop 'ERROR: aborting...'
137  endif
138  if (imatch.eq.1) then
139  print *,' file data matches CPU model'
140  elseif (icpu.eq.2) then
141  print *,' file data must be swapped to match CPU'
142  stop 'ERROR: cannot perform swapping'
143  else
144  print *,' I do not know about the data encoding'
145  stop 'ERROR: aborting...'
146  endif
147  read(lu, err=95, end=94) nval, (val1(i), val2(i), i=1,nval)
148  read(lu, err=95, end=94) (dval(i), i=1,nval)
149  read(lu, err=98, end=94) llint,lint,dcplx,scplx
150  print *,' nval: ',nval
151  print 50, (val1(i), val2(i), i=1,nval)
152  print 51, (dval(i), i=1,nval)
153  print *, 'extra:', llint,lint,dcplx,scplx
154  close(lu, err=97)
155  else
156  if (verbose) then
157  print *,'writing to ',filename(1:index(filename,' ')-1)
158  endif
159  open(lu, file=filename, form='unformatted', err=99)
160  call tf_magic(cmagic, imagic)
161  print *,'writing magic number: ''',cmagic,', ',imagic,''''
162  write(lu, err=98) imagic
163  nval=mval
164  do i=1,nval
165  val1(i)=i*4
166  val2(i)=100*val1(i)
167  dval(i)=dble(i)*15.d0
168  enddo
169  llint=1551
170  lint=2662
171  scplx=(14.5d0,15.4d0)
172  dcplx=(4.5d0,5.4d0)
173  write(lu, err=98) nval, (val1(i), val2(i), i=1,nval)
174  write(lu, err=98) (dval(i), i=1,nval)
175  write(lu, err=98) llint,lint,dcplx,scplx
176  print *,' nval: ',nval
177  print 50, (val1(i), val2(i), i=1,nval)
178  print 51, (dval(i), i=1,nval)
179  print *, 'extra:', llint,lint,dcplx,scplx
180  close(lu, err=97)
181  endif
182 c
183  stop
184  50 format(2x,'val1/2:',2(1x,i10))
185  51 format(2x,'val: ',f10.3)
186  99 stop 'ERROR: opening for writing'
187  98 stop 'ERROR: writing'
188  97 stop 'ERROR: closing'
189  96 stop 'ERROR: opening for reading'
190  95 stop 'ERROR: reading'
191  94 stop 'ERROR: reading - unexpected end'
192  end
193 c
194 c
195 c ----- END OF fortranF77.f -----