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

Go to the source code of this file.

Functions/Subroutines

program pzbla1tim
subroutine pzbla1timinfo (summry, nout, nmat, nval, 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, ltest, iam, nprocs, alpha, work)

Function/Subroutine Documentation

◆ pzbla1tim()

program pzbla1tim

Definition at line 12 of file pzblas1tim.f.

◆ pzbla1timinfo()

subroutine pzbla1timinfo ( character*( * ) summry,
integer nout,
integer nmat,
integer, dimension( ldval ) nval,
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,
logical, dimension( * ) ltest,
integer iam,
integer nprocs,
complex*16 alpha,
integer, dimension( * ) work )

Definition at line 572 of file pzblas1tim.f.

580*
581* -- PBLAS test routine (version 2.0) --
582* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
583* and University of California, Berkeley.
584* April 1, 1998
585*
586* .. Scalar Arguments ..
587 INTEGER IAM, LDPVAL, LDQVAL, LDVAL, NGRIDS, NMAT, NOUT,
588 $ NPROCS
589 COMPLEX*16 ALPHA
590* ..
591* .. Array Arguments ..
592 CHARACTER*( * ) SUMMRY
593 LOGICAL LTEST( * )
594 INTEGER CSCXVAL( LDVAL ), CSCYVAL( LDVAL ),
595 $ IMBXVAL( LDVAL ), IMBYVAL( LDVAL ),
596 $ INBXVAL( LDVAL ), INBYVAL( LDVAL ),
597 $ INCXVAL( LDVAL ), INCYVAL( LDVAL ),
598 $ IXVAL( LDVAL ), IYVAL( LDVAL ), JXVAL( LDVAL ),
599 $ JYVAL( LDVAL ), MBXVAL( LDVAL ),
600 $ MBYVAL( LDVAL ), MXVAL( LDVAL ),
601 $ MYVAL( LDVAL ), NBXVAL( LDVAL ),
602 $ NBYVAL( LDVAL ), NVAL( LDVAL ), NXVAL( LDVAL ),
603 $ NYVAL( LDVAL ), PVAL( LDPVAL ), QVAL( LDQVAL ),
604 $ RSCXVAL( LDVAL ), RSCYVAL( LDVAL ), WORK( * )
605* ..
606*
607* Purpose
608* =======
609*
610* PZBLA1TIMINFO get the needed startup information for timing various
611* Level 1 PBLAS routines, and transmits it to all processes.
612*
613* Notes
614* =====
615*
616* For packing the information we assumed that the length in bytes of an
617* integer is equal to the length in bytes of a real single precision.
618*
619* Arguments
620* =========
621*
622* SUMMRY (global output) CHARACTER*(*)
623* On exit, SUMMRY is the name of output (summary) file (if
624* any). SUMMRY is only defined for process 0.
625*
626* NOUT (global output) INTEGER
627* On exit, NOUT specifies the unit number for the output file.
628* When NOUT is 6, output to screen, when NOUT is 0, output to
629* stderr. NOUT is only defined for process 0.
630*
631* NMAT (global output) INTEGER
632* On exit, NMAT specifies the number of different test cases.
633*
634* NVAL (global output) INTEGER array
635* On entry, NVAL is an array of dimension LDVAL. On exit, this
636* array contains the values of N to run the code with.
637*
638* MXVAL (global output) INTEGER array
639* On entry, MXVAL is an array of dimension LDVAL. On exit, this
640* array contains the values of DESCX( M_ ) to run the code
641* with.
642*
643* NXVAL (global output) INTEGER array
644* On entry, NXVAL is an array of dimension LDVAL. On exit, this
645* array contains the values of DESCX( N_ ) to run the code
646* with.
647*
648* IMBXVAL (global output) INTEGER array
649* On entry, IMBXVAL is an array of dimension LDVAL. On exit,
650* this array contains the values of DESCX( IMB_ ) to run the
651* code with.
652*
653* MBXVAL (global output) INTEGER array
654* On entry, MBXVAL is an array of dimension LDVAL. On exit,
655* this array contains the values of DESCX( MB_ ) to run the
656* code with.
657*
658* INBXVAL (global output) INTEGER array
659* On entry, INBXVAL is an array of dimension LDVAL. On exit,
660* this array contains the values of DESCX( INB_ ) to run the
661* code with.
662*
663* NBXVAL (global output) INTEGER array
664* On entry, NBXVAL is an array of dimension LDVAL. On exit,
665* this array contains the values of DESCX( NB_ ) to run the
666* code with.
667*
668* RSCXVAL (global output) INTEGER array
669* On entry, RSCXVAL is an array of dimension LDVAL. On exit,
670* this array contains the values of DESCX( RSRC_ ) to run the
671* code with.
672*
673* CSCXVAL (global output) INTEGER array
674* On entry, CSCXVAL is an array of dimension LDVAL. On exit,
675* this array contains the values of DESCX( CSRC_ ) to run the
676* code with.
677*
678* IXVAL (global output) INTEGER array
679* On entry, IXVAL is an array of dimension LDVAL. On exit, this
680* array contains the values of IX to run the code with.
681*
682* JXVAL (global output) INTEGER array
683* On entry, JXVAL is an array of dimension LDVAL. On exit, this
684* array contains the values of JX to run the code with.
685*
686* INCXVAL (global output) INTEGER array
687* On entry, INCXVAL is an array of dimension LDVAL. On exit,
688* this array contains the values of INCX to run the code with.
689*
690* MYVAL (global output) INTEGER array
691* On entry, MYVAL is an array of dimension LDVAL. On exit, this
692* array contains the values of DESCY( M_ ) to run the code
693* with.
694*
695* NYVAL (global output) INTEGER array
696* On entry, NYVAL is an array of dimension LDVAL. On exit, this
697* array contains the values of DESCY( N_ ) to run the code
698* with.
699*
700* IMBYVAL (global output) INTEGER array
701* On entry, IMBYVAL is an array of dimension LDVAL. On exit,
702* this array contains the values of DESCY( IMB_ ) to run the
703* code with.
704*
705* MBYVAL (global output) INTEGER array
706* On entry, MBYVAL is an array of dimension LDVAL. On exit,
707* this array contains the values of DESCY( MB_ ) to run the
708* code with.
709*
710* INBYVAL (global output) INTEGER array
711* On entry, INBYVAL is an array of dimension LDVAL. On exit,
712* this array contains the values of DESCY( INB_ ) to run the
713* code with.
714*
715* NBYVAL (global output) INTEGER array
716* On entry, NBYVAL is an array of dimension LDVAL. On exit,
717* this array contains the values of DESCY( NB_ ) to run the
718* code with.
719*
720* RSCYVAL (global output) INTEGER array
721* On entry, RSCYVAL is an array of dimension LDVAL. On exit,
722* this array contains the values of DESCY( RSRC_ ) to run the
723* code with.
724*
725* CSCYVAL (global output) INTEGER array
726* On entry, CSCYVAL is an array of dimension LDVAL. On exit,
727* this array contains the values of DESCY( CSRC_ ) to run the
728* code with.
729*
730* IYVAL (global output) INTEGER array
731* On entry, IYVAL is an array of dimension LDVAL. On exit, this
732* array contains the values of IY to run the code with.
733*
734* JYVAL (global output) INTEGER array
735* On entry, JYVAL is an array of dimension LDVAL. On exit, this
736* array contains the values of JY to run the code with.
737*
738* INCYVAL (global output) INTEGER array
739* On entry, INCYVAL is an array of dimension LDVAL. On exit,
740* this array contains the values of INCY to run the code with.
741*
742* LDVAL (global input) INTEGER
743* On entry, LDVAL specifies the maximum number of different va-
744* lues that can be used for DESCX(:), IX, JX, INCX, DESCY(:),
745* IY, JY and INCY. This is also the maximum number of test
746* cases.
747*
748* NGRIDS (global output) INTEGER
749* On exit, NGRIDS specifies the number of different values that
750* can be used for P and Q.
751*
752* PVAL (global output) INTEGER array
753* On entry, PVAL is an array of dimension LDPVAL. On exit, this
754* array contains the values of P to run the code with.
755*
756* LDPVAL (global input) INTEGER
757* On entry, LDPVAL specifies the maximum number of different
758* values that can be used for P.
759*
760* QVAL (global output) INTEGER array
761* On entry, QVAL is an array of dimension LDQVAL. On exit, this
762* array contains the values of Q to run the code with.
763*
764* LDQVAL (global input) INTEGER
765* On entry, LDQVAL specifies the maximum number of different
766* values that can be used for Q.
767*
768* LTEST (global output) LOGICAL array
769* On entry, LTEST is an array of dimension at least ten. On
770* exit, if LTEST( i ) is .TRUE., the i-th Level 1 PBLAS routine
771* will be tested. See the input file for the ordering of the
772* routines.
773*
774* IAM (local input) INTEGER
775* On entry, IAM specifies the number of the process executing
776* this routine.
777*
778* NPROCS (global input) INTEGER
779* On entry, NPROCS specifies the total number of processes.
780*
781* ALPHA (global output) COMPLEX*16
782* On exit, ALPHA specifies the value of alpha to be used in all
783* the test cases.
784*
785* WORK (local workspace) INTEGER array
786* On entry, WORK is an array of dimension at least
787* MAX( 2, 2*NGRIDS+23*NMAT+NSUBS ) with NSUBS = 10. This array
788* is used to pack all output arrays in order to send info in
789* one message.
790*
791* -- Written on April 1, 1998 by
792* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
793*
794* =====================================================================
795*
796* .. Parameters ..
797 INTEGER NIN, NSUBS
798 parameter( nin = 11, nsubs = 10 )
799* ..
800* .. Local Scalars ..
801 LOGICAL LTESTT
802 INTEGER I, ICTXT, J
803* ..
804* .. Local Arrays ..
805 CHARACTER*7 SNAMET
806 CHARACTER*79 USRINFO
807* ..
808* .. External Subroutines ..
809 EXTERNAL blacs_abort, blacs_get, blacs_gridexit,
810 $ blacs_gridinit, blacs_setup, icopy, igebr2d,
811 $ igebs2d, sgebr2d, sgebs2d, zgebr2d, zgebs2d
812* ..
813* .. Intrinsic Functions ..
814 INTRINSIC max, min
815* ..
816* .. Common Blocks ..
817 CHARACTER*7 SNAMES( NSUBS )
818 COMMON /snamec/snames
819* ..
820* .. Executable Statements ..
821*
822*
823* Process 0 reads the input data, broadcasts to other processes and
824* writes needed information to NOUT
825*
826 IF( iam.EQ.0 ) THEN
827*
828* Open file and skip data file header
829*
830 OPEN( nin, file='PZBLAS1TIM.dat', status='OLD' )
831 READ( nin, fmt = * ) summry
832 summry = ' '
833*
834* Read in user-supplied info about machine type, compiler, etc.
835*
836 READ( nin, fmt = 9999 ) usrinfo
837*
838* Read name and unit number for summary output file
839*
840 READ( nin, fmt = * ) summry
841 READ( nin, fmt = * ) nout
842 IF( nout.NE.0 .AND. nout.NE.6 )
843 $ OPEN( nout, file = summry, status = 'UNKNOWN' )
844*
845* Read and check the parameter values for the tests.
846*
847* Get number of grids
848*
849 READ( nin, fmt = * ) ngrids
850 IF( ngrids.LT.1 .OR. ngrids.GT.ldpval ) THEN
851 WRITE( nout, fmt = 9998 ) 'Grids', ldpval
852 GO TO 100
853 ELSE IF( ngrids.GT.ldqval ) THEN
854 WRITE( nout, fmt = 9998 ) 'Grids', ldqval
855 GO TO 100
856 END IF
857*
858* Get values of P and Q
859*
860 READ( nin, fmt = * ) ( pval( i ), i = 1, ngrids )
861 READ( nin, fmt = * ) ( qval( i ), i = 1, ngrids )
862*
863* Read ALPHA
864*
865 READ( nin, fmt = * ) alpha
866*
867* Read number of tests.
868*
869 READ( nin, fmt = * ) nmat
870 IF( nmat.LT.1 .OR. nmat.GT.ldval ) THEN
871 WRITE( nout, fmt = 9998 ) 'Tests', ldval
872 GO TO 100
873 END IF
874*
875* Read in input data into arrays.
876*
877 READ( nin, fmt = * ) ( nval( i ), i = 1, nmat )
878 READ( nin, fmt = * ) ( mxval( i ), i = 1, nmat )
879 READ( nin, fmt = * ) ( nxval( i ), i = 1, nmat )
880 READ( nin, fmt = * ) ( imbxval( i ), i = 1, nmat )
881 READ( nin, fmt = * ) ( inbxval( i ), i = 1, nmat )
882 READ( nin, fmt = * ) ( mbxval( i ), i = 1, nmat )
883 READ( nin, fmt = * ) ( nbxval( i ), i = 1, nmat )
884 READ( nin, fmt = * ) ( rscxval( i ), i = 1, nmat )
885 READ( nin, fmt = * ) ( cscxval( i ), i = 1, nmat )
886 READ( nin, fmt = * ) ( ixval( i ), i = 1, nmat )
887 READ( nin, fmt = * ) ( jxval( i ), i = 1, nmat )
888 READ( nin, fmt = * ) ( incxval( i ), i = 1, nmat )
889 READ( nin, fmt = * ) ( myval( i ), i = 1, nmat )
890 READ( nin, fmt = * ) ( nyval( i ), i = 1, nmat )
891 READ( nin, fmt = * ) ( imbyval( i ), i = 1, nmat )
892 READ( nin, fmt = * ) ( inbyval( i ), i = 1, nmat )
893 READ( nin, fmt = * ) ( mbyval( i ), i = 1, nmat )
894 READ( nin, fmt = * ) ( nbyval( i ), i = 1, nmat )
895 READ( nin, fmt = * ) ( rscyval( i ), i = 1, nmat )
896 READ( nin, fmt = * ) ( cscyval( i ), i = 1, nmat )
897 READ( nin, fmt = * ) ( iyval( i ), i = 1, nmat )
898 READ( nin, fmt = * ) ( jyval( i ), i = 1, nmat )
899 READ( nin, fmt = * ) ( incyval( i ), i = 1, nmat )
900*
901* Read names of subroutines and flags which indicate
902* whether they are to be tested.
903*
904 DO 10 i = 1, nsubs
905 ltest( i ) = .false.
906 10 CONTINUE
907 20 CONTINUE
908 READ( nin, fmt = 9996, END = 50 ) SNAMET, ltestt
909 DO 30 i = 1, nsubs
910 IF( snamet.EQ.snames( i ) )
911 $ GO TO 40
912 30 CONTINUE
913*
914 WRITE( nout, fmt = 9995 )snamet
915 GO TO 100
916*
917 40 CONTINUE
918 ltest( i ) = ltestt
919 GO TO 20
920*
921 50 CONTINUE
922*
923* Close input file
924*
925 CLOSE ( nin )
926*
927* For pvm only: if virtual machine not set up, allocate it and
928* spawn the correct number of processes.
929*
930 IF( nprocs.LT.1 ) THEN
931 nprocs = 0
932 DO 60 i = 1, ngrids
933 nprocs = max( nprocs, pval( i )*qval( i ) )
934 60 CONTINUE
935 CALL blacs_setup( iam, nprocs )
936 END IF
937*
938* Temporarily define blacs grid to include all processes so
939* information can be broadcast to all processes
940*
941 CALL blacs_get( -1, 0, ictxt )
942 CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
943*
944* Pack information arrays and broadcast
945*
946 CALL zgebs2d( ictxt, 'All', ' ', 1, 1, alpha, 1 )
947*
948 work( 1 ) = ngrids
949 work( 2 ) = nmat
950 CALL igebs2d( ictxt, 'All', ' ', 2, 1, WORK, 2 )
951*
952 I = 1
953 CALL ICOPY( NGRIDS, PVAL, 1, WORK( I ), 1 )
954 I = I + NGRIDS
955 CALL ICOPY( NGRIDS, QVAL, 1, WORK( I ), 1 )
956 I = I + NGRIDS
957 CALL ICOPY( NMAT, NVAL, 1, WORK( I ), 1 )
958 I = I + NMAT
959 CALL ICOPY( NMAT, MXVAL, 1, WORK( I ), 1 )
960 I = I + NMAT
961 CALL ICOPY( NMAT, NXVAL, 1, WORK( I ), 1 )
962 I = I + NMAT
963 CALL ICOPY( NMAT, IMBXVAL, 1, WORK( I ), 1 )
964 I = I + NMAT
965 CALL ICOPY( NMAT, INBXVAL, 1, WORK( I ), 1 )
966 I = I + NMAT
967 CALL ICOPY( NMAT, MBXVAL, 1, WORK( I ), 1 )
968 I = I + NMAT
969 CALL ICOPY( NMAT, NBXVAL, 1, WORK( I ), 1 )
970 I = I + NMAT
971 CALL ICOPY( NMAT, RSCXVAL, 1, WORK( I ), 1 )
972 I = I + NMAT
973 CALL ICOPY( NMAT, CSCXVAL, 1, WORK( I ), 1 )
974 I = I + NMAT
975 CALL ICOPY( NMAT, IXVAL, 1, WORK( I ), 1 )
976 I = I + NMAT
977 CALL ICOPY( NMAT, JXVAL, 1, WORK( I ), 1 )
978 I = I + NMAT
979 CALL ICOPY( NMAT, INCXVAL, 1, WORK( I ), 1 )
980 I = I + NMAT
981 CALL ICOPY( NMAT, MYVAL, 1, WORK( I ), 1 )
982 I = I + NMAT
983 CALL ICOPY( NMAT, NYVAL, 1, WORK( I ), 1 )
984 I = I + NMAT
985 CALL ICOPY( NMAT, IMBYVAL, 1, WORK( I ), 1 )
986 I = I + NMAT
987 CALL ICOPY( NMAT, INBYVAL, 1, WORK( I ), 1 )
988 I = I + NMAT
989 CALL ICOPY( NMAT, MBYVAL, 1, WORK( I ), 1 )
990 I = I + NMAT
991 CALL ICOPY( NMAT, NBYVAL, 1, WORK( I ), 1 )
992 I = I + NMAT
993 CALL ICOPY( NMAT, RSCYVAL, 1, WORK( I ), 1 )
994 I = I + NMAT
995 CALL ICOPY( NMAT, CSCYVAL, 1, WORK( I ), 1 )
996 I = I + NMAT
997 CALL ICOPY( NMAT, IYVAL, 1, WORK( I ), 1 )
998 I = I + NMAT
999 CALL ICOPY( NMAT, JYVAL, 1, WORK( I ), 1 )
1000 I = I + NMAT
1001 CALL ICOPY( NMAT, INCYVAL, 1, WORK( I ), 1 )
1002 I = I + NMAT
1003*
1004 DO 70 J = 1, NSUBS
1005 IF( LTEST( J ) ) THEN
1006 WORK( I ) = 1
1007 ELSE
1008 WORK( I ) = 0
1009 END IF
1010 I = I + 1
1011 70 CONTINUE
1012 I = I - 1
1013 CALL IGEBS2D( ICTXT, 'all', ' ', I, 1, WORK, I )
1014*
1015* regurgitate input
1016*
1017 WRITE( NOUT, FMT = 9999 )
1018 $ 'level 1 pblas timing program.'
1019 WRITE( NOUT, FMT = 9999 ) USRINFO
1020 WRITE( NOUT, FMT = * )
1021 WRITE( NOUT, FMT = 9999 )
1022 $ 'timing of the complex double precision '//
1023 $ 'Level 1 PBLAS'
1024 WRITE( NOUT, FMT = * )
1025 WRITE( NOUT, FMT = 9999 )
1026 $ 'The following parameter values will be used:'
1027 WRITE( NOUT, FMT = * )
1028 WRITE( NOUT, FMT = 9993 ) NMAT
1029 WRITE( NOUT, FMT = 9992 ) NGRIDS
1030 WRITE( NOUT, FMT = 9990 )
1031 $ 'P', ( PVAL(I), I = 1, MIN(NGRIDS, 5) )
1032.GT. IF( NGRIDS5 )
1033 $ WRITE( NOUT, FMT = 9991 ) ( PVAL(I), I = 6,
1034 $ MIN( 10, NGRIDS ) )
1035.GT. IF( NGRIDS10 )
1036 $ WRITE( NOUT, FMT = 9991 ) ( PVAL(I), I = 11,
1037 $ MIN( 15, NGRIDS ) )
1038.GT. IF( NGRIDS15 )
1039 $ WRITE( NOUT, FMT = 9991 ) ( PVAL(I), I = 16, NGRIDS )
1040 WRITE( NOUT, FMT = 9990 )
1041 $ 'Q', ( QVAL(I), I = 1, MIN(NGRIDS, 5) )
1042.GT. IF( NGRIDS5 )
1043 $ WRITE( NOUT, FMT = 9991 ) ( QVAL(I), I = 6,
1044 $ MIN( 10, NGRIDS ) )
1045.GT. IF( NGRIDS10 )
1046 $ WRITE( NOUT, FMT = 9991 ) ( QVAL(I), I = 11,
1047 $ MIN( 15, NGRIDS ) )
1048.GT. IF( NGRIDS15 )
1049 $ WRITE( NOUT, FMT = 9991 ) ( QVAL(I), I = 16, NGRIDS )
1050 WRITE( NOUT, FMT = 9994 ) ALPHA
1051 IF( LTEST( 1 ) ) THEN
1052 WRITE( NOUT, FMT = 9989 ) SNAMES( 1 ), ' ... Yes'
1053 ELSE
1054 WRITE( NOUT, FMT = 9989 ) SNAMES( 1 ), ' ... No '
1055 END IF
1056 DO 80 I = 2, NSUBS
1057 IF( LTEST( I ) ) THEN
1058 WRITE( NOUT, FMT = 9988 ) SNAMES( I ), ' ... Yes'
1059 ELSE
1060 WRITE( NOUT, FMT = 9988 ) SNAMES( I ), ' ... No '
1061 END IF
1062 80 CONTINUE
1063 WRITE( NOUT, FMT = * )
1064*
1065 ELSE
1066*
1067* If in pvm, must participate setting up virtual machine
1068*
1069.LT. IF( NPROCS1 )
1070 $ CALL BLACS_SETUP( IAM, NPROCS )
1071*
1072* Temporarily define blacs grid to include all processes so
1073* information can be broadcast to all processes
1074*
1075 CALL BLACS_GET( -1, 0, ICTXT )
1076 CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
1077*
1078 CALL ZGEBR2D( ICTXT, 'All', ' ', 1, 1, ALPHA, 1, 0, 0 )
1079*
1080 CALL IGEBR2D( ICTXT, 'All', ' ', 2, 1, WORK, 2, 0, 0 )
1081 NGRIDS = WORK( 1 )
1082 NMAT = WORK( 2 )
1083*
1084 I = 2*NGRIDS + 23*NMAT + NSUBS
1085 CALL IGEBR2D( ICTXT, 'All', ' ', I, 1, WORK, I, 0, 0 )
1086*
1087 I = 1
1088 CALL ICOPY( NGRIDS, WORK( I ), 1, PVAL, 1 )
1089 I = I + NGRIDS
1090 CALL ICOPY( NGRIDS, WORK( I ), 1, QVAL, 1 )
1091 I = I + NGRIDS
1092 CALL ICOPY( NMAT, WORK( I ), 1, NVAL, 1 )
1093 I = I + NMAT
1094 CALL ICOPY( NMAT, WORK( I ), 1, MXVAL, 1 )
1095 I = I + NMAT
1096 CALL ICOPY( NMAT, WORK( I ), 1, NXVAL, 1 )
1097 I = I + NMAT
1098 CALL ICOPY( NMAT, WORK( I ), 1, IMBXVAL, 1 )
1099 I = I + NMAT
1100 CALL ICOPY( NMAT, WORK( I ), 1, INBXVAL, 1 )
1101 I = I + NMAT
1102 CALL ICOPY( NMAT, WORK( I ), 1, MBXVAL, 1 )
1103 I = I + NMAT
1104 CALL ICOPY( NMAT, WORK( I ), 1, NBXVAL, 1 )
1105 I = I + NMAT
1106 CALL ICOPY( NMAT, WORK( I ), 1, RSCXVAL, 1 )
1107 I = I + NMAT
1108 CALL ICOPY( NMAT, WORK( I ), 1, CSCXVAL, 1 )
1109 I = I + NMAT
1110 CALL ICOPY( NMAT, WORK( I ), 1, IXVAL, 1 )
1111 I = I + NMAT
1112 CALL ICOPY( NMAT, WORK( I ), 1, JXVAL, 1 )
1113 I = I + NMAT
1114 CALL ICOPY( NMAT, WORK( I ), 1, INCXVAL, 1 )
1115 I = I + NMAT
1116 CALL ICOPY( NMAT, WORK( I ), 1, MYVAL, 1 )
1117 I = I + NMAT
1118 CALL ICOPY( NMAT, WORK( I ), 1, NYVAL, 1 )
1119 I = I + NMAT
1120 CALL ICOPY( NMAT, WORK( I ), 1, IMBYVAL, 1 )
1121 I = I + NMAT
1122 CALL ICOPY( NMAT, WORK( I ), 1, INBYVAL, 1 )
1123 I = I + NMAT
1124 CALL ICOPY( NMAT, WORK( I ), 1, MBYVAL, 1 )
1125 I = I + NMAT
1126 CALL ICOPY( NMAT, WORK( I ), 1, NBYVAL, 1 )
1127 I = I + NMAT
1128 CALL ICOPY( NMAT, WORK( I ), 1, RSCYVAL, 1 )
1129 I = I + NMAT
1130 CALL ICOPY( NMAT, WORK( I ), 1, CSCYVAL, 1 )
1131 I = I + NMAT
1132 CALL ICOPY( NMAT, WORK( I ), 1, IYVAL, 1 )
1133 I = I + NMAT
1134 CALL ICOPY( NMAT, WORK( I ), 1, JYVAL, 1 )
1135 I = I + NMAT
1136 CALL ICOPY( NMAT, WORK( I ), 1, INCYVAL, 1 )
1137 I = I + NMAT
1138*
1139 DO 90 J = 1, NSUBS
1140.EQ. IF( WORK( I )1 ) THEN
1141 LTEST( J ) = .TRUE.
1142 ELSE
1143 LTEST( J ) = .FALSE.
1144 END IF
1145 I = I + 1
1146 90 CONTINUE
1147*
1148 END IF
1149*
1150 CALL BLACS_GRIDEXIT( ICTXT )
1151*
1152 RETURN
1153*
1154 100 WRITE( NOUT, FMT = 9997 )
1155 CLOSE( NIN )
1156.NE..AND..NE. IF( NOUT6 NOUT0 )
1157 $ CLOSE( NOUT )
1158 CALL BLACS_ABORT( ICTXT, 1 )
1159*
1160 STOP
1161*
1162 9999 FORMAT( A )
1163 9998 FORMAT( ' Number of values of ',5A, ' is less than 1 or greater ',
1164 $ 'than ', I2 )
1165 9997 FORMAT( ' Illegal input in file ',40A,'. Aborting run.' )
1166 9996 FORMAT( A7, L2 )
1167 9995 FORMAT( ' Subprogram name ', A7, ' not recognized',
1168 $ /' ******* TESTS ABANDONED *******' )
1169 9994 FORMAT( 2X, 'Alpha : (', G16.6,
1170 $ ',', G16.6, ')' )
1171 9993 FORMAT( 2X, 'Number of Tests : ', I6 )
1172 9992 FORMAT( 2X, 'Number of process grids : ', I6 )
1173 9991 FORMAT( 2X, ' : ', 5I6 )
1174 9990 FORMAT( 2X, A1, ' : ', 5I6 )
1175 9989 FORMAT( 2X, 'Routines to be tested : ', A, A8 )
1176 9988 FORMAT( 2X, ' ', A, A8 )
1177*
1178* End of PZBLA1TIMINFO
1179*
end diagonal values have been computed in the(sparse) matrix id.SOL
#define alpha
Definition eval.h:35
subroutine icopy(n, sx, incx, sy, incy)
ICOPY
Definition icopy.f:75
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1072
subroutine blacs_gridinit(cntxt, c, nprow, npcol)
Definition mpi.f:745
subroutine zgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1092
subroutine zgebs2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1051
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
Definition mpi.f:1113
subroutine blacs_gridexit(cntxt)
Definition mpi.f:762