1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2! Copyright 2010.  Los Alamos National Security, LLC. This material was    !
3! produced under U.S. Government contract DE-AC52-06NA25396 for Los Alamos !
4! National Laboratory (LANL), which is operated by Los Alamos National     !
5! Security, LLC for the U.S. Department of Energy. The U.S. Government has !
6! rights to use, reproduce, and distribute this software.  NEITHER THE     !
7! GOVERNMENT NOR LOS ALAMOS NATIONAL SECURITY, LLC MAKES ANY WARRANTY,     !
8! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS         !
9! SOFTWARE.  If software is modified to produce derivative works, such     !
10! modified software should be clearly marked, so as not to confuse it      !
11! with the version available from LANL.                                    !
12!                                                                          !
13! Additionally, this program is free software; you can redistribute it     !
14! and/or modify it under the terms of the GNU General Public License as    !
15! published by the Free Software Foundation; version 2.0 of the License.   !
16! Accordingly, this program is distributed in the hope that it will be     !
17! useful, but WITHOUT ANY WARRANTY; without even the implied warranty of   !
18! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General !
19! Public License for more details.                                         !
20!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
21
22! 1 = A0
23! 2 = B1
24! 3 = B2
25! 4 = B3
26! 5 = B4
27! 6 = B5
28! 7 = R1
29! 8 = RCUT
30! 9 = TAIL1
31! 10 = TAIL2
32! 11 = TAIL3
33! 12 = TAIL4
34! 13 = TAIL5
35! 14 = TAIL6
36
37SUBROUTINE UNIVSCALE_SUB(R, A, X)
38
39  USE MYPRECISION
40
41  IMPLICIT NONE
42
43  REAL(LATTEPREC) :: A(14), X, R, RMINUSR1, POLYNOM, RMOD
44
45  IF (R .LE. A(7)) THEN
46
47     RMOD = R - A(6)
48
49     POLYNOM = RMOD*(A(2) + RMOD*(A(3) + RMOD*(A(4) + A(5)*RMOD)))
50
51     X = EXP(POLYNOM)
52
53  ELSEIF (R .GT. A(7) .AND. R .LT. A(8)) THEN
54
55     RMINUSR1 = R - A(7)
56
57     X = A(9) + RMINUSR1*(A(10) + &
58          RMINUSR1*(A(11) + RMINUSR1*(A(12) + &
59          RMINUSR1*(A(13) + RMINUSR1*A(14)))))
60
61  ELSE
62
63     X = ZERO
64
65  END IF
66
67  X = A(1)*X
68
69  RETURN
70
71END SUBROUTINE UNIVSCALE_SUB
72