func2d_deintersect.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	func2d_deintersect (npt, nfunc, yy)

Function/Subroutine Documentation

func2d_deintersect()

subroutine func2d_deintersect	(	integer, intent(in)	npt,
		integer, intent(in)	nfunc,
		intent(inout)	yy )

Definition at line 28 of file func2d_deintersect.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
      INTEGER ,INTENT(IN)  :: NPT
      INTEGER ,INTENT(IN)  :: NFUNC
      my_real ,DIMENSION(NPT,NFUNC) ,INTENT(INOUT):: yy
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: IPT,IFUNC,I1,I2,J1,J2
      my_real :: t1,t2,y1,y2,dy1,dy2
      my_real ,DIMENSION(NPT) :: ytmp
      my_real ,PARAMETER :: eps = 1.0e-1
c-----------------------------------------------
c     Check and correct segment intersections between 2 functions with same abscissas
c     with respect to the second independent variable
C=======================================================================
      ytmp(:) = zero   
      IF (nfunc > 1) THEN 
        DO ifunc = 2,nfunc
          j1 = ifunc - 1
          j2 = ifunc
          ytmp(1) = yy(1,j2)
          DO ipt = 2,npt
            i1 = ipt - 1
            i2 = ipt
c
            t1 = yy(i1,j1)
            y1 = yy(i1,j2)
            t2 = yy(i2,j1)
            y2 = yy(i2,j2)
            dy1 = y1 - t1
            dy2 = y2 - t2
            IF (dy1*dy2 < 0) THEN
              ! segment intersection, needs correction
              y2 = t2 *(one + eps)
              yy(i2,j2) = y2
            ENDIF
            ytmp(ipt) = y2
          END DO
          yy(1:npt,j2) = ytmp(1:npt)
        END DO
      END IF
c-----------
      RETURN