[求助] 求解嵌套非线性方程组，改程序，求助

program tu2
use IMSL
implicit none
external FCN
real*8 FCN
real,parameter::ERRREL=0.0001
integer,parameter::N=2
integer,parameter::ITMAX=100
real*8::XGUESS(N)=(/0.0467,0.0732/)
real X(N),FNORM
real*8 A1,A2,A3,A,B,C,D
real*8 Z0,Zi
real*8 E,F
real,parameter::pi=3.14159
integer,parameter::Zrs=5
integer,parameter::A4s=9
integer k,i
real*8::Zr(Zrs)=(/1.0,2.0,3.0,4.0,5.0/)
real*8::A4(A4s)=(/0.075,0.10,0.15,0.20,0.25,0.30,0.35,0.40,0.425/)
common /group2/ zi
common /group3/ A2
!!**************************************************
Zi=-3.0                  !!天线阻抗虚部的值
Z0=50.0                  !!传输线的特性阻抗
A2=0.25                  !!第二个支节的长度
!!***************************************************
do i=1,Zrs
do k=1,A4s
call  NEQNF(Zr(i),A4(k),FCN(i,k),ERRREL,N,ITMAX,XGUESS,X,FNORM)
write(*,*) X
stop
end
!!!**************************
subroutine A4_get_A(A4,A)
implicit none
real*8 A2,A3,A4,A
real,parameter::pi=3.14159
common /group3/ A2
A=cos(2.0*pi*A2)*cos(2.0*pi*A4)-sin(2.0*pi*A2)*(-cos(2.0*pi*A4)/tan(2.0*pi*A3)+sin(2.0*pi*A4))              !!A的函数式

return
end
!!!***************************
subroutine A4_get_B(A4,B)
implicit none
real*8 A2,A3,A4,z0,B
real,parameter::pi=3.14159
common /group3/ A2
common /group1/ Z0
B=Z0*(cos(2.0*pi*A2)*sin(2.0*pi*A4)+sin(2.0*pi*A2)*(sin(2.0*pi*A4)/tan(2.0*pi*A3)+cos(2.0*pi*A4)))            !!B的函数式
return
end
!!*****************************
subroutine A4_get_C(A4,C)
implicit none
real*8 A1,A2,A3,A4,Z0,C
real,parameter::pi=3.14159
common /group3/ A2
common /group1/ Z0
C=1.0/Z0*(cos(2.0*pi*A4)*((-cos(2.0*pi*A2))/tan(2.0*pi*A1)+sin(2.0*pi*A2))+(sin(2.0*pi*A2)/tan(2.0*pi*A1)+cos(2.0*pi*A2))*((-cos(2.0*pi*A4))/tan(2.0*pi*A3)+sin(2.0*pi*A4)))
return
end
!!*******************************
subroutine A4_get_D(A4,D)
implicit none
real*8 A1,A2,A3,A4,D
real,parameter::pi=3.14159

common /group3/ A2
D=-sin(2.0*pi*A4)*(-cos(2.0*pi*A2)/tan(2.0*pi*A1)+sin(2.0*pi*A2))+(sin(2.0*pi*A2)/tan(2.0*pi*A1)+cos(2.0*pi*A2))*(sin(2.0*pi*A4)/tan(2.0*pi*A3)+cos(2.0*pi*A4))
return
end
!!****************************************************

subroutine FCN(A,B,C,D,A4,Zr,XA,F,N)
implicit none
integer N
real,target::XA(N)
real F(N)
real,pointer::A1,A3
real*8 A,B,C,D,A4,Z0,Zr,Zi
common /group1/Z0
common /group2/Zi

A1=>XA(1)
A3=>XA(2)
call A4_get_A(A4,A)
call A4_get_B(A4,B)
call A4_get_C(A4,C)
call A4_get_D(A4,D)

F(1)=A*D+B*C-Z0*((D-C*Zi)*(D-C*Zi)+(C*Zr)*(C*Zr))
F(2)=(D*A-B*C)*Zi-A*C*(Zr*Zr+Zi*Zi)+D*B
return
end