newmaxima.f90

来自「蒙特卡罗的一个程序分析 与大家分享 共同研究」· F90 代码 · 共 64 行

subroutine NewMaxima( Nsp, MaxSp, nmtype, DXYZ, DROT, NATT, NSUC )

implicit none

integer, intent(in)									:: Nsp
integer, intent(in)									:: Maxsp
integer, intent(in)									:: nmtype

real, dimension(MaxSp), intent(inout)				:: DXYZ
real, dimension(MaxSp), intent(inout)				:: DROT

integer, dimension(nmtype, MaxSp), intent(inout)	:: NATT
integer, dimension(nmtype, MaxSp), intent(inout)	:: NSUC

! Local Stuff

integer									:: i

real									:: SimRatio
real, dimension(2)						:: TarRatio

TarRatio(1) = 0.5
TarRatio(2) = 0.5


do i = 1, Nsp

	if( NATT(1,i) /= 0 ) then

		SimRatio = real( NSUC(1,i) ) / real( NATT(1,i) )

		if( SimRatio > TarRatio(1) ) DXYZ(i) = DXYZ(i) * 1.05
		if( SimRatio < TarRatio(1) ) DXYZ(i) = DXYZ(i) * 0.95

		DXYZ(i) = min( DXYZ(i), 0.5 )

	end if

	if( NATT(2,i) /= 0 ) then
			
		SimRatio = real( NSUC(2,i) ) / real( NATT(2,i) )

		if( SimRatio > TarRatio(2) ) DROT(i) = DROT(i) * 1.05
		if( SimRatio < TarRatio(2) ) DROT(i) = DROT(i) * 0.95

		DROT(i) = min( DROT(i), 0.5 )

	end if

end do

NATT = 0
NSUC = 0

return

end subroutine NewMaxima