Question

程序填空题 特别急！！ 还有怎么编写程序 判断是否为降序数 用fortran

Answer 1

subroutine cholesky(SST, S, n)

integer, intent(in) :: n
real*8, intent(in) :: SST(n,n)
real*8, intent(out) :: S(n,n)
real*8 :: D(n), L(n,n)

integer i,j,k

D = 0.d0
L = 0.d0
do i = 1,n
L(i,i)=1.
D(i)=SST(i,i)
do j=1,i-1
L(i,j)=SST(i,j);
do k=1,j-1
L(i,j)=L(i,j)-L(i,k)*L(j,k)*D(k)
end do
if (D(j).ne.0.) L(i,j)=L(i,j)/D(j)
end do
do k=1,i-1
D(i)=D(i)-L(i,k)*L(i,k)*D(k)
end do
end do
S=0.
do i=1,n
do j=1,i
if (D(j)>0.) S(i,j)=S(i,j)+L(i,j)*sqrt(D(j))
end do
end do

end subroutine cholesky

subroutine linearSearchroot(funcname,xmin,xmax,root)
implicit none
real*8, intent(in) :: xmin,xmax
real(kind=8),intent(out) :: root(5000)
character(len=*) :: funcname
integer(kind=8) :: i,j,k=1,nstep=100000
real(kind=8) :: tol=1e-2,x,fx,fxold,xold,grad

do i=1,(xmax-xmin)*nstep
x=xmin+dble(i)/nstep
call func222(fx,x)
if(i>1)then
xold=x
fxold=fx
call getgradient(fx,fxold,x,xold,grad)
endif
if(abs(fx)<tol)then
root(k)=x
write(*,*)x
k=k+1
endif
end do

end subroutine
subroutine random_init()
implicit none
integer :: i, n, clock
integer, dimension(:), allocatable :: seed

call random_seed(size=n)
allocate(seed(n))

call system_clock(count=clock)

seed = clock + 37 * (/ (i - 1, i = 1, n) /)
call random_seed(put = seed)

deallocate(seed)

end subroutine random_init
module matrixinfo

integer,parameter :: dimen=2
end module

program less
use omp_lib
implicit none
integer :: i,j,k,cyctot=22222
integer,parameter :: ND=2
real(kind=8) :: x0,xn,root(200)=0
real(kind=8) :: NDx0(ND),NDxn(ND),NDroot(ND,200)=0
real(kind=8) :: tol=1e-10
character(len=30) :: method,funcname
call random_seed()

x0=-0.9999999
xn=0.9999999
method='mc_integral'
!call integral(method,x0,xn)

x0=-10
xn=10
funcname='homework'

root=0
NDx0=(/-99,-99/)
NDxn=(/99,99/)
!method='steepdecent_randomwalk_nd'
method='conjugate_gradient_nd'
call NDminimize(funcname,tol,ND,root,NDx0,NDxn,method,cyctot)

end program