SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
All Classes Files Functions Variables Typedefs Macros

◆ psbla1timinfo()

subroutine psbla1timinfo ( 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,
real  alpha,
integer, dimension( * )  work 
)

Definition at line 543 of file psblas1tim.f.

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