Skip to content
Snippets Groups Projects
Commit c1efdaed authored by Hans Rabus's avatar Hans Rabus
Browse files

Upload New File

parent 43812a50
No related branches found
No related tags found
1 merge request!1Add new directory
PROGRAM outsiders2D
CHARACTER FNAME*80, FILENO*2, TRIM, ADJUSTL, PARTIC*40, LINE*80
DO I=0,27
WRITE(*,'(i2,$)') I
WRITE(FILENO,'(i2)') I
FILENO=ADJUSTL(FILENO)
FNAME='O_ExtractionScoringPlane_t'//TRIM(FILENO)//'.csv'
OPEN(11,FILE=FNAME,STATUS='OLD')
OPEN(12,FILE='HITSI1+2all+0.dat',STATUS='UNKNOWN')
READ(11,'(a)') LINE
DO WHILE(LINE(1:1).EQ.'#')
READ(11,'(a)') LINE
END DO
READ(LINE,*) X2,Y2,Z2,X1,Y1,Z1,E,PARTIC,IEV
IEV0=IEV
NEV=1
DO
IF(PARTIC(1:1).EQ.'C') THEN
IZ=6
IF(PARTIC(1:2).EQ.'C1') THEN
READ(PARTIC(2:3),'(I2)') M
ELSEIF(PARTIC(1:2).EQ.'C9') THEN
M=9
ELSE
M=0
ENDIF
ELSE IF(PARTIC(1:5).EQ.'proto') THEN
IZ=1
M=1
ELSE IF(PARTIC(1:5).EQ.'deute') THEN
IZ=1
M=2
ELSE IF(PARTIC(1:5).EQ.'trito') THEN
IZ=1
M=3
ELSE IF(PARTIC(1:5).EQ.'alpha') THEN
IZ=2
M=4
ELSE IF(PARTIC(1:2).EQ.'He') THEN
IZ=2
M=3
ELSE IF(PARTIC(1:2).EQ.'Li') THEN
IZ=3
READ(PARTIC(3:3),*) M
ELSE IF(PARTIC(1:2).EQ.'e-') THEN
IZ=-1
M=0
ELSE
Print*,'WARNING: Unknown particle ignored: '//PARTIC
ENDIF
IF(M.GT.0) THEN
XD1=X1+(X2-X1)/(Z2-Z1)*(13.8-Z1)
YD1=Y1+(Y2-Y1)/(Z2-Z1)*(13.8-Z1)
XD2=X1+(X2-X1)/(Z2-Z1)*(243.8-Z1)
YD2=Y1+(Y2-Y1)/(Z2-Z1)*(243.8-Z1)
CALL WRITIT(12,IEV0,IZ,M,XD1,YD1,XD2,YD2,E)
END IF
READ(11,*,END=20) X2,Y2,Z2,X1,Y1,Z1,E,PARTIC,IEV
IF(IEV.NE.IEV0) THEN
IEV0=IEV
NEV=NEV+1
IF(MOD(NEV,500).EQ.0) WRITE(*,'(1H.,a,$)') ''
ENDIF
END DO
20 CONTINUE
CLOSE(11)
WRITE(*,*)
END DO
CLOSE(12)
END
SUBROUTINE WRITIT(LUN,IEV0,IZ,MC,XC1,YC1,XC2,YC2,EC)
CHARACTER SFLOAT*16, SINTEG*8
WRITE(LUN,'(a)') TRIM(SINTEG(IEV0))//' '//
& TRIM(SINTEG(IZ))//' '//TRIM(SINTEG(MC))//' '//
& TRIM(SFLOAT(XC1,3))//' '//TRIM(SFLOAT(YC1,3))//' '//
& TRIM(SFLOAT(XC2,3))//' '//TRIM(SFLOAT(YC2,3))//' '//
& TRIM(SFLOAT(EC,3))
END
C! ******************************************************************
CHARACTER*16 FUNCTION SFLOAT(X,NDIG)
C! ------------------------------------------------------------------
CHARACTER FMZ*7
FMZ='(F16.0)'
IF(NDIG.GE.10) NDIG=9
WRITE(FMZ(6:6),'(i1)') NDIG
SFLOAT=''
WRITE(SFLOAT,FMZ) X
N=16
DO WHILE(SFLOAT(N:N).EQ.'0')
SFLOAT(N:N)=' '
N=N-1
END DO
SFLOAT=ADJUSTL(SFLOAT)
RETURN
END FUNCTION SFLOAT
C! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
C! ******************************************************************
CHARACTER*8 FUNCTION SINTEG(N)
C! ------------------------------------------------------------------
SINTEG=''
WRITE(SINTEG,'(I8)') N
SINTEG=ADJUSTL(SINTEG)
RETURN
END FUNCTION SINTEG
C! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment