Upload New File

Simulation_Track_Structure/PTra_HIT/Obsolete/outside2Dall.f

+      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='F_ExtractionScoringPlane_t'//TRIM(FILENO)//'.csv'
+        OPEN(11,FILE=FNAME,STATUS='OLD')
+        OPEN(12,FILE='HITSI1+2all.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