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

Go to the source code of this file.

Functions/Subroutines

program pdbla2tim
subroutine pdbla2timinfo (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

◆ pdbla2tim()

program pdbla2tim

Definition at line 11 of file pdblas2tim.f.

◆ 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.GT. IF( NGRIDS5 )
1282 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 6,
1283 $ MIN( 10, NGRIDS ) )
1284.GT. IF( NGRIDS10 )
1285 $ WRITE( NOUT, FMT = 9990 ) ( PVAL(I), I = 11,
1286 $ MIN( 15, NGRIDS ) )
1287.GT. IF( NGRIDS15 )
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.GT. IF( NGRIDS5 )
1292 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 6,
1293 $ MIN( 10, NGRIDS ) )
1294.GT. IF( NGRIDS10 )
1295 $ WRITE( NOUT, FMT = 9990 ) ( QVAL(I), I = 11,
1296 $ MIN( 15, NGRIDS ) )
1297.GT. IF( NGRIDS15 )
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.LT. IF( NPROCS1 )
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.EQ. IF( WORK( I )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.NE..AND..NE. IF( NOUT6 NOUT0 )
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*
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
dgebs2d
subroutine dgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1082
dgebr2d
subroutine dgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1123
sgebr2d
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
blacs_gridexit
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762