[u/mrichter/AliRoot.git] / GEANT321 / gdraw / gdshad.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1995/10/24 10:20:28  cernlib
* Geant
*
*
#include "geant321/pilot.h"
#if defined(CERNLIB_CG)
*CMZ :  3.21/02 29/03/94  15.41.27  by  S.Giani
*-- Author :
      SUBROUTINE GDSHAD(LINCOL,APROSC)
*
******************************************************************
*                                                                *
* Function: Recieve light intensity and angle with surface       *
*           Compute colour shading for the surface               *
*                                                                *
* I/O parameters:                                                *
* LINCOL = colour code                                           *
* APROSC = inclination between light rays and surface            *
*                                                                *
* Author: S. Giani                                               *
*                                                                *
******************************************************************
*
#include "geant321/gcbank.inc"
#include "geant321/gcunit.inc"
#include "geant321/cggpar.inc"
#include "geant321/cghpar.inc"
#include "geant321/cgctra.inc"
#include "geant321/cgcedg.inc"
#include "geant321/gcdraw.inc"
#include "geant321/gcflag.inc"
*
#include "geant321/gctrak.inc"
#include "geant321/gcrayt.inc"
*     DATA AAA /1./
*     SAVE AAA
*
*      print *,aprosc
      IF(LINCOL.EQ.2)THEN
         LINCOL=16
      ELSEIF(LINCOL.EQ.3)THEN
         LINCOL=66
      ELSEIF(LINCOL.EQ.4)THEN
         LINCOL=116
      ELSEIF(LINCOL.EQ.5)THEN
         LINCOL=41
      ELSEIF(LINCOL.EQ.6)THEN
         LINCOL=141
      ELSEIF(LINCOL.EQ.7)THEN
         LINCOL=91
      ELSE
*        print *,'color not supported'
         GOTO 20
      ENDIF
*
**      AAA=AAA+1
*******      AAA=AAA*123.456789
*******      AAA=AINT(AAA)
*******      QD=AAA
*
      SMIN=-1.0001
      SMAX=-1.+0.08
      DO 10 I=1,25
         IF(SMAX.GT.0.99)SMAX=1.0001
         IF(APROSC.GT.SMIN.AND.APROSC.LE.SMAX)THEN
**        QD=RNDM(AAA)
**        QCD=QD*(SMAX-SMIN)
**        IF((APRO-SMIN).GT.QCD)THEN
            LINCOL=LINCOL+(I+1)/1.5
**        ELSE
**           IF(I.GT.1)THEN
**            LINCOL=LINCOL+I-1
**           ELSE
**            LINCOL=LINCOL+I
**           ENDIF
**        ENDIF
            GOTO 20
         ELSE
            SMIN=SMAX
            SMAX=SMAX+0.08
         ENDIF
   10 CONTINUE
*
*     print *,aprosc,'=aprosc'
*
   20 CONTINUE
      CALL ISFACI(LINCOL)
      CALL ISPLCI(LINCOL)
      CALL ISPMCI(LINCOL)
*
  999 END
#endif
Commit	Line	Data
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