OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbawarpoff.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!|| cbal58warp ../engine/source/elements/shell/coqueba/cbawarpoff.F
25!||--- called by ------------------------------------------------------
26!|| cbaforc3 ../engine/source/elements/shell/coqueba/cbaforc3.F
27!||--- calls -----------------------------------------------------
28!|| setuvarw ../engine/source/elements/shell/coqueba/cbawarpoff.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!||====================================================================
33 SUBROUTINE cbal58warp(ELBUF_STR,NEL,
34 1 X,IXC,E3X ,E3Y ,E3Z ,OFFG ,ZLLC2 )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE elbufdef_mod
39 use element_mod , only : nixc
40C-----------------------------------------------
41C I M P L I C I T T Y P E S
42C-----------------------------------------------
43#include "implicit_f.inc"
44c-----------------------------------------------
45c g l o b a l p a r a m e t e r s
46c-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C D U M M Y A R G U M E N T S
50C-----------------------------------------------
51 INTEGER NEL
52 INTEGER IXC(NIXC,*)
53 my_real
54 . x(3,*),e3x(*),e3y(*),e3z(*),offg(*),zllc2(*)
55 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
56C-----------------------------------------------
57C L O C A L V A R I A B L E S
58C-----------------------------------------------
59 INTEGER I, NG, ILAY, IR, IS, IT, NPTR, NPTS
60 my_real
61 . xx(4),yy(4),zz(4),hix(mvsiz),hiy(mvsiz),hiz(mvsiz)
62 my_real
63 . r13(mvsiz),
64 . r23(mvsiz),
65 . r33(mvsiz),
66 . deta1(mvsiz),rx0(mvsiz), ry0(mvsiz), rz0(mvsiz),
67 . sx0(mvsiz),sy0(mvsiz),sz0(mvsiz),pg,pg1,vpg(2,4),
68 . rx(mvsiz), ry(mvsiz), rz(mvsiz),
69 . sx(mvsiz),sy(mvsiz),sz(mvsiz),cc,pmax(mvsiz),pcos(mvsiz,4)
70 my_real, DIMENSION(:) ,POINTER :: uvar
71
72C
73 parameter(pg=.577350269189626)
74 parameter(pg1=-.577350269189626)
75C--------------------------
76C INITIALISATION
77C--------------------------
78 DATA vpg/pg1,pg1,pg,pg1,pg,pg,pg1,pg/
79C=======================================================================
80c ---- 4 ------3
81c------| |
82c------| |
83c ---- 1 ------2
84C--- recalculate r,s at 4 ipt, 4*g1=ksi_i*xi+(hi*xi)*eta; 4*g2=eta_i*xi+(hi*xi)*ksi
85 DO i=1,nel
86 IF (offg(i)<one .OR. zllc2(i)<em02) cycle
87 xx(1:4) = x(1,ixc(2:5,i))
88 yy(1:4) = x(2,ixc(2:5,i))
89 zz(1:4) = x(3,ixc(2:5,i))
90 hix(i) = xx(1)-xx(2)+xx(3)-xx(4)
91 hiy(i) = yy(1)-yy(2)+yy(3)-yy(4)
92 hiz(i) = zz(1)-zz(2)+zz(3)-zz(4)
93 rx0(i)=-xx(1)+xx(2)+xx(3)-xx(4)
94 ry0(i)=-yy(1)+yy(2)+yy(3)-yy(4)
95 rz0(i)=-zz(1)+zz(2)+zz(3)-zz(4)
96 sx0(i)=-xx(1)-xx(2)+xx(3)+xx(4)
97 sy0(i)=-yy(1)-yy(2)+yy(3)+yy(4)
98 sz0(i)=-zz(1)-zz(2)+zz(3)+zz(4)
99 ENDDO
100 nptr = elbuf_str%NPTR
101 npts = elbuf_str%NPTS
102C----- only for npt=1
103 pmax(1:nel) =zero
104 DO is = 1,npts
105 DO ir = 1,nptr
106 ng = nptr*(is-1) + ir
107 pcos(1:nel,ng) =one
108 DO i=1,nel
109 IF (offg(i)<one .OR. zllc2(i)<em02) cycle
110 rx(i)=rx0(i)+hix(i)*vpg(2,ng)
111 ry(i)=ry0(i)+hiy(i)*vpg(2,ng)
112 rz(i)=rz0(i)+hiz(i)*vpg(2,ng)
113 sx(i)=sx0(i)+hix(i)*vpg(1,ng)
114 sy(i)=sy0(i)+hiy(i)*vpg(1,ng)
115 sz(i)=sz0(i)+hiz(i)*vpg(1,ng)
116 ENDDO
117C----------------------------
118 DO i=1,nel
119 IF (offg(i)<one .OR. zllc2(i)<em02) cycle
120 r13(i) = ry(i) * sz(i) - rz(i) * sy(i)
121 r23(i) = rz(i) * sx(i) - rx(i) * sz(i)
122 r33(i) = rx(i) * sy(i) - ry(i) * sx(i)
123 deta1(i) = sqrt(r13(i)*r13(i)+r23(i)*r23(i)+r33(i)*r33(i))
124 cc = one/max(deta1(i),em20)
125 pcos(i,ng) = cc*(e3x(i)*r13(i)+e3y(i)*r23(i)+e3z(i)*r33(i))
126 pmax(i) = max(pmax(i),pcos(i,ng))
127 ENDDO
128 END DO !IR = 1,NPTR
129 END DO !IR = 1,NPTR
130 ilay = 1
131 it=1
132 DO is = 1,npts
133 DO ir = 1,nptr
134 ng = nptr*(is-1) + ir
135 uvar => elbuf_str%BUFLY(ilay)%MAT(ir,is,it)%VAR
136C----------------------------
137 DO i=1,nel
138 IF (offg(i)<one .OR. zllc2(i)<em02) cycle
139 cc =one/(one+sqrt(zllc2(i)))
140 IF (pcos(i,ng)/=pmax(i)) pcos(i,ng) = min(pcos(i,ng),cc)
141 ENDDO
142 CALL setuvarw(nel,pcos(1,ng),uvar)
143 END DO !IR = 1,NPTR
144 END DO !IR = 1,NPTR
145C----------------------------
146 RETURN
147 END
148!||====================================================================
149!|| setuvarw ../engine/source/elements/shell/coqueba/cbawarpoff.F
150!||--- called by ------------------------------------------------------
151!|| cbal58warp ../engine/source/elements/shell/coqueba/cbawarpoff.F
152!||====================================================================
153 SUBROUTINE setuvarw(NEL,PCOS,UVAR )
154C-----------------------------------------------
155C I M P L I C I T T Y P E S
156C-----------------------------------------------
157#include "implicit_f.inc"
158C-----------------------------------------------
159C D U M M Y A R G U M E N T S
160C-----------------------------------------------
161 INTEGER NEL
162 my_real
163 . pcos(*),uvar(nel,*)
164C-----------------------------------------------
165C L O C A L V A R I A B L E S
166C-----------------------------------------------
167 INTEGER I
168 my_real
169 . u_max
170C=======================================================================
171C-----put cc and recovering more rapide
172 DO i=1,nel
173 IF (pcos(i) >=0.64.AND.uvar(i,40)==one) cycle
174 IF (pcos(i) <0.34) THEN
175 u_max = min(one,1.5*uvar(i,40))
176 uvar(i,40) =em10
177C---------try EM10
178 ELSEIF (pcos(i) <0.5) THEN
179 u_max = min(one,1.05*uvar(i,40))
180 uvar(i,40) =em3*(pcos(i)-0.34)/(0.5-0.34)
181 ELSEIF (pcos(i) <0.64) THEN
182 u_max = min(one,1.02*uvar(i,40))
183 uvar(i,40) =em02*(pcos(i)-0.5)/(0.64-0.5)
184c ELSEIF (PCOS(I) <0.9) THEN
185c U_MAX = MIN(ONE,1.01*UVAR(I,40))
186c UVAR(I,40) =EM01*(PCOS(I)-0.64)/(0.9-0.64)
187 ELSE
188 u_max = min(one,1.01*uvar(i,40))
189 uvar(i,40) = pcos(i)
190 END IF
191 uvar(i,40)=min(uvar(i,40),u_max)
192 ENDDO
193C----------------------------
194 RETURN
195 END
setuvarw
subroutine setuvarw(nel, pcos, uvar)
Definition cbawarpoff.F:154
cbal58warp
subroutine cbal58warp(elbuf_str, nel, x, ixc, e3x, e3y, e3z, offg, zllc2)
Definition cbawarpoff.F:35
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21