OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ebcs_extrapol.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| ebcs_extrapol ../engine/source/boundary_conditions/ebcs/ebcs_extrapol.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| ebcs_extrap2 ../engine/source/boundary_conditions/ebcs/ebcs_extrapol.F
29!||--- uses -----------------------------------------------------
30!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.F90
31!||====================================================================
32 SUBROUTINE ebcs_extrapol(FV, NP, TF, EBCS_TAB)
33 USE ebcs_mod
34C-----------------------------------------------
35C D e s c r i p t i o n
36C-----------------------------------------------
37C Function f for EBCS is defined for times from
38C tmin to tmax
39C When current time t is such that t < tmin value
40C for F is taken as F(tmin).
41C When current time t is such that t > tmax value
42C for F is taken as F(tmax).
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com04_c.inc"
51#include "com08_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: NP(NFUNCT)
56 my_real, INTENT(IN) :: fv(*), tf(*)
57 TYPE(t_ebcs_tab), TARGET, INTENT(IN) :: EBCS_TAB
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER I, N, NPOINT
62 INTEGER :: EBCS_EXTRAP(NFUNCT)
63 CLASS(t_ebcs), POINTER :: EBCS
64
65 DO i = 1, nfunct
66 ebcs_extrap(i) = 0
67 ENDDO
68
69 DO i = 1, nebcs
70 IF(.NOT.ebcs_tab%need_to_compute(i)) cycle
71 ebcs => ebcs_tab%tab(i)%poly
72 SELECT TYPE (ebcs)
73 TYPE IS (t_ebcs_gradp0)
74 IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
75 IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
76 IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
77 TYPE IS (t_ebcs_pres)
78 IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
79 IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
80 IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
81 TYPE IS (t_ebcs_valvin)
82 IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
83 IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
84 IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
85 TYPE IS (t_ebcs_valvout)
86 IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
87 IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
88 IF (ebcs%ipres > 0) ebcs_extrap(ebcs%ipres) = 1
89 TYPE IS (t_ebcs_vel)
90 IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
91 IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
92 IF (ebcs%ivx > 0) ebcs_extrap(ebcs%ivx) = 1
93 IF (ebcs%ivy > 0) ebcs_extrap(ebcs%ivy) = 1
94 IF (ebcs%ivz > 0) ebcs_extrap(ebcs%ivz) = 1
95 TYPE IS (t_ebcs_normv)
96 IF (ebcs%irho > 0) ebcs_extrap(ebcs%irho) = 1
97 IF (ebcs%iener > 0) ebcs_extrap(ebcs%iener) = 1
98 IF (ebcs%ivimp > 0) ebcs_extrap(ebcs%ivimp) = 1
99 CLASS DEFAULT
100 END SELECT
101 ENDDO
102
103 DO n=1,nfunct
104 IF (ebcs_extrap(n) == 1) THEN
105 npoint=(np(n+1)-np(n))/2
106 CALL ebcs_extrap2(tf(np(n)),tt,npoint,fv(n))
107 ENDIF
108 ENDDO
109
110 RETURN
111 END SUBROUTINE ebcs_extrapol
112
113!||====================================================================
114!|| ebcs_extrap2 ../engine/source/boundary_conditions/ebcs/ebcs_extrapol.F
115!||--- called by ------------------------------------------------------
116!|| ebcs_extrapol ../engine/source/boundary_conditions/ebcs/ebcs_extrapol.F
117!||====================================================================
118 SUBROUTINE ebcs_extrap2(TF,TT,NPOINT,F)
119C-----------------------------------------------
120C I m p l i c i t T y p e s
121C-----------------------------------------------
122#include "implicit_f.inc"
123C-----------------------------------------------
124C D u m m y A r g u m e n t s
125C-----------------------------------------------
126 INTEGER NPOINT
127 my_real tt, f
128 my_real tf(2,*)
129C-----------------------------------------------
130C L o c a l V a r i a b l e s
131C-----------------------------------------------
132
133C-----------------------------------------------
134C B o d y
135C-----------------------------------------------
136 !!! If tt (=current time) is lower than tmin (=TF(1,1)) then take first value
137 !!! If tt (=current time) is greater than tmax (=TF(1,NPOINT)= then take last value
138
139 IF (tt <= tf(1, 1)) THEN
140 f = tf(2,1)
141 ENDIF
142 IF (tt >= tf(1, npoint)) THEN
143 f = tf(2, npoint)
144 ENDIF
145
146 RETURN
147 END SUBROUTINE ebcs_extrap2
my_real
#define my_real
Definition cppsort.cpp:32
ebcs_extrapol
subroutine ebcs_extrapol(fv, np, tf, ebcs_tab)
Definition ebcs_extrapol.F:33
ebcs_extrap2
subroutine ebcs_extrap2(tf, tt, npoint, f)
Definition ebcs_extrapol.F:119