При вызове подпрограммы Fortran из функции C ++, а функция C ++ вызывается внутри OpenMP-параллели для конструкции, подпрограмма Fortran время от времени возвращает разные значения. Это подпрограмма черного ящика, которая должна возвращать тот же результат с тем же вводом (50 аргументов). Я распараллелил вызов подпрограммы, чтобы запустить его для сотен различных комбинаций ввода. Если я запускаю программу дважды и печатаю результаты каждого выполнения подпрограммы, результаты не совпадают.
Подробности о проблеме:
Код огромен, но мне удалось упростить его на примере, иллюстрирующем проблему:
//StdAfx.h
#include "other.h"#include <omp.h>
//...many other includes
//first.cpp
#include "StdAfx.h"typedef struct
{
float x[51];
float result;
} A;
typedef A *B;
B old=NULL;
int size;
float weight;
int var;
int main()
{
size = 100;
old = new (nothrow) A[size];
long* control=NULL;
control = new long[size];
int kk;
//...
//changing some control[] values to -1
var = 5; weight = 0.7;
//...
#pragma omp parallel for
for (kk=0; kk<=size-1; kk++)
{
if (control[kk]>-1) old[kk].result = calcresult(old[kk].x,kk);
}
...
delete [] old;
oldpop = NULL;
delete [] control;
control = NULL;
}
float calcresult(float *x, int k)
{
int dev=0;
double kresult;
dev = 10;
kresult = othercalcresult(&x[0],k);
kresult += (weight*dev*double(1.0/var));
return(kresult);
}
//other.h
float othercalcresult(float *x, int anyk=0);
//other.cpp
extern "C" {
void _stdcall fdlf_(int VET[93],int *N, double *extresult);
}
double anothercalcresult(float *x, int *iVet)
{
int iN=1;
double extresult=0.0;
//stuff here
//original fortran subroutine has 50 arguments
fdlf_(iVet,&iN,&extresult);
return(extresult);
}
float othercalcresult(float *x, int anyk=0)
{
unsigned int i,ii;
float otherresult=0.0;
int ulimit;
//ulimit = 10;
//iVet is a two dimensional array iVet
int** iVet = new int*[numcenarios_anaprog_local];
for (ii=0; ii<ulimit; ii++) iVet[ii]=new int[93];
//initialize new vector
for (i=0; i<ulimit; i++)
for (ii=0; ii<93; ii++)
iVet[i][ii]=(100*i)+ii;
double* partialresult=NULL;
partialresult= new double[ulimit];
for (int jj=0;jj<ulimit;jj++) partialresult[jj] = 0.0;
//stuff here
for (i=0;i<ulimit;i++) partialresult[i] = anothercalcresult(x,iVet[i])
for (i=0;i<ulimit;i++) otherresult+=float(partialresult[i]);
return(otherresult);
}
//EXT.F90
RECURSIVE SUBROUTINE AUXSUB1(N,VALUE1)
INTEGER N
REAL*8 VALUE1
VALUE1 = 1 / (2 ** N)
RETURN
END SUBROUTINE AUXSUB1
RECURSIVE SUBROUTINE AUXSUB2(N,VALUE2)
INTEGER N
REAL*8 VALUE2
VALUE2 = 1 / (3 ** N)
RETURN
END SUBROUTINE AUXSUB2
RECURSIVE SUBROUTINE FDLF(VET,N,EXTRESULT)
INTEGER VET(93),N
REAL*8 VALUE1, VALUE2, EXTRESULT
VALUE1 = 0.
VALUE2 = 0.
EXTRESULT = 0.0
CALL AUXSUB1(N,VALUE1)
CALL AUXSUB2(N,VALUE2)
DO I=1,93
IF I.LT.47 THEN
EXTRESULT = EXTRESULT + VALUE1
ELSE
EXTRESULT = EXTRESULT + VALUE2
END IF
END DO
EXTRESULT = 1 / EXTRESULT
RETURN
END SUBROUTINE FDLF
Задача ещё не решена.
Других решений пока нет …