889
890
891
892
893
894
895
896 INTEGER IA, JA, M, N
897
898
899 INTEGER DESCA( * ), IPIV( * )
900 COMPLEX*16 A( * )
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
1000 $ LLD_, MB_, M_, NB_, N_, RSRC_
1001 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
1002 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
1003 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
1004
1005
1006 INTEGER IACOL, ICOFFA, ICTXT, IITMP, IPVT, IPCOL,
1007 $ IPROW, ITMP, J, JJ, JJA, KK, MYCOL, MYROW,
1008 $ NPCOL, NPROW, NQ
1009
1010
1011 EXTERNAL blacs_gridinfo, igebr2d, igebs2d, igerv2d,
1012 $ igesd2d, igamn2d,
infog1l, pzswap
1013
1014
1015 INTEGER INDXL2G, NUMROC
1017
1018
1020
1021
1022
1023
1024
1025 ictxt = desca( ctxt_ )
1026 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
1027 CALL infog1l( ja, desca( nb_ ), npcol, mycol, desca( csrc_ ), jja,
1028 $ iacol )
1029 icoffa = mod( ja-1, desca( nb_ ) )
1030 nq =
numroc( n+icoffa, desca( nb_ ), mycol, iacol, npcol )
1031 IF( mycol.EQ.iacol )
1032 $ nq = nq - icoffa
1033
1034 DO 20 j = ja, ja+n-2
1035
1036 ipvt = ja+n-1
1037 itmp = ja+n
1038
1039
1040
1041 CALL infog1l( j, desca( nb_ ), npcol, mycol, desca( csrc_ ),
1042 $ jj, iacol )
1043 DO 10 kk = jj, jja+nq-1
1044 IF( ipiv( kk ).LT.ipvt )THEN
1045 iitmp = kk
1046 ipvt = ipiv( kk )
1047 END IF
1048 10 CONTINUE
1049
1050
1051
1052 CALL igamn2d( ictxt, 'Rowwise', ' ', 1, 1, ipvt, 1, iprow,
1053 $ ipcol, 1, -1, mycol )
1054
1055
1056
1057 IF( mycol.EQ.ipcol ) THEN
1058 itmp =
indxl2g( iitmp, desca( nb_ ), mycol, desca( csrc_ ),
1059 $ npcol )
1060 CALL igebs2d( ictxt, 'Rowwise', ' ', 1, 1, itmp, 1 )
1061 IF( ipcol.NE.iacol ) THEN
1062 CALL igerv2d( ictxt, 1, 1, ipiv( iitmp ), 1, myrow,
1063 $ iacol )
1064 ELSE
1065 IF( mycol.EQ.iacol )
1066 $ ipiv( iitmp ) = ipiv( jj )
1067 END IF
1068 ELSE
1069 CALL igebr2d( ictxt, 'Rowwise', ' ', 1, 1, itmp, 1, myrow,
1070 $ ipcol )
1071 IF( mycol.EQ.iacol .AND. ipcol.NE.iacol )
1072 $ CALL igesd2d( ictxt, 1, 1, ipiv( jj ), 1, myrow, ipcol )
1073 END IF
1074
1075
1076
1077 CALL pzswap( m, a, ia, itmp, desca, 1, a, ia, j, desca, 1 )
1078
1079 20 CONTINUE
1080
1081
1082
integer function indxl2g(indxloc, nb, iproc, isrcproc, nprocs)
subroutine infog1l(gindx, nb, nprocs, myroc, isrcproc, lindx, rocsrc)
integer function numroc(n, nb, iproc, isrcproc, nprocs)