我正在尝试翻译这个 CODE从 Fortran 到 C。
这是我目前所拥有的:
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include "mpi.h"
#define PRINT_NOTHING 0
#define PRINT_UP_TO_MESGS 1
#define PRINT_UP_TO_ARRAYS 2
#define PRINT_UP_TO_MATRICES 3
#define PRINT_LEVEL PRINT_UP_TO_MATRICES
/*! Parameters: */
#define TOTMEM 425053208
#define INTMEM 13107200
#define NTESTS 20
#define DLEN_ 9
#define DBLESZ 8 /*! Size of a DOUBLE PRE. */
#define MEMSIZ 425053208/8 /*! Memory for DOUBLE PRE. */
#define MASTER 0
#define MPI_ERROR_CODE_ERROR_GRID 1
#define MPI_ERROR_CODE_NOT_FACT 2
#define MPI_ERROR_CODE_NOT_SOLVE 3
#define BLACS_USER_WONT_FIN_MPI 0
#define BLACS_USER_WILL_FIN_MPI 1
#define DESCRIPTOR_SIZE 7
typedef enum {
FALSE,
TRUE
} logical;
/*! External subroutines: */
extern void Cblacs_barrier (int context,
char* scope);
extern void Cblacs_exit (int doneflag);
extern void Cblacs_get (int ,
int ,
int *context);
extern void Cblacs_gridexit (int context);
extern void Cblacs_gridinfo (int context,
int *our_nprow,
int *our_npcol,
int *my_prow,
int *my_pcol);
extern void Cblacs_gridinit (int* context,
char* order,
int nproc_rows,
int nproc_cols);
extern void Cblacs_pinfo (int *my_blacs_pid,
int *our_blacs_nprocs);
/* http://www.netlib.org/scalapack/explore-html/dd/d22/descinit_8f.html */
extern void descinit_ (int *desc,
int *m,
int *n,
int *mb,
int *nb,
int *irsrc,
int *icsrc,
int *ictxt,
int *lld,
int *info);
/* http://www.netlib.org/scalapack/explore-html/dc/d44/igsum2d___8c.html */
extern void igsum2d_ (int *contxt,
char *scope,
char *top,
int *m,
int *n,
int *a,
int *lda,
int *rdest,
int *cdest);
/* http://www.netlib.org/scalapack/explore-html/db/da1/pdbmatgen_8f.html */
extern void pdbmatgen_ (int *ictxt,
char *aform,
char *aform2,
int *bwl,
int *bwu,
int *n,
int *mb,
int *nb,
double *a,
int *lda,
int *iarow,
int *iacol,
int *iseed,
int *myrow,
int *mycol,
int *nprow,
int *npcol);
/* http://www.netlib.org/scalapack/explore-html/d8/dba/pdchekpad_8f.html */
extern void pdchekpad_ (int * ictxt,
char *mess,
int *m,
int *n,
double *a,
int *lda,
int *ipre,
int *ipost,
double *chkval);
/* http://www.netlib.org/scalapack/explore-html/d2/dc2/pddblaschk_8f.html */
extern void pddblaschk_ (char *symm,
char *uplo,
char *trans,
int *n,
int *bwl,
int *bwu,
int *nrhs,
double *x,
int *ix,
int *jx,
int *descx,
int *iaseed,
double *a,
int *ia,
int *ja,
int *desca,
int *ibseed,
double *anorm,
double *resid,
double *work,
int *worksiz);
/* http://www.netlib.org/scalapack/explore-html/d6/d3b/pdfillpad_8f.html */
extern void pdfillpad_ (int *ictxt,
int *m,
int *n,
double *a,
int *lda,
int *ipre,
int *ipost,
double *chkval);
/* http://www.netlib.org/scalapack/explore-html/d0/d2b/pdgbinfo_8f.html */
extern void pdgbinfo_ (char *summry,
int *nout,
char *trans,
int *nmat,
int *nval,
int *ldnval,
int *nbw,
int *bwlval,
int *bwuval,
int *ldbwval,
int *nnb,
int *nbval,
int *ldnbval,
int *nnr,
int *nrval,
int *ldnrval,
int *nnbr,
int *nbrval,
int *ldnbrval,
int *ngrids,
int *pval,
int *ldpval,
int *qval,
int *ldqval,
float *thresh,
double *work, /* Array to gather and bcast. */
int *iam,
int *nprocs);
/* http://www.netlib.org/scalapack/explore-html/dd/dad/pdgbtrf_8f.html */
extern void pdgbtrf_ (int *n,
int *bwl,
int *bwu,
double *a,
int *ja,
int *desca,
int *ipiv,
double *af,
int *laf,
double *work,
int *lwork,
int *info);
/* http://www.netlib.org/scalapack/explore-html/d9/dda/pdgbtrs_8f.html */
extern void pdgbtrs_ (char *trans,
int *n,
int *bwl,
int *bwu,
int *nrhs,
double *a,
int *ja,
int *desca,
int *ipiv,
double *b,
int *ib,
int *descb,
double *af,
int *laf,
double *work,
int *lwork,
int *info);
/*
http://www.netlib.org/scalapack/explore-html/d2/d66/_e_i_g_2pdmatgen_8f.html
*/
extern void pdmatgen_ (int *ictxt,
char *aform,
char *diag,
int *m,
int *n,
int *mb,
int *nb,
double *a,
int *lda,
int *iarow,
int *iacol,
int *iseed,
int *iroff,
int *irnum,
int *icoff,
int *icnum,
int *myrow,
int *mycol,
int *nprow,
int *npcol);
/* http://www.netlib.org/scalapack/explore-html/d2/dcd/sltimer_8f_source.html */
extern void slboot_ (void);
extern void slcombine_ (int *ictxt,
char *scope,
char *op,
char *timetype,
int *n,
int *ibeg,
double *times);
extern void sltimer_ ( int *i );
/*! External functions: */
/* http://www.netlib.org/scalapack/explore-html/d4/d48/numroc_8f.html */
extern int numroc_ (int *n,
int *nb,
int *iproc,
int *isrcproc,
int *nprocs);
/* http://www.netlib.org/scalapack/explore-html/df/dee/tools_8f.html#a67ae4efe5110e3297b1e9e3a46d8c78b */
extern logical lsame_ (char *ca,
char *cb);
/* http://www.netlib.org/scalapack/explore-html/db/dd0/pdlange_8f.html */
extern double pdlange_ (char *norm,
int *m,
int *n,
double *a,
int *ia,
int *ja,
int *desca,
double *work );
/*! Intrinsic functions: */
/* INTRINSIC DBLE, MAX, MIN, MOD */
inline double DBLE(int xx) { return (double) xx; }
inline double MAX(double xx, double yy) { return xx >= yy? xx: yy; }
inline double MIN(double xx, double yy) { return xx <= yy? xx: yy; }
inline int MOD(int xx, int yy) { return xx%yy; }
/*! PROGRAM PDGBDRIVER: */
int main (int argc, char **argv) {
/*! Parameters: */
int ntests = NTESTS; /* Number of num. tests to be performed */
// int BLOCK_CYCLIC_2D = 1;
// int DTYPE_ = 1;
// int CTXT_ = 2;
// int M_ = 3;
// int N_ = 4;
// int MB_ = 5;
// int NB_ = 6;
// int RSRC_ = 7;
// int CSRC_ = 8;
// int LLD_ = 9;
//
// double ZERO = 0.0;
// double PADVAL = -9923.0;
//
// int INT_ONE = 1;
/*! Local scalars: */
logical CHECK; /* Should or shouldn't I perform the num. tests? */
char TRANS; /* Should I transpose the matrix? */
// char PASSED[6];
char OUTFILE[80]; /* ? */
// int BWL;
// int BWU;
// int BW_NUM;
// int FILLIN_SIZE;
// int FREE_PTR;
// int H;
// int HH;
int I; /* Iterator per process grid. */
int IAM; /* My MPI process ID. */
int IASEED; /* Seed for random matrix A creation. */
int IBSEED; /* Seed for random matrix B creation. */
// int ICTXT;
// int ICTXTB;
// int IERR_TEMP;
// int IMIDPAD;
// int INFO;
// int IPA;
// int IPB;
// int IPOSTPAD;
// int IPREPAD;
// int IPW;
// int IPW_SIZE;
// int IPW_SOLVE;
// int IPW_SOLVE_SIZE;
// int IP_DRIVER_W;
// int IP_FILLIN;
// int J;
// int K;
/*! Data statements: */
// int KFAIL = 4;
// int KPASS = 4;
// int KSKIP = 4;
// int KTESTS = 4;
/*! Local scalars: (continued) */
// int MYCOL;
// int MYRHS_SIZE;
// int MYROW;
// int N;
// int NB;
int NBW; /* Number of bandwith values per matrix. */
int NGRIDS; /* Number of process grids to try for. */
int NMAT; /* Number of matrices */
int NNB; /* Number of sizes of NB (block column size). */
int NNBR;
int NNR;
int NOUT; /* Device out... o.O */
// int NP;
int NPCOL; /* Procs per row in processors grid/ */
int NPROCS; /* The size of OUR communicator. */
// int NPROCS_REAL;
int NPROW; /* Procs per row in processors grid/ */
// int NQ;
// int NRHS;
// int N_FIRST;
// int N_LAST;
// int WORKSIZ;
float THRESH; /* Threshold variable for numerical tests. */
// double ANORM;
// double NOPS;
// double NOPS2;
// double SRESID;
// double TMFLOPS;
// double TMFLOPS2;
/*! Local arrays: */
// int IPIV[INTMEM];
int BWLVAL[NTESTS]; /* Values of lower diagonals per matrix. */
int BWUVAL[NTESTS]; /* Values of upper diagonals per matrix. */
// int DESCA[7];
// int DESCA2D[DLEN_];
// int DESCB[7];
// int DESCB2D[DLEN_];
// int IERR[1];
int NBRVAL[NTESTS]; /* ? */
int NBVAL[NTESTS]; /* Column sizes per matrix. */
int NRVAL[NTESTS]; /* ? */
int NVAL[NTESTS]; /* Values of N for a given matrix. */
int PVAL[NTESTS]; /* Values for proc. rows. */
int QVAL[NTESTS]; /* Values for proc. cols. */
// double CTIME[2];
double *MEM; /* GLOABL array for broadcasting the information. */
// double WTIME[2];
/*! Executable statements: */
/*! Get starting information: */
Cblacs_pinfo(&IAM, &NPROCS);
IASEED = 100;
IBSEED = 200;
MEM = (double *) malloc(MEMSIZ);
pdgbinfo_(OUTFILE, &NOUT, &TRANS, &NMAT, NVAL, &ntests, &NBW,
BWLVAL, BWUVAL, &ntests, &NNB, NBVAL, &ntests, &NNR,
NRVAL, &ntests, &NNBR, NBRVAL, &ntests, &NGRIDS, PVAL,
&ntests, QVAL, &ntests, &THRESH, MEM, &IAM, &NPROCS);
CHECK = (THRESH >= 0.0f);
/*! Print headings: */
fprintf(stdout, "\n");
fprintf(stdout, "TIME TR N BWL BWU NB NRHS P Q L*U Time Slv Time MFLOPS MFLOP2 CHECK\n");
fprintf(stdout, "---- -- ------ --- --- ---- ----- ---- ---- -------- -------- -------- -------- ------\n");
fprintf(stdout, "\n");
fflush(stdout);
/*! Loop over different process grids: */
for (I = 1; I <= NGRIDS; I++) {
NPROW = PVAL[I - 1];
NPCOL = QVAL[I - 1];
fprintf(stdout, "Solving for a %d x %d grid!\n", NPROW, NPCOL);
}
free(MEM);
Cblacs_exit(0);
exit(EXIT_SUCCESS);
}
请原谅注释掉的变量数量，但正如我所说，我基本上是从头开始翻译引用驱动程序。
我的问题是它突然开始出现段错误，当我编写 for 循环时......它之前是有效的。这是一个时髦的内存操作问题的明显迹象，这可能是由与 C 和 Fortran 之间的内存管理差异相关的问题引起的。
至少，这是我的猜测。
有人知道可能出了什么问题吗？
最佳答案
这里的根本问题实际上是对 pdgbinfo 的调用，它从来没有真正打算从 C 中调用(毕竟它在测试中)；问题是字符串，它们实际上与数字数组的传递方式不同——长度总是被传递(例如，以便您可以打印它们)。
您可以在 C 端模拟它，但它将高度依赖编译器。最好的办法是从这些例程中拉出字符串，或者使用 ISO_C_BINDING为相关的 Fortran 例程生成可移植的 C 接口(interface)。在 F77 代码中包含纯数字数组的例程应该不是问题。
更新:如果您更改 pdgbinfo.f 的开头和子例程声明，如下所示:
SUBROUTINE PDGBINFO(CSUMMRY, NOUT, TRANS, NMAT, NVAL, LDNVAL, NBW,
& BWLVAL, BWUVAL, LDBWVAL, NNB, NBVAL, LDNBVAL,
& NNR, NRVAL, LDNRVAL, NNBR, NBRVAL, LDNBRVAL,
& NGRIDS, PVAL, LDPVAL, QVAL, LDQVAL, THRESH,
& WORK, IAM, NPROCS ) BIND(C)
use iso_c_binding
implicit none
*
*
*
* -- ScaLAPACK routine (version 1.7) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* November 15, 1997
*
* .. Scalar Arguments ..
CHARACTER(kind=c_char), intent(OUT) :: TRANS
CHARACTER(kind=c_char), dimension(*), intent(OUT) :: CSUMMRY
INTEGER(kind=c_int), intent(IN) :: IAM, LDNVAL, LDNBVAL,
& LDNRVAL, LDNBRVAL, LDPVAL,
& LDBWVAL, LDQVAL
INTEGER(kind=c_int), intent(INOUT) :: NPROCS
INTEGER(kind=c_int), intent(OUT) :: NOUT, NMAT, NBW, NNB,
& NNR, NNBR, NGRIDS
REAL(kind=c_float), intent(OUT) :: THRESH
INTEGER(kind=c_int), intent(OUT) :: NBRVAL( LDNBRVAL ),
& NBVAL( LDNBVAL ),
& NRVAL( LDNRVAL ), NVAL( LDNVAL ),
& BWLVAL( LDBWVAL),BWUVAL( LDBWVAL),
& PVAL( LDPVAL ), QVAL(LDQVAL), WORK( * )
CHARACTER(kind=c_char,len=100) :: SUMMRY
INTEGER :: c,sumlen
然后更改读取文件的位置，将字符串复制到 C 数组中:
*
* Read name and unit number for summary output file
*
READ( NIN, FMT = * ) SUMMRY
** convert to C string
sumlen = len_trim(SUMMRY)
do c=1,sumlen
csummry(c) = summry(c:c)
enddo
csummry(sumlen+1) = c_null_char
然后，您应该能够在 C 程序中去掉 pdgbinfo 之后的下划线，并使其以可跨编译器套件移植的方式工作。
关于C/Fortran 混合代码以一种奇怪的方式使用 MPI/ScaLAPACK 段错误，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/15536238/