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

Go to the source code of this file.

Functions/Subroutines

subroutine cuserini (elbuf_str, jft, jlt, nft, nel, npt, istrain, sigsh, numel, ix, nix, nsigsh, numsh, ptsh, ir, is, nlay)

Function/Subroutine Documentation

◆ cuserini()

subroutine cuserini ( type(elbuf_struct_), target elbuf_str,
integer jft,
integer jlt,
integer nft,
integer nel,
integer npt,
integer istrain,
sigsh,
integer numel,
integer, dimension(nix,*) ix,
integer nix,
integer nsigsh,
integer numsh,
integer, dimension(*) ptsh,
integer ir,
integer is,
integer nlay )

Definition at line 31 of file cuserini.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40C-----------------------------------------------
41C ROUTINE GENERIQUE 4NOEUDS-3NOEUDS
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER JFT,JLT,NUMEL,NIX,NFT,NPT,ISTRAIN,IR,IS,NLAY,NSIGSH,
54 . NEL,NUMSH,ILAW
55 INTEGER IX(NIX,*),PTSH(*)
56 my_real
57 . sigsh(nsigsh,*)
58 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
59C------------------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 INTEGER I,J,II,JJ,KK,N,NPTI,NU,NIP,NUVAR,NVARS,NPG,IPT,
63 . IPT_ALL,IT,ILAY,NPTT,L_SIGB
64 TYPE(L_BUFEL_) ,POINTER :: LBUF
65 TYPE(BUF_LAY_) ,POINTER :: BUFLY
66 my_real, DIMENSION(:), POINTER :: uvar,siga,sigb,sigc
67C=======================================================================
68 DO i=jft,jlt
69 IF (abs(isigi) /=3 .AND. abs(isigi)/=4 .AND. abs(isigi)/=5)THEN
70 ii = i+nft
71 n = nint(sigsh(1,ii))
72 IF(n == ix(nix,ii))THEN
73 jj = ii
74 ELSE
75 jj = ii
76 DO j = 1,numel
77 ii= j
78 n = nint(sigsh(1,ii))
79 IF(n == 0) GOTO 200
80 IF(n == ix(nix,jj))GOTO 70
81 ENDDO
82 GOTO 200
83 70 CONTINUE
84 ENDIF
85 ELSE
86 jj=nft+i
87 n =ix(nix,jj)
88 ii=ptsh(jj)
89 IF(ii == 0)GOTO 200
90 END IF
91 nip = nint(sigsh(nvshell + 2,ii))
92 npg = nint(sigsh(nvshell + 3,ii))
93 nvars= nint(sigsh(nvshell + 4,ii))
94 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
95c
96 IF (elbuf_str%BUFLY(1)%ILAW == 36) THEN ! backstress is no more stored in uvar
97 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
98 IF (nvars > 3 .and. nip > 0 .and. l_sigb > 0) THEN
99 ipt_all = 0
100 DO ilay=1,nlay
101 bufly => elbuf_str%BUFLY(ilay)
102 nptt = bufly%NPTT
103 nuvar = bufly%NVAR_MAT
104 DO it=1,nptt
105 sigb => bufly%LBUF(ir,is,it)%SIGB
106 ipt = ipt_all + it
107 DO j = 1,3
108 jj = (j-1)*nel + i
109 sigb(jj) = sigsh(nvshell + 4 + (ipt -1)*nvars + j ,ii)
110 ENDDO
111 ENDDO
112 ipt_all = ipt_all + nptt
113 ENDDO ! DO ILAY=1,NPT
114 ENDIF
115c
116 ELSE IF (elbuf_str%BUFLY(1)%ILAW == 78) THEN ! backstress is no more stored in uvar
117 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
118 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
119 ipt_all = 0
120 DO ilay=1,nlay
121 bufly => elbuf_str%BUFLY(ilay)
122 nptt = bufly%NPTT
123 DO it=1,nptt
124 ipt = ipt_all + it
125 uvar => bufly%MAT(ir,is,it)%VAR
126 siga => bufly%LBUF(ir,is,it)%SIGA
127 sigb => bufly%LBUF(ir,is,it)%SIGB
128 sigc => bufly%LBUF(ir,is,it)%SIGC
129 kk = nvshell + 4 + (ipt-1)*nvars
130 DO nu = 1,nuvar
131 jj = (nu-1)*nel + i
132 uvar(jj) = sigsh(kk + nu,ii)
133 ENDDO
134 kk = kk + nuvar
135 DO j = 1,l_sigb
136 jj = (j-1)*nel + i
137 siga(jj) = sigsh(kk + j ,ii)
138 ENDDO
139 DO j = 1,l_sigb
140 jj = (j-1)*nel + i
141 sigb(jj) = sigsh(kk + l_sigb + j ,ii)
142 ENDDO
143 DO j = 1,l_sigb
144 jj = (j-1)*nel + i
145 sigc(jj) = sigsh(kk + l_sigb*2 + j ,ii)
146 ENDDO
147 ENDDO
148 ipt_all = ipt_all + nptt
149 ENDDO ! DO ILAY=1,NPT
150c
151 ELSE IF (elbuf_str%BUFLY(1)%ILAW == 87) THEN ! backstress is no more stored in uvar
152 l_sigb = elbuf_str%BUFLY(1)%L_SIGB
153 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
154 ipt_all = 0
155 DO ilay=1,nlay
156 bufly => elbuf_str%BUFLY(ilay)
157 nptt = bufly%NPTT
158 DO it=1,nptt
159 ipt = ipt_all + it
160 uvar => bufly%MAT(ir,is,it)%VAR
161 sigb => bufly%LBUF(ir,is,it)%SIGB
162 kk = nvshell + 4 + (ipt-1)*nvars
163
164 DO nu = 1,nuvar
165 jj = (nu-1)*nel + i
166 uvar(jj) = sigsh(kk + nu,ii)
167 ENDDO
168 kk = kk + nuvar
169 DO j = 1,l_sigb
170 jj = (j-1)*nel + i
171 sigb(jj) = sigsh(kk + j ,ii)
172 ENDDO
173 ENDDO
174 ipt_all = ipt_all + nptt
175 ENDDO ! DO ILAY=1,NPT
176c
177 ELSE IF (elbuf_str%BUFLY(1)%ILAW == 112) THEN ! backstress is no more stored in uvar
178 ipt_all = 0
179 DO ilay=1,nlay
180 nptt = elbuf_str%BUFLY(ilay)%NPTT
181 DO it=1,nptt
182 ipt = ipt_all + it
183 kk = nvshell + 4 + (ipt-1)*nvars
184 DO j = 1,3
185 jj = i + j*nel
186 elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)%PLA(jj) = sigsh(kk + j,ii)
187 ENDDO
188 ENDDO
189 ipt_all = ipt_all + nptt
190 ENDDO ! DO ILAY=1,NPT
191c
192 ELSE IF (npg <= 1) THEN
193 IF (nip == 0) THEN
194 uvar => elbuf_str%BUFLY(1)%MAT(ir,is,1)%VAR
195 DO nu = 1,min(nvars,nuvar)
196 uvar((nu -1)*nel + i) = sigsh(nvshell + 4 + nu, ii)
197 ENDDO
198 ELSE
199 ipt_all = 0
200 DO ilay=1,nlay
201 nptt = elbuf_str%BUFLY(ilay)%NPTT
202 nuvar = elbuf_str%BUFLY(ilay)%NVAR_MAT
203 DO it=1,nptt
204 ipt = ipt_all + it
205 uvar => elbuf_str%BUFLY(ilay)%MAT(ir,is,it)%VAR
206 DO nu = 1,min(nvars,nuvar)
207 uvar((nu -1)*nel + i) =
208 . sigsh(nvshell + 4 + nu + (ipt -1)*nvars , ii)
209 ENDDO
210 ENDDO
211 ipt_all = ipt_all + nptt
212 ENDDO ! DO ILAY=1,NPT
213c
214 ENDIF
215 ENDIF
216 200 CONTINUE
217 ENDDO
218C-----------
219 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20