|
群主大人,我这个程序在CVF上是链接上的,没有任何问题,出来的结果也是对的,我现在要做的工作就是把它移植到IVF上,所以我的问题是接口的问题,所有的虚参都是有定义的,在CVF上是通过COMMON /FLAG/ 和strctflag进行链接的,现在在IVF上这个链接不起作用了,所以我需要在fortran里面写一个接口让它链接上。
我这样写接口对吗:[Fortran] 纯文本查看 复制代码
SUBROUTINE ISAT
1 (ELWRK, LRW, IELWRK, LIW, ANDTOL, EPSTOL, RNDTOL, STRIDE, YALL)
USE ISO_C_Binding
INCLUDE 'CHEM.TXT'
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
TYPE, BIND(C) :: incrmnt
C DOUBLE PRECISION(C_DOUBLE) :: y[lenth]
C DOUBLE PRECISION(C_DOUBLE) :: ddy[lenth]
C DOUBLE PRECISION(C_DOUBLE) :: above[lenth]
C DOUBLE PRECISION(C_DOUBLE) :: below[lenth]
INTEGER(C_int) :: bf,js,gross
C Type(C_PTR), value :: incrmnt *lchild
C Type(C_PTR), value :: incrmnt *rchild
C Type(C_PTR), value :: incrmnt *father
END TYPE incrmnt
C
TYPE, BIND(C) :: strctflag
INTEGER(C_INT) :: IFLAG,NONEAR,GSN,GSO
END TYPE strctflag
C
TYPE, BIND(C) :: ssflag
INTEGER(C_INT) :: nstep,ifind,iinteg,ienlge,irecrd
END TYPE ssflag
C
INTERFACE
subroutine bisrch() BIND(C, Name="bisrch" )
C function bisrch(pst) BIND(C, Name="bisrch" )
C import
C Type(C_PTR) , value :: pst
C integer compar(type incrmnt *,type incrmnt *)
C TYPE(C_PTR), VALUE :: p
C integer(c_int),value :: flag,i
C END function bisrch
END subroutine bisrch
END INTERFACE
C type (incrmnt) :: fst
type (strctflag) :: fst
C type (ssflag) :: fst
C---------------------------------------------------------------
EXTERNAL BALNCE [C], INSRTD [C], ENLRGE [C],
& FRMEM[C], STATIS[C], FUN, JAC
DIMENSION YALL(KMAX), YTMP(KMAX), YQ(KMAX)
DIMENSION ELWRK(LRW),IELWRK(LIW)
INTEGER(4) nstep, ifind, iinteg, ienlge, irecrd
INTEGER(4) IFLAG, NONEAR, BF, GS, JS, GSN, GSO, GROSS
DOUBLE PRECISION ABOVE, BELOW, Y, DDY
DIMENSION Y(KMAX),DDY(KMAX),RTOL(KMAX),ATOL(KMAX)
DIMENSION ABOVE(KMAX+1),BELOW(KMAX+1),RPAR(KMAX),IPAR(KMAX)
c
real*4 contm,difftm,chemtm,dintm,isatm,intgtm,srchtm,deltm,
& slargetm,baltm,tmchm,tmchm0
common /stime/ difftm, contm, chemtm, dintm, isatm, intgtm,
& srchtm, deltm, slargetm, baltm
common /sflag/ nstep, ifind, iinteg, ienlge, irecrd
common /ode/ neq, mf, itol, iopt, itask, istate,rtol, atol
c
COMMON /FIND/ Y, DDY, ABOVE, BELOW, BF, JS, GROSS
COMMON /strctflag/ IFLAG, NONEAR, GSN, GSO
DO I = 1, KK+1
YTMP(I) = YALL(I)
Y(I) = YTMP(I)
END DO
TMPTM0 = SECNDS(0.0)
call bisrch
TMPTM = SECNDS(0.0)
SRCHTM = SRCHTM + (TMPTM - TMPTM0)
C的部分我没有改动,还跟昨天的帖子里面一样,如下:[C] 纯文本查看 复制代码
#include "stdafx.h"
#include <iostream>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <math.h>
#include <malloc.h>
#include "isatcdef.h"
struct incrmnt
{
double y[lenth];
double ddy[lenth];
double above[lenth];
double below[lenth];
int bf;
int js;
int gross;
struct incrmnt *lchild;
struct incrmnt *rchild;
struct incrmnt *father;
};
struct strctflag
{
int iflag;
int nonear;
int gsn;
int gso;
};
struct ssflag
{ int nstep;
int ifind;
int iinteg;
int ienlge;
int irecrd;
};
struct incrmnt FIND;
struct strctflag FLAG;
struct ssflag SFLAG;
struct incrmnt *phead=NULL,*pfind=NULL,*pfather=NULL,
*pnear=NULL,*q=NULL,*a=NULL,*f=NULL,*b=NULL,*pd=NULL;
double plus[lenth],minus[lenth];
double min=Maxmin;
void bisrch()
{
int compar(struct incrmnt *,struct incrmnt *);
struct incrmnt *p;
int flag,i;
// initialize pfind.
// pfind=(struct incrmnt *)malloc(sizeof(struct incrmnt));
pfind=new incrmnt;
for(i=0;i<=lenth-1;i++)
pfind->y[i]=FIND.y[i];
pfind->lchild=NULL;
pfind->rchild=NULL;
pfind->father=NULL;
pfind->bf=0;
pfind->js=0;
pfind->gross=0;
if (phead==NULL)
{
phead=pfind;
FLAG.iflag=1;
FLAG.nonear=1;
return;
}
else
/*to find the location for pfind, insert it and adjust the bitree*/
{
f=NULL;a=phead;p=phead;q=NULL;
/*to find the location to insert pfind*/
while(p!=NULL)
{
if(p->bf!=0)
{a=p;f=q;} /* adjustment will start from node a,*/
/* f is the parents node of a */
//p->father=q;
q=p;
flag=compar(pfind,p); /*comparing the keyword*/
if(flag==0)
{
for(i=0;i<=lenth-1;i++)
{
FIND.ddy[i]=p->ddy[i];
}
p->js=p->js+1;
FIND.js=p->js;
min=Maxmin;
pnear=NULL;
delete pfind;
FLAG.iflag=0;
return;
}
else
if(flag==1)
p=p->lchild;
else
p=p->rchild;
}
if (fabs(min-Maxmin)<=1.e-10)
FLAG.nonear=1;
else
{
FLAG.nonear=0;
for (i=0;i<=lenth-1;i++)
{
FIND.ddy[i]=pnear->ddy[i];
}
}
FLAG.iflag=1;
return;
}
}
我的接口主要就是在fortran里面添加的那一段,所以我在上个回复中只是粘贴了添加的那一部分,对不起,后来你跟我说subroutine和function在接口中的处理方式不一样,所以我又将C里面的函数bisrch()改成了上个回复中的样子,因而也没有把声明的部分写出来,实在抱歉。上面这两段在通过我写的接口编译没有问题,但是还是链接不上来,相当于没起到接口的作用,我想问一下问题出在哪里?
不好意思搞的这么麻烦你,十分感谢! |
|