Upload New File

Simulation_Track_Structure/PTra_HIT/FilterExtrAp.f

+      PROGRAM FilterExtrAp
+      IMPLICIT REAL (A-H,O-Z)
+      IMPLICIT INTEGER (I-N)
+      INTEGER*8 NEV,IEV
+      CHARACTER*100 FILNAM,FULLNM,BUFFER
+      CHARACTER*20 STRING
+      CHARACTER*20 DATEN(8,1000),PARTIC,LINES(1000)*80
+      CHARACTER*80 FPATH,FPATT,OPATH,PPATH       ! File name pattern
+      CHARACTER*2 PREFIX(2)
+      CHARACTER ADJUSTL,TRIM
+
+      LOGICAL ACCEPT,BORON,CARBON,GOOD,THERE
+
+      DIMENSION LUNOUT(2)
+
+      DATA PREFIX / 'F_','O_' /
+      DATA LUNOUT / 12,13 /
+
+      PPATH='-'
+      
+      PRINT*,'# files per run'
+      READ(*,*) NF
+
+      PRINT*, 'Number of source directories'
+      READ(*,*) NDIRS
+
+      PRINT*, 'Replace existing output files? (1/0)'
+      READ(*,*) KILL
+      IF(KILL.EQ.0) THEN
+        PRINT*,'Existing output files will be extended.'
+      ELSE
+        PRINT*,'Existing output files will be replaced'
+      ENDIF
+
+      FPATT='ExtractionScoringPlane_t#.csv'
+      LOCF=INDEX(FPATT,'#')
+      
+      Loop_Directories: DO IDIR=1,NDIRS
+
+      READ(*,'(a)') FPATH
+      READ(*,'(a)') OPATH
+      PRINT*,'|'//TRIM(FPATH)//'|'//TRIM(OPATH)//'|'
+      
+      IEV=-1
+      EX1=0.
+      EY1=0.
+      EZ1=0.
+      E1=0.
+      N1=0
+      EX2=0.
+      EY2=0.
+      EZ2=0.
+      E2=0.
+      N2=0
+      IDUM=1
+
+      Loop_Files: DO I=1,NF
+        WRITE(STRING,'(I8)') I-1
+        FILNAM=FPATT(1:LOCF-1)//TRIM(ADJUSTL(STRING))
+     &                        //FPATT(LOCF+1:80)
+        PRINT*, TRIM(FILNAM)//'|'
+
+        FULLNM=TRIM(FPATH)//FILNAM
+        INQUIRE(FILE=FULLNM,EXIST=THERE)
+        IF(.NOT.THERE) THEN
+          PRINT*,'File '//TRIM(FULLNM)//' not found'
+          CYCLE Loop_Files
+        END IF
+
+        OPEN(11,FILE=FULLNM,STATUS='OLD')
+        DO J=1,13
+          READ(11,'(a)') LINES(J)
+        END DO
+
+        DO ICASE=1,2
+          FULLNM=TRIM(OPATH)//PREFIX(ICASE)//FILNAM
+          PRINT*,TRIM(FULLNM)//'|'
+
+          INQUIRE(FILE=FULLNM,EXIST=THERE)
+          IF(PPATH.EQ.OPATH.OR.(THERE.AND.KILL.EQ.0)) THEN
+            OPEN(LUNOUT(ICASE),FILE=FULLNM,STATUS='OLD',ACCESS='APPEND')
+          ELSE
+            OPEN(LUNOUT(ICASE),FILE=FULLNM,STATUS='UNKNOWN')
+            DO J=1,13
+              WRITE(LUNOUT(ICASE),'(a)') LINES(J)
+            END DO
+          END IF
+        END DO
+
+        J=1 
+        READ(11,'(A)',END=10) LINES(J)
+        READ(LINES(J),*) (DATEN(K,J),K=1,8),NEV
+        NEVENT=NEV
+
+        Process_this_File: DO 
+          IDUM=IDUM+1
+          IF(MOD(IDUM,100000).EQ.0) WRITE(*,'(a,$)') '.'
+
+          DO WHILE(NEV.EQ.NEVENT)
+            J=J+1
+            READ(11,'(A)',END=10) LINES(J)
+            READ(LINES(J),*) (DATEN(K,J),K=1,8),NEV
+          END DO
+
+          GOOD=CARBON(DATEN(8,1))
+C!        Make sure the first output line is carbon ion (if there)
+          IF(.NOT.GOOD) THEN 
+            DO K=2,J-1
+              GOOD=CARBON(DATEN(8,K))
+              IF(GOOD) THEN 
+                BUFFER=LINES(1)
+                LINES(1)=LINES(K)
+                LINES(K)=BUFFER
+                DO L=1,8
+                  BUFFER=DATEN(L,1)
+                  DATEN(L,1)=DATEN(L,K)
+                  DATEN(L,K)=BUFFER
+                END DO
+                EXIT
+              ENDIF 
+            END DO
+          ENDIF
+
+          IF(GOOD) THEN
+            DO K=1,J-1
+              IF(ACCEPT(DATEN(8,K))) WRITE(LUNOUT(1),'(a)') LINES(K)
+            END DO
+          ELSE
+            DO K=1,J-1
+              IF(ACCEPT(DATEN(8,K))) WRITE(LUNOUT(2),'(a)') LINES(K)
+            END DO
+          END IF
+
+          LINES(1)=LINES(J)
+          J=1
+          READ(LINES(J),*) (DATEN(K,J),K=1,8),NEV
+          NEVENT=NEV
+        END DO Process_this_file
+
+  10    CONTINUE
+        CLOSE(11)
+        CLOSE(LUNOUT(ICASE))
+        PRINT*,'Done!'
+      END DO Loop_Files
+      END DO Loop_Directories
+      END
+
+      LOGICAL FUNCTION ACCEPT(PARTIC)
+      CHARACTER*20 PARTIC
+      LOGICAL CARBON
+      ACCEPT=CARBON(PARTIC).OR.PARTIC(1:2).EQ.'e-'
+     &                     .OR.PARTIC(1:5).EQ.'alpha'
+     &                     .OR.PARTIC(1:5).EQ.'proto'
+     &                     .OR.PARTIC(1:5).EQ.'deute'
+     &                     .OR.PARTIC(1:5).EQ.'trito'
+     &                     .OR.PARTIC(1:2).EQ.'He'
+     &                     .OR.PARTIC(1:2).EQ.'Li'
+     &                     .OR.PARTIC(1:2).EQ.'Be' ! 26-Apr-2024
+     &                     .OR.PARTIC(1:1).EQ.'B'  ! 26-Apr-2024
+     &                     .OR.PARTIC(1:1).EQ.'N'  ! 26-Apr-2024
+      RETURN
+      END
+
+      LOGICAL FUNCTION BORON(PARTIC)
+      CHARACTER*20 PARTIC
+      BORON=PARTIC(1:1).EQ.'B'.AND.PARTIC(2:2).NE.'e'
+      RETURN
+      END
+
+      LOGICAL FUNCTION CARBON(PARTIC)
+      CHARACTER*20 PARTIC
+      CARBON=PARTIC(1:2).EQ.'C1'.OR.PARTIC(1:2).EQ.'C9'
+      RETURN
+      END
\ No newline at end of file