GEANT321/gdraw/gdshad.F

   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