normc.f

来自「gsac程序包」· F 代码 · 共 35 行

	subroutine normc(e,ex,xnorm)
	complex*16 e(*)
	real*8 ex, xnorm

	common/lwater/lfluid
	logical lfluid
	real*8 test,testt,x,y,fac
	real*8 DREAL
	integer i, IUP
	test = 0.0D+00
	testt = 0.0D+00
	if(lfluid)then
		IUP = 2
	else
		IUP = 5
	endif
	do 2 i = 1,IUP
		if(dabs(dreal(e(i))).gt.testt) testt =dabs(dreal(e(i)))
		if(dabs(dimag(e(i))).gt.testt) testt =dabs(dimag(e(i)))
    2	continue
	if(testt.lt.1.0e-30)testt=1.0
	do 1 i =1,IUP
		x=dreal(e(i))/testt
		y=dimag(e(i))/testt
		fac = x*x + y*y
		if(test.lt.fac) test = fac
    1	continue
	test = testt*dsqrt(test)
	if(test.lt.1.0d-30) test=1.0
	xnorm = 1./test
	ex =-dlog(xnorm)
	return
	end