372 SUBROUTINE cdrvsg2stg( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
373 $ NOUNIT, A, LDA, B, LDB, D, D2, Z, LDZ, AB,
374 $ BB, AP, BP, WORK, NWORK, RWORK, LRWORK,
375 $ IWORK, LIWORK, RESULT, INFO )
384 INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
385 $ NSIZES, NTYPES, NWORK
390 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
391 REAL D( * ), D2( * ), RESULT( * ), RWORK( * )
392 COMPLEX A( LDA, * ), AB( LDA, * ), AP( * ),
393 $ b( ldb, * ), bb( ldb, * ), bp( * ), work( * ),
401 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0, ten = 10.0e+0 )
403 parameter( czero = ( 0.0e+0, 0.0e+0 ),
404 $ cone = ( 1.0e+0, 0.0e+0 ) )
406 parameter( maxtyp = 21 )
411 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
412 $ itype, iu, j, jcol, jsize, jtype, ka, ka9, kb,
413 $ kb9, m, mtypes, n, nerrs, nmats, nmax, ntest,
415 REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
416 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU, TEMP1, TEMP2
419 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
420 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
426 EXTERNAL LSAME, SLAMCH, SLARND
435 INTRINSIC abs, real, max, min, sqrt
438 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 6*9 /
439 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
441 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
454 nmax = max( nmax, nn( j ) )
461 IF( nsizes.LT.0 )
THEN
463 ELSE IF( badnn )
THEN
465 ELSE IF( ntypes.LT.0 )
THEN
467 ELSE IF( lda.LE.1 .OR. lda.LT.nmax )
THEN
469 ELSE IF( ldz.LE.1 .OR. ldz.LT.nmax )
THEN
471 ELSE IF( 2*max( nmax, 2 )**2.GT.nwork )
THEN
473 ELSE IF( 2*max( nmax, 2 )**2.GT.lrwork )
THEN
475 ELSE IF( 2*max( nmax, 2 )**2.GT.liwork )
THEN
480 CALL xerbla(
'CDRVSG2STG', -info )
486 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
491 unfl = slamch(
'Safe minimum' )
492 ovfl = slamch(
'Overflow' )
493 ulp = slamch(
'Epsilon' )*slamch(
'Base' )
495 rtunfl = sqrt( unfl )
496 rtovfl = sqrt( ovfl )
499 iseed2( i ) = iseed( i )
507 DO 650 jsize = 1, nsizes
509 aninv = one / real( max( 1, n ) )
511 IF( nsizes.NE.1 )
THEN
512 mtypes = min( maxtyp, ntypes )
514 mtypes = min( maxtyp+1, ntypes )
519 DO 640 jtype = 1, mtypes
520 IF( .NOT.dotype( jtype ) )
526 ioldsd( j ) = iseed( j )
544 IF( mtypes.GT.maxtyp )
547 itype = ktype( jtype )
548 imode = kmode( jtype )
552 GO TO ( 40, 50, 60 )kmagn( jtype )
559 anorm = ( rtovfl*ulp )*aninv
563 anorm = rtunfl*n*ulpinv
573 IF( itype.EQ.1 )
THEN
579 CALL claset(
'Full', lda, n, czero, czero, a, lda )
581 ELSE IF( itype.EQ.2 )
THEN
587 CALL claset(
'Full', lda, n, czero, czero, a, lda )
589 a( jcol, jcol ) = anorm
592 ELSE IF( itype.EQ.4 )
THEN
598 CALL clatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
599 $ anorm, 0, 0,
'N', a, lda, work, iinfo )
601 ELSE IF( itype.EQ.5 )
THEN
607 CALL clatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
608 $ anorm, n, n,
'N', a, lda, work, iinfo )
610 ELSE IF( itype.EQ.7 )
THEN
616 CALL clatmr( n, n,
'S', iseed,
'H', work, 6, one, cone,
617 $
'T',
'N', work( n+1 ), 1, one,
618 $ work( 2*n+1 ), 1, one,
'N', idumma, 0, 0,
619 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
621 ELSE IF( itype.EQ.8 )
THEN
627 CALL clatmr( n, n,
'S', iseed,
'H', work, 6, one, cone,
628 $
'T',
'N', work( n+1 ), 1, one,
629 $ work( 2*n+1 ), 1, one,
'N', idumma, n, n,
630 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
632 ELSE IF( itype.EQ.9 )
THEN
646 IF( kb9.GT.ka9 )
THEN
650 ka = max( 0, min( n-1, ka9 ) )
651 kb = max( 0, min( n-1, kb9 ) )
652 CALL clatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
653 $ anorm, ka, ka,
'N', a, lda, work, iinfo )
660 IF( iinfo.NE.0 )
THEN
661 WRITE( nounit, fmt = 9999 )
'Generator', iinfo, n, jtype,
674 il = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
675 iu = 1 + int( ( n-1 )*slarnd( 1, iseed2 ) )
704 CALL clatms( n, n,
'U', iseed,
'P', rwork, 5, ten,
705 $ one, kb, kb, uplo, b, ldb, work( n+1 ),
712 CALL clacpy(
' ', n, n, a, lda, z, ldz )
713 CALL clacpy( uplo, n, n, b, ldb, bb, ldb )
715 CALL chegv( ibtype,
'V', uplo, n, z, ldz, bb, ldb, d,
716 $ work, nwork, rwork, iinfo )
717 IF( iinfo.NE.0 )
THEN
718 WRITE( nounit, fmt = 9999 )
'CHEGV(V,' // uplo //
719 $
')', iinfo, n, jtype, ioldsd
721 IF( iinfo.LT.0 )
THEN
724 result( ntest ) = ulpinv
731 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
732 $ ldz, d, work, rwork, result( ntest ) )
738 CALL clacpy(
' ', n, n, a, lda, z, ldz )
739 CALL clacpy( uplo, n, n, b, ldb, bb, ldb )
742 $ bb, ldb, d2, work, nwork, rwork,
744 IF( iinfo.NE.0 )
THEN
745 WRITE( nounit, fmt = 9999 )
746 $
'CHEGV_2STAGE(V,' // uplo //
747 $
')', iinfo, n, jtype, ioldsd
749 IF( iinfo.LT.0 )
THEN
752 result( ntest ) = ulpinv
769 temp1 = max( temp1, abs( d( j ) ),
771 temp2 = max( temp2, abs( d( j )-d2( j ) ) )
774 result( ntest ) = temp2 /
775 $ max( unfl, ulp*max( temp1, temp2 ) )
781 CALL clacpy(
' ', n, n, a, lda, z, ldz )
782 CALL clacpy( uplo, n, n, b, ldb, bb, ldb )
784 CALL chegvd( ibtype,
'V', uplo, n, z, ldz, bb, ldb, d,
785 $ work, nwork, rwork, lrwork, iwork,
787 IF( iinfo.NE.0 )
THEN
788 WRITE( nounit, fmt = 9999 )
'CHEGVD(V,' // uplo //
789 $
')', iinfo, n, jtype, ioldsd
791 IF( iinfo.LT.0 )
THEN
794 result( ntest ) = ulpinv
801 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
802 $ ldz, d, work, rwork, result( ntest ) )
808 CALL clacpy(
' ', n, n, a, lda, ab, lda )
809 CALL clacpy( uplo, n, n, b, ldb, bb, ldb )
811 CALL chegvx( ibtype,
'V',
'A', uplo, n, ab, lda, bb,
812 $ ldb, vl, vu, il, iu, abstol, m, d, z,
813 $ ldz, work, nwork, rwork, iwork( n+1 ),
815 IF( iinfo.NE.0 )
THEN
816 WRITE( nounit, fmt = 9999 )
'CHEGVX(V,A' // uplo //
817 $
')', iinfo, n, jtype, ioldsd
819 IF( iinfo.LT.0 )
THEN
822 result( ntest ) = ulpinv
829 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
830 $ ldz, d, work, rwork, result( ntest ) )
834 CALL clacpy(
' ', n, n, a, lda, ab, lda )
835 CALL clacpy( uplo, n, n, b, ldb, bb, ldb )
844 CALL chegvx( ibtype,
'V',
'V', uplo, n, ab, lda, bb,
845 $ ldb, vl, vu, il, iu, abstol, m, d, z,
846 $ ldz, work, nwork, rwork, iwork( n+1 ),
848 IF( iinfo.NE.0 )
THEN
849 WRITE( nounit, fmt = 9999 )
'CHEGVX(V,V,' //
850 $ uplo //
')', iinfo, n, jtype, ioldsd
852 IF( iinfo.LT.0 )
THEN
855 result( ntest ) = ulpinv
862 CALL csgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
863 $ ldz, d, work, rwork, result( ntest ) )
867 CALL clacpy(
' ', n, n, a, lda, ab, lda )
868 CALL clacpy( uplo, n, n, b, ldb, bb, ldb )
870 CALL chegvx( ibtype,
'V',
'I', uplo, n, ab, lda, bb,
871 $ ldb, vl, vu, il, iu, abstol, m, d, z,
872 $ ldz, work, nwork, rwork, iwork( n+1 ),
874 IF( iinfo.NE.0 )
THEN
875 WRITE( nounit, fmt = 9999 )
'CHEGVX(V,I,' //
876 $ uplo //
')', iinfo, n, jtype, ioldsd
878 IF( iinfo.LT.0 )
THEN
881 result( ntest ) = ulpinv
888 CALL csgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
889 $ ldz, d, work, rwork, result( ntest ) )
899 IF( lsame( uplo,
'U' ) )
THEN
919 CALL chpgv( ibtype,
'V', uplo, n, ap, bp, d, z, ldz,
920 $ work, rwork, iinfo )
921 IF( iinfo.NE.0 )
THEN
922 WRITE( nounit, fmt = 9999 )
'CHPGV(V,' // uplo //
923 $
')', iinfo, n, jtype, ioldsd
925 IF( iinfo.LT.0 )
THEN
928 result( ntest ) = ulpinv
935 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
936 $ ldz, d, work, rwork, result( ntest ) )
944 IF( lsame( uplo,
'U' ) )
THEN
964 CALL chpgvd( ibtype,
'V', uplo, n, ap, bp, d, z, ldz,
965 $ work, nwork, rwork, lrwork, iwork,
967 IF( iinfo.NE.0 )
THEN
968 WRITE( nounit, fmt = 9999 )
'CHPGVD(V,' // uplo //
969 $
')', iinfo, n, jtype, ioldsd
971 IF( iinfo.LT.0 )
THEN
974 result( ntest ) = ulpinv
981 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
982 $ ldz, d, work, rwork, result( ntest ) )
990 IF( lsame( uplo,
'U' ) )
THEN
1003 ap( ij ) = a( i, j )
1004 bp( ij ) = b( i, j )
1010 CALL chpgvx( ibtype,
'V',
'A', uplo, n, ap, bp, vl,
1011 $ vu, il, iu, abstol, m, d, z, ldz, work,
1012 $ rwork, iwork( n+1 ), iwork, info )
1013 IF( iinfo.NE.0 )
THEN
1014 WRITE( nounit, fmt = 9999 )
'CHPGVX(V,A' // uplo //
1015 $
')', iinfo, n, jtype, ioldsd
1017 IF( iinfo.LT.0 )
THEN
1020 result( ntest ) = ulpinv
1027 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1028 $ ldz, d, work, rwork, result( ntest ) )
1034 IF( lsame( uplo,
'U' ) )
THEN
1038 ap( ij ) = a( i, j )
1039 bp( ij ) = b( i, j )
1047 ap( ij ) = a( i, j )
1048 bp( ij ) = b( i, j )
1056 CALL chpgvx( ibtype,
'V',
'V', uplo, n, ap, bp, vl,
1057 $ vu, il, iu, abstol, m, d, z, ldz, work,
1058 $ rwork, iwork( n+1 ), iwork, info )
1059 IF( iinfo.NE.0 )
THEN
1060 WRITE( nounit, fmt = 9999 )
'CHPGVX(V,V' // uplo //
1061 $
')', iinfo, n, jtype, ioldsd
1063 IF( iinfo.LT.0 )
THEN
1066 result( ntest ) = ulpinv
1073 CALL csgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1074 $ ldz, d, work, rwork, result( ntest ) )
1080 IF( lsame( uplo,
'U' ) )
THEN
1084 ap( ij ) = a( i, j )
1085 bp( ij ) = b( i, j )
1093 ap( ij ) = a( i, j )
1094 bp( ij ) = b( i, j )
1100 CALL chpgvx( ibtype,
'V',
'I', uplo, n, ap, bp, vl,
1101 $ vu, il, iu, abstol, m, d, z, ldz, work,
1102 $ rwork, iwork( n+1 ), iwork, info )
1103 IF( iinfo.NE.0 )
THEN
1104 WRITE( nounit, fmt = 9999 )
'CHPGVX(V,I' // uplo //
1105 $
')', iinfo, n, jtype, ioldsd
1107 IF( iinfo.LT.0 )
THEN
1110 result( ntest ) = ulpinv
1117 CALL csgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1118 $ ldz, d, work, rwork, result( ntest ) )
1122 IF( ibtype.EQ.1 )
THEN
1130 IF( lsame( uplo,
'U' ) )
THEN
1132 DO 320 i = max( 1, j-ka ), j
1133 ab( ka+1+i-j, j ) = a( i, j )
1135 DO 330 i = max( 1, j-kb ), j
1136 bb( kb+1+i-j, j ) = b( i, j )
1141 DO 350 i = j, min( n, j+ka )
1142 ab( 1+i-j, j ) = a( i, j )
1144 DO 360 i = j, min( n, j+kb )
1145 bb( 1+i-j, j ) = b( i, j )
1150 CALL chbgv(
'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1151 $ d, z, ldz, work, rwork, iinfo )
1152 IF( iinfo.NE.0 )
THEN
1153 WRITE( nounit, fmt = 9999 )
'CHBGV(V,' //
1154 $ uplo //
')', iinfo, n, jtype, ioldsd
1156 IF( iinfo.LT.0 )
THEN
1159 result( ntest ) = ulpinv
1166 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1167 $ ldz, d, work, rwork, result( ntest ) )
1175 IF( lsame( uplo,
'U' ) )
THEN
1177 DO 380 i = max( 1, j-ka ), j
1178 ab( ka+1+i-j, j ) = a( i, j )
1180 DO 390 i = max( 1, j-kb ), j
1181 bb( kb+1+i-j, j ) = b( i, j )
1186 DO 410 i = j, min( n, j+ka )
1187 ab( 1+i-j, j ) = a( i, j )
1189 DO 420 i = j, min( n, j+kb )
1190 bb( 1+i-j, j ) = b( i, j )
1195 CALL chbgvd(
'V', uplo, n, ka, kb, ab, lda, bb,
1196 $ ldb, d, z, ldz, work, nwork, rwork,
1197 $ lrwork, iwork, liwork, iinfo )
1198 IF( iinfo.NE.0 )
THEN
1199 WRITE( nounit, fmt = 9999 )
'CHBGVD(V,' //
1200 $ uplo //
')', iinfo, n, jtype, ioldsd
1202 IF( iinfo.LT.0 )
THEN
1205 result( ntest ) = ulpinv
1212 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1213 $ ldz, d, work, rwork, result( ntest ) )
1221 IF( lsame( uplo,
'U' ) )
THEN
1223 DO 440 i = max( 1, j-ka ), j
1224 ab( ka+1+i-j, j ) = a( i, j )
1226 DO 450 i = max( 1, j-kb ), j
1227 bb( kb+1+i-j, j ) = b( i, j )
1232 DO 470 i = j, min( n, j+ka )
1233 ab( 1+i-j, j ) = a( i, j )
1235 DO 480 i = j, min( n, j+kb )
1236 bb( 1+i-j, j ) = b( i, j )
1241 CALL chbgvx(
'V',
'A', uplo, n, ka, kb, ab, lda,
1242 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1243 $ iu, abstol, m, d, z, ldz, work, rwork,
1244 $ iwork( n+1 ), iwork, iinfo )
1245 IF( iinfo.NE.0 )
THEN
1246 WRITE( nounit, fmt = 9999 )
'CHBGVX(V,A' //
1247 $ uplo //
')', iinfo, n, jtype, ioldsd
1249 IF( iinfo.LT.0 )
THEN
1252 result( ntest ) = ulpinv
1259 CALL csgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1260 $ ldz, d, work, rwork, result( ntest ) )
1266 IF( lsame( uplo,
'U' ) )
THEN
1268 DO 500 i = max( 1, j-ka ), j
1269 ab( ka+1+i-j, j ) = a( i, j )
1271 DO 510 i = max( 1, j-kb ), j
1272 bb( kb+1+i-j, j ) = b( i, j )
1277 DO 530 i = j, min( n, j+ka )
1278 ab( 1+i-j, j ) = a( i, j )
1280 DO 540 i = j, min( n, j+kb )
1281 bb( 1+i-j, j ) = b( i, j )
1288 CALL chbgvx(
'V',
'V', uplo, n, ka, kb, ab, lda,
1289 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1290 $ iu, abstol, m, d, z, ldz, work, rwork,
1291 $ iwork( n+1 ), iwork, iinfo )
1292 IF( iinfo.NE.0 )
THEN
1293 WRITE( nounit, fmt = 9999 )
'CHBGVX(V,V' //
1294 $ uplo //
')', iinfo, n, jtype, ioldsd
1296 IF( iinfo.LT.0 )
THEN
1299 result( ntest ) = ulpinv
1306 CALL csgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1307 $ ldz, d, work, rwork, result( ntest ) )
1313 IF( lsame( uplo,
'U' ) )
THEN
1315 DO 560 i = max( 1, j-ka ), j
1316 ab( ka+1+i-j, j ) = a( i, j )
1318 DO 570 i = max( 1, j-kb ), j
1319 bb( kb+1+i-j, j ) = b( i, j )
1324 DO 590 i = j, min( n, j+ka )
1325 ab( 1+i-j, j ) = a( i, j )
1327 DO 600 i = j, min( n, j+kb )
1328 bb( 1+i-j, j ) = b( i, j )
1333 CALL chbgvx(
'V',
'I', uplo, n, ka, kb, ab, lda,
1334 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1335 $ iu, abstol, m, d, z, ldz, work, rwork,
1336 $ iwork( n+1 ), iwork, iinfo )
1337 IF( iinfo.NE.0 )
THEN
1338 WRITE( nounit, fmt = 9999 )
'CHBGVX(V,I' //
1339 $ uplo //
')', iinfo, n, jtype, ioldsd
1341 IF( iinfo.LT.0 )
THEN
1344 result( ntest ) = ulpinv
1351 CALL csgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1352 $ ldz, d, work, rwork, result( ntest ) )
1361 ntestt = ntestt + ntest
1362 CALL slafts(
'CSG', n, n, jtype, ntest, result, ioldsd,
1363 $ thresh, nounit, nerrs )
1369 CALL slasum(
'CSG', nounit, nerrs, ntestt )
1373 9999
FORMAT(
' CDRVSG2STG: ', a,
' returned INFO=', i6,
'.', / 9x,
1374 $
'N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine xerbla(srname, info)
subroutine cdrvsg2stg(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, ldb, d, d2, z, ldz, ab, bb, ap, bp, work, nwork, rwork, lrwork, iwork, liwork, result, info)
CDRVSG2STG
subroutine clatmr(m, n, dist, iseed, sym, d, mode, cond, dmax, rsign, grade, dl, model, condl, dr, moder, condr, pivtng, ipivot, kl, ku, sparse, anorm, pack, a, lda, iwork, info)
CLATMR
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine csgt01(itype, uplo, n, m, a, lda, b, ldb, z, ldz, d, work, rwork, result)
CSGT01
subroutine chbgv(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, rwork, info)
CHBGV
subroutine chbgvd(jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHBGVD
subroutine chbgvx(jobz, range, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail, info)
CHBGVX
subroutine chegv_2stage(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, info)
CHEGV_2STAGE
subroutine chegv(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, info)
CHEGV
subroutine chegvd(itype, jobz, uplo, n, a, lda, b, ldb, w, work, lwork, rwork, lrwork, iwork, liwork, info)
CHEGVD
subroutine chegvx(itype, jobz, range, uplo, n, a, lda, b, ldb, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
CHEGVX
subroutine chpgv(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, rwork, info)
CHPGV
subroutine chpgvd(itype, jobz, uplo, n, ap, bp, w, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
CHPGVD
subroutine chpgvx(itype, jobz, range, uplo, n, ap, bp, vl, vu, il, iu, abstol, m, w, z, ldz, work, rwork, iwork, ifail, info)
CHPGVX
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine slafts(type, m, n, imat, ntests, result, iseed, thresh, iounit, ie)
SLAFTS
subroutine slasum(type, iounit, ie, nrun)
SLASUM