PROGRAM Fancy ! ! PROGRAM DESCRIPTION: ! ! prints out decay chains of gemimi events ! to continue reading out events after fortran pause type ! "continue" or just "c". ! ! AUTHORS: ! ! Bob Charity (RJC) ! ! CREATION DATE: 1988 ! ! ! C H A N G E L O G ! ! Date | Name | Description ! ----------------+-------+----------------------------------------------------- ! [change_entry] ! USE gem_kind USE sortsub IMPLICIT NONE LOGICAL :: printit INTEGER :: L,nn(500),ii,k,n_max,parent,nnn,l_old INTEGER :: I_read_error,N_tot,M_frag,jj,ill INTEGER :: unit_in,unit_out CHARACTER(LEN=6) :: fragment(100),space = " " CHARACTER(LEN=100) :: out(100) CHARACTER(LEn=1) :: c unit_in = 2 unit_out = -1 call start_sort(unit_in,unit_out,I_read_error) l_old = -1 WRITE (UNIT=*, FMT=*) "1=all events,2=one event per each l wave" READ (UNIT=5, FMT=*) ill N_TOT = 0 M_frag = 0 DO call get_event(l,I_read_error) IF (I_read_error /= 0) EXIT printit = .true. if (ill == 2 .AND. l == l_old) printit = .FALSE. l_old = l IF (printit) THEN WRITE (UNIT=*, FMT=*) "L=",l," weight=",weight," N_binary=",n_binary WRITE (UNIT=*, FMT=*) "Number of fragments=",N_frag WRITE (UNIT=*, FMT=*) " " ! zero decay branch markers nn(1) = 0. DO ii=2,100 nn(ii) = -1 END DO n_max = 0. DO jj=1,n_frag out(jj) = space//space//space//space//space//space//& &space//space//space//space//space//space END DO DO jj=1,N_frag ! first identify fragment IF (frag(jj)%Z == -1) THEN IF (frag(jj)%A == 1) THEN fragment(jj) = " E1 " ELSE IF (frag(jj)%A == 2) THEN fragment(jj) = " E2 " ELSE IF (frag(jj)%A == 3) THEN fragment(jj) = " M1 " ELSE IF (frag(jj)%A > 10) THEN fragment(jj) = "K xray" END IF ELSE IF (frag(jj)%Z == 0) THEN IF (frag(jj)%A == 1) THEN fragment(jj) = " n " END IF ELSE IF (frag(jj)%Z == 1) THEN IF (frag(jj)%A == 1) THEN fragment(jj) = " p " ELSE IF (frag(jj)%A == 2) THEN fragment(jj) = " d " ELSE IF (frag(jj)%A == 3) THEN fragment(jj) = " t " END IF ELSE IF (frag(jj)%Z == 2 .AND. frag(jj)%A == 4) THEN fragment(jj) = " a " ELSE WRITE (UNIT=fragment(jj), FMT="(I3,A2,TR1)")& frag(jj)%A,name(frag(jj)%Z) END IF ! reconstruct tree IF (frag(jj)%id > 31) THEN DO IF (frag(jj)%id <= 31) EXIT frag(jj)%id = ISHFT(frag(jj)%id,-1) END DO END IF IF (nn(frag(jj)%id) < 0.) THEN ! this is the first particle of this decay branch parent = ISHFT(frag(jj)%id,-1) ii = 1 DO IF (nn(parent) >= 0) EXIT parent = ISHFT(parent,-1) ii = ii + 1 END DO DO k=ii,1,-1 parent = ISHFT(frag(jj)%id,-k) IF (k == ii) THEN nnn = nn(parent) ELSE nnn = nnn + 1 nn(parent) = nnn END IF IF (parent == 1) THEN out(nn(parent)+1)(26:74)& = "--------------------------------------------------" ELSE IF (parent == 2) THEN out(nn(parent)+1)(14:39)& = "--------------------------" ELSE IF (parent == 3) THEN out(nn(parent)+1)(60:88)& = "---------------------------" ELSE IF (parent == 4) THEN out(nn(parent)+1)(8:21) = "--------------" ELSE IF (parent == 5) THEN out(nn(parent)+1)(32:45) = "--------------" ELSE IF (parent == 6) THEN out(nn(parent)+1)(56:69) = "--------------" ELSE IF (parent == 7) THEN out(nn(parent)+1)(80:93) = "--------------" ELSE IF (parent == 8) THEN out(nn(parent)+1)(5:12) = "--------" ELSE IF (parent == 9) THEN out(nn(parent)+1)(17:24) = "--------" ELSE IF (parent == 10) THEN out(nn(parent)+1)(29:36) = "--------" ELSE IF (parent == 11) THEN out(nn(parent)+1)(41:48) = "--------" ELSE IF (parent == 12) THEN out(nn(parent)+1)(53:60) = "--------" ELSE IF (parent == 13) THEN out(nn(parent)+1)(65:72) = "--------" ELSE IF (parent == 14) THEN out(nn(parent)+1)(77:84) = "--------" ELSE IF (parent == 15) THEN out(nn(parent)+1)(89:96) = "--------" ELSE IF (parent == 16) THEN out(nn(parent)+1)(4:7) = "----" ELSE IF (parent == 17) THEN out(nn(parent)+1)(10:13) = "----" ELSE IF (parent == 18) THEN out(nn(parent)+1)(16:19) = "----" ELSE IF (parent == 19) THEN out(nn(parent)+1)(22:25) = "----" ELSE IF (parent == 20) THEN out(nn(parent)+1)(28:31) = "----" ELSE IF (parent == 21) THEN out(nn(parent)+1)(34:37) = "----" ELSE IF (parent == 22) THEN out(nn(parent)+1)(40:43) = "----" ELSE IF (parent == 23) THEN out(nn(parent)+1)(46:49) = "----" ELSE IF (parent == 24) THEN out(nn(parent)+1)(52:55) = "----" ELSE IF (parent == 25) THEN out(nn(parent)+1)(58:61) = "----" ELSE IF (parent == 26) THEN out(nn(parent)+1)(64:67) = "----" ELSE IF (parent == 27) THEN out(nn(parent)+1)(70:73) = "----" ELSE IF (parent == 28) THEN out(nn(parent)+1)(76:79) = "----" ELSE IF (parent == 29) THEN out(nn(parent)+1)(82:85) = "----" ELSE IF (parent == 30) THEN out(nn(parent)+1)(88:91) = "----" ELSE IF (parent == 31) THEN out(nn(parent)+1)(94:97) = "----" END IF END DO nn(frag(jj)%id) = nnn + 1 END IF nn(frag(jj)%id) = nn(frag(jj)%id) + 1 n_max = MAX (n_max,nn(frag(jj)%id)) IF (frag(jj)%id == 1) THEN out(nn(frag(jj)%id))(47:52) = fragment(jj) ELSE IF (frag(jj)%id == 2) THEN out(nn(frag(jj)%id))(23:28) = fragment(jj) ELSE IF (frag(jj)%id == 3) THEN out(nn(frag(jj)%id))(71:76) = fragment(jj) ELSE IF (frag(jj)%id == 4) THEN out(nn(frag(jj)%id))(10:15) = fragment(jj) ELSE IF (frag(jj)%id == 5) THEN out(nn(frag(jj)%id))(36:41) = fragment(jj) ELSE IF (frag(jj)%id == 6) THEN out(nn(frag(jj)%id))(57:62) = fragment(jj) ELSE IF (frag(jj)%id == 7) THEN out(nn(frag(jj)%id))(84:89) = fragment(jj) ELSE IF (frag(jj)%id == 8) THEN out(nn(frag(jj)%id))(5:10) = fragment(jj) ELSE IF (frag(jj)%id == 9) THEN out(nn(frag(jj)%id))(18:23) = fragment(jj) ELSE IF (frag(jj)%id == 10) THEN out(nn(frag(jj)%id))(29:34) = fragment(jj) ELSE IF (frag(jj)%id == 11) THEN out(nn(frag(jj)%id))(42:47) = fragment(jj) ELSE IF (frag(jj)%id == 12) THEN out(nn(frag(jj)%id))(53:58) = fragment(jj) ELSE IF (frag(jj)%id == 13) THEN out(nn(frag(jj)%id))(66:71) = fragment(jj) ELSE IF (frag(jj)%id == 14) THEN out(nn(frag(jj)%id))(77:82) = fragment(jj) ELSE IF (frag(jj)%id == 15) THEN out(nn(frag(jj)%id))(90:95) = fragment(jj) ELSE IF (frag(jj)%id == 16) THEN out(nn(frag(jj)%id))(2:7) = fragment(jj) ELSE IF (frag(jj)%id == 17) THEN out(nn(frag(jj)%id))(9:14) = fragment(jj) ELSE IF (frag(jj)%id == 18) THEN out(nn(frag(jj)%id))(14:19) = fragment(jj) ELSE IF (frag(jj)%id == 19) THEN out(nn(frag(jj)%id))(21:26) = fragment(jj) ELSE IF (frag(jj)%id == 20) THEN out(nn(frag(jj)%id))(26:31) = fragment(jj) ELSE IF (frag(jj)%id == 21) THEN out(nn(frag(jj)%id))(33:38) = fragment(jj) ELSE IF (frag(jj)%id == 22) THEN out(nn(frag(jj)%id))(38:43) = fragment(jj) ELSE IF (frag(jj)%id == 23) THEN out(nn(frag(jj)%id))(45:50) = fragment(jj) ELSE IF (frag(jj)%id == 24) THEN out(nn(frag(jj)%id))(50:55) = fragment(jj) ELSE IF (frag(jj)%id == 25) THEN out(nn(frag(jj)%id))(57:62) = fragment(jj) ELSE IF (frag(jj)%id == 26) THEN out(nn(frag(jj)%id))(62:67) = fragment(jj) ELSE IF (frag(jj)%id == 27) THEN out(nn(frag(jj)%id))(69:74) = fragment(jj) ELSE IF (frag(jj)%id == 28) THEN out(nn(frag(jj)%id))(74:79) = fragment(jj) ELSE IF (frag(jj)%id == 29) THEN out(nn(frag(jj)%id))(81:86) = fragment(jj) ELSE IF (frag(jj)%id == 30) THEN out(nn(frag(jj)%id))(86:91) = fragment(jj) ELSE IF (frag(jj)%id == 31) THEN out(nn(frag(jj)%id))(93:98) = fragment(jj) ELSE out(nn(frag(jj)%id))(34:39) = fragment(jj) END IF END DO DO ii=1,n_max WRITE (UNIT=6, FMT="(TR2,A100)") out(ii) END DO WRITE (UNIT=6, FMT="(A)") " PAUSE" READ (UNIT=5, FMT="(A1)") c if (c /= "c" .AND. c /= "C") STOP END IF END DO CLOSE (UNIT=2) STOP END PROGRAM Fancy