Re: [fluka-discuss]: How to output the source info?

From: Julien Bonvalet <julien.bonvalet_at_u-bordeaux.fr>
Date: Mon, 27 Jan 2020 09:29:43 +0100 (CET)

Dear Haoyu,
Sender: owner-fluka-discuss_at_mi.infn.it

You can find in attach an example...

LINE 64, I write in a test file:

   WRITE(LUNOUT,*)
        CALL OAUXFI('testgek.dat',LUNRDB,'OLD',IERR)
        OPEN(UNIT=3D89,FILE=3D"testsource.dat",STATUS=3D"UNKNOWN")
        WRITE(LUNOUT,*)
        DO I =3D 1, NLINES
           READ(LUNRDB,*) ENRGY(I), XCOO(I), YCOO(I), ZCOO(I),
     & UU(I), VV(I), WW(I), WEIGH(I)
*=09 ENRGY(I)=3DENRGY(I)
        END DO
        KOUNT =3D 0
      END IF

Regards

Julien (CELIA FRANCE)


----- Mail original -----
De: "Haoyu Shi" <shihy_at_ihep.ac.cn>
=C3=80: "fluka-discuss" <fluka-discuss_at_fluka.org>
Envoy=C3=A9: Vendredi 24 Janvier 2020 20:03:04
Objet: [fluka-discuss]: How to output the source info?

Dear FLUKA Experts,
Sender: owner-fluka-discuss_at_mi.infn.it

I'm trying to study with external source file. The source file contains=20
the x,y,z,cosx,cosy and energy. Since I always get strange results, I=20
want to let the program output the source information, to whether the=20
LUNOUT or user-defined file.

For example, I read =E2=80=9CX,COSX,Y,COSY,Z,DE=E2=80=9D from one file open=
ed by=20
OPEN card, and then let
TKEFLK (NPFLKA) =3D (1.0D0+DE)*10.0D0
TXFLK (NPFLKA) =3D COSX
TYFLK (NPFLKA) =3D COSY
TZFLK (NPFLKA) =3D SQRT ( ONEONE - TXFLK (NPFLKA)**2
      & - TYFLK (NPFLKA)**2 )
XFLK (NPFLKA) =3D X*100.0D0
YFLK (NPFLKA) =3D Y*100.0D0
ZFLK (NPFLKA) =3D Z*100.0D0

And I just want to write all these infos to the LUNOUT or some other=20
file using same variable name(TKEFLK,TXFEK=E2=80=A6etc). I tried to add=20
=E2=80=9Cwrite=E2=80=9D command within source.f, or in USROUT routine, but =
all failed.

How could I do this? Or is there any other way to check my source input?

Thank you very much.

Best Regards,
Haoyu

__________________________________________________________________________
 filename=source.f
*$ CREATE SOURCE.FOR
*COPY SOURCE
*
*=== source ===========================================================*
*
      SUBROUTINE SOURCE ( NOMORE )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
* *
* Copyright (C) 1990-2006 by Alfredo Ferrari & Paola Sala *
* All Rights Reserved. *
* *
* *
* New source for FLUKA9x-FLUKA200x: *
* *
* Created on 07 january 1990 by Alfredo Ferrari & Paola Sala *
* Infn - Milan *
* *
* Last change on 03-mar-06 by Alfredo Ferrari *
* *
* This is just an example of a possible user written source routine. *
* note that the beam card still has some meaning - in the scoring the *
* maximum momentum used in deciding the binning is taken from the *
* beam momentum. Other beam card parameters are obsolete. *
* *
*----------------------------------------------------------------------*
*
      INCLUDE '(BEAMCM)'
      INCLUDE '(FHEAVY)'
      INCLUDE '(FLKSTK)'
      INCLUDE '(IOIOCM)'
      INCLUDE '(LTCLCM)'
      INCLUDE '(PAPROP)'
      INCLUDE '(SOURCM)'
      INCLUDE '(SUMCOU)'
*
      LOGICAL LFIRST
      INTEGER IJBEAM
      PARAMETER(NLINES = 33000)
      DIMENSION ENRGY(NLINES), XCOO(NLINES), YCOO(NLINES),
     & ZCOO(NLINES), UU(NLINES), VV(NLINES), WW(NLINES),
     & WEIGH(NLINES)
      SAVE LFIRST, KOUNT
      DATA LFIRST / .TRUE. /
*======================================================================*
* *
* BASIC VERSION *
* *
*======================================================================*
      NOMORE = 0
      IJBEAM=1
* +-------------------------------------------------------------------*
* | First call initializations:
      IF ( LFIRST ) THEN
* | *** The following 3 cards are mandatory ***
         TKESUM = ZERZER
         LFIRST = .FALSE.
         LUSSRC = .TRUE.
* | *** User initialization ***
        WRITE(LUNOUT,*)
        CALL OAUXFI('testgek.dat',LUNRDB,'OLD',IERR)
        OPEN(UNIT=89,FILE="testsource.dat",STATUS="UNKNOWN")
        WRITE(LUNOUT,*)
        DO I = 1, NLINES
           READ(LUNRDB,*) ENRGY(I), XCOO(I), YCOO(I), ZCOO(I),
     & UU(I), VV(I), WW(I), WEIGH(I)
* ENRGY(I)=ENRGY(I)
        END DO
        KOUNT = 0
      END IF
* |
* +-------------------------------------------------------------------*
      KOUNT = KOUNT + 1
* Sample a line from the file
      XI = FLRNDM(DUMMY)
      LINE = INT(XI * DBLE(NLINES)) + 1
      IF(KOUNT .LE. 100) THEN
         WRITE(89,*) LINE,ENRGY(LINE),XCOO(LINE),YCOO(LINE),
     & ZCOO(LINE),UU(LINE),VV(LINE),WW(LINE),WEIGH(LINE)
      END IF
* Push one source particle to the stack. Note that you could as well
* push many but this way we reserve a maximum amount of space in the
* stack for the secondaries to be generated
* Npflka is the stack counter: of course any time source is called it
* must be =0
      NPFLKA = NPFLKA + 1
* Wt is the weight of the particle
      WTFLK (NPFLKA) = WEIGH(LINE)
      WEIPRI = WEIPRI + WTFLK (NPFLKA)
* Particle type (1=proton.....). Ijbeam is the type set by the BEAM
* card
* +-------------------------------------------------------------------*
* | (Radioactive) isotope:
       IF ( IJBEAM .EQ. -2 .AND. LRDBEA ) THEN
          IARES = IPROA
          IZRES = IPROZ
          IISRES = IPROM
          CALL STISBM ( IARES, IZRES, IISRES )
          IJHION = IPROZ * 1000 + IPROA
          IJHION = IJHION * 100 + KXHEAV
          IONID = IJHION
          CALL DCDION ( IONID )
          CALL SETION ( IONID )
* |
* +-------------------------------------------------------------------*
* | Heavy ion:
       ELSE IF ( IJBEAM .EQ. -2 ) THEN
          IJHION = IPROZ * 1000 + IPROA
          IJHION = IJHION * 100 + KXHEAV
          IONID = IJHION
          CALL DCDION ( IONID )
          CALL SETION ( IONID )
          ILOFLK (NPFLKA) = IJHION
* | Flag this is prompt radiation
          LRADDC (NPFLKA) = .FALSE.
* |
* +-------------------------------------------------------------------*
* | Normal hadron:
       ELSE
         IONID = IJBEAM
         ILOFLK (NPFLKA) = IJBEAM
* | Flag this is prompt radiation
         LRADDC (NPFLKA) = .FALSE.
* | Group number for "low" energy neutrons, set to 0 anyway
         IGROUP (NPFLKA) = 0
      END IF
* |
* |
* +-------------------------------------------------------------------*
* From this point .....
* Particle generation (1 for primaries)
      LOFLK (NPFLKA) = 1
* User dependent flag:
      LOUSE (NPFLKA) = 0
* User dependent spare variables:
      DO 100 ISPR = 1, MKBMX1
         SPAREK (ISPR,NPFLKA) = ZERZER
 100 CONTINUE
* User dependent spare flags:
      DO 200 ISPR = 1, MKBMX2
         ISPARK (ISPR,NPFLKA) = 0
 200 CONTINUE
* Save the track number of the stack particle:
      ISPARK (MKBMX2,NPFLKA) = NPFLKA
      NPARMA = NPARMA + 1
      NUMPAR (NPFLKA) = NPARMA
      NEVENT (NPFLKA) = 0
      DFNEAR (NPFLKA) = +ZERZER
* ... to this point: don't change anything
* Particle age (s)
      AGESTK (NPFLKA) = +ZERZER
      AKNSHR (NPFLKA) = -TWOTWO
* Group number for "low" energy neutrons, set to 0 anyway
      IGROUP (NPFLKA) = 0
* Kinetic energy of the particle (GeV)
      TKEFLK (NPFLKA) = ENRGY(LINE)
* Particle momentum
      PMOFLK (NPFLKA) = SQRT ( TKEFLK (NPFLKA) * ( TKEFLK (NPFLKA)
     & + TWOTWO * AM (ILOFLK(NPFLKA)) ) )
* Cosines (tx,ty,tz)
      TXFLK (NPFLKA) = UU(LINE)
      TYFLK (NPFLKA) = VV(LINE)
      TZFLK (NPFLKA) = SQRT ( ONEONE - TXFLK (NPFLKA)**2
     & - TYFLK (NPFLKA)**2 )
* Polarization cosines:
      TXPOL (NPFLKA) = -TWOTWO
      TYPOL (NPFLKA) = +ZERZER
      TZPOL (NPFLKA) = +ZERZER
* Particle coordinates
      XFLK (NPFLKA) = XCOO(LINE)
      YFLK (NPFLKA) = YCOO(LINE)
      ZFLK (NPFLKA) = ZCOO(LINE)
* Calculate the total kinetic energy of the primaries: don't change
      IF ( ILOFLK (NPFLKA) .EQ. -2 .OR. ILOFLK (NPFLKA) .GT. 100000 )
     & THEN
         TKESUM = TKESUM + TKEFLK (NPFLKA) * WTFLK (NPFLKA)
      ELSE IF ( ILOFLK (NPFLKA) .NE. 0 ) THEN
         TKESUM = TKESUM + ( TKEFLK (NPFLKA) + AMDISC (ILOFLK(NPFLKA)) )
     & * WTFLK (NPFLKA)
      ELSE
         TKESUM = TKESUM + TKEFLK (NPFLKA) * WTFLK (NPFLKA)
      END IF
      RADDLY (NPFLKA) = ZERZER
* Here we ask for the region number of the hitting point.
* NREG (NPFLKA) = ...
* The following line makes the starting region search much more
* robust if particles are starting very close to a boundary:
      CALL GEOCRS ( TXFLK (NPFLKA), TYFLK (NPFLKA), TZFLK (NPFLKA) )
      CALL GEOREG ( XFLK (NPFLKA), YFLK (NPFLKA), ZFLK (NPFLKA),
     & NRGFLK(NPFLKA), IDISC )
* Do not change these cards:
      CALL GEOHSM ( NHSPNT (NPFLKA), 1, -11, MLATTC )
      NLATTC (NPFLKA) = MLATTC
      CMPATH (NPFLKA) = ZERZER
      CALL SOEVSV
      RETURN
*=== End of subroutine Source =========================================*
      END


__________________________________________________________________________
You can manage unsubscription from this mailing list at https://www.fluka.org/fluka.php?id=acc_info
Received on Mon Jan 27 2020 - 12:34:37 CET

This archive was generated by hypermail 2.3.0 : Mon Jan 27 2020 - 12:34:43 CET