rnormc.f

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

	subroutine rnormc(e,ex,xnorm)
	implicit none

	common/lwater/lfluid
	logical lfluid
	real*8 ex
	real*8 DREAL
	real *8 test,testt,x,y,fac,xnorm
	complex*16 e(5,5)

	integer i, j, IUP

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