SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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*
icopy
subroutine icopy(n, sx, incx, sy, incy)
Definition pblastst.f:1525
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
Here is the call graph for this function:
Here is the caller graph for this function: