stpwtbl.f

计算能量损失,重离子经过介质后的能量沉积LET,射程

*$debug
*$declare


	subroutine readsptbl
	include	'stpwtbl.i'
	integer	i,j,m11
	OPEN(8,FILE='STPW.TBL',STATUS='OLD')
	READ(8,'(2I5)') MAXIN,MAXTG
	DO 15 I=1,MAXIN
 15       READ(8,'(A8,2F10.6)') INNAME(I),INCIN(1,I),INCIN(2,I)
	DO 25 I=1,MAXTG
	  READ(8,'(A8,3F10.5)') TGNAME(I),TG1(1,I),TG1(2,I),tg1(3,I)
	  M11=TG1(1,I)
	  DO 35 J=1,M11
 35	  READ(8,'(4F10.5)')TG2(1,J,I),TG2(2,J,I),TG2(3,J,I),TG2(4,J,I)
 25	CONTINUE
	CLOSE(8)
	return
	end


******************************************************************************

	subroutine setstpwin(noi,z,a)
	integer	noi
	real	z,a

	include	'stpwtbl.i'

	BEAM=INNAME(NOI)
	PA=INCIN(2,NOI) 
	PZ=INCIN(1,NOI)
	z=pz
	a=pa

	return
	end



	subroutine askstpwin(noi,z,a)
	integer	noi
	real	z,a

	include	'stpwtbl.i'
	real	zp
	integer	i,k
	WRITE(*,*) '  Please give the atomic no. of the projectile !'
	READ(*,*)ZP
	WRITE(*,'(/)')
	k=0
	DO 56 I=1,MAXIN 
		IF(INCIN(1,I).EQ.ZP)THEN
			WRITE(*,'(''  '',I3,1X,A8,$)')I,INNAME(I)
			k=k+1
			if(mod(k,4).eq.0) write(*,*)
		ENDIF
  56	CONTINUE
  	write(*,*)
	WRITE(*,*) 'Please, enter projectile no.! '
	READ(*,*) NOI

	call setstpwin(noi,z,a)

	return
	end



******************************************************************************

	subroutine askstpwtg(not)
	integer	not

	include	'stpwtbl.i'
	integer	i

	WRITE(*,'(//,1x,5(I3,1X,A8))') (I,TGNAME(I),I=1,MAXTG)
	WRITE(*,*) 'Please, enter target no.! '
	READ(*,*) NOT

	call stopp(not)

	return
	end