ebcs_extrapol.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	ebcs_extrapol (fv, np, tf, ebcs_tab)
subroutine	ebcs_extrap2 (tf, tt, npoint, f)

Function/Subroutine Documentation

ebcs_extrap2()

subroutine ebcs_extrap2	(		tf,
			tt,
		integer	npoint,
			f )

Definition at line 118 of file ebcs_extrapol.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NPOINT
      my_real tt, f
      my_real tf(2,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
 
C-----------------------------------------------
C   B o d y
C-----------------------------------------------
      !!! If tt (=current time) is lower than tmin (=TF(1,1)) then take first value
      !!! If tt (=current time) is greater than tmax (=TF(1,NPOINT)= then take last value
 
      IF (tt <= tf(1, 1)) THEN
         f = tf(2,1)
      ENDIF
      IF (tt >= tf(1, npoint)) THEN
         f = tf(2, npoint)
      ENDIF
 
      RETURN

ebcs_extrapol()

subroutine ebcs_extrapol	(	dimension(*), intent(in)	fv,
		integer, dimension(nfunct), intent(in)	np,
		dimension(*), intent(in)	tf,
		type(t_ebcs_tab), intent(in), target	ebcs_tab )

Definition at line 32 of file ebcs_extrapol.F.

      USE ebcs_mod
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C Function f for EBCS is defined for times from
C tmin to tmax
C When current time t is such that t < tmin value
C for F is taken as F(tmin).
C When current time t is such that t > tmax value
C for F is taken as F(tmax).
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) ::  NP(NFUNCT)
      my_real, INTENT(IN) :: fv(*), tf(*)
      TYPE(t_ebcs_tab), TARGET, INTENT(IN) :: EBCS_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N, NPOINT
      INTEGER :: EBCS_EXTRAP(NFUNCT)
      CLASS(t_ebcs), POINTER :: EBCS
 
      DO i = 1, nfunct
         ebcs_extrap(i) = 0
      ENDDO
 
      DO i = 1, nebcs
         IF(.NOT.ebcs_tab%need_to_compute(i)) cycle
         ebcs => ebcs_tab%tab(i)%poly
         SELECT TYPE (ebcs)
           TYPE IS (t_ebcs_gradp0)
             IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
             IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
             IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
           TYPE IS (t_ebcs_pres)
             IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
             IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
             IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
           TYPE IS (t_ebcs_valvin)
             IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
             IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
             IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
           TYPE IS (t_ebcs_valvout)
             IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
             IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
             IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
           TYPE IS (t_ebcs_vel)
             IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
             IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
             IF (ebcs%ivx > 0) ebcs_extrap(ebcs%ivx) = 1
             IF (ebcs%ivy > 0) ebcs_extrap(ebcs%ivy) = 1
             IF (ebcs%ivz > 0) ebcs_extrap(ebcs%ivz) = 1
           TYPE IS (t_ebcs_normv)
             IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
             IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
             IF (ebcs%ivimp > 0) ebcs_extrap(ebcs%ivimp) = 1
           CLASS DEFAULT
        END SELECT
      ENDDO
 
      DO  n=1,nfunct
         IF (ebcs_extrap(n) == 1) THEN
            npoint=(np(n+1)-np(n))/2
            CALL ebcs_extrap2(tf(np(n)),tt,npoint,fv(n))
         ENDIF
      ENDDO
 
      RETURN