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

◆ pzbla2timinfo()

subroutine pzbla2timinfo ( 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,
complex*16  alpha,
complex*16  beta,
integer, dimension( * )  work 
)

Definition at line 705 of file pzblas2tim.f.

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