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

◆ pdbla2timinfo()

subroutine pdbla2timinfo ( 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,
double precision  alpha,
double precision  beta,
integer, dimension( * )  work 
)

Definition at line 689 of file pdblas2tim.f.

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