Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdshad.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:20:28 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10#if defined(CERNLIB_CG)
11*CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani
12*-- Author :
13 SUBROUTINE GDSHAD(LINCOL,APROSC)
14*
15******************************************************************
16* *
17* Function: Recieve light intensity and angle with surface *
18* Compute colour shading for the surface *
19* *
20* I/O parameters: *
21* LINCOL = colour code *
22* APROSC = inclination between light rays and surface *
23* *
24* Author: S. Giani *
25* *
26******************************************************************
27*
28#include "geant321/gcbank.inc"
29#include "geant321/gcunit.inc"
30#include "geant321/cggpar.inc"
31#include "geant321/cghpar.inc"
32#include "geant321/cgctra.inc"
33#include "geant321/cgcedg.inc"
34#include "geant321/gcdraw.inc"
35#include "geant321/gcflag.inc"
36*
37#include "geant321/gctrak.inc"
38#include "geant321/gcrayt.inc"
39* DATA AAA /1./
40* SAVE AAA
41*
42* print *,aprosc
43 IF(LINCOL.EQ.2)THEN
44 LINCOL=16
45 ELSEIF(LINCOL.EQ.3)THEN
46 LINCOL=66
47 ELSEIF(LINCOL.EQ.4)THEN
48 LINCOL=116
49 ELSEIF(LINCOL.EQ.5)THEN
50 LINCOL=41
51 ELSEIF(LINCOL.EQ.6)THEN
52 LINCOL=141
53 ELSEIF(LINCOL.EQ.7)THEN
54 LINCOL=91
55 ELSE
56* print *,'color not supported'
57 GOTO 20
58 ENDIF
59*
60** AAA=AAA+1
61******* AAA=AAA*123.456789
62******* AAA=AINT(AAA)
63******* QD=AAA
64*
65 SMIN=-1.0001
66 SMAX=-1.+0.08
67 DO 10 I=1,25
68 IF(SMAX.GT.0.99)SMAX=1.0001
69 IF(APROSC.GT.SMIN.AND.APROSC.LE.SMAX)THEN
70** QD=RNDM(AAA)
71** QCD=QD*(SMAX-SMIN)
72** IF((APRO-SMIN).GT.QCD)THEN
73 LINCOL=LINCOL+(I+1)/1.5
74** ELSE
75** IF(I.GT.1)THEN
76** LINCOL=LINCOL+I-1
77** ELSE
78** LINCOL=LINCOL+I
79** ENDIF
80** ENDIF
81 GOTO 20
82 ELSE
83 SMIN=SMAX
84 SMAX=SMAX+0.08
85 ENDIF
86 10 CONTINUE
87*
88* print *,aprosc,'=aprosc'
89*
90 20 CONTINUE
91 CALL ISFACI(LINCOL)
92 CALL ISPLCI(LINCOL)
93 CALL ISPMCI(LINCOL)
94*
95 999 END
96#endif