/[PAMELA software]/PamVMC/trk/src/f77/gprnhran.F
ViewVC logotype

Contents of /PamVMC/trk/src/f77/gprnhran.F

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations) (download)
Thu Feb 19 17:46:26 2009 UTC (15 years, 11 months ago) by nikolas
Branch: MAIN
Cleaning up before releasing

1 *
2 * $Id: gprnhran.F,v 3.1 2005/12/06 01:06:42 cafagna Exp $
3 *
4 * $Log: gprnhran.F,v $
5 * Revision 3.1 2005/12/06 01:06:42 cafagna
6 * Adding new magnetic field routines
7 *
8 * Revision 1.2 1996/04/10 16:31:41 mclareni
9 * NAME given dimension 2
10 *
11 * Revision 1.1 1996/04/09 13:34:34 mclareni
12 * Add new routine rnhran.F (V149), also to Imakefile
13 *
14 * 27/05/2005 Sergio Bottai
15 * MODIFIED IN ORDER TO USE GEANT RANDOM NUMBERS
16 *
17 *
18 SUBROUTINE GPRNHRAN(Y,N,XLO,XWID,XRAN)
19 CHARACTER*8 NAME(2)
20
21 DIMENSION Y(*)
22
23 DATA IERR /0/
24 DATA NAME /'GPRNHRAN','GPRNHPRE'/
25
26 NTRY=1
27 IF(Y(N) .EQ. 1) GOTO 4
28 WRITE(6,101) NAME(1),Y(N)
29 GOTO 5
30
31 ENTRY GPRNHPRE(Y,N)
32 NTRY=2
33
34 5 YTOT=0
35 DO 1 I = 1,N
36 IF(Y(I) .LT. 0) GOTO 9
37 YTOT=YTOT+Y(I)
38 1 Y(I)=YTOT
39 IF(YTOT .LE. 0) GOTO 9
40 YINV=1/YTOT
41 DO 2 I = 1,N
42 2 Y(I)=Y(I)*YINV
43 Y(N)=1
44 IF(NTRY .EQ. 2) RETURN
45
46 c 4 CALL RANLUX(YR,1)
47 4 CALL GRNDM(YR,1)
48
49 L=LOCATR(Y,N,YR)
50 IF(L .LT. 0) THEN
51 L=-L
52 XRAN=XLO+XWID*(L+((YR-Y(L))/(Y(L+1)-Y(L))))
53 ELSEIF(L .EQ. 0) THEN
54 XRAN=XLO+XWID*(YR/Y(1))
55 ELSE
56 XRAN=XLO+L*XWID
57 ENDIF
58 RETURN
59
60 9 IERR=IERR+1
61 IF(IERR .LT. 6) WRITE(6,102) NAME(NTRY)
62 WRITE(6,'(1X,10F13.7)') (Y(K),K=1,N)
63 XRAN=0
64 RETURN
65 101 FORMAT(/7X,'+++++ CERN V149 ',A6,' : Y(N) = ',E15.6,' .NE. 1; ',
66 1 'Y(I) NOT IN CUMULATIVE FORM.'/)
67 102 FORMAT(/7X,'+++++ CERN V149 ',A6,' : NOT ALL VALUES Y(I) > 0'/)
68 END
69

  ViewVC Help
Powered by ViewVC 1.1.23