GEANT321/gphys/gsynit.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:35  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 #if defined(CERNLIB_NEVER)
  11 *CMZ :  3.21/02 29/03/94  15.41.23  by  S.Giani
  12 *-- Author :
  13       SUBROUTINE GSYNIT
  14 C
  15 C  Preperation of synchrotron radiation tables.
  16 C  This routine can be used to compute the YT and FTI used
  17 C  in GSYNGE.
  18 C  Author: Igor Gavrilenko
  19 C
  20       COMMON /SYNTAB/ YT(54),FT(54),FTI(53)
  21       EXTERNAL BK53,BKS53
  22       DOUBLE PRECISION YM,YMA,EPS,XX
  23 C...
  24       DATA EPS/.0001/
  25 C...
  26       L = 0
  27       YS = .000001
  28       DO 20 I = 1,6
  29          YS = YS*10.
  30          DO 10 J = 1,9,1
  31             L = L+1
  32             YM = J*YS
  33             YT(L) = YM
  34             YMA = YM+YS
  35             IF(L.EQ.54) YMA = 20.
  36             FT(L) = DGAUSS(BK53,YM,YMA,EPS)
  37    10    CONTINUE
  38    20 CONTINUE
  39 C...
  40       DO 30 I = 53,1,-1
  41          FT(I) = FT(I)+FT(I+1)
  42    30 CONTINUE
  43 C...
  44       DO 40 I = 53,1,-1
  45          YM = YT(I)
  46          YMA = YT(I+1)
  47          IF(I.LT.53) FTI(I) = DGAUSS(BKS53,YM,YMA,EPS)+FTI(I+1)
  48          IF(I.EQ.53) FTI(I) = DGAUSS(BKS53,YM,YMA,EPS)
  49    40 CONTINUE
  50 C...
  51       E N D
  52 C-------------------------------------------------------
  53       DOUBLE PRECISION FUNCTION B K 5 3 (X)
  54 C
  55       DOUBLE PRECISION X
  56 C...
  57       BK53 = 4./(3.*X)*DBSKR3(X,2)+DBSKR3(X,1)
  58       RETURN
  59       E N D
  60 C------------------------------------------------------
  61       DOUBLE PRECISION FUNCTION B K S 5 3 (X)
  62 C
  63       COMMON /SYNTAB/ YT(54),FT(54),FTI(53)
  64       DOUBLE PRECISION X
  65 C...
  66       IF(X.GT.YT(1)) GO TO 10
  67       BKS53 = FT(1)
  68       GO TO 60
  69 C...
  70    10 IF(X.LT.YT(54)) GO TO 20
  71       BKS53 = 0.
  72       RETURN
  73 C...
  74    20 K1 = 1
  75       K2 = 54
  76    30 K = (K1+K2)/2
  77       IF(X.GT.YT(K)) K1 = K
  78       IF(X.LT.YT(K)) K2 = K
  79       IF(X.NE.YT(K)) GO TO 40
  80       BKS53 = FT(K)
  81       GO TO 60
  82 C...
  83    40 IF(K2-K1.GT.1) GO TO 30
  84       F1 = FT(K1)
  85       F2 = FT(K2)
  86       X1 = YT(K1)
  87       X2 = YT(K2)
  88 C...
  89       IF(X.LE.1.) THEN
  90          X1 = LOG(X1)
  91          X2 = LOG(X2)
  92          B = F1+(F2-F1)/(X2-X1)*(LOG(X)-X1)
  93          GO TO 50
  94       ENDIF
  95 C...
  96       IF(X.GT.1.) THEN
  97          F1 = LOG(F1)
  98          F2 = LOG(F2)
  99          B = F1+(F2-F1)/(X2-X1)*(X-X1)
 100          B = EXP(B)
 101       ENDIF
 102 C...
 103    50 BKS53 = B
 104    60 BKS53 = .1909859*BKS53
 105       RETURN
 106       E N D
 107 #endif