OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
psblas2tim.f File Reference

Go to the source code of this file.

Functions/Subroutines

program psbla2tim
subroutine psbla2timinfo (summry, nout, nmat, diagval, tranval, uploval, mval, nval, maval, naval, imbaval, mbaval, inbaval, nbaval, rscaval, cscaval, iaval, javal, mxval, nxval, imbxval, mbxval, inbxval, nbxval, rscxval, cscxval, ixval, jxval, incxval, myval, nyval, imbyval, mbyval, inbyval, nbyval, rscyval, cscyval, iyval, jyval, incyval, ldval, ngrids, pval, ldpval, qval, ldqval, nblog, ltest, iam, nprocs, alpha, beta, work)

Function/Subroutine Documentation

◆ psbla2tim()

program psbla2tim

Definition at line 11 of file psblas2tim.f.

◆ psbla2timinfo()

subroutine psbla2timinfo ( character*( * ) summry,
integer nout,
integer nmat,
character*1, dimension( ldval ) diagval,
character*1, dimension( ldval ) tranval,
character*1, dimension( ldval ) uploval,
integer, dimension( ldval ) mval,
integer, dimension( ldval ) nval,
integer, dimension( ldval ) maval,
integer, dimension( ldval ) naval,
integer, dimension( ldval ) imbaval,
integer, dimension( ldval ) mbaval,
integer, dimension( ldval ) inbaval,
integer, dimension( ldval ) nbaval,
integer, dimension( ldval ) rscaval,
integer, dimension( ldval ) cscaval,
integer, dimension( ldval ) iaval,
integer, dimension( ldval ) javal,
integer, dimension( ldval ) mxval,
integer, dimension( ldval ) nxval,
integer, dimension( ldval ) imbxval,
integer, dimension( ldval ) mbxval,
integer, dimension( ldval ) inbxval,
integer, dimension( ldval ) nbxval,
integer, dimension( ldval ) rscxval,
integer, dimension( ldval ) cscxval,
integer, dimension( ldval ) ixval,
integer, dimension( ldval ) jxval,
integer, dimension( ldval ) incxval,
integer, dimension( ldval ) myval,
integer, dimension( ldval ) nyval,
integer, dimension( ldval ) imbyval,
integer, dimension( ldval ) mbyval,
integer, dimension( ldval ) inbyval,
integer, dimension( ldval ) nbyval,
integer, dimension( ldval ) rscyval,
integer, dimension( ldval ) cscyval,
integer, dimension( ldval ) iyval,
integer, dimension( ldval ) jyval,
integer, dimension( ldval ) incyval,
integer ldval,
integer ngrids,
integer, dimension( ldpval ) pval,
integer ldpval,
integer, dimension( ldqval ) qval,
integer ldqval,
integer nblog,
logical, dimension( * ) ltest,
integer iam,
integer nprocs,
real alpha,
real beta,
integer, dimension( * ) work )

Definition at line 691 of file psblas2tim.f.

703*
704* -- PBLAS test routine (version 2.0) --
705* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
706* and University of California, Berkeley.
707* April 1, 1998
708*
709* .. Scalar Arguments ..
710 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NBLOG, NGRIDS,
711 $ NMAT, NOUT, NPROCS
712 REAL ALPHA, BETA
713* ..
714* .. Array Arguments ..
715 CHARACTER*( * ) SUMMRY
716 CHARACTER*1 DIAGVAL( LDVAL ), TRANVAL( LDVAL ),
717 $ UPLOVAL( LDVAL )
718 LOGICAL LTEST( * )
719 INTEGER CSCAVAL( LDVAL ), CSCXVAL( LDVAL ),
720 $ CSCYVAL( LDVAL ), IAVAL( LDVAL ),
721 $ IMBAVAL( LDVAL ), IMBXVAL( LDVAL ),
722 $ IMBYVAL( LDVAL ), INBAVAL( LDVAL ),
723 $ INBXVAL( LDVAL ), INBYVAL( LDVAL ),
724 $ INCXVAL( LDVAL ), INCYVAL( LDVAL ),
725 $ IXVAL( LDVAL ), IYVAL( LDVAL ), JAVAL( LDVAL ),
726 $ JXVAL( LDVAL ), JYVAL( LDVAL ), MAVAL( LDVAL ),
727 $ MBAVAL( LDVAL ), MBXVAL( LDVAL ),
728 $ MBYVAL( LDVAL ), MVAL( LDVAL ), MXVAL( LDVAL ),
729 $ MYVAL( LDVAL ), NAVAL( LDVAL ),
730 $ NBAVAL( LDVAL ), NBXVAL( LDVAL ),
731 $ NBYVAL( LDVAL ), NVAL( LDVAL ), NXVAL( LDVAL ),
732 $ NYVAL( LDVAL ), PVAL( LDPVAL ), QVAL( LDQVAL ),
733 $ RSCAVAL( LDVAL ), RSCXVAL( LDVAL ),
734 $ RSCYVAL( LDVAL ), WORK( * )
735* ..
736*
737* Purpose
738* =======
739*
740* PSBLA2TIMINFO get the needed startup information for timing various
741* Level 2 PBLAS routines, and transmits it to all processes.
742*
743* Notes
744* =====
745*
746* For packing the information we assumed that the length in bytes of an
747* integer is equal to the length in bytes of a real single precision.
748*
749* Arguments
750* =========
751*
752* SUMMRY (global output) CHARACTER*(*)
753* On exit, SUMMRY is the name of output (summary) file (if
754* any). SUMMRY is only defined for process 0.
755*
756* NOUT (global output) INTEGER
757* On exit, NOUT specifies the unit number for the output file.
758* When NOUT is 6, output to screen, when NOUT is 0, output to
759* stderr. NOUT is only defined for process 0.
760*
761* NMAT (global output) INTEGER
762* On exit, NMAT specifies the number of different test cases.
763*
764* DIAGVAL (global output) CHARACTER array
765* On entry, DIAGVAL is an array of dimension LDVAL. On exit,
766* this array contains the values of DIAG to run the code with.
767*
768* TRANVAL (global output) CHARACTER array
769* On entry, TRANVAL is an array of dimension LDVAL. On exit,
770* this array contains the values of TRANS to run the code
771* with.
772*
773* UPLOVAL (global output) CHARACTER array
774* On entry, UPLOVAL is an array of dimension LDVAL. On exit,
775* this array contains the values of UPLO to run the code with.
776*
777* MVAL (global output) INTEGER array
778* On entry, MVAL is an array of dimension LDVAL. On exit, this
779* array contains the values of M to run the code with.
780*
781* NVAL (global output) INTEGER array
782* On entry, NVAL is an array of dimension LDVAL. On exit, this
783* array contains the values of N to run the code with.
784*
785* MAVAL (global output) INTEGER array
786* On entry, MAVAL is an array of dimension LDVAL. On exit, this
787* array contains the values of DESCA( M_ ) to run the code
788* with.
789*
790* NAVAL (global output) INTEGER array
791* On entry, NAVAL is an array of dimension LDVAL. On exit, this
792* array contains the values of DESCA( N_ ) to run the code
793* with.
794*
795* IMBAVAL (global output) INTEGER array
796* On entry, IMBAVAL is an array of dimension LDVAL. On exit,
797* this array contains the values of DESCA( IMB_ ) to run the
798* code with.
799*
800* MBAVAL (global output) INTEGER array
801* On entry, MBAVAL is an array of dimension LDVAL. On exit,
802* this array contains the values of DESCA( MB_ ) to run the
803* code with.
804*
805* INBAVAL (global output) INTEGER array
806* On entry, INBAVAL is an array of dimension LDVAL. On exit,
807* this array contains the values of DESCA( INB_ ) to run the
808* code with.
809*
810* NBAVAL (global output) INTEGER array
811* On entry, NBAVAL is an array of dimension LDVAL. On exit,
812* this array contains the values of DESCA( NB_ ) to run the
813* code with.
814*
815* RSCAVAL (global output) INTEGER array
816* On entry, RSCAVAL is an array of dimension LDVAL. On exit,
817* this array contains the values of DESCA( RSRC_ ) to run the
818* code with.
819*
820* CSCAVAL (global output) INTEGER array
821* On entry, CSCAVAL is an array of dimension LDVAL. On exit,
822* this array contains the values of DESCA( CSRC_ ) to run the
823* code with.
824*
825* IAVAL (global output) INTEGER array
826* On entry, IAVAL is an array of dimension LDVAL. On exit, this
827* array contains the values of IA to run the code with.
828*
829* JAVAL (global output) INTEGER array
830* On entry, JAVAL is an array of dimension LDVAL. On exit, this
831* array contains the values of JA to run the code with.
832*
833* MXVAL (global output) INTEGER array
834* On entry, MXVAL is an array of dimension LDVAL. On exit, this
835* array contains the values of DESCX( M_ ) to run the code
836* with.
837*
838* NXVAL (global output) INTEGER array
839* On entry, NXVAL is an array of dimension LDVAL. On exit, this
840* array contains the values of DESCX( N_ ) to run the code
841* with.
842*
843* IMBXVAL (global output) INTEGER array
844* On entry, IMBXVAL is an array of dimension LDVAL. On exit,
845* this array contains the values of DESCX( IMB_ ) to run the
846* code with.
847*
848* MBXVAL (global output) INTEGER array
849* On entry, MBXVAL is an array of dimension LDVAL. On exit,
850* this array contains the values of DESCX( MB_ ) to run the
851* code with.
852*
853* INBXVAL (global output) INTEGER array
854* On entry, INBXVAL is an array of dimension LDVAL. On exit,
855* this array contains the values of DESCX( INB_ ) to run the
856* code with.
857*
858* NBXVAL (global output) INTEGER array
859* On entry, NBXVAL is an array of dimension LDVAL. On exit,
860* this array contains the values of DESCX( NB_ ) to run the
861* code with.
862*
863* RSCXVAL (global output) INTEGER array
864* On entry, RSCXVAL is an array of dimension LDVAL. On exit,
865* this array contains the values of DESCX( RSRC_ ) to run the
866* code with.
867*
868* CSCXVAL (global output) INTEGER array
869* On entry, CSCXVAL is an array of dimension LDVAL. On exit,
870* this array contains the values of DESCX( CSRC_ ) to run the
871* code with.
872*
873* IXVAL (global output) INTEGER array
874* On entry, IXVAL is an array of dimension LDVAL. On exit, this
875* array contains the values of IX to run the code with.
876*
877* JXVAL (global output) INTEGER array
878* On entry, JXVAL is an array of dimension LDVAL. On exit, this
879* array contains the values of JX to run the code with.
880*
881* INCXVAL (global output) INTEGER array
882* On entry, INCXVAL is an array of dimension LDVAL. On exit,
883* this array contains the values of INCX to run the code with.
884*
885* MYVAL (global output) INTEGER array
886* On entry, MYVAL is an array of dimension LDVAL. On exit, this
887* array contains the values of DESCY( M_ ) to run the code
888* with.
889*
890* NYVAL (global output) INTEGER array
891* On entry, NYVAL is an array of dimension LDVAL. On exit, this
892* array contains the values of DESCY( N_ ) to run the code
893* with.
894*
895* IMBYVAL (global output) INTEGER array
896* On entry, IMBYVAL is an array of dimension LDVAL. On exit,
897* this array contains the values of DESCY( IMB_ ) to run the
898* code with.
899*
900* MBYVAL (global output) INTEGER array
901* On entry, MBYVAL is an array of dimension LDVAL. On exit,
902* this array contains the values of DESCY( MB_ ) to run the
903* code with.
904*
905* INBYVAL (global output) INTEGER array
906* On entry, INBYVAL is an array of dimension LDVAL. On exit,
907* this array contains the values of DESCY( INB_ ) to run the
908* code with.
909*
910* NBYVAL (global output) INTEGER array
911* On entry, NBYVAL is an array of dimension LDVAL. On exit,
912* this array contains the values of DESCY( NB_ ) to run the
913* code with.
914*
915* RSCYVAL (global output) INTEGER array
916* On entry, RSCYVAL is an array of dimension LDVAL. On exit,
917* this array contains the values of DESCY( RSRC_ ) to run the
918* code with.
919*
920* CSCYVAL (global output) INTEGER array
921* On entry, CSCYVAL is an array of dimension LDVAL. On exit,
922* this array contains the values of DESCY( CSRC_ ) to run the
923* code with.
924*
925* IYVAL (global output) INTEGER array
926* On entry, IYVAL is an array of dimension LDVAL. On exit, this
927* array contains the values of IY to run the code with.
928*
929* JYVAL (global output) INTEGER array
930* On entry, JYVAL is an array of dimension LDVAL. On exit, this
931* array contains the values of JY to run the code with.
932*
933* INCYVAL (global output) INTEGER array
934* On entry, INCYVAL is an array of dimension LDVAL. On exit,
935* this array contains the values of INCY to run the code with.
936*
937* LDVAL (global input) INTEGER
938* On entry, LDVAL specifies the maximum number of different va-
939* lues that can be used for DIAG, TRANS, UPLO, M, N, DESCA(:),
940* IA, JA, DESCX(:), IX, JX, INCX, DESCY(:), IY, JY and INCY.
941* This is also the maximum number of test cases.
942*
943* NGRIDS (global output) INTEGER
944* On exit, NGRIDS specifies the number of different values that
945* can be used for P and Q.
946*
947* PVAL (global output) INTEGER array
948* On entry, PVAL is an array of dimension LDPVAL. On exit, this
949* array contains the values of P to run the code with.
950*
951* LDPVAL (global input) INTEGER
952* On entry, LDPVAL specifies the maximum number of different
953* values that can be used for P.
954*
955* QVAL (global output) INTEGER array
956* On entry, QVAL is an array of dimension LDQVAL. On exit, this
957* array contains the values of Q to run the code with.
958*
959* LDQVAL (global input) INTEGER
960* On entry, LDQVAL specifies the maximum number of different
961* values that can be used for Q.
962*
963* NBLOG (global output) INTEGER
964* On exit, NBLOG specifies the logical computational block size
965* to run the tests with. NBLOG must be at least one.
966*
967* LTEST (global output) LOGICAL array
968* On entry, LTEST is an array of dimension at least seven. On
969* exit, if LTEST( i ) is .TRUE., the i-th Level 2 PBLAS routine
970* will be tested. See the input file for the ordering of the
971* routines.
972*
973* IAM (local input) INTEGER
974* On entry, IAM specifies the number of the process executing
975* this routine.
976*
977* NPROCS (global input) INTEGER
978* On entry, NPROCS specifies the total number of processes.
979*
980* ALPHA (global output) REAL
981* On exit, ALPHA specifies the value of alpha to be used in all
982* the test cases.
983*
984* BETA (global output) REAL
985* On exit, BETA specifies the value of beta to be used in all
986* the test cases.
987*
988* WORK (local workspace) INTEGER array
989* On entry, WORK is an array of dimension at least
990* MAX( 3, 2*NGRIDS+37*NMAT+NSUBS ) with NSUBS = 7. This array
991* is used to pack all output arrays in order to send info in
992* one message.
993*
994* -- Written on April 1, 1998 by
995* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
996*
997* =====================================================================
998*
999* .. Parameters ..
1000 INTEGER NIN, NSUBS
1001 parameter( nin = 11, nsubs = 7 )
1002* ..
1003* .. Local Scalars ..
1004 LOGICAL LTESTT
1005 INTEGER I, ICTXT, J
1006* ..
1007* .. Local Arrays ..
1008 CHARACTER*7 SNAMET
1009 CHARACTER*79 USRINFO
1010* ..
1011* .. External Subroutines ..
1012 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
1013 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
1014 $ igebs2d, sgebr2d, sgebs2d
1015* ..
1016* .. Intrinsic Functions ..
1017 INTRINSIC char, ichar, max, min
1018* ..
1019* .. Common Blocks ..
1020 CHARACTER*7 SNAMES( NSUBS )
1021 COMMON /snamec/snames
1022* ..
1023* .. Executable Statements ..
1024*
1025* Process 0 reads the input data, broadcasts to other processes and
1026* writes needed information to NOUT
1027*
1028 IF( iam.EQ.0 ) THEN
1029*
1030* Open file and skip data file header
1031*
1032 OPEN( nin, file='PSBLAS2TIM.dat', status='OLD' )
1033 READ( nin, fmt = * ) summry
1034 summry = ' '
1035*
1036* Read in user-supplied info about machine type, compiler, etc.
1037*
1038 READ( nin, fmt = 9999 ) usrinfo
1039*
1040* Read name and unit number for summary output file
1041*
1042 READ( nin, fmt = * ) summry
1043 READ( nin, fmt = * ) nout
1044 IF( nout.NE.0 .AND. nout.NE.6 )
1045 $ OPEN( nout, file = summry, status = 'UNKNOWN' )
1046*
1047* Read and check the parameter values for the tests.
1048*
1049* Get logical computational block size
1050*
1051 READ( nin, fmt = * ) nblog
1052 IF( nblog.LT.1 )
1053 $ nblog = 32
1054*
1055* Get number of grids
1056*
1057 READ( nin, fmt = * ) ngrids
1058 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
1059 WRITE( nout, fmt = 9998 ) 'Grids', ldpval
1060 GO TO 120
1061 ELSE IF( ngrids.GT.ldqval ) THEN
1062 WRITE( nout, fmt = 9998 ) 'Grids', ldqval
1063 GO TO 120
1064 END IF
1065*
1066* Get values of P and Q
1067*
1068 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
1069 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
1070*
1071* Read ALPHA, BETA
1072*
1073 READ( nin, fmt = * ) alpha
1074 READ( nin, fmt = * ) beta
1075*
1076* Read number of tests.
1077*
1078 READ( nin, fmt = * ) nmat
1079 IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
1080 WRITE( nout, fmt = 9998 ) 'Tests', ldval
1081 GO TO 120
1082 END IF
1083*
1084* Read in input data into arrays.
1085*
1086 READ( nin, fmt = * ) ( uploval( i ), i = 1, nmat )
1087 READ( nin, fmt = * ) ( tranval( i ), i = 1, nmat )
1088 READ( nin, fmt = * ) ( diagval( i ), i = 1, nmat )
1089 READ( nin, fmt = * ) ( mval( i ), i = 1, nmat )
1090 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
1091 READ( nin, fmt = * ) ( maval( i ), i = 1, nmat )
1092 READ( nin, fmt = * ) ( naval( i ), i = 1, nmat )
1093 READ( nin, fmt = * ) ( imbaval( i ), i = 1, nmat )
1094 READ( nin, fmt = * ) ( inbaval( i ), i = 1, nmat )
1095 READ( nin, fmt = * ) ( mbaval( i ), i = 1, nmat )
1096 READ( nin, fmt = * ) ( nbaval( i ), i = 1, nmat )
1097 READ( nin, fmt = * ) ( rscaval( i ), i = 1, nmat )
1098 READ( nin, fmt = * ) ( cscaval( i ), i = 1, nmat )
1099 READ( nin, fmt = * ) ( iaval( i ), i = 1, nmat )
1100 READ( nin, fmt = * ) ( javal( i ), i = 1, nmat )
1101 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
1102 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
1103 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
1104 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
1105 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
1106 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
1107 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
1108 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
1109 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
1110 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
1111 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
1112 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
1113 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
1114 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
1115 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
1116 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
1117 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
1118 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
1119 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
1120 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
1121 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
1122 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
1123*
1124* Read names of subroutines and flags which indicate
1125* whether they are to be tested.
1126*
1127 DO 10 i = 1, nsubs
1128 ltest( i ) = .false.
1129 10 CONTINUE
1130 20 CONTINUE
1131 READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
1132 DO 30 i = 1, nsubs
1133 IF( snamet.EQ.snames( i ) )
1134 $ GO TO 40
1135 30 CONTINUE
1136*
1137 WRITE( nout, fmt = 9995 )snamet
1138 GO TO 120
1139*
1140 40 CONTINUE
1141 ltest( i ) = ltestt
1142 GO TO 20
1143*
1144 50 CONTINUE
1145*
1146* Close input file
1147*
1148 CLOSE ( nin )
1149*
1150* For pvm only: if virtual machine not set up, allocate it and
1151* spawn the correct number of processes.
1152*
1153 IF( nprocs.LT.1 ) THEN
1154 nprocs = 0
1155 DO 60 i = 1, ngrids
1156 nprocs = max( nprocs, pval( i )*qval( i ) )
1157 60 CONTINUE
1158 CALL blacs_setup( iam, nprocs )
1159 END IF
1160*
1161* Temporarily define blacs grid to include all processes so
1162* information can be broadcast to all processes
1163*
1164 CALL blacs_get( -1, 0, ictxt )
1165 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1166*
1167* Pack information arrays and broadcast
1168*
1169 CALL sgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
1170 CALL sgebs2d( ictxt, 'All', ' ', 1, 1, beta, 1 )
1171*
1172 work( 1 ) = ngrids
1173 work( 2 ) = nmat
1174 work( 3 ) = nblog
1175 CALL igebs2d( ictxt, 'All', ' ', 3, 1, work, 3 )
1176*
1177 i = 1
1178 DO 70 j = 1, nmat
1179 work( i ) = ichar( diagval( j ) )
1180 work( i+1 ) = ichar( tranval( j ) )
1181 work( i+2 ) = ichar( uploval( j ) )
1182 i = i + 3
1183 70 CONTINUE
1184 CALL icopy( ngrids, pval, 1, work( i ), 1 )
1185 i = i + ngrids
1186 CALL icopy( ngrids, qval, 1, work( i ), 1 )
1187 i = i + ngrids
1188 CALL icopy( nmat, mval, 1, work( i ), 1 )
1189 i = i + nmat
1190 CALL icopy( nmat, nval, 1, work( i ), 1 )
1191 i = i + nmat
1192 CALL icopy( nmat, maval, 1, work( i ), 1 )
1193 i = i + nmat
1194 CALL icopy( nmat, naval, 1, work( i ), 1 )
1195 i = i + nmat
1196 CALL icopy( nmat, imbaval, 1, work( i ), 1 )
1197 i = i + nmat
1198 CALL icopy( nmat, inbaval, 1, work( i ), 1 )
1199 i = i + nmat
1200 CALL icopy( nmat, mbaval, 1, work( i ), 1 )
1201 i = i + nmat
1202 CALL icopy( nmat, nbaval, 1, work( i ), 1 )
1203 i = i + nmat
1204 CALL icopy( nmat, rscaval, 1, work( i ), 1 )
1205 i = i + nmat
1206 CALL icopy( nmat, cscaval, 1, work( i ), 1 )
1207 i = i + nmat
1208 CALL icopy( nmat, iaval, 1, work( i ), 1 )
1209 i = i + nmat
1210 CALL icopy( nmat, javal, 1, work( i ), 1 )
1211 i = i + nmat
1212 CALL icopy( nmat, mxval, 1, work( i ), 1 )
1213 i = i + nmat
1214 CALL icopy( nmat, nxval, 1, work( i ), 1 )
1215 i = i + nmat
1216 CALL icopy( nmat, imbxval, 1, work( i ), 1 )
1217 i = i + nmat
1218 CALL icopy( nmat, inbxval, 1, work( i ), 1 )
1219 i = i + nmat
1220 CALL icopy( nmat, mbxval, 1, work( i ), 1 )
1221 i = i + nmat
1222 CALL icopy( nmat, nbxval, 1, work( i ), 1 )
1223 i = i + nmat
1224 CALL icopy( nmat, rscxval, 1, work( i ), 1 )
1225 i = i + nmat
1226 CALL icopy( nmat, cscxval, 1, work( i ), 1 )
1227 i = i + nmat
1228 CALL icopy( nmat, ixval, 1, work( i ), 1 )
1229 i = i + nmat
1230 CALL icopy( nmat, jxval, 1, work( i ), 1 )
1231 i = i + nmat
1232 CALL icopy( nmat, incxval, 1, work( i ), 1 )
1233 i = i + nmat
1234 CALL icopy( nmat, myval, 1, work( i ), 1 )
1235 i = i + nmat
1236 CALL icopy( nmat, nyval, 1, work( i ), 1 )
1237 i = i + nmat
1238 CALL icopy( nmat, imbyval, 1, work( i ), 1 )
1239 i = i + nmat
1240 CALL icopy( nmat, inbyval, 1, work( i ), 1 )
1241 i = i + nmat
1242 CALL icopy( nmat, mbyval, 1, work( i ), 1 )
1243 i = i + nmat
1244 CALL icopy( nmat, nbyval, 1, work( i ), 1 )
1245 i = i + nmat
1246 CALL icopy( nmat, rscyval, 1, work( i ), 1 )
1247 i = i + nmat
1248 CALL icopy( nmat, cscyval, 1, work( i ), 1 )
1249 i = i + nmat
1250 CALL icopy( nmat, iyval, 1, work( i ), 1 )
1251 i = i + nmat
1252 CALL icopy( nmat, jyval, 1, work( i ), 1 )
1253 i = i + nmat
1254 CALL icopy( nmat, incyval, 1, work( i ), 1 )
1255 i = i + nmat
1256*
1257 DO 80 j = 1, nsubs
1258 IF( ltest( j ) ) THEN
1259 work( i ) = 1
1260 ELSE
1261 work( i ) = 0
1262 END IF
1263 i = i + 1
1264 80 CONTINUE
1265 i = i - 1
1266 CALL igebs2d( ictxt, 'All', ' ', i, 1, work, i )
1267*
1268* regurgitate input
1269*
1270 WRITE( nout, fmt = 9999 )
1271 $ 'Level 2 PBLAS timing program.'
1272 WRITE( nout, fmt = 9999 ) usrinfo
1273 WRITE( nout, fmt = * )
1274 WRITE( nout, fmt = 9999 )
1275 $ 'Tests of the real single precision '//
1276 $ 'Level 2 PBLAS'
1277 WRITE( nout, fmt = * )
1278 WRITE( nout, fmt = 9992 ) nmat
1279 WRITE( nout, fmt = 9986 ) nblog
1280 WRITE( nout, fmt = 9991 ) ngrids
1281 WRITE( nout, fmt = 9989 )
1282 $ 'P', ( pval(i), i = 1, min(ngrids, 5) )
1283 IF( ngrids.GT.5 )
1284 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 6,
1285 $ min( 10, ngrids ) )
1286 IF( ngrids.GT.10 )
1287 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 11,
1288 $ min( 15, ngrids ) )
1289 IF( ngrids.GT.15 )
1290 $ WRITE( nout, fmt = 9990 ) ( pval(i), i = 16, ngrids )
1291 WRITE( nout, fmt = 9989 )
1292 $ 'Q', ( qval(i), i = 1, min(ngrids, 5) )
1293 IF( ngrids.GT.5 )
1294 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 6,
1295 $ min( 10, ngrids ) )
1296 IF( ngrids.GT.10 )
1297 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 11,
1298 $ min( 15, ngrids ) )
1299 IF( ngrids.GT.15 )
1300 $ WRITE( nout, fmt = 9990 ) ( qval(i), i = 16, ngrids )
1301 WRITE( nout, fmt = 9994 ) alpha
1302 WRITE( nout, fmt = 9993 ) beta
1303 IF( ltest( 1 ) ) THEN
1304 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... Yes'
1305 ELSE
1306 WRITE( nout, fmt = 9988 ) snames( 1 ), ' ... No '
1307 END IF
1308 DO 90 i = 1, nsubs
1309 IF( ltest( i ) ) THEN
1310 WRITE( nout, fmt = 9987 ) snames( i ), ' ... Yes'
1311 ELSE
1312 WRITE( nout, fmt = 9987 ) snames( i ), ' ... No '
1313 END IF
1314 90 CONTINUE
1315 WRITE( nout, fmt = * )
1316*
1317 ELSE
1318*
1319* If in pvm, must participate setting up virtual machine
1320*
1321 IF( nprocs.LT.1 )
1322 $ CALL blacs_setup( iam, nprocs )
1323*
1324* Temporarily define blacs grid to include all processes so
1325* information can be broadcast to all processes
1326*
1327 CALL blacs_get( -1, 0, ictxt )
1328 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
1329*
1330 CALL sgebr2d( ictxt, 'All', ' ', 1, 1, alpha, 1, 0, 0 )
1331 CALL sgebr2d( ictxt, 'All', ' ', 1, 1, beta, 1, 0, 0 )
1332*
1333 CALL igebr2d( ictxt, 'All', ' ', 3, 1, work, 3, 0, 0 )
1334 ngrids = work( 1 )
1335 nmat = work( 2 )
1336 nblog = work( 3 )
1337*
1338 i = 2*ngrids + 37*nmat + nsubs
1339 CALL igebr2d( ictxt, 'All', ' ', i, 1, work, i, 0, 0 )
1340*
1341 i = 1
1342 DO 100 j = 1, nmat
1343 diagval( j ) = char( work( i ) )
1344 tranval( j ) = char( work( i+1 ) )
1345 uploval( j ) = char( work( i+2 ) )
1346 i = i + 3
1347 100 CONTINUE
1348 CALL icopy( ngrids, work( i ), 1, pval, 1 )
1349 i = i + ngrids
1350 CALL icopy( ngrids, work( i ), 1, qval, 1 )
1351 i = i + ngrids
1352 CALL icopy( nmat, work( i ), 1, mval, 1 )
1353 i = i + nmat
1354 CALL icopy( nmat, work( i ), 1, nval, 1 )
1355 i = i + nmat
1356 CALL icopy( nmat, work( i ), 1, maval, 1 )
1357 i = i + nmat
1358 CALL icopy( nmat, work( i ), 1, naval, 1 )
1359 i = i + nmat
1360 CALL icopy( nmat, work( i ), 1, imbaval, 1 )
1361 i = i + nmat
1362 CALL icopy( nmat, work( i ), 1, inbaval, 1 )
1363 i = i + nmat
1364 CALL icopy( nmat, work( i ), 1, mbaval, 1 )
1365 i = i + nmat
1366 CALL icopy( nmat, work( i ), 1, nbaval, 1 )
1367 i = i + nmat
1368 CALL icopy( nmat, work( i ), 1, rscaval, 1 )
1369 i = i + nmat
1370 CALL icopy( nmat, work( i ), 1, cscaval, 1 )
1371 i = i + nmat
1372 CALL icopy( nmat, work( i ), 1, iaval, 1 )
1373 i = i + nmat
1374 CALL icopy( nmat, work( i ), 1, javal, 1 )
1375 i = i + nmat
1376 CALL icopy( nmat, work( i ), 1, mxval, 1 )
1377 i = i + nmat
1378 CALL icopy( nmat, work( i ), 1, nxval, 1 )
1379 i = i + nmat
1380 CALL icopy( nmat, work( i ), 1, imbxval, 1 )
1381 i = i + nmat
1382 CALL icopy( nmat, work( i ), 1, inbxval, 1 )
1383 i = i + nmat
1384 CALL icopy( nmat, work( i ), 1, mbxval, 1 )
1385 i = i + nmat
1386 CALL icopy( nmat, work( i ), 1, nbxval, 1 )
1387 i = i + nmat
1388 CALL icopy( nmat, work( i ), 1, rscxval, 1 )
1389 i = i + nmat
1390 CALL icopy( nmat, work( i ), 1, cscxval, 1 )
1391 i = i + nmat
1392 CALL icopy( nmat, work( i ), 1, ixval, 1 )
1393 i = i + nmat
1394 CALL icopy( nmat, work( i ), 1, jxval, 1 )
1395 i = i + nmat
1396 CALL icopy( nmat, work( i ), 1, incxval, 1 )
1397 i = i + nmat
1398 CALL icopy( nmat, work( i ), 1, myval, 1 )
1399 i = i + nmat
1400 CALL icopy( nmat, work( i ), 1, nyval, 1 )
1401 i = i + nmat
1402 CALL icopy( nmat, work( i ), 1, imbyval, 1 )
1403 i = i + nmat
1404 CALL icopy( nmat, work( i ), 1, inbyval, 1 )
1405 i = i + nmat
1406 CALL icopy( nmat, work( i ), 1, mbyval, 1 )
1407 i = i + nmat
1408 CALL icopy( nmat, work( i ), 1, nbyval, 1 )
1409 i = i + nmat
1410 CALL icopy( nmat, work( i ), 1, rscyval, 1 )
1411 i = i + nmat
1412 CALL icopy( nmat, work( i ), 1, cscyval, 1 )
1413 i = i + nmat
1414 CALL icopy( nmat, work( i ), 1, iyval, 1 )
1415 i = i + nmat
1416 CALL icopy( nmat, work( i ), 1, jyval, 1 )
1417 i = i + nmat
1418 CALL icopy( nmat, work( i ), 1, incyval, 1 )
1419 i = i + nmat
1420*
1421 DO 110 j = 1, nsubs
1422 IF( work( i ).EQ.1 ) THEN
1423 ltest( j ) = .true.
1424 ELSE
1425 ltest( j ) = .false.
1426 END IF
1427 i = i + 1
1428 110 CONTINUE
1429*
1430 END IF
1431*
1432 CALL blacs_gridexit( ictxt )
1433*
1434 RETURN
1435*
1436 120 WRITE( nout, fmt = 9997 )
1437 CLOSE( nin )
1438 IF( nout.NE.6 .AND. nout.NE.0 )
1439 $ CLOSE( nout )
1440 CALL blacs_abort( ictxt, 1 )
1441*
1442 stop
1443*
1444 9999 FORMAT( a )
1445 9998 FORMAT( ' Number of values of ',5a, ' is less than 1 or greater ',
1446 $ 'than ', i2 )
1447 9997 FORMAT( ' Illegal input in file ',40a,'. Aborting run.' )
1448 9996 FORMAT( a7, l2 )
1449 9995 FORMAT( ' Subprogram name ', a7, ' not recognized',
1450 $ /' ******* TESTS ABANDONED *******' )
1451 9994 FORMAT( 2x, 'Alpha : ', g16.6 )
1452 9993 FORMAT( 2x, 'Beta : ', g16.6 )
1453 9992 FORMAT( 2x, 'Number of Tests : ', i6 )
1454 9991 FORMAT( 2x, 'Number of process grids : ', i6 )
1455 9990 FORMAT( 2x, ' : ', 5i6 )
1456 9989 FORMAT( 2x, a1, ' : ', 5i6 )
1457 9988 FORMAT( 2x, 'Routines to be tested : ', a, a8 )
1458 9987 FORMAT( 2x, ' ', a, a8 )
1459 9986 FORMAT( 2x, 'Logical block size : ', i6 )
1460*
1461* End of PSBLA2TIMINFO
1462*
alpha
#define alpha
Definition eval.h:35
icopy
subroutine icopy(n, sx, incx, sy, incy)
ICOPY
Definition icopy.f:75
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
sgebs2d
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1072
blacs_gridinit
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762