pir0texnik2
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Значит вот как оно меня все выглядит....
Код:
subroutine ye_circ_ii (precis,a_,Li_,Di_,k_,k2_,pl2_,plk2_,qlk2_,p_,q_,M_max,ye_circ_out)
!DEC$ ATTRIBUTES DLLEXPORT :: YE_CIRC_II
include 'link_fnl_shared.h'
USE QDAG_INT
USE QDAGS_INT
Implicit none
COMMON a,Li,Di,k,k2,pl2,plk2,qlk2,m, q,p
complex*16 ye_circ_out
Integer, intent(in) :: p_,q_,M_max
real*8 , intent(in) :: a_,Li_,Di_,k_,k2_,pl2_,plk2_,qlk2_
aa = dexp(-k); bb= 1.0d0;
CALL D_QDAGS (ReYepp1,aa,bb,ReYe1)
|
Где ReYepp1:
Код:
real*8 function ReYepp1 (x1)
COMMON a,Li,Di,k,k2,pl2,plk2,qlk2,m, q,p
real*8 a,Li,Di,k,k2,pl2,plk2,qlk2
integer p,q,m
real*8, INTENT(IN) :: x1
real*8 H22, sqt, x, plk2x2
if ((dabs(x1)<10.0d-20).or.(dabs(x1)==1.0d0)) then
ReYepp1 = 0.0d0
else
x = -dlog(x1)
plk2x2 = plk2+x*x
call H2(m,a*x,H22)
sqt=DSQRT(k2-x*x)
ReYepp1 = 1.0d0/H22/x* &
( &
pl2*x*x*((-1.0d0)**p)*dsin(Li*sqt)/sqt/(plk2x2)/(plk2x2)- &
0.5d0*Li*plk2/(plk2x2) &
) /x1
endif
END |
где H2(m,a*x,H22):
Код:
subroutine H2 (m,x,out)
USE BSJ1_INT
USE BSY1_INT
real*8, INTENT(OUT) :: out
integer, INTENT(IN) :: m
real*8, INTENT(IN) :: x
real*8 Jm,Ym, besseljn,besselyn
if (m==0) then
out = D_BSJ1(x)*D_BSJ1(x) + D_BSY1(x)*D_BSY1(x)
else
Jm = besseljn(m-1,x)-besseljn(m+1,x)
Ym = besselyn(m-1,x)-besselyn(m+1,x)
out = 0.25d0*( Jm*Jm + Ym*Ym )
end if
END |
где besseljn(m,x) и besselyn(m,x):
Код: function besseljn(n, x)
USE BSJ0_INT
USE BSJ1_INT
implicit none
real*8 besseljn
real*8, INTENT(IN) :: x
integer, INTENT(IN) :: n
integer i
real*8 a
real*8 b
real*8 tmp
SELECT CASE (n)
CASE (0)
besseljn = D_BSJ0(x);
CASE (1)
besseljn = D_BSJ1(x);
CASE (2)
if( x==0 ) then
besseljn = 0.0d0
else
besseljn = (2.0d0*D_BSJ1(x)/x-D_BSJ0(x));
endif
CASE (3:)
if( x<10d-20 ) then
besseljn = 0.0d0;
else
a = D_BSJ0(x);
b = D_BSJ1(x);
do i=1,n-1,1
tmp = b;
b = 2.0d0*i/x*b-a;
a = tmp;
enddo
besseljn = b;
endif
END SELECT
return
end function
!=================================
function besselyn(n, x)
USE BSY0_INT
USE BSY1_INT
implicit none
real*8 besselyn
real*8, INTENT(IN) :: x
integer, INTENT(IN) :: n
integer i
real*8 a
real*8 b
real*8 tmp
SELECT CASE (n)
CASE (0)
besselyn = D_BSY0(x);
CASE (1)
besselyn = D_BSY1(x);
CASE (2:)
a = D_BSY0(x);
b = D_BSY1(x);
do i=1,n-1,1
tmp = b;
b = 2.0d0*i/x*b-a;
a = tmp;
enddo
besselyn = b;
END SELECT
return
end function |
И все это вызывается из билдера вот так:
Код: HINSTANCE HIns=NULL;
HIns=::LoadLibrary("ye_circ.dll");
sub_fortran_1 ye_circ_ii;
ye_circ_ii=(sub_fortran_1)(GetProcAddress((HMODULE) HIns,"YE_CIRC_II"));
complex<double> Y = 0;
double precis = 0.005;
ye_circ_ii (&precis,&a,&Li,&Di,&k,&k2,&pl2,&plk2,&qlk2,&p,&q,&II,&Y);
|
а прототип процудцры выглядит так :
Код:
typedef void (__stdcall *sub_fortran_1)(double*,const double*,const double*,const double*,const double*,const double*,const double*,const double*,const double*,const int*,const int*,const int*,complex<double>*);
|
все переменные проверено совпадают по типу и по кол-ву...
в отладчике в студии - это все хорошо видно, что dll загружается нормально и с правильными значениями, но потом в процессе счета получаесят какой-то загадочный косяк... :(
более того, от чего становится совсем грусно, все работало в CVF 6.6, со старым IMSL, но захотелось нового кимпилятора и нового ИМСЛ.... и вот. :-) |
