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