├── .github └── workflows │ ├── cmake.yml │ └── make.yml ├── .gitignore ├── BLACS ├── CMakeLists.txt ├── INSTALL │ ├── CMakeLists.txt │ ├── Cintface.c │ ├── Fintface.f │ ├── Makefile_install │ ├── README │ ├── cmpi_sane.c │ ├── fmpi_sane.f │ ├── mpif.h │ ├── size.c │ ├── syserrors.c │ ├── tc_UseMpich.c │ ├── tc_cCsameF77.c │ └── tc_fCsameF77.f ├── Makefile ├── SRC │ ├── BI_Arecv.c │ ├── BI_ArgCheck.c │ ├── BI_Asend.c │ ├── BI_BeComb.c │ ├── BI_BlacsAbort.c │ ├── BI_BlacsErr.c │ ├── BI_BlacsWarn.c │ ├── BI_BuffIsFree.c │ ├── BI_ContxtNum.c │ ├── BI_EmergencyBuff.c │ ├── BI_GetBuff.c │ ├── BI_GetMpiGeType.c │ ├── BI_GetMpiTrType.c │ ├── BI_GlobalVars.c │ ├── BI_HypBR.c │ ├── BI_HypBS.c │ ├── BI_IdringBR.c │ ├── BI_IdringBS.c │ ├── BI_MpathBR.c │ ├── BI_MpathBS.c │ ├── BI_MringComb.c │ ├── BI_Pack.c │ ├── BI_Rsend.c │ ├── BI_Srecv.c │ ├── BI_SringBR.c │ ├── BI_SringBS.c │ ├── BI_Ssend.c │ ├── BI_TransDist.c │ ├── BI_TransUserComm.c │ ├── BI_TreeBR.c │ ├── BI_TreeBS.c │ ├── BI_TreeComb.c │ ├── BI_Unpack.c │ ├── BI_UpdateBuffs.c │ ├── BI_cMPI_amn.c │ ├── BI_cMPI_amn2.c │ ├── BI_cMPI_amx.c │ ├── BI_cMPI_amx2.c │ ├── BI_cMPI_sum.c │ ├── BI_cvvamn.c │ ├── BI_cvvamn2.c │ ├── BI_cvvamx.c │ ├── BI_cvvamx2.c │ ├── BI_cvvsum.c │ ├── BI_dMPI_amn.c │ ├── BI_dMPI_amn2.c │ ├── BI_dMPI_amx.c │ ├── BI_dMPI_amx2.c │ ├── BI_dmvcopy.c │ ├── BI_dvmcopy.c │ ├── BI_dvvamn.c │ ├── BI_dvvamn2.c │ ├── BI_dvvamx.c │ ├── BI_dvvamx2.c │ ├── BI_dvvsum.c │ ├── BI_iMPI_amn.c │ ├── BI_iMPI_amn2.c │ ├── BI_iMPI_amx.c │ ├── BI_iMPI_amx2.c │ ├── BI_imvcopy.c │ ├── BI_ivmcopy.c │ ├── BI_ivvamn.c │ ├── BI_ivvamn2.c │ ├── BI_ivvamx.c │ ├── BI_ivvamx2.c │ ├── BI_ivvsum.c │ ├── BI_sMPI_amn.c │ ├── BI_sMPI_amn2.c │ ├── BI_sMPI_amx.c │ ├── BI_sMPI_amx2.c │ ├── BI_smvcopy.c │ ├── BI_svmcopy.c │ ├── BI_svvamn.c │ ├── BI_svvamn2.c │ ├── BI_svvamx.c │ ├── BI_svvamx2.c │ ├── BI_svvsum.c │ ├── BI_zMPI_amn.c │ ├── BI_zMPI_amn2.c │ ├── BI_zMPI_amx.c │ ├── BI_zMPI_amx2.c │ ├── BI_zMPI_sum.c │ ├── BI_zvvamn.c │ ├── BI_zvvamn2.c │ ├── BI_zvvamx.c │ ├── BI_zvvamx2.c │ ├── BI_zvvsum.c │ ├── Bconfig.h │ ├── Bdef.h │ ├── CMakeLists.txt │ ├── Makefile │ ├── blacs2sys_.c │ ├── blacs_abort_.c │ ├── blacs_barr_.c │ ├── blacs_exit_.c │ ├── blacs_free_.c │ ├── blacs_get_.c │ ├── blacs_grid_.c │ ├── blacs_info_.c │ ├── blacs_init_.c │ ├── blacs_map_.c │ ├── blacs_pcoord_.c │ ├── blacs_pinfo_.c │ ├── blacs_pnum_.c │ ├── blacs_set_.c │ ├── blacs_setup_.c │ ├── cgamn2d_.c │ ├── cgamx2d_.c │ ├── cgebr2d_.c │ ├── cgebs2d_.c │ ├── cgerv2d_.c │ ├── cgesd2d_.c │ ├── cgsum2d_.c │ ├── ctrbr2d_.c │ ├── ctrbs2d_.c │ ├── ctrrv2d_.c │ ├── ctrsd2d_.c │ ├── dcputime00_.c │ ├── dgamn2d_.c │ ├── dgamx2d_.c │ ├── dgebr2d_.c │ ├── dgebs2d_.c │ ├── dgerv2d_.c │ ├── dgesd2d_.c │ ├── dgsum2d_.c │ ├── dtrbr2d_.c │ ├── dtrbs2d_.c │ ├── dtrrv2d_.c │ ├── dtrsd2d_.c │ ├── dwalltime00_.c │ ├── free_handle_.c │ ├── igamn2d_.c │ ├── igamx2d_.c │ ├── igebr2d_.c │ ├── igebs2d_.c │ ├── igerv2d_.c │ ├── igesd2d_.c │ ├── igsum2d_.c │ ├── itrbr2d_.c │ ├── itrbs2d_.c │ ├── itrrv2d_.c │ ├── itrsd2d_.c │ ├── kbrid_.c │ ├── kbsid_.c │ ├── krecvid_.c │ ├── ksendid_.c │ ├── sgamn2d_.c │ ├── sgamx2d_.c │ ├── sgebr2d_.c │ ├── sgebs2d_.c │ ├── sgerv2d_.c │ ├── sgesd2d_.c │ ├── sgsum2d_.c │ ├── src-C.c.in │ ├── strbr2d_.c │ ├── strbs2d_.c │ ├── strrv2d_.c │ ├── strsd2d_.c │ ├── sys2blacs_.c │ ├── zgamn2d_.c │ ├── zgamx2d_.c │ ├── zgebr2d_.c │ ├── zgebs2d_.c │ ├── zgerv2d_.c │ ├── zgesd2d_.c │ ├── zgsum2d_.c │ ├── ztrbr2d_.c │ ├── ztrbs2d_.c │ ├── ztrrv2d_.c │ └── ztrsd2d_.c └── TESTING │ ├── CMakeLists.txt │ ├── Cbt.c │ ├── Cbt.h │ ├── Makefile │ ├── README │ ├── blacstest.f │ ├── bsbr.dat │ ├── bt.dat │ ├── btprim.f │ ├── comb.dat │ ├── runtest.cmake │ ├── sdrv.dat │ └── tools.f ├── CMAKE ├── CheckBLACSCompilerFlags.cmake ├── FortranMangling.cmake ├── scalapack-config-build.cmake.in ├── scalapack-config-install.cmake.in └── scalapack-config-version.cmake.in ├── CMakeLists.txt ├── EXAMPLE ├── CSCAEXMAT.dat ├── CSCAEXRHS.dat ├── DSCAEXMAT.dat ├── DSCAEXRHS.dat ├── Makefile ├── SCAEX.dat ├── SSCAEXMAT.dat ├── SSCAEXRHS.dat ├── ZSCAEXMAT.dat ├── ZSCAEXRHS.dat ├── pcscaex.f ├── pdscaex.f ├── pdscaexinfo.f ├── psscaex.f └── pzscaex.f ├── LICENSE ├── Makefile ├── PBLAS ├── CMakeLists.txt ├── SRC │ ├── CMakeLists.txt │ ├── Makefile │ ├── PBBLAS │ │ ├── CMakeLists.txt │ │ ├── Makefile │ │ ├── pbcmatadd.f │ │ ├── pbctran.f │ │ ├── pbctrget.f │ │ ├── pbctrnv.f │ │ ├── pbctrsrt.f │ │ ├── pbctrst1.f │ │ ├── pbcvecadd.f │ │ ├── pbdmatadd.f │ │ ├── pbdtran.f │ │ ├── pbdtrget.f │ │ ├── pbdtrnv.f │ │ ├── pbdtrsrt.f │ │ ├── pbdtrst1.f │ │ ├── pbdvecadd.f │ │ ├── pbsmatadd.f │ │ ├── pbstran.f │ │ ├── pbstrget.f │ │ ├── pbstrnv.f │ │ ├── pbstrsrt.f │ │ ├── pbstrst1.f │ │ ├── pbsvecadd.f │ │ ├── pbzmatadd.f │ │ ├── pbztran.f │ │ ├── pbztrget.f │ │ ├── pbztrnv.f │ │ ├── pbztrsrt.f │ │ ├── pbztrst1.f │ │ └── pbzvecadd.f │ ├── PBblacs.h │ ├── PBblas.h │ ├── PBpblas.h │ ├── PBtools.h │ ├── PTOOLS │ │ ├── CMakeLists.txt │ │ ├── Makefile │ │ ├── PB_CGatherV.c │ │ ├── PB_CInOutV.c │ │ ├── PB_CInOutV2.c │ │ ├── PB_CInV.c │ │ ├── PB_CInV2.c │ │ ├── PB_COutV.c │ │ ├── PB_CScatterV.c │ │ ├── PB_CVMcontig.c │ │ ├── PB_CVMinit.c │ │ ├── PB_CVMloc.c │ │ ├── PB_CVMnpq.c │ │ ├── PB_CVMpack.c │ │ ├── PB_CVMswp.c │ │ ├── PB_CVMupdate.c │ │ ├── PB_Cabort.c │ │ ├── PB_Cainfog2l.c │ │ ├── PB_CargFtoC.c │ │ ├── PB_Cbinfo.c │ │ ├── PB_Cchkmat.c │ │ ├── PB_Cchkvec.c │ │ ├── PB_Cconjg.c │ │ ├── PB_Cctypeset.c │ │ ├── PB_Cdescribe.c │ │ ├── PB_Cdescset.c │ │ ├── PB_Cdtypeset.c │ │ ├── PB_Cfirstnb.c │ │ ├── PB_Cg2lrem.c │ │ ├── PB_Cgcd.c │ │ ├── PB_Cgetbuf.c │ │ ├── PB_Cindxg2p.c │ │ ├── PB_Cinfog2l.c │ │ ├── PB_Citypeset.c │ │ ├── PB_Clastnb.c │ │ ├── PB_Clcm.c │ │ ├── PB_Cmalloc.c │ │ ├── PB_Cnnxtroc.c │ │ ├── PB_Cnpreroc.c │ │ ├── PB_Cnumroc.c │ │ ├── PB_Cpaxpby.c │ │ ├── PB_CpaxpbyDN.c │ │ ├── PB_CpaxpbyND.c │ │ ├── PB_CpaxpbyNN.c │ │ ├── PB_Cpdot11.c │ │ ├── PB_CpdotND.c │ │ ├── PB_CpdotNN.c │ │ ├── PB_Cpgeadd.c │ │ ├── PB_CpgemmAB.c │ │ ├── PB_CpgemmAC.c │ │ ├── PB_CpgemmBC.c │ │ ├── PB_Cplacnjg.c │ │ ├── PB_Cplapad.c │ │ ├── PB_Cplapd2.c │ │ ├── PB_Cplaprnt.c │ │ ├── PB_Cplasca2.c │ │ ├── PB_Cplascal.c │ │ ├── PB_CpswapND.c │ │ ├── PB_CpswapNN.c │ │ ├── PB_Cpsym.c │ │ ├── PB_CpsymmAB.c │ │ ├── PB_CpsymmBC.c │ │ ├── PB_Cpsyr.c │ │ ├── PB_Cpsyr2.c │ │ ├── PB_Cpsyr2kA.c │ │ ├── PB_Cpsyr2kAC.c │ │ ├── PB_CpsyrkA.c │ │ ├── PB_CpsyrkAC.c │ │ ├── PB_Cptradd.c │ │ ├── PB_Cptran.c │ │ ├── PB_Cptrm.c │ │ ├── PB_CptrmmAB.c │ │ ├── PB_CptrmmB.c │ │ ├── PB_Cptrsm.c │ │ ├── PB_CptrsmAB.c │ │ ├── PB_CptrsmAB0.c │ │ ├── PB_CptrsmAB1.c │ │ ├── PB_CptrsmB.c │ │ ├── PB_Cptrsv.c │ │ ├── PB_Cspan.c │ │ ├── PB_Cstypeset.c │ │ ├── PB_Ctop.c │ │ ├── PB_Ctzahemv.c │ │ ├── PB_Ctzasymv.c │ │ ├── PB_Ctzatrmv.c │ │ ├── PB_Ctzhemm.c │ │ ├── PB_Ctzhemv.c │ │ ├── PB_Ctzher.c │ │ ├── PB_Ctzher2.c │ │ ├── PB_Ctzher2k.c │ │ ├── PB_Ctzherk.c │ │ ├── PB_Ctzsymm.c │ │ ├── PB_Ctzsymv.c │ │ ├── PB_Ctzsyr.c │ │ ├── PB_Ctzsyr2.c │ │ ├── PB_Ctzsyr2k.c │ │ ├── PB_Ctzsyrk.c │ │ ├── PB_Ctztrmm.c │ │ ├── PB_Ctztrmv.c │ │ ├── PB_Cwarn.c │ │ ├── PB_Cztypeset.c │ │ ├── PB_freebuf_.c │ │ ├── PB_topget_.c │ │ └── PB_topset_.c │ ├── PTZBLAS │ │ ├── CMakeLists.txt │ │ ├── Makefile │ │ ├── cagemv.f │ │ ├── cahemv.f │ │ ├── casymv.f │ │ ├── catrmv.f │ │ ├── ccshft.f │ │ ├── chescal.f │ │ ├── cmmadd.f │ │ ├── cmmcadd.f │ │ ├── cmmdda.f │ │ ├── cmmddac.f │ │ ├── cmmddact.f │ │ ├── cmmddat.f │ │ ├── cmmtadd.f │ │ ├── cmmtcadd.f │ │ ├── crshft.f │ │ ├── cset.f │ │ ├── csymv.f │ │ ├── csyr.f │ │ ├── csyr2.f │ │ ├── ctzcnjg.f │ │ ├── ctzpad.f │ │ ├── ctzpadcpy.f │ │ ├── ctzscal.f │ │ ├── cvvdotc.f │ │ ├── cvvdotu.f │ │ ├── dagemv.f │ │ ├── dascal.f │ │ ├── dasqrtb.f │ │ ├── dasymv.f │ │ ├── datrmv.f │ │ ├── dcshft.f │ │ ├── dmmadd.f │ │ ├── dmmcadd.f │ │ ├── dmmdda.f │ │ ├── dmmddac.f │ │ ├── dmmddact.f │ │ ├── dmmddat.f │ │ ├── dmmtadd.f │ │ ├── dmmtcadd.f │ │ ├── drshft.f │ │ ├── dset.f │ │ ├── dtzpad.f │ │ ├── dtzpadcpy.f │ │ ├── dtzscal.f │ │ ├── dvasum.f │ │ ├── dvvdot.f │ │ ├── dzvasum.f │ │ ├── immadd.f │ │ ├── immdda.f │ │ ├── immddat.f │ │ ├── immtadd.f │ │ ├── pxerbla.f │ │ ├── sagemv.f │ │ ├── sascal.f │ │ ├── sasqrtb.f │ │ ├── sasymv.f │ │ ├── satrmv.f │ │ ├── scshft.f │ │ ├── scvasum.f │ │ ├── smmadd.f │ │ ├── smmcadd.f │ │ ├── smmdda.f │ │ ├── smmddac.f │ │ ├── smmddact.f │ │ ├── smmddat.f │ │ ├── smmtadd.f │ │ ├── smmtcadd.f │ │ ├── srshft.f │ │ ├── sset.f │ │ ├── stzpad.f │ │ ├── stzpadcpy.f │ │ ├── stzscal.f │ │ ├── svasum.f │ │ ├── svvdot.f │ │ ├── zagemv.f │ │ ├── zahemv.f │ │ ├── zasymv.f │ │ ├── zatrmv.f │ │ ├── zcshft.f │ │ ├── zhescal.f │ │ ├── zmmadd.f │ │ ├── zmmcadd.f │ │ ├── zmmdda.f │ │ ├── zmmddac.f │ │ ├── zmmddact.f │ │ ├── zmmddat.f │ │ ├── zmmtadd.f │ │ ├── zmmtcadd.f │ │ ├── zrshft.f │ │ ├── zset.f │ │ ├── zsymv.f │ │ ├── zsyr.f │ │ ├── zsyr2.f │ │ ├── ztzcnjg.f │ │ ├── ztzpad.f │ │ ├── ztzpadcpy.f │ │ ├── ztzscal.f │ │ ├── zvvdotc.f │ │ └── zvvdotu.f │ ├── pblas.h │ ├── pcagemv_.c │ ├── pcahemv_.c │ ├── pcamax_.c │ ├── pcatrmv_.c │ ├── pcaxpy_.c │ ├── pccopy_.c │ ├── pcdotc_.c │ ├── pcdotu_.c │ ├── pcgeadd_.c │ ├── pcgemm_.c │ ├── pcgemv_.c │ ├── pcgerc_.c │ ├── pcgeru_.c │ ├── pchemm_.c │ ├── pchemv_.c │ ├── pcher2_.c │ ├── pcher2k_.c │ ├── pcher_.c │ ├── pcherk_.c │ ├── pcscal_.c │ ├── pcsscal_.c │ ├── pcswap_.c │ ├── pcsymm_.c │ ├── pcsyr2k_.c │ ├── pcsyrk_.c │ ├── pctradd_.c │ ├── pctranc_.c │ ├── pctranu_.c │ ├── pctrmm_.c │ ├── pctrmv_.c │ ├── pctrsm_.c │ ├── pctrsv_.c │ ├── pdagemv_.c │ ├── pdamax_.c │ ├── pdasum_.c │ ├── pdasymv_.c │ ├── pdatrmv_.c │ ├── pdaxpy_.c │ ├── pdcopy_.c │ ├── pddot_.c │ ├── pdgeadd_.c │ ├── pdgemm_.c │ ├── pdgemv_.c │ ├── pdger_.c │ ├── pdnrm2_.c │ ├── pdscal_.c │ ├── pdswap_.c │ ├── pdsymm_.c │ ├── pdsymv_.c │ ├── pdsyr2_.c │ ├── pdsyr2k_.c │ ├── pdsyr_.c │ ├── pdsyrk_.c │ ├── pdtradd_.c │ ├── pdtran_.c │ ├── pdtrmm_.c │ ├── pdtrmv_.c │ ├── pdtrsm_.c │ ├── pdtrsv_.c │ ├── pdzasum_.c │ ├── pdznrm2_.c │ ├── picopy_.c │ ├── pilaenv.f │ ├── psagemv_.c │ ├── psamax_.c │ ├── psasum_.c │ ├── psasymv_.c │ ├── psatrmv_.c │ ├── psaxpy_.c │ ├── pscasum_.c │ ├── pscnrm2_.c │ ├── pscopy_.c │ ├── psdot_.c │ ├── psgeadd_.c │ ├── psgemm_.c │ ├── psgemv_.c │ ├── psger_.c │ ├── psnrm2_.c │ ├── psscal_.c │ ├── psswap_.c │ ├── pssymm_.c │ ├── pssymv_.c │ ├── pssyr2_.c │ ├── pssyr2k_.c │ ├── pssyr_.c │ ├── pssyrk_.c │ ├── pstradd_.c │ ├── pstran_.c │ ├── pstrmm_.c │ ├── pstrmv_.c │ ├── pstrsm_.c │ ├── pstrsv_.c │ ├── pzagemv_.c │ ├── pzahemv_.c │ ├── pzamax_.c │ ├── pzatrmv_.c │ ├── pzaxpy_.c │ ├── pzcopy_.c │ ├── pzdotc_.c │ ├── pzdotu_.c │ ├── pzdscal_.c │ ├── pzgeadd_.c │ ├── pzgemm_.c │ ├── pzgemv_.c │ ├── pzgerc_.c │ ├── pzgeru_.c │ ├── pzhemm_.c │ ├── pzhemv_.c │ ├── pzher2_.c │ ├── pzher2k_.c │ ├── pzher_.c │ ├── pzherk_.c │ ├── pzscal_.c │ ├── pzswap_.c │ ├── pzsymm_.c │ ├── pzsyr2k_.c │ ├── pzsyrk_.c │ ├── pztradd_.c │ ├── pztranc_.c │ ├── pztranu_.c │ ├── pztrmm_.c │ ├── pztrmv_.c │ ├── pztrsm_.c │ └── pztrsv_.c ├── TESTING │ ├── CMakeLists.txt │ ├── Makefile │ ├── PCBLAS1TST.dat │ ├── PCBLAS2TST.dat │ ├── PCBLAS3TST.dat │ ├── PDBLAS1TST.dat │ ├── PDBLAS2TST.dat │ ├── PDBLAS3TST.dat │ ├── PSBLAS1TST.dat │ ├── PSBLAS2TST.dat │ ├── PSBLAS3TST.dat │ ├── PZBLAS1TST.dat │ ├── PZBLAS2TST.dat │ ├── PZBLAS3TST.dat │ ├── dlamch.f │ ├── pblastst.f │ ├── pcblas1tst.f │ ├── pcblas2tst.f │ ├── pcblas3tst.f │ ├── pcblastst.f │ ├── pdblas1tst.f │ ├── pdblas2tst.f │ ├── pdblas3tst.f │ ├── pdblastst.f │ ├── psblas1tst.f │ ├── psblas2tst.f │ ├── psblas3tst.f │ ├── psblastst.f │ ├── pzblas1tst.f │ ├── pzblas2tst.f │ ├── pzblas3tst.f │ ├── pzblastst.f │ └── slamch.f └── TIMING │ ├── CMakeLists.txt │ ├── Makefile │ ├── PCBLAS1TIM.dat │ ├── PCBLAS2TIM.dat │ ├── PCBLAS3TIM.dat │ ├── PDBLAS1TIM.dat │ ├── PDBLAS2TIM.dat │ ├── PDBLAS3TIM.dat │ ├── PSBLAS1TIM.dat │ ├── PSBLAS2TIM.dat │ ├── PSBLAS3TIM.dat │ ├── PZBLAS1TIM.dat │ ├── PZBLAS2TIM.dat │ ├── PZBLAS3TIM.dat │ ├── pblastim.f │ ├── pcblas1tim.f │ ├── pcblas2tim.f │ ├── pcblas3tim.f │ ├── pcblastim.f │ ├── pdblas1tim.f │ ├── pdblas2tim.f │ ├── pdblas3tim.f │ ├── pdblastim.f │ ├── psblas1tim.f │ ├── psblas2tim.f │ ├── psblas3tim.f │ ├── psblastim.f │ ├── pzblas1tim.f │ ├── pzblas2tim.f │ ├── pzblas3tim.f │ └── pzblastim.f ├── README ├── REDIST ├── CMakeLists.txt ├── SRC │ ├── CMakeLists.txt │ ├── Makefile │ ├── pcgemr.c │ ├── pcgemr2.c │ ├── pctrmr.c │ ├── pctrmr2.c │ ├── pdgemr.c │ ├── pdgemr2.c │ ├── pdtrmr.c │ ├── pdtrmr2.c │ ├── pgemraux.c │ ├── pigemr.c │ ├── pigemr2.c │ ├── pitrmr.c │ ├── pitrmr2.c │ ├── psgemr.c │ ├── psgemr2.c │ ├── pstrmr.c │ ├── pstrmr2.c │ ├── pzgemr.c │ ├── pzgemr2.c │ ├── pztrmr.c │ ├── pztrmr2.c │ └── redist.h └── TESTING │ ├── CMakeLists.txt │ ├── GEMR2D.dat │ ├── Makefile │ ├── TRMR2D.dat │ ├── pcgemrdrv.c │ ├── pctrmrdrv.c │ ├── pdgemrdrv.c │ ├── pdtrmrdrv.c │ ├── pigemrdrv.c │ ├── pitrmrdrv.c │ ├── psgemrdrv.c │ ├── pstrmrdrv.c │ ├── pzgemrdrv.c │ ├── pztrmrdrv.c │ └── redist.h ├── SLmake.inc.example ├── SRC ├── CMakeLists.txt ├── Makefile ├── bdlaapp.f ├── bdlaexc.f ├── bdtrexc.f ├── bslaapp.f ├── bslaexc.f ├── bstrexc.f ├── cdbtf2.f ├── cdbtrf.f ├── cdttrf.f ├── cdttrsv.f ├── clahqr2.f ├── clamov.c ├── clamsh.f ├── clanv2.f ├── claref.f ├── cpttrsv.f ├── csteqr2.f ├── ctrmvt.f ├── ddbtf2.f ├── ddbtrf.f ├── ddttrf.f ├── ddttrsv.f ├── dlamov.c ├── dlamsh.f ├── dlapst.f ├── dlaqr6.f ├── dlar1va.f ├── dlaref.f ├── dlarrb2.f ├── dlarrd2.f ├── dlarre2.f ├── dlarre2a.f ├── dlarrf2.f ├── dlarrv2.f ├── dlasorte.f ├── dlasrt2.f ├── dpttrsv.f ├── dstegr2.f ├── dstegr2a.f ├── dstegr2b.f ├── dstein2.f ├── dsteqr2.f ├── dtrmvt.f ├── getpbbuf.c ├── lamov.h ├── pbchkvect.c ├── pblas.h ├── pcdbsv.f ├── pcdbtrf.f ├── pcdbtrs.f ├── pcdbtrsv.f ├── pcdtsv.f ├── pcdttrf.f ├── pcdttrs.f ├── pcdttrsv.f ├── pcgbsv.f ├── pcgbtrf.f ├── pcgbtrs.f ├── pcgebd2.f ├── pcgebrd.f ├── pcgecon.f ├── pcgeequ.f ├── pcgehd2.f ├── pcgehrd.f ├── pcgelq2.f ├── pcgelqf.f ├── pcgels.f ├── pcgeql2.f ├── pcgeqlf.f ├── pcgeqpf.f ├── pcgeqr2.f ├── pcgeqrf.f ├── pcgerfs.f ├── pcgerq2.f ├── pcgerqf.f ├── pcgesv.f ├── pcgesvd.f ├── pcgesvx.f ├── pcgetf2.f ├── pcgetrf.f ├── pcgetri.f ├── pcgetrs.f ├── pcggqrf.f ├── pcggrqf.f ├── pcheev.f ├── pcheevd.f ├── pcheevr.f ├── pcheevx.f ├── pchegs2.f ├── pchegst.f ├── pchegvx.f ├── pchengst.f ├── pchentrd.f ├── pchetd2.f ├── pchetrd.f ├── pchettrd.f ├── pclabrd.f ├── pclacgv.f ├── pclacon.f ├── pclaconsb.f ├── pclacp2.f ├── pclacp3.f ├── pclacpy.f ├── pclaevswp.f ├── pclahqr.f ├── pclahrd.f ├── pclamr1d.f ├── pclange.f ├── pclanhe.f ├── pclanhs.f ├── pclansy.f ├── pclantr.f ├── pclapiv.f ├── pclapv2.f ├── pclaqge.f ├── pclaqsy.f ├── pclarf.f ├── pclarfb.f ├── pclarfc.f ├── pclarfg.f ├── pclarft.f ├── pclarz.f ├── pclarzb.f ├── pclarzc.f ├── pclarzt.f ├── pclascl.f ├── pclase2.f ├── pclaset.f ├── pclasmsub.f ├── pclassq.f ├── pclaswp.f ├── pclatra.f ├── pclatrd.f ├── pclatrs.f ├── pclatrz.f ├── pclattrs.f ├── pclauu2.f ├── pclauum.f ├── pclawil.f ├── pcmax1.f ├── pcpbsv.f ├── pcpbtrf.f ├── pcpbtrs.f ├── pcpbtrsv.f ├── pcpocon.f ├── pcpoequ.f ├── pcporfs.f ├── pcposv.f ├── pcposvx.f ├── pcpotf2.f ├── pcpotrf.f ├── pcpotri.f ├── pcpotrs.f ├── pcptsv.f ├── pcpttrf.f ├── pcpttrs.f ├── pcpttrsv.f ├── pcrot.c ├── pcsrscl.f ├── pcstein.f ├── pctrcon.f ├── pctrevc.f ├── pctrrfs.f ├── pctrti2.f ├── pctrtri.f ├── pctrtrs.f ├── pctzrzf.f ├── pcung2l.f ├── pcung2r.f ├── pcungl2.f ├── pcunglq.f ├── pcungql.f ├── pcungqr.f ├── pcungr2.f ├── pcungrq.f ├── pcunm2l.f ├── pcunm2r.f ├── pcunmbr.f ├── pcunmhr.f ├── pcunml2.f ├── pcunmlq.f ├── pcunmql.f ├── pcunmqr.f ├── pcunmr2.f ├── pcunmr3.f ├── pcunmrq.f ├── pcunmrz.f ├── pcunmtr.f ├── pddbsv.f ├── pddbtrf.f ├── pddbtrs.f ├── pddbtrsv.f ├── pddtsv.f ├── pddttrf.f ├── pddttrs.f ├── pddttrsv.f ├── pdgbsv.f ├── pdgbtrf.f ├── pdgbtrs.f ├── pdgebal.f ├── pdgebd2.f ├── pdgebrd.f ├── pdgecon.f ├── pdgeequ.f ├── pdgehd2.f ├── pdgehrd.f ├── pdgelq2.f ├── pdgelqf.f ├── pdgels.f ├── pdgeql2.f ├── pdgeqlf.f ├── pdgeqpf.f ├── pdgeqr2.f ├── pdgeqrf.f ├── pdgerfs.f ├── pdgerq2.f ├── pdgerqf.f ├── pdgesv.f ├── pdgesvd.f ├── pdgesvx.f ├── pdgetf2.f ├── pdgetrf.f ├── pdgetri.f ├── pdgetrs.f ├── pdggqrf.f ├── pdggrqf.f ├── pdhseqr.f ├── pdlabad.f ├── pdlabrd.f ├── pdlacon.f ├── pdlaconsb.f ├── pdlacp2.f ├── pdlacp3.f ├── pdlacpy.f ├── pdlaed0.f ├── pdlaed1.f ├── pdlaed2.f ├── pdlaed3.f ├── pdlaedz.f ├── pdlaevswp.f ├── pdlahqr.f ├── pdlahrd.f ├── pdlaiect.c ├── pdlamch.f ├── pdlamr1d.f ├── pdlamve.f ├── pdlange.f ├── pdlanhs.f ├── pdlansy.f ├── pdlantr.f ├── pdlapiv.f ├── pdlapv2.f ├── pdlaqge.f ├── pdlaqr0.f ├── pdlaqr1.f ├── pdlaqr2.f ├── pdlaqr3.f ├── pdlaqr4.f ├── pdlaqr5.f ├── pdlaqsy.f ├── pdlared1d.f ├── pdlared2d.f ├── pdlarf.f ├── pdlarfb.f ├── pdlarfg.f ├── pdlarft.f ├── pdlarz.f ├── pdlarzb.f ├── pdlarzt.f ├── pdlascl.f ├── pdlase2.f ├── pdlaset.f ├── pdlasmsub.f ├── pdlasrt.f ├── pdlassq.f ├── pdlaswp.f ├── pdlatra.f ├── pdlatrd.f ├── pdlatrs.f ├── pdlatrz.f ├── pdlauu2.f ├── pdlauum.f ├── pdlawil.f ├── pdorg2l.f ├── pdorg2r.f ├── pdorgl2.f ├── pdorglq.f ├── pdorgql.f ├── pdorgqr.f ├── pdorgr2.f ├── pdorgrq.f ├── pdorm2l.f ├── pdorm2r.f ├── pdormbr.f ├── pdormhr.f ├── pdorml2.f ├── pdormlq.f ├── pdormql.f ├── pdormqr.f ├── pdormr2.f ├── pdormr3.f ├── pdormrq.f ├── pdormrz.f ├── pdormtr.f ├── pdpbsv.f ├── pdpbtrf.f ├── pdpbtrs.f ├── pdpbtrsv.f ├── pdpocon.f ├── pdpoequ.f ├── pdporfs.f ├── pdposv.f ├── pdposvx.f ├── pdpotf2.f ├── pdpotrf.f ├── pdpotri.f ├── pdpotrs.f ├── pdptsv.f ├── pdpttrf.f ├── pdpttrs.f ├── pdpttrsv.f ├── pdrot.f ├── pdrscl.f ├── pdstebz.f ├── pdstedc.f ├── pdstein.f ├── pdsyev.f ├── pdsyevd.f ├── pdsyevr.f ├── pdsyevx.f ├── pdsygs2.f ├── pdsygst.f ├── pdsygvx.f ├── pdsyngst.f ├── pdsyntrd.f ├── pdsytd2.f ├── pdsytrd.f ├── pdsyttrd.f ├── pdtrcon.f ├── pdtrord.f ├── pdtrrfs.f ├── pdtrsen.f ├── pdtrti2.f ├── pdtrtri.f ├── pdtrtrs.f ├── pdtzrzf.f ├── pdzsum1.f ├── pilaenvx.f ├── pilaver.f ├── piparmq.f ├── pjlaenv.f ├── pmpcol.f ├── pmpim2.f ├── pscsum1.f ├── psdbsv.f ├── psdbtrf.f ├── psdbtrs.f ├── psdbtrsv.f ├── psdtsv.f ├── psdttrf.f ├── psdttrs.f ├── psdttrsv.f ├── psgbsv.f ├── psgbtrf.f ├── psgbtrs.f ├── psgebal.f ├── psgebd2.f ├── psgebrd.f ├── psgecon.f ├── psgeequ.f ├── psgehd2.f ├── psgehrd.f ├── psgelq2.f ├── psgelqf.f ├── psgels.f ├── psgeql2.f ├── psgeqlf.f ├── psgeqpf.f ├── psgeqr2.f ├── psgeqrf.f ├── psgerfs.f ├── psgerq2.f ├── psgerqf.f ├── psgesv.f ├── psgesvd.f ├── psgesvx.f ├── psgetf2.f ├── psgetrf.f ├── psgetri.f ├── psgetrs.f ├── psggqrf.f ├── psggrqf.f ├── pshseqr.f ├── pslabad.f ├── pslabrd.f ├── pslacon.f ├── pslaconsb.f ├── pslacp2.f ├── pslacp3.f ├── pslacpy.f ├── pslaed0.f ├── pslaed1.f ├── pslaed2.f ├── pslaed3.f ├── pslaedz.f ├── pslaevswp.f ├── pslahqr.f ├── pslahrd.f ├── pslaiect.c ├── pslamch.f ├── pslamr1d.f ├── pslamve.f ├── pslange.f ├── pslanhs.f ├── pslansy.f ├── pslantr.f ├── pslapiv.f ├── pslapv2.f ├── pslaqge.f ├── pslaqr0.f ├── pslaqr1.f ├── pslaqr2.f ├── pslaqr3.f ├── pslaqr4.f ├── pslaqr5.f ├── pslaqsy.f ├── pslared1d.f ├── pslared2d.f ├── pslarf.f ├── pslarfb.f ├── pslarfg.f ├── pslarft.f ├── pslarz.f ├── pslarzb.f ├── pslarzt.f ├── pslascl.f ├── pslase2.f ├── pslaset.f ├── pslasmsub.f ├── pslasrt.f ├── pslassq.f ├── pslaswp.f ├── pslatra.f ├── pslatrd.f ├── pslatrs.f ├── pslatrz.f ├── pslauu2.f ├── pslauum.f ├── pslawil.f ├── psorg2l.f ├── psorg2r.f ├── psorgl2.f ├── psorglq.f ├── psorgql.f ├── psorgqr.f ├── psorgr2.f ├── psorgrq.f ├── psorm2l.f ├── psorm2r.f ├── psormbr.f ├── psormhr.f ├── psorml2.f ├── psormlq.f ├── psormql.f ├── psormqr.f ├── psormr2.f ├── psormr3.f ├── psormrq.f ├── psormrz.f ├── psormtr.f ├── pspbsv.f ├── pspbtrf.f ├── pspbtrs.f ├── pspbtrsv.f ├── pspocon.f ├── pspoequ.f ├── psporfs.f ├── psposv.f ├── psposvx.f ├── pspotf2.f ├── pspotrf.f ├── pspotri.f ├── pspotrs.f ├── psptsv.f ├── pspttrf.f ├── pspttrs.f ├── pspttrsv.f ├── psrot.f ├── psrscl.f ├── psstebz.f ├── psstedc.f ├── psstein.f ├── pssyev.f ├── pssyevd.f ├── pssyevr.f ├── pssyevx.f ├── pssygs2.f ├── pssygst.f ├── pssygvx.f ├── pssyngst.f ├── pssyntrd.f ├── pssytd2.f ├── pssytrd.f ├── pssyttrd.f ├── pstrcon.f ├── pstrord.f ├── pstrrfs.f ├── pstrsen.f ├── pstrti2.f ├── pstrtri.f ├── pstrtrs.f ├── pstzrzf.f ├── pxsyevx.h ├── pzaxpy.c ├── pzdbsv.f ├── pzdbtrf.f ├── pzdbtrs.f ├── pzdbtrsv.f ├── pzdotc.c ├── pzdotu.c ├── pzdrscl.f ├── pzdtsv.f ├── pzdttrf.f ├── pzdttrs.f ├── pzdttrsv.f ├── pzgbsv.f ├── pzgbtrf.f ├── pzgbtrs.f ├── pzgebd2.f ├── pzgebrd.f ├── pzgecon.f ├── pzgeequ.f ├── pzgehd2.f ├── pzgehrd.f ├── pzgelq2.f ├── pzgelqf.f ├── pzgels.f ├── pzgeql2.f ├── pzgeqlf.f ├── pzgeqpf.f ├── pzgeqr2.f ├── pzgeqrf.f ├── pzgerfs.f ├── pzgerq2.f ├── pzgerqf.f ├── pzgesv.f ├── pzgesvd.f ├── pzgesvx.f ├── pzgetf2.f ├── pzgetrf.f ├── pzgetri.f ├── pzgetrs.f ├── pzggqrf.f ├── pzggrqf.f ├── pzheev.f ├── pzheevd.f ├── pzheevr.f ├── pzheevx.f ├── pzhegs2.f ├── pzhegst.f ├── pzhegvx.f ├── pzhengst.f ├── pzhentrd.f ├── pzhetd2.f ├── pzhetrd.f ├── pzhettrd.f ├── pzlabrd.f ├── pzlacgv.f ├── pzlacon.f ├── pzlaconsb.f ├── pzlacp2.f ├── pzlacp3.f ├── pzlacpy.f ├── pzlaevswp.f ├── pzlahqr.f ├── pzlahrd.f ├── pzlamr1d.f ├── pzlange.f ├── pzlanhe.f ├── pzlanhs.f ├── pzlansy.f ├── pzlantr.f ├── pzlapiv.f ├── pzlapv2.f ├── pzlaqge.f ├── pzlaqsy.f ├── pzlarf.f ├── pzlarfb.f ├── pzlarfc.f ├── pzlarfg.f ├── pzlarft.f ├── pzlarz.f ├── pzlarzb.f ├── pzlarzc.f ├── pzlarzt.f ├── pzlascl.f ├── pzlase2.f ├── pzlaset.f ├── pzlasmsub.f ├── pzlassq.f ├── pzlaswp.f ├── pzlatra.f ├── pzlatrd.f ├── pzlatrs.f ├── pzlatrz.f ├── pzlattrs.f ├── pzlauu2.f ├── pzlauum.f ├── pzlawil.f ├── pzmax1.f ├── pzpbsv.f ├── pzpbtrf.f ├── pzpbtrs.f ├── pzpbtrsv.f ├── pzpocon.f ├── pzpoequ.f ├── pzporfs.f ├── pzposv.f ├── pzposvx.f ├── pzpotf2.f ├── pzpotrf.f ├── pzpotri.f ├── pzpotrs.f ├── pzptsv.f ├── pzpttrf.f ├── pzpttrs.f ├── pzpttrsv.f ├── pzrot.c ├── pzstein.f ├── pztrcon.f ├── pztrevc.f ├── pztrrfs.f ├── pztrti2.f ├── pztrtri.f ├── pztrtrs.f ├── pztzrzf.f ├── pzung2l.f ├── pzung2r.f ├── pzungl2.f ├── pzunglq.f ├── pzungql.f ├── pzungqr.f ├── pzungr2.f ├── pzungrq.f ├── pzunm2l.f ├── pzunm2r.f ├── pzunmbr.f ├── pzunmhr.f ├── pzunml2.f ├── pzunmlq.f ├── pzunmql.f ├── pzunmqr.f ├── pzunmr2.f ├── pzunmr3.f ├── pzunmrq.f ├── pzunmrz.f ├── pzunmtr.f ├── sdbtf2.f ├── sdbtrf.f ├── sdttrf.f ├── sdttrsv.f ├── slamov.c ├── slamsh.f ├── slapst.f ├── slaqr6.f ├── slar1va.f ├── slaref.f ├── slarrb2.f ├── slarrd2.f ├── slarre2.f ├── slarre2a.f ├── slarrf2.f ├── slarrv2.f ├── slasorte.f ├── slasrt2.f ├── spttrsv.f ├── sstegr2.f ├── sstegr2a.f ├── sstegr2b.f ├── sstein2.f ├── ssteqr2.f ├── strmvt.f ├── tools.h ├── zdbtf2.f ├── zdbtrf.f ├── zdttrf.f ├── zdttrsv.f ├── zlahqr2.f ├── zlamov.c ├── zlamsh.f ├── zlanv2.f ├── zlaref.f ├── zpttrsv.f ├── zsteqr2.f └── ztrmvt.f ├── TESTING ├── BLLT.dat ├── BLU.dat ├── BRD.dat ├── CMakeLists.txt ├── EIG │ ├── CMakeLists.txt │ ├── Makefile │ ├── listing │ ├── pcbrddriver.f │ ├── pcbrdinfo.f │ ├── pcevcdriver.f │ ├── pcevcinfo.f │ ├── pcgebdrv.f │ ├── pcgehdrv.f │ ├── pcget22.f │ ├── pcgsepchk.f │ ├── pcgsepdriver.f │ ├── pcgsepreq.f │ ├── pcgsepsubtst.f │ ├── pcgseptst.f │ ├── pchetdrv.f │ ├── pchrddriver.f │ ├── pchrdinfo.f │ ├── pclafchk.f │ ├── pclagsy.f │ ├── pclasizegsep.f │ ├── pclasizeheevr.f │ ├── pclasizeheevx.f │ ├── pclasizesep.f │ ├── pclasizesepr.f │ ├── pclatms.f │ ├── pclatran.f │ ├── pcmatgen.f │ ├── pcnepdriver.f │ ├── pcnepfchk.f │ ├── pcnepinfo.f │ ├── pcrptseptst.f │ ├── pcsdpsubtst.f │ ├── pcsepchk.f │ ├── pcsepdriver.f │ ├── pcsepqtq.f │ ├── pcseprdriver.f │ ├── pcsepreq.f │ ├── pcseprreq.f │ ├── pcseprsubtst.f │ ├── pcseprtst.f │ ├── pcsepsubtst.f │ ├── pcseptst.f │ ├── pctrddriver.f │ ├── pctrdinfo.f │ ├── pcttrdtester.f │ ├── pdbrddriver.f │ ├── pdbrdinfo.f │ ├── pdgebdrv.f │ ├── pdgehdrv.f │ ├── pdgrptseptst.f │ ├── pdgsepchk.f │ ├── pdgsepdriver.f │ ├── pdgsepreq.f │ ├── pdgsepsubtst.f │ ├── pdgseptst.f │ ├── pdhrddriver.f │ ├── pdhrdinfo.f │ ├── pdhseqrdriver.f │ ├── pdlafchk.f │ ├── pdlagge.f │ ├── pdlagsy.f │ ├── pdlasizegsep.f │ ├── pdlasizesep.f │ ├── pdlasizesepr.f │ ├── pdlasizesqp.f │ ├── pdlasizesyev.f │ ├── pdlasizesyevr.f │ ├── pdlasizesyevx.f │ ├── pdlatms.f │ ├── pdlatran.f │ ├── pdmatgen.f │ ├── pdmatgen2.f │ ├── pdnepdriver.f │ ├── pdnepfchk.f │ ├── pdnepinfo.f │ ├── pdrptseptst.f │ ├── pdsdpsubtst.f │ ├── pdsepchk.f │ ├── pdsepdriver.f │ ├── pdsepinfo.f │ ├── pdsepqtq.f │ ├── pdseprdriver.f │ ├── pdsepreq.f │ ├── pdseprreq.f │ ├── pdseprsubtst.f │ ├── pdseprtst.f │ ├── pdsepsubtst.f │ ├── pdseptst.f │ ├── pdsqpsubtst.f │ ├── pdsvdchk.f │ ├── pdsvdcmp.f │ ├── pdsvddriver.f │ ├── pdsvdtst.f │ ├── pdsytdrv.f │ ├── pdtrddriver.f │ ├── pdtrdinfo.f │ ├── pdttrdtester.f │ ├── pmatgeninc.f │ ├── psbrddriver.f │ ├── psbrdinfo.f │ ├── psgebdrv.f │ ├── psgehdrv.f │ ├── psgrptseptst.f │ ├── psgsepchk.f │ ├── psgsepdriver.f │ ├── psgsepreq.f │ ├── psgsepsubtst.f │ ├── psgseptst.f │ ├── pshrddriver.f │ ├── pshrdinfo.f │ ├── pshseqrdriver.f │ ├── pslafchk.f │ ├── pslagge.f │ ├── pslagsy.f │ ├── pslasizegsep.f │ ├── pslasizesep.f │ ├── pslasizesepr.f │ ├── pslasizesqp.f │ ├── pslasizesyev.f │ ├── pslasizesyevr.f │ ├── pslasizesyevx.f │ ├── pslatms.f │ ├── pslatran.f │ ├── psmatgen.f │ ├── psmatgen2.f │ ├── psnepdriver.f │ ├── psnepfchk.f │ ├── psnepinfo.f │ ├── psrptseptst.f │ ├── pssdpsubtst.f │ ├── pssepchk.f │ ├── pssepdriver.f │ ├── pssepinfo.f │ ├── pssepqtq.f │ ├── psseprdriver.f │ ├── pssepreq.f │ ├── psseprreq.f │ ├── psseprsubtst.f │ ├── psseprtst.f │ ├── pssepsubtst.f │ ├── psseptst.f │ ├── pssqpsubtst.f │ ├── pssvdchk.f │ ├── pssvdcmp.f │ ├── pssvddriver.f │ ├── pssvdtst.f │ ├── pssytdrv.f │ ├── pstrddriver.f │ ├── pstrdinfo.f │ ├── psttrdtester.f │ ├── pzbrddriver.f │ ├── pzbrdinfo.f │ ├── pzevcdriver.f │ ├── pzevcinfo.f │ ├── pzgebdrv.f │ ├── pzgehdrv.f │ ├── pzget22.f │ ├── pzgsepchk.f │ ├── pzgsepdriver.f │ ├── pzgsepreq.f │ ├── pzgsepsubtst.f │ ├── pzgseptst.f │ ├── pzhetdrv.f │ ├── pzhrddriver.f │ ├── pzhrdinfo.f │ ├── pzlafchk.f │ ├── pzlagsy.f │ ├── pzlasizegsep.f │ ├── pzlasizeheevr.f │ ├── pzlasizeheevx.f │ ├── pzlasizesep.f │ ├── pzlasizesepr.f │ ├── pzlatms.f │ ├── pzlatran.f │ ├── pzmatgen.f │ ├── pznepdriver.f │ ├── pznepfchk.f │ ├── pznepinfo.f │ ├── pzrptseptst.f │ ├── pzsdpsubtst.f │ ├── pzsepchk.f │ ├── pzsepdriver.f │ ├── pzsepqtq.f │ ├── pzseprdriver.f │ ├── pzsepreq.f │ ├── pzseprreq.f │ ├── pzseprsubtst.f │ ├── pzseprtst.f │ ├── pzsepsubtst.f │ ├── pzseptst.f │ ├── pztrddriver.f │ ├── pztrdinfo.f │ ├── pzttrdtester.f │ └── xpjlaenv.f ├── EVC.dat ├── HRD.dat ├── INV.dat ├── LIN │ ├── CMakeLists.txt │ ├── Makefile │ ├── pcbmatgen.f │ ├── pcdbdriver.f │ ├── pcdbinfo.f │ ├── pcdblaschk.f │ ├── pcdbmv1.f │ ├── pcdtdriver.f │ ├── pcdtinfo.f │ ├── pcdtlaschk.f │ ├── pcgbdriver.f │ ├── pcgbinfo.f │ ├── pcgbmv1.f │ ├── pcgelqrv.f │ ├── pcgeqlrv.f │ ├── pcgeqrrv.f │ ├── pcgerqrv.f │ ├── pcgetrrv.f │ ├── pcinvchk.f │ ├── pcinvdriver.f │ ├── pcinvinfo.f │ ├── pclafchk.f │ ├── pclaschk.f │ ├── pclltdriver.f │ ├── pclltinfo.f │ ├── pclsdriver.f │ ├── pclsinfo.f │ ├── pcludriver.f │ ├── pcluinfo.f │ ├── pcmatgen.f │ ├── pcpbdriver.f │ ├── pcpbinfo.f │ ├── pcpblaschk.f │ ├── pcpbmv1.f │ ├── pcpotrrv.f │ ├── pcptdriver.f │ ├── pcptinfo.f │ ├── pcptlaschk.f │ ├── pcqrdriver.f │ ├── pcqrinfo.f │ ├── pcqrt13.f │ ├── pcqrt14.f │ ├── pcqrt16.f │ ├── pcqrt17.f │ ├── pctzrzrv.f │ ├── pdbmatgen.f │ ├── pddbdriver.f │ ├── pddbinfo.f │ ├── pddblaschk.f │ ├── pddbmv1.f │ ├── pddtdriver.f │ ├── pddtinfo.f │ ├── pddtlaschk.f │ ├── pdgbdriver.f │ ├── pdgbinfo.f │ ├── pdgbmv1.f │ ├── pdgelqrv.f │ ├── pdgeqlrv.f │ ├── pdgeqrrv.f │ ├── pdgerqrv.f │ ├── pdgetrrv.f │ ├── pdinvchk.f │ ├── pdinvdriver.f │ ├── pdinvinfo.f │ ├── pdlafchk.f │ ├── pdlaschk.f │ ├── pdlltdriver.f │ ├── pdlltinfo.f │ ├── pdlsdriver.f │ ├── pdlsinfo.f │ ├── pdludriver.f │ ├── pdluinfo.f │ ├── pdmatgen.f │ ├── pdpbdriver.f │ ├── pdpbinfo.f │ ├── pdpblaschk.f │ ├── pdpbmv1.f │ ├── pdpotrrv.f │ ├── pdptdriver.f │ ├── pdptinfo.f │ ├── pdptlaschk.f │ ├── pdqrdriver.f │ ├── pdqrinfo.f │ ├── pdqrt13.f │ ├── pdqrt14.f │ ├── pdqrt16.f │ ├── pdqrt17.f │ ├── pdtzrzrv.f │ ├── pmatgeninc.f │ ├── psbmatgen.f │ ├── psdbdriver.f │ ├── psdbinfo.f │ ├── psdblaschk.f │ ├── psdbmv1.f │ ├── psdtdriver.f │ ├── psdtinfo.f │ ├── psdtlaschk.f │ ├── psgbdriver.f │ ├── psgbinfo.f │ ├── psgbmv1.f │ ├── psgelqrv.f │ ├── psgeqlrv.f │ ├── psgeqrrv.f │ ├── psgerqrv.f │ ├── psgetrrv.f │ ├── psinvchk.f │ ├── psinvdriver.f │ ├── psinvinfo.f │ ├── pslafchk.f │ ├── pslaschk.f │ ├── pslltdriver.f │ ├── pslltinfo.f │ ├── pslsdriver.f │ ├── pslsinfo.f │ ├── psludriver.f │ ├── psluinfo.f │ ├── psmatgen.f │ ├── pspbdriver.f │ ├── pspbinfo.f │ ├── pspblaschk.f │ ├── pspbmv1.f │ ├── pspotrrv.f │ ├── psptdriver.f │ ├── psptinfo.f │ ├── psptlaschk.f │ ├── psqrdriver.f │ ├── psqrinfo.f │ ├── psqrt13.f │ ├── psqrt14.f │ ├── psqrt16.f │ ├── psqrt17.f │ ├── pstzrzrv.f │ ├── pzbmatgen.f │ ├── pzdbdriver.f │ ├── pzdbinfo.f │ ├── pzdblaschk.f │ ├── pzdbmv1.f │ ├── pzdtdriver.f │ ├── pzdtinfo.f │ ├── pzdtlaschk.f │ ├── pzgbdriver.f │ ├── pzgbinfo.f │ ├── pzgbmv1.f │ ├── pzgelqrv.f │ ├── pzgeqlrv.f │ ├── pzgeqrrv.f │ ├── pzgerqrv.f │ ├── pzgetrrv.f │ ├── pzinvchk.f │ ├── pzinvdriver.f │ ├── pzinvinfo.f │ ├── pzlafchk.f │ ├── pzlaschk.f │ ├── pzlltdriver.f │ ├── pzlltinfo.f │ ├── pzlsdriver.f │ ├── pzlsinfo.f │ ├── pzludriver.f │ ├── pzluinfo.f │ ├── pzmatgen.f │ ├── pzpbdriver.f │ ├── pzpbinfo.f │ ├── pzpblaschk.f │ ├── pzpbmv1.f │ ├── pzpotrrv.f │ ├── pzptdriver.f │ ├── pzptinfo.f │ ├── pzptlaschk.f │ ├── pzqrdriver.f │ ├── pzqrinfo.f │ ├── pzqrt13.f │ ├── pzqrt14.f │ ├── pzqrt16.f │ ├── pzqrt17.f │ └── pztzrzrv.f ├── LLT.dat ├── LS.dat ├── LU.dat ├── NEP.dat ├── QR.dat ├── SEP.dat ├── SEPR.dat ├── SVD.dat └── TRD.dat ├── TOOLS ├── CMakeLists.txt ├── LAPACK │ ├── CMakeLists.txt │ ├── Makefile │ ├── clagge.f │ ├── claghe.f │ ├── clagsy.f │ ├── clarnd.f │ ├── clarnv.f │ ├── clarot.f │ ├── clatm1.f │ ├── clatms.f │ ├── dlagge.f │ ├── dlagsy.f │ ├── dlaran.f │ ├── dlarnd.f │ ├── dlarot.f │ ├── dlatm1.f │ ├── dlatms.f │ ├── icopy.f │ ├── slagge.f │ ├── slagsy.f │ ├── slaran.f │ ├── slarnd.f │ ├── slarot.f │ ├── slatm1.f │ ├── slatms.f │ ├── zlagge.f │ ├── zlaghe.f │ ├── zlagsy.f │ ├── zlarnd.f │ ├── zlarnv.f │ ├── zlarot.f │ ├── zlatm1.f │ └── zlatms.f ├── Makefile ├── SL_gridreshape.c ├── SL_init.f ├── ccdotc.f ├── ccdotu.f ├── chk1mat.f ├── clatcpy.f ├── cmatadd.f ├── dddot.f ├── desc_convert.f ├── descinit.f ├── descset.f ├── dlatcpy.f ├── dmatadd.f ├── dsasum.f ├── dscasum.f ├── dscnrm2.f ├── dsnrm2.f ├── iceil.f ├── ilacpy.f ├── ilcm.f ├── indxg2l.f ├── indxg2p.f ├── indxl2g.f ├── infog1l.f ├── infog2l.f ├── npreroc.f ├── numroc.f ├── pcchekpad.f ├── pccol2row.f ├── pcelget.f ├── pcelset.f ├── pcelset2.f ├── pcfillpad.f ├── pchkxmat.f ├── pclaprnt.f ├── pclaread.f ├── pclawrite.f ├── pcmatadd.f ├── pcrow2col.f ├── pctreecomb.f ├── pdchekpad.f ├── pdcol2row.f ├── pdelget.f ├── pdelset.f ├── pdelset2.f ├── pdfillpad.f ├── pdlaprnt.f ├── pdlaread.f ├── pdlawrite.f ├── pdmatadd.f ├── pdrow2col.f ├── pdtreecomb.f ├── pichekpad.f ├── picol2row.f ├── pielget.f ├── pielset.f ├── pielset2.f ├── pifillpad.f ├── pilaprnt.f ├── pirow2col.f ├── pitreecomb.f ├── pschekpad.f ├── pscol2row.f ├── pselget.f ├── pselset.f ├── pselset2.f ├── psfillpad.f ├── pslaprnt.f ├── pslaread.f ├── pslawrite.f ├── psmatadd.f ├── psrow2col.f ├── pstreecomb.f ├── pzchekpad.f ├── pzcol2row.f ├── pzelget.f ├── pzelset.f ├── pzelset2.f ├── pzfillpad.f ├── pzlaprnt.f ├── pzlaread.f ├── pzlawrite.f ├── pzmatadd.f ├── pzrow2col.f ├── pztreecomb.f ├── reshape.c ├── slatcpy.f ├── sltimer.f ├── smatadd.f ├── ssdot.f ├── zlatcpy.f ├── zmatadd.f ├── zzdotc.f └── zzdotu.f └── scalapack.pc.in /.github/workflows/cmake.yml: -------------------------------------------------------------------------------- 1 | name: CMake CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | paths-ignore: 8 | - '.github/workflows/make.yml' 9 | - '.gitignore' 10 | - 'README' 11 | - '**README' 12 | - 'LICENSE' 13 | - '**Makefile' 14 | - 'SLmake.inc.example' 15 | 16 | concurrency: 17 | group: ${{ github.workflow }}-${{ github.ref }} 18 | cancel-in-progress: true 19 | 20 | env: 21 | CFLAGS: "-Wall -pedantic" 22 | FFLAGS: "-fcheck=all,no-bounds" 23 | CMAKE_BUILD_TYPE: Release 24 | MPIEXEC_PREFLAGS: "--oversubscribe" 25 | 26 | defaults: 27 | run: 28 | shell: bash 29 | 30 | jobs: 31 | 32 | build-all: 33 | name: > 34 | CMake ${{ matrix.cmake }} 35 | runs-on: ubuntu-latest 36 | strategy: 37 | matrix: 38 | # CMake versions to test: 39 | # - minimum and maximum in the `cmake_minimum_required` 40 | # (if needed expand this to add all intermediate values 41 | # for *temporary* CI testing) 42 | # - latest version 43 | cmake: ["3.26", "4.0", latest] 44 | fail-fast: false 45 | steps: 46 | 47 | - name: Checkout ScaLAPACK 48 | uses: actions/checkout@v4 49 | 50 | - name: Setup MPI 51 | # uses: mpi4py/setup-mpi@v1 52 | run: | 53 | sudo apt -y update 54 | sudo apt -y install openmpi-bin libopenmpi-dev 55 | 56 | - name: Install BLAS and LAPACK 57 | run: sudo apt -y install libblas-dev liblapack-dev 58 | 59 | - name: Setup CMake 60 | uses: jwlawson/actions-setup-cmake@v2 61 | with: 62 | cmake-version: ${{ matrix.cmake }} 63 | 64 | - name: CMake configuration 65 | # TODO: Use cmake presets for newer versions 66 | # TODO: Simplify the defaults to not require configuration 67 | run: > 68 | cmake -B build \ 69 | -G Ninja \ 70 | -DCMAKE_BUILD_TYPE=${{env.CMAKE_BUILD_TYPE}} \ 71 | -DBUILD_SHARED_LIBS=ON \ 72 | -DSCALAPACK_BUILD_TESTS=ON \ 73 | -DMPIEXEC_PREFLAGS=${{env.MPIEXEC_PREFLAGS}} 74 | 75 | - name: Build 76 | run: > 77 | cmake --build build 78 | 79 | - name: Test 80 | # CMake<3.20 does not have -B option 81 | working-directory: ${{github.workspace}}/build 82 | run: > 83 | ctest --output-on-failure 84 | 85 | - name: Install 86 | run: cmake --install build --prefix scalapack_install 87 | -------------------------------------------------------------------------------- /.github/workflows/make.yml: -------------------------------------------------------------------------------- 1 | name: Makefile CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | paths-ignore: 8 | - '.github/workflows/cmake.yml' 9 | - '.gitignore' 10 | - 'README' 11 | - '**README' 12 | - 'LICENSE' 13 | - 'CMAKE**' 14 | - '**CMakeLists.txt' 15 | 16 | concurrency: 17 | group: ${{ github.workflow }}-${{ github.ref }} 18 | cancel-in-progress: true 19 | 20 | defaults: 21 | run: 22 | shell: bash 23 | 24 | jobs: 25 | 26 | build-all: 27 | runs-on: ubuntu-latest 28 | 29 | steps: 30 | 31 | - name: Checkout ScaLAPACK 32 | uses: actions/checkout@v2 33 | 34 | - name: Setup MPI 35 | uses: mpi4py/setup-mpi@v1 36 | 37 | - name: Build ScaLAPACK 38 | run: | 39 | cp SLmake.inc.example SLmake.inc 40 | make --silent -j lib 41 | make --silent all 42 | 43 | - name: Run examples 44 | working-directory: ${{github.workspace}}/EXAMPLE 45 | run: | 46 | mpiexec -n 4 ./xsscaex 47 | mpiexec -n 4 ./xdscaex 48 | mpiexec -n 4 ./xcscaex 49 | mpiexec -n 4 ./xzscaex 50 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.oo 3 | BLACS/INSTALL/cmake_install.cmake 4 | BLACS/INSTALL/Makefile 5 | BLACS/INSTALL/x* 6 | TESTING/x* 7 | REDIST/TESTING/x* 8 | PBLAS/TESTING/x* 9 | PBLAS/TESTING/PB_Cabort.c 10 | PBLAS/TESTING/PB_Cwarn.c 11 | PBLAS/TIMING/x*tim 12 | PBLAS/TIMING/PB_Cabort.c 13 | PBLAS/TIMING/PB_Cwarn.c 14 | *.a 15 | BLACS/TESTING/xCbtest 16 | BLACS/TESTING/xFbtest 17 | SLmake.inc 18 | 19 | -------------------------------------------------------------------------------- /BLACS/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_subdirectory(SRC) 2 | if(${SCALAPACK_BUILD_TESTS}) 3 | add_subdirectory(TESTING) 4 | endif() 5 | -------------------------------------------------------------------------------- /BLACS/INSTALL/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.26...4.0) 2 | project(INSTALL C Fortran) 3 | 4 | add_executable(xintface Fintface.f Cintface.c) 5 | set_property(TARGET xintface PROPERTY POSITION_INDEPENDENT_CODE TRUE) 6 | -------------------------------------------------------------------------------- /BLACS/INSTALL/Cintface.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void c_intface_(int *i) 4 | { 5 | fprintf(stdout, "Add_\n"); 6 | } 7 | 8 | void c_intface(int *i) 9 | { 10 | fprintf(stdout, "NoChange\n"); 11 | } 12 | 13 | void c_intface__(int *i) 14 | { 15 | fprintf(stdout, "f77IsF2C\n"); 16 | } 17 | 18 | void C_INTFACE(int *i) 19 | { 20 | fprintf(stdout, "UpCase\n"); 21 | } 22 | -------------------------------------------------------------------------------- /BLACS/INSTALL/Fintface.f: -------------------------------------------------------------------------------- 1 | program intface 2 | external c_intface 3 | integer i 4 | 5 | call c_intface(i) 6 | 7 | stop 8 | end 9 | -------------------------------------------------------------------------------- /BLACS/INSTALL/Makefile_install: -------------------------------------------------------------------------------- 1 | include ../../SLmake.inc 2 | 3 | help : 4 | @ echo " " 5 | @ echo " " 6 | @ echo "You need to specify which INSTALL executable to build." 7 | @ echo "General choices are: xsize, xintface, xsyserrors" 8 | @ echo "MPI specific choices are: xsyserrors, xtc_CsameF77, xtc_UseMpich," 9 | @ echo " xcmpi_sane, xfmpi_sane" 10 | @ echo " " 11 | @ echo "Here is a brief explanation of each of these routines: " 12 | cat README 13 | 14 | xsize : size.o 15 | $(CCLOADER) $(CCLOADFLAGS) -o $@ size.o 16 | 17 | xintface : Fintface.o Cintface.o 18 | $(FCLOADER) $(FCLOADFLAGS) -o $@ Fintface.o Cintface.o 19 | 20 | xsyserrors : syserrors.o 21 | $(CCLOADER) $(CCLOADFLAGS) -o $@ syserrors.o 22 | 23 | xtc_CsameFC : tc_fCsameF77.o tc_cCsameF77.o 24 | $(FCLOADER) $(FCLOADFLAGS) -o $@ tc_fCsameF77.o tc_cCsameF77.o 25 | 26 | xtc_UseMpich : tc_UseMpich.o 27 | $(CCLOADER) $(CCLOADFLAGS) -o $@ tc_UseMpich.o 28 | 29 | xcmpi_sane : cmpi_sane.o 30 | $(CCLOADER) $(CCLOADFLAGS) -o $@ cmpi_sane.o 31 | 32 | xfmpi_sane : mpif.h fmpi_sane.o 33 | $(FCLOADER) $(FCLOADFLAGS) -o $@ fmpi_sane.o 34 | 35 | clean: 36 | rm -f size.o Fintface.o Cintface.o syserrors.o transcomm.o \ 37 | mpi_sane.o fmpi_sane.o tc_UseMpich.o tc_fCsameF77.o tc_cCsameF77.o 38 | 39 | .f.o: ; $(FC) -c $(FCFLAGS) $*.f 40 | 41 | .c.o: 42 | $(CC) -c $(CCFLAGS) $(CDEFS) $< 43 | -------------------------------------------------------------------------------- /BLACS/INSTALL/README: -------------------------------------------------------------------------------- 1 | These routines help to configure the BLACS and its tester during installation. 2 | See the paper "Installing and testing the BLACS" for details. 3 | 4 | 5 | xintface will tell you the correct setting for Bmake.inc's INTFACE macro. 6 | 7 | xsize prints out the correct sizes for various data types, which are hardwired 8 | in btprim_PVM.c ibtsizeof. 9 | 10 | ============================ MPI SPECIFIC ROUTINES ============================ 11 | xsyserrors indicates the correct setting for Bmake.inc's SYSERRORS macro. 12 | 13 | xcmpi_sane will give you a sanity test to see if the most basic MPI program 14 | will run on your system using the C interface to MPI. 15 | 16 | xfmpi_sane will give you a sanity test to see if the most basic MPI program 17 | will run on your system using the Fortran77 interface to MPI. 18 | 19 | ***** FINDING THE CORRECT TRANSCOMM SETTING ***** 20 | The remaining routines exist in order to allow the user to find the correct 21 | setting for Bmake.inc's TRANSCOMM macro. THESE ROUTINES USE HEURISTICS, AND 22 | THUS MAY BE INCORRECT. 23 | 24 | First make and run xtc_CsameF77. If this reports back not to set TRANSCOMM 25 | to -DCSameF77 or does not complete, make and run xtc_UseMpich. If this fails to 26 | compile or does not tell you what to set TRANSCOMM to, you must leave TRANSCOMM 27 | blank. 28 | -------------------------------------------------------------------------------- /BLACS/INSTALL/cmpi_sane.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "mpi.h" 3 | /* 4 | * Increase/decrease this value to test if a process of a particular size can 5 | * be spawned to a particular machine 6 | */ 7 | #define WASTE_SIZE 100 8 | #define NPROC 4 9 | main(int narg, char **args) 10 | /* 11 | * This program checks to make sure that you can run a basic program on your 12 | * machine using MPI. Can increase WASTE_SIZE if you think size of executable 13 | * may be causing launching problems. 14 | */ 15 | { 16 | int i, Iam, Np; 17 | int irank[NPROC]; 18 | double WasteOfSpace[WASTE_SIZE]; 19 | MPI_Comm mcom; 20 | MPI_Group wgrp, mgrp; 21 | MPI_Status stat; 22 | 23 | MPI_Init(&narg, &args); 24 | MPI_Comm_size(MPI_COMM_WORLD, &Np); 25 | if (Np < NPROC) 26 | { 27 | fprintf(stderr, "Not enough processes to run sanity check; need %d, but I've only got %d\n", NPROC, Np); 28 | MPI_Abort(MPI_COMM_WORLD, -1); 29 | } 30 | 31 | for (i=0; i != WASTE_SIZE; i++) WasteOfSpace[i] = 0.0; /* page in Waste */ 32 | /* 33 | * Form context with NPROC members 34 | */ 35 | for (i=0; i != NPROC; i++) irank[i] = i; 36 | MPI_Comm_group(MPI_COMM_WORLD, &wgrp); 37 | MPI_Group_incl(wgrp, NPROC, irank, &mgrp); 38 | MPI_Comm_create(MPI_COMM_WORLD, mgrp, &mcom); 39 | MPI_Group_free(&mgrp); 40 | /* 41 | * Everyone in new communicator sends a message to his neighbor 42 | */ 43 | if (mcom != MPI_COMM_NULL) 44 | { 45 | MPI_Comm_rank(mcom, &Iam); 46 | /* 47 | * Odd nodes receive first, so we don't hang if MPI_Send is globally blocking 48 | */ 49 | if (Iam % 2) 50 | { 51 | MPI_Recv(&i, 1, MPI_INT, (NPROC+Iam-1)%NPROC, 0, mcom, &stat); 52 | MPI_Send(&Iam, 1, MPI_INT, (Iam+1)%NPROC, 0, mcom); 53 | } 54 | else 55 | { 56 | MPI_Send(&Iam, 1, MPI_INT, (Iam+1)%NPROC, 0, mcom); 57 | MPI_Recv(&i, 1, MPI_INT, (NPROC+Iam-1)%NPROC, 0, mcom, &stat); 58 | } 59 | /* 60 | * Make sure we've received the right information 61 | */ 62 | if (i != (NPROC+Iam-1)%NPROC) 63 | { 64 | fprintf(stderr, "Communication does not seem to work properly!!\n"); 65 | MPI_Abort(MPI_COMM_WORLD, -1); 66 | } 67 | } 68 | fprintf(stdout, "%d: C MPI sanity test passed\n", Iam); 69 | MPI_Finalize(); 70 | exit(0); 71 | } 72 | -------------------------------------------------------------------------------- /BLACS/INSTALL/size.c: -------------------------------------------------------------------------------- 1 | #include 2 | main() 3 | { 4 | printf("ISIZE=%d\nSSIZE=%d\nDSIZE=%d\nCSIZE=%d\nZSIZE=%d\n", 5 | sizeof(int), sizeof(float), sizeof(double), 6 | 2*sizeof(float), 2*sizeof(double)); 7 | } 8 | -------------------------------------------------------------------------------- /BLACS/INSTALL/syserrors.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | main(int nargs, char **args) 5 | { 6 | MPI_Datatype Dtype, Dt; 7 | int i, j, ierr; 8 | 9 | MPI_Init(&nargs, &args); 10 | printf( "If this routine does not complete, you should set SYSERRORS = -DZeroByteTypeBug.\n"); 11 | 12 | i = 0; 13 | j = 1; 14 | ierr = MPI_Type_indexed(1, &i, &j, MPI_INT, &Dtype); 15 | if (ierr == MPI_SUCCESS) 16 | { 17 | MPI_Type_commit(&Dtype); 18 | ierr = MPI_Type_vector(0, 1, 1, MPI_INT, &Dt); 19 | if (ierr != MPI_SUCCESS) 20 | printf("MPI_Type_vector returned %d, set SYSERRORS = -DZeroByteTypeBug\n", ierr); 21 | else MPI_Type_commit(&Dt); 22 | } 23 | else printf("MPI_Type_commit returned %d, set SYSERRORS = -DZeroByteTypeBug\n", ierr); 24 | if (ierr == MPI_SUCCESS) printf("Leave SYSERRORS blank for this system.\n"); 25 | 26 | MPI_Finalize(); 27 | } 28 | -------------------------------------------------------------------------------- /BLACS/INSTALL/tc_UseMpich.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | main() 4 | { 5 | MPI_Comm ccomm; 6 | int fcomm; 7 | extern void *MPIR_ToPointer(); 8 | extern int MPIR_FromPointer(); 9 | extern void *MPIR_RmPointer(); 10 | 11 | if (sizeof(int) < sizeof(int*)) 12 | { 13 | fcomm = MPIR_FromPointer(MPI_COMM_WORLD); 14 | ccomm = (MPI_Comm) MPIR_ToPointer(fcomm); 15 | if (ccomm == MPI_COMM_WORLD) 16 | printf("Set TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1\n"); 17 | else 18 | printf("Do _NOT_ set TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1\n"); 19 | } 20 | else 21 | { 22 | printf("Compile and run xtc_CsameF77 for correct TRANSCOMM setting.\n"); 23 | printf("If xtc_CsameF77 fails, leave TRANSCOMM blank.\n"); 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /BLACS/INSTALL/tc_cCsameF77.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int Ccommcheck(int F77World, int f77comm) 4 | { 5 | int Np, Iam, i, OK=1; 6 | 7 | if (sizeof(int) != sizeof(MPI_Comm)) OK=0; 8 | else if ((MPI_Comm) F77World != MPI_COMM_WORLD) OK=0; 9 | else 10 | { 11 | MPI_Comm_rank(MPI_COMM_WORLD, &Iam); 12 | if (Iam > 1) OK = ((MPI_Comm) f77comm == MPI_COMM_NULL); 13 | else 14 | { 15 | i = MPI_Comm_size((MPI_Comm) f77comm, &Np); 16 | if (i != MPI_SUCCESS) OK = 0; 17 | else if (Np != 2) OK = 0; 18 | } 19 | } 20 | MPI_Allreduce(&OK, &i, 1, MPI_INT, MPI_MIN, MPI_COMM_WORLD); 21 | return(i); 22 | } 23 | 24 | /* 25 | * Fortran interfaces 26 | */ 27 | int CCOMMCHECK(int *F77World, int *f77comm) 28 | { 29 | return(Ccommcheck(*F77World, *f77comm)); 30 | } 31 | int ccommcheck_(int *F77World, int *f77comm) 32 | { 33 | return(Ccommcheck(*F77World, *f77comm)); 34 | } 35 | int ccommcheck(int *F77World, int *f77comm) 36 | { 37 | return(Ccommcheck(*F77World, *f77comm)); 38 | } 39 | -------------------------------------------------------------------------------- /BLACS/INSTALL/tc_fCsameF77.f: -------------------------------------------------------------------------------- 1 | program tctst 2 | include 'mpif.h' 3 | integer f77com, wgrp, f77grp, Iam, i, ierr 4 | integer irank(2) 5 | external Ccommcheck 6 | integer Ccommcheck 7 | 8 | call mpi_init(ierr) 9 | call mpi_comm_size(MPI_COMM_WORLD, i, ierr) 10 | call mpi_comm_rank(MPI_COMM_WORLD, Iam, ierr) 11 | if (i .lt. 2) then 12 | print*,'Need at least 2 processes to run test, aborting.' 13 | else 14 | if (Iam .eq. 0) then 15 | print*,'If this routine does not complete successfully,' 16 | print*,'Do _NOT_ set TRANSCOMM = -DCSameF77' 17 | print*,' ' 18 | print*,' ' 19 | end if 20 | * 21 | * Form context with 2 members 22 | * 23 | irank(1) = 0 24 | irank(2) = 1 25 | call mpi_comm_group(MPI_COMM_WORLD, wgrp, ierr) 26 | call mpi_group_incl(wgrp, 2, irank, f77grp, ierr) 27 | call mpi_comm_create(MPI_COMM_WORLD, f77grp, f77com, ierr) 28 | call mpi_group_free(f77grp, ierr) 29 | 30 | i = Ccommcheck(MPI_COMM_WORLD, f77com) 31 | if (Iam .eq. 0) then 32 | if (i .eq. 0) then 33 | print*,'Do _NOT_ set TRANSCOMM = -DCSameF77' 34 | else 35 | print*,'Set TRANSCOMM = -DCSameF77' 36 | end if 37 | end if 38 | 39 | if (f77grp .ne. MPI_COMM_NULL) call mpi_comm_free(f77com, ierr) 40 | end if 41 | call mpi_finalize(ierr) 42 | 43 | stop 44 | end 45 | -------------------------------------------------------------------------------- /BLACS/Makefile: -------------------------------------------------------------------------------- 1 | all : lib tester 2 | 3 | clean: 4 | ( cd TESTING ; $(MAKE) clean ) 5 | ( cd SRC ; $(MAKE) clean ) 6 | 7 | tester : 8 | ( cd TESTING ; $(MAKE) ) 9 | 10 | lib : 11 | ( cd SRC ; $(MAKE) ) 12 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Arecv.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_Arecv(BLACSCONTEXT *ctxt, Int src, Int msgid, BLACBUFF *bp) 4 | { 5 | Int i, info; 6 | MpiInt errclass; 7 | 8 | info=MPI_Irecv(bp->Buff, bp->N, bp->dtype, src, msgid, ctxt->scp->comm, 9 | &bp->Aops[bp->nAops]); 10 | while(info != MPI_SUCCESS) 11 | { 12 | i=MPI_Error_class(info, &errclass); 13 | if ( (errclass != MPI_ERR_UNKNOWN) && (errclass != MPI_ERR_OTHER) && 14 | (errclass != MPI_ERR_INTERN) ) 15 | { 16 | Mmpierror(info, "MPI_Irecv", ctxt, __LINE__, __FILE__); 17 | BI_BlacsErr(BI_ContxtNum(ctxt), __LINE__, __FILE__, 18 | "MPI error %d on call to MPI_Irecv", info); 19 | } 20 | #if (BlacsDebugLvl > 0) 21 | else BI_BlacsWarn(BI_ContxtNum(ctxt), __LINE__, __FILE__, 22 | "MPI error %d assumed to mean out of non-blocking resources on call to MPI_Irecv", 23 | info); 24 | #endif 25 | info=MPI_Irecv(bp->Buff, bp->N, bp->dtype, src, msgid, ctxt->scp->comm, 26 | &bp->Aops[bp->nAops]); 27 | } 28 | bp->nAops++; 29 | /* 30 | * Signal if we need to use status to figure out true length of received message 31 | * We only need do this if we are doing our own buffering 32 | */ 33 | #ifndef MpiBuffGood 34 | if (bp->dtype == MPI_PACKED) bp->N = -bp->nAops; 35 | #endif 36 | } 37 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Asend.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_Asend(BLACSCONTEXT *ctxt, Int dest, Int msgid, BLACBUFF *bp) 4 | { 5 | Int i, info; 6 | MpiInt errclass; 7 | 8 | info=MPI_Isend(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm, 9 | &bp->Aops[bp->nAops]); 10 | while(info != MPI_SUCCESS) 11 | { 12 | i=MPI_Error_class(info, &errclass); 13 | if ( (errclass != MPI_ERR_UNKNOWN) && (errclass != MPI_ERR_OTHER) && 14 | (errclass != MPI_ERR_INTERN) ) 15 | { 16 | Mmpierror(info, "MPI_Isend", ctxt, __LINE__, __FILE__); 17 | BI_BlacsErr(BI_ContxtNum(ctxt), __LINE__, __FILE__, 18 | "MPI error %d on call to MPI_Isend", info); 19 | } 20 | #if (BlacsDebugLvl > 0) 21 | else BI_BlacsWarn(BI_ContxtNum(ctxt), __LINE__, __FILE__, 22 | "MPI error %d assumed to mean out of non-blocking resources on call to MPI_Isend", 23 | info); 24 | #endif 25 | info=MPI_Isend(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm, 26 | &bp->Aops[bp->nAops]); 27 | } 28 | bp->nAops++; 29 | } 30 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_BlacsAbort.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_BlacsAbort(Int ErrNo) 4 | { 5 | Int ierr; 6 | fflush(stderr); 7 | fflush(stdout); 8 | ierr=MPI_Abort(MPI_COMM_WORLD, ErrNo); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_BlacsErr.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_BlacsErr(Int ConTxt, Int line, char *file, char *form, ...) 4 | { 5 | #ifdef __STDC__ 6 | void BI_BlacsAbort(Int ErrNo); 7 | #else 8 | void BI_BlacsAbort(); 9 | #endif 10 | extern Int BI_Iam; 11 | Int myrow, mycol; 12 | va_list argptr; 13 | char cline[100]; 14 | BLACSCONTEXT *ctxt; 15 | 16 | va_start(argptr, form); 17 | vsprintf(cline, form, argptr); 18 | va_end(argptr); 19 | 20 | if (ConTxt > -1) 21 | { 22 | MGetConTxt(ConTxt, ctxt); 23 | myrow = ctxt->cscp.Iam; 24 | mycol = ctxt->rscp.Iam; 25 | } 26 | else myrow = mycol = -1; 27 | 28 | fprintf(stderr, 29 | "BLACS ERROR '%s'\nfrom {%d,%d}, pnum=%d, Contxt=%d, on line %d of file '%s'.\n\n", 30 | cline, myrow, mycol, BI_Iam, ConTxt, line, file); 31 | 32 | BI_BlacsAbort(1); 33 | } 34 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_BlacsWarn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_BlacsWarn(Int ConTxt, Int line, char *file, char *form, ...) 4 | { 5 | extern Int BI_Iam; 6 | extern BLACSCONTEXT **BI_MyContxts; 7 | Int myrow, mycol; 8 | va_list argptr; 9 | char cline[100]; 10 | 11 | va_start(argptr, form); 12 | vsprintf(cline, form, argptr); 13 | va_end(argptr); 14 | 15 | if (ConTxt > -1) 16 | { 17 | myrow = BI_MyContxts[ConTxt]->cscp.Iam; 18 | mycol = BI_MyContxts[ConTxt]->rscp.Iam; 19 | } 20 | else myrow = mycol = -1; 21 | 22 | fprintf(stderr, 23 | "BLACS WARNING '%s'\nfrom {%d,%d}, pnum=%d, Contxt=%d, on line %d of file '%s'.\n\n", 24 | cline, myrow, mycol, BI_Iam, ConTxt, line, file); 25 | } 26 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_BuffIsFree.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | Int BI_BuffIsFree(BLACBUFF *bp, Int Wait) 4 | /* 5 | * Check to see if buff is finished with async. operations. If Wait != 0, 6 | * wait for all async. operations to complete. 7 | */ 8 | { 9 | MpiInt i, info; 10 | extern MPI_Status *BI_Stats; 11 | extern Int BI_Np; 12 | 13 | 14 | if (!Wait) 15 | { 16 | info=MPI_Testall(bp->nAops, bp->Aops, &i, BI_Stats); 17 | if (!i) 18 | { 19 | /* 20 | * If we are doing our own Packing, need to check true length of receive 21 | */ 22 | #ifndef MpiBuffGood 23 | /* 24 | * If we have an outstanding receive, make sure that when it 25 | * completes we correctly set bp->N, if required 26 | */ 27 | if (bp->N < 0) 28 | { 29 | if (bp->Aops[-bp->N-1] == MPI_REQUEST_NULL) 30 | { 31 | info=MPI_Get_count(&BI_Stats[(-bp->N-1)*sizeof(MPI_Status)],MPI_PACKED, &i); 32 | if (i != MPI_UNDEFINED) bp->N = i; 33 | else BI_BlacsWarn(-1, __LINE__, __FILE__, 34 | "MPI_Get_count returned MPI_UNDEFINED.\n"); 35 | } 36 | } 37 | #endif 38 | return(0); 39 | } 40 | } 41 | else 42 | { 43 | info=MPI_Waitall(bp->nAops, bp->Aops, BI_Stats); 44 | } 45 | 46 | bp->nAops = 0; 47 | /* 48 | * If we are doing our own packing, need to check true length of receive 49 | */ 50 | #ifndef MpiBuffGood 51 | /* 52 | * If we had an outstanding receive, make sure that we correctly set bp->N, 53 | * if required 54 | */ 55 | if (bp->N < 0) 56 | { 57 | info=MPI_Get_count(&BI_Stats[(-bp->N-1)*sizeof(MPI_Status)],MPI_PACKED, &i); 58 | if (i != MPI_UNDEFINED) bp->N = i; 59 | else BI_BlacsWarn(-1, __LINE__, __FILE__, 60 | "MPI_Get_count returned MPI_UNDEFINED.\n"); 61 | } 62 | #endif 63 | return(1); 64 | } 65 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ContxtNum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | Int BI_ContxtNum(BLACSCONTEXT *ctxt) 4 | /* 5 | * Returns the integer ID of ctxt 6 | */ 7 | { 8 | Int i; 9 | extern Int BI_MaxNCtxt; 10 | extern BLACSCONTEXT **BI_MyContxts; 11 | 12 | if (ctxt == NULL) return(-1); 13 | for (i=0; i < BI_MaxNCtxt; i++) if (BI_MyContxts[i] == ctxt) break; 14 | if (i == BI_MaxNCtxt) 15 | BI_BlacsErr(-1, -1, "BLACS INTERNAL ROUTINE", "illegal context"); 16 | return(i); 17 | } 18 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_EmergencyBuff.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | /*************************************************************************** 4 | * If there is insufficient space to allocate a needed buffer, this * 5 | * routine is called. It moniters active buffers for the time defined by * 6 | * the user-changeable macro value BUFWAIT. If in that time no active * 7 | * buffer becomes inactive, a hang is assumed, and the grid is killed. * 8 | ***************************************************************************/ 9 | void BI_EmergencyBuff(Int length) 10 | { 11 | void BI_UpdateBuffs(BLACBUFF *); 12 | 13 | char *cptr; 14 | Int i, j; 15 | double Mwalltime(void); 16 | double t1; 17 | extern Int BI_Np; 18 | extern BLACBUFF *BI_ReadyB, *BI_ActiveQ; 19 | 20 | j = sizeof(BLACBUFF); 21 | if (j % sizeof(MPI_Request)) 22 | j += sizeof(MPI_Request) - j % sizeof(MPI_Request); 23 | i = j + BI_Np*sizeof(MPI_Request); 24 | if (i % BUFFALIGN) i += BUFFALIGN - i % BUFFALIGN; 25 | t1 = Mwalltime(); 26 | while ( (BI_ActiveQ) && (Mwalltime() - t1 < BUFWAIT) && !(BI_ReadyB) ) 27 | { 28 | BI_UpdateBuffs(NULL); 29 | if (BI_ReadyB) 30 | { 31 | if (BI_ReadyB->Len < length) 32 | { 33 | free(BI_ReadyB); 34 | cptr = malloc(length + i); 35 | BI_ReadyB = (BLACBUFF *) cptr; 36 | if (BI_ReadyB) 37 | { 38 | BI_ReadyB->nAops = 0; 39 | BI_ReadyB->Aops = (MPI_Request *) &cptr[j]; 40 | BI_ReadyB->Buff = &cptr[i]; 41 | BI_ReadyB->Len = length; 42 | } 43 | } 44 | } 45 | } 46 | if (BI_ReadyB == NULL) 47 | { 48 | BI_BlacsErr(-1, __LINE__, __FILE__, "BLACS out of buffer space"); 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_GetMpiGeType.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *ctxt, Int m, Int n, Int lda, 3 | MPI_Datatype Dtype, Int *N) 4 | { 5 | Int info; 6 | MPI_Datatype GeType; 7 | 8 | /* 9 | * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, 10 | * so we set type MPI_BYTE as a flag for a 0 byte message 11 | */ 12 | #ifdef ZeroByteTypeBug 13 | if ( (m < 1) || (n < 1) ) 14 | { 15 | *N = 0; 16 | return (MPI_BYTE); 17 | } 18 | #endif 19 | *N = 1; 20 | info=MPI_Type_vector(n, m, lda, Dtype, &GeType); 21 | info=MPI_Type_commit(&GeType); 22 | 23 | return(GeType); 24 | } 25 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_GlobalVars.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | /* 3 | * Define global variables 4 | */ 5 | Int BI_MaxNCtxt=0; /* Number of context pointers allocated */ 6 | Int BI_MaxNSysCtxt=0; /* Number of system ctxt ptrs allocated */ 7 | Int BI_Iam, BI_Np=(-1); /* My pnum, and # of procs in system */ 8 | BLACBUFF *BI_ReadyB=NULL; /* buffer that is ready for use */ 9 | BLACBUFF *BI_ActiveQ=NULL; /* pointer to start of active buffer queue */ 10 | BLACBUFF BI_AuxBuff; 11 | BLACSCONTEXT **BI_MyContxts=NULL; /* Array of pointers to my contexts */ 12 | MPI_Comm *BI_SysContxts=NULL; 13 | Int *BI_COMM_WORLD=NULL; 14 | MPI_Status *BI_Stats=NULL; 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_HypBR.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | Int BI_HypBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, Int src) 4 | { 5 | void BI_Srecv(BLACSCONTEXT *, Int, Int, BLACBUFF *); 6 | Int relnode, bit, Np, Iam, msgid; 7 | 8 | Np = ctxt->scp->Np; 9 | Iam = ctxt->scp->Iam; 10 | msgid = Mscopeid(ctxt); 11 | 12 | for (bit=2; bit < Np; bit <<= 1); 13 | if (bit^Np) return(NPOW2); /* not a power of 2 */ 14 | relnode = Iam ^ src; 15 | 16 | BI_Srecv(ctxt, BANYNODE, msgid, bp); 17 | for(bit=1; (bit^Np); bit <<= 1) 18 | if (bit > relnode) send(ctxt, Iam^bit, msgid, bp); 19 | 20 | return(0); 21 | } 22 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_HypBS.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | Int BI_HypBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send) 3 | { 4 | Int bit, Np, Iam, msgid; 5 | 6 | Np = ctxt->scp->Np; 7 | if (Np < 2) return(NORV); 8 | Iam = ctxt->scp->Iam; 9 | msgid = Mscopeid(ctxt); 10 | 11 | for (bit=2; bit < Np; bit <<= 1); 12 | if (bit^Np) return(NPOW2); /* not a power of 2 */ 13 | 14 | for(bit=1; (bit^Np); bit <<= 1) 15 | send(ctxt, (Iam^bit), msgid, bp); 16 | 17 | return(0); /* error-free return */ 18 | } 19 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_IdringBR.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_IdringBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, Int src, Int step) 4 | { 5 | void BI_Srecv(BLACSCONTEXT *, Int, Int, BLACBUFF *); 6 | Int Np, Iam, msgid, dest; 7 | 8 | Np = ctxt->scp->Np; 9 | Iam = ctxt->scp->Iam; 10 | dest = (Np + Iam + step) % Np; 11 | msgid = Mscopeid(ctxt); 12 | BI_Srecv(ctxt, BANYNODE, msgid, bp); 13 | if (dest != src) send(ctxt, dest, msgid, bp); 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_IdringBS.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_IdringBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, Int step) 4 | { 5 | Int Np, Iam, msgid; 6 | 7 | Np = ctxt->scp->Np; 8 | if (Np < 2) return; 9 | Iam = ctxt->scp->Iam; 10 | msgid = Mscopeid(ctxt); 11 | 12 | send(ctxt, (Np+Iam+step)%Np, msgid, bp); 13 | } 14 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_MpathBR.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_MpathBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, Int src, Int npaths) 4 | { 5 | void BI_Arecv(BLACSCONTEXT *, Int, Int, BLACBUFF *); 6 | Int BI_BuffIsFree(BLACBUFF *, Int); 7 | 8 | Int pathlen; /* the minimal length of each path */ 9 | Int mydist; /* my distance from src */ 10 | Int faredge; /* node at far end of path */ 11 | Int lastlong; /* distance to node on end of last path with extra node */ 12 | Int Np, Iam, msgid, Np_1, dest; 13 | 14 | msgid = Mscopeid(ctxt); 15 | BI_Arecv(ctxt, BANYNODE, msgid, bp); 16 | Np = ctxt->scp->Np; 17 | Iam = ctxt->scp->Iam; 18 | Np_1 = Np - 1; 19 | if (npaths == FULLCON) npaths = Np_1; 20 | 21 | if (npaths > 0) 22 | { 23 | dest = (Iam+1) % Np; 24 | mydist = (Np + Iam - src) % Np; 25 | } 26 | else 27 | { 28 | dest = (Np_1+Iam) % Np; 29 | mydist = (Np + src - Iam) % Np; 30 | npaths = -npaths; 31 | } 32 | /* 33 | * Make sure npaths is cool 34 | */ 35 | if (npaths > Np_1) npaths = Np_1; 36 | 37 | pathlen = Np_1 / npaths; 38 | lastlong = (Np_1%npaths) * (pathlen+1); 39 | if (lastlong) 40 | { 41 | if (mydist <= lastlong) faredge = ((mydist-1)/(pathlen+1)+1)*(pathlen+1); 42 | else faredge = ((lastlong-1)/(pathlen+1)+1) * (pathlen+1) 43 | + ((mydist-lastlong-1)/pathlen + 1) * pathlen; 44 | } 45 | else faredge = ((mydist-1)/pathlen + 1) * pathlen; 46 | 47 | BI_BuffIsFree(bp, 1); /* wait for recv to complete */ 48 | if (mydist < faredge) send(ctxt, dest, msgid, bp); 49 | } 50 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_MpathBS.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_MpathBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, Int npaths) 4 | { 5 | Int pathlen; /* the length of each path */ 6 | Int dist; /* the distance to the node closest to src on each path */ 7 | Int pdest; /* part of dest calculation -- saves unneeded ops */ 8 | Int lastlong; /* number of paths with extra node */ 9 | Int Np, Iam, msgid, Np_1, dir; 10 | 11 | Np = ctxt->scp->Np; 12 | if (Np < 2) return; 13 | Iam = ctxt->scp->Iam; 14 | msgid = Mscopeid(ctxt); 15 | Np_1 = Np - 1; 16 | if (npaths == FULLCON) npaths = Np_1; 17 | 18 | if (npaths > 0) /* paths are increasing rings */ 19 | { 20 | pdest = Iam; 21 | dir = 1; 22 | } 23 | else /* paths are decreasing rings */ 24 | { 25 | pdest = Np + Iam; 26 | dir = -1; 27 | npaths = -npaths; 28 | } 29 | /* 30 | * Ensure npaths is correct 31 | */ 32 | if (npaths > Np_1) npaths = Np_1; 33 | pathlen = Np_1 / npaths; 34 | 35 | /* 36 | * Loop over all long paths (paths with an extra node), if there are any 37 | */ 38 | lastlong = (Np_1 % npaths) * (pathlen+1); /* last node in long ring */ 39 | for (dist=1; dist < lastlong; dist += pathlen+1) 40 | send(ctxt, (pdest+dir*dist)%Np, msgid, bp); 41 | 42 | /* 43 | * Loop over all normal length paths 44 | */ 45 | while (dist < Np) 46 | { 47 | send(ctxt, (pdest+dir*dist)%Np, msgid, bp); 48 | dist += pathlen; 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Pack.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | BLACBUFF *BI_Pack(BLACSCONTEXT *ctxt,BVOID *A,BLACBUFF *bp,MPI_Datatype Dtype) 3 | { 4 | BLACBUFF *BI_GetBuff(Int); 5 | MpiInt i, info, one=1; 6 | MPI_Aint eltsiz; 7 | #ifdef ZeroByteTypeBug 8 | char *cptr; 9 | extern BLACBUFF BI_AuxBuff; 10 | extern Int BI_Np; 11 | #endif 12 | 13 | /* 14 | * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, 15 | * so we have set MPI_BYTE as a flag for a 0 byte message 16 | */ 17 | #ifdef ZeroByteTypeBug 18 | if (Dtype == MPI_BYTE) 19 | { 20 | info = sizeof(BLACBUFF); 21 | if (info % sizeof(MPI_Request)) 22 | info += sizeof(MPI_Request) - info % sizeof(MPI_Request); 23 | i = info + BI_Np*sizeof(MPI_Request); 24 | if (i % BUFFALIGN) i += BUFFALIGN - i % BUFFALIGN; 25 | cptr = malloc(i); 26 | if (cptr) 27 | { 28 | bp = (BLACBUFF *) cptr; 29 | bp->Len = bp->N = bp->nAops = 0; 30 | bp->Aops = (MPI_Request *) &cptr[info]; 31 | bp->Buff = (char *) &bp->Len; 32 | bp->dtype = MPI_BYTE; 33 | return(bp); 34 | } 35 | else BI_BlacsErr(BI_ContxtNum(ctxt), __LINE__, __FILE__, 36 | "Not enough memory to allocate 0 byte buffer\n"); 37 | } 38 | #endif 39 | if (bp == NULL) 40 | { 41 | info=MPI_Pack_size(one, Dtype, ctxt->scp->comm, &i); 42 | bp = BI_GetBuff(i); 43 | } 44 | 45 | i = 0; 46 | info=MPI_Pack(A, one, Dtype, bp->Buff, bp->Len, &i, ctxt->scp->comm); 47 | bp->dtype = MPI_PACKED; 48 | bp->N = i; 49 | 50 | return(bp); 51 | } 52 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Rsend.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | 4 | void BI_Rsend(BLACSCONTEXT *ctxt, Int dest, Int msgid, BLACBUFF *bp) 5 | { 6 | Int info; 7 | 8 | info=MPI_Rsend(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Srecv.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_Srecv(BLACSCONTEXT *ctxt, Int src, Int msgid, BLACBUFF *bp) 4 | { 5 | Int i, info; 6 | extern MPI_Status *BI_Stats; 7 | 8 | info=MPI_Recv(bp->Buff, bp->N, bp->dtype, src, msgid, ctxt->scp->comm,BI_Stats); 9 | /* 10 | * If we are doing our own buffering, need to determine the true length of 11 | * the message just received 12 | */ 13 | #ifndef MpiBuffGood 14 | if (bp->dtype == MPI_PACKED) 15 | { 16 | info=MPI_Get_count(BI_Stats, MPI_PACKED, &i); 17 | if (i != MPI_UNDEFINED) bp->N = i; 18 | else BI_BlacsWarn(BI_ContxtNum(ctxt), __LINE__, __FILE__, 19 | "MPI_Get_count returned MPI_UNDEFINED.\n"); 20 | } 21 | #endif 22 | } 23 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_SringBR.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_SringBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, Int src) 4 | { 5 | void BI_Srecv(BLACSCONTEXT *, Int, Int, BLACBUFF *); 6 | 7 | Int mydist; /* my distance from source */ 8 | Int Np, Iam, msgid, rightedge; 9 | 10 | Np = ctxt->scp->Np; 11 | Iam = ctxt->scp->Iam; 12 | msgid = Mscopeid(ctxt); 13 | 14 | mydist = (Np + Iam - src) % Np; 15 | rightedge = Np/2; 16 | BI_Srecv(ctxt, BANYNODE, msgid, bp); 17 | 18 | /* 19 | * If I'm between source & right edge of split ring, send to right 20 | */ 21 | if (mydist < rightedge) 22 | send(ctxt, (Iam+1)%Np, msgid, bp); 23 | /* 24 | * If I'm between source and left edge of split ring, send to left 25 | */ 26 | else if (mydist > rightedge+1) 27 | send(ctxt, (Np+Iam-1)%Np, msgid, bp); 28 | } 29 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_SringBS.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_SringBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send) 4 | { 5 | Int Np, Iam, msgid; 6 | 7 | Np = ctxt->scp->Np; 8 | if (Np < 2) return; 9 | Iam = ctxt->scp->Iam; 10 | msgid = Mscopeid(ctxt); 11 | send(ctxt, (Iam + 1)%Np, msgid, bp); 12 | if (Np > 2) send(ctxt, (Np + Iam - 1)%Np, msgid, bp); 13 | } 14 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Ssend.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_Ssend(BLACSCONTEXT *ctxt, Int dest, Int msgid, BLACBUFF *bp) 4 | { 5 | Int info; 6 | info=MPI_Send(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm); 7 | } 8 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_TransDist.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_TransDist(BLACSCONTEXT *ctxt, char scope, Int m, Int n, Int *rA, 4 | Int *cA, Int ldrc, BI_DistType *dist, Int rdest, Int cdest) 5 | /* 6 | * This routine translates distances (offsets from the destination node), 7 | * stored in location dist, into row and column coordinates. 8 | */ 9 | { 10 | Int i, j, k, dest; 11 | Int Ng, nprow, npcol, myrow, mycol; 12 | 13 | Mgridinfo(ctxt, Ng, nprow, npcol, myrow, mycol); 14 | if (rdest == -1) rdest = cdest = 0; 15 | 16 | switch (scope) 17 | { 18 | case 'r': 19 | for (j=0; j < n; j++) 20 | { 21 | for (i=0; i < m; i++) 22 | { 23 | rA[i] = myrow; 24 | cA[i] = (Int) (cdest + dist[i]) % npcol; 25 | } 26 | rA += ldrc; 27 | cA += ldrc; 28 | dist += m; 29 | } 30 | break; 31 | case 'c': 32 | for (j=0; j < n; j++) 33 | { 34 | for (i=0; i < m; i++) 35 | { 36 | rA[i] = (Int) (rdest + dist[i]) % nprow; 37 | cA[i] = mycol; 38 | } 39 | rA += ldrc; 40 | cA += ldrc; 41 | dist += m; 42 | } 43 | break; 44 | case 'a': 45 | dest = Mvkpnum(ctxt, rdest, cdest); 46 | for (j=0; j < n; j++) 47 | { 48 | for (i=0; i < m; i++) 49 | { 50 | k = (Int) (dest + dist[i]) % Ng; /* figure node number */ 51 | Mvpcoord(ctxt, k, rA[i], cA[i]); /* figure node coordinates */ 52 | } 53 | rA += ldrc; 54 | cA += ldrc; 55 | dist += m; 56 | } 57 | } 58 | } 59 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_TransUserComm.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | MPI_Comm BI_TransUserComm(Int Ucomm, Int Np, Int *pmap) 4 | { 5 | MPI_Comm bcomm, ucomm; 6 | MPI_Group bgrp, ugrp; 7 | Int i; 8 | 9 | MpiInt *mpmap = (MpiInt *)malloc(Np * sizeof(MpiInt)); 10 | for (i=0; iscp->Np; 11 | if (Np < 2) return; 12 | Iam = ctxt->scp->Iam; 13 | msgid = Mscopeid(ctxt); 14 | mydist = (Np + Iam - src) % Np; 15 | 16 | /* 17 | * Go up to first step of tree where I send data to other nodes 18 | */ 19 | for (i=nbranches; i < Np; i *= nbranches); 20 | for (i /= nbranches; (mydist%i); i /= nbranches); 21 | BI_Srecv(ctxt, BANYNODE, msgid, bp); 22 | 23 | /* 24 | * While I need to send data to others 25 | */ 26 | while ( (i > 1) && !(mydist%i) ) 27 | { 28 | i /= nbranches; 29 | j = 1; 30 | do 31 | { 32 | destdist = mydist + j*i; 33 | if (destdist < Np) 34 | send(ctxt, (src+destdist)%Np, msgid, bp); 35 | } 36 | while(++j < nbranches); 37 | } 38 | 39 | } /* end BI_TreeBR */ 40 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_Unpack.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_Unpack(BLACSCONTEXT *ctxt, BVOID *A, BLACBUFF *bp, MPI_Datatype Dtype) 4 | { 5 | MpiInt i=0, info, one=1; 6 | 7 | /* 8 | * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, 9 | * so we have set MPI_BYTE as a flag for a 0 byte message 10 | */ 11 | #ifdef ZeroByteTypeBug 12 | if (Dtype == MPI_BYTE) return; 13 | #endif 14 | info=MPI_Unpack(bp->Buff, bp->Len, &i, A, one, Dtype, ctxt->scp->comm); 15 | info=MPI_Type_free(&Dtype); 16 | } 17 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_UpdateBuffs.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_UpdateBuffs(BLACBUFF *Newbp) 4 | { 5 | Int BI_BuffIsFree(BLACBUFF *, Int); 6 | BLACBUFF *bp, *bp2; 7 | extern BLACBUFF *BI_ReadyB, *BI_ActiveQ; 8 | 9 | if (Newbp) 10 | { 11 | if (BI_ActiveQ == NULL) BI_ActiveQ = Newbp->prev = Newbp; 12 | else 13 | { 14 | BI_ActiveQ->prev->next = Newbp; 15 | Newbp->prev = BI_ActiveQ->prev; 16 | BI_ActiveQ->prev = Newbp; 17 | } 18 | Newbp->next = NULL; 19 | if (Newbp == BI_ReadyB) BI_ReadyB = NULL; 20 | } 21 | /* 22 | * See if any active buffers are ready for reuse. 23 | */ 24 | for (bp=BI_ActiveQ; bp != NULL; bp = bp2) 25 | { 26 | bp2 = bp->next; 27 | if ( BI_BuffIsFree(bp, 0) ) /* if all of buff's Aops are done */ 28 | { 29 | /* 30 | * Remove bp from BI_ActiveQ -- update pointers 31 | */ 32 | if (bp->next) bp->next->prev = bp->prev; 33 | else BI_ActiveQ->prev = bp->prev; 34 | if (bp != BI_ActiveQ) bp->prev->next = bp->next; 35 | else BI_ActiveQ = BI_ActiveQ->next; 36 | 37 | /* 38 | * If no ready buffer, inactive buff becomes ready 39 | */ 40 | if (BI_ReadyB == NULL) BI_ReadyB = bp; 41 | /* 42 | * If inactive buff bigger than present ready buff, release ready, 43 | * and inactive buff becomes ready 44 | */ 45 | else if (BI_ReadyB->Len < bp->Len) 46 | { 47 | free(BI_ReadyB); 48 | BI_ReadyB = bp; 49 | } 50 | /* 51 | * If ready buffer exists and is bigger than inactive buff, 52 | * free inactive buff 53 | */ 54 | else free(bp); 55 | } 56 | } 57 | } /* end BI_UpdateBuffs */ 58 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cMPI_amn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_cMPI_amn(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_cvvamn(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_cvvamn(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cMPI_amn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cMPI_amn2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_cvvamn2(Int, char *, char *); 5 | BI_cvvamn2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cMPI_amx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_cMPI_amx(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_cvvamx(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_cvvamx(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cMPI_amx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cMPI_amx2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_cvvamx2(Int, char *, char *); 5 | BI_cvvamx2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cMPI_sum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cMPI_sum(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_cvvsum(Int, char *, char *); 5 | BI_cvvsum(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cvvamn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cvvamn(Int N, char *vec1, char *vec2) 3 | { 4 | SCOMPLEX *v1=(SCOMPLEX*)vec1, *v2=(SCOMPLEX*)vec2; 5 | float diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(SCOMPLEX); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Cabs(v1[k]) - Cabs(v2[k]); 18 | if (diff > 0) 19 | { 20 | v1[k].r = v2[k].r; 21 | v1[k].i = v2[k].i; 22 | dist1[k] = dist2[k]; 23 | } 24 | else if (diff == 0) 25 | { 26 | if (dist1[k] > dist2[k]) 27 | { 28 | v1[k].r = v2[k].r; 29 | v1[k].i = v2[k].i; 30 | dist1[k] = dist2[k]; 31 | } 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cvvamn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cvvamn2(Int N, char *vec1, char *vec2) 3 | { 4 | Int r, i; 5 | float *v1=(float*)vec1, *v2=(float*)vec2; 6 | float diff; 7 | 8 | N *= 2; 9 | for (r=0, i=1; r != N; r += 2, i += 2) 10 | { 11 | diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); 12 | if (diff > 0) 13 | { 14 | v1[r] = v2[r]; 15 | v1[i] = v2[i]; 16 | } 17 | else if (diff == 0) 18 | { 19 | if (v1[r] != v2[r]) 20 | { 21 | if (v1[r] < v2[r]) 22 | { 23 | v1[r] = v2[r]; 24 | v1[i] = v2[i]; 25 | } 26 | } 27 | else 28 | { 29 | if (v1[i] < v2[i]) 30 | { 31 | v1[r] = v2[r]; 32 | v1[i] = v2[i]; 33 | } 34 | } 35 | } 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cvvamx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cvvamx(Int N, char *vec1, char *vec2) 3 | { 4 | SCOMPLEX *v1=(SCOMPLEX*)vec1, *v2=(SCOMPLEX*)vec2; 5 | float diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(SCOMPLEX); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Cabs(v1[k]) - Cabs(v2[k]); 18 | if (diff < 0) 19 | { 20 | v1[k].r = v2[k].r; 21 | v1[k].i = v2[k].i; 22 | dist1[k] = dist2[k]; 23 | } 24 | else if (diff == 0) 25 | { 26 | if (dist1[k] > dist2[k]) 27 | { 28 | v1[k].r = v2[k].r; 29 | v1[k].i = v2[k].i; 30 | dist1[k] = dist2[k]; 31 | } 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cvvamx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cvvamx2(Int N, char *vec1, char *vec2) 3 | { 4 | Int r, i; 5 | float *v1=(float*)vec1, *v2=(float*)vec2; 6 | float diff; 7 | 8 | N *= 2; 9 | for (r=0, i=1; r != N; r += 2, i += 2) 10 | { 11 | diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); 12 | if (diff < 0) 13 | { 14 | v1[r] = v2[r]; 15 | v1[i] = v2[i]; 16 | } 17 | else if (diff == 0) 18 | { 19 | if (v1[r] != v2[r]) 20 | { 21 | if (v1[r] < v2[r]) 22 | { 23 | v1[r] = v2[r]; 24 | v1[i] = v2[i]; 25 | } 26 | } 27 | else 28 | { 29 | if (v1[i] < v2[i]) 30 | { 31 | v1[r] = v2[r]; 32 | v1[i] = v2[i]; 33 | } 34 | } 35 | } 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_cvvsum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_cvvsum(Int N, char *vec1, char *vec2) 3 | { 4 | float *v1=(float*)vec1, *v2=(float*)vec2; 5 | Int k; 6 | N *=2; 7 | for (k=0; k < N; k++) v1[k] += v2[k]; 8 | } 9 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dMPI_amn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_dMPI_amn(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_dvvamn(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_dvvamn(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dMPI_amn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dMPI_amn2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_dvvamn2(Int, char *, char *); 5 | BI_dvvamn2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dMPI_amx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_dMPI_amx(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_dvvamx(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_dvvamx(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dMPI_amx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dMPI_amx2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_dvvamx2(Int, char *, char *); 5 | BI_dvvamx2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dmvcopy.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dmvcopy(Int m, Int n, double *A, Int lda, double *buff) 3 | /* 4 | * Performs a matrix to vector copy (pack) for the data type double 5 | */ 6 | { 7 | Int i, j; 8 | 9 | if ( (m == lda) || (n == 1) ) 10 | { 11 | m = n * m; 12 | for (i=0; i < m; i++) buff[i] = A[i]; 13 | } 14 | else if (m == 1) 15 | { 16 | for (j=0; j < n; j++) buff[j] = A[j*lda]; 17 | } 18 | else 19 | { 20 | for (j=0; j < n; j++) 21 | { 22 | for (i=0; i < m; i++) buff[i] = A[i]; 23 | A += lda; 24 | buff += m; 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dvmcopy.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_dvmcopy(Int m, Int n, double *A, Int lda, double *buff) 4 | /* 5 | * performs an vector to matrix copy (unpack) for the data type double 6 | */ 7 | { 8 | Int i, j; 9 | 10 | if ( (m == lda) || (n == 1) ) 11 | { 12 | m = n * m; 13 | for (i=0; i < m; i++) A[i] = buff[i]; 14 | } 15 | else if (m == 1) 16 | { 17 | for (j=0; j < n; j++) A[j*lda] = buff[j]; 18 | } 19 | else 20 | { 21 | for (j=0; j< n; j++) 22 | { 23 | for (i=0; i < m; i++) A[i] = buff[i]; 24 | A += lda; 25 | buff += m; 26 | } 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dvvamn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dvvamn(Int N, char *vec1, char *vec2) 3 | { 4 | double *v1=(double*)vec1, *v2=(double*)vec2; 5 | double diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(double); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Rabs(v1[k]) - Rabs(v2[k]); 18 | if (diff > 0) 19 | { 20 | v1[k] = v2[k]; 21 | dist1[k] = dist2[k]; 22 | } 23 | else if (diff == 0) 24 | { 25 | if (dist1[k] > dist2[k]) 26 | { 27 | v1[k] = v2[k]; 28 | dist1[k] = dist2[k]; 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dvvamn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dvvamn2(Int N, char *vec1, char *vec2) 3 | { 4 | Int k; 5 | double *v1=(double*)vec1, *v2=(double*)vec2; 6 | double diff; 7 | 8 | for (k=0; k != N; k++) 9 | { 10 | diff = Rabs(v1[k]) - Rabs(v2[k]); 11 | if (diff > 0) v1[k] = v2[k]; 12 | else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dvvamx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dvvamx(Int N, char *vec1, char *vec2) 3 | { 4 | double *v1=(double*)vec1, *v2=(double*)vec2; 5 | double diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(double); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Rabs(v1[k]) - Rabs(v2[k]); 18 | if (diff < 0) 19 | { 20 | v1[k] = v2[k]; 21 | dist1[k] = dist2[k]; 22 | } 23 | else if (diff == 0) 24 | { 25 | if (dist1[k] > dist2[k]) 26 | { 27 | v1[k] = v2[k]; 28 | dist1[k] = dist2[k]; 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dvvamx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dvvamx2(Int N, char *vec1, char *vec2) 3 | { 4 | Int k; 5 | double *v1=(double*)vec1, *v2=(double*)vec2; 6 | double diff; 7 | 8 | for (k=0; k != N; k++) 9 | { 10 | diff = Rabs(v1[k]) - Rabs(v2[k]); 11 | if (diff < 0) v1[k] = v2[k]; 12 | else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_dvvsum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_dvvsum(Int N, char *vec1, char *vec2) 3 | { 4 | double *v1=(double*)vec1, *v2=(double*)vec2; 5 | Int k; 6 | for (k=0; k < N; k++) v1[k] += v2[k]; 7 | } 8 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_iMPI_amn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_iMPI_amn(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_ivvamn(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_ivvamn(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_iMPI_amn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_iMPI_amn2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_ivvamn2(Int, char *, char *); 5 | BI_ivvamn2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_iMPI_amx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_iMPI_amx(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_ivvamx(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_ivvamx(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_iMPI_amx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_iMPI_amx2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_ivvamx2(Int, char *, char *); 5 | BI_ivvamx2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_imvcopy.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_imvcopy(Int m, Int n, Int *A, Int lda, Int *buff) 3 | /* 4 | * Performs a matrix to vector copy (pack) for the data type Int 5 | */ 6 | { 7 | Int i, j; 8 | 9 | if ( (m == lda) || (n == 1) ) 10 | { 11 | m = n * m; 12 | for (i=0; i < m; i++) buff[i] = A[i]; 13 | } 14 | else if (m == 1) 15 | { 16 | for (j=0; j < n; j++) buff[j] = A[j*lda]; 17 | } 18 | else 19 | { 20 | for (j=0; j < n; j++) 21 | { 22 | for (i=0; i < m; i++) buff[i] = A[i]; 23 | A += lda; 24 | buff += m; 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ivmcopy.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_ivmcopy(Int m, Int n, Int *A, Int lda, Int *buff) 4 | /* 5 | * performs an vector to matrix copy (unpack) for the data type Int 6 | */ 7 | { 8 | Int i, j; 9 | 10 | if ( (m == lda) || (n == 1) ) 11 | { 12 | m = n * m; 13 | for (i=0; i < m; i++) A[i] = buff[i]; 14 | } 15 | else if (m == 1) 16 | { 17 | for (j=0; j < n; j++) A[j*lda] = buff[j]; 18 | } 19 | else 20 | { 21 | for (j=0; j< n; j++) 22 | { 23 | for (i=0; i < m; i++) A[i] = buff[i]; 24 | A += lda; 25 | buff += m; 26 | } 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ivvamn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_ivvamn(Int N, char *vec1, char *vec2) 3 | { 4 | Int *v1=(Int*)vec1, *v2=(Int*)vec2; 5 | Int diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(Int); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Rabs(v1[k]) - Rabs(v2[k]); 18 | if (diff > 0) 19 | { 20 | v1[k] = v2[k]; 21 | dist1[k] = dist2[k]; 22 | } 23 | else if (diff == 0) 24 | { 25 | if (dist1[k] > dist2[k]) 26 | { 27 | v1[k] = v2[k]; 28 | dist1[k] = dist2[k]; 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ivvamn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_ivvamn2(Int N, char *vec1, char *vec2) 4 | { 5 | Int k; 6 | Int *v1=(Int*)vec1, *v2=(Int*)vec2; 7 | Int diff; 8 | 9 | for (k=0; k != N; k++) 10 | { 11 | diff = Rabs(v1[k]) - Rabs(v2[k]); 12 | if (diff > 0) v1[k] = v2[k]; 13 | else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ivvamx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_ivvamx(Int N, char *vec1, char *vec2) 3 | { 4 | Int *v1=(Int*)vec1, *v2=(Int*)vec2; 5 | Int diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(Int); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Rabs(v1[k]) - Rabs(v2[k]); 18 | if (diff < 0) 19 | { 20 | v1[k] = v2[k]; 21 | dist1[k] = dist2[k]; 22 | } 23 | else if (diff == 0) 24 | { 25 | if (dist1[k] > dist2[k]) 26 | { 27 | v1[k] = v2[k]; 28 | dist1[k] = dist2[k]; 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ivvamx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_ivvamx2(Int N, char *vec1, char *vec2) 3 | { 4 | Int k; 5 | Int *v1=(Int*)vec1, *v2=(Int*)vec2; 6 | Int diff; 7 | 8 | for (k=0; k != N; k++) 9 | { 10 | diff = Rabs(v1[k]) - Rabs(v2[k]); 11 | if (diff < 0) v1[k] = v2[k]; 12 | else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_ivvsum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_ivvsum(Int N, char *vec1, char *vec2) 3 | { 4 | Int *v1=(Int*)vec1, *v2=(Int*)vec2; 5 | Int k; 6 | for (k=0; k < N; k++) v1[k] += v2[k]; 7 | } 8 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_sMPI_amn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_sMPI_amn(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_svvamn(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_svvamn(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_sMPI_amn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_sMPI_amn2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_svvamn2(Int, char *, char *); 5 | BI_svvamn2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_sMPI_amx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_sMPI_amx(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_svvamx(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_svvamx(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_sMPI_amx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_sMPI_amx2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_svvamx2(Int, char *, char *); 5 | BI_svvamx2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_smvcopy.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_smvcopy(Int m, Int n, float *A, Int lda, float *buff) 3 | /* 4 | * Performs a matrix to vector copy (pack) for the data type float 5 | */ 6 | { 7 | Int i, j; 8 | 9 | if ( (m == lda) || (n == 1) ) 10 | { 11 | m = n * m; 12 | for (i=0; i < m; i++) buff[i] = A[i]; 13 | } 14 | else if (m == 1) 15 | { 16 | for (j=0; j < n; j++) buff[j] = A[j*lda]; 17 | } 18 | else 19 | { 20 | for (j=0; j < n; j++) 21 | { 22 | for (i=0; i < m; i++) buff[i] = A[i]; 23 | A += lda; 24 | buff += m; 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_svmcopy.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_svmcopy(Int m, Int n, float *A, Int lda, float *buff) 4 | /* 5 | * performs an vector to matrix copy (unpack) for the data type float 6 | */ 7 | { 8 | Int i, j; 9 | 10 | if ( (m == lda) || (n == 1) ) 11 | { 12 | m = n * m; 13 | for (i=0; i < m; i++) A[i] = buff[i]; 14 | } 15 | else if (m == 1) 16 | { 17 | for (j=0; j < n; j++) A[j*lda] = buff[j]; 18 | } 19 | else 20 | { 21 | for (j=0; j< n; j++) 22 | { 23 | for (i=0; i < m; i++) A[i] = buff[i]; 24 | A += lda; 25 | buff += m; 26 | } 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_svvamn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_svvamn(Int N, char *vec1, char *vec2) 3 | { 4 | float *v1=(float*)vec1, *v2=(float*)vec2; 5 | float diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(float); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Rabs(v1[k]) - Rabs(v2[k]); 18 | if (diff > 0) 19 | { 20 | v1[k] = v2[k]; 21 | dist1[k] = dist2[k]; 22 | } 23 | else if (diff == 0) 24 | { 25 | if (dist1[k] > dist2[k]) 26 | { 27 | v1[k] = v2[k]; 28 | dist1[k] = dist2[k]; 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_svvamn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_svvamn2(Int N, char *vec1, char *vec2) 3 | { 4 | Int k; 5 | float *v1=(float*)vec1, *v2=(float*)vec2; 6 | float diff; 7 | 8 | for (k=0; k != N; k++) 9 | { 10 | diff = Rabs(v1[k]) - Rabs(v2[k]); 11 | if (diff > 0) v1[k] = v2[k]; 12 | else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_svvamx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_svvamx(Int N, char *vec1, char *vec2) 3 | { 4 | float *v1=(float*)vec1, *v2=(float*)vec2; 5 | float diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(float); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Rabs(v1[k]) - Rabs(v2[k]); 18 | if (diff < 0) 19 | { 20 | v1[k] = v2[k]; 21 | dist1[k] = dist2[k]; 22 | } 23 | else if (diff == 0) 24 | { 25 | if (dist1[k] > dist2[k]) 26 | { 27 | v1[k] = v2[k]; 28 | dist1[k] = dist2[k]; 29 | } 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_svvamx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_svvamx2(Int N, char *vec1, char *vec2) 3 | { 4 | Int k; 5 | float *v1=(float*)vec1, *v2=(float*)vec2; 6 | float diff; 7 | 8 | for (k=0; k != N; k++) 9 | { 10 | diff = Rabs(v1[k]) - Rabs(v2[k]); 11 | if (diff < 0) v1[k] = v2[k]; 12 | else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_svvsum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_svvsum(Int N, char *vec1, char *vec2) 3 | { 4 | float *v1=(float*)vec1, *v2=(float*)vec2; 5 | Int k; 6 | for (k=0; k < N; k++) v1[k] += v2[k]; 7 | } 8 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zMPI_amn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_zMPI_amn(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_zvvamn(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_zvvamn(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zMPI_amn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zMPI_amn2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_zvvamn2(Int, char *, char *); 5 | BI_zvvamn2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zMPI_amx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | void BI_zMPI_amx(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 4 | { 5 | void BI_zvvamx(Int, char *, char *); 6 | extern BLACBUFF BI_AuxBuff; 7 | 8 | BI_zvvamx(BI_AuxBuff.Len, inout, in); 9 | } 10 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zMPI_amx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zMPI_amx2(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_zvvamx2(Int, char *, char *); 5 | BI_zvvamx2(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zMPI_sum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zMPI_sum(void *in, void *inout, MpiInt *N, MPI_Datatype *dtype) 3 | { 4 | void BI_zvvsum(Int, char *, char *); 5 | BI_zvvsum(*N, inout, in); 6 | } 7 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zvvamn.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zvvamn(Int N, char *vec1, char *vec2) 3 | { 4 | DCOMPLEX *v1=(DCOMPLEX*)vec1, *v2=(DCOMPLEX*)vec2; 5 | double diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(DCOMPLEX); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Cabs(v1[k]) - Cabs(v2[k]); 18 | if (diff > 0) 19 | { 20 | v1[k].r = v2[k].r; 21 | v1[k].i = v2[k].i; 22 | dist1[k] = dist2[k]; 23 | } 24 | else if (diff == 0) 25 | { 26 | if (dist1[k] > dist2[k]) 27 | { 28 | v1[k].r = v2[k].r; 29 | v1[k].i = v2[k].i; 30 | dist1[k] = dist2[k]; 31 | } 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zvvamn2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zvvamn2(Int N, char *vec1, char *vec2) 3 | { 4 | Int r, i; 5 | double *v1=(double*)vec1, *v2=(double*)vec2; 6 | double diff; 7 | 8 | N *= 2; 9 | for (r=0, i=1; r != N; r += 2, i += 2) 10 | { 11 | diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); 12 | if (diff > 0) 13 | { 14 | v1[r] = v2[r]; 15 | v1[i] = v2[i]; 16 | } 17 | else if (diff == 0) 18 | { 19 | if (v1[r] != v2[r]) 20 | { 21 | if (v1[r] < v2[r]) 22 | { 23 | v1[r] = v2[r]; 24 | v1[i] = v2[i]; 25 | } 26 | } 27 | else 28 | { 29 | if (v1[i] < v2[i]) 30 | { 31 | v1[r] = v2[r]; 32 | v1[i] = v2[i]; 33 | } 34 | } 35 | } 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zvvamx.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zvvamx(Int N, char *vec1, char *vec2) 3 | { 4 | DCOMPLEX *v1=(DCOMPLEX*)vec1, *v2=(DCOMPLEX*)vec2; 5 | double diff; 6 | BI_DistType *dist1, *dist2; 7 | Int i, k; 8 | 9 | k = N * sizeof(DCOMPLEX); 10 | i = k % sizeof(BI_DistType); 11 | if (i) k += sizeof(BI_DistType) - i; 12 | dist1 = (BI_DistType *) &vec1[k]; 13 | dist2 = (BI_DistType *) &vec2[k]; 14 | 15 | for (k=0; k < N; k++) 16 | { 17 | diff = Cabs(v1[k]) - Cabs(v2[k]); 18 | if (diff < 0) 19 | { 20 | v1[k].r = v2[k].r; 21 | v1[k].i = v2[k].i; 22 | dist1[k] = dist2[k]; 23 | } 24 | else if (diff == 0) 25 | { 26 | if (dist1[k] > dist2[k]) 27 | { 28 | v1[k].r = v2[k].r; 29 | v1[k].i = v2[k].i; 30 | dist1[k] = dist2[k]; 31 | } 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zvvamx2.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zvvamx2(Int N, char *vec1, char *vec2) 3 | { 4 | Int r, i; 5 | double *v1=(double*)vec1, *v2=(double*)vec2; 6 | double diff; 7 | 8 | N *= 2; 9 | for (r=0, i=1; r != N; r += 2, i += 2) 10 | { 11 | diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); 12 | if (diff < 0) 13 | { 14 | v1[r] = v2[r]; 15 | v1[i] = v2[i]; 16 | } 17 | else if (diff == 0) 18 | { 19 | if (v1[r] != v2[r]) 20 | { 21 | if (v1[r] < v2[r]) 22 | { 23 | v1[r] = v2[r]; 24 | v1[i] = v2[i]; 25 | } 26 | } 27 | else 28 | { 29 | if (v1[i] < v2[i]) 30 | { 31 | v1[r] = v2[r]; 32 | v1[i] = v2[i]; 33 | } 34 | } 35 | } 36 | } 37 | } 38 | -------------------------------------------------------------------------------- /BLACS/SRC/BI_zvvsum.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | void BI_zvvsum(Int N, char *vec1, char *vec2) 3 | { 4 | double *v1=(double*)vec1, *v2=(double*)vec2; 5 | Int k; 6 | N *=2; 7 | for (k=0; k < N; k++) v1[k] += v2[k]; 8 | } 9 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs2sys_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | #if (INTFACE == C_CALL) 3 | MPI_Comm Cblacs2sys_handle(Int BlacsCtxt) 4 | #else 5 | Int blacs2sys_handle_(Int *BlacsCtxt) 6 | #endif 7 | { 8 | #if (INTFACE == C_CALL) 9 | Int i[2]; 10 | extern Int BI_MaxNSysCtxt; 11 | extern MPI_Comm *BI_SysContxts; 12 | 13 | if (BI_COMM_WORLD == NULL) Cblacs_pinfo(i, &i[1]); 14 | if ( (BlacsCtxt >= BI_MaxNSysCtxt) || (BlacsCtxt < 0) ) 15 | { 16 | BI_BlacsErr(-1, __LINE__, __FILE__, 17 | "No system context corresponding to BLACS system context handle %d\n", 18 | BlacsCtxt); 19 | } 20 | else if (BI_SysContxts[BlacsCtxt] == MPI_COMM_NULL) 21 | { 22 | BI_BlacsErr(-1, __LINE__, __FILE__, 23 | "No system context corresponding to BLACS system context handle %d\n", 24 | BlacsCtxt); 25 | } 26 | return(BI_SysContxts[BlacsCtxt]); 27 | #else 28 | return(*BlacsCtxt); 29 | #endif 30 | } 31 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_abort_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_abort(Int ConTxt, Int ErrNo) 5 | #else 6 | F_VOID_FUNC blacs_abort_(Int *ConTxt, Int *ErrNo) 7 | #endif 8 | { 9 | void Cblacs_gridinfo(Int, Int *, Int *, Int *, Int *); 10 | void BI_BlacsAbort(Int ErrNo); 11 | Int nprow, npcol, myrow, mycol; 12 | extern Int BI_Iam; 13 | 14 | Cblacs_gridinfo(Mpval(ConTxt), &nprow, &npcol, &myrow, &mycol); 15 | fprintf(stderr, 16 | "{%d,%d}, pnum=%d, Contxt=%d, killed other procs, exiting with error #%d.\n\n", 17 | myrow, mycol, BI_Iam, Mpval(ConTxt), Mpval(ErrNo)); 18 | 19 | BI_BlacsAbort(Mpval(ErrNo)); 20 | } 21 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_barr_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_barrier(Int ConTxt, char *scope) 5 | #else 6 | F_VOID_FUNC blacs_barrier_(Int *ConTxt, F_CHAR scope) 7 | #endif 8 | { 9 | char tscope; 10 | Int ierr; 11 | BLACSCONTEXT *ctxt; 12 | 13 | tscope = F2C_CharTrans(scope); 14 | tscope = Mlowcase(tscope); 15 | MGetConTxt(Mpval(ConTxt), ctxt); 16 | switch(tscope) 17 | { 18 | case 'r': 19 | MPI_Barrier(ctxt->rscp.comm); 20 | break; 21 | case 'c': 22 | MPI_Barrier(ctxt->cscp.comm); 23 | break; 24 | case 'a': 25 | MPI_Barrier(ctxt->ascp.comm); 26 | break; 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_exit_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_exit(Int NotDone) 5 | #else 6 | F_VOID_FUNC blacs_exit_(Int *NotDone) 7 | #endif 8 | { 9 | void Cblacs_gridexit(Int); 10 | void BI_UpdateBuffs(BLACBUFF *); 11 | BLACBUFF *BI_GetBuff(Int); 12 | Int BI_BuffIsFree(BLACBUFF *, Int); 13 | BLACBUFF *bp; 14 | extern BLACBUFF *BI_ReadyB, *BI_ActiveQ, BI_AuxBuff; 15 | extern MPI_Status *BI_Stats; 16 | Int i; 17 | extern Int BI_MaxNCtxt, BI_Np; 18 | extern BLACSCONTEXT **BI_MyContxts; 19 | /* 20 | * Destroy all contexts 21 | */ 22 | for (i=0; i < BI_MaxNCtxt; i++) if (BI_MyContxts[i]) Cblacs_gridexit(i); 23 | free(BI_MyContxts); 24 | 25 | if (BI_ReadyB) free(BI_ReadyB); 26 | while (BI_ActiveQ != NULL) 27 | { 28 | bp = BI_ActiveQ; 29 | BI_BuffIsFree(bp, 1); /* wait for async sends to complete */ 30 | BI_ActiveQ = bp->next; 31 | free(bp); 32 | } 33 | free (BI_AuxBuff.Aops); 34 | free (BI_Stats); 35 | 36 | /* 37 | * Reset parameters to initial values 38 | */ 39 | BI_MaxNCtxt = 0; 40 | BI_MyContxts = NULL; 41 | BI_Np = -1; 42 | if (!Mpval(NotDone)) 43 | { 44 | free(BI_COMM_WORLD); 45 | BI_COMM_WORLD = NULL; 46 | MPI_Finalize(); 47 | } 48 | BI_ReadyB = NULL; 49 | BI_ActiveQ = NULL; 50 | BI_AuxBuff.Aops = NULL; 51 | BI_Stats = NULL; 52 | } 53 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_free_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_freebuff(Int ConTxt, Int Wait) 5 | #else 6 | F_VOID_FUNC blacs_freebuff_(Int *ConTxt, Int *Wait) 7 | #endif 8 | { 9 | void BI_UpdateBuffs(BLACBUFF *); 10 | Int BI_BuffIsFree(BLACBUFF *, Int); 11 | extern BLACBUFF *BI_ReadyB, *BI_ActiveQ; 12 | 13 | if (Mpval(Wait)) /* wait for all buffers to be done */ 14 | { 15 | while (BI_ActiveQ != NULL) BI_UpdateBuffs(NULL); 16 | } 17 | else BI_UpdateBuffs(NULL); 18 | 19 | if (BI_ReadyB) 20 | { 21 | free(BI_ReadyB); 22 | BI_ReadyB = NULL; 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_get_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | #if (INTFACE == C_CALL) 3 | void Cblacs_get(Int ConTxt, Int what, Int *val) 4 | #else 5 | F_VOID_FUNC blacs_get_(Int *ConTxt, Int *what, Int *val) 6 | #endif 7 | { 8 | Int Csys2blacs_handle(MPI_Comm); 9 | Int ierr, *iptr; 10 | MpiInt flag; 11 | Int comm; 12 | BLACSCONTEXT *ctxt; 13 | 14 | switch( Mpval(what) ) 15 | { 16 | case SGET_SYSCONTXT: 17 | if (BI_COMM_WORLD == NULL) Cblacs_pinfo(val, &ierr); 18 | #if (INTFACE == C_CALL) 19 | *val = Csys2blacs_handle(MPI_COMM_WORLD); 20 | #else 21 | *val = *BI_COMM_WORLD; 22 | #endif 23 | break; 24 | case SGET_MSGIDS: 25 | if (BI_COMM_WORLD == NULL) Cblacs_pinfo(val, &val[1]); 26 | iptr = &val[1]; 27 | ierr=MPI_Comm_get_attr(MPI_COMM_WORLD, MPI_TAG_UB, (BVOID **) &iptr,&flag); 28 | val[0] = 0; 29 | val[1] = *iptr; 30 | break; 31 | case SGET_DEBUGLVL: 32 | *val = BlacsDebugLvl; 33 | break; 34 | case SGET_BLACSCONTXT: 35 | MGetConTxt(Mpval(ConTxt), ctxt); 36 | #if (INTFACE == C_CALL) 37 | *val = Csys2blacs_handle(ctxt->pscp.comm); 38 | #else /* if user called the fortran interface to the BLACS */ 39 | *val = MPI_Comm_c2f(ctxt->pscp.comm); 40 | #endif 41 | break; 42 | case SGET_NR_BS: 43 | MGetConTxt(Mpval(ConTxt), ctxt); 44 | *val = ctxt->Nr_bs; 45 | break; 46 | case SGET_NB_BS: 47 | MGetConTxt(Mpval(ConTxt), ctxt); 48 | *val = ctxt->Nb_bs - 1; 49 | break; 50 | case SGET_NR_CO: 51 | MGetConTxt(Mpval(ConTxt), ctxt); 52 | *val = ctxt->Nr_co; 53 | break; 54 | case SGET_NB_CO: 55 | MGetConTxt(Mpval(ConTxt), ctxt); 56 | *val = ctxt->Nb_co - 1; 57 | break; 58 | case SGET_TOPSREPEAT: 59 | MGetConTxt(Mpval(ConTxt), ctxt); 60 | *val = ctxt->TopsRepeat; 61 | break; 62 | case SGET_TOPSCOHRNT: 63 | MGetConTxt(Mpval(ConTxt), ctxt); 64 | *val = ctxt->TopsCohrnt; 65 | break; 66 | default: 67 | BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Unknown WHAT (%d)", 68 | Mpval(what)); 69 | } 70 | } 71 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_grid_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_gridexit(Int ConTxt) 5 | #else 6 | F_VOID_FUNC blacs_gridexit_(Int *ConTxt) 7 | #endif 8 | { 9 | Int i; 10 | BLACSCONTEXT *ctxt; 11 | extern Int BI_MaxNCtxt; 12 | extern BLACSCONTEXT **BI_MyContxts; 13 | 14 | if ( (Mpval(ConTxt) < 0) || (Mpval(ConTxt) >= BI_MaxNCtxt) ) 15 | BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, 16 | "Trying to exit non-existent context"); 17 | 18 | if (BI_MyContxts[Mpval(ConTxt)] == NULL) 19 | BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, 20 | "Trying to exit an already freed context"); 21 | 22 | MGetConTxt(Mpval(ConTxt), ctxt); 23 | /* 24 | * Destroy context 25 | */ 26 | MPI_Comm_free(&ctxt->pscp.comm); 27 | MPI_Comm_free(&ctxt->ascp.comm); 28 | MPI_Comm_free(&ctxt->rscp.comm); 29 | MPI_Comm_free(&ctxt->cscp.comm); 30 | free(ctxt); 31 | BI_MyContxts[Mpval(ConTxt)] = NULL; 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_info_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_gridinfo(Int ConTxt, Int *nprow, Int *npcol, Int *myrow, Int *mycol) 5 | #else 6 | F_VOID_FUNC blacs_gridinfo_(Int *ConTxt, Int *nprow, Int *npcol, 7 | Int *myrow, Int *mycol) 8 | #endif 9 | { 10 | extern BLACSCONTEXT **BI_MyContxts; 11 | extern Int BI_MaxNCtxt; 12 | BLACSCONTEXT *ctxt; 13 | /* 14 | * Make sure context handle is in range 15 | */ 16 | if ( (Mpval(ConTxt) >= 0) && (Mpval(ConTxt) < BI_MaxNCtxt) ) 17 | { 18 | /* 19 | * Make sure context is still defined 20 | */ 21 | ctxt = BI_MyContxts[Mpval(ConTxt)]; 22 | if (ctxt != NULL) 23 | { 24 | *nprow = ctxt->cscp.Np; 25 | *npcol = ctxt->rscp.Np; 26 | *myrow = ctxt->cscp.Iam; 27 | *mycol = ctxt->rscp.Iam; 28 | } 29 | else *nprow = *npcol = *myrow = *mycol = -1; 30 | } 31 | else *nprow = *npcol = *myrow = *mycol = -1; 32 | } 33 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_init_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_gridinit(Int *ConTxt, char *order, Int nprow, Int npcol) 5 | #else 6 | F_VOID_FUNC blacs_gridinit_(Int *ConTxt, F_CHAR order, Int *nprow, Int *npcol) 7 | #endif 8 | { 9 | void Cblacs_gridmap(Int *, Int *, Int, Int, Int); 10 | Int *tmpgrid, *iptr; 11 | Int i, j; 12 | 13 | /* 14 | * Grid can be row- or column-major natural ordering when blacs_gridinit is 15 | * called. Define a tmpgrid to reflect this, and call blacs_gridmap to 16 | * set it up 17 | */ 18 | iptr = tmpgrid = (Int*) malloc( Mpval(nprow)*Mpval(npcol)*sizeof(*tmpgrid) ); 19 | if (Mlowcase(F2C_CharTrans(order)) == 'c') 20 | { 21 | i = Mpval(npcol) * Mpval(nprow); 22 | for (j=0; j < i; j++) iptr[j] = j; 23 | } 24 | else 25 | { 26 | for (j=0; j < Mpval(npcol); j++) 27 | { 28 | for (i=0; i < Mpval(nprow); i++) iptr[i] = i * Mpval(npcol) + j; 29 | iptr += Mpval(nprow); 30 | } 31 | } 32 | #if (INTFACE == C_CALL) 33 | Cblacs_gridmap(ConTxt, tmpgrid, nprow, nprow, npcol); 34 | #else 35 | blacs_gridmap_(ConTxt, tmpgrid, nprow, nprow, npcol); 36 | #endif 37 | free(tmpgrid); 38 | } 39 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_pcoord_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_pcoord(Int ConTxt, Int nodenum, Int *prow, Int *pcol) 5 | #else 6 | F_VOID_FUNC blacs_pcoord_(Int *ConTxt, Int *nodenum, Int *prow, Int *pcol) 7 | #endif 8 | { 9 | BLACSCONTEXT *ctxt; 10 | 11 | MGetConTxt(Mpval(ConTxt), ctxt); 12 | if ( (Mpval(nodenum) >= 0) && (Mpval(nodenum) < ctxt->ascp.Np) ) 13 | { 14 | Mpcoord(ctxt, Mpval(nodenum), *prow, *pcol); 15 | } 16 | else *prow = *pcol = -1; 17 | } 18 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_pinfo_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_pinfo(Int *mypnum, Int *nprocs) 5 | #else 6 | F_VOID_FUNC blacs_pinfo_(Int *mypnum, Int *nprocs) 7 | #endif 8 | { 9 | Int ierr; 10 | extern Int BI_Iam, BI_Np; 11 | MpiInt flag, Iam = BI_Iam, Np = BI_Np; 12 | MpiInt argc=0; 13 | char **argv=NULL; 14 | if (BI_COMM_WORLD == NULL) 15 | { 16 | MPI_Initialized(&flag); 17 | 18 | if (!flag) 19 | ierr = MPI_Init(&argc,&argv); // call Init and ignore argc and argv 20 | 21 | BI_COMM_WORLD = (Int *) malloc(sizeof(Int)); 22 | *BI_COMM_WORLD = MPI_Comm_c2f(MPI_COMM_WORLD); 23 | } 24 | MPI_Comm_size(MPI_COMM_WORLD, &Np); 25 | MPI_Comm_rank(MPI_COMM_WORLD, &Iam); 26 | *mypnum = BI_Iam = Iam; 27 | *nprocs = BI_Np = Np; 28 | } 29 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_pnum_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | Int Cblacs_pnum(Int ConTxt, Int prow, Int pcol) 5 | #else 6 | F_INT_FUNC blacs_pnum_(Int *ConTxt, Int *prow, Int *pcol) 7 | #endif 8 | { 9 | BLACSCONTEXT *ctxt; 10 | 11 | MGetConTxt(Mpval(ConTxt), ctxt); 12 | if ( (Mpval(prow) >= 0) && (Mpval(prow) < ctxt->cscp.Np) && 13 | (Mpval(pcol) >= 0) && (Mpval(pcol) < ctxt->rscp.Np) ) 14 | return( Mkpnum(ctxt, Mpval(prow), Mpval(pcol)) ); 15 | else return(-1); 16 | } 17 | -------------------------------------------------------------------------------- /BLACS/SRC/blacs_setup_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cblacs_setup(Int *mypnum, Int *nprocs) 5 | #else 6 | F_VOID_FUNC blacs_setup_(Int *mypnum, Int *nprocs) 7 | #endif 8 | { 9 | /* 10 | * blacs_setup same as blacs_pinfo for non-PVM versions of the BLACS 11 | */ 12 | void Cblacs_pinfo(Int *, Int *); 13 | Cblacs_pinfo(mypnum, nprocs); 14 | } 15 | -------------------------------------------------------------------------------- /BLACS/SRC/dcputime00_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | double Cdcputime00(void) 5 | #else 6 | F_DOUBLE_FUNC dcputime00_(void) 7 | #endif 8 | { 9 | return(-1.0); 10 | } 11 | -------------------------------------------------------------------------------- /BLACS/SRC/dwalltime00_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | double Cdwalltime00(void) 5 | #else 6 | F_DOUBLE_FUNC dwalltime00_(void) 7 | #endif 8 | { 9 | return(MPI_Wtime()); 10 | } 11 | -------------------------------------------------------------------------------- /BLACS/SRC/free_handle_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | void Cfree_blacs_system_handle(Int ISysCtxt) 5 | #else 6 | void free_blacs_system_handle_(Int *ISysCxt) 7 | #endif 8 | { 9 | #if (INTFACE == C_CALL) 10 | Int i, j, DEF_WORLD; 11 | MPI_Comm *tSysCtxt; 12 | extern Int BI_MaxNSysCtxt; 13 | extern MPI_Comm *BI_SysContxts; 14 | 15 | 16 | if ( (ISysCtxt < BI_MaxNSysCtxt) && (ISysCtxt > 0) ) 17 | { 18 | if (BI_SysContxts[ISysCtxt] != MPI_COMM_NULL) 19 | BI_SysContxts[ISysCtxt] = MPI_COMM_NULL; 20 | else BI_BlacsWarn(-1, __LINE__, __FILE__, 21 | "Trying to free non-existent system context handle %d", ISysCtxt); 22 | } 23 | else if (ISysCtxt == 0) return; /* never free MPI_COMM_WORLD */ 24 | else BI_BlacsWarn(-1, __LINE__, __FILE__, 25 | "Trying to free non-existent system context handle %d", ISysCtxt); 26 | 27 | /* 28 | * See if we have freed enough space to decrease the size of our table 29 | */ 30 | for (i=j=0; i < BI_MaxNSysCtxt; i++) 31 | if (BI_SysContxts[i] == MPI_COMM_NULL) j++; 32 | /* 33 | * If needed, get a smaller system context array 34 | */ 35 | if (j > 2*MAXNSYSCTXT) 36 | { 37 | j = BI_MaxNSysCtxt - MAXNSYSCTXT; 38 | tSysCtxt = (MPI_Comm *) malloc(j * sizeof(MPI_Comm)); 39 | for (i=j=0; i < BI_MaxNSysCtxt; i++) 40 | { 41 | if (BI_SysContxts[i] != MPI_COMM_NULL) 42 | tSysCtxt[j++] = BI_SysContxts[i]; 43 | } 44 | BI_MaxNSysCtxt -= MAXNSYSCTXT; 45 | for(; j < BI_MaxNSysCtxt; j++) tSysCtxt[j] = MPI_COMM_NULL; 46 | free(BI_SysContxts); 47 | BI_SysContxts = tSysCtxt; 48 | } 49 | #endif 50 | } 51 | -------------------------------------------------------------------------------- /BLACS/SRC/kbrid_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | Int Ckbrid(Int ConTxt, char *scope, Int rsrc, Int csrc) 5 | #else 6 | F_INT_FUNC kbrid_(Int *ConTxt, F_CHAR scope, Int *rsrc, Int *csrc) 7 | #endif 8 | { 9 | Int msgid; 10 | char tmpscope; 11 | BLACSCONTEXT *ctxt; 12 | 13 | MGetConTxt(Mpval(ConTxt), ctxt); 14 | tmpscope = Mlowcase(F2C_CharTrans(scope)); 15 | switch(tmpscope) 16 | { 17 | case 'c' : 18 | ctxt->scp = &ctxt->cscp; 19 | break; 20 | case 'r' : 21 | ctxt->scp = &ctxt->cscp; 22 | break; 23 | case 'a' : 24 | ctxt->scp = &ctxt->cscp; 25 | break; 26 | } 27 | msgid = Mscopeid(ctxt); 28 | return (msgid); 29 | } 30 | -------------------------------------------------------------------------------- /BLACS/SRC/kbsid_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | Int Ckbsid(Int ConTxt, char *scope) 5 | #else 6 | F_INT_FUNC kbsid_(Int *ConTxt, F_CHAR scope) 7 | #endif 8 | { 9 | char tmpscope; 10 | Int msgid; 11 | BLACSCONTEXT *ctxt; 12 | 13 | MGetConTxt(Mpval(ConTxt), ctxt); 14 | tmpscope = Mlowcase(F2C_CharTrans(scope)); 15 | switch(tmpscope) 16 | { 17 | case 'c' : 18 | ctxt->scp = &ctxt->cscp; 19 | break; 20 | case 'r' : 21 | ctxt->scp = &ctxt->rscp; 22 | break; 23 | case 'a' : 24 | ctxt->scp = &ctxt->ascp; 25 | break; 26 | } 27 | msgid = Mscopeid(ctxt); 28 | return(msgid); 29 | } 30 | -------------------------------------------------------------------------------- /BLACS/SRC/krecvid_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | Int Ckrecvid(Int ConTxt, Int rsrc, Int csrc) 5 | #else 6 | F_INT_FUNC krecvid_(Int *ConTxt, Int *rsrc, Int *csrc) 7 | #endif 8 | { 9 | return(PT2PTID+1); 10 | } /* end krecvid */ 11 | -------------------------------------------------------------------------------- /BLACS/SRC/ksendid_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | Int Cksendid(Int ConTxt, Int rdest, Int cdest) 5 | #else 6 | F_INT_FUNC ksendid_(Int *ConTxt, Int *rdest, Int *cdest) 7 | #endif 8 | { 9 | return(PT2PTID+1); 10 | } /* end ksendid */ 11 | -------------------------------------------------------------------------------- /BLACS/SRC/src-C.c.in: -------------------------------------------------------------------------------- 1 | #define CallFromC 2 | #include "@CMAKE_CURRENT_SOURCE_DIR@/@src@" 3 | -------------------------------------------------------------------------------- /BLACS/SRC/sys2blacs_.c: -------------------------------------------------------------------------------- 1 | #include "Bdef.h" 2 | 3 | #if (INTFACE == C_CALL) 4 | Int Csys2blacs_handle(MPI_Comm SysCtxt) 5 | #else 6 | Int sys2blacs_handle_(Int *SysCtxt) 7 | #endif 8 | { 9 | #if (INTFACE == C_CALL) 10 | Int i, j, DEF_WORLD; 11 | MPI_Comm *tSysCtxt; 12 | extern Int BI_MaxNSysCtxt; 13 | extern MPI_Comm *BI_SysContxts; 14 | 15 | if (BI_COMM_WORLD == NULL) 16 | Cblacs_pinfo(&i, &j); 17 | if (SysCtxt == MPI_COMM_NULL) 18 | BI_BlacsErr(-1, __LINE__, __FILE__, 19 | "Cannot define a BLACS system handle based on MPI_COMM_NULL"); 20 | /* 21 | * See if we already have this system handle stored 22 | */ 23 | for (i=0; i < BI_MaxNSysCtxt; i++) 24 | if (BI_SysContxts[i] == SysCtxt) return(i); 25 | /* 26 | * The first time in this routine, we need to define MPI_COMM_WORLD, if it isn't 27 | * what is already being defined. 28 | */ 29 | DEF_WORLD = ( (!BI_SysContxts) && (SysCtxt != MPI_COMM_WORLD) ); 30 | /* 31 | * Find free slot in system context array 32 | */ 33 | for (i=0; i < BI_MaxNSysCtxt; i++) 34 | if (BI_SysContxts[i] == MPI_COMM_NULL) break; 35 | /* 36 | * If needed, get a bigger system context array 37 | */ 38 | if (i == BI_MaxNSysCtxt) 39 | { 40 | j = BI_MaxNSysCtxt + MAXNSYSCTXT; 41 | if ( (MAXNSYSCTXT == 1) && (DEF_WORLD) ) j++; 42 | tSysCtxt = (MPI_Comm *) malloc(j * sizeof(MPI_Comm)); 43 | for (i=0; i < BI_MaxNSysCtxt; i++) tSysCtxt[i] = BI_SysContxts[i]; 44 | BI_MaxNSysCtxt = j; 45 | for (j=i; j < BI_MaxNSysCtxt; j++) tSysCtxt[j] = MPI_COMM_NULL; 46 | if (BI_SysContxts) free(BI_SysContxts); 47 | BI_SysContxts = tSysCtxt; 48 | } 49 | if (DEF_WORLD) BI_SysContxts[i++] = MPI_COMM_WORLD; 50 | BI_SysContxts[i] = SysCtxt; 51 | return(i); 52 | #else 53 | return(*SysCtxt); 54 | #endif 55 | } 56 | -------------------------------------------------------------------------------- /BLACS/TESTING/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set(FTestObj 2 | blacstest.f btprim.f tools.f) 3 | 4 | if ("${CMAKE_Fortran_COMPILER_ID}" STREQUAL "GNU" AND CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) 5 | set_source_files_properties(blacstest.f PROPERTIES COMPILE_FLAGS "-std=legacy") 6 | endif() 7 | 8 | add_executable(xFbtest ${FTestObj}) 9 | target_link_libraries(xFbtest scalapack MPI::MPI_Fortran) 10 | 11 | set(CTestObj 12 | Cbt.c) 13 | 14 | set_property( 15 | SOURCE Cbt.c 16 | APPEND PROPERTY COMPILE_DEFINITIONS BTCINTFACE 17 | ) 18 | 19 | add_executable(xCbtest ${CTestObj} ${FTestObj}) 20 | target_link_libraries(xCbtest scalapack MPI::MPI_Fortran) 21 | 22 | file(COPY bsbr.dat DESTINATION ${SCALAPACK_BINARY_DIR}/BLACS/TESTING) 23 | file(COPY bt.dat DESTINATION ${SCALAPACK_BINARY_DIR}/BLACS/TESTING) 24 | file(COPY comb.dat DESTINATION ${SCALAPACK_BINARY_DIR}/BLACS/TESTING) 25 | file(COPY sdrv.dat DESTINATION ${SCALAPACK_BINARY_DIR}/BLACS/TESTING) 26 | 27 | # We could run the BLACS TESTING the following way 28 | # But BLACS TESTING are TESTING anormal exit so even if they pass, 29 | # CTest will determine they fail 30 | #add_test(xFbtest0 ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xFbtest) 31 | #add_test(xCbtest0 ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xCbtest) 32 | 33 | add_test(xCbtest 34 | ${CMAKE_COMMAND} 35 | -DMPIEXEC=${MPIEXEC} 36 | -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} 37 | -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} 38 | -DTEST_PROG=xCbtest 39 | -DOUTPUTDIR=${SCALAPACK_BINARY_DIR}/BLACS/TESTING 40 | -DRUNTIMEDIR=${CMAKE_RUNTIME_OUTPUT_DIRECTORY} 41 | -DSOURCEDIR=${CMAKE_CURRENT_SOURCE_DIR} 42 | -P ${CMAKE_CURRENT_SOURCE_DIR}/runtest.cmake 43 | ) 44 | 45 | add_test(xFbtest 46 | ${CMAKE_COMMAND} 47 | -DMPIEXEC=${MPIEXEC} 48 | -DMPIEXEC_NUMPROC_FLAG=${MPIEXEC_NUMPROC_FLAG} 49 | -DMPIEXEC_PREFLAGS=${MPIEXEC_PREFLAGS} 50 | -DTEST_PROG=xFbtest 51 | -DOUTPUTDIR=${SCALAPACK_BINARY_DIR}/BLACS/TESTING 52 | -DRUNTIMEDIR=${CMAKE_RUNTIME_OUTPUT_DIRECTORY} 53 | -DSOURCEDIR=${CMAKE_CURRENT_SOURCE_DIR} 54 | -P ${CMAKE_CURRENT_SOURCE_DIR}/runtest.cmake 55 | ) 56 | -------------------------------------------------------------------------------- /BLACS/TESTING/Cbt.h: -------------------------------------------------------------------------------- 1 | #define ADD_ 0 2 | #define NOCHANGE 1 3 | #define UPCASE 2 4 | 5 | #ifndef Int 6 | #define Int int 7 | #endif 8 | 9 | #ifdef UpCase 10 | #define F77_CALL_C UPCASE 11 | #endif 12 | 13 | #ifdef NoChange 14 | #define F77_CALL_C NOCHANGE 15 | #endif 16 | 17 | #ifdef Add_ 18 | #define F77_CALL_C ADD_ 19 | #endif 20 | 21 | #ifndef F77_CALL_C 22 | #define F77_CALL_C ADD_ 23 | #endif 24 | -------------------------------------------------------------------------------- /BLACS/TESTING/Makefile: -------------------------------------------------------------------------------- 1 | include ../../SLmake.inc 2 | 3 | # --------------------------------------------------------------------- 4 | # The file tools.f contains some LAPACK routines that the tester calls. 5 | # If you have ScaLAPACK, you may point to your tools library instead 6 | # of compiling this file. 7 | # --------------------------------------------------------------------- 8 | tools = tools.o 9 | 10 | exe : all 11 | ctest : xCbtest 12 | ftest : xFbtest 13 | all : xCbtest xFbtest 14 | 15 | obj = blacstest.o btprim.o 16 | 17 | xCbtest: $(obj) $(tools) 18 | $(CC) -c $(CDEFS) $(CCFLAGS) -DBTCINTFACE Cbt.c 19 | $(FCLOADER) $(FCLOADFLAGS) -o $@ $(obj) $(tools) Cbt.o ../../$(SCALAPACKLIB) 20 | 21 | xFbtest: $(obj) $(tools) 22 | $(FCLOADER) $(FCLOADFLAGS) -o $@ $(obj) $(tools) ../../$(SCALAPACKLIB) 23 | 24 | # -------------------------------------------------------------------- 25 | # The files tools.f and blacstest.f are compiled without optimization. 26 | # Tools.f contains the LAPACK routines slamch and dlamch, which only 27 | # operate correctly for low-levels of optimization. Blacstest.f is 28 | # extremely large, and optimizing it takes a long time. More 29 | # importantly, the sun's f77 compiler seems to produce errors in 30 | # trying to optimize such a large file. We therefore insist that it 31 | # also not be optimized. 32 | # -------------------------------------------------------------------- 33 | tools.o : tools.f 34 | $(FC) $(NOOPT) -c $*.f 35 | 36 | blacstest.o : blacstest.f 37 | $(FC) $(NOOPT) -c $*.f 38 | 39 | btprim.o : btprim.f 40 | $(FC) -c $(FCFLAGS) $*.f 41 | 42 | clean : 43 | rm -f $(obj) tools.o Cbt.o xCbtest xFbtest 44 | 45 | .f.o: ; $(FC) -c $(FCFLAGS) $*.f 46 | 47 | .c.o: 48 | $(CC) -c $(CDEFS) $(CCFLAGS) $< 49 | -------------------------------------------------------------------------------- /BLACS/TESTING/README: -------------------------------------------------------------------------------- 1 | (1) To compile, just type "make". You must first edit and correct the 2 | file BLACS/Bmake.inc. Sample Bmake.inc's can be found in the 3 | BLACS/BMAKES directories. See the paper "Installing and testing the BLACS" 4 | for details. 5 | 6 | (2) Type "make clean" to get rid of old .o files. 7 | 8 | (3) The file blacstest.f is extremely large (roughly 20,000 lines), 9 | and this may be too large to compile on some systems. If you have this 10 | problem, a slight modification to the BLACS/TESTING Makefile should allow 11 | you to split blacstest.f into smaller files. 12 | -------------------------------------------------------------------------------- /BLACS/TESTING/bsbr.dat: -------------------------------------------------------------------------------- 1 | 3 Number of scopes 2 | 'R' 'C' 'A' values for scopes 3 | 8 Number of topologies 4 | 'I' 'S' '1' 'd' 'm' ' ' 'T' 'H' TOP 5 | 5 Number of shapes 6 | 'G' 'U' 'U' 'L' 'L' UPLO 7 | 'E' 'U' 'N' 'U' 'N' DIAG 8 | 5 Number of matrices 9 | 2 1 25 13 0 M 10 | 2 7 19 32 0 N 11 | 3 3 25 14 1 LDASRC 12 | 2 2 25 22 1 LDADEST 13 | 4 Number of src/dest pairs 14 | 0 1 3 2 RSRC 15 | 0 0 1 1 CSRC 16 | 4 Number of grids 17 | 2 4 1 1 7 1 4 NPROW 18 | 2 1 3 4 1 8 2 NPCOL 19 | -------------------------------------------------------------------------------- /BLACS/TESTING/bt.dat: -------------------------------------------------------------------------------- 1 | 'Sample BLACS tester run' Comment line 2 | 6 device out 3 | 'blacstest.out' output fname 4 | 'T' Run SDRV? 5 | 'T' Run BSBR? 6 | 'T' Run COMB? 7 | 'T' Run AUX? 8 | 5 Number of precisions 9 | 'I' 'S' 'D' 'C' 'Z' Values for precision 10 | 0 Verbosity level 11 | -------------------------------------------------------------------------------- /BLACS/TESTING/comb.dat: -------------------------------------------------------------------------------- 1 | 3 Number of OPs 2 | '+' '>' '<' Combine operations to perform 3 | 3 Number of scopes 4 | 'R' 'C' 'A' values for scopes 5 | 2 Repeatability flag (0=no-rep, 1=rep, 2=both) 6 | 2 Coherence flag (0=no-coh, 1=coh, 2=both) 7 | 4 Number of topologies 8 | ' ' 'T' 'H' 'f' 'M' TOP 9 | 6 Number of matrices 10 | 3 1 2 25 13 0 M 11 | 5 1 3 19 32 0 N 12 | 5 1 4 25 14 1 LDASRC 13 | 9 1 5 25 22 1 LDADEST 14 | 4 1 -1 25 22 1 LDI 15 | 4 Number of dests 16 | 0 -1 0 2 RDEST 17 | 0 -1 1 0 CDEST 18 | 4 Number of grids 19 | 2 1 4 1 1 8 3 NPROW 20 | 2 4 1 3 7 1 2 NPCOL 21 | -------------------------------------------------------------------------------- /BLACS/TESTING/runtest.cmake: -------------------------------------------------------------------------------- 1 | message("Running BLACS TESTS") 2 | message(STATUS "${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./${TEST_PROG}") 3 | message(STATUS "Output out_${TEST_PROG}.txt") 4 | file(COPY ${RUNTIMEDIR}/${TEST_PROG} DESTINATION ${OUTPUTDIR}) 5 | 6 | execute_process(COMMAND ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./${TEST_PROG} 7 | OUTPUT_FILE "out_${TEST_PROG}.txt" 8 | ERROR_FILE "error_${TEST_PROG}.txt" 9 | RESULT_VARIABLE HAD_ERROR) 10 | 11 | if(HAD_ERROR) 12 | # This is normal to exit in Error (good behaviour) 13 | # So we are going to check that the output have the last line of the testing : DONE BLACS_GRIDEXIT 14 | file(READ "out_${TEST_PROG}.txt" TESTSTRING) 15 | 16 | STRING(REPLACE "DONE BLACS_GRIDEXIT" "BLACS OK" tmp ${TESTSTRING}) 17 | 18 | if("${tmp}" STREQUAL "${TESTSTRING}") 19 | message( STATUS "Error in error_${TEST_PROG}.txt") 20 | message(FATAL_ERROR "Test failed - Test did not reach DONE BLACS_GRIDEXIT") 21 | else() 22 | message( STATUS "Test Passed") 23 | endif() 24 | endif() 25 | -------------------------------------------------------------------------------- /BLACS/TESTING/sdrv.dat: -------------------------------------------------------------------------------- 1 | 5 Number of shapes 2 | 'G' 'U' 'U' 'L' 'L' UPLO 3 | 'E' 'U' 'N' 'U' 'N' DIAG 4 | 5 Number of matrices 5 | 2 1 25 13 0 M 6 | 2 7 19 32 0 N 7 | 2 3 25 14 1 LDASRC 8 | 3 2 25 22 1 LDADEST 9 | 1 Number of src/dest pairs 10 | 0 1 3 0 RSRC 11 | 0 0 0 2 CSRC 12 | 0 1 2 0 RDEST 13 | 1 1 0 0 CDEST 14 | 3 Number of grids 15 | 2 4 1 NPROW 16 | 2 1 4 NPCOL 17 | -------------------------------------------------------------------------------- /CMAKE/FortranMangling.cmake: -------------------------------------------------------------------------------- 1 | # Macro that defines variables describing the Fortran name mangling 2 | # convention 3 | # 4 | # Sets the following outputs on success: 5 | # 6 | # INTFACE 7 | # Add_ 8 | # NoChange 9 | # f77IsF2C 10 | # UpCase 11 | # 12 | 13 | include_guard() 14 | 15 | block() 16 | # TODO: This path is hard-coded 17 | set(BLACS_INSTALL_SRC 18 | ${CMAKE_CURRENT_LIST_DIR}/../BLACS/INSTALL 19 | ) 20 | 21 | try_run(xintface_res xintface_compile_res 22 | SOURCES 23 | ${BLACS_INSTALL_SRC}/Fintface.f 24 | ${BLACS_INSTALL_SRC}/Cintface.c 25 | NO_CACHE 26 | COMPILE_OUTPUT_VARIABLE xintface_compile_output 27 | RUN_OUTPUT_VARIABLE xintface_output 28 | ) 29 | if(NOT xintface_compile_res) 30 | message(FATAL_ERROR 31 | "Could not compile BLACS/INSTALL:\n" 32 | "${xintface_compile_output}" 33 | ) 34 | endif() 35 | if(NOT ${xintface_res} EQUAL 0) 36 | message(FATAL_ERROR 37 | "xintface did not execute properly:\n" 38 | "${xintface_output}" 39 | ) 40 | endif() 41 | string(STRIP "${xintface_output}" xintface_output) 42 | set(CDEFS ${xintface_output} CACHE STRING "Fortran Mangling") 43 | endblock() 44 | -------------------------------------------------------------------------------- /CMAKE/scalapack-config-build.cmake.in: -------------------------------------------------------------------------------- 1 | include("@SCALAPACK_BINARY_DIR@/scalapack-targets.cmake") 2 | -------------------------------------------------------------------------------- /CMAKE/scalapack-config-install.cmake.in: -------------------------------------------------------------------------------- 1 | get_filename_component(_SELF_DIR "${CMAKE_CURRENT_LIST_FILE}" PATH) 2 | include(${_SELF_DIR}/scalapack-targets.cmake) 3 | -------------------------------------------------------------------------------- /CMAKE/scalapack-config-version.cmake.in: -------------------------------------------------------------------------------- 1 | set(PACKAGE_VERSION "@SCALAPACK_VERSION@") 2 | if(NOT ${PACKAGE_FIND_VERSION} VERSION_GREATER ${PACKAGE_VERSION}) 3 | set(PACKAGE_VERSION_COMPATIBLE 1) 4 | if(${PACKAGE_FIND_VERSION} VERSION_EQUAL ${PACKAGE_VERSION}) 5 | set(PACKAGE_VERSION_EXACT 1) 6 | endif() 7 | endif() 8 | 9 | -------------------------------------------------------------------------------- /EXAMPLE/CSCAEXMAT.dat: -------------------------------------------------------------------------------- 1 | 6 6 2 | 6.0000E+0 4.0000E+0 3 | 3.0000E+0 -5.0000E+0 4 | 0.0000E+0 0.0000E+0 5 | 0.0000E+0 0.0000E+0 6 | 3.0000E+0 -3.0000E+0 7 | 0.0000E+0 0.0000E+0 8 | 0.0000E+0 0.0000E+0 9 | -3.0000E+0 0.0000E+0 10 | -1.0000E+0 -9.0000E+0 11 | 1.0000E+0 2.0000E+0 12 | 1.0000E+0 4.0000E+0 13 | 0.0000E+0 0.0000E+0 14 | -1.0000E+0 -3.0000E+0 15 | 0.0000E+0 0.0000E+0 16 | 11.0000E+0 21.0000E+0 17 | 0.0000E+0 0.0000E+0 18 | 0.0000E+0 0.0000E+0 19 | 10.0000E+0 5.0000E+0 20 | 0.0000E+0 0.0000E+0 21 | 0.0000E+0 0.0000E+0 22 | 0.0000E+0 0.0000E+0 23 | -11.0000E+0 -12.0000E+0 24 | 0.0000E+0 0.0000E+0 25 | 0.0000E+0 0.0000E+0 26 | 0.0000E+0 0.0000E+0 27 | 0.0000E+0 0.0000E+0 28 | 0.0000E+0 0.0000E+0 29 | 2.0000E+0 0.0000E+0 30 | -4.0000E+0 5.0000E+0 31 | 0.0000E+0 0.0000E+0 32 | 0.0000E+0 0.0000E+0 33 | 0.0000E+0 0.0000E+0 34 | 0.0000E+0 0.0000E+0 35 | 8.0000E+0 1.0000E+0 36 | 0.0000E+0 0.0000E+0 37 | -10.0000E+0 -10.0000E+0 38 | -------------------------------------------------------------------------------- /EXAMPLE/CSCAEXRHS.dat: -------------------------------------------------------------------------------- 1 | 6 1 2 | 72.000000000000000000E+00 0E+0 3 | 0.000000000000000000E+00 0E+0 4 | 160.000000000000000000E+00 0E+0 5 | 0.000000000000000000E+00 0E+0 6 | 0.000000000000000000E+00 0E+0 7 | 0.000000000000000000E+00 0E+0 8 | -------------------------------------------------------------------------------- /EXAMPLE/DSCAEXMAT.dat: -------------------------------------------------------------------------------- 1 | 6 6 2 | 6.0000D+0 3 | 3.0000D+0 4 | 0.0000D+0 5 | 0.0000D+0 6 | 3.0000D+0 7 | 0.0000D+0 8 | 0.0000D+0 9 | -3.0000D+0 10 | -1.0000D+0 11 | 1.0000D+0 12 | 1.0000D+0 13 | 0.0000D+0 14 | -1.0000D+0 15 | 0.0000D+0 16 | 11.0000D+0 17 | 0.0000D+0 18 | 0.0000D+0 19 | 10.0000D+0 20 | 0.0000D+0 21 | 0.0000D+0 22 | 0.0000D+0 23 | -11.0000D+0 24 | 0.0000D+0 25 | 0.0000D+0 26 | 0.0000D+0 27 | 0.0000D+0 28 | 0.0000D+0 29 | 2.0000D+0 30 | -4.0000D+0 31 | 0.0000D+0 32 | 0.0000D+0 33 | 0.0000D+0 34 | 0.0000D+0 35 | 8.0000D+0 36 | 0.0000D+0 37 | -10.0000D+0 38 | -------------------------------------------------------------------------------- /EXAMPLE/DSCAEXRHS.dat: -------------------------------------------------------------------------------- 1 | 6 1 2 | 72.000000000000000000D+00 3 | 0.000000000000000000D+00 4 | 160.000000000000000000D+00 5 | 0.000000000000000000D+00 6 | 0.000000000000000000D+00 7 | 0.000000000000000000D+00 8 | -------------------------------------------------------------------------------- /EXAMPLE/Makefile: -------------------------------------------------------------------------------- 1 | include ../SLmake.inc 2 | 3 | TESTOBJS = psscaex.o pdscaexinfo.o 4 | TESTOBJD = pdscaex.o pdscaexinfo.o 5 | TESTOBJC = pcscaex.o pdscaexinfo.o 6 | TESTOBJZ = pzscaex.o pdscaexinfo.o 7 | 8 | all: pdscaex pcscaex pzscaex psscaex 9 | 10 | single: psscaex 11 | 12 | double: pdscaex 13 | 14 | complex: pcscaex 15 | 16 | complex16: pzscaex 17 | 18 | psscaex: $(TESTOBJS) 19 | $(FCLOADER) $(FCLOADFLAGS) -o xsscaex $(TESTOBJS) ../$(SCALAPACKLIB) $(LIBS) 20 | 21 | pzscaex: $(TESTOBJZ) 22 | $(FCLOADER) $(FCLOADFLAGS) -o xzscaex $(TESTOBJZ) ../$(SCALAPACKLIB) $(LIBS) 23 | 24 | pcscaex: $(TESTOBJC) 25 | $(FCLOADER) $(FCLOADFLAGS) -o xcscaex $(TESTOBJC) ../$(SCALAPACKLIB) $(LIBS) 26 | 27 | pdscaex: $(TESTOBJD) 28 | $(FCLOADER) $(FCLOADFLAGS) -o xdscaex $(TESTOBJD) ../$(SCALAPACKLIB) $(LIBS) 29 | 30 | clean : 31 | rm -f $(TESTOBJS) $(TESTOBJD) $(TESTOBJZ) $(TESTOBJC) xsscaex xzscaex xcscaex xdscaex 32 | 33 | .f.o : ; $(FC) -c $(FCFLAGS) $*.f 34 | 35 | .c.o : ; $(CC) -c $(CDEFS) $(CCFLAGS) $*.c 36 | 37 | -------------------------------------------------------------------------------- /EXAMPLE/SCAEX.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK Tutorial, Example input file' 2 | 'PARA95, ScaLAPACK Example, August 1995.' 3 | 'SCAEX.out' output file name (if any) 4 | 6 device out 5 | 6 value of N 6 | 1 value of NRHS 7 | 2 values of NB 8 | 2 values of NPROW 9 | 2 values of NPCOL 10 | -------------------------------------------------------------------------------- /EXAMPLE/SSCAEXMAT.dat: -------------------------------------------------------------------------------- 1 | 6 6 2 | 6.0000E+0 3 | 3.0000E+0 4 | 0.0000E+0 5 | 0.0000E+0 6 | 3.0000E+0 7 | 0.0000E+0 8 | 0.0000E+0 9 | -3.0000E+0 10 | -1.0000E+0 11 | 1.0000E+0 12 | 1.0000E+0 13 | 0.0000E+0 14 | -1.0000E+0 15 | 0.0000E+0 16 | 11.0000E+0 17 | 0.0000E+0 18 | 0.0000E+0 19 | 10.0000E+0 20 | 0.0000E+0 21 | 0.0000E+0 22 | 0.0000E+0 23 | -11.0000E+0 24 | 0.0000E+0 25 | 0.0000E+0 26 | 0.0000E+0 27 | 0.0000E+0 28 | 0.0000E+0 29 | 2.0000E+0 30 | -4.0000E+0 31 | 0.0000E+0 32 | 0.0000E+0 33 | 0.0000E+0 34 | 0.0000E+0 35 | 8.0000E+0 36 | 0.0000E+0 37 | -10.0000E+0 38 | -------------------------------------------------------------------------------- /EXAMPLE/SSCAEXRHS.dat: -------------------------------------------------------------------------------- 1 | 6 1 2 | 72.000000000000000000E+00 3 | 0.000000000000000000E+00 4 | 160.000000000000000000E+00 5 | 0.000000000000000000E+00 6 | 0.000000000000000000E+00 7 | 0.000000000000000000E+00 8 | -------------------------------------------------------------------------------- /EXAMPLE/ZSCAEXMAT.dat: -------------------------------------------------------------------------------- 1 | 6 6 2 | 6.0000D+0 4.0000D+0 3 | 3.0000D+0 -5.0000D+0 4 | 0.0000D+0 0.0000D+0 5 | 0.0000D+0 0.0000D+0 6 | 3.0000D+0 -3.0000D+0 7 | 0.0000D+0 0.0000D+0 8 | 0.0000D+0 0.0000D+0 9 | -3.0000D+0 0.0000D+0 10 | -1.0000D+0 -9.0000D+0 11 | 1.0000D+0 2.0000D+0 12 | 1.0000D+0 4.0000D+0 13 | 0.0000D+0 0.0000D+0 14 | -1.0000D+0 -3.0000D+0 15 | 0.0000D+0 0.0000D+0 16 | 11.0000D+0 21.0000D+0 17 | 0.0000D+0 0.0000D+0 18 | 0.0000D+0 0.0000D+0 19 | 10.0000D+0 5.0000D+0 20 | 0.0000D+0 0.0000D+0 21 | 0.0000D+0 0.0000D+0 22 | 0.0000D+0 0.0000D+0 23 | -11.0000D+0 -12.0000D+0 24 | 0.0000D+0 0.0000D+0 25 | 0.0000D+0 0.0000D+0 26 | 0.0000D+0 0.0000D+0 27 | 0.0000D+0 0.0000D+0 28 | 0.0000D+0 0.0000D+0 29 | 2.0000D+0 0.0000D+0 30 | -4.0000D+0 5.0000D+0 31 | 0.0000D+0 0.0000D+0 32 | 0.0000D+0 0.0000D+0 33 | 0.0000D+0 0.0000D+0 34 | 0.0000D+0 0.0000D+0 35 | 8.0000D+0 1.0000D+0 36 | 0.0000D+0 0.0000D+0 37 | -10.0000D+0 -10.0000D+0 38 | -------------------------------------------------------------------------------- /EXAMPLE/ZSCAEXRHS.dat: -------------------------------------------------------------------------------- 1 | 6 1 2 | 72.000000000000000000D+00 81.000000000000000000D+00 3 | 0.000000000000000000D+00 0.000000000000000000D+00 4 | 160.000000000000000000D+00 120.000000000000000000D+00 5 | 0.000000000000000000D+00 0.000000000000000000D+00 6 | 0.000000000000000000D+00 0.000000000000000000D+00 7 | 0.000000000000000000D+00 0.000000000000000000D+00 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1992-2025 The University of Tennessee and The University 2 | of Tennessee Research Foundation. All rights 3 | reserved. 4 | Copyright (c) 2000-2025 The University of California Berkeley. All 5 | rights reserved. 6 | Copyright (c) 2006-2025 The University of Colorado Denver. All rights 7 | reserved. 8 | 9 | $COPYRIGHT$ 10 | 11 | Additional copyrights may follow 12 | 13 | $HEADER$ 14 | 15 | Redistribution and use in source and binary forms, with or without 16 | modification, are permitted provided that the following conditions are 17 | met: 18 | 19 | - Redistributions of source code must retain the above copyright 20 | notice, this list of conditions and the following disclaimer. 21 | 22 | - Redistributions in binary form must reproduce the above copyright 23 | notice, this list of conditions and the following disclaimer listed 24 | in this license in the documentation and/or other materials 25 | provided with the distribution. 26 | 27 | - Neither the name of the copyright holders nor the names of its 28 | contributors may be used to endorse or promote products derived from 29 | this software without specific prior written permission. 30 | 31 | The copyright holders provide no reassurances that the source code 32 | provided does not infringe any patent, copyright, or any other 33 | intellectual property rights of third parties. The copyright holders 34 | disclaim any liability to any recipient for claims brought against 35 | recipient by any third party for infringement of that parties 36 | intellectual property rights. 37 | 38 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 39 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 40 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 41 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 42 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 43 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 44 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 45 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 46 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 47 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 48 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 49 | -------------------------------------------------------------------------------- /PBLAS/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_subdirectory(SRC) 2 | if(${SCALAPACK_BUILD_TESTS}) 3 | add_subdirectory(TESTING) 4 | add_subdirectory(TIMING) 5 | endif() 6 | -------------------------------------------------------------------------------- /PBLAS/SRC/PBBLAS/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set (PBSBLASAUX pbstran.f pbsmatadd.f pbstrsrt.f pbstrget.f 2 | pbstrnv.f pbsvecadd.f pbstrst1.f) 3 | 4 | set (PBCBLASAUX pbctran.f pbcmatadd.f pbctrsrt.f pbctrget.f 5 | pbctrnv.f pbcvecadd.f pbctrst1.f) 6 | 7 | set (PBDBLASAUX pbdtran.f pbdmatadd.f pbdtrsrt.f pbdtrget.f 8 | pbdtrnv.f pbdvecadd.f pbdtrst1.f) 9 | 10 | set (PBZBLASAUX pbztran.f pbzmatadd.f pbztrsrt.f pbztrget.f 11 | pbztrnv.f pbzvecadd.f pbztrst1.f) 12 | 13 | set(pbblas 14 | ${PBSBLASAUX} ${PBCBLASAUX} ${PBDBLASAUX} ${PBZBLASAUX}) 15 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTOOLS/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set( ALLCTOOLS 2 | PB_CGatherV.c PB_CInV.c PB_CInV2.c PB_CInOutV.c 3 | PB_CInOutV2.c PB_COutV.c PB_CScatterV.c PB_CVMinit.c 4 | PB_CVMloc.c PB_CVMnpq.c PB_CVMpack.c PB_CVMswp.c 5 | PB_CVMupdate.c PB_CVMcontig.c PB_Cabort.c PB_Cainfog2l.c 6 | PB_Cbinfo.c PB_Cchkmat.c PB_Cchkvec.c PB_Cconjg.c 7 | PB_Cgetbuf.c PB_Cinfog2l.c PB_Citypeset.c PB_Cgcd.c 8 | PB_Clcm.c PB_Cmalloc.c PB_Cnumroc.c PB_Cg2lrem.c 9 | PB_Cindxg2p.c PB_Cnnxtroc.c PB_Cnpreroc.c PB_CpswapNN.c 10 | PB_CpswapND.c PB_Cpdot11.c PB_CpdotNN.c PB_CpdotND.c 11 | PB_CpaxpbyNN.c PB_CpaxpbyND.c PB_CpaxpbyDN.c PB_Cpaxpby.c 12 | PB_CpgemmBC.c PB_CpgemmAC.c PB_CpgemmAB.c PB_Cplaprnt.c 13 | PB_Cplapad.c PB_Cplapd2.c PB_Cplascal.c PB_Cplasca2.c 14 | PB_Cplacnjg.c PB_Cpsym.c PB_CpsymmAB.c PB_CpsymmBC.c 15 | PB_Cpsyr.c PB_CpsyrkA.c PB_CpsyrkAC.c PB_Cpsyr2.c 16 | PB_Cpsyr2kA.c PB_Cpsyr2kAC.c PB_Cptrm.c PB_Cpgeadd.c 17 | PB_Cptradd.c PB_Cptran.c PB_CptrmmAB.c PB_CptrmmB.c 18 | PB_Cptrsm.c PB_CptrsmAB.c PB_CptrsmAB0.c PB_CptrsmAB1.c 19 | PB_CptrsmB.c PB_Cptrsv.c PB_Ctop.c PB_Ctzahemv.c 20 | PB_Ctzasymv.c PB_Ctzatrmv.c PB_Ctzhemm.c PB_Ctzhemv.c 21 | PB_Ctzher.c PB_Ctzherk.c PB_Ctzher2.c PB_Ctzher2k.c 22 | PB_Ctzsymm.c PB_Ctzsymv.c PB_Ctzsyr.c PB_Ctzsyrk.c 23 | PB_Ctzsyr2.c PB_Ctzsyr2k.c PB_Ctztrmm.c PB_Ctztrmv.c 24 | PB_Cwarn.c PB_freebuf_.c PB_topget_.c PB_topset_.c 25 | PB_Cdescset.c PB_Cdescribe.c PB_CargFtoC.c PB_Cfirstnb.c 26 | PB_Clastnb.c PB_Cspan.c) 27 | 28 | set( SCTOOLS PB_Cstypeset.c) 29 | 30 | set( DCTOOLS PB_Cdtypeset.c) 31 | 32 | set( CCTOOLS PB_Cctypeset.c) 33 | 34 | set( ZCTOOLS PB_Cztypeset.c) 35 | 36 | set(ptools ${ALLCTOOLS} ${SCTOOLS} ${DCTOOLS} ${CCTOOLS} ${ZCTOOLS}) 37 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTOOLS/PB_Cfirstnb.c: -------------------------------------------------------------------------------- 1 | /* --------------------------------------------------------------------- 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * --------------------------------------------------------------------- 9 | */ 10 | /* 11 | * Include files 12 | */ 13 | #include "../pblas.h" 14 | #include "../PBpblas.h" 15 | #include "../PBtools.h" 16 | #include "../PBblacs.h" 17 | #include "../PBblas.h" 18 | 19 | #ifdef __STDC__ 20 | Int PB_Cfirstnb( Int N, Int I, Int INB, Int NB ) 21 | #else 22 | Int PB_Cfirstnb( N, I, INB, NB ) 23 | /* 24 | * .. Scalar Arguments .. 25 | */ 26 | Int I, INB, N, NB; 27 | #endif 28 | { 29 | /* 30 | * Purpose 31 | * ======= 32 | * 33 | * PB_Cfirstnb returns the global number of matrix rows or columns of the 34 | * first block, if N rows or columns are given out starting from the 35 | * global index I. Note that if N is equal 0, this routine returns 0. 36 | * 37 | * Arguments 38 | * ========= 39 | * 40 | * N (global input) INTEGER 41 | * On entry, N specifies the number of rows/columns being dealt 42 | * out. N must be at least zero. 43 | * 44 | * I (global input) INTEGER 45 | * On entry, I specifies the global index of the matrix entry. 46 | * I must be at least zero. 47 | * 48 | * INB (global input) INTEGER 49 | * On entry, INB specifies the size of the first block of the 50 | * global matrix distribution. INB must be at least one. 51 | * 52 | * NB (global input) INTEGER 53 | * On entry, NB specifies the size of the blocks used to parti- 54 | * tion the matrix. NB must be at least one. 55 | * 56 | * -- Written on April 1, 1998 by 57 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 58 | * 59 | * --------------------------------------------------------------------- 60 | */ 61 | /* 62 | * .. Local Scalars .. 63 | */ 64 | Int inbt; 65 | /* .. 66 | * .. Executable Statements .. 67 | * 68 | */ 69 | inbt = ( ( INB -= I ) <= 0 ? ( (-INB) / NB + 1 ) * NB + INB : INB ); 70 | return( MIN( inbt, N ) ); 71 | /* 72 | * End of PB_Cfirstnb 73 | */ 74 | } 75 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTOOLS/PB_Clastnb.c: -------------------------------------------------------------------------------- 1 | /* --------------------------------------------------------------------- 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * --------------------------------------------------------------------- 9 | */ 10 | /* 11 | * Include files 12 | */ 13 | #include "../pblas.h" 14 | #include "../PBpblas.h" 15 | #include "../PBtools.h" 16 | #include "../PBblacs.h" 17 | #include "../PBblas.h" 18 | 19 | #ifdef __STDC__ 20 | Int PB_Clastnb( Int N, Int I, Int INB, Int NB ) 21 | #else 22 | Int PB_Clastnb( N, I, INB, NB ) 23 | /* 24 | * .. Scalar Arguments .. 25 | */ 26 | Int I, INB, N, NB; 27 | #endif 28 | { 29 | /* 30 | * Purpose 31 | * ======= 32 | * 33 | * PB_Clastnb returns the global number of matrix rows or columns of the 34 | * last block, if N rows or columns are given out starting from the glo- 35 | * bal index I. Note that if N is equal 0, this routine returns 0. 36 | * 37 | * Arguments 38 | * ========= 39 | * 40 | * N (global input) INTEGER 41 | * On entry, N specifies the number of rows/columns being dealt 42 | * out. N must be at least zero. 43 | * 44 | * I (global input) INTEGER 45 | * On entry, I specifies the global index of the matrix entry. 46 | * I must be at least zero. 47 | * 48 | * INB (global input) INTEGER 49 | * On entry, INB specifies the size of the first block of the 50 | * global matrix distribution. INB must be at least one. 51 | * 52 | * NB (global input) INTEGER 53 | * On entry, NB specifies the size of the blocks used to parti- 54 | * tion the matrix. NB must be at least one. 55 | * 56 | * -- Written on April 1, 1998 by 57 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 58 | * 59 | * --------------------------------------------------------------------- 60 | */ 61 | /* 62 | * .. Local Scalars .. 63 | */ 64 | Int lnbt; 65 | /* .. 66 | * .. Executable Statements .. 67 | * 68 | */ 69 | if( ( lnbt = I + N - INB ) > 0 ) 70 | { 71 | lnbt = lnbt - NB * ( ( NB + lnbt - 1 ) / NB - 1 ); 72 | return( MIN( lnbt, N ) ); 73 | } 74 | else 75 | { 76 | return( N ); 77 | } 78 | /* 79 | * End of PB_Clastnb 80 | */ 81 | } 82 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTOOLS/PB_Cmalloc.c: -------------------------------------------------------------------------------- 1 | /* --------------------------------------------------------------------- 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * --------------------------------------------------------------------- 9 | */ 10 | /* 11 | * Include files 12 | */ 13 | #include "../pblas.h" 14 | #include "../PBpblas.h" 15 | #include "../PBtools.h" 16 | #include "../PBblacs.h" 17 | #include "../PBblas.h" 18 | 19 | #ifdef __STDC__ 20 | char * PB_Cmalloc( Int LENGTH ) 21 | #else 22 | char * PB_Cmalloc( LENGTH ) 23 | /* 24 | * .. Scalar Arguments .. 25 | */ 26 | Int LENGTH; 27 | #endif 28 | { 29 | /* 30 | * Purpose 31 | * ======= 32 | * 33 | * PB_Cmalloc allocates a dynamic memory buffer. In case of failure, the 34 | * program is stopped by calling Cblacs_abort. 35 | * 36 | * Arguments 37 | * ========= 38 | * 39 | * LENGTH (local input) INTEGER 40 | * On entry, LENGTH specifies the length in bytes of the buffer 41 | * to be allocated. If LENGTH is less or equal than zero, this 42 | * function returns NULL. 43 | * 44 | * -- Written on April 1, 1998 by 45 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 46 | * 47 | * --------------------------------------------------------------------- 48 | */ 49 | /* 50 | * .. Local Scalars .. 51 | */ 52 | char * bufptr = NULL; 53 | /* .. 54 | * .. Executable Statements .. 55 | * 56 | */ 57 | if( LENGTH > 0 ) 58 | { 59 | if( !( bufptr = (char *) malloc( (unsigned)LENGTH ) ) ) 60 | { 61 | (void) fprintf( stderr, "Not enough memory on line %d of file %s!!\n", 62 | __LINE__, __FILE__ ); 63 | Cblacs_abort( -1, -1 ); 64 | } 65 | } 66 | return( bufptr ); 67 | /* 68 | * End of PB_Cmalloc 69 | */ 70 | } 71 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTOOLS/PB_freebuf_.c: -------------------------------------------------------------------------------- 1 | /* --------------------------------------------------------------------- 2 | * 3 | * -- PBLAS routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * --------------------------------------------------------------------- 9 | */ 10 | /* 11 | * Include files 12 | */ 13 | #include "../pblas.h" 14 | #include "../PBpblas.h" 15 | #include "../PBtools.h" 16 | #include "../PBblacs.h" 17 | #include "../PBblas.h" 18 | 19 | void PB_freebuf_(void) 20 | { 21 | /* 22 | * Purpose 23 | * ======= 24 | * 25 | * PB_freebuf_ disposes the dynamic memory allocated by PB_Cgetbuf. 26 | * 27 | * -- Written on April 1, 1998 by 28 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 29 | * 30 | * --------------------------------------------------------------------- 31 | */ 32 | /* .. 33 | * .. Executable Statements .. 34 | * 35 | */ 36 | (void) PB_Cgetbuf( " ", -1 ); 37 | /* 38 | * End of PB_freebuf_ 39 | */ 40 | } 41 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set (APBTZ 2 | pxerbla.f) 3 | 4 | set (IPBTZ 5 | immadd.f immdda.f immtadd.f immddat.f) 6 | 7 | set (SPBTZ 8 | svasum.f sset.f scshft.f srshft.f 9 | svvdot.f smmadd.f smmcadd.f smmtadd.f 10 | smmtcadd.f smmdda.f smmddac.f smmddat.f 11 | smmddact.f stzpad.f stzpadcpy.f stzscal.f 12 | sagemv.f sasymv.f satrmv.f) 13 | 14 | set (SCPBTZ 15 | sasqrtb.f sascal.f) 16 | 17 | set (CPBTZ 18 | scvasum.f cset.f ccshft.f crshft.f 19 | cvvdotu.f cvvdotc.f cmmadd.f cmmcadd.f 20 | cmmtadd.f cmmtcadd.f cmmdda.f cmmddac.f 21 | cmmddat.f cmmddact.f ctzpad.f ctzpadcpy.f 22 | chescal.f ctzscal.f ctzcnjg.f cagemv.f 23 | cahemv.f catrmv.f casymv.f csymv.f 24 | csyr.f csyr2.f) 25 | 26 | set (DPBTZ 27 | dvasum.f dset.f dcshft.f drshft.f 28 | dvvdot.f dmmadd.f dmmcadd.f dmmtadd.f 29 | dmmtcadd.f dmmdda.f dmmddac.f dmmddat.f 30 | dmmddact.f dtzpad.f dtzpadcpy.f dtzscal.f 31 | dagemv.f dasymv.f datrmv.f) 32 | 33 | set (DZPBTZ 34 | dasqrtb.f dascal.f) 35 | 36 | set (ZPBTZ 37 | dzvasum.f zset.f zcshft.f zrshft.f 38 | zvvdotu.f zvvdotc.f zmmadd.f zmmcadd.f 39 | zmmtadd.f zmmtcadd.f zmmdda.f zmmddac.f 40 | zmmddat.f zmmddact.f ztzpad.f ztzpadcpy.f 41 | zhescal.f ztzscal.f ztzcnjg.f zagemv.f 42 | zahemv.f zatrmv.f zasymv.f zsymv.f 43 | zsyr.f zsyr2.f) 44 | 45 | 46 | set(ptzblas 47 | ${APBTZ} ${IPBTZ} ${SPBTZ} ${SCPBTZ} 48 | ${CPBTZ} ${DPBTZ} ${DZPBTZ} ${ZPBTZ} ) 49 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/cvvdotc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE CVVDOTC( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX DOT 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * CVVDOTC computes the following dot product: 20 | * 21 | * dot = dot + x**H * y, 22 | * 23 | * where x and y are n vectors. 24 | * 25 | * Arguments 26 | * ========= 27 | * 28 | * N (input) INTEGER 29 | * On entry, N specifies the length of the vectors x and y. N 30 | * must be at least zero. 31 | * 32 | * DOT (input/output) COMPLEX 33 | * On exit, DOT is updated with the dot product of the vectors x 34 | * and y. 35 | * 36 | * X (input) COMPLEX array of dimension at least 37 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 38 | * array X must contain the vector x. 39 | * 40 | * INCX (input) INTEGER 41 | * On entry, INCX specifies the increment for the elements of X. 42 | * INCX must not be zero. 43 | * 44 | * Y (input) COMPLEX array of dimension at least 45 | * ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented 46 | * array Y must contain the vector y. 47 | * 48 | * INCY (input) INTEGER 49 | * On entry, INCY specifies the increment for the elements of Y. 50 | * INCY must not be zero. 51 | * 52 | * -- Written on April 1, 1998 by 53 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 54 | * 55 | * ===================================================================== 56 | * 57 | * .. Local Scalars .. 58 | COMPLEX DOTC 59 | * .. 60 | * .. External Subroutines .. 61 | EXTERNAL CCDOTC 62 | * .. 63 | * .. Executable Statements .. 64 | * 65 | CALL CCDOTC( N, DOTC, X, INCX, Y, INCY ) 66 | DOT = DOT + DOTC 67 | * 68 | RETURN 69 | * 70 | * End of CVVDOTC 71 | * 72 | END 73 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/cvvdotu.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE CVVDOTU( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX DOT 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * CVVDOTU computes the following dot product: 20 | * 21 | * dot = dot + x**T * y, 22 | * 23 | * where x and y are n vectors. 24 | * 25 | * Arguments 26 | * ========= 27 | * 28 | * N (input) INTEGER 29 | * On entry, N specifies the length of the vectors x and y. N 30 | * must be at least zero. 31 | * 32 | * DOT (input/output) COMPLEX 33 | * On exit, DOT is updated with the dot product of the vectors x 34 | * and y. 35 | * 36 | * X (input) COMPLEX array of dimension at least 37 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 38 | * array X must contain the vector x. 39 | * 40 | * INCX (input) INTEGER 41 | * On entry, INCX specifies the increment for the elements of X. 42 | * INCX must not be zero. 43 | * 44 | * Y (input) COMPLEX array of dimension at least 45 | * ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented 46 | * array Y must contain the vector y. 47 | * 48 | * INCY (input) INTEGER 49 | * On entry, INCY specifies the increment for the elements of Y. 50 | * INCY must not be zero. 51 | * 52 | * -- Written on April 1, 1998 by 53 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 54 | * 55 | * ===================================================================== 56 | * 57 | * .. Local Scalars .. 58 | COMPLEX DOTU 59 | * .. 60 | * .. External Subroutines .. 61 | EXTERNAL CCDOTU 62 | * .. 63 | * .. Executable Statements .. 64 | * 65 | CALL CCDOTU( N, DOTU, X, INCX, Y, INCY ) 66 | DOT = DOT + DOTU 67 | * 68 | RETURN 69 | * 70 | * End of CVVDOTU 71 | * 72 | END 73 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/dasqrtb.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DASQRTB( A, B, C ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | DOUBLE PRECISION A, B, C 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * DASQRTB computes c := a * sqrt( b ) where a, b and c are scalars. 16 | * 17 | * Arguments 18 | * ========= 19 | * 20 | * A (input) DOUBLE PRECISION 21 | * On entry, A specifies the scalar a. 22 | * 23 | * B (input) DOUBLE PRECISION 24 | * On entry, B specifies the scalar b. 25 | * 26 | * C (output) DOUBLE PRECISION 27 | * On entry, C specifies the scalar c. On exit, c is overwritten 28 | * by the product of a and the square root of b. 29 | * 30 | * -- Written on April 1, 1998 by 31 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 32 | * 33 | * ===================================================================== 34 | * 35 | * .. Intrinsic Functions .. 36 | INTRINSIC SQRT 37 | * .. 38 | * .. Executable Statements .. 39 | * 40 | C = A * SQRT( B ) 41 | * 42 | RETURN 43 | * 44 | * End of DASQRTB 45 | * 46 | END 47 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/dvasum.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DVASUM( N, ASUM, X, INCX ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | DOUBLE PRECISION ASUM 11 | * .. 12 | * .. Array Arguments .. 13 | DOUBLE PRECISION X( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * DVASUM returns the sum of absolute values of the entries of a vector 20 | * x. 21 | * 22 | * Arguments 23 | * ========= 24 | * 25 | * N (input) INTEGER 26 | * On entry, N specifies the length of the vector x. N must be 27 | * at least zero. 28 | * 29 | * ASUM (output) DOUBLE PRECISION 30 | * On exit, ASUM specifies the sum of absolute values. 31 | * 32 | * X (input) DOUBLE PRECISION array of dimension at least 33 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 34 | * array X must contain the vector x. 35 | * 36 | * INCX (input) INTEGER 37 | * On entry, INCX specifies the increment for the elements of X. 38 | * INCX must not be zero. 39 | * 40 | * -- Written on April 1, 1998 by 41 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 42 | * 43 | * ===================================================================== 44 | * 45 | * .. External Functions .. 46 | DOUBLE PRECISION DASUM 47 | EXTERNAL DASUM 48 | * .. 49 | * .. Executable Statements .. 50 | * 51 | ASUM = DASUM( N, X, INCX ) 52 | * 53 | RETURN 54 | * 55 | * End of DVASUM 56 | * 57 | END 58 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/dvvdot.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DVVDOT( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | DOUBLE PRECISION DOT 11 | * .. 12 | * .. Array Arguments .. 13 | DOUBLE PRECISION X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * DVVDOT computes the following dot product: 20 | * 21 | * dot = dot + x**T * y, 22 | * 23 | * where x and y are n vectors. 24 | * 25 | * Arguments 26 | * ========= 27 | * 28 | * N (input) INTEGER 29 | * On entry, N specifies the length of the vectors x and y. N 30 | * must be at least zero. 31 | * 32 | * DOT (input/output) DOUBLE PRECISION 33 | * On exit, DOT is updated with the dot product of the vectors x 34 | * and y. 35 | * 36 | * X (input) DOUBLE PRECISION array of dimension at least 37 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 38 | * array X must contain the vector x. 39 | * 40 | * INCX (input) INTEGER 41 | * On entry, INCX specifies the increment for the elements of X. 42 | * INCX must not be zero. 43 | * 44 | * Y (input) DOUBLE PRECISION array of dimension at least 45 | * ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented 46 | * array Y must contain the vector y. 47 | * 48 | * INCY (input) INTEGER 49 | * On entry, INCY specifies the increment for the elements of Y. 50 | * INCY must not be zero. 51 | * 52 | * -- Written on April 1, 1998 by 53 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 54 | * 55 | * ===================================================================== 56 | * 57 | * .. External Functions .. 58 | DOUBLE PRECISION DDOT 59 | EXTERNAL DDOT 60 | * .. 61 | * .. Executable Statements .. 62 | * 63 | DOT = DOT + DDOT( N, X, INCX, Y, INCY ) 64 | * 65 | RETURN 66 | * 67 | * End of DVVDOT 68 | * 69 | END 70 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/dzvasum.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DZVASUM( N, ASUM, X, INCX ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | DOUBLE PRECISION ASUM 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX*16 X( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * DZVASUM returns the sum of absolute values of the entries of a vector 20 | * x. 21 | * 22 | * Arguments 23 | * ========= 24 | * 25 | * N (input) INTEGER 26 | * On entry, N specifies the length of the vector x. N must be 27 | * at least zero. 28 | * 29 | * ASUM (output) COMPLEX*16 30 | * On exit, ASUM specifies the sum of absolute values. 31 | * 32 | * X (input) COMPLEX*16 array of dimension at least 33 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 34 | * array X must contain the vector x. 35 | * 36 | * INCX (input) INTEGER 37 | * On entry, INCX specifies the increment for the elements of X. 38 | * INCX must not be zero. 39 | * 40 | * -- Written on April 1, 1998 by 41 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 42 | * 43 | * ===================================================================== 44 | * 45 | * .. External Functions .. 46 | DOUBLE PRECISION DZASUM 47 | EXTERNAL DZASUM 48 | * .. 49 | * .. Executable Statements .. 50 | * 51 | ASUM = DZASUM( N, X, INCX ) 52 | * 53 | RETURN 54 | * 55 | * End of DZVASUM 56 | * 57 | END 58 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/pxerbla.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PXERBLA( ICTXT, SRNAME, INFO ) 2 | * 3 | * -- ScaLAPACK auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER ICTXT, INFO 10 | * .. 11 | * .. Array Arguments .. 12 | CHARACTER*(*) SRNAME 13 | * .. 14 | * 15 | * Purpose 16 | * ======= 17 | * 18 | * PXERBLA is an error handler for the ScaLAPACK routines. It is called 19 | * by a ScaLAPACK routine if an input parameter has an invalid value. A 20 | * message is printed. Installers may consider modifying this routine in 21 | * order to call system-specific exception-handling facilities. 22 | * 23 | * Arguments 24 | * ========= 25 | * 26 | * ICTXT (local input) INTEGER 27 | * On entry, ICTXT specifies the BLACS context handle, indica- 28 | * ting the global context of the operation. The context itself 29 | * is global, but the value of ICTXT is local. 30 | * 31 | * SRNAME (global input) CHARACTER*(*) 32 | * On entry, SRNAME specifies the name of the routine which cal- 33 | * ling PXERBLA. 34 | * 35 | * INFO (global input) INTEGER 36 | * On entry, INFO specifies the position of the invalid parame- 37 | * ter in the parameter list of the calling routine. 38 | * 39 | * -- Written on April 1, 1998 by 40 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 41 | * 42 | * ===================================================================== 43 | * 44 | * .. Local Scalars .. 45 | INTEGER MYCOL, MYROW, NPCOL, NPROW 46 | * .. 47 | * .. External Subroutines .. 48 | EXTERNAL BLACS_GRIDINFO 49 | * .. 50 | * .. Executable Statements .. 51 | * 52 | CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL ) 53 | * 54 | WRITE( *, FMT = 9999 ) MYROW, MYCOL, SRNAME, INFO 55 | * 56 | 9999 FORMAT( '{', I5, ',', I5, '}: On entry to ', A, 57 | $ ' parameter number ', I4, ' had an illegal value' ) 58 | * 59 | RETURN 60 | * 61 | * End of PXERBLA 62 | * 63 | END 64 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/sasqrtb.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SASQRTB( A, B, C ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | REAL A, B, C 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * SASQRTB computes c := a * sqrt( b ) where a, b and c are scalars. 16 | * 17 | * Arguments 18 | * ========= 19 | * 20 | * A (input) REAL 21 | * On entry, A specifies the scalar a. 22 | * 23 | * B (input) REAL 24 | * On entry, B specifies the scalar b. 25 | * 26 | * C (output) REAL 27 | * On entry, C specifies the scalar c. On exit, c is overwritten 28 | * by the product of a and the square root of b. 29 | * 30 | * -- Written on April 1, 1998 by 31 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 32 | * 33 | * ===================================================================== 34 | * 35 | * .. Intrinsic Functions .. 36 | INTRINSIC SQRT 37 | * .. 38 | * .. Executable Statements .. 39 | * 40 | C = A * SQRT( B ) 41 | * 42 | RETURN 43 | * 44 | * End of SASQRTB 45 | * 46 | END 47 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/scvasum.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SCVASUM( N, ASUM, X, INCX ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | REAL ASUM 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX X( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * SCVASUM returns the sum of absolute values of the entries of a vector 20 | * x. 21 | * 22 | * Arguments 23 | * ========= 24 | * 25 | * N (input) INTEGER 26 | * On entry, N specifies the length of the vector x. N must be 27 | * at least zero. 28 | * 29 | * ASUM (output) COMPLEX 30 | * On exit, ASUM specifies the sum of absolute values. 31 | * 32 | * X (input) COMPLEX array of dimension at least 33 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 34 | * array X must contain the vector x. 35 | * 36 | * INCX (input) INTEGER 37 | * On entry, INCX specifies the increment for the elements of X. 38 | * INCX must not be zero. 39 | * 40 | * -- Written on April 1, 1998 by 41 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 42 | * 43 | * ===================================================================== 44 | * 45 | * .. External Functions .. 46 | REAL SCASUM 47 | EXTERNAL SCASUM 48 | * .. 49 | * .. Executable Statements .. 50 | * 51 | ASUM = SCASUM( N, X, INCX ) 52 | * 53 | RETURN 54 | * 55 | * End of SCVASUM 56 | * 57 | END 58 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/svasum.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SVASUM( N, ASUM, X, INCX ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | REAL ASUM 11 | * .. 12 | * .. Array Arguments .. 13 | REAL X( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * SVASUM returns the sum of absolute values of the entries of a vector 20 | * x. 21 | * 22 | * Arguments 23 | * ========= 24 | * 25 | * N (input) INTEGER 26 | * On entry, N specifies the length of the vector x. N must be 27 | * at least zero. 28 | * 29 | * ASUM (output) REAL 30 | * On exit, ASUM specifies the sum of absolute values. 31 | * 32 | * X (input) REAL array of dimension at least 33 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 34 | * array X must contain the vector x. 35 | * 36 | * INCX (input) INTEGER 37 | * On entry, INCX specifies the increment for the elements of X. 38 | * INCX must not be zero. 39 | * 40 | * -- Written on April 1, 1998 by 41 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 42 | * 43 | * ===================================================================== 44 | * 45 | * .. External Functions .. 46 | REAL SASUM 47 | EXTERNAL SASUM 48 | * .. 49 | * .. Executable Statements .. 50 | * 51 | ASUM = SASUM( N, X, INCX ) 52 | * 53 | RETURN 54 | * 55 | * End of SVASUM 56 | * 57 | END 58 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/svvdot.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SVVDOT( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | REAL DOT 11 | * .. 12 | * .. Array Arguments .. 13 | REAL X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * SVVDOT computes the following dot product: 20 | * 21 | * dot = dot + x**T * y, 22 | * 23 | * where x and y are n vectors. 24 | * 25 | * Arguments 26 | * ========= 27 | * 28 | * N (input) INTEGER 29 | * On entry, N specifies the length of the vectors x and y. N 30 | * must be at least zero. 31 | * 32 | * DOT (input/output) REAL 33 | * On exit, DOT is updated with the dot product of the vectors x 34 | * and y. 35 | * 36 | * X (input) REAL array of dimension at least 37 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 38 | * array X must contain the vector x. 39 | * 40 | * INCX (input) INTEGER 41 | * On entry, INCX specifies the increment for the elements of X. 42 | * INCX must not be zero. 43 | * 44 | * Y (input) REAL array of dimension at least 45 | * ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented 46 | * array Y must contain the vector y. 47 | * 48 | * INCY (input) INTEGER 49 | * On entry, INCY specifies the increment for the elements of Y. 50 | * INCY must not be zero. 51 | * 52 | * -- Written on April 1, 1998 by 53 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 54 | * 55 | * ===================================================================== 56 | * 57 | * .. External Functions .. 58 | REAL SDOT 59 | EXTERNAL SDOT 60 | * .. 61 | * .. Executable Statements .. 62 | * 63 | DOT = DOT + SDOT( N, X, INCX, Y, INCY ) 64 | * 65 | RETURN 66 | * 67 | * End of SVVDOT 68 | * 69 | END 70 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/zvvdotc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE ZVVDOTC( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX*16 DOT 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX*16 X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * ZVVDOTC computes the following dot product: 20 | * 21 | * dot = dot + x**H * y, 22 | * 23 | * where x and y are n vectors. 24 | * 25 | * Arguments 26 | * ========= 27 | * 28 | * N (input) INTEGER 29 | * On entry, N specifies the length of the vectors x and y. N 30 | * must be at least zero. 31 | * 32 | * DOT (input/output) COMPLEX*16 33 | * On exit, DOT is updated with the dot product of the vectors x 34 | * and y. 35 | * 36 | * X (input) COMPLEX*16 array of dimension at least 37 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 38 | * array X must contain the vector x. 39 | * 40 | * INCX (input) INTEGER 41 | * On entry, INCX specifies the increment for the elements of X. 42 | * INCX must not be zero. 43 | * 44 | * Y (input) COMPLEX*16 array of dimension at least 45 | * ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented 46 | * array Y must contain the vector y. 47 | * 48 | * INCY (input) INTEGER 49 | * On entry, INCY specifies the increment for the elements of Y. 50 | * INCY must not be zero. 51 | * 52 | * -- Written on April 1, 1998 by 53 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 54 | * 55 | * ===================================================================== 56 | * 57 | * .. Local Scalars .. 58 | COMPLEX*16 DOTC 59 | * .. 60 | * .. External Subroutines .. 61 | EXTERNAL ZZDOTC 62 | * .. 63 | * .. Executable Statements .. 64 | * 65 | CALL ZZDOTC( N, DOTC, X, INCX, Y, INCY ) 66 | DOT = DOT + DOTC 67 | * 68 | RETURN 69 | * 70 | * End of ZVVDOTC 71 | * 72 | END 73 | -------------------------------------------------------------------------------- /PBLAS/SRC/PTZBLAS/zvvdotu.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE ZVVDOTU( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- PBLAS auxiliary routine (version 2.0) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * April 1, 1998 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX*16 DOT 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX*16 X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * ZVVDOTU computes the following dot product: 20 | * 21 | * dot = dot + x**T * y, 22 | * 23 | * where x and y are n vectors. 24 | * 25 | * Arguments 26 | * ========= 27 | * 28 | * N (input) INTEGER 29 | * On entry, N specifies the length of the vectors x and y. N 30 | * must be at least zero. 31 | * 32 | * DOT (input/output) COMPLEX*16 33 | * On exit, DOT is updated with the dot product of the vectors x 34 | * and y. 35 | * 36 | * X (input) COMPLEX*16 array of dimension at least 37 | * ( 1 + ( n - 1 )*abs( INCX ) ). Before entry, the incremented 38 | * array X must contain the vector x. 39 | * 40 | * INCX (input) INTEGER 41 | * On entry, INCX specifies the increment for the elements of X. 42 | * INCX must not be zero. 43 | * 44 | * Y (input) COMPLEX*16 array of dimension at least 45 | * ( 1 + ( n - 1 )*abs( INCY ) ). Before entry, the incremented 46 | * array Y must contain the vector y. 47 | * 48 | * INCY (input) INTEGER 49 | * On entry, INCY specifies the increment for the elements of Y. 50 | * INCY must not be zero. 51 | * 52 | * -- Written on April 1, 1998 by 53 | * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 54 | * 55 | * ===================================================================== 56 | * 57 | * .. Local Scalars .. 58 | COMPLEX*16 DOTU 59 | * .. 60 | * .. External Subroutines .. 61 | EXTERNAL ZZDOTU 62 | * .. 63 | * .. Executable Statements .. 64 | * 65 | CALL ZZDOTU( N, DOTU, X, INCX, Y, INCY ) 66 | DOT = DOT + DOTU 67 | * 68 | RETURN 69 | * 70 | * End of ZVVDOTU 71 | * 72 | END 73 | -------------------------------------------------------------------------------- /PBLAS/TESTING/PCBLAS1TST.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Testing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PCBLAS1TST.SUMM' output file name (if any) 4 | 6 device out 5 | F logical flag, T to stop on failures 6 | T logical flag, T to test error exits 7 | 0 verbosity, 0 for pass/fail, 1-3 for matrix dump on errors 8 | 10 the leading dimension gap 9 | 4 number of process grids (ordered pairs of P & Q) 10 | 2 1 2 1 4 2 3 8 values of P 11 | 2 2 1 4 1 3 2 1 values of Q 12 | (2.0E0, -3.0E0) value of ALPHA 13 | 4 number of tests problems 14 | 14 44 28 7 values of N 15 | 36 9 39 53 values of M_X 16 | 24 67 3 12 values of N_X 17 | 2 5 2 5 values of IMB_X 18 | 2 5 2 5 values of INB_X 19 | 2 5 2 5 values of MB_X 20 | 2 5 2 5 values of NB_X 21 | 0 0 0 0 values of RSRC_X 22 | 0 0 0 0 values of CSRC_X 23 | 5 3 1 1 values of IX 24 | 2 6 1 1 values of JX 25 | 1 9 1 53 values of INCX 26 | 2 6 35 14 values of M_Y 27 | 27 55 43 12 values of N_Y 28 | 2 5 2 5 values of IMB_Y 29 | 2 5 2 5 values of INB_Y 30 | 2 5 2 5 values of MB_Y 31 | 2 5 2 5 values of NB_Y 32 | 0 0 0 0 values of RSRC_Y 33 | 0 0 0 0 values of CSRC_Y 34 | 1 4 1 1 values of IY 35 | 7 6 1 1 values of JY 36 | 2 6 35 1 values of INCY 37 | PCSWAP T put F for no test in the same column 38 | PCSCAL T put F for no test in the same column 39 | PCSSCAL T put F for no test in the same column 40 | PCCOPY T put F for no test in the same column 41 | PCAXPY T put F for no test in the same column 42 | PCDOTU T put F for no test in the same column 43 | PCDOTC T put F for no test in the same column 44 | PSCNRM2 T put F for no test in the same column 45 | PSCASUM T put F for no test in the same column 46 | PCAMAX T put F for no test in the same column 47 | -------------------------------------------------------------------------------- /PBLAS/TESTING/PDBLAS1TST.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Testing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PDBLAS1TST.SUMM' output file name (if any) 4 | 6 device out 5 | F logical flag, T to stop on failures 6 | T logical flag, T to test error exits 7 | 0 verbosity, 0 for pass/fail, 1-3 for matrix dump on errors 8 | 10 the leading dimension gap 9 | 4 number of process grids (ordered pairs of P & Q) 10 | 2 1 2 1 4 2 3 8 values of P 11 | 2 2 1 4 1 3 2 1 values of Q 12 | 2.0D0 value of ALPHA 13 | 4 number of tests problems 14 | 14 44 28 7 values of N 15 | 36 9 39 53 values of M_X 16 | 24 67 3 12 values of N_X 17 | 2 5 2 5 values of IMB_X 18 | 2 5 2 5 values of INB_X 19 | 2 5 2 5 values of MB_X 20 | 2 5 2 5 values of NB_X 21 | 0 0 0 0 values of RSRC_X 22 | 0 0 0 0 values of CSRC_X 23 | 5 3 1 1 values of IX 24 | 2 6 1 1 values of JX 25 | 1 9 1 53 values of INCX 26 | 2 6 35 14 values of M_Y 27 | 27 55 43 12 values of N_Y 28 | 2 5 2 5 values of IMB_Y 29 | 2 5 2 5 values of INB_Y 30 | 2 5 2 5 values of MB_Y 31 | 2 5 2 5 values of NB_Y 32 | 0 0 0 0 values of RSRC_Y 33 | 0 0 0 0 values of CSRC_Y 34 | 1 4 1 1 values of IY 35 | 7 6 1 1 values of JY 36 | 2 6 35 1 values of INCY 37 | PDSWAP T put F for no test in the same column 38 | PDSCAL T put F for no test in the same column 39 | PDCOPY T put F for no test in the same column 40 | PDAXPY T put F for no test in the same column 41 | PDDOT T put F for no test in the same column 42 | PDNRM2 T put F for no test in the same column 43 | PDASUM T put F for no test in the same column 44 | PDAMAX T put F for no test in the same column 45 | -------------------------------------------------------------------------------- /PBLAS/TESTING/PSBLAS1TST.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Testing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PSBLAS1TST.SUMM' output file name (if any) 4 | 6 device out 5 | F logical flag, T to stop on failures 6 | T logical flag, T to test error exits 7 | 0 verbosity, 0 for pass/fail, 1-3 for matrix dump on errors 8 | 10 the leading dimension gap 9 | 4 number of process grids (ordered pairs of P & Q) 10 | 2 1 2 1 4 2 3 8 values of P 11 | 2 2 1 4 1 3 2 1 values of Q 12 | 2.0E0 value of ALPHA 13 | 4 number of tests problems 14 | 14 44 28 7 values of N 15 | 36 9 39 53 values of M_X 16 | 24 67 3 12 values of N_X 17 | 2 5 2 5 values of IMB_X 18 | 2 5 2 5 values of INB_X 19 | 2 5 2 5 values of MB_X 20 | 2 5 2 5 values of NB_X 21 | 0 0 0 0 values of RSRC_X 22 | 0 0 0 0 values of CSRC_X 23 | 5 3 1 1 values of IX 24 | 2 6 1 1 values of JX 25 | 1 9 1 53 values of INCX 26 | 2 6 35 14 values of M_Y 27 | 27 55 43 12 values of N_Y 28 | 2 5 2 5 values of IMB_Y 29 | 2 5 2 5 values of INB_Y 30 | 2 5 2 5 values of MB_Y 31 | 2 5 2 5 values of NB_Y 32 | 0 0 0 0 values of RSRC_Y 33 | 0 0 0 0 values of CSRC_Y 34 | 1 4 1 1 values of IY 35 | 7 6 1 1 values of JY 36 | 2 6 35 1 values of INCY 37 | PSSWAP T put F for no test in the same column 38 | PSSCAL T put F for no test in the same column 39 | PSCOPY T put F for no test in the same column 40 | PSAXPY T put F for no test in the same column 41 | PSDOT T put F for no test in the same column 42 | PSNRM2 T put F for no test in the same column 43 | PSASUM T put F for no test in the same column 44 | PSAMAX T put F for no test in the same column 45 | -------------------------------------------------------------------------------- /PBLAS/TESTING/PZBLAS1TST.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Testing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PZBLAS1TST.SUMM' output file name (if any) 4 | 6 device out 5 | F logical flag, T to stop on failures 6 | T logical flag, T to test error exits 7 | 0 verbosity, 0 for pass/fail, 1-3 for matrix dump on errors 8 | 10 the leading dimension gap 9 | 4 number of process grids (ordered pairs of P & Q) 10 | 2 1 2 1 4 2 3 8 values of P 11 | 2 2 1 4 1 3 2 1 values of Q 12 | (2.0D0, -3.0D0) value of ALPHA 13 | 4 number of tests problems 14 | 14 44 28 7 values of N 15 | 36 9 39 53 values of M_X 16 | 24 67 3 12 values of N_X 17 | 2 5 2 5 values of IMB_X 18 | 2 5 2 5 values of INB_X 19 | 2 5 2 5 values of MB_X 20 | 2 5 2 5 values of NB_X 21 | 0 0 0 0 values of RSRC_X 22 | 0 0 0 0 values of CSRC_X 23 | 5 3 1 1 values of IX 24 | 2 6 1 1 values of JX 25 | 1 9 1 53 values of INCX 26 | 2 6 35 14 values of M_Y 27 | 27 55 43 12 values of N_Y 28 | 2 5 2 5 values of IMB_Y 29 | 2 5 2 5 values of INB_Y 30 | 2 5 2 5 values of MB_Y 31 | 2 5 2 5 values of NB_Y 32 | 0 0 0 0 values of RSRC_Y 33 | 0 0 0 0 values of CSRC_Y 34 | 1 4 1 1 values of IY 35 | 7 6 1 1 values of JY 36 | 2 6 35 1 values of INCY 37 | PZSWAP T put F for no test in the same column 38 | PZSCAL T put F for no test in the same column 39 | PZDSCAL T put F for no test in the same column 40 | PZCOPY T put F for no test in the same column 41 | PZAXPY T put F for no test in the same column 42 | PZDOTU T put F for no test in the same column 43 | PZDOTC T put F for no test in the same column 44 | PDZNRM2 T put F for no test in the same column 45 | PDZASUM T put F for no test in the same column 46 | PZAMAX T put F for no test in the same column 47 | -------------------------------------------------------------------------------- /PBLAS/TIMING/PCBLAS1TIM.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Timing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PCBLAS1TIM.SUMM' output file name (if any) 4 | 6 device out 5 | 1 number of process grids (ordered pairs of P & Q) 6 | 2 2 1 4 2 3 8 values of P 7 | 2 2 4 1 3 2 1 values of Q 8 | (2.0E0, -3.0E0) value of ALPHA 9 | 2 number of tests problems 10 | 1000 1000 values of N 11 | 1000 1 values of M_X 12 | 1 1500 values of N_X 13 | 32 32 values of IMB_X 14 | 32 32 values of INB_X 15 | 32 32 values of MB_X 16 | 32 32 values of NB_X 17 | 0 0 values of RSRC_X 18 | 0 0 values of CSRC_X 19 | 1 1 values of IX 20 | 1 1 values of JX 21 | 1 1 values of INCX 22 | 1 1 values of M_Y 23 | 1000 1500 values of N_Y 24 | 32 32 values of IMB_Y 25 | 32 32 values of INB_Y 26 | 32 32 values of MB_Y 27 | 32 32 values of NB_Y 28 | 0 0 values of RSRC_Y 29 | 0 0 values of CSRC_Y 30 | 1 1 values of IY 31 | 1 1 values of JY 32 | 1 1 values of INCY 33 | PCSWAP T put F for no test in the same column 34 | PCSCAL T put F for no test in the same column 35 | PCSSCAL T put F for no test in the same column 36 | PCCOPY T put F for no test in the same column 37 | PCAXPY T put F for no test in the same column 38 | PCDOTU T put F for no test in the same column 39 | PCDOTC T put F for no test in the same column 40 | PSCNRM2 T put F for no test in the same column 41 | PSCASUM T put F for no test in the same column 42 | PCAMAX T put F for no test in the same column 43 | -------------------------------------------------------------------------------- /PBLAS/TIMING/PDBLAS1TIM.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Timing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PDBLAS1TIM.SUMM' output file name (if any) 4 | 6 device out 5 | 1 number of process grids (ordered pairs of P & Q) 6 | 2 2 1 4 2 3 8 values of P 7 | 2 2 4 1 3 2 1 values of Q 8 | 2.0D0 value of ALPHA 9 | 2 number of tests problems 10 | 1000 1000 values of N 11 | 1000 1 values of M_X 12 | 1 1500 values of N_X 13 | 32 32 values of IMB_X 14 | 32 32 values of INB_X 15 | 32 32 values of MB_X 16 | 32 32 values of NB_X 17 | 0 0 values of RSRC_X 18 | 0 0 values of CSRC_X 19 | 1 1 values of IX 20 | 1 1 values of JX 21 | 1 1 values of INCX 22 | 1 1 values of M_Y 23 | 1000 1500 values of N_Y 24 | 32 32 values of IMB_Y 25 | 32 32 values of INB_Y 26 | 32 32 values of MB_Y 27 | 32 32 values of NB_Y 28 | 0 0 values of RSRC_Y 29 | 0 0 values of CSRC_Y 30 | 1 1 values of IY 31 | 1 1 values of JY 32 | 1 1 values of INCY 33 | PDSWAP T put F for no test in the same column 34 | PDSCAL T put F for no test in the same column 35 | PDCOPY T put F for no test in the same column 36 | PDAXPY T put F for no test in the same column 37 | PDDOT T put F for no test in the same column 38 | PDNRM2 T put F for no test in the same column 39 | PDASUM T put F for no test in the same column 40 | PDAMAX T put F for no test in the same column 41 | -------------------------------------------------------------------------------- /PBLAS/TIMING/PDBLAS3TIM.dat: -------------------------------------------------------------------------------- 1 | 'Level 3 PBLAS, Timing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PDBLAS3TIM.SUMM' output file name (if any) 4 | 6 device out 5 | 10 value of the logical computational blocksize NB 6 | 1 number of process grids (ordered pairs of P & Q) 7 | 2 2 1 4 2 3 8 values of P 8 | 2 2 4 1 3 2 1 values of Q 9 | 2.0D0 value of ALPHA 10 | 3.0D0 value of BETA 11 | 8 number of tests problems 12 | 'N' 'N' 'N' 'N' 'N' 'N' 'N' 'N' values of DIAG 13 | 'L' 'L' 'L' 'L' 'L' 'L' 'L' 'L' values of SIDE 14 | 'N' 'N' 'N' 'N' 'T' 'T' 'T' 'T' values of TRANSA 15 | 'N' 'N' 'T' 'T' 'N' 'N' 'T' 'T' values of TRANSB 16 | 'U' 'L' 'U' 'L' 'U' 'L' 'U' 'L' values of UPLO 17 | 3 4 3 4 3 4 3 4 values of M 18 | 3 4 3 4 3 4 3 4 values of N 19 | 3 4 3 4 3 4 3 4 values of K 20 | 6 10 6 10 6 10 6 10 values of M_A 21 | 6 10 6 10 6 10 6 10 values of N_A 22 | 2 5 2 5 2 5 2 5 values of IMB_A 23 | 2 5 2 5 2 5 2 5 values of INB_A 24 | 2 5 2 5 2 5 2 5 values of MB_A 25 | 2 5 2 5 2 5 2 5 values of NB_A 26 | 0 1 0 1 0 1 0 1 values of RSRC_A 27 | 0 0 0 0 0 0 0 0 values of CSRC_A 28 | 1 1 1 1 1 1 1 1 values of IA 29 | 1 1 1 1 1 1 1 1 values of JA 30 | 6 10 6 10 6 10 6 10 values of M_B 31 | 6 10 6 10 6 10 6 10 values of N_B 32 | 2 5 2 5 2 5 2 5 values of IMB_B 33 | 2 5 2 5 2 5 2 5 values of INB_B 34 | 2 5 2 5 2 5 2 5 values of MB_B 35 | 2 5 2 5 2 5 2 5 values of NB_B 36 | 0 1 0 1 0 1 0 1 values of RSRC_B 37 | 0 0 0 0 0 0 0 0 values of CSRC_B 38 | 1 1 1 1 1 1 1 1 values of IB 39 | 1 1 1 1 1 1 1 1 values of JB 40 | 6 10 6 10 6 10 6 10 values of M_C 41 | 6 10 6 10 6 10 6 10 values of N_C 42 | 2 5 2 5 2 5 2 5 values of IMB_C 43 | 2 5 2 5 2 5 2 5 values of INB_C 44 | 2 5 2 5 2 5 2 5 values of MB_C 45 | 2 5 2 5 2 5 2 5 values of NB_C 46 | 0 1 0 1 0 1 0 1 values of RSRC_C 47 | 0 0 0 0 0 0 0 0 values of CSRC_C 48 | 1 1 1 1 1 1 1 1 values of IC 49 | 1 1 1 1 1 1 1 1 values of JC 50 | PDGEMM T put F for no test in the same column 51 | PDSYMM T put F for no test in the same column 52 | PDSYRK T put F for no test in the same column 53 | PDSYR2K T put F for no test in the same column 54 | PDTRMM T put F for no test in the same column 55 | PDTRSM T put F for no test in the same column 56 | PDGEADD T put F for no test in the same column 57 | PDTRADD T put F for no test in the same column 58 | -------------------------------------------------------------------------------- /PBLAS/TIMING/PSBLAS1TIM.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Timing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PSBLAS1TIM.SUMM' output file name (if any) 4 | 6 device out 5 | 1 number of process grids (ordered pairs of P & Q) 6 | 2 2 1 4 2 3 8 values of P 7 | 2 2 4 1 3 2 1 values of Q 8 | 2.0E0 value of ALPHA 9 | 2 number of tests problems 10 | 1000 1000 values of N 11 | 1000 1 values of M_X 12 | 1 1500 values of N_X 13 | 32 32 values of IMB_X 14 | 32 32 values of INB_X 15 | 32 32 values of MB_X 16 | 32 32 values of NB_X 17 | 0 0 values of RSRC_X 18 | 0 0 values of CSRC_X 19 | 1 1 values of IX 20 | 1 1 values of JX 21 | 1 1 values of INCX 22 | 1 1 values of M_Y 23 | 1000 1500 values of N_Y 24 | 32 32 values of IMB_Y 25 | 32 32 values of INB_Y 26 | 32 32 values of MB_Y 27 | 32 32 values of NB_Y 28 | 0 0 values of RSRC_Y 29 | 0 0 values of CSRC_Y 30 | 1 1 values of IY 31 | 1 1 values of JY 32 | 1 1 values of INCY 33 | PSSWAP T put F for no test in the same column 34 | PSSCAL T put F for no test in the same column 35 | PSCOPY T put F for no test in the same column 36 | PSAXPY T put F for no test in the same column 37 | PSDOT T put F for no test in the same column 38 | PSNRM2 T put F for no test in the same column 39 | PSASUM T put F for no test in the same column 40 | PSAMAX T put F for no test in the same column 41 | -------------------------------------------------------------------------------- /PBLAS/TIMING/PZBLAS1TIM.dat: -------------------------------------------------------------------------------- 1 | 'Level 1 PBLAS, Timing input file' 2 | 'Intel iPSC/860 hypercube, gamma model.' 3 | 'PZBLAS1TIM.SUMM' output file name (if any) 4 | 6 device out 5 | 1 number of process grids (ordered pairs of P & Q) 6 | 2 2 1 4 2 3 8 values of P 7 | 2 2 4 1 3 2 1 values of Q 8 | (2.0D0, -3.0D0) value of ALPHA 9 | 2 number of tests problems 10 | 1000 1000 values of N 11 | 1000 1 values of M_X 12 | 1 1500 values of N_X 13 | 32 32 values of IMB_X 14 | 32 32 values of INB_X 15 | 32 32 values of MB_X 16 | 32 32 values of NB_X 17 | 0 0 values of RSRC_X 18 | 0 0 values of CSRC_X 19 | 1 1 values of IX 20 | 1 1 values of JX 21 | 1 1 values of INCX 22 | 1 1 values of M_Y 23 | 1000 1500 values of N_Y 24 | 32 32 values of IMB_Y 25 | 32 32 values of INB_Y 26 | 32 32 values of MB_Y 27 | 32 32 values of NB_Y 28 | 0 0 values of RSRC_Y 29 | 0 0 values of CSRC_Y 30 | 1 1 values of IY 31 | 1 1 values of JY 32 | 1 1 values of INCY 33 | PZSWAP T put F for no test in the same column 34 | PZSCAL T put F for no test in the same column 35 | PZDSCAL T put F for no test in the same column 36 | PZCOPY T put F for no test in the same column 37 | PZAXPY T put F for no test in the same column 38 | PZDOTU T put F for no test in the same column 39 | PZDOTC T put F for no test in the same column 40 | PDZNRM2 T put F for no test in the same column 41 | PDZASUM T put F for no test in the same column 42 | PZAMAX T put F for no test in the same column 43 | -------------------------------------------------------------------------------- /REDIST/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_subdirectory(SRC) 2 | if(${SCALAPACK_BUILD_TESTS}) 3 | add_subdirectory(TESTING) 4 | endif() 5 | -------------------------------------------------------------------------------- /REDIST/SRC/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set (ALLAUX 2 | pgemraux.c) 3 | 4 | set (IMRSRC 5 | pigemr.c pigemr2.c pitrmr.c pitrmr2.c) 6 | 7 | set (SMRSRC 8 | psgemr.c psgemr2.c pstrmr.c pstrmr2.c) 9 | 10 | set (CMRSRC 11 | pcgemr.c pcgemr2.c pctrmr.c pctrmr2.c) 12 | 13 | set (DMRSRC 14 | pdgemr.c pdgemr2.c pdtrmr.c pdtrmr2.c) 15 | 16 | set (ZMRSRC 17 | pzgemr.c pzgemr2.c pztrmr.c pztrmr2.c) 18 | 19 | set(redist ${ALLAUX} ${IMRSRC} ${SMRSRC} ${CMRSRC} ${DMRSRC} ${ZMRSRC}) 20 | 21 | -------------------------------------------------------------------------------- /REDIST/SRC/redist.h: -------------------------------------------------------------------------------- 1 | #ifdef T3D 2 | #define float double 3 | #endif 4 | #ifdef T3E 5 | #define float double 6 | #endif 7 | #ifdef CRAY 8 | #define float double 9 | #endif 10 | #ifndef Int 11 | #define Int int 12 | #endif 13 | -------------------------------------------------------------------------------- /REDIST/TESTING/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${SCALAPACK_BINARY_DIR}/scalapack/REDIST/TESTING) 2 | 3 | file(COPY GEMR2D.dat DESTINATION ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) 4 | file(COPY TRMR2D.dat DESTINATION ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}) 5 | 6 | add_executable(xigemr pigemrdrv.c) 7 | add_executable(xsgemr psgemrdrv.c) 8 | add_executable(xdgemr pdgemrdrv.c) 9 | add_executable(xcgemr pcgemrdrv.c) 10 | add_executable(xzgemr pzgemrdrv.c) 11 | 12 | add_executable(xitrmr pitrmrdrv.c) 13 | add_executable(xstrmr pstrmrdrv.c) 14 | add_executable(xdtrmr pdtrmrdrv.c) 15 | add_executable(xctrmr pctrmrdrv.c) 16 | add_executable(xztrmr pztrmrdrv.c) 17 | 18 | target_link_libraries(xigemr scalapack MPI::MPI_Fortran ) 19 | target_link_libraries(xsgemr scalapack MPI::MPI_Fortran ) 20 | target_link_libraries(xdgemr scalapack MPI::MPI_Fortran ) 21 | target_link_libraries(xcgemr scalapack MPI::MPI_Fortran ) 22 | target_link_libraries(xzgemr scalapack MPI::MPI_Fortran ) 23 | 24 | target_link_libraries(xitrmr scalapack MPI::MPI_Fortran ) 25 | target_link_libraries(xstrmr scalapack MPI::MPI_Fortran ) 26 | target_link_libraries(xdtrmr scalapack MPI::MPI_Fortran ) 27 | target_link_libraries(xctrmr scalapack MPI::MPI_Fortran ) 28 | target_link_libraries(xztrmr scalapack MPI::MPI_Fortran ) 29 | 30 | #add_test(xigemr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xigemr) 31 | #add_test(xsgemr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xsgemr) 32 | #add_test(xdgemr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xdgemr) 33 | #add_test(xcgemr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xcgemr) 34 | #add_test(xzgemr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xzgemr) 35 | 36 | #add_test(xitrmr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xitrmr) 37 | #add_test(xstrmr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xstrmr) 38 | #add_test(xdtrmr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xdtrmr) 39 | #add_test(xctrmr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xctrmr) 40 | #add_test(xztrmr ${MPIEXEC} ${MPIEXEC_NUMPROC_FLAG} 4 ${MPIEXEC_PREFLAGS} ./xztrmr) 41 | 42 | -------------------------------------------------------------------------------- /REDIST/TESTING/TRMR2D.dat: -------------------------------------------------------------------------------- 1 | # test file for SCALAPACK routine TRMR2D 2 | 10 # number of tests 3 | # m n m0 n0 sr0 sc0 i0 j0 p0 q0 nbr0 nbc0 m1 n1 sr1 sc1 i1 j1 p1 q1 nbr1 nbc1 UP UNIT 4 | 12 20 81 79 0 0 18 52 1 1 6 8 56 103 1 1 42 34 2 2 8 8 1 0 5 | 59 79 98 100 0 1 13 22 1 2 8 1 62 173 0 0 4 25 1 2 9 8 1 0 6 | 22 25 87 121 0 1 17 15 2 2 12 51 90 157 1 1 19 11 2 2 36 91 1 0 7 | 1 13 1 109 0 0 1 51 2 2 8 9 134 123 0 1 15 74 1 2 16 8 0 0 8 | 129 11 187 74 0 0 1 11 2 2 7 8 185 94 0 0 27 20 2 1 8 21 1 1 9 | 43 10 45 27 1 0 2 4 2 1 10 2 149 96 0 0 78 70 1 1 9 9 1 0 10 | 1 27 80 29 0 1 72 1 2 2 19 8 41 43 1 0 18 10 2 1 8 9 0 0 11 | 29 5 37 40 0 1 1 29 1 2 17 9 46 86 0 0 5 81 2 1 7 9 0 1 12 | 59 25 91 151 0 1 20 62 2 2 5 150 81 89 0 0 5 9 1 1 9 12 0 0 13 | 31 76 114 95 0 1 79 17 1 2 8 49 169 169 0 1 50 16 1 2 9 8 1 0 14 | 12 127 22 191 1 1 11 21 2 2 8 1 28 193 1 0 11 46 2 1 9 8 1 1 15 | -------------------------------------------------------------------------------- /REDIST/TESTING/redist.h: -------------------------------------------------------------------------------- 1 | #ifdef T3D 2 | #define float double 3 | #endif 4 | #ifdef T3E 5 | #define float double 6 | #endif 7 | #ifdef CRAY 8 | #define float double 9 | #endif 10 | #ifndef Int 11 | #define Int int 12 | #endif 13 | -------------------------------------------------------------------------------- /SLmake.inc.example: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | # 3 | # Program: ScaLAPACK 4 | # 5 | # Module: SLmake.inc 6 | # 7 | # Purpose: Top-level Definitions 8 | # 9 | # Creation date: February 15, 2000 10 | # 11 | # Modified: October 13, 2011 12 | # 13 | # Send bug reports, comments or suggestions to scalapack@cs.utk.edu 14 | # 15 | ############################################################################ 16 | # 17 | # C preprocessor definitions: set CDEFS to one of the following: 18 | # 19 | # -DNoChange (fortran subprogram names are lower case without any suffix) 20 | # -DUpCase (fortran subprogram names are upper case without any suffix) 21 | # -DAdd_ (fortran subprogram names are lower case with "_" appended) 22 | 23 | CDEFS = -DAdd_ 24 | 25 | # 26 | # The fortran and C compilers, loaders, and their flags 27 | # 28 | 29 | FC = mpif90 30 | CC = mpicc 31 | NOOPT = -O0 32 | FCFLAGS = -O3 33 | CCFLAGS = -O3 34 | FCLOADER = $(FC) 35 | CCLOADER = $(CC) 36 | FCLOADFLAGS = $(FCFLAGS) 37 | CCLOADFLAGS = $(CCFLAGS) 38 | 39 | # 40 | # The archiver and the flag(s) to use when building archive (library) 41 | # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo 42 | # 43 | 44 | ARCH = ar 45 | ARCHFLAGS = cr 46 | RANLIB = ranlib 47 | 48 | # 49 | # The name of the ScaLAPACK library to be created 50 | # 51 | 52 | SCALAPACKLIB = libscalapack.a 53 | 54 | # 55 | # BLAS, LAPACK (and possibly other) libraries needed for linking test programs 56 | # 57 | 58 | BLASLIB = -lblas 59 | LAPACKLIB = -llapack 60 | LIBS = $(LAPACKLIB) $(BLASLIB) 61 | -------------------------------------------------------------------------------- /SRC/clamov.c: -------------------------------------------------------------------------------- 1 | // 2 | // clamov.c 3 | // 4 | // Written by Lee Killough 04/19/2012 5 | // 6 | 7 | #define TYPE complex 8 | #define FUNC "CLAMOV" 9 | #define LAMOV clamov_ 10 | #define LACPY clacpy_ 11 | #include "lamov.h" 12 | -------------------------------------------------------------------------------- /SRC/dlamov.c: -------------------------------------------------------------------------------- 1 | // 2 | // dlamov.c 3 | // 4 | // Written by Lee Killough 04/19/2012 5 | // 6 | 7 | #define TYPE double 8 | #define FUNC "DLAMOV" 9 | #define LAMOV dlamov_ 10 | #define LACPY dlacpy_ 11 | #include "lamov.h" 12 | -------------------------------------------------------------------------------- /SRC/getpbbuf.c: -------------------------------------------------------------------------------- 1 | #include "tools.h" 2 | 3 | char * getpbbuf( char *mess, Int length ) 4 | { 5 | /* 6 | * Purpose 7 | * ======= 8 | * 9 | * getpbbuf returns a pointer to a working buffer of size length alloca- 10 | * ted for the PBLAS routines. 11 | * 12 | * ====================================================================== 13 | * 14 | * .. Local Scalars .. 15 | */ 16 | static char * pblasbuf = NULL; 17 | static Int pbbuflen = 0, mone = -1; 18 | /* .. 19 | * .. External Functions .. 20 | */ 21 | void blacs_abort_(); 22 | /* .. 23 | * .. Executable Statements .. 24 | */ 25 | if( length >= 0 ) 26 | { 27 | if( length > pbbuflen ) 28 | { 29 | if( pblasbuf ) 30 | free( pblasbuf ); 31 | pblasbuf = (char *) malloc((unsigned)length); 32 | if( !pblasbuf ) 33 | { 34 | fprintf( stderr, 35 | "PBLAS %s ERROR: Memory allocation failed\n", 36 | mess ); 37 | blacs_abort_( &mone, &mone ); 38 | } 39 | pbbuflen = length; 40 | } 41 | } 42 | else if( pblasbuf ) 43 | { 44 | free( pblasbuf ); 45 | pblasbuf = NULL; 46 | pbbuflen = 0; 47 | } 48 | return( pblasbuf ); 49 | } 50 | -------------------------------------------------------------------------------- /SRC/pilaver.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE PILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) 2 | C 3 | C -- ScaLAPACK computational routine (version 2.0.1 ) -- 4 | C -- ScaLAPACK is a software package provided by Univ. of Tennessee, -- 5 | C -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 6 | C January 2012 7 | C 8 | C Purpose 9 | C ======= 10 | C 11 | C This subroutine return the ScaLAPACK version. 12 | C 13 | C Arguments 14 | C ========= 15 | C VERS_MAJOR (output) INTEGER 16 | C return the scalapack major version 17 | C VERS_MINOR (output) INTEGER 18 | C return the scalapack minor version from the major version 19 | C VERS_PATCH (output) INTEGER 20 | C return the scalapack patch version from the minor version 21 | C ===================================================================== 22 | C 23 | INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH 24 | C ===================================================================== 25 | VERS_MAJOR = 2 26 | VERS_MINOR = 0 27 | VERS_PATCH = 2 28 | C ===================================================================== 29 | C 30 | RETURN 31 | END 32 | 33 | -------------------------------------------------------------------------------- /SRC/slamov.c: -------------------------------------------------------------------------------- 1 | // 2 | // slamov.c 3 | // 4 | // Written by Lee Killough 04/19/2012 5 | // 6 | 7 | #define TYPE float 8 | #define FUNC "SLAMOV" 9 | #define LAMOV slamov_ 10 | #define LACPY slacpy_ 11 | #include "lamov.h" 12 | -------------------------------------------------------------------------------- /SRC/tools.h: -------------------------------------------------------------------------------- 1 | #include "./pblas.h" 2 | 3 | #ifdef __STDC__ 4 | typedef void (*CPYPTR)(Int, Int, float *, Int, float *, Int); 5 | #define SLVOID void 6 | #else 7 | typedef void (*CPYPTR)(); 8 | #define SLVOID char 9 | #endif 10 | 11 | #define ErrPrnt fprintf(stderr, "line %d of file %s\n",__LINE__, __FILE__); 12 | 13 | #define Mdescset(desc, m, n, mb, nb, rsrc, csrc, ictxt, lld) \ 14 | { \ 15 | (desc)[DT_] = BLOCK_CYCLIC_2D; \ 16 | (desc)[CTXT_] = (ictxt); \ 17 | (desc)[M_] = (m); \ 18 | (desc)[N_] = (n); \ 19 | (desc)[MB_] = (mb); \ 20 | (desc)[NB_] = (nb); \ 21 | (desc)[RSRC_] = (rsrc); \ 22 | (desc)[CSRC_] = (csrc); \ 23 | (desc)[LLD_] = (lld); \ 24 | } 25 | 26 | #define MCindxg2p(IG, nb, srcproc, nprocs) \ 27 | ( ((srcproc) + (IG)/(nb)) % nprocs ) 28 | 29 | typedef struct {double r, i;} DCOMPLEX; 30 | typedef struct {float r, i;} SCOMPLEX; 31 | 32 | #define Mmalloc(M_ptr, M_type, M_elt, M_i, M_ctxt) \ 33 | { \ 34 | void pberror_(); \ 35 | (M_ptr) = ( M_type * ) malloc((M_elt)*(sizeof(M_type))); \ 36 | if (!(M_ptr)) \ 37 | { \ 38 | if ((M_elt) > 0) \ 39 | { \ 40 | (M_i) = 1; \ 41 | fprintf(stderr, "Not enough memory on line %d of file %s!!\n", \ 42 | __LINE__, __FILE__); \ 43 | pberror_(&(M_ctxt), __FILE__, &(M_i)); \ 44 | } \ 45 | } \ 46 | } 47 | -------------------------------------------------------------------------------- /SRC/zlamov.c: -------------------------------------------------------------------------------- 1 | // 2 | // zlamov.c 3 | // 4 | // Written by Lee Killough 04/19/2012 5 | // 6 | 7 | #define TYPE complex16 8 | #define FUNC "ZLAMOV" 9 | #define LAMOV zlamov_ 10 | #define LACPY zlacpy_ 11 | #include "lamov.h" 12 | -------------------------------------------------------------------------------- /TESTING/BLLT.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK, Version 1.2, banded linear systems input file' 2 | 'MPI machine' 3 | '' output file name (if any) 4 | 6 device out 5 | 'U' define Lower or Upper 6 | 8 number of problem sizes 7 | 3 5 17 28 37 121 200 1023 values of N 8 | 6 number of bandwidths 9 | 1 2 4 10 31 64 values of BW 10 | 1 number of NB's 11 | -1 values of NB (-1 for automatic determination) 12 | 1 number of NRHS's (must be 1) 13 | 4 values of NRHS 14 | 1 number of NBRHS's (ignored) 15 | 1 values of NBRHS (ignored) 16 | 4 number of process grids 17 | 1 2 3 4 values of "Number of Process Columns" 18 | 3.0 threshold 19 | -------------------------------------------------------------------------------- /TESTING/BLU.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK, Version 1.2, banded linear systems input file' 2 | 'MPI machine' 3 | '' output file name (if any) 4 | 6 device out 5 | 'N' define transpose or not 6 | 3 number of problem sizes 7 | 3 5 17 28 37 121 200 1023 values of N 8 | 3 number of bandwidths 9 | 1 3 15 6 13 20 values of BWL 10 | 1 1 4 18 24 33 values of BWU 11 | 1 number of NB's 12 | -1 values of NB (-1 for automatic determination) 13 | 1 number of NRHS's (must be 1) 14 | 4 values of NRHS 15 | 1 number of NBRHS's (ignored) 16 | 1 values of NBRHS (ignored) 17 | 4 number of process grids 18 | 1 2 3 4 values of "Number of Process Columns" 19 | 3.0 threshold 20 | -------------------------------------------------------------------------------- /TESTING/BRD.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK BRD input file' 2 | 'MPI machine' 3 | 'BRD.out' output file name (if any) 4 | 6 device out 5 | 4 number of problems sizes 6 | 4 10 17 13 23 31 57 values of M 7 | 4 12 13 13 23 31 50 values of N 8 | 4 number of NB's 9 | 2 3 4 5 values of NB 10 | 4 number of processor grids (ordered pairs of P & Q) 11 | 1 2 1 4 2 3 8 values of P 12 | 1 2 4 1 3 2 1 values of Q 13 | 10.0 threshold 14 | -------------------------------------------------------------------------------- /TESTING/EIG/listing: -------------------------------------------------------------------------------- 1 | * orthogonal matrix Q, the Hessenberg matrix, and the array TAU returned 2 | INTEGER CONTEXTC, CSRC_A, IACOL, IAROW, ICOFFA, IROFFA, 3 | DOUBLE PRECISION ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL, 4 | * orthogonal matrix Q, the Hessenberg matrix, and the array TAU returned 5 | INTEGER CONTEXTC, CSRC_A, IACOL, IAROW, ICOFFA, IROFFA, 6 | REAL ANINV, ANORM, COND, MAXQTQNRM, MAXTSTNRM, OVFL, 7 | -------------------------------------------------------------------------------- /TESTING/EVC.dat: -------------------------------------------------------------------------------- 1 | 'SCALAPACK NEP (Nonsymmetric Eigenvalue Problem) input file' 2 | 'MPI Machine' 3 | 'EVC.out' output file name (if any) 4 | 6 device out 5 | 1 number of problems sizes 6 | 100 1000 1500 2000 2500 3000 Probs 7 | 1 number of NB's 8 | 8 values of NB 9 | 4 number of process grids (ordered pairs of P & Q) 10 | 1 1 4 2 3 2 2 1 values of P 11 | 1 4 1 2 3 1 4 8 values of Q 12 | 20.0 threshold 13 | -------------------------------------------------------------------------------- /TESTING/HRD.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK HRD input file' 2 | 'MPI machine' 3 | 'HRD.out' output file name (if any) 4 | 6 device out 5 | 4 number of problems sizes 6 | 50 50 50 50 values of N 7 | 1 2 3 5 values of ILO 8 | 50 48 45 49 values of IHI 9 | 3 number of NB's 10 | 2 3 4 values of NB 11 | 4 number of processor grids (ordered pairs of P & Q) 12 | 1 2 1 4 2 3 8 values of P 13 | 1 2 4 1 3 2 1 values of Q 14 | 3.0 threshold 15 | -------------------------------------------------------------------------------- /TESTING/INV.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK, Version 1.0, Matrix Inversion Testing input file' 2 | 'MPI machine.' 3 | 'INV.out' output file name (if any) 4 | 6 device out 5 | 5 number of matrix types (next line) 6 | 'GEN' 'UTR' 'LTR' 'UPD' 'LPD' GEN, UTR, LTR, UPD, LPD 7 | 4 number of problems sizes 8 | 2 5 10 15 13 20 30 50 values of N 9 | 4 number of NB's 10 | 2 3 4 5 6 20 values of NB 11 | 4 number of process grids (ordered P & Q) 12 | 1 2 1 4 2 3 8 values of P 13 | 1 1 4 1 3 2 1 values of Q 14 | 1.0 threshold 15 | -------------------------------------------------------------------------------- /TESTING/LLT.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK, LLt factorization input file' 2 | 'MPI machine' 3 | 'LLT.out' output file name (if any) 4 | 6 device out 5 | 'U' define Lower or Upper 6 | 4 number of problems sizes 7 | 4 10 17 13 23 31 57 values of N 8 | 3 number of NB's 9 | 2 3 4 5 values of NB 10 | 3 number of NRHS's 11 | 1 3 9 28 values of NRHS 12 | 3 number of NBRHS's 13 | 1 3 5 7 values of NBRHS 14 | 4 number of process grids (ordered pairs P & Q) 15 | 1 2 1 4 2 3 8 values of P 16 | 1 2 4 1 3 2 1 values of Q 17 | 3.0 threshold 18 | T (T or F) Test Cond. Est. and Iter. Ref. Routines 19 | -------------------------------------------------------------------------------- /TESTING/LS.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK LS solve input file' 2 | 'MPI machine' 3 | 'LS.out' output file name (if any) 4 | 6 device out 5 | 3 number of problems sizes 6 | 15 7 31 values of M 7 | 5 21 31 values of N 8 | 2 number of NB's 9 | 2 3 5 values of NB 10 | 2 number of NRHS's 11 | 2 3 5 values of NRHS 12 | 2 number of NBRHS's 13 | 1 2 values of NBRHS 14 | 4 number of process grids (ordered pairs P & Q) 15 | 1 1 4 2 2 3 8 values of P 16 | 1 4 1 2 3 2 1 values of Q 17 | 4.0 threshold 18 | -------------------------------------------------------------------------------- /TESTING/LU.dat: -------------------------------------------------------------------------------- 1 | 'SCALAPACK, LU factorization input file' 2 | 'MPI Machine' 3 | 'LU.out' output file name (if any) 4 | 6 device out 5 | 4 number of problems sizes 6 | 4 10 17 13 23 31 57 values of M 7 | 4 12 13 13 23 31 50 values of N 8 | 3 number of NB's 9 | 2 3 4 5 values of NB 10 | 3 number of NRHS's 11 | 1 3 9 28 values of NRHS 12 | 3 Number of NBRHS's 13 | 1 3 5 7 values of NBRHS 14 | 4 number of process grids (ordered pairs of P & Q) 15 | 1 2 1 4 2 3 8 values of P 16 | 1 2 4 1 3 2 1 values of Q 17 | 1.0 threshold 18 | T (T or F) Test Cond. Est. and Iter. Ref. Routines 19 | -------------------------------------------------------------------------------- /TESTING/NEP.dat: -------------------------------------------------------------------------------- 1 | 'SCALAPACK NEP (Nonsymmetric Eigenvalue Problem) input file' 2 | 'MPI machine' 3 | 'NEP.out' output file name (if any) 4 | 6 device out 5 | 7 number of problems sizes 6 | 1 2 3 4 6 10 50 Probs 7 | 3 number of NB's 8 | 6 8 17 values of NB 9 | 2 number of process grids (ordered pairs of P & Q) 10 | 1 2 1 1 4 2 1 values of P 11 | 1 2 3 4 1 4 8 values of Q 12 | 20.0 threshold 13 | -------------------------------------------------------------------------------- /TESTING/QR.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK, Orthogonal factorizations input file' 2 | 'MPI machine' 3 | 'QR.out' output file name (if any) 4 | 6 device out 5 | 6 number of factorizations 6 | 'QR' 'QL' 'LQ' 'RQ' 'QP' 'TZ' factorizations: QR, QL, LQ, RQ, QP, TZ 7 | 4 number of problems sizes 8 | 2 5 13 15 13 26 30 15 values of M 9 | 2 7 8 10 17 20 30 35 values of N 10 | 4 number of blocking sizes 11 | 4 3 5 5 4 6 values of MB 12 | 4 7 3 5 8 2 values of NB 13 | 4 number of process grids (ordered pairs P & Q) 14 | 1 2 1 4 2 3 8 values of P 15 | 1 2 4 1 3 2 1 values of Q 16 | 5.0 threshold 17 | -------------------------------------------------------------------------------- /TESTING/SVD.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK Singular Value Decomposition input file' 2 | 6 device out 3 | 4 maxnodes 4 | ' ' 5 | 'TEST 1 - test medium matrices - all types and requests' 6 | 20.0 Threshold 7 | 1 number of matrices 8 | 100 number of rows 9 | 25 number of columns 10 | 1 number of processor configurations (P, Q, NB) 11 | 2 values of P (NPROW) 12 | 2 values of Q (NPCOL) 13 | 8 values of NB 14 | ' ' 15 | 'TEST 2 - test medium matrices - all processor configurations' 16 | 20.0 Threshold 17 | 1 number of matrices 18 | 80 number of rows 19 | 32 number of columns 20 | 1 number of processor configurations (P, Q, NB) 21 | 2 values of P (NPROW) 22 | 2 values of Q (NPCOL) 23 | 8 values of NB 24 | ' ' 25 | 'TEST 3 - test one large matrix' 26 | 15.0 Threshold 27 | 1 number of matrices 28 | 24 number of rows 29 | 8 number of columns 30 | 1 number of processor configurations (P, Q, NB) 31 | 2 values of P (NPROW) 32 | 2 values of Q (NPCOL) 33 | 8 values of NB 34 | ' ' 35 | 'End of tests' 36 | -1 37 | -------------------------------------------------------------------------------- /TESTING/TRD.dat: -------------------------------------------------------------------------------- 1 | 'ScaLAPACK TRD computation input file' 2 | 'MPI machine' 3 | 'TRD.out' output file name 4 | 6 device out 5 | 'L' define Lower or Upper 6 | 4 number of problems sizes 7 | 16 50 6 11 21 22 23 values of N 8 | 4 number of NB's 9 | 1 2 3 4 5 values of NB 10 | 3 Number of processor grids (ordered pairs of P & Q) 11 | 1 1 4 2 1 3 1 values of P 12 | 1 4 1 2 3 1 1 values of Q 13 | 10.0 threshold 14 | -------------------------------------------------------------------------------- /TOOLS/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_subdirectory(LAPACK) 2 | 3 | set (ATOOLS 4 | iceil.f ilacpy.f ilcm.f indxg2p.f indxg2l.f 5 | indxl2g.f infog1l.f infog2l.f npreroc.f numroc.f 6 | chk1mat.f pchkxmat.f sltimer.f desc_convert.f 7 | descinit.f descset.f 8 | SL_init.f) 9 | 10 | set (ITOOLS 11 | picol2row.f pirow2col.f pilaprnt.f pitreecomb.f pifillpad.f 12 | pichekpad.f pielset.f pielset2.f pielget.f) 13 | 14 | set (STOOLS 15 | dsnrm2.f dsasum.f slatcpy.f ssdot.f smatadd.f 16 | psmatadd.f pscol2row.f psrow2col.f pslaprnt.f pstreecomb.f 17 | psfillpad.f pschekpad.f pselset.f pselset2.f pselget.f 18 | pslaread.f pslawrite.f) 19 | 20 | set (DTOOLS 21 | dddot.f dlatcpy.f dmatadd.f pdmatadd.f pdcol2row.f 22 | pdrow2col.f pdlaprnt.f pdtreecomb.f pdfillpad.f pdchekpad.f 23 | pdelset.f pdelset2.f pdelget.f 24 | pdlaread.f pdlawrite.f) 25 | 26 | set (CTOOLS 27 | dscnrm2.f dscasum.f ccdotu.f ccdotc.f clatcpy.f 28 | cmatadd.f pcmatadd.f pccol2row.f pcrow2col.f pclaprnt.f 29 | pctreecomb.f pcfillpad.f pcchekpad.f pcelset.f pcelset2.f 30 | pcelget.f 31 | pclaread.f pclawrite.f) 32 | 33 | set (ZTOOLS 34 | zzdotu.f zzdotc.f zlatcpy.f zmatadd.f pzmatadd.f 35 | pzcol2row.f pzrow2col.f pzlaprnt.f pztreecomb.f pzfillpad.f 36 | pzchekpad.f pzelset.f pzelset2.f pzelget.f 37 | pzlaread.f pzlawrite.f) 38 | 39 | set(tools 40 | ${ATOOLS} ${ITOOLS} ${STOOLS} ${DTOOLS} ${CTOOLS} ${ZTOOLS}) 41 | 42 | set(tools-C 43 | reshape.c SL_gridreshape.c ) 44 | 45 | -------------------------------------------------------------------------------- /TOOLS/LAPACK/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | set (ALLAUX icopy.f) 2 | 3 | set (SCATGEN slatm1.f slaran.f slarnd.f) 4 | 5 | set (SMATGEN slatms.f slagge.f slagsy.f slarot.f) 6 | 7 | set (CMATGEN clarnv.f clatm1.f clatms.f clagge.f claghe.f clagsy.f clarot.f clarnd.f) 8 | 9 | set (DZATGEN dlatm1.f dlaran.f dlarnd.f) 10 | 11 | set (DMATGEN dlatms.f dlagge.f dlagsy.f dlarot.f) 12 | 13 | set (ZMATGEN zlarnv.f zlatm1.f zlatms.f zlagge.f zlaghe.f zlagsy.f zlarot.f zlarnd.f) 14 | 15 | set (extra_lapack 16 | ${ALLAUX} ${SCATGEN} ${SMATGEN} ${CMATGEN} ${DZATGEN} ${DMATGEN} ${ZMATGEN}) 17 | -------------------------------------------------------------------------------- /TOOLS/LAPACK/Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################ 2 | # 3 | # Program: ScaLAPACK 4 | # 5 | # Module: Makefile 6 | # 7 | # Purpose: Tools - LAPACK Makefile 8 | # 9 | # Creation date: March 20, 1995 10 | # 11 | # Modified: February 16, 2000 12 | # 13 | # Send bug reports, comments or suggestions to scalapack@cs.utk.edu 14 | # 15 | ############################################################################ 16 | 17 | include ../../SLmake.inc 18 | 19 | ALLAUX = icopy.o 20 | 21 | SCATGEN = slatm1.o slaran.o slarnd.o 22 | 23 | SMATGEN = slatms.o slagge.o slagsy.o slarot.o 24 | 25 | CMATGEN = clarnv.o clatm1.o clatms.o clagge.o claghe.o clagsy.o clarot.o \ 26 | clarnd.o 27 | 28 | DZATGEN = dlatm1.o dlaran.o dlarnd.o 29 | 30 | DMATGEN = dlatms.o dlagge.o dlagsy.o dlarot.o 31 | 32 | ZMATGEN = zlarnv.o zlatm1.o zlatms.o zlagge.o zlaghe.o zlagsy.o zlarot.o \ 33 | zlarnd.o 34 | 35 | all : single complex double complex16 36 | 37 | single: $(ALLAUX) $(SMATGEN) $(SCATGEN) 38 | $(ARCH) $(ARCHFLAGS) ../../$(SCALAPACKLIB) $(SLASRC) $(ALLAUX) $(SCLAUX) \ 39 | $(SMATGEN) $(SCATGEN) 40 | $(RANLIB) ../../$(SCALAPACKLIB) 41 | 42 | complex: $(ALLAUX) $(CMATGEN) $(SCATGEN) 43 | $(ARCH) $(ARCHFLAGS) ../../$(SCALAPACKLIB) $(CLASRC) $(ALLAUX) $(SCLAUX) \ 44 | $(CMATGEN) $(SCATGEN) 45 | $(RANLIB) ../../$(SCALAPACKLIB) 46 | 47 | double: $(ALLAUX) $(DMATGEN) $(DZATGEN) 48 | $(ARCH) $(ARCHFLAGS) ../../$(SCALAPACKLIB) $(DLASRC) $(ALLAUX) $(DZLAUX) \ 49 | $(DMATGEN) $(DZATGEN) 50 | $(RANLIB) ../../$(SCALAPACKLIB) 51 | 52 | complex16: $(ALLAUX) $(ZMATGEN) $(DZATGEN) 53 | $(ARCH) $(ARCHFLAGS) ../../$(SCALAPACKLIB) $(ZLASRC) $(ALLAUX) $(DZLAUX) \ 54 | $(ZMATGEN) $(DZATGEN) 55 | $(RANLIB) ../../$(SCALAPACKLIB) 56 | 57 | clean : 58 | rm -f *.o 59 | 60 | slamch.o: 61 | $(FC) -c $(NOOPT) slamch.f 62 | 63 | dlamch.o: 64 | $(FC) -c $(NOOPT) dlamch.f 65 | 66 | .f.o : ; $(FC) -c $(FCFLAGS) $*.f 67 | 68 | -------------------------------------------------------------------------------- /TOOLS/SL_gridreshape.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #ifndef Int 5 | #define Int int 6 | #endif 7 | 8 | Int SL_Cgridreshape(Int ctxt, Int pstart, Int row_major_in, Int row_major_out, Int P, Int Q) 9 | { 10 | Int Cblacs_pnum(); 11 | Int nctxt, P0, Q0, Np, i, *g; 12 | 13 | Cblacs_gridinfo(ctxt, &P0, &Q0, &i, &Np); 14 | Np = P * Q; 15 | if (Np+pstart > P0*Q0) 16 | { 17 | fprintf(stderr, "Illegal reshape command in %s\n",__FILE__); 18 | Cblacs_abort(ctxt, -22); 19 | } 20 | g = (Int *) malloc(Np * sizeof(Int)); 21 | if (!g) 22 | { 23 | fprintf(stderr, "Cannot allocate memory in %s\n",__FILE__); 24 | Cblacs_abort(ctxt, -23); 25 | } 26 | if (row_major_in) /* Read in in row-major order */ 27 | { 28 | if (row_major_out) 29 | for (i=0; i != Np; i++) 30 | g[(i%Q)*P+i/Q] = Cblacs_pnum(ctxt, (pstart+i)/Q0, (pstart+i)%Q0); 31 | else 32 | for (i=0; i != Np; i++) 33 | g[i] = Cblacs_pnum(ctxt, (pstart+i)/Q0, (pstart+i)%Q0); 34 | } 35 | else /* read in in column-major order */ 36 | { 37 | if (row_major_out) 38 | for (i=0; i != Np; i++) 39 | g[(i%Q)*P+i/Q] = Cblacs_pnum(ctxt, (pstart+i)%P0, (pstart+i)/P0); 40 | else 41 | for (i=0; i != Np; i++) 42 | g[i] = Cblacs_pnum(ctxt, (pstart+i)%P0, (pstart+i)/P0); 43 | } 44 | Cblacs_get(ctxt, 10, &nctxt); 45 | Cblacs_gridmap(&nctxt, g, P, P, Q); 46 | free(g); 47 | 48 | return(nctxt); 49 | } 50 | 51 | Int sl_gridreshape_(Int *ctxt, Int *pstart, Int *row_major_in, Int *row_major_out, Int *P, Int *Q) 52 | { 53 | return( SL_Cgridreshape(*ctxt, *pstart, *row_major_in, *row_major_out, 54 | *P, *Q) ); 55 | } 56 | 57 | Int SL_GRIDRESHAPE(Int *ctxt, Int *pstart, Int *row_major_in, Int *row_major_out, Int *P, Int *Q) 58 | { 59 | return( SL_Cgridreshape(*ctxt, *pstart, *row_major_in, *row_major_out, 60 | *P, *Q) ); 61 | } 62 | 63 | Int sl_gridreshape__(Int *ctxt, Int *pstart, Int *row_major_in, Int *row_major_out, Int *P, Int *Q) 64 | { 65 | return( SL_Cgridreshape(*ctxt, *pstart, *row_major_in, *row_major_out, 66 | *P, *Q) ); 67 | } 68 | 69 | Int sl_gridreshape(Int *ctxt, Int *pstart, Int *row_major_in, Int *row_major_out, Int *P, Int *Q) 70 | { 71 | return( SL_Cgridreshape(*ctxt, *pstart, *row_major_in, *row_major_out, 72 | *P, *Q) ); 73 | } 74 | -------------------------------------------------------------------------------- /TOOLS/SL_init.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SL_INIT( ICTXT, NPROW, NPCOL ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER ICTXT, NPCOL, NPROW 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * SL_INIT initializes an NPROW x NPCOL process grid using a row-major 16 | * ordering of the processes. This routine retrieves a default system 17 | * context which will include all available processes. In addition it 18 | * spawns the processes if needed. 19 | * 20 | * Arguments 21 | * ========= 22 | * 23 | * ICTXT (global output) INTEGER 24 | * ICTXT specifies the BLACS context handle identifying the 25 | * created process grid. The context itself is global. 26 | * 27 | * NPROW (global input) INTEGER 28 | * NPROW specifies the number of process rows in the grid 29 | * to be created. 30 | * 31 | * NPCOL (global input) INTEGER 32 | * NPCOL specifies the number of process columns in the grid 33 | * to be created. 34 | * 35 | * ===================================================================== 36 | * 37 | * .. Local Scalars .. 38 | INTEGER IAM, NPROCS 39 | * .. 40 | * .. External Subroutines .. 41 | EXTERNAL BLACS_GET, BLACS_GRIDINIT, BLACS_PINFO, 42 | $ BLACS_SETUP 43 | * .. 44 | * .. Executable Statements .. 45 | * 46 | * Get starting information 47 | * 48 | CALL BLACS_PINFO( IAM, NPROCS ) 49 | * 50 | * If machine needs additional set up, do it now 51 | * 52 | IF( NPROCS.LT.1 ) THEN 53 | IF( IAM.EQ.0 ) 54 | $ NPROCS = NPROW * NPCOL 55 | CALL BLACS_SETUP( IAM, NPROCS ) 56 | END IF 57 | * 58 | * Define process grid 59 | * 60 | CALL BLACS_GET( -1, 0, ICTXT ) 61 | CALL BLACS_GRIDINIT( ICTXT, 'Row-major', NPROW, NPCOL ) 62 | * 63 | RETURN 64 | * 65 | * End of SL_INIT 66 | * 67 | END 68 | -------------------------------------------------------------------------------- /TOOLS/ccdotc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE CCDOTC( N, DOTC, X, INCX, Y, INCY ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX DOTC 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * CCDOTC is a simple FORTRAN wrapper around the BLAS function 20 | * CDOTC returning the result in the parameter list instead. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. Local Scalars .. 25 | COMPLEX CTEMP 26 | INTEGER I,IX,IY 27 | * .. 28 | * .. Intrinsic Functions .. 29 | INTRINSIC CONJG 30 | * .. 31 | * .. Executable Statements .. 32 | * 33 | CTEMP = (0.0d0,0.0d0) 34 | DOTC = (0.0d0,0.0d0) 35 | IF (N.LE.0) RETURN 36 | IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 37 | * 38 | * code for both increments equal to 1 39 | * 40 | DO i = 1,N 41 | CTEMP = CTEMP + CONJG(X(I))*Y(I) 42 | END DO 43 | ELSE 44 | * 45 | * code for unequal increments or equal increments 46 | * not equal to 1 47 | * 48 | IX = 1 49 | IY = 1 50 | IF (INCX.LT.0) IX = (-N+1)*INCX + 1 51 | IF (INCY.LT.0) IY = (-N+1)*INCY + 1 52 | DO I = 1,N 53 | CTEMP = CTEMP + CONJG(X(IX))*Y(IY) 54 | IX = IX + INCX 55 | IY = IY + INCY 56 | END DO 57 | END IF 58 | DOTC = CTEMP 59 | * 60 | RETURN 61 | * 62 | * End of CCDOTC 63 | * 64 | END 65 | -------------------------------------------------------------------------------- /TOOLS/ccdotu.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE CCDOTU( N, DOTU, X, INCX, Y, INCY ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX DOTU 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * CCDOTU is a simple FORTRAN wrapper around the BLAS function 20 | * CDOTU returning the result in the parameter list instead. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. Local Scalars .. 25 | COMPLEX CTEMP 26 | INTEGER I,IX,IY 27 | * .. 28 | * .. Executable Statements .. 29 | * 30 | CTEMP = (0.0d0,0.0d0) 31 | DOTU = (0.0d0,0.0d0) 32 | IF (N.LE.0) RETURN 33 | IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 34 | * 35 | * code for both increments equal to 1 36 | * 37 | DO i = 1,N 38 | CTEMP = CTEMP + X(I)*Y(I) 39 | END DO 40 | ELSE 41 | * 42 | * code for unequal increments or equal increments 43 | * not equal to 1 44 | * 45 | IX = 1 46 | IY = 1 47 | IF (INCX.LT.0) IX = (-N+1)*INCX + 1 48 | IF (INCY.LT.0) IY = (-N+1)*INCY + 1 49 | DO I = 1,N 50 | CTEMP = CTEMP + X(IX)*Y(IY) 51 | IX = IX + INCX 52 | IY = IY + INCY 53 | END DO 54 | END IF 55 | DOTU = CTEMP 56 | * 57 | RETURN 58 | * 59 | * End of CCDOTU 60 | * 61 | END 62 | -------------------------------------------------------------------------------- /TOOLS/dddot.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE DDDOT( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | DOUBLE PRECISION DOT 11 | * .. 12 | * .. Array Arguments .. 13 | DOUBLE PRECISION X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * DDDOT is a simple FORTRAN wrapper around the BLAS function 20 | * DDOT returning the result in the parameter list instead. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. External Functions .. 25 | DOUBLE PRECISION DDOT 26 | EXTERNAL DDOT 27 | * .. 28 | * .. Executable Statements .. 29 | * 30 | DOT = DDOT( N, X, INCX, Y, INCY ) 31 | * 32 | RETURN 33 | * 34 | * End of DDDOT 35 | * 36 | END 37 | -------------------------------------------------------------------------------- /TOOLS/dsasum.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION DSASUM( N, X, INCX ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | * .. 11 | * .. Array Arguments .. 12 | REAL X( * ) 13 | * .. 14 | * 15 | * Purpose 16 | * ======= 17 | * 18 | * DSASUM is a simple FORTRAN wrapper around the BLAS function SASUM 19 | * returning the result as a double allowing it to be callable by C 20 | * programs. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. External Functions .. 25 | REAL SASUM 26 | EXTERNAL SASUM 27 | * .. 28 | * .. Intrinsic Functions .. 29 | INTRINSIC DBLE 30 | * .. 31 | * .. Executable Statements .. 32 | * 33 | DSASUM = DBLE( SASUM( N, X, INCX ) ) 34 | * 35 | RETURN 36 | * 37 | * End of DSASUM 38 | * 39 | END 40 | -------------------------------------------------------------------------------- /TOOLS/dscasum.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION DSCASUM( N, X, INCX ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | * .. 11 | * .. Array Arguments .. 12 | COMPLEX X( * ) 13 | * .. 14 | * 15 | * Purpose 16 | * ======= 17 | * 18 | * DSCASUM is a simple FORTRAN wrapper around the BLAS function SCASUM 19 | * returning the result as a double allowing it to be callable by C 20 | * programs. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. External Functions .. 25 | REAL SCASUM 26 | EXTERNAL SCASUM 27 | * .. 28 | * .. Intrinsic Functions .. 29 | INTRINSIC DBLE 30 | * .. 31 | * .. Executable Statements .. 32 | * 33 | DSCASUM = DBLE( SCASUM( N, X, INCX ) ) 34 | * 35 | RETURN 36 | * 37 | * End of DSCASUM 38 | * 39 | END 40 | -------------------------------------------------------------------------------- /TOOLS/dscnrm2.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION DSCNRM2( N, X, INCX ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | * .. 11 | * .. Array Arguments .. 12 | COMPLEX X( * ) 13 | * .. 14 | * 15 | * Purpose 16 | * ======= 17 | * 18 | * DSCNRM2 is a simple FORTRAN wrapper around the BLAS function SCNRM2 19 | * returning the result as a double allowing it to be callable by C 20 | * programs. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. External Functions .. 25 | REAL SCNRM2 26 | EXTERNAL SCNRM2 27 | * .. 28 | * .. Intrinsic Functions .. 29 | INTRINSIC DBLE 30 | * .. 31 | * .. Executable Statements .. 32 | * 33 | DSCNRM2 = DBLE( SCNRM2( N, X, INCX ) ) 34 | * 35 | RETURN 36 | * 37 | * End of DSCNRM2 38 | * 39 | END 40 | -------------------------------------------------------------------------------- /TOOLS/dsnrm2.f: -------------------------------------------------------------------------------- 1 | DOUBLE PRECISION FUNCTION DSNRM2( N, X, INCX ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, N 10 | * .. 11 | * .. Array Arguments .. 12 | REAL X( * ) 13 | * .. 14 | * 15 | * Purpose 16 | * ======= 17 | * 18 | * DSNRM2 is a simple FORTRAN wrapper around the BLAS function SNRM2 19 | * returning the result as a double allowing it to be callable by C 20 | * programs. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. External Functions .. 25 | REAL SNRM2 26 | EXTERNAL SNRM2 27 | * .. 28 | * .. Intrinsic Functions .. 29 | INTRINSIC DBLE 30 | * .. 31 | * .. Executable Statements .. 32 | * 33 | DSNRM2 = DBLE( SNRM2( N, X, INCX ) ) 34 | * 35 | RETURN 36 | * 37 | * End of DSNRM2 38 | * 39 | END 40 | -------------------------------------------------------------------------------- /TOOLS/iceil.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION ICEIL( INUM, IDENOM ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER IDENOM, INUM 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * ICEIL returns the ceiling of the division of two integers. 16 | * 17 | * Arguments 18 | * ========= 19 | * 20 | * INUM (local input) INTEGER 21 | * The numerator, 22 | * 23 | * IDENOM (local input) INTEGER 24 | * and the denominator of the fraction to be evaluated. 25 | * 26 | * ===================================================================== 27 | * 28 | * .. Executable Statements .. 29 | * 30 | ICEIL = (INUM+IDENOM-1) / IDENOM 31 | * 32 | RETURN 33 | * 34 | * End of ICEIL 35 | * 36 | END 37 | -------------------------------------------------------------------------------- /TOOLS/ilcm.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION ILCM( M, N ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER M, N 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * ILCM computes and returns the Least Common Multiple (LCM) of two 16 | * positive integers M and N. In fact the routine computes the greatest 17 | * common divisor (GCD) and use the fact that M*N = GCD*LCM. 18 | * 19 | * Arguments 20 | * ========= 21 | * 22 | * M (input) INTEGER 23 | * On entry, M >=0. Unchanged on exit. 24 | * 25 | * N (input) INTEGER 26 | * On entry, N >=0. Unchanged on exit. 27 | * 28 | * ===================================================================== 29 | * 30 | * .. Local Scalars .. 31 | INTEGER IA, IQ, IR 32 | * .. 33 | * .. Executable Statements .. 34 | * 35 | IF( M.GE.N ) THEN 36 | IA = M 37 | ILCM = N 38 | ELSE 39 | IA = N 40 | ILCM = M 41 | ENDIF 42 | * 43 | 10 CONTINUE 44 | IQ = IA / ILCM 45 | IR = IA - IQ * ILCM 46 | IF( IR.EQ.0 ) THEN 47 | ILCM = ( M * N ) / ILCM 48 | RETURN 49 | END IF 50 | IA = ILCM 51 | ILCM = IR 52 | GO TO 10 53 | * 54 | * End of ILCM 55 | * 56 | END 57 | -------------------------------------------------------------------------------- /TOOLS/indxg2l.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION INDXG2L( INDXGLOB, NB, IPROC, ISRCPROC, NPROCS ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INDXGLOB, IPROC, ISRCPROC, NB, NPROCS 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * INDXG2L computes the local index of a distributed matrix entry 16 | * pointed to by the global index INDXGLOB. 17 | * 18 | * Arguments 19 | * ========= 20 | * 21 | * INDXGLOB (global input) INTEGER 22 | * The global index of the distributed matrix entry. 23 | * 24 | * NB (global input) INTEGER 25 | * Block size, size of the blocks the distributed matrix is 26 | * split into. 27 | * 28 | * IPROC (local dummy) INTEGER 29 | * Dummy argument in this case in order to unify the calling 30 | * sequence of the tool-routines. 31 | * 32 | * ISRCPROC (local dummy) INTEGER 33 | * Dummy argument in this case in order to unify the calling 34 | * sequence of the tool-routines. 35 | * 36 | * NPROCS (global input) INTEGER 37 | * The total number processes over which the distributed 38 | * matrix is distributed. 39 | * 40 | * ===================================================================== 41 | * 42 | * .. Intrinsic Functions .. 43 | INTRINSIC MOD 44 | * .. 45 | * .. Executable Statements .. 46 | * 47 | INDXG2L = NB*((INDXGLOB-1)/(NB*NPROCS))+MOD(INDXGLOB-1,NB)+1 48 | * 49 | RETURN 50 | * 51 | * End of INDXG2L 52 | * 53 | END 54 | -------------------------------------------------------------------------------- /TOOLS/indxg2p.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION INDXG2P( INDXGLOB, NB, IPROC, ISRCPROC, NPROCS ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INDXGLOB, IPROC, ISRCPROC, NB, NPROCS 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * INDXG2P computes the process coordinate which posseses the entry of a 16 | * distributed matrix specified by a global index INDXGLOB. 17 | * 18 | * Arguments 19 | * ========= 20 | * 21 | * INDXGLOB (global input) INTEGER 22 | * The global index of the element. 23 | * 24 | * NB (global input) INTEGER 25 | * Block size, size of the blocks the distributed matrix is 26 | * split into. 27 | * 28 | * IPROC (local dummy) INTEGER 29 | * Dummy argument in this case in order to unify the calling 30 | * sequence of the tool-routines. 31 | * 32 | * ISRCPROC (global input) INTEGER 33 | * The coordinate of the process that possesses the first 34 | * row/column of the distributed matrix. 35 | * 36 | * NPROCS (global input) INTEGER 37 | * The total number processes over which the matrix is 38 | * distributed. 39 | * 40 | * ===================================================================== 41 | * 42 | * .. Intrinsic Functions .. 43 | INTRINSIC MOD 44 | * .. 45 | * .. Executable Statements .. 46 | * 47 | INDXG2P = MOD( ISRCPROC + (INDXGLOB - 1) / NB, NPROCS ) 48 | * 49 | RETURN 50 | * 51 | * End of INDXG2P 52 | * 53 | END 54 | -------------------------------------------------------------------------------- /TOOLS/indxl2g.f: -------------------------------------------------------------------------------- 1 | INTEGER FUNCTION INDXL2G( INDXLOC, NB, IPROC, ISRCPROC, NPROCS ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INDXLOC, IPROC, ISRCPROC, NB, NPROCS 10 | * .. 11 | * 12 | * Purpose 13 | * ======= 14 | * 15 | * INDXL2G computes the global index of a distributed matrix entry 16 | * pointed to by the local index INDXLOC of the process indicated by 17 | * IPROC. 18 | * 19 | * Arguments 20 | * ========= 21 | * 22 | * INDXLOC (global input) INTEGER 23 | * The local index of the distributed matrix entry. 24 | * 25 | * NB (global input) INTEGER 26 | * Block size, size of the blocks the distributed matrix is 27 | * split into. 28 | * 29 | * IPROC (local input) INTEGER 30 | * The coordinate of the process whose local array row or 31 | * column is to be determined. 32 | * 33 | * ISRCPROC (global input) INTEGER 34 | * The coordinate of the process that possesses the first 35 | * row/column of the distributed matrix. 36 | * 37 | * NPROCS (global input) INTEGER 38 | * The total number processes over which the distributed 39 | * matrix is distributed. 40 | * 41 | * ===================================================================== 42 | * 43 | * .. Intrinsic Functions .. 44 | INTRINSIC MOD 45 | * .. 46 | * .. Executable Statements .. 47 | * 48 | INDXL2G = NPROCS*NB*((INDXLOC-1)/NB) + MOD(INDXLOC-1,NB) + 49 | $ MOD(NPROCS+IPROC-ISRCPROC, NPROCS)*NB + 1 50 | * 51 | RETURN 52 | * 53 | * End of INDXL2G 54 | * 55 | END 56 | -------------------------------------------------------------------------------- /TOOLS/ssdot.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE SSDOT( N, DOT, X, INCX, Y, INCY ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | REAL DOT 11 | * .. 12 | * .. Array Arguments .. 13 | REAL X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * SSDOT is a simple FORTRAN wrapper around the BLAS function 20 | * SDOT returning the result in the parameter list instead. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. External Functions .. 25 | REAL SDOT 26 | EXTERNAL SDOT 27 | * .. 28 | * .. Executable Statements .. 29 | * 30 | DOT = SDOT( N, X, INCX, Y, INCY ) 31 | * 32 | RETURN 33 | * 34 | * End of SSDOT 35 | * 36 | END 37 | -------------------------------------------------------------------------------- /TOOLS/zzdotc.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE ZZDOTC( N, DOTC, X, INCX, Y, INCY ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX*16 DOTC 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX*16 X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * ZZDOTC is a simple FORTRAN wrapper around the BLAS function 20 | * ZDOTC returning the result in the parameter list instead. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. Local Scalars .. 25 | COMPLEX*16 ZTEMP 26 | INTEGER I,IX,IY 27 | * .. 28 | * .. Intrinsic Functions .. 29 | INTRINSIC DCONJG 30 | * .. 31 | * .. Executable Statements .. 32 | * 33 | ZTEMP = (0.0d0,0.0d0) 34 | DOTC = (0.0d0,0.0d0) 35 | IF (N.LE.0) RETURN 36 | IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 37 | * 38 | * code for both increments equal to 1 39 | * 40 | DO i = 1,N 41 | ZTEMP = ZTEMP + DCONJG(X(I))*Y(I) 42 | END DO 43 | ELSE 44 | * 45 | * code for unequal increments or equal increments 46 | * not equal to 1 47 | * 48 | IX = 1 49 | IY = 1 50 | IF (INCX.LT.0) IX = (-N+1)*INCX + 1 51 | IF (INCY.LT.0) IY = (-N+1)*INCY + 1 52 | DO I = 1,N 53 | ZTEMP = ZTEMP + DCONJG(X(IX))*Y(IY) 54 | IX = IX + INCX 55 | IY = IY + INCY 56 | END DO 57 | END IF 58 | DOTC = ZTEMP 59 | * 60 | RETURN 61 | * 62 | * End of ZZDOTC 63 | * 64 | END 65 | -------------------------------------------------------------------------------- /TOOLS/zzdotu.f: -------------------------------------------------------------------------------- 1 | SUBROUTINE ZZDOTU( N, DOTU, X, INCX, Y, INCY ) 2 | * 3 | * -- ScaLAPACK tools routine (version 1.7) -- 4 | * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 5 | * and University of California, Berkeley. 6 | * May 1, 1997 7 | * 8 | * .. Scalar Arguments .. 9 | INTEGER INCX, INCY, N 10 | COMPLEX*16 DOTU 11 | * .. 12 | * .. Array Arguments .. 13 | COMPLEX*16 X( * ), Y( * ) 14 | * .. 15 | * 16 | * Purpose 17 | * ======= 18 | * 19 | * ZZDOTU is a simple FORTRAN wrapper around the BLAS function 20 | * ZDOTU returning the result in the parameter list instead. 21 | * 22 | * ===================================================================== 23 | * 24 | * .. Local Scalars .. 25 | COMPLEX*16 ZTEMP 26 | INTEGER I,IX,IY 27 | * .. 28 | * .. Executable Statements .. 29 | * 30 | ZTEMP = (0.0d0,0.0d0) 31 | DOTU = (0.0d0,0.0d0) 32 | IF (N.LE.0) RETURN 33 | IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 34 | * 35 | * code for both increments equal to 1 36 | * 37 | DO i = 1,N 38 | ZTEMP = ZTEMP + X(I)*Y(I) 39 | END DO 40 | ELSE 41 | * 42 | * code for unequal increments or equal increments 43 | * not equal to 1 44 | * 45 | IX = 1 46 | IY = 1 47 | IF (INCX.LT.0) IX = (-N+1)*INCX + 1 48 | IF (INCY.LT.0) IY = (-N+1)*INCY + 1 49 | DO I = 1,N 50 | ZTEMP = ZTEMP + X(IX)*Y(IY) 51 | IX = IX + INCX 52 | IY = IY + INCY 53 | END DO 54 | END IF 55 | DOTU = ZTEMP 56 | * 57 | RETURN 58 | * 59 | * End of ZZDOTU 60 | * 61 | END 62 | -------------------------------------------------------------------------------- /scalapack.pc.in: -------------------------------------------------------------------------------- 1 | prefix=@CMAKE_INSTALL_PREFIX@ 2 | libdir=${prefix}/@CMAKE_INSTALL_LIBDIR@ 3 | 4 | Name: scalapack 5 | Description: SCALAPACK reference implementation 6 | Version: @SCALAPACK_VERSION@ 7 | URL: http://www.netlib.org/scalapack/ 8 | Libs: -L${libdir} -lscalapack 9 | Requires: mpi lapack blas 10 | --------------------------------------------------------------------------------