MINICERN/mathlib/gen/g/vavden.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:48  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       FUNCTION VAVDEN(RLAM)
  11
  12       COMMON /GXXXC1/ WCM(0:200),AC(0:13),HC(0:8),ITYPE,NPT
  13
  14       DIMENSION H(9)
  15
  16       V=0
  17       IF(RLAM .LT. AC(0) .OR. RLAM .GT. AC(8)) GO TO 9
  18
  19       IF(ITYPE .EQ. 1) THEN
  20        FN=1
  21        X=(RLAM+HC(0))*HC(1)
  22        H(1)=X
  23        H(2)=X**2-1
  24        DO 1 K = 2,8
  25        FN=FN+1
  26     1  H(K+1)=X*H(K)-FN*H(K-1)
  27        S=1+HC(7)*H(9)
  28        DO 2 K = 2,6
  29     2  S=S+HC(K)*H(K+1)
  30        V=HC(8)*EXP(-0.5*X**2)*MAX(S,0.)
  31       ELSEIF(ITYPE .EQ. 2) THEN
  32        X=RLAM**2
  33        V=AC(1)*EXP(-AC(2)*(RLAM+AC(5)*X)-
  34      1   AC(3)*EXP(-AC(4)*(RLAM+AC(6)*X)))
  35       ELSEIF(ITYPE .EQ. 3) THEN
  36        IF(RLAM .LT. AC(7)) THEN
  37         X=RLAM**2
  38         V=AC(1)*EXP(-AC(2)*(RLAM+AC(5)*X)-
  39      1         AC(3)*EXP(-AC(4)*(RLAM+AC(6)*X)))
  40        ELSE
  41         X=1/RLAM
  42         V=(AC(11)*X+AC(12))*X
  43        ENDIF
  44       ELSEIF(ITYPE .EQ. 4) THEN
  45        V=AC(13)*DENLAN(RLAM)
  46       ENDIF
  47     9 VAVDEN=V
  48       RETURN
  49
  50       ENTRY VAVDIS(RLAM)
  51
  52       IF(RLAM .LE. AC(0)) THEN
  53        V=0
  54       ELSEIF(RLAM .GE. AC(8)) THEN
  55        V=1
  56       ELSE
  57        X=RLAM-AC(0)
  58        K=X*AC(10)
  59        V=MIN(WCM(K)+(X-K*AC(9))*(WCM(K+1)-WCM(K))*AC(10),1.)
  60       ENDIF
  61       VAVDIS=V
  62       RETURN
  63
  64       ENTRY VAVRND(RAN)
  65
  66       K=MAX(MIN(ABS(LOCATF(WCM(0),NPT+1,RAN)),NPT)-1,0)
  67       X=WCM(K+1)-WCM(K)
  68       V=AC(0)+K*AC(9)
  69       IF(X .GT. 0) V=V+(RAN-WCM(K))*AC(9)/X
  70       VAVRND=V
  71       RETURN
  72       END