This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / v / munomi.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1996/04/01 15:02:55  mclareni
6 * Mathlib gen
7 *
8 *
9 #include "gen/pilot.h"
10       SUBROUTINE MUNOMI(NCH,NTOT,P,N,IERROR)
11 C
12 C    MULTINOMIAL GENERATOR
13 C    CODED FROM LOS ALAMOS REPORT      LA-5061-MS
14 C    PROB(N(1),...,N(NCH))=FACT(NTOT)*(PRODUCT ON I OF(P(I)**N(I)/FACT(N
15 C        WHERE FACT(N) STANDS FOR FACTORIAL OF N
16 C    ON INPUT NCH NUMBER OF CHANNELS
17 C             NTOT SUM OF N(I)
18 C             P(I) , I=1,NCH   LIST OF INDIVIDUAL PROBABILITIES
19 C                  THIS LIST IS ALTERED AFTER FIRST CALL TO REPRESENT
20 C                  DISTRIBUTION FUNCTIO TO SAVE TIME ON FURTHER CALLS
21 C                  WITH IDENTICAL REQUESTS
22 C                  SUM OF P(I),I=1,J-1 OVERWRITES P(J)
23 C                  ALTERNATIVELY ONE MAY ENTER DIRECTLY THIS ALTERED
24 C                  LIST BUT P(NCH) MUST BE .EQ.1.
25 C    RETURNS  N(I) , I=1,NCH
26 C             IERROR.EQ.0 NORMALLY
27 C             IERROR.EQ.1 IF AT LEAST ONE P IS NEGATIVE
28 C             IERROR.EQ.2 IF SUM OF P(I) IS LARGER THAN 1.
29 C
30       DIMENSION P(2),N(2)
31 C    CHECKING/PREPARATION IS DONE IN PRINCIPLE ONCE
32       IF(P(NCH).EQ.1.) GO TO 200
33 C    CHECK INPUT PROBABILITIES
34       IF(P(1).LT.0.) GO TO 800
35       DO 150 I=2,NCH
36       IF(P(I).LT.0.) GO TO 800
37 C    PREPARE DISTRIBUTION FUNCTION
38       P(I)=P(I)+P(I-1)
39   150 CONTINUE
40 C    CHECK OVERALL SUM
41       IF(P(NCH).GT.1.) GO TO 900
42 C    SET SUM EXACTLY EQUAL TO 1. , WILL BE RECOGNISED ON FURTHER CALLS
43       P(NCH)=1.
44   200 CONTINUE
45       IERROR=0
46       CALL UZERO(N,1,NCH)
47       DO 350 I=1,NTOT
48       R=RNDM(I)
49       DO 250 J=1,NCH
50       IF(P(J).LT.R) GO TO 250
51       K=J
52       GO TO 300
53   250 CONTINUE
54 C    ONE SHOULD NOT REACH THIS PLACE
55       K=NCH
56   300 CONTINUE
57       N(K)=N(K)+1
58   350 CONTINUE
59       GO TO 999
60   800 CONTINUE
61 C    AT LEAST ONE NEGATIVE PROBABILITY
62       IERROR=1
63       GO TO 999
64   900 CONTINUE
65 C    SUM OF PROBABILITIES IS LARGER THAN 1.
66       IERROR=2
67   999 CONTINUE
68       RETURN
69       END