mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-09-12 22:08:31 +02:00
Inlined multiply_poly
This commit is contained in:
parent
873d978348
commit
5b427641a6
@ -563,8 +563,20 @@ double precision function general_primitive_integral(dim, &
|
|||||||
d_poly(i)=0.d0
|
d_poly(i)=0.d0
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
|
||||||
call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
|
integer :: ib, ic
|
||||||
|
if (ior(n_Ix,n_Iy) >= 0) then
|
||||||
|
do ib=0,n_Ix
|
||||||
|
do ic = 0,n_Iy
|
||||||
|
d_poly(ib+ic) = d_poly(ib+ic) + Iy_pol(ic) * Ix_pol(ib)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do n_pt_tmp = n_Ix+n_Iy, 0, -1
|
||||||
|
if (d_poly(n_pt_tmp) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
if (n_pt_tmp == -1) then
|
if (n_pt_tmp == -1) then
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
@ -573,8 +585,21 @@ double precision function general_primitive_integral(dim, &
|
|||||||
d1(i)=0.d0
|
d1(i)=0.d0
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
|
||||||
call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
|
if (ior(n_pt_tmp,n_Iz) >= 0) then
|
||||||
|
! Bottleneck here
|
||||||
|
do ib=0,n_pt_tmp
|
||||||
|
do ic = 0,n_Iz
|
||||||
|
d1(ib+ic) = d1(ib+ic) + Iz_pol(ic) * d_poly(ib)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do n_pt_out = n_pt_tmp+n_Iz, 0, -1
|
||||||
|
if (d1(n_pt_out) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
double precision :: rint_sum
|
double precision :: rint_sum
|
||||||
accu = accu + rint_sum(n_pt_out,const,d1)
|
accu = accu + rint_sum(n_pt_out,const,d1)
|
||||||
|
|
||||||
@ -921,8 +946,20 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
|||||||
X(ix) *= dble(a-1)
|
X(ix) *= dble(a-1)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(X,nx,B_10,2,d,nd)
|
! call multiply_poly(X,nx,B_10,2,d,nd)
|
||||||
|
if (nx >= 0) then
|
||||||
|
integer :: ib
|
||||||
|
do ib=0,nx
|
||||||
|
d(ib ) = d(ib ) + B_10(0) * X(ib)
|
||||||
|
d(ib+1) = d(ib+1) + B_10(1) * X(ib)
|
||||||
|
d(ib+2) = d(ib+2) + B_10(2) * X(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nx+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
nx = nd
|
nx = nd
|
||||||
!DIR$ LOOP COUNT(8)
|
!DIR$ LOOP COUNT(8)
|
||||||
@ -943,8 +980,19 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
|||||||
X(ix) *= c
|
X(ix) *= c
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(X,nx,B_00,2,d,nd)
|
! call multiply_poly(X,nx,B_00,2,d,nd)
|
||||||
|
if (nx >= 0) then
|
||||||
|
do ib=0,nx
|
||||||
|
d(ib ) = d(ib ) + B_00(0) * X(ib)
|
||||||
|
d(ib+1) = d(ib+1) + B_00(1) * X(ib)
|
||||||
|
d(ib+2) = d(ib+2) + B_00(2) * X(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nx+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
ny=0
|
ny=0
|
||||||
@ -961,9 +1009,19 @@ recursive subroutine I_x1_pol_mult_recurs(a,c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt
|
|||||||
call I_x1_pol_mult_recurs(a-1,c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
call I_x1_pol_mult_recurs(a-1,c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(Y,ny,C_00,2,d,nd)
|
! call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||||
|
if (ny >= 0) then
|
||||||
|
do ib=0,ny
|
||||||
|
d(ib ) = d(ib ) + C_00(0) * Y(ib)
|
||||||
|
d(ib+1) = d(ib+1) + C_00(1) * Y(ib)
|
||||||
|
d(ib+2) = d(ib+2) + C_00(2) * Y(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = ny+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
||||||
@ -1001,8 +1059,20 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
|||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(X,nx,B_00,2,d,nd)
|
! call multiply_poly(X,nx,B_00,2,d,nd)
|
||||||
|
if (nx >= 0) then
|
||||||
|
integer :: ib
|
||||||
|
do ib=0,nx
|
||||||
|
d(ib ) = d(ib ) + B_00(0) * X(ib)
|
||||||
|
d(ib+1) = d(ib+1) + B_00(1) * X(ib)
|
||||||
|
d(ib+2) = d(ib+2) + B_00(2) * X(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nx+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
ny=0
|
ny=0
|
||||||
|
|
||||||
@ -1012,8 +1082,19 @@ recursive subroutine I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
|||||||
enddo
|
enddo
|
||||||
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(Y,ny,C_00,2,d,nd)
|
! call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||||
|
if (ny >= 0) then
|
||||||
|
do ib=0,ny
|
||||||
|
d(ib ) = d(ib ) + C_00(0) * Y(ib)
|
||||||
|
d(ib+1) = d(ib+1) + C_00(1) * Y(ib)
|
||||||
|
d(ib+2) = d(ib+2) + C_00(2) * Y(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = ny+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -1040,8 +1121,20 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
|||||||
nx = 0
|
nx = 0
|
||||||
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,X,nx,n_pt_in)
|
call I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,X,nx,n_pt_in)
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(X,nx,B_10,2,d,nd)
|
! call multiply_poly(X,nx,B_10,2,d,nd)
|
||||||
|
if (nx >= 0) then
|
||||||
|
integer :: ib
|
||||||
|
do ib=0,nx
|
||||||
|
d(ib ) = d(ib ) + B_10(0) * X(ib)
|
||||||
|
d(ib+1) = d(ib+1) + B_10(1) * X(ib)
|
||||||
|
d(ib+2) = d(ib+2) + B_10(2) * X(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nx+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
nx = nd
|
nx = nd
|
||||||
!DIR$ LOOP COUNT(8)
|
!DIR$ LOOP COUNT(8)
|
||||||
@ -1059,8 +1152,19 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
|||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(X,nx,B_00,2,d,nd)
|
! call multiply_poly(X,nx,B_00,2,d,nd)
|
||||||
|
if (nx >= 0) then
|
||||||
|
do ib=0,nx
|
||||||
|
d(ib ) = d(ib ) + B_00(0) * X(ib)
|
||||||
|
d(ib+1) = d(ib+1) + B_00(1) * X(ib)
|
||||||
|
d(ib+2) = d(ib+2) + B_00(2) * X(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nx+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
ny=0
|
ny=0
|
||||||
!DIR$ LOOP COUNT(8)
|
!DIR$ LOOP COUNT(8)
|
||||||
@ -1070,9 +1174,19 @@ recursive subroutine I_x1_pol_mult_a2(c,B_10,B_01,B_00,C_00,D_00,d,nd,n_pt_in)
|
|||||||
!DIR$ FORCEINLINE
|
!DIR$ FORCEINLINE
|
||||||
call I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
call I_x1_pol_mult_a1(c,B_10,B_01,B_00,C_00,D_00,Y,ny,n_pt_in)
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(Y,ny,C_00,2,d,nd)
|
! call multiply_poly(Y,ny,C_00,2,d,nd)
|
||||||
|
if (ny >= 0) then
|
||||||
|
do ib=0,ny
|
||||||
|
d(ib ) = d(ib ) + C_00(0) * Y(ib)
|
||||||
|
d(ib+1) = d(ib+1) + C_00(1) * Y(ib)
|
||||||
|
d(ib+2) = d(ib+2) + C_00(2) * Y(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = ny+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
||||||
@ -1119,8 +1233,21 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
|||||||
Y(1) = D_00(1)
|
Y(1) = D_00(1)
|
||||||
Y(2) = D_00(2)
|
Y(2) = D_00(2)
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(Y,ny,D_00,2,d,nd)
|
! call multiply_poly(Y,ny,D_00,2,d,nd)
|
||||||
|
if (ny >= 0) then
|
||||||
|
integer :: ib
|
||||||
|
do ib=0,ny
|
||||||
|
d(ib ) = d(ib ) + D_00(0) * Y(ib)
|
||||||
|
d(ib+1) = d(ib+1) + D_00(1) * Y(ib)
|
||||||
|
d(ib+2) = d(ib+2) + D_00(2) * Y(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = ny+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
return
|
return
|
||||||
|
|
||||||
case default
|
case default
|
||||||
@ -1137,8 +1264,19 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
|||||||
X(ix) *= dble(c-1)
|
X(ix) *= dble(c-1)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(X,nx,B_01,2,d,nd)
|
! call multiply_poly(X,nx,B_01,2,d,nd)
|
||||||
|
if (nx >= 0) then
|
||||||
|
do ib=0,nx
|
||||||
|
d(ib ) = d(ib ) + B_01(0) * X(ib)
|
||||||
|
d(ib+1) = d(ib+1) + B_01(1) * X(ib)
|
||||||
|
d(ib+2) = d(ib+2) + B_01(2) * X(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nx+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
ny = 0
|
ny = 0
|
||||||
!DIR$ LOOP COUNT(6)
|
!DIR$ LOOP COUNT(6)
|
||||||
@ -1147,8 +1285,19 @@ recursive subroutine I_x2_pol_mult(c,B_10,B_01,B_00,C_00,D_00,d,nd,dim)
|
|||||||
enddo
|
enddo
|
||||||
call I_x2_pol_mult(c-1,B_10,B_01,B_00,C_00,D_00,Y,ny,dim)
|
call I_x2_pol_mult(c-1,B_10,B_01,B_00,C_00,D_00,Y,ny,dim)
|
||||||
|
|
||||||
!DIR$ FORCEINLINE
|
! !DIR$ FORCEINLINE
|
||||||
call multiply_poly(Y,ny,D_00,2,d,nd)
|
! call multiply_poly(Y,ny,D_00,2,d,nd)
|
||||||
|
if (ny >= 0) then
|
||||||
|
do ib=0,ny
|
||||||
|
d(ib ) = d(ib ) + D_00(0) * Y(ib)
|
||||||
|
d(ib+1) = d(ib+1) + D_00(1) * Y(ib)
|
||||||
|
d(ib+2) = d(ib+2) + D_00(2) * Y(ib)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = ny+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
end select
|
end select
|
||||||
end
|
end
|
||||||
@ -1206,3 +1355,34 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine multiply_poly_local(b,nb,c,nc,d,nd)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Multiply two polynomials
|
||||||
|
! D(t) += B(t)*C(t)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: nb, nc
|
||||||
|
integer, intent(out) :: nd
|
||||||
|
double precision, intent(in) :: b(0:nb), c(0:nc)
|
||||||
|
double precision, intent(inout) :: d(0:nb+nc)
|
||||||
|
|
||||||
|
integer :: ndtmp
|
||||||
|
integer :: ib, ic, id, k
|
||||||
|
if(ior(nc,nb) < 0) return !False if nc>=0 and nb>=0
|
||||||
|
|
||||||
|
do ib=0,nb
|
||||||
|
do ic = 0,nc
|
||||||
|
d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nb+nc,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -428,6 +428,112 @@ end subroutine
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine multiply_poly_0c(b,c,nc,d,nd)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Multiply two polynomials
|
||||||
|
! D(t) += B(t)*C(t)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: nc
|
||||||
|
integer, intent(out) :: nd
|
||||||
|
double precision, intent(in) :: b(0:0), c(0:nc)
|
||||||
|
double precision, intent(inout) :: d(0:0+nc)
|
||||||
|
|
||||||
|
integer :: ic
|
||||||
|
|
||||||
|
do ic = 0,nc
|
||||||
|
d(ic) = d(ic) + c(ic) * b(0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nc,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine multiply_poly_1c(b,c,nc,d,nd)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Multiply two polynomials
|
||||||
|
! D(t) += B(t)*C(t)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: nc
|
||||||
|
integer, intent(out) :: nd
|
||||||
|
double precision, intent(in) :: b(0:1), c(0:nc)
|
||||||
|
double precision, intent(inout) :: d(0:1+nc)
|
||||||
|
|
||||||
|
integer :: ic, id
|
||||||
|
if(nc < 0) return
|
||||||
|
|
||||||
|
do ic = 0,nc
|
||||||
|
d( ic) = d( ic) + c(ic) * b(0)
|
||||||
|
d(1+ic) = d(1+ic) + c(ic) * b(1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nc+1,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine multiply_poly_2c(b,c,nc,d,nd)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Multiply two polynomials
|
||||||
|
! D(t) += B(t)*C(t)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: nc
|
||||||
|
integer, intent(out) :: nd
|
||||||
|
double precision, intent(in) :: b(0:2), c(0:nc)
|
||||||
|
double precision, intent(inout) :: d(0:2+nc)
|
||||||
|
|
||||||
|
integer :: ic, id, k
|
||||||
|
if (nc <0) return
|
||||||
|
|
||||||
|
do ic = 0,nc
|
||||||
|
d( ic) = d( ic) + c(ic) * b(0)
|
||||||
|
d(1+ic) = d(1+ic) + c(ic) * b(1)
|
||||||
|
d(2+ic) = d(2+ic) + c(ic) * b(2)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nc+2,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine multiply_poly_3c(b,c,nc,d,nd)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Multiply two polynomials
|
||||||
|
! D(t) += B(t)*C(t)
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: nc
|
||||||
|
integer, intent(out) :: nd
|
||||||
|
double precision, intent(in) :: b(0:3), c(0:nc)
|
||||||
|
double precision, intent(inout) :: d(0:3+nc)
|
||||||
|
|
||||||
|
integer :: ic, id
|
||||||
|
if (nc <0) return
|
||||||
|
|
||||||
|
do ic = 1,nc
|
||||||
|
d( ic) = d(1+ic) + c(ic) * b(0)
|
||||||
|
d(1+ic) = d(1+ic) + c(ic) * b(1)
|
||||||
|
d(2+ic) = d(1+ic) + c(ic) * b(2)
|
||||||
|
d(3+ic) = d(1+ic) + c(ic) * b(3)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do nd = nc+3,0,-1
|
||||||
|
if (d(nd) /= 0.d0) exit
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine multiply_poly(b,nb,c,nc,d,nd)
|
subroutine multiply_poly(b,nb,c,nc,d,nd)
|
||||||
@ -444,29 +550,16 @@ subroutine multiply_poly(b,nb,c,nc,d,nd)
|
|||||||
|
|
||||||
integer :: ndtmp
|
integer :: ndtmp
|
||||||
integer :: ib, ic, id, k
|
integer :: ib, ic, id, k
|
||||||
if(ior(nc,nb) >= 0) then ! True if nc>=0 and nb>=0
|
if(ior(nc,nb) < 0) return !False if nc>=0 and nb>=0
|
||||||
continue
|
|
||||||
else
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
ndtmp = nb+nc
|
|
||||||
|
|
||||||
do ic = 0,nc
|
do ib=0,nb
|
||||||
d(ic) = d(ic) + c(ic) * b(0)
|
do ic = 0,nc
|
||||||
enddo
|
|
||||||
|
|
||||||
do ib=1,nb
|
|
||||||
d(ib) = d(ib) + c(0) * b(ib)
|
|
||||||
do ic = 1,nc
|
|
||||||
d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
|
d(ib+ic) = d(ib+ic) + c(ic) * b(ib)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do nd = ndtmp,0,-1
|
do nd = nb+nc,0,-1
|
||||||
if (d(nd) == 0.d0) then
|
if (d(nd) /= 0.d0) exit
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
exit
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end
|
end
|
||||||
|
Loading…
Reference in New Issue
Block a user