OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cuserini4.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cuserini4 (elbuf_str, jft, jlt, nft, nel, istrain, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, ir, is, npt, igtyp, igeo, nlay, npg, ipg)

Function/Subroutine Documentation

◆ cuserini4()

subroutine cuserini4 ( type(elbuf_struct_), target elbuf_str,
integer jft,
integer jlt,
integer nft,
integer nel,
integer istrain,
sigsh,
integer nsigsh,
integer numel,
integer, dimension(nix,*) ix,
integer nix,
integer numsh,
integer, dimension(*) ptsh,
integer ir,
integer is,
integer npt,
integer igtyp,
integer, dimension(npropgi,*) igeo,
integer nlay,
integer npg,
integer ipg )

Definition at line 34 of file cuserini4.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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