« back to all changes in this revision
Viewing changes to TESTS/mmio.f
- browse files at revision 14
- compare with another revision
- download diff
- download tarball
- view history from revision 14
- Committer: Package Import Robot
- Author(s): Sylvestre Ledru
- Date: 2012-02-22 11:05:03 UTC
- mfrom: (1.2.5)
- Revision ID: package-import@ubuntu.com-20120222110503-h6ux3f5ilm5q76w0
Tags: 3.1.0-1
New upstream release
- files added:
- PARPACK_CHANGES
- TESTS
- files modified:
- CHANGES
added
removed
TESTS/mmio.f
1
subroutine mmread(iunit,rep,field,symm,rows,cols,nnz,nnzmax,
2
* indx,jndx,ival,rval,cval)
3
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4
c
5
c This routine will read data from a matrix market formatted file.
6
c The data may be either sparse coordinate format, or dense array format.
7
c
8
c The unit iunit must be open, and the file will be rewound on return.
9
c
10
c 20-Sept-96 Karin A. Remington, NIST ACMD (karin@cam.nist.gov)
11
c 18-Oct-96 Change in routine name to match C and Matlab routines.
12
c 30-Oct-96 Bug fixes in mmio.f:
13
c -looping for comment lines
14
c -fixed non-ansi zero stringlength
15
c -incorrect size calculation for skew-symmetric arrays
16
c Other changes in mmio.f:
17
c -added integer value parameter to calling sequences
18
c -enforced proper count in size info line
19
c -added routine to count words in string (countwd)
20
c (Thanks to G.P.Leendetse and H.Oudshoom for their review
21
c of the initial version and suggested fixes.)
22
c 15-Oct-08 fixed illegal attempt of mimicking "do while" construct
23
c by redifing limits inside loop. (lines 443-450)
24
c (Thanks to Geraldo Veiga for his comments.)
25
c
26
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
27
c
28
c Arguments:
29
c
30
c name type in/out description
31
c ---------------------------------------------------------------
32
c
33
c iunit integer in Unit identifier for the file
34
c containing the data to be read.
35
c Must be open prior to call.
36
c Will be rewound on return.
37
c
38
c rep character*10 out Matrix Market 'representation'
39
c indicator. On return:
40
c
41
c coordinate (for sparse data)
42
c array (for dense data)
43
c elemental (to be added)
44
c
45
c field character*7 out Matrix Market 'field'. On return:
46
c
47
c real
48
c complex
49
c integer
50
c pattern
51
c
52
c symm character*19 out Matrix Market 'field'. On return:
53
c
54
c symmetric
55
c hermitian
56
c skew-symmetric
57
c general
58
c
59
c rows integer out Number of rows in matrix.
60
c
61
c cols integer out Number of columns in matrix.
62
c
63
c nnz integer out Number of nonzero entries required to
64
c store matrix.
65
c
66
c nnzmax integer in Maximum dimension of data arrays.
67
c
68
c indx integer(nnz)out Row indices for coordinate format.
69
c Undefined for array format.
70
c
71
c jndx integer(nnz)out Column indices for coordinate format.
72
c Undefined for array format.
73
c
74
c ival integer(nnz) out Integer data (if applicable, see 'field')
75
c
76
c rval double(nnz) out Real data (if applicable, see 'field')
77
c
78
c cval complex(nnz)out Complex data (if applicable, see 'field')
79
c
80
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
81
c
82
c Declarations:
83
c
84
integer ival(*)
85
double precision rval(*)
86
complex cval(*)
87
double precision rpart,ipart
88
integer indx(*)
89
integer jndx(*)
90
integer i, rows, cols, nnz, nnzreq, nnzmax, iunit
91
integer count
92
character mmhead*15
93
character mmtype*6
94
character rep*10
95
character field*7
96
character symm*19
97
character tmp1*1024
98
character tmp2*2
99
c
100
c Read header line and check validity:
101
c
102
read (iunit,end=1000,fmt=5) tmp1
103
5 format(1024A)
104
call getwd(mmhead,tmp1,1024,1,next,count)
105
if ( count .eq. 0 ) go to 5000
106
call getwd(mmtype,tmp1,1024,next,next,count)
107
if ( count .eq. 0 ) go to 5000
108
call getwd(rep,tmp1,1024,next,next,count)
109
if ( count .eq. 0 ) go to 5000
110
call getwd(field,tmp1,1024,next,next,count)
111
if ( count .eq. 0 ) go to 5000
112
call getwd(symm,tmp1,1024,next,next,count)
113
if ( count .eq. 0 ) go to 5000
114
if ( mmhead .ne. '%%MatrixMarket' ) go to 5000
115
c
116
c Convert type code to lower case for easier comparisons:
117
c
118
call lowerc(mmtype,1,6)
119
if ( mmtype .ne. 'matrix' ) then
120
print *,'Invalid matrix type: ',mmtype
121
print *,'This reader only understands type ''matrix''.'
122
stop
123
else
124
call lowerc(rep,1,10)
125
call lowerc(field,1,7)
126
call lowerc(symm,1,19)
127
endif
128
c
129
c Test input qualifiers:
130
c
131
if (rep .ne. 'coordinate' .and. rep .ne. 'array' )
132
* go to 6000
133
if (rep .eq. 'coordinate' .and. field .ne. 'integer' .and.
134
* field .ne. 'real' .and. field .ne. 'complex' .and.
135
* field .ne. 'pattern') go to 7000
136
if (rep .eq. 'array' .and. field .ne. 'integer' .and.
137
* field .ne. 'real' .and. field .ne. 'complex' ) go to 8000
138
if (symm .ne. 'general' .and. symm .ne. 'symmetric' .and.
139
* symm .ne. 'hermitian' .and. symm .ne. 'skew-symmetric')
140
* go to 9000
141
c
142
c Read through comment lines, ignoring content:
143
c
144
read (iunit,end=2000,fmt=200) tmp2
145
200 format(1a)
146
10 continue
147
if ( tmp2(1:1) .ne. '%' ) then
148
go to 20
149
endif
150
read (iunit,end=2000,fmt=200) tmp2
151
go to 10
152
20 continue
153
c
154
c Just read a non-comment.
155
c Now, back up a line, and read for first int, and back up
156
c again. This will set pointer to just before apparent size
157
c info line.
158
c Before continuing with free form input, count the number of
159
c words on the size info line to ensure there is the right amount
160
c of info (2 words for array matrices, 3 for coordinate matrices).
161
c
162
backspace (iunit)
163
read (iunit,end=1000,fmt=5) tmp1
164
call countwd(tmp1,1024,1,count)
165
if ( rep .eq. 'array' .and. count .ne. 2 ) go to 3000
166
if ( rep .eq. 'coordinate' .and. count .ne. 3 ) go to 3500
167
c
168
c Correct number of words are present, now back up and read them.
169
c
170
backspace (iunit)
171
c
172
if ( rep .eq. 'coordinate' ) then
173
c
174
c Read matrix in sparse coordinate format
175
c
176
read (iunit,fmt=*) rows,cols,nnz
177
c
178
c Check to ensure adequate storage is available
179
c
180
if ( nnz .gt. nnzmax ) then
181
print *,'insufficent array lengths for matrix of ',nnz,
182
* ' nonzeros.'
183
print *,'resize nnzmax to at least ',nnz,'. (currently ',
184
* nnzmax,')'
185
stop
186
endif
187
c
188
c Read data according to data type (real,integer,complex, or pattern)
189
c
190
if ( field .eq. 'integer' ) then
191
do 30 i=1,nnz
192
read (iunit,fmt=*,end=4000) indx(i),jndx(i),ival(i)
193
30 continue
194
elseif ( field .eq. 'real' ) then
195
do 35 i=1,nnz
196
read (iunit,fmt=*,end=4000) indx(i),jndx(i),rval(i)
197
35 continue
198
elseif ( field .eq. 'complex' ) then
199
do 40 i=1,nnz
200
read (iunit,fmt=*,end=4000) indx(i),jndx(i),rpart,ipart
201
cval(i) = cmplx(rpart,ipart)
202
40 continue
203
elseif ( field .eq. 'pattern' ) then
204
do 50 i=1,nnz
205
read (iunit,fmt=*,end=4000) indx(i),jndx(i)
206
50 continue
207
else
208
print *,'''',field,''' data type not recognized.'
209
stop
210
endif
211
rewind(iunit)
212
return
213
c
214
elseif ( rep .eq. 'array' ) then
215
c
216
c Read matrix in dense column-oriented array format
217
c
218
read (iunit,fmt=*) rows,cols
219
c
220
c Check to ensure adequate storage is available
221
c
222
if ( symm .eq. 'symmetric' .or. symm .eq. 'hermitian' ) then
223
nnzreq = (rows*cols - rows)/2 + rows
224
nnz = nnzreq
225
elseif ( symm .eq. 'skew-symmetric' ) then
226
nnzreq = (rows*cols - rows)/2
227
nnz = nnzreq
228
else
229
nnzreq = rows*cols
230
nnz = nnzreq
231
endif
232
if ( nnzreq .gt. nnzmax ) then
233
print *,'insufficent array length for ',rows, ' by ',
234
* cols,' dense ',symm,' matrix.'
235
print *,'resize nnzmax to at least ',nnzreq,'. (currently ',
236
* nnzmax,')'
237
stop
238
endif
239
c
240
c Read data according to data type (real,integer,complex, or pattern)
241
c
242
if ( field .eq. 'integer' ) then
243
do 60 i=1,nnzreq
244
read (iunit,fmt=*,end=4000) ival(i)
245
60 continue
246
elseif ( field .eq. 'real' ) then
247
do 65 i=1,nnzreq
248
read (iunit,fmt=*,end=4000) rval(i)
249
65 continue
250
elseif ( field .eq. 'complex' ) then
251
do 70 i=1,nnzreq
252
read (iunit,fmt=*,end=4000) rpart,ipart
253
cval(i) = cmplx(rpart,ipart)
254
70 continue
255
else
256
print *,'''pattern'' data not consistant with type ''array'''
257
stop
258
endif
259
rewind(iunit)
260
return
261
else
262
print *,'''',rep,''' representation not recognized.'
263
print *, 'Recognized representations:'
264
print *, ' array'
265
print *, ' coordinate'
266
stop
267
endif
268
c
269
c Various error conditions:
270
c
271
1000 print *,'Premature end-of-file.'
272
print *,'No lines found.'
273
stop
274
2000 print *,'Premature end-of-file.'
275
print *,'No data lines found.'
276
stop
277
3000 print *,'Size info inconsistant with representation.'
278
print *,'Array matrices need exactly 2 size descriptors.'
279
print *, count,' were found.'
280
stop
281
3500 print *,'Size info inconsistant with representation.'
282
print *,'Coordinate matrices need exactly 3 size descriptors.'
283
print *, count,' were found.'
284
stop
285
4000 print *,'Premature end-of-file.'
286
print *,'Check that the data file contains ',nnz,
287
* ' lines of i,j,[val] data.'
288
print *,'(it appears there are only ',i,' such lines.)'
289
stop
290
5000 print *,'Invalid matrix header: ',tmp1
291
print *,'Correct header format:'
292
print *,'%%MatrixMarket type representation field symmetry'
293
print *
294
print *,'Check specification and try again.'
295
6000 print *,'''',rep,''' representation not recognized.'
296
print *, 'Recognized representations:'
297
print *, ' array'
298
print *, ' coordinate'
299
stop
300
7000 print *,'''',field,''' field is not recognized.'
301
print *, 'Recognized fields:'
302
print *, ' real'
303
print *, ' complex'
304
print *, ' integer'
305
print *, ' pattern'
306
stop
307
8000 print *,'''',field,''' arrays are not recognized.'
308
print *, 'Recognized fields:'
309
print *, ' real'
310
print *, ' complex'
311
print *, ' integer'
312
stop
313
9000 print *,'''',symm,''' symmetry is not recognized.'
314
print *, 'Recognized symmetries:'
315
print *, ' general'
316
print *, ' symmetric'
317
print *, ' hermitian'
318
print *, ' skew-symmetric'
319
stop
320
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
321
end
322
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
323
c End of subroutine mmread
324
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
325
326
subroutine mminfo(iunit,rep,field,symm,rows,cols,nnz)
327
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
328
c
329
c This routine will read header information from a Matrix Market
330
c formatted file.
331
c
332
c The unit iunit must be open, and the file will be rewound on return.
333
c
334
c 20-Sept-96 Karin A. Remington, NIST ACMD (karin@cam.nist.gov)
335
c 18-Oct-96 Change in routine name to match C and Matlab routines.
336
c 30-Oct-96 Bug fixes in mmio.f:
337
c -looping for comment lines
338
c -fixed non-ansi zero stringlength
339
c -incorrect size calculation for skew-symmetric arrays
340
c Other changes in mmio.f:
341
c -added integer value parameter to calling sequences
342
c -enforced proper count in size info line
343
c -added routine to count words in string (countwd)
344
c (Thanks to G.P.Leendetse and H.Oudshoom for their review
345
c of the initial version and suggested fixes.)
346
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
347
c
348
c Arguments:
349
c
350
c name type in/out description
351
c ---------------------------------------------------------------
352
c
353
c iunit integer in Unit identifier for the open file
354
c containing the data to be read.
355
c
356
c rep character*10 out Matrix Market 'representation'
357
c indicator. On return:
358
c
359
c coordinate (for sparse data)
360
c array (for dense data)
361
c elemental (to be added)
362
c
363
c field character*7 out Matrix Market 'field'. On return:
364
c
365
c real
366
c complex
367
c integer
368
c pattern
369
c
370
c symm character*19 out Matrix Market 'field'. On return:
371
c
372
c symmetric
373
c hermitian
374
c skew-symmetric
375
c general
376
c
377
c rows integer out Number of rows in matrix.
378
c
379
c cols integer out Number of columns in matrix.
380
c
381
c nnz integer out Number of nonzero entries required to store
382
c the matrix.
383
c
384
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
385
c
386
c Declarations:
387
c
388
integer i, rows, cols, nnz, iunit
389
integer count
390
character mmhead*14
391
character mmtype*6
392
character rep*10
393
character field*7
394
character symm*19
395
character tmp1*1024
396
character tmp2*2
397
c
398
c Read header line and check validity:
399
c
400
read (iunit,end=1000,fmt=5) tmp1
401
5 format(1024A)
402
c
403
c Parse words from header line:
404
c
405
call getwd(mmhead,tmp1,1024,1,next,count)
406
if ( count .eq. 0 ) go to 5000
407
call getwd(mmtype,tmp1,1024,next,next,count)
408
if ( count .eq. 0 ) go to 5000
409
call getwd(rep,tmp1,1024,next,next,count)
410
if ( count .eq. 0 ) go to 5000
411
call getwd(field,tmp1,1024,next,next,count)
412
if ( count .eq. 0 ) go to 5000
413
call getwd(symm,tmp1,1024,next,next,count)
414
if ( count .eq. 0 ) go to 5000
415
if ( mmhead .ne. '%%MatrixMarket' ) go to 5000
416
c
417
c Convert type code to upper case for easier comparisons:
418
c
419
call lowerc(mmtype,1,6)
420
if ( mmtype .ne. 'matrix' ) then
421
print *,'Invalid matrix type: ',mmtype
422
print *,'This reader only understands type ''matrix''.'
423
stop
424
else
425
call lowerc(rep,1,10)
426
call lowerc(field,1,7)
427
call lowerc(symm,1,19)
428
endif
429
c
430
c Test input qualifiers:
431
c
432
if (rep .ne. 'coordinate' .and. rep .ne. 'array' )
433
* go to 6000
434
if (rep .eq. 'coordinate' .and. field .ne. 'integer' .and.
435
* field .ne. 'real' .and. field .ne. 'complex' .and.
436
* field .ne. 'pattern') go to 7000
437
if (rep .eq. 'array' .and. field .ne. 'integer' .and.
438
* field .ne. 'real' .and. field .ne. 'complex' ) go to 8000
439
if (symm .ne. 'general' .and. symm .ne. 'symmetric' .and.
440
* symm .ne. 'hermitian' .and. symm .ne. 'skew-symmetric')
441
* go to 9000
442
c
443
c Read through comment lines, ignoring content:
444
c
445
read (iunit,end=2000,fmt=200) tmp2
446
200 format(1a)
447
10 continue
448
if ( tmp2(1:1) .ne. '%' ) then
449
go to 20
450
endif
451
read (iunit,end=2000,fmt=200) tmp2
452
go to 10
453
20 continue
454
c
455
c Just read a non-comment.
456
c Now, back up a line, and read for first int, and back up
457
c again. This will set pointer to just before apparent size
458
c info line.
459
c Before continuing with free form input, count the number of
460
c words on the size info line to ensure there is the right amount
461
c of info (2 words for array matrices, 3 for coordinate matrices).
462
c
463
backspace (iunit)
464
read (iunit,end=1000,fmt=5) tmp1
465
call countwd(tmp1,1024,1,count)
466
if ( rep .eq. 'array' .and. count .ne. 2 ) go to 3000
467
if ( rep .eq. 'coordinate' .and. count .ne. 3 ) go to 3500
468
c
469
c Correct number of words are present, now back up and read them.
470
c
471
backspace (iunit)
472
c
473
if ( rep .eq. 'coordinate' ) then
474
c
475
c Read matrix in sparse coordinate format
476
c
477
read (iunit,fmt=*) rows,cols,nnz
478
c
479
c Rewind before returning
480
c
481
rewind(iunit)
482
return
483
c
484
elseif ( rep .eq. 'array' ) then
485
c
486
c Read matrix in dense column-oriented array format
487
c
488
read (iunit,fmt=*) rows,cols
489
if ( symm .eq. 'symmetric' .or. symm .eq. 'hermitian' ) then
490
nnz = (rows*cols - rows)/2 + rows
491
elseif ( symm .eq. 'skew-symmetric' ) then
492
nnz = (rows*cols - rows)/2
493
else
494
nnz = rows*cols
495
endif
496
c
497
c Rewind before returning
498
c
499
rewind(iunit)
500
return
501
else
502
print *,'''',rep,''' representation not recognized.'
503
print *, 'Recognized representations:'
504
print *, ' array'
505
print *, ' coordinate'
506
stop
507
endif
508
c
509
c Various error conditions:
510
c
511
1000 print *,'Premature end-of-file.'
512
print *,'No lines found.'
513
stop
514
2000 print *,'Premature end-of-file.'
515
print *,'No data found.'
516
stop
517
3000 print *,'Size info inconsistant with representation.'
518
print *,'Array matrices need exactly 2 size descriptors.'
519
print *, count,' were found.'
520
stop
521
3500 print *,'Size info inconsistant with representation.'
522
print *,'Coordinate matrices need exactly 3 size descriptors.'
523
print *, count,' were found.'
524
stop
525
5000 print *,'Invalid matrix header: ',tmp1
526
print *,'Correct header format:'
527
print *,'%%MatrixMarket type representation field symmetry'
528
print *
529
print *,'Check specification and try again.'
530
stop
531
6000 print *,'''',rep,''' representation not recognized.'
532
print *, 'Recognized representations:'
533
print *, ' array'
534
print *, ' coordinate'
535
stop
536
7000 print *,'''',field,''' field is not recognized.'
537
print *, 'Recognized fields:'
538
print *, ' real'
539
print *, ' complex'
540
print *, ' integer'
541
print *, ' pattern'
542
stop
543
8000 print *,'''',field,''' arrays are not recognized.'
544
print *, 'Recognized fields:'
545
print *, ' real'
546
print *, ' complex'
547
print *, ' integer'
548
stop
549
9000 print *,'''',symm,''' symmetry is not recognized.'
550
print *, 'Recognized symmetries:'
551
print *, ' general'
552
print *, ' symmetric'
553
print *, ' hermitian'
554
print *, ' skew-symmetric'
555
stop
556
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
557
end
558
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
559
c End of subroutine mmread
560
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
561
562
subroutine mmwrite(ounit,rep,field,symm,rows,cols,nnz,
563
* indx,jndx,ival,rval,cval)
564
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
565
c
566
c This routine will write data to a matrix market formatted file.
567
c The data may be either sparse coordinate format, or dense array format.
568
c
569
c The unit ounit must be open.
570
c
571
c 20-Sept-96 Karin A. Remington, NIST ACMD (karin@cam.nist.gov)
572
c 18-Oct-96 Change in routine name to match C and Matlab routines.
573
c 30-Oct-96 Bug fixes in mmio.f:
574
c -looping for comment lines
575
c -fixed non-ansi zero stringlength
576
c -incorrect size calculation for skew-symmetric arrays
577
c Other changes in mmio.f:
578
c -added integer value parameter to calling sequences
579
c -enforced proper count in size info line
580
c -added routine to count words in string (countwd)
581
c (Thanks to G.P.Leendetse and H.Oudshoom for their review
582
c of the initial version and suggested fixes.)
583
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
584
c
585
c Arguments:
586
c
587
c name type in/out description
588
c ---------------------------------------------------------------
589
c
590
c ounit integer in Unit identifier for the file
591
c to which the data will be written.
592
c Must be open prior to call.
593
c
594
c rep character* in Matrix Market 'representation'
595
c indicator. Valid inputs:
596
c
597
c coordinate (for sparse data)
598
c array (for dense data)
599
c *elemental* (to be added)
600
c
601
c field character* in Matrix Market 'field'. Valid inputs:
602
c
603
c real
604
c complex
605
c integer
606
c pattern (not valid for dense arrays)
607
c
608
c symm character* in Matrix Market 'field'. Valid inputs:
609
c
610
c symmetric
611
c hermitian
612
c skew-symmetric
613
c general
614
c
615
c rows integer in Number of rows in matrix.
616
c
617
c cols integer in Number of columns in matrix.
618
c
619
c nnz integer in Number of nonzero entries in matrix.
620
c (rows*cols for array matrices)
621
c
622
c indx integer(nnz)in Row indices for coordinate format.
623
c Undefined for array format.
624
c
625
c jndx integer(nnz)in Column indices for coordinate format.
626
c Undefined for array format.
627
c
628
c ival integer(nnz) in Integer data (if applicable, see 'field')
629
c
630
c rval double(nnz) in Real data (if applicable, see 'field')
631
c
632
c cval complex(nnz)in Complex data (if applicable, see 'field')
633
c
634
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
635
c
636
c Declarations:
637
c
638
integer ival(*)
639
double precision rval(*)
640
complex cval(*)
641
integer indx(*)
642
integer jndx(*)
643
integer i, rows, cols, nnz, nnzreq, ounit
644
character*(*)rep,field,symm
645
c
646
c Test input qualifiers:
647
c
648
if (rep .ne. 'coordinate' .and. rep .ne. 'array' )
649
* go to 1000
650
if (rep .eq. 'coordinate' .and. field .ne. 'integer' .and.
651
* field .ne. 'real' .and. field .ne. 'complex' .and.
652
* field .ne. 'pattern') go to 2000
653
if (rep .eq. 'array' .and. field .ne. 'integer' .and.
654
* field .ne. 'real' .and. field .ne. 'complex' ) go to 3000
655
if (symm .ne. 'general' .and. symm .ne. 'symmetric' .and.
656
* symm .ne. 'hermitian' .and. symm .ne. 'skew-symmetric')
657
* go to 4000
658
c
659
c Write header line:
660
c
661
write(unit=ounit,fmt=5)rep,' ',field,' ',symm
662
5 format('%%MatrixMarket matrix ',11A,1A,8A,1A,20A)
663
c
664
c Write size information:
665
c
666
if ( rep .eq. 'coordinate' ) then
667
nnzreq=nnz
668
write(unit=ounit,fmt=*) rows,cols,nnz
669
if ( field .eq. 'integer' ) then
670
do 10 i=1,nnzreq
671
write(unit=ounit,fmt=*)indx(i),jndx(i),ival(i)
672
10 continue
673
elseif ( field .eq. 'real' ) then
674
do 20 i=1,nnzreq
675
write(unit=ounit,fmt=*)indx(i),jndx(i),rval(i)
676
20 continue
677
elseif ( field .eq. 'complex' ) then
678
do 30 i=1,nnzreq
679
write(unit=ounit,fmt=*)indx(i),jndx(i),
680
* real(cval(i)),aimag(cval(i))
681
30 continue
682
else
683
c field .eq. 'pattern'
684
do 40 i=1,nnzreq
685
write(unit=ounit,fmt=*)indx(i),jndx(i)
686
40 continue
687
endif
688
else
689
c rep .eq. 'array'
690
if ( symm .eq. 'general' ) then
691
nnzreq = rows*cols
692
elseif ( symm .eq. 'symmetric' .or.
693
* symm .eq. 'hermitian' ) then
694
nnzreq = (rows*cols - rows)/2 + rows
695
else
696
c symm .eq. 'skew-symmetric'
697
nnzreq = (rows*cols - rows)/2
698
endif
699
write(unit=ounit,fmt=*)rows,cols
700
if ( field .eq. 'integer' ) then
701
do 50 i=1,nnzreq
702
write(unit=ounit,fmt=*)ival(i)
703
50 continue
704
elseif ( field .eq. 'real' ) then
705
do 60 i=1,nnzreq
706
write(unit=ounit,fmt=*)rval(i)
707
60 continue
708
else
709
c field .eq. 'complex'
710
do 70 i=1,nnzreq
711
write(unit=ounit,fmt=*)real(cval(i)),aimag(cval(i))
712
70 continue
713
endif
714
endif
715
return
716
c
717
c Various errors
718
c
719
1000 print *,'''',rep,''' representation not recognized.'
720
print *, 'Recognized representations:'
721
print *, ' array'
722
print *, ' coordinate'
723
stop
724
2000 print *,'''',field,''' field is not recognized.'
725
print *, 'Recognized fields:'
726
print *, ' real'
727
print *, ' complex'
728
print *, ' integer'
729
print *, ' pattern'
730
stop
731
3000 print *,'''',field,''' arrays are not recognized.'
732
print *, 'Recognized fields:'
733
print *, ' real'
734
print *, ' complex'
735
print *, ' integer'
736
stop
737
4000 print *,'''',symm,''' symmetry is not recognized.'
738
print *, 'Recognized symmetries:'
739
print *, ' general'
740
print *, ' symmetric'
741
print *, ' hermitian'
742
print *, ' skew-symmetric'
743
stop
744
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
745
end
746
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
747
c End of subroutine mmwrite
748
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
749
750
subroutine lowerc(string,pos,len)
751
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
752
c Convert uppercase letters to lowercase letters in string with
753
c starting postion pos and length len.
754
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
755
integer pos, len
756
character*(*) string
757
758
character*26 lcase, ucase
759
save lcase,ucase
760
data lcase/'abcdefghijklmnopqrstuvwxyz'/
761
data ucase/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
762
763
do 10 i=pos,len
764
k = index(ucase,string(i:i))
765
if (k.ne.0) string(i:i) = lcase(k:k)
766
10 continue
767
return
768
end
769
770
subroutine getwd(word,string,slen,start,next,wlen)
771
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
772
c Getwd extracts the first word from string starting
773
c at position start. On return, next is the position
774
c of the blank which terminates the word in string.
775
c If the found word is longer than the allocated space
776
c for the word in the calling program, the word will be
777
c truncated to fit.
778
c Count is set to the length of the word found.
779
c
780
c 30-Oct-96 Bug fix: fixed non-ansi zero stringlength
781
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
782
integer slen, start, next, begin, space, wlen
783
character*(*) word
784
character*(*) string
785
786
begin = start
787
do 5 i=start,slen
788
space = index(string(i:slen),' ')
789
if ( space .gt. 1) then
790
next = i+space-1
791
go to 100
792
endif
793
begin=begin+1
794
5 continue
795
100 continue
796
wlen=next-begin
797
if ( wlen .le. 0 ) then
798
wlen = 0
799
word = ' '
800
return
801
endif
802
word=string(begin:begin+wlen)
803
return
804
end
805
806
subroutine countwd(string,slen,start,count)
807
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
808
c Countwd counts the number of words in string starting
809
c at position start. On return, count is the number of words.
810
c 30-Oct-96 Routine added
811
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
812
character*(*) string
813
integer slen, start, next, wordlength, count
814
character tmp2*2
815
816
count = 0
817
next = 1
818
10 call getwd(tmp2,string,1024,next,next,wordlength)
819
if ( wordlength .gt. 0 ) then
820
count = count + 1
821
go to 10
822
endif
823
return
824
end
Loggerhead is a web-based interface for Breezy
Version: 2.0.1