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

Go to the source code of this file.

Functions/Subroutines

program pzbla2tim
subroutine pzbla2timinfo (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

◆ pzbla2tim()

program pzbla2tim

Definition at line 11 of file pzblas2tim.f.

◆ 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*
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
zgebr2d
subroutine zgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1092
zgebs2d
subroutine zgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1051
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762