vinter.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	vinter (tf, iad, ipos, ilen, nel, x, dydx, y)
subroutine	vinter2 (tf, iad, ipos, ilen, nel0, x, dydx, y)
subroutine	vinter2dp (tf, iad, ipos, ilen, nel0, x, dydx, y)
program	__vinter_f__

Function/Subroutine Documentation

__vinter_f__()

program __vinter_f__

Definition at line 281 of file vinter.F.

vinter()

subroutine vinter	(		tf,
		integer, dimension(nel)	iad,
		integer, dimension(nel)	ipos,
		integer, dimension(nel)	ilen,
		integer	nel,
			x,
			dydx,
			y )

Definition at line 72 of file vinter.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C
      INTEGER :: NEL
      INTEGER :: ILEN(NEL),IPOS(NEL),IAD(NEL)
      my_real :: x(nel),dydx(nel),y(nel)
      my_real :: tf(2,*)
C-----------------------------------------------
      INTEGER :: I,J,J1,J2,ICONT
C=======================================================================
      j = 0
 100  CONTINUE
C 
       j = j+1
       icont = 0
       DO i=1,nel
         j1 = ipos(i)+iad(i)+1
         IF(j<=ilen(i)-1.AND.x(i)>tf(1,j1))THEN
           ipos(i)=ipos(i)+1
           icont = 1
         ENDIF
       ENDDO
C
      IF(icont==1)GOTO 100
C
      DO i=1,nel
        j1   =ipos(i)+iad(i)
        j2   = j1+1
        dydx(i)=(tf(2,j2)-tf(2,j1))/(tf(1,j2)-tf(1,j1))
        y(i)   = tf(2,j1) + dydx(i)*(x(i)-tf(1,j1))
      ENDDO
C
      RETURN

vinter2()

subroutine vinter2	(		tf,
		integer, dimension(*)	iad,
		integer, dimension(*)	ipos,
		integer, dimension(*)	ilen,
		integer	nel0,
			x,
			dydx,
			y )

Definition at line 143 of file vinter.F.

C same as vinter with possibility to decrease x
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C
      INTEGER ILEN(*),IPOS(*),IAD(*),NEL0
      my_real x(*),dydx(*),y(*),tf(2,*)
      INTEGER I,J1,J,ICONT,J2
 
      my_real tf2j2,tf2j1,tf1j2,tf1j1,
     .  xdp,yydp, dydxdp
      LOGICAL COND1, COND2
C
      j = 0
      icont = 1
      DO WHILE(icont==1)
C 
       j = j+1
       icont = 0
       DO i=1,nel0
         j1 = ipos(i)+iad(i)+1
         cond1 = j<=ilen(i)-1
         IF(cond1) cond1 = x(i)>tf(1,j1)
         cond2 = ipos(i)>=1
         IF(cond2) cond2 = x(i)<tf(1,j1-1)
         IF(cond1)THEN
           ipos(i)=ipos(i)+1
           icont = 1
         ELSEIF(cond2)THEN
           ipos(i)=ipos(i)-1
           icont = 1
         ENDIF
       ENDDO
C
      ENDDO
C
      DO i=1,nel0
        j1   =ipos(i)+iad(i)
        j2   = j1+1
 
        tf2j2 = tf(2,j2)
        tf2j1 = tf(2,j1)
        tf1j2 = tf(1,j2)
        tf1j1 = tf(1,j1)
        xdp = x(i)
 
ccc        DYDX(I)=(TF(2,J2)-TF(2,J1))/(TF(1,J2)-TF(1,J1))
 
        dydxdp = (tf2j2-tf2j1)/(tf1j2-tf1j1)
        dydx(i) = dydxdp
ccc        Y(I)   = TF(2,J1) + DYDX(I)*(X(I)-TF(1,J1))
        yydp = tf2j1 + dydxdp * (xdp - tf1j1)
        y(i) = yydp
 
      ENDDO
C
      RETURN

vinter2dp()

subroutine vinter2dp	(		tf,
		integer, dimension(*)	iad,
		integer, dimension(*)	ipos,
		integer, dimension(*)	ilen,
		integer	nel0,
			x,
			dydx,
			y )

Definition at line 214 of file vinter.F.

C same as vinter with possibility to decrease x
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
 
      INTEGER ILEN(*),IPOS(*),IAD(*),NEL0
      my_real x(*),dydx(*),y(*),tf(2,*)
      INTEGER I,J1,J,ICONT,J2
      DOUBLE PRECISION TF2J2,TF2J1,TF1J2,TF1J1, XDP,YYDP, DYDXDP
      j = 0
      icont = 1
      DO WHILE(icont==1)
 
       j = j+1
       icont = 0
       DO i=1,nel0
         j1 = ipos(i)+iad(i)+1
         IF(j<=ilen(i)-1.AND.x(i)>tf(1,j1))THEN
           ipos(i)=ipos(i)+1
           icont = 1
         ELSEIF(ipos(i)>=1.AND.x(i)<tf(1,j1-1))THEN
           ipos(i)=ipos(i)-1
           icont = 1
         ENDIF
       ENDDO
 
      ENDDO
C
      DO i=1,nel0
        j1   =ipos(i)+iad(i)
        j2   = j1+1
 
        tf2j2 = tf(2,j2)
        tf2j1 = tf(2,j1)
        tf1j2 = tf(1,j2)
        tf1j1 = tf(1,j1)
        xdp = x(i)
 
ccc        DYDX(I)=(TF(2,J2)-TF(2,J1))/(TF(1,J2)-TF(1,J1))
 
        dydxdp = (tf2j2-tf2j1)/(tf1j2-tf1j1)
        dydx(i) = dydxdp
ccc        Y(I)   = TF(2,J1) + DYDX(I)*(X(I)-TF(1,J1))
        yydp = tf2j1 + dydxdp * (xdp - tf1j1)
        y(i) = yydp
 
      ENDDO
C
      RETURN