writehist.f90

巨正则系综蒙特卡罗算法的源程序；可以用来进行吸附等分子模拟；最大的好处在于可以插入或删除原子

subroutine WriteHist( MaxMol, MaxSp, Ubins, Nham, BETA, ZETA, Uwidth, Umin, &
					  UN_HIST, N_HIST, BoxSize, UN_HistFile, N_HistFile, &
					  Nsim_min, Nsim_max )

implicit none

integer, intent(in)								:: MaxMol
integer, intent(in)								:: MaxSp
integer, intent(in)								:: Ubins
integer, intent(in)								:: Nham

real, dimension(Nham), intent(in)				:: BETA
real, dimension(MaxSp,Nham), intent(in)			:: ZETA

real, intent(in)								:: Uwidth
real, intent(in)								:: Umin

real, dimension(Ubins, 0:MaxMol, Nham), intent(in)	:: UN_HIST
real, dimension(0:MaxMol, MaxSp, Nham), intent(in)	:: N_HIST

real, intent(in)								:: BoxSize

character*30, intent(in)						:: UN_HistFile
character*30, intent(in)						:: N_HistFile

integer, dimension(MaxSp)						:: Nsim_min, Nsim_max

! local stuff

integer						:: h, i, j, flag, stbin, endbin
character*30				:: filename


open( 70, file = N_HistFile )

do i = Nsim_min(1), Nsim_max(1)

	write(70,10) i, N_HIST(i,1,1:Nham)

	10 format( I8, <Nham>(2x,G16.7E3) )

end do

close(70)

do h = 1, Nham

	filename = trim(UN_HistFile)//'_h'//char( 48 + h/10 )//char(48 + mod(h,10))//'.dat'

	open( 80, file = filename )

	write(80, "(A)") ' Temp (K)   ln(zeta)      Uwidth      X           Y           Z '

	write(80, "(1x,2(G11.5),F8.2,2x,3(F10.4,2x))") 1.0/BETA(h), log(ZETA(1,h)) / BETA(h), Uwidth, &
											BoxSize, BoxSize, BoxSize

	do i = Nsim_min(1), Nsim_max(1)

		if( sum( UN_HIST(1:Ubins,i,h) ) /= 0.0 ) then

			flag = 0

			j = 0

			do while( flag == 0 )

				j = j + 1

				if( UN_HIST(j,i,h) /= 0.0 )	flag = 1

			end do

			stbin = j
	
			flag = 0
	
			j = Ubins + 1
	
			do while( flag == 0 )

				j = j - 1

				if( UN_HIST(j,i,h) /= 0.0 )	flag = 1
		
			end do
	
			endbin = j

			write(80, "(2I8,4x,F14.5)") i, endbin - stbin + 1, &
				Umin + ( real(stbin) - 0.5 ) * Uwidth

			write(80, 15) UN_HIST( stbin:endbin, i, h )

			15 format( <endbin - stbin + 1>(2x,G16.7E3) )

		else

			write(80, "(2I8,4x,F14.5)") i, 1, &
				Umin + ( real(stbin) - 0.5 ) * Uwidth

			write(80,"(2x,G16.7E3)") 0.0

		end if

	end do

	close(80)

end do

return

end subroutine WriteHist