writedata.f90

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

						INTPARAM(1:4,j,i),  &
						REALPARAM(1,j,i) * 180.0/Pi, REALPARAM(2:8,j,i)

				else if( INTPARAM(4,j,i) == 2 ) then

					write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,4I3,T45,7G11.5)") &
						j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
						INTPARAM(1:4,j,i), &
						REALPARAM(1,j,i) * 180.0/Pi, REALPARAM(2:6,j,i)

				end if

			case( 'FxBend' )
			
				write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,2I3)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
					INTPARAM(1:2,j,i)

				m = INTPARAM(1,j,i)

				do k = 1, m

					REALPARAM( 1+2*k, j, i ) = REALPARAM( 1+2*k, j, i ) * 180.0 / Pi 

				end do

				write(unit, 31) &
					INTPARAM(3:2+m,j,i), &
					REALPARAM(1:1+2*m,j,i)

				do k = 1, m

					REALPARAM( 1+2*k, j, i ) = REALPARAM( 1+2*k, j, i ) * Pi / 180.0 

				end do

				31 format( T30, <m>I3, T45, <1+2*m>G11.5 )

			case( 'FxBendTor' )

				write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,4I3)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
					INTPARAM(1:4,j,i)

				m = INTPARAM(1,j,i)
				n = INTPARAM(2,j,i)

				do k = 1, m

					REALPARAM( 1+2*k, j, i ) = REALPARAM( 1+2*k, j, i ) * 180.0 / Pi 

				end do

				write(unit, 32) &
					INTPARAM(5:4+m+2*n,j,i)

				if( INTPARAM(3,j,i) == 1 ) then

					write(unit, 33) &
						REALPARAM(1:1+2*m+6*n,j,i)

				else if( INTPARAM(3,j,i) == 2 ) then

					write(unit, 34) &
						REALPARAM(1:1+2*m+4*n,j,i)

				end if

				do k = 1, m

					REALPARAM( 1+2*k, j, i ) = REALPARAM( 1+2*k, j, i ) * Pi / 180.0 

				end do

				32 format( T30, <m+2*n>I3 )
				33 format( T45, <1+2*m+6*n>G11.5 )
				34 format( T45, <1+2*m+4*n>G11.5 )

			case( 'Stretch' )

				write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,I3,T45,2G11.5)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
					INTPARAM(1,j,i), REALPARAM(1:2,j,i)

			case( 'StBend' )
			
				write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,2I3)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
					INTPARAM(1:2,j,i)

				m = INTPARAM(1,j,i)

				do k = 1, m

					REALPARAM( 2+2*k, j, i ) = REALPARAM( 2+2*k, j, i ) * 180.0 / Pi 

				end do

				write(unit, 35) &
					INTPARAM(3:2+m,j,i), &
					REALPARAM(1:2+2*m,j,i)

				do k = 1, m

					REALPARAM( 2+2*k, j, i ) = REALPARAM( 2+2*k, j, i ) * Pi / 180.0 

				end do

				35 format( T30, <m>I3, T45, <2+2*m>G11.5 )

			case( 'StBendTor' )

				write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,4I3)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
					INTPARAM(1:4,j,i)

				m = INTPARAM(1,j,i)
				n = INTPARAM(2,j,i)

				do k = 1, m

					REALPARAM( 2+2*k, j, i ) = REALPARAM( 2+2*k, j, i ) * 180.0 / Pi 

				end do

				write(unit, 36) &
					INTPARAM(5:4+m+2*n,j,i)

				if( INTPARAM(3,j,i) == 1 ) then

					write(unit, 37) &
						REALPARAM(1:2+2*m+6*n,j,i)

				else if( INTPARAM(3,j,i) == 2 ) then

					write(unit, 38) &
						REALPARAM(1:2+2*m+4*n,j,i)

				end if

				do k = 1, m

					REALPARAM( 2+2*k, j, i ) = REALPARAM( 2+2*k, j, i ) * Pi / 180.0 

				end do

				36 format( T30, <m+2*n>I3 )
				37 format( T45, <2+2*m+6*n>G11.5 )
				38 format( T45, <2+2*m+4*n>G11.5 )

			case( 'Match' )
			
				write(unit,"(1x,I3,T9,A,T13,I3,T21,A,T30,I3)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i), &
					INTPARAM(1,j,i)

			case( 'Complete' )
			
				write(unit,"(1x,I3,T9,A,T13,I3,T21,A)") &
					j, BEADTYPE(j,i), GROUPTYPE(j,i), METHOD(j,i)

		end select


	end do

	write(unit,"(A)") ' Configurational Bias Steps '
	write(unit,"(A)") ' Step     Attempts     Start Bead     End Bead '

	do j = 1, NSTEPS(i)

		write(unit, "(1x,I3,T12,I3,T26,I3,T40,I3)") j, NTRIALS(j,i), &
				STEPSTART(j,i), STEPSTART(j,i) + STEPLENGTH(j,i) - 1

	end do

	write(unit,"(A)") ' Early Rejection Steps'
	write(unit,"(A)") ' ER Step     Start CCB Step     End CCB Step '

	do j = 1, ERSTEPS(i)

		write(unit, "(1x,I3,T18,I3,T36,I3)") j, ERSTART(j,i), EREND(j,i)

	end do

	write(unit,"(A)") ' Expanded Ensemble Damping Factors'
	write(unit,"(A,I2)") ' Bead         Alpha 1 to ', EESTEPS(i) 

	do j = 1, LENLJ(i) + LENION(i)

		write(unit,"(1x,I3,T12, 10(f7.4,2x))") j, BEADDAMP(j,1:EESTEPS(i),i)

	end do

end do

write(unit,*)

if( FromDisk ) then

	write(unit,"(1x,A,A)") 'The initial configuration was taken from file: ', &
							trim( InputConf )

else

	write(unit,"(1x,A)") 'The initial configuration was randomly generated '

end if

write(unit,"(1x,A,T48,A,I10)") 'Initial Seed', '= ', Seed

write(unit,"(1x,A,T48,A,4F7.2)") 'Percentage of Disp/Rot, Creat/Destruc, Regrow', &
								'= ', PROB_MOVE(1) * 100.0, &
								( PROB_MOVE(2) - PROB_MOVE(1) ) * 100.0, &
								( PROB_MOVE(3) - PROB_MOVE(2) ) * 100.0

write(unit,"(1x,A,T48,A,2F7.2)") 'Percentage of Displacement, Rotations', &
								'= ', PROB_DR(1) * 100.0, &
								( 1.0 - PROB_DR(1) ) * 100.0

if( Nsp > 1 ) then

	write(unit,"(1x,A,T48,A)", Advance='No') 'Percentage of Species Creat/Destruc', '= '

	do i = 1, Nsp

		write(unit,"(F7.2)", Advance='No') ( PROB_SP_CD(i) - sum( PROB_SP_CD(1:i-1) )	) * 100.0

	end do

	write(unit,*)

	write(unit,"(1x,A,T48,A)", Advance='No') 'Percentage of Species Regrowths', '= '

	do i = 1, Nsp

		write(unit,"(F7.2)", Advance='No') ( PROB_SP_RG(i) - sum( PROB_SP_RG(1:i-1) )	) * 100.0

	end do

	write(unit,*)

end if

write(unit,"(1x,A,T48,A,3(I8,2x))") 'MC Steps per Cycle, Storage, Adjustment', '= ', &
										NinCycle, Nstorage, Nadjust

write(unit,"(1x,A,T48,A,I8)") 'MC Steps per Histogram data Collection', '= ', &
										Ncollect

write(unit,"(1x,A,T48,A,F10.4)") 'Width of energy histogram bin (K)', '= ', &
										Uwidth

write(unit,*)

close(unit)

return

end subroutine WriteData