OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cuserini4.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!|| cuserini4 ../starter/source/elements/shell/coqueba/cuserini4.F
25!||--- called by ------------------------------------------------------
26!|| cbainit3 ../starter/source/elements/shell/coqueba/cbainit3.F
27!|| cdkinit3 ../starter/source/elements/sh3n/coquedk/cdkinit3.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| fretitl2 ../starter/source/starter/freform.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../starter/share/message_module/message_mod.F
33!||====================================================================
34 SUBROUTINE cuserini4(ELBUF_STR,
35 1 JFT ,JLT ,NFT ,NEL ,ISTRAIN ,
36 2 SIGSH ,NSIGSH ,NUMEL ,IX ,NIX ,
37 3 NUMSH ,PTSH ,IR ,IS ,NPT ,
38 4 IGTYP ,IGEO ,NLAY ,NPG ,IPG )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE elbufdef_mod
43 USE message_mod
44 USE names_and_titles_mod , ONLY : nchartitle
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "param_c.inc"
53#include "com01_c.inc"
54#include "scr17_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER JFT,JLT,NFT,NEL,IR,IS,NPT,NUMEL,NIX,ISTRAIN,NSIGSH,NUMSH,
59 . IGTYP,IGEO(NPROPGI,*),NLAY,NPG,IPG
60 INTEGER IX(NIX,*),PTSH(*)
61 my_real
62 . sigsh(nsigsh,*)
63 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
64C------------------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 CHARACTER(LEN=NCHARTITLE)::TITR
68 INTEGER I,J,II,JJ,KK,N,NPTI,I1,I2,PT,NPGI,NU,NUVAR,NVARS,IPT,NPI,
69 . IPID1,PID1,C1,IPT_ALL,IT,ILAY,NPTT,L_SIGB
70 TYPE(L_BUFEL_) ,POINTER :: LBUF
71 TYPE(buf_lay_) ,POINTER :: BUFLY
72 my_real, DIMENSION(:), POINTER :: uvar,siga,sigb,sigc
73C--------------------------------------------------------------
74 DO i=jft,jlt
75 IF (abs(isigi)/=3 .AND. abs(isigi)/=4 .AND. abs(isigi)/=5)THEN
76 ii = i+nft
77 n = nint(sigsh(1,ii))
78 IF (n/=ix(nix,ii)) THEN
79 jj = ii
80 DO j = 1,numel
81 ii= j
82 n = nint(sigsh(1,ii))
83 IF (n == 0) GOTO 200
84 IF (n == ix(nix,jj)) GOTO 60
85 ENDDO
86 60 CONTINUE
87 ENDIF
88 ELSE
89 jj=nft+i
90 n =ix(nix,jj)
91 ii=ptsh(jj)
92 IF (ii == 0) GOTO 200
93 ENDIF
94C
95 npi = nint(sigsh(nvshell + 2,ii))
96 npgi = nint(sigsh(nvshell + 3,ii))
97 nvars = nint(sigsh(nvshell + 4,ii))
98C
99 IF ((npgi /= npg.OR.npi /= npt) .AND. igtyp/=51 .AND. igtyp/=52) THEN
100c for IGTYP == 51, usually NPT <= NPTI (NPTI = NTPP --> for all layers)
101 ipid1=ix(nix-1,nft+i)
102 pid1=igeo(1,ipid1)
103 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
104 CALL ancmsg(msgid=26,
105 . anmode=aninfo,
106 . msgtype=msgerror,
107 . c1=titr,
108 . i1=pid1,
109 . i2=n)
110C
111 ELSE
112 IF (npgi > 0) THEN
113 IF (npi > 0) THEN
114c
115 IF (elbuf_str%BUFLY(1)%ILAW == 36) THEN ! backstress is no more stored in uvar
116 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
117 IF (nvars > 3 .and. npi > 0 .and. l_sigb > 0) THEN
118 kk = nvshell + 4 +(ipg-1)*nvars*npi
119c
120 DO ilay=1,nlay
121 bufly => elbuf_str%BUFLY(ilay)
122 nptt = bufly%NPTT
123 nuvar = bufly%NVAR_MAT
124 DO it=1,nptt
125 sigb => bufly%LBUF(ir,is,it)%SIGB
126 DO j = 1,l_sigb
127 kk = kk + 1
128 jj = (j-1)*nel + i
129 sigb(jj) = sigsh(kk,ii)
130 ENDDO
131 ENDDO
132 ENDDO ! DO ILAY=1,NPT
133 ENDIF
134c
135 ELSE IF (elbuf_str%BUFLY(1)%ILAW == 78) THEN ! backstress is no more stored in uvar
136 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
137 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
138 kk = nvshell + 4 +(ipg-1)*nvars*npi
139c
140 DO ilay=1,nlay
141 bufly => elbuf_str%BUFLY(ilay)
142 nptt = bufly%NPTT
143 DO it=1,nptt
144 uvar => bufly%MAT(ir,is,it)%VAR
145 siga => bufly%LBUF(ir,is,it)%SIGA
146 sigb => bufly%LBUF(ir,is,it)%SIGB
147 sigc => bufly%LBUF(ir,is,it)%SIGC
148c
149 DO nu = 1,nuvar
150 kk = kk + 1
151 jj = (nu-1)*nel + i
152 uvar(jj) = sigsh(kk,ii)
153 ENDDO
154 DO j = 1,l_sigb
155 kk = kk + 1
156 jj = (j-1)*nel + i
157 siga(jj) = sigsh(kk,ii)
158 ENDDO
159 DO j = 1,l_sigb
160 kk = kk + 1
161 jj = (j-1)*nel + i
162 sigb(jj) = sigsh(kk,ii)
163 ENDDO
164 DO j = 1,l_sigb
165 kk = kk + 1
166 jj = (j-1)*nel + i
167 sigc(jj) = sigsh(kk,ii)
168 ENDDO
169 ENDDO
170 ENDDO ! DO ILAY=1,NPT
171c
172 ELSE IF (elbuf_str%BUFLY(1)%ILAW == 87) THEN ! backstress is no more stored in uvar
173 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
174 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
175 kk = nvshell + 4 +(ipg-1)*nvars*npi
176c
177 DO ilay=1,nlay
178 bufly => elbuf_str%BUFLY(ilay)
179 nptt = bufly%NPTT
180 DO it=1,nptt
181 uvar => bufly%MAT(ir,is,it)%VAR
182
183 sigb => bufly%LBUF(ir,is,it)%SIGB
184c
185 DO nu = 1,nuvar
186 kk = kk + 1
187 jj = (nu-1)*nel + i
188 uvar(jj) = sigsh(kk,ii)
189 ENDDO
190 DO j = 1,l_sigb
191 kk = kk + 1
192 jj = (j-1)*nel + i
193 sigb(jj) = sigsh(kk,ii)
194 ENDDO
195 ENDDO
196 ENDDO ! DO ILAY=1,NPT
197c
198 ELSE IF (elbuf_str%BUFLY(1)%ILAW == 112) THEN
199 kk = nvshell + 4 +(ipg-1)*nvars*npi
200 DO ilay=1,nlay
201 nptt = elbuf_str%BUFLY(ilay)%NPTT
202 DO it=1,nptt
203 DO j = 1,3
204 kk = kk + 1
205 jj = i + j*nel
206 elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)%PLA(jj) = sigsh(kk,ii)
207 ENDDO
208 ENDDO
209 ENDDO ! DO ILAY=1,NPT
210c
211 ELSE ! ILAW
212 ipt_all = 0
213 DO ilay=1,nlay
214 nptt = elbuf_str%BUFLY(ilay)%NPTT
215 nuvar = elbuf_str%BUFLY(ilay)%NVAR_MAT
216 DO it=1,nptt
217 ipt = ipt_all + it
218 uvar => elbuf_str%BUFLY(ilay)%MAT(ir,is,it)%VAR
219 DO nu = 1,min(nvars,nuvar)
220 uvar((nu -1)*nel + i) =
221 . sigsh(nvshell+4+(ipg-1)*nvars*npi+(ipt-1)*nvars+nu,ii)
222 ENDDO
223 ENDDO
224 ipt_all = ipt_all + nptt
225 ENDDO ! DO ILAY=1,NPT
226 END IF ! ILAW
227c
228 ELSE
229 ENDIF ! IF (NPI > 0)
230 ELSE
231 ENDIF ! IF (NPGI > 0)
232 ENDIF ! IF ((NPGI /= NPG.OR.NPI /= NPT) .AND. IGTYP /= 51)
233C
234200 CONTINUE
235C
236 ENDDO ! DO I=JFT,JLT
237C---
238 RETURN
239 END
cuserini4
subroutine cuserini4(elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)
Definition cuserini4.F:39
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804