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