OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cbawarpoff.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cbal58warp (elbuf_str, nel, x, ixc, e3x, e3y, e3z, offg, zllc2)
subroutine setuvarw (nel, pcos, uvar)

Function/Subroutine Documentation

◆ cbal58warp()

subroutine cbal58warp ( type(elbuf_struct_), target elbuf_str,
integer nel,
x,
integer, dimension(nixc,*) ixc,
e3x,
e3y,
e3z,
offg,
zllc2 )

Definition at line 33 of file cbawarpoff.F.

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
setuvarw
subroutine setuvarw(nel, pcos, uvar)
Definition cbawarpoff.F:154
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

◆ setuvarw()

subroutine setuvarw ( integer nel,
pcos,
uvar )

Definition at line 153 of file cbawarpoff.F.

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