minter1d_rat.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    minter1d_rat   ../common_source/eos/minter1d_rat.F
!||--- called by ------------------------------------------------------
!||    mintp1_rt      ../common_source/eos/mintp1_rt.F
!||    mintp_re       ../common_source/eos/mintp_re.F
!||    mintp_rt       ../common_source/eos/mintp_rt.F
!||--- uses       -----------------------------------------------------
!||    constant_mod   ../common_source/modules/constant_mod.F
!||====================================================================
      SUBROUTINE minter1d_rat(X0,X1,X2,X3,Y0,Y1,Y2,Y3,X,Y,YP,I,N)
C     INTERPOLATION (RATIONAL FUNCTION)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE constant_mod , ONLY : zero, em20, one
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
        IMPLICIT NONE
#include      "my_real.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER I, N
        my_real x0, x1, x2, x3, y0, y1, y2, y3, x, y, yp
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        my_real q, d, r, s, sp, c2, dm, sm, c1, c6, c4, c3, c3d, c5
C-----------------------------------------------
        q = x-x1
        d = x2-x1
        r = d-q
        s = (y2-y1) / d
        sp = (y3-y2) / (x3-x2)
        c2 = (sp-s) / (x3-x1)
        dm = x1-x0
        dm = sign(max(em20,abs(dm)),dm)
        sm = (y1-y0) / dm
        c1 = (s-sm) / (d+dm)
        c6 = zero
        IF(i == 1)THEN
          IF(s*(s-d*c2) <= zero) c2 = s/d
          c4 = c2
        ELSE IF(i == n-1)THEN
          c4 = c1
        ELSE
          IF(i == 2 .AND. sm*(sm-dm*c1) <= zero) c1=(s-sm-sm) / d
          c3 = abs(c2*r)
          c3d = c3+abs(c1*q)
          c5 = zero
          IF(c3d > zero) THEN
            c3 = c3/c3d
            c5 = c3*(c1-c2)
          ENDIF
          c4 = c2+c5
          c6 = d*c5*(one-c3)
        ENDIF
        y = y1 + q*(s-r*c4)
        yp = s+(q-r)*c4+c6
        RETURN
      END