OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sgrtails.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "sms_c.inc"
#include "scr17_c.inc"
#include "r2r_c.inc"
#include "sphcom.inc"
#include "boltpr_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sgrtails (ixs, pm, iparg, geo, eadd, nd, iparts, dd_iad, idx, isolnod, inum, index, cep, itr1, ixs10, igrsurf, igrbric, ixs20, ixs16, igeo, iddlevel, ipm, nod2els, isoloff, isolnod1, tagprt_sms, inivol, sph2sol, sol2sph, sol2sph_typ, iflag_bpreload, clusters, matparam_tab, rnoise, print_flag, damp_range_part, ipreload_fun)

Function/Subroutine Documentation

◆ sgrtails()

subroutine sgrtails ( integer, dimension(11,*) ixs,
pm,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(*) eadd,
integer nd,
integer, dimension(*) iparts,
integer, dimension(nspmd+1,*) dd_iad,
integer idx,
integer, dimension(*) isolnod,
integer, dimension(16,*) inum,
integer, dimension(*) index,
integer, dimension(*) cep,
integer, dimension(*) itr1,
integer, dimension(6,*) ixs10,
type (surf_), dimension(nsurf) igrsurf,
type (group_), dimension(ngrbric) igrbric,
integer, dimension(12,*) ixs20,
integer, dimension(8,*) ixs16,
integer, dimension(npropgi,numgeo) igeo,
integer, intent(in) iddlevel,
integer, dimension(npropmi,nummat) ipm,
integer, dimension(*) nod2els,
integer, dimension(*) isoloff,
integer, dimension(*) isolnod1,
integer, dimension(*) tagprt_sms,
type (inivol_struct_), dimension(num_inivol) inivol,
integer, dimension(*) sph2sol,
integer, dimension(2,*) sol2sph,
integer, dimension(*) sol2sph_typ,
integer, dimension(*) iflag_bpreload,
type (cluster_), dimension(ncluster) clusters,
type(matparam_struct_), dimension(nummat), intent(in), target matparam_tab,
rnoise,
integer, intent(in) print_flag,
integer, dimension(npart), intent(in) damp_range_part,
integer, dimension(2,numpreload), intent(in) ipreload_fun )
Parameters
[in]print_flagflag to print the element group data
[in]damp_range_partflag to compute the damping range

Definition at line 41 of file sgrtails.F.

51C-----------------------------------------------
52C A n a l y s e M o d u l e
53C-----------------------------------------------
54 USE my_alloc_mod
55 USE message_mod
56 USE r2r_mod
57 USE reorder_mod
58 USE groupdef_mod
59 USE cluster_mod
60 USE matparam_def_mod
61 USE inivol_def_mod , ONLY : inivol_struct_, num_inivol
62 USE qa_out_mod
63 USE names_and_titles_mod , ONLY : nchartitle
64 USE ale_mod , ONLY : ale
65 use element_mod , only : nixs
66C-----------------------------------------------
67C A R G U M E N T S
68C-----------------------------------------------
69C IXS(11,NUMELS) ARRAY: CONECS+PID+MID+NOS SOLIDS E
70C PM(NPROPM,NUMMAT) ARRAY: MATERIAL PARAMETERS (real) E
71C IPM(NPROPMI,NUMMAT) ARRAY: MATERIAL PARAMETERS (integer) E
72C GEO(NPROPG,NUMGEO) ARRAY: PROPERTY PARAMETERS (real) E
73C IGEO(NPROPGI,NUMGEO) ARRAY: PROPERTY PARAMETERS (integer) E
74C IPARG(NPARG,NGROUP) ARRAY: GROUP PARAMETERS (itneger) E/S
75C EADD(NUMELS) ARRAY: IDAM indexes / checkboard S
76C DD_IAD ARRAY: FROM DD IN SUPER GROUPS S
77C IPARTS E/S
78C INUM(13,NUMELS) ARRAY:WORKING E/S
79C INDEX(NUMELS) ARRAY:WORKING E/S
80C CEP(NUMELS) ARRAY:WORKING E/S
81C ITR1(NSELS) ARRAY:WORKING E/S
82C ISOLOFF(NUMELS) FLAG ELEM RBY ON/OFF E/S
83C-----------------------------------------------
84C I M P L I C I T T Y P E S
85C-----------------------------------------------
86#include "implicit_f.inc"
87C-----------------------------------------------
88C C O M M O N B L O C K S
89C-----------------------------------------------
90#include "vect01_c.inc"
91#include "com01_c.inc"
92#include "com04_c.inc"
93#include "units_c.inc"
94#include "param_c.inc"
95#include "sms_c.inc"
96#include "scr17_c.inc"
97#include "r2r_c.inc"
98#include "sphcom.inc"
99#include "boltpr_c.inc"
100C-----------------------------------------------
101C D U M M Y A R G U M E N T S
102C-----------------------------------------------
103 INTEGER ND, IDX
104 INTEGER IXS(11,*),IPARG(NPARG,*),EADD(*), ISOLNOD(*),
105 . DD_IAD(NSPMD+1,*),IPARTS(*),
106 . INUM(16,*), INDEX(*),CEP(*),ITR1(*),IXS10(6,*),IXS20(12,*),
107 . IXS16(8,*),IGEO(NPROPGI,NUMGEO),IPM(NPROPMI,NUMMAT),
108 . NOD2ELS(*), ISOLOFF(*),ISOLNOD1(*),
109 . TAGPRT_SMS(*),SPH2SOL(*),
110 . SOL2SPH(2,*),SOL2SPH_TYP(*),IFLAG_BPRELOAD(*)
111 INTEGER, INTENT(IN) :: IDDLEVEL
112 INTEGER, INTENT(IN) :: PRINT_FLAG !< flag to print the element group data
113 INTEGER, INTENT(IN) :: DAMP_RANGE_PART(NPART) !< flag to compute the damping range
114 TYPE(MATPARAM_STRUCT_) , TARGET, DIMENSION(NUMMAT),INTENT(IN) :: MATPARAM_TAB
115 my_real pm(npropm,nummat), geo(npropg,numgeo), rnoise(nperturb,numels)
116 INTEGER, DIMENSION(2,NUMPRELOAD),INTENT(IN) :: IPRELOAD_FUN
117C-----------------------------------------------
118 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
119 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
120 TYPE (INIVOL_STRUCT_) , DIMENSION(NUM_INIVOL) :: INIVOL
121 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTERS
122C-----------------------------------------------
123C L O C A L V A R I A B L E S
124C-----------------------------------------------
125 INTEGER
126 . NGR1, MLN, NG, ISSN, ISSN_, N, MID, PID, II,ILOC,IL,NEL, NE1,IREP,IINT,
127 . P, NEL_PREC, IGT, JHBE, I, IKSNOD0,NB,IEOS,NLAY,
128 . MODE, WORK(70000), NN, J, NPTR,NPTS,NPTT,NPG,
129 . IPLAST,NUVARP, INEG, JIVF,ICPRE,ICSTR,
130 . IFAIL,IMATVIS,NLY,NL,ILAW,IM,IPMAT,ITET4,ITET10,
131 . NGP(NSPMD+1),JJ,IFAILMODEL,NFAIL,ISVIS,IVISC,IMAT,
132 . INUM_R2R(1+R2R_SIU*NUMELS),IPARTSPH,IPARTR2R,MFT,IBOLTP,ICP0,ISM0,
133 . IPERT,STAT,ITSH,IT10,ICPT10,JALE_FROM_MAT,JALE_FROM_PROP,IDAMP_FREQ_RANGE
134 DATA ipmat /100/
135 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEXS2
136 INTEGER ID
137 CHARACTER(LEN=NCHARTITLE)::TITR
138 INTEGER :: CLUSTER_TYP,CLUSTER_NEL
139 INTEGER, DIMENSION(:), ALLOCATABLE :: SAVE_CLUSTER
140 my_real, DIMENSION(:,:), ALLOCATABLE :: xnum_rnoise
141 TYPE(MATPARAM_STRUCT_) , POINTER :: MATPARAM
142 LOGICAL lFOUND
143 INTEGER :: NB_NODES, LDIM, OFFSET
144C--------------------------------------------------------------
145C GROUPING BY MVSIZ GROUPS
146C--------------------------------------------------------------
147 CALL my_alloc(indexs2,numels)
148 nullify(matparam)
149 indexs2(1:numels)=permutation%SOLID(1:numels)
150 ngr1 = ngroup + 1
151C
152 IF (nperturb > 0) THEN
153 ALLOCATE(xnum_rnoise(nperturb,numels),stat=stat)
154 IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
155 . msgtype=msgerror,
156 . c1='XNUM_RNOISE')
157 ELSE
158 ALLOCATE(xnum_rnoise(0,0))
159 ENDIF
160C
161C Phase 1: Domain Decomposition
162C
163 idx=idx+nd*(nspmd+1)
164 CALL zeroin(1,nd*(nspmd+1),dd_iad(1,nspgroup+1))
165C NSPGROUP = NSPGROUP + ND
166 nft = 0
167C initialization dd_iad
168 DO n=1,nd
169 DO p=1,nspmd+1
170 dd_iad(p,nspgroup+n) = 0
171 END DO
172 ENDDO
173C
174 DO i=1,numels
175 isolnod1(i) = isolnod(i)
176 ENDDO
177C
178 DO n=1,nd
179 nel = eadd(n+1)-eadd(n)
180C
181 DO i = 1, nel
182 index(i) = i
183 inum(1,i)=iparts(nft+i)
184 inum(2,i)=ixs(1,nft+i)
185 inum(3,i)=ixs(2,nft+i)
186 inum(4,i)=ixs(3,nft+i)
187 inum(5,i)=ixs(4,nft+i)
188 inum(6,i)=ixs(5,nft+i)
189 inum(7,i)=ixs(6,nft+i)
190 inum(8,i)=ixs(7,nft+i)
191 inum(9,i)=ixs(8,nft+i)
192 inum(10,i)=ixs(9,nft+i)
193 inum(11,i)=ixs(10,nft+i)
194 inum(12,i)=ixs(11,nft+i)
195 inum(13,i)=isolnod(nft+i)
196 IF (nsubdom>0) inum_r2r(i) = tag_elsf(nft+i)
197 IF (nperturb > 0) THEN
198 DO ipert = 1, nperturb
199 xnum_rnoise(ipert,i) = rnoise(ipert,nft+i)
200 ENDDO
201 ENDIF
202 ENDDO
203C
204 IF(nsphsol /= 0 .AND. nft < numels8)THEN
205 DO i=1, nel
206 inum(14,i)=sol2sph(1,nft+i)
207 inum(15,i)=sol2sph(2,nft+i)
208 inum(16,i)=sol2sph_typ(nft+i)
209 ENDDO
210 END IF
211
212 IF(doqa .NE. 0 .OR. iddlevel == 0) THEN
213 mode=0
214 CALL my_orders( mode, work, cep(nft+1), index, nel , 1)
215 ELSE
216 nb_nodes = 8 ! 8 nodes for solids
217 ldim = 16 ! fist dimension of INUM
218 offset = 2 ! nodes starts at INUM(3,I)
219 CALL cpp_reorder_elements(nel, nspmd, nb_nodes, offset, ldim , cep(nft+1), inum, index)
220 ENDIF
221
222 DO i = 1, nel
223 permutation%SOLID(i+nft)=indexs2(index(i)+nft)
224 iparts(i+nft)=inum(1,index(i))
225 ixs(1,i+nft)=inum(2,index(i))
226 ixs(2,i+nft)=inum(3,index(i))
227 ixs(3,i+nft)=inum(4,index(i))
228 ixs(4,i+nft)=inum(5,index(i))
229 ixs(5,i+nft)=inum(6,index(i))
230 ixs(6,i+nft)=inum(7,index(i))
231 ixs(7,i+nft)=inum(8,index(i))
232 ixs(8,i+nft)=inum(9,index(i))
233 ixs(9,i+nft)=inum(10,index(i))
234 ixs(10,i+nft)=inum(11,index(i))
235 ixs(11,i+nft)=inum(12,index(i))
236 isolnod(i+nft)=inum(13,index(i))
237 itr1(nft+index(i)) = nft+i
238 IF (nsubdom>0) tag_elsf(nft+i) = inum_r2r(index(i))
239 IF (nperturb > 0) THEN
240 DO ipert = 1, nperturb
241 rnoise(ipert,i+nft) = xnum_rnoise(ipert,index(i))
242 ENDDO
243 ENDIF
244 ENDDO
245C
246C Renumarotation ISOLOFF
247C
248 DO i = 1, nel
249 inum(3,i) = isoloff(nft+i)
250 END DO
251C
252 DO i = 1, nel
253 isoloff(nft+i) = inum(3,index(i))
254 END DO
255c
256c Renum. BoltPreload
257c
258 IF (npreload > 0) THEN
259 DO i=1,nel
260 inum(4,i)=iflag_bpreload(nft+i)
261 ENDDO
262
263 DO i=1,nel
264 iflag_bpreload(nft+i)=inum(4,index(i))
265 ENDDO
266 ENDIF
267
268C
269 IF (nft>=numels8+numels10+numels20) THEN
270 DO i = 1, nel
271 ii = i+nft-(numels8+numels10+numels20)
272 inum(1,i)=ixs16(1,ii)
273 inum(2,i)=ixs16(2,ii)
274 inum(3,i)=ixs16(3,ii)
275 inum(4,i)=ixs16(4,ii)
276 inum(5,i)=ixs16(5,ii)
277 inum(6,i)=ixs16(6,ii)
278 inum(7,i)=ixs16(7,ii)
279 inum(8,i)=ixs16(8,ii)
280 ENDDO
281 DO i = 1, nel
282 ii = i+nft-(numels8+numels10+numels20)
283 ixs16(1,ii)=inum(1,index(i))
284 ixs16(2,ii)=inum(2,index(i))
285 ixs16(3,ii)=inum(3,index(i))
286 ixs16(4,ii)=inum(4,index(i))
287 ixs16(5,ii)=inum(5,index(i))
288 ixs16(6,ii)=inum(6,index(i))
289 ixs16(7,ii)=inum(7,index(i))
290 ixs16(8,ii)=inum(8,index(i))
291 ENDDO
292 ELSEIF (nft>=numels8+numels10) THEN
293 DO i = 1, nel
294 ii = i+nft-(numels8+numels10)
295 inum(1,i)=ixs20(1,ii)
296 inum(2,i)=ixs20(2,ii)
297 inum(3,i)=ixs20(3,ii)
298 inum(4,i)=ixs20(4,ii)
299 inum(5,i)=ixs20(5,ii)
300 inum(6,i)=ixs20(6,ii)
301 inum(7,i)=ixs20(7,ii)
302 inum(8,i)=ixs20(8,ii)
303 inum(9,i)=ixs20(9,ii)
304 inum(10,i)=ixs20(10,ii)
305 inum(11,i)=ixs20(11,ii)
306 inum(12,i)=ixs20(12,ii)
307 ENDDO
308 DO i = 1, nel
309 ii = i+nft-(numels8+numels10)
310 ixs20(1,ii)=inum(1,index(i))
311 ixs20(2,ii)=inum(2,index(i))
312 ixs20(3,ii)=inum(3,index(i))
313 ixs20(4,ii)=inum(4,index(i))
314 ixs20(5,ii)=inum(5,index(i))
315 ixs20(6,ii)=inum(6,index(i))
316 ixs20(7,ii)=inum(7,index(i))
317 ixs20(8,ii)=inum(8,index(i))
318 ixs20(9,ii)=inum(9,index(i))
319 ixs20(10,ii)=inum(10,index(i))
320 ixs20(11,ii)=inum(11,index(i))
321 ixs20(12,ii)=inum(12,index(i))
322 ENDDO
323 ELSEIF (nft>=numels8) THEN
324 DO i = 1, nel
325 ii = i+nft-numels8
326 inum(1,i)=ixs10(1,ii)
327 inum(2,i)=ixs10(2,ii)
328 inum(3,i)=ixs10(3,ii)
329 inum(4,i)=ixs10(4,ii)
330 inum(5,i)=ixs10(5,ii)
331 inum(6,i)=ixs10(6,ii)
332 ENDDO
333 DO i = 1, nel
334 ii = i+nft-numels8
335 ixs10(1,ii)=inum(1,index(i))
336 ixs10(2,ii)=inum(2,index(i))
337 ixs10(3,ii)=inum(3,index(i))
338 ixs10(4,ii)=inum(4,index(i))
339 ixs10(5,ii)=inum(5,index(i))
340 ixs10(6,ii)=inum(6,index(i))
341 ENDDO
342 ENDIF
343C
344C RENUMBERING FOR SPH CONVERSION
345C
346 IF(nsphsol /= 0 .AND. nft < numels8)THEN
347C
348C rebuild SOL2SPH
349 DO i=1,nel
350 sol2sph(1,nft+i)=inum(14,index(i))
351 sol2sph(2,nft+i)=inum(15,index(i))
352 sol2sph_typ(nft+i)=inum(16,index(i))
353 END DO
354 END IF
355C
356 p = cep(nft+index(1))
357 nb = 1
358 DO i = 2, nel
359 IF (cep(nft+index(i))/=p) THEN
360 dd_iad(p+1,nspgroup+n) = nb
361 nb = 1
362 p = cep(nft+index(i))
363 ELSE
364 nb = nb + 1
365 ENDIF
366 ENDDO
367 dd_iad(p+1,nspgroup+n) = nb
368 DO p = 2, nspmd
369 dd_iad(p,nspgroup+n) = dd_iad(p,nspgroup+n)
370 . + dd_iad(p-1,nspgroup+n)
371 ENDDO
372 DO p = nspmd+1,2,-1
373 dd_iad(p,nspgroup+n) = dd_iad(p-1,nspgroup+n)+1
374 ENDDO
375 dd_iad(1,nspgroup+n) = 1
376C
377C update CEP
378C
379 DO i = 1, nel
380 index(i) = cep(nft+index(i))
381 ENDDO
382 DO i = 1, nel
383 cep(nft+i) = index(i)
384 ENDDO
385 nft = nft + nel
386 ENDDO
387
388C
389C RENUMBERING FOR SURFACES
390C
391 DO i=1,nsurf
392 nn=igrsurf(i)%NSEG
393 DO j=1,nn
394 IF (igrsurf(i)%ELTYP(j) == 1)
395 . igrsurf(i)%ELEM(j) = itr1(igrsurf(i)%ELEM(j))
396 ENDDO
397 ENDDO
398C
399C RENUMBERING FOR SOLID GROUPS
400C
401 DO i=1,ngrbric
402 nn=igrbric(i)%NENTITY
403 DO j=1,nn
404 igrbric(i)%ENTITY(j) = itr1(igrbric(i)%ENTITY(j))
405 ENDDO
406 ENDDO
407C
408C RENUMBERING FOR SPH CONVERSION
409C
410 IF(nsphsol /= 0)THEN
411 DO i=1,numsph
412 IF(sph2sol(i) /= 0)sph2sol(i)=itr1(sph2sol(i))
413 ENDDO
414 END IF
415C
416C renumbering INVERSE CONNECTIVITY
417C
418 DO i=1,8*numels+6*numels10+12*numels20+8*numels16
419 IF(nod2els(i) /= 0)nod2els(i)=itr1(nod2els(i))
420 END DO
421
422
423! -----------------------
424! reordering for cluster typ=1 (solid cluster)
425 DO i=1,ncluster
426 cluster_typ = clusters(i)%TYPE
427 IF(cluster_typ==1) THEN
428 cluster_nel = clusters(i)%NEL
429 ALLOCATE( save_cluster( cluster_nel ) )
430 save_cluster( 1:cluster_nel ) = clusters(i)%ELEM( 1:cluster_nel )
431 DO j=1,cluster_nel
432 clusters(i)%ELEM(j) = itr1( save_cluster( j ) )
433 ENDDO
434 DEALLOCATE( save_cluster )
435 ENDIF
436 ENDDO
437! -----------------------
438
439C
440C phase 2 : grouping by MVSIZ groups
441C ngroup is global, iparg is global but organized according to dd
442C
443
444 ineg = 0
445 DO 300 n=1,nd
446 nft = 0
447 DO p = 1, nspmd
448 icpt10 = -huge(icpt10)
449 ngp(p)=0
450 nel = dd_iad(p+1,nspgroup+n)-dd_iad(p,nspgroup+n)
451 IF (nel>0) THEN
452 nel_prec = dd_iad(p,nspgroup+n)-dd_iad(1,nspgroup+n)
453 ngp(p)=ngroup
454 ng = (nel-1)/nvsiz + 1
455 DO 220 i=1,ng
456C ngroup global
457 ngroup=ngroup+1
458 CALL zeroin(1,nparg,iparg(1,ngroup))
459 ii = eadd(n)+nft
460 mid = ixs(1,ii)
461 pid = ixs(nixs-1,ii)
462C damping frequency range apply to group
463 idamp_freq_range = damp_range_part(iparts(ii))
464C Bolt preloading
465 iboltp=0
466 IF (npreload > 0) THEN
467 iboltp=iflag_bpreload(ii)
468 ENDIF
469 ipartr2r = 0
470 IF (nsubdom>0) ipartr2r = tag_mat(mid)
471 id = igeo(1,pid)
472 CALL fretitl2(titr,igeo(npropgi-ltitr+1,pid),ltitr)
473 iksnod0=isolnod(ii)
474C we may need isolnod in case of return to the d.d.
475C moreover ISOLNOD reset to 0 real in lectur
476 npt=1
477 jivf=0
478 nuvarp=0
479 jhbe= 1
480 jpor=0
481 jclos=0
482 iplast= 1
483 icpre=0
484 icstr=0
485 irep = 0
486 iint = 0
487 jcvt = 0
488 isorth=0
489 istrain=0
490 isvis = 0
491 ipartsph=0
492 ivisc = 0
493 itsh = 0
494 it10 = 0
495 itet4 = 0
496 itet10 = 0
497C-------------------------
498C GROUP PARAMETER
499 IF (pid/=0) THEN
500 irep = igeo(6,pid)
501 jhbe = igeo(10,pid)
502 igt = igeo(11,pid)
503 npt = igeo(4,pid)
504 issn = igeo(5,pid)
505 iint = igeo(15,pid)
506 jcvt = igeo(16,pid)
507 isorth = igeo(17,pid)
508 istrain= igeo(12,pid)
509 itet4 = igeo(20,pid)
510 itet10 = igeo(50,pid)
511c
512 isvis = igeo(33,pid)
513 ipartsph=igeo(38,pid)
514C
515 IF ((issn == 10.OR.issn == 11).AND.(igt == 14.OR.igt == 6)) THEN
516 IF (iksnod0/=4 .AND. iksnod0/=8.AND. iksnod0/=10 ) THEN
517 CALL ancmsg(msgid=1159,
518 . msgtype=msgerror,
519 . anmode=aninfo_blind_2,
520 . i1=id,
521 . c1=titr,
522C . I2=IKSNOD0,
523 . i3=jhbe)
524 ENDIF
525 ENDIF
526C
527 IF (jhbe == 222) THEN
528 IF (iksnod0 == 8) THEN
529 jhbe= 14
530 ELSEIF (iksnod0 == 16 .OR. iksnod0 == 20) THEN
531 jhbe= 16
532 ENDIF
533 ENDIF
534C
535 IF (jhbe == 12) THEN
536 IF (issn == 10.OR.issn == 11) THEN
537 CALL ancmsg(msgid=1159,
538 . msgtype=msgerror,
539 . anmode=aninfo_blind_2,
540 . i1=id,
541 . c1=titr,
542 . i2=jhbe)
543 ENDIF
544 IF (iksnod0 == 4 .OR. iksnod0 == 10) THEN
545 jhbe= 1
546 ELSE
547 CALL ancmsg(msgid=1160,
548 . msgtype=msgwarning,
549 . anmode=aninfo_blind_2,
550 . i1=id,
551 . c1=titr,
552 . prmod=msg_cumu)
553 ENDIF
554 ENDIF
555
556 IF (igt == 15) jpor = 2*nint(geo(28,pid))
557 IF (geo(130,pid) > 0) jclos=1
558 IF (igt > 28) nuvarp = nint(geo(25,pid))
559 IF (igt /= 15) THEN
560 iplast = igeo(9,pid)
561 icpre = igeo(13,pid)
562 icstr = igeo(14,pid)
563 icpt10 = icpre
564 ENDIF
565 IF (igt == 14.OR.igt == 6) THEN
566 IF (itet4/=0.AND.iksnod0 == 8) THEN
567 itet4=0
568 END IF
569 IF (itet10/=0.AND.iksnod0 == 8) THEN
570 itet10=0
571 END IF
572 END IF
573 ENDIF
574C
575 mln = nint(pm(19,abs(mid)))
576 IF(mln == 20)THEN
577 IF(iparg(5,ngroup)/=2)THEN
578 CALL ancmsg(msgid=129,
579 . msgtype=msgerror,
580 . anmode=aninfo)
581 CALL arret(2)
582 ENDIF
583 ENDIF
584C
585 IF(mid<0)THEN
586 IF(mln == 6.AND.jpor/=2)mln=17
587 IF(mln == 46)mln=47
588 mid=abs(mid)
589 ixs(1,ii)=mid
590 ineg = 1
591 ENDIF
592c
593 matparam => matparam_tab(mid)
594 IF(igt == 6 .AND. mln == 70) THEN
595 CALL ancmsg(msgid=1221,
596 . msgtype=msgerror,
597 . anmode=aninfo_blind_1,
598 . i1=id,
599 . c1=titr,
600 . i2=igt,
601 . i3=mln)
602
603 ENDIF
604 IF(igt == 0 .AND. mln /= 0) THEN
605 CALL ancmsg(msgid=1586,
606 . msgtype=msgerror,
607 . anmode=aninfo_blind_1,
608 . i1=ipm(1,mid),
609 . i2=id,
610 . prmod=msg_cumu)
611 ENDIF
612 IF (jhbe == 24 .AND. igt == 6) THEN
613 IF(mln /= 14 .AND. mln /= 12 .AND. mln /= 25 .AND.
614 . mln /= 28 .AND. mln /= 50 .AND. mln /= 68 .AND.
615 . mln /= 53 .AND. mln /= 93 .AND. mln /= 107 .AND.
616 . mln /= 112.AND. mln /= 122 .AND. mln /= 127 .AND. mln /= 128) THEN
617
618 CALL ancmsg(msgid=1225,
619 . msgtype=msgwarning,
620 . anmode=aninfo_blind_2,
621 . i1=id,
622 . c1=titr,
623 . i2=mln,
624 . prmod=msg_cumu)
625 END IF
626 ENDIF
627C
628 ! Compatibility with /MAT/LAW115 statistic formulation
629 IF ((mln == 115).AND.(((jhbe>2).AND.(jhbe<21)).OR.((itet4>0).AND.(itet4<3)))) THEN
630 CALL ancmsg(msgid=1905,
631 . msgtype=msgwarning,
632 . anmode=aninfo_blind_2,
633 . i1=id,
634 . c1=titr,
635 . i2=mln,
636 . prmod=msg_cumu)
637 ENDIF
638C
639 ifail = 0
640 nfail = 0
641 IF (igt == 22) THEN
642 nlay = igeo(30,pid)
643 DO il=1,nlay
644 imat = igeo(100+il,pid)
645 nfail = max(nfail,matparam_tab(imat)%NFAIL)
646 ENDDO
647 ELSE
648 nfail = matparam_tab(mid)%NFAIL
649 ENDIF
650c
651 IF (nfail > 0)THEN
652 ifail = 1
653 IF(mln /= 25 .AND. mln < 28) THEN
654 DO j=1,nfail
655 ifailmodel = ipm(111 + 15*(j - 1) ,mid)
656 IF (ifailmodel == 10 .OR. ifailmodel == 4
657 . .OR.ifailmodel == 5 .OR. ifailmodel == 6)istrain = 1
658 ENDDO
659 ENDIF
660 ENDIF
661 IF(iksnod0 == 10.OR.
662 . (iksnod0 == 4.AND.itet4 == 1))THEN
663 npt=4
664 it10 =1
665 ELSEIF(iksnod0 == 4)THEN
666 npt=1
667 ENDIF
668 IF ((jhbe/=1 .AND. jhbe/=2) .AND. mln==68 ) THEN
669 CALL ancmsg(msgid=672,
670 . msgtype=msgerror,
671 . anmode=aninfo_blind_1,
672 . i1=id,
673 . c1=titr,
674 . i2=igeo(1,pid))
675 ENDIF
676 IF (jhbe == 2) jhbe=0 ! Hourglass Halquist
677 IF(mln == 1 .AND.igt /= 22) THEN
678 IF ((jhbe == 14 .AND. npt /= 222).OR.(jhbe == 15 .AND. npt /= 2) ) THEN
679 npt = 2
680 IF(jhbe==14 ) npt = 222
681 CALL ancmsg(msgid=791,
682 . msgtype=msgwarning,
683 . anmode=aninfo_blind_1,
684 . i1=id,
685 . i2=jhbe,
686 . c1=titr)
687 ENDIF
688 ENDIF
689C
690 jale_from_mat = nint(pm(72,mid))
691 jale_from_prop = igeo(62,pid)
692 jale = max(jale_from_mat, jale_from_prop) !if inconsistent, error message was displayed in PART reader
693 jlag=0
694 IF(jale == 0.AND.mln /= 18)jlag=1
695 jeul=0
696 IF(jale == 2)THEN
697 jale=0
698 jeul=1
699C foam + air
700 ELSEIF(jale == 3 .AND. mln == 77) THEN
701 jlag=1
702 ENDIF
703C Multidomains - JALE of JEUL is set to 0 for dupplicated parts with void material
704 IF (nsubdom>0) THEN
705 IF (ipartr2r == 0) THEN
706 IF (jale > 0) jale = 0
707 IF (jeul > 0) jeul = 0
708 ENDIF
709 ENDIF
710
711
712 !ALE REZONING/REMAPING : number of MAT/EOS variables to treat (used by staggered scheme only : arezon.F)
713 ! with ale framework, since the mesh is arbitrary, the variable must be updated to map thei expected location and not follow the arbitrary mesh displacement
714 ! this numbering here will be used in arezon.F to loop over variables to rezon/remap
715 IF(jale == 1)THEN
716 ale%REZON%NUM_NUVAR_MAT = max(ale%REZON%NUM_NUVAR_MAT, matparam%REZON%NUM_NUVAR_MAT)
717 ale%REZON%NUM_NUVAR_EOS = max(ale%REZON%NUM_NUVAR_EOS, matparam%REZON%NUM_NUVAR_EOS)
718 ENDIF
719
720 !ALE UVAR REZONING (81:MAT, 82:EOS)
721 IF(jale == 1)THEN
722 iparg(81,ngroup) = matparam%REZON%NUM_NUVAR_MAT
723 iparg(82,ngroup) = matparam%REZON%NUM_NUVAR_EOS
724 ENDIF
725C
726 IF(mln/=50)jtur=nint(pm(70,mid))
727 jthe=nint(pm(71,mid))
728C Multifluid law
729 israt=ipm(3,mid)
730 imatvis = ipm(216, mid)
731 issn=0
732 IF(jlag/=0.AND.pid/=0)THEN
733 issn=igeo(5,pid)
734C IF (ITET4 == 1 .AND. IKSNOD0 == 4 .AND. ISSN /= 0) ISSN=0
735 ELSE
736 issn=4
737 ENDIF
738 IF(mln == 13) irigid_mat = 1
739C
740 jsms=0
741 IF(isms/=0)THEN
742 IF(idtgrs/=0)THEN
743 IF(tagprt_sms(iparts(ii))/=0)jsms=1
744 ELSE
745 jsms=1
746 END IF
747 END IF
748 ieos = ipm(4,mid)
749C--------------------
750C- ICPRE,ISMSTR JCVT Automatic
751C--------------------
752 IF (igt == 20 .OR. igt == 21 .OR. igt == 22) itsh = 1
753C---add ICPRE auto for thick-shell
754 IF (itsh == 1 ) THEN
755 icp0=matparam%COMPRESSIBILITY
756 SELECT CASE (icp0)
757C-------compressible
758 CASE(1)
759 icpre = 0
760C------
761 CASE(2)
762 icpre = 1
763C--------elasto-plastic
764 CASE(3)
765 icpre = 2
766 END SELECT
767C------- Out message
768 IF (icpre>0) CALL ancmsg(msgid=1741,
769 . msgtype=msginfo,
770 . anmode=aninfo_blind_2,
771 . i1=id,
772 . c1=titr,
773 . i2=icpre,
774 . prmod=msg_cumu)
775 IF (issn >= 10) THEN
776 CALL ancmsg(msgid=3027,
777 . msgtype=msgerror,
778 . anmode=aninfo_blind_2,
779 . i1=id,
780 . c1=titr,
781 . i2=issn)
782 ENDIF
783 END IF !IF (ITSH == 1 )
784C
785 IF (igt == 14 .OR. igt == 6) THEN
786 IF (icpre<0) THEN
787 IF (iksnod0 ==8.AND.jhbe>10) THEN
788 icp0=matparam%COMPRESSIBILITY
789 SELECT CASE (icp0)
790C-------compressible
791 CASE(1)
792 icpre = 3
793C------
794 CASE(2)
795 icpre = 1
796C--------elasto-plastic
797 CASE(3)
798 icpre = 2
799 END SELECT
800C------- Out message
801 CALL ancmsg(msgid=1741,
802 . msgtype=msginfo,
803 . anmode=aninfo_blind_2,
804 . i1=id,
805 . c1=titr,
806 . i2=icpre,
807 . prmod=msg_cumu)
808 ELSE
809 icpre = 0
810 END IF !(IKSNOD0 ==8.AND.JHBE>10) THEN
811 END IF !IF (ICPRE<0)
812C------ quadratic S16,S20 not compatible with total strain--
813 IF (issn<0) THEN
814C--- ISM0 : 2 large, 1: small ; ICP0 : 1 inc, 2 total
815 ism0 = matparam%SMSTR
816 icp0 = matparam%STRAIN_FORMULATION
817 IF (icp0 ==2.AND.jhbe/=16) THEN
818 IF (ism0==1) THEN
819 issn = 11
820 ELSE
821 issn = 10
822C IF (MATPARAM%COMPRESSIBILITY==2) ISSN = 10
823 END IF
824 ELSE
825 IF (ism0==1) THEN
826 issn = 1
827 ELSE
828 issn = 2
829 END IF
830 END IF
831C--- ISMSTR=12 for law1
832 IF (mln == 1.AND.jhbe/=16) issn = 12
833C------- Out message
834 CALL ancmsg(msgid=1742,
835 . msgtype=msginfo,
836 . anmode=aninfo_blind_2,
837 . i1=id,
838 . c1=titr,
839 . i2=issn,
840 . prmod=msg_cumu)
841 END IF
842C----- Iframe automatic JCVT=2 excpeting law58&fluide
843 IF (jcvt<0) THEN
844 jcvt = 0
845 IF (iksnod0==8.AND.jlag>0.AND.mln/=68) jcvt = 1
846C------- Out message
847 ism0 = jcvt+1
848 CALL ancmsg(msgid=1764,
849 . msgtype=msginfo,
850 . anmode=aninfo_blind_2,
851 . i1=id,
852 . c1=titr,
853 . i2=ism0,
854 . prmod=msg_cumu)
855 END IF
856 END IF
857C---add ICPRE auto for T10, firsly limited by Large Strain
858 IF (it10 ==1 .AND. (issn==4 .OR. issn==10)
859 . .AND. iksnod0==10 ) THEN
860 icp0=matparam%COMPRESSIBILITY
861 SELECT CASE (icp0)
862C-------compressible
863 CASE(1)
864 icpre = 3
865C------
866 CASE(2)
867 icpre = 1
868 IF (mln == 1.OR.mln == 92) icpre = 3
869C--------elasto-plastic
870 CASE(3)
871 icpre = 2
872 IF (icpt10==3) icpre = 3
873 END SELECT
874C------- Out message
875 IF (icpre ==1 .OR. icpre ==2) CALL ancmsg(
876 . msgid=1741,
877 . msgtype=msginfo,
878 . anmode=aninfo_blind_2,
879 . i1=id,
880 . c1=titr,
881 . i2=icpre,
882 . prmod=msg_cumu)
883 ELSEIF (it10 ==1) THEN
884 icpre = 0
885 END IF !IF (IT10 == 1 )
886c
887 IF (mln == 1.AND.issn<10) CALL init_mat_keyword(matparam,"HYDROSTATIC")
888 IF (itsh == 1.AND. matparam%IPRES/=1) CALL ancmsg(
889 . msgid=3012,
890 . msgtype=msginfo,
891 . anmode=aninfo_blind_2,
892 . i1=id,
893 . c1=titr,
894 . i2=mln,
895 . prmod=msg_cumu)
896C--------------------
897C COMPATIBILITY TEST
898C--------------------
899
900 !---------------------------------!
901 ! ALE / EULER compatibility !
902 !---------------------------------!
903 IF (jale+jeul /= 0) THEN
904
905 IF (jhbe>=2.AND.jhbe/=24) THEN !FORMULATION CHECK
906 CALL ancmsg(msgid=608,
907 . msgtype=msgerror,
908 . anmode=aninfo_blind_1,
909 . i1=id,
910 . c1=titr,
911 . i2=jhbe) ! allows only: isolid=1(JHBE=1)
912 ELSEIF (jcvt==1) THEN !COROTATIONAL NOT ALLOWED
913 IF(jhbe==0) THEN
914 CALL ancmsg(msgid=246,
915 . msgtype=msgerror,
916 . anmode=aninfo_blind_1,
917 . i1=id,
918 . c1=titr,
919 . i2=2)
920 ELSE
921 CALL ancmsg(msgid=246,
922 . msgtype=msgerror,
923 . anmode=aninfo_blind_1,
924 . i1=id,
925 . c1=titr,
926 . i2=jhbe)
927 END IF
928 END IF
929
930 END IF
931 !---------------------------------!
932C
933 IF (igt == 14.AND.mln == 28 .AND.
934 . (jhbe == 0.OR.jhbe == 1.OR.jhbe == 12.OR.jhbe == 17)
935 . .AND.jcvt == 1) THEN
936 CALL ancmsg(msgid=247,
937 . msgtype=msgerror,
938 . anmode=aninfo_blind_1,
939 . i1=id,
940 . c1=titr,
941 . i2=jhbe)
942 ENDIF
943 IF (igt == 14.AND.(mln == 14.OR.mln == 24)
944 . .AND.(jhbe == 12.AND.jcvt == 1)) THEN
945 CALL ancmsg(msgid=248,
946 . msgtype=msgerror,
947 . anmode=aninfo_blind_1,
948 . i1=id,
949 . c1=titr,
950 . i2=jhbe,
951 . i3=mln)
952 ENDIF
953C
954 IF(iksnod0 == 4.AND.
955 . (jhbe==0.OR.jhbe==1.OR.jhbe==12.OR.jhbe==17).AND.jcvt==1)THEN
956 CALL ancmsg(msgid=340,
957 . msgtype=msgwarning,
958 . anmode=aninfo_blind_2,
959 . i1=id,
960 . c1=titr,
961 . i2=igeo(1,pid))
962 jcvt = 0
963 ELSEIF(iksnod0 == 4.OR.iksnod0 == 10)THEN
964 jcvt = 0
965 ENDIF
966 IF(iksnod0 == 4 .AND. jhbe /= 1 .AND. jhbe /= 2) THEN
967 jhbe = 1
968 npt=1
969 IF(itet4 == 1) npt=4
970 ENDIF
971 IF(iksnod0 == 10 .AND. jhbe /= 1 .AND. jhbe /= 2) THEN
972c CALL ANCMSG(MSGID=341,
973c . MSGTYPE=MSGWARNING,
974c . ANMODE=ANINFO_BLIND_2,
975c . I1=ID,
976c . C1=TITR,
977c . I2=JHBE)
978 jcvt = 0
979 jhbe = 1
980 IF (npt/=4) npt=4
981 ENDIF
982C
983 IF(iksnod0 == 10 .AND. (jhbe == 1 .OR. jhbe == 2)
984 . .AND. jcvt == 1) THEN
985 CALL ancmsg(msgid=609,
986 . msgtype=msgwarning,
987 . anmode=aninfo_blind_2,
988 . i1=id,
989 . c1=titr)
990 jcvt = 0
991 ENDIF
992c IF (JHBE == 14 .AND. (IKSNOD0 == 16 .OR. IKSNOD0 == 20)) THEN
993 IF (jhbe /= 16 .AND. iksnod0 == 20) THEN
994 CALL ancmsg(msgid=860,
995 . msgtype=msgwarning,
996 . anmode=aninfo_blind_2,
997 . i1=id,
998 . c1=titr,
999 . i2=jhbe)
1000 jhbe = 16
1001 npt = max(npt, 222)
1002 ENDIF
1003 IF (jhbe == 14 .AND. iksnod0 /= 8) THEN
1004 IF(iksnod0 /= 4.AND.iksnod0 /= 10)THEN
1005 CALL ancmsg(msgid=758,
1006 . msgtype=msgwarning,
1007 . anmode=aninfo_blind_2,
1008 . i1=id,
1009 . c1=titr,
1010 . i2=jhbe,
1011 . prmod=msg_cumu)
1012 ENDIF
1013 jhbe = 0
1014 ENDIF
1015 IF (jhbe == 15 .AND. iksnod0 /= 6 .AND. iksnod0 /= 8) THEN
1016 IF(iksnod0 /= 4.AND.iksnod0 /= 10)THEN
1017 CALL ancmsg(msgid=547,
1018 . msgtype=msgerror,
1019 . anmode=aninfo_blind_1,
1020 . i1=id,
1021 . c1=titr,
1022 . i2=jhbe)
1023 ENDIF
1024 jhbe = 0
1025 ENDIF
1026 IF (jhbe == 16 .AND. iksnod0 /= 16 .AND. iksnod0 /= 20) THEN
1027 IF(iksnod0 /= 4.AND.iksnod0 /= 10)THEN
1028 CALL ancmsg(msgid=548,
1029 . msgtype=msgerror,
1030 . anmode=aninfo_blind_1,
1031 . i1=id,
1032 . c1=titr,
1033 . i2=jhbe)
1034 ENDIF
1035 jhbe = 0
1036 ENDIF
1037 IF (jhbe == 24 .AND. iksnod0 /= 8.AND. iksnod0 /= 6) THEN
1038 IF(iksnod0 /= 4.AND.iksnod0 /= 10)THEN
1039 CALL ancmsg(msgid=758,
1040 . msgtype=msgwarning,
1041 . anmode=aninfo_blind_2,
1042 . i1=id,
1043 . c1=titr,
1044 . i2=jhbe,
1045 . prmod=msg_cumu)
1046 ENDIF
1047 jhbe = 0
1048 ENDIF
1049 IF (jhbe==15 .AND. igt/=20 .AND. igt/=21 .AND. igt/=22) THEN
1050 CALL ancmsg(msgid=549,
1051 . msgtype=msgerror,
1052 . anmode=aninfo_blind_1,
1053 . i1=id,
1054 . c1=titr,
1055 . i2=jhbe,
1056 . i3=igt)
1057 ENDIF
1058 IF (iksnod0==16 .AND. igt/=20 ) THEN
1059 CALL ancmsg(msgid=3116,
1060 . msgtype=msgerror,
1061 . anmode=aninfo_blind_1,
1062 . i1=id,
1063 . c1=titr,
1064 . i2=igt)
1065 ENDIF
1066 IF (jhbe/=15 .AND.
1067 . (igt == 20 .OR. igt == 21 .OR. igt == 22 ).AND. iksnod0==6 ) THEN
1068 CALL ancmsg(msgid=639,
1069 . msgtype=msgerror,
1070 . anmode=aninfo_blind_1,
1071 . i1=id,
1072 . c1=titr,
1073 . i2=ixs(11,ii))
1074 ENDIF
1075 IF ((jhbe == 17 .OR.jhbe == 18) .AND. iksnod0 /= 8) THEN
1076 IF(iksnod0 /= 4.AND.iksnod0 /= 10)THEN
1077 CALL ancmsg(msgid=758,
1078 . msgtype=msgwarning,
1079 . anmode=aninfo_blind_2,
1080 . i1=id,
1081 . c1=titr,
1082 . i2=jhbe,
1083 . prmod=msg_cumu)
1084 ENDIF
1085 jhbe = 0
1086C----- could happen when tet_hexa used the same pid
1087 IF (issn==0) issn=4
1088 ENDIF
1089C------ default IHKT of HEPH
1090 IF (jhbe == 24 .AND. iint==0) THEN
1091 iint =1
1092 IF (imatvis > 0 .OR.mln==24) THEN
1093 SELECT CASE (mln)
1094C--------hyperelastic, visco-elastic
1095 CASE(38,42,62,69,70,82,88,90,92,94,190)
1096 iint =2
1097C--------SUPERELASTIC
1098 CASE(71)
1099 iint =2
1100C--------compo (damage)
1101 CASE(24)
1102 iint =2
1103 END SELECT
1104 END IF
1105 END IF !(JHBE == 24 ) THEN
1106C------ new element like Is17 ,nu=PM(21,MID)
1107 IF (jhbe == 18 ) THEN
1108 icp0 = icpre
1109C -------------------
1110 icpre = 1
1111 SELECT CASE (mln)
1112C--------elastic ,visco-elastic
1113 CASE(1,13,16,33,34,35,38,40,41,70,77,90,190)
1114 icpre = 0
1115 IF (pm(21,mid)>=0.49) icpre = 1
1116C-----Keep IINT=2 for message and output (Isolid=18->17), remove free-shear in Engine
1117C------- free-shear locking removed
1118C IF (ICPRE==1.OR.ICP0==1) IINT =0
1119C--------hyper-elastic
1120 CASE(42,62,69,82,88,92,94,100,101,111)
1121C IF (ICP0/=3) IINT =0
1122C--------case Icpre=2 of elasto-plastic
1123 CASE(2,36)
1124 icpre = 2
1125C--------elasto-plastic (not large plasticity)
1126 CASE(21,22,23,24,27,52,79,81,84)
1127 icpre = 2
1128C--------orhtotropic,composite (P isn't calculated independently)
1129 CASE(12,14,15,25,28,50,53,68,76,93,107,112,127)
1130 icpre = 0
1131 END SELECT
1132 IF (icp0 ==3) THEN
1133 IF (icpre/=0) THEN
1134C-------- warning out for no-zero input
1135 CALL ancmsg(msgid=1573,
1136 . msgtype=msgwarning,
1137 . anmode=aninfo_blind_2,
1138 . i1=id,
1139 . c1=titr,
1140 . i2=icpre,
1141 . prmod=msg_cumu)
1142 icpre = 0
1143 END IF
1144 ELSE
1145 IF (icp0 /=0 .AND. icpre/=icp0) THEN
1146C-------- warning out for no-zero input
1147 CALL ancmsg(msgid=1573,
1148 . msgtype=msgwarning,
1149 . anmode=aninfo_blind_2,
1150 . i1=id,
1151 . c1=titr,
1152 . i2=icpre,
1153 . prmod=msg_cumu)
1154 icpre = icp0
1155 END IF
1156 END IF !(ICP0 ==3) THEN
1157C -------------------
1158 ism0 = issn
1159 issn=2
1160 SELECT CASE (mln)
1161C--------elastic can be both 4,10
1162 CASE(1)
1163C--------hyper-elastic
1164 IF (ism0 == 10.OR.ism0 == 12) issn = ism0
1165 CASE(42,62,69,82,88,92,94,95,100,101,111)
1166 issn=10
1167C--------visco_elastic add 90
1168 CASE(38,90,190)
1169 issn=10
1170C--------special
1171 CASE(28)
1172 issn=1
1173C--------visco_elastic
1174 CASE(70)
1175 issn=11
1176 END SELECT
1177 IF (ism0 /=0 .AND. issn/=ism0) THEN
1178C-------- warning out for no-zero input
1179 CALL ancmsg(msgid=1574,
1180 . msgtype=msgwarning,
1181 . anmode=aninfo_blind_2,
1182 . i1=id,
1183 . c1=titr,
1184 . i2=issn,
1185 . prmod=msg_cumu)
1186 issn = ism0
1187 END IF
1188 jhbe =17
1189 IF (icp0==0.OR.ism0==0) THEN
1190 CALL ancmsg(msgid=1575,
1191 . msgtype=msginfo,
1192 . anmode=aninfo_blind_2,
1193 . i1=id,
1194 . c1=titr,
1195 . i2=issn,
1196 . i3=icpre,
1197 . prmod=msg_cumu)
1198 END IF
1199 ENDIF !IF (JHBE == 18 )
1200C-----due to ICPRE automatic
1201 IF (icpre == 3.AND.(igt == 14.OR.igt == 6)) icpre =0
1202 IF((mln == 95 .OR. mln == 100 .OR. mln == 101 .OR. mln == 111) .AND. issn /= 10 ) THEN
1203 issn = 10
1204 CALL ancmsg(msgid=1200,
1205 . msgtype=msgwarning,
1206 . anmode=aninfo_blind_2,
1207 . i1=id,
1208 . c1=titr,
1209 . i2=mln)
1210
1211 ENDIF
1212 IF (iksnod0 == 16 .OR. iksnod0 == 20) THEN
1213 jcvt = 0
1214 ENDIF
1215
1216
1217C------For Incompatibility w/ Isolid=12, don't add new law
1218 IF( iksnod0 == 8 .AND.iabs(jhbe) < 200 .AND. npt == 8
1219 . .AND.iabs(jhbe) /= 14. and.iabs(jhbe) /= 15
1220 . .AND.iabs(jhbe) /= 24 .AND.iabs(jhbe) /= 17
1221 . .AND.iabs(jhbe) /= 18) THEN
1222C
1223 IF(mln /= 1 .AND. mln/= 2 .AND. mln /= 3 .AND.
1224 . mln /= 28 .AND. mln /= 29 .AND. mln /= 30 .AND.
1225 . mln /=31 .AND. mln/= 33 .AND. mln /= 34 .AND.
1226 . mln /= 35 .AND. mln /= 36 .AND. mln /= 38 .AND.
1227 . mln /= 39 .AND. mln /= 40 .AND. mln /= 41 .AND.
1228 . mln /= 42 .AND. mln /= 44 .AND. mln /= 45 .AND.
1229 . mln /= 48 .AND. mln /= 50 .AND. mln /= 52 .AND.
1230 . mln /= 53 .AND. mln /= 56 .AND. mln /= 60 .AND.
1231 . mln /= 62 )THEN
1232 jhbe = 17
1233 icpre = 1
1234 igeo(10, pid) = 17
1235 igeo(13, pid) = 1
1236 CALL ancmsg(msgid=869,
1237 . msgtype=msgwarning,
1238 . anmode=aninfo_blind_2,
1239 . i1=id,
1240 . c1=titr,
1241 . i2=mln)
1242 ENDIF
1243c . AND.(MLN == 4.OR.MLN == 6.OR.MLN == 10.OR.MLN == 21.
1244c . OR.MLN == 22.OR.MLN == 23.OR.MLN == 24.OR.MLN == 49))THEN
1245cc CALL ANSTCKI(MLN)
1246cc CALL ANCERR(601,ANINFO_BLIND_2)
1247 ENDIF
1248 IF (issn == 10 .OR. issn == 12) THEN
1249 IF(mln /= 38 .AND. mln /= 42 .AND. mln /= 62 .AND.
1250 . mln /= 69 .AND. mln /= 82 .AND. mln /= 92 .AND.
1251 . mln /= 99 .AND. mln /= 1 .AND. mln /= 88 .AND.
1252 . mln /= 71 .AND. mln /= 94 .AND. mln /= 90 .AND.
1253 . mln /= 95 .AND. mln /=100 .AND. mln /= 101 .AND.
1254 . mln /= 111 .AND. mln /=190) THEN
1255C--------------warning out
1256 CALL ancmsg(msgid=1092,
1257 . msgtype=msgwarning,
1258 . anmode=aninfo_blind_2,
1259 . i1=id,
1260 . c1=titr,
1261 . i2=mln)
1262 IF (issn == 12) THEN
1263 issn = 2
1264 ELSE
1265 issn = 4
1266 END IF
1267 END IF
1268 ELSE IF (issn == 11) THEN
1269 IF(mln /= 1 .AND.mln /= 38 .AND. mln /= 70 .AND. mln /= 77
1270 . .AND. mln /= 90 .AND. mln /= 190)THEN
1271C--------------error out
1272 CALL ancmsg(msgid=1093,
1273 . msgtype=msgerror,
1274 . anmode=aninfo_blind_1,
1275 . i1=id,
1276 . c1=titr,
1277 . i2=mln)
1278 END IF
1279 ENDIF
1280 IF(mln == 70 .OR. mln == 77) THEN
1281 IF (itsh==1) THEN ! not compatible to total strain
1282 issn = 1
1283 ELSEIF (issn /= 11 .AND. issn /= 1) THEN
1284 issn = 11
1285 END IF
1286 ENDIF
1287C---------------remove Icpre=11 excepting for certain visco-elastic 34
1288 IF( icpre==1.AND.iksnod0 ==8.AND.(jhbe==14.OR.jhbe==17))THEN
1289C
1290 IF(mln == 34 )THEN
1291C---------- no warning message as ICPRE = 11 is the internal flag
1292 icpre = 11
1293 igeo(13, pid) = 11
1294 END IF
1295 IF(mln == 28 )THEN
1296 icpre = 0
1297 igeo(13, pid) = 0
1298 CALL ancmsg(msgid=1585,
1299 . msgtype=msgwarning,
1300 . anmode=aninfo_blind_2,
1301 . i1=id,
1302 . c1=titr)
1303 END IF
1304 END IF
1305C
1306 IF (jhbe == 16.AND.mln == 25)THEN
1307 CALL ancmsg(msgid=855,
1308 . msgtype=msgerror,
1309 . anmode=aninfo_blind_1,
1310 . i1=id,
1311 . c1=titr,
1312 . i2=jhbe,
1313 . i3=mln)
1314 ENDIF
1315 IF (mln ==200.AND.(igt == 14.OR.igt == 20))THEN
1316 CALL ancmsg(msgid=2035,
1317 . msgtype=msgerror,
1318 . anmode=aninfo_blind_1,
1319 . i1=id,
1320 . c1=titr,
1321 . i2=mln)
1322 ENDIF
1323C-------------------------------------------------
1324C composite-------------
1325 IF (jhbe==14 .OR. jhbe==16) THEN
1326 nptr=abs(npt)/100
1327 npts=mod(abs(npt)/10,10)
1328 nptt=mod(abs(npt),10)
1329 npg = nptr*npts*nptt
1330 nly = npts
1331 ELSE
1332 npg = npt
1333 nly = npt
1334 ENDIF
1335C -----for mix hardening------------
1336 IF (igt==22) THEN
1337 IF (jhbe==14 ) THEN
1338 SELECT CASE (icstr)
1339 CASE(100)
1340 nly = nptr
1341 IF (nly ==0) THEN
1342 nly =iint
1343 npg = nly*npts*nptt
1344 ENDIF
1345 CASE(10)
1346 nly = npts
1347 IF (nly ==0) THEN
1348 nly =iint
1349 npg = nly*nptr*nptt
1350 ENDIF
1351 CASE(1)
1352 nly = nptt
1353 IF (nly ==0) THEN
1354 nly =iint
1355 npg = nly*nptr*npts
1356 ENDIF
1357 END SELECT
1358 ENDIF
1359 DO nl=1,nly
1360 im=igeo(ipmat+nl,pid)
1361 ilaw=nint(pm(19,im))
1362C-------for the case where we use ISRAT=0 law in Part define and ISRAT=1 laws in certain layers
1363 israt=max(israt,ipm(3,im))
1364 ENDDO
1365 ENDIF
1366
1367C-------
1368 ne1 = min( nvsiz, nel + nel_prec - nft) ! Nb of elements in the group
1369 IF(issn > 4 .AND. iboltp /= 0)THEN
1370C
1371 issn_ = issn
1372C
1373 IF(issn_==10)THEN
1374 issn=4
1375 ELSEIF(issn_==11)THEN
1376 issn=1
1377 ELSEIF(issn_==12)THEN
1378 issn=2
1379 END IF
1380C
1381 DO j=1,ne1
1382 ii=eadd(n)+nft+j-1
1383C
1384C Preloaded elements are not compatible with Total Strain formulations
1385 id=ixs(nixs,ii)
1386 CALL ancmsg(msgid=1775,
1387 . msgtype=msgwarning,
1388 . i1=id,
1389 . i2=iparts(ii),
1390 . i3=issn_,
1391 . i4=issn ,
1392 . anmode=aninfo_blind_1,
1393 . prmod=msg_cumu)
1394 END DO
1395 ENDIF
1396 IF(iksnod0 == 10.AND.itet10==3)THEN
1397 iint = itet10
1398 itet10 = 2
1399 ELSEIF(iksnod0 == 10.AND.itet10==2)THEN
1400 iint = 0
1401 ENDIF
1402C------ compatibility w/ AMS
1403 IF (iksnod0 == 10.AND.itet10==2.AND.isms>0) THEN
1404 CALL ancmsg(msgid=2024,
1405 . msgtype=msgerror,
1406 . anmode=aninfo_blind_2,
1407 . i1=id,
1408 . c1=titr,
1409 . prmod=msg_cumu)
1410 END IF
1411C-------
1412 ! remove incompatibility for Itet4 = 3
1413 IF (issn < 10 .AND. itet4 == 3 .AND. ASSOCIATED(matparam)) THEN
1414 IF(matparam%STRAIN_FORMULATION==2) THEN
1415 CALL ancmsg(msgid=2037,
1416 . msgtype=msgwarning,
1417 . anmode=aninfo_blind_2,
1418 . i1=igeo(1,pid),
1419 . i2=issn,
1420 . prmod=msg_cumu)
1421 issn = 10
1422 ENDIF
1423 ENDIF
1424 ivisc = matparam%IVISC
1425 IF (ivisc == 2 .AND. issn /=10 .AND. issn /=12) THEN
1426 CALL ancmsg(msgid=3018,
1427 . msgtype=msgwarning,
1428 . anmode=aninfo_blind_2,
1429 . i1=pid,
1430 . c1=titr)
1431 ENDIF
1432C-------------------------------------------------
1433C IPARG STORAGE
1434C-------------------------------------------------
1435 iparg(1,ngroup) = mln
1436 iparg(2,ngroup) = ne1
1437 iparg(3,ngroup) = eadd(n)-1 + nft
1438 iparg(4,ngroup) = lbufel+1 ! kept in place for compatibility with other groups using old buffer
1439 iparg(5,ngroup) = 1
1440 iparg(7,ngroup) = jale
1441 iparg(9,ngroup) = issn
1442 iparg(11,ngroup)= jeul
1443 iparg(12,ngroup)= jtur
1444 iparg(13,ngroup)= -abs(jthe)
1445 IF(jale+jeul /= 0)THEN
1446 iparg(13,ngroup)= +abs(jthe)
1447 ENDIF
1448 iparg(14,ngroup)= jlag
1449 iparg(10,ngroup)= icpre
1450 iparg(17,ngroup)= icstr
1451 iparg(6,ngroup) = npt
1452 iparg(18,ngroup)= mid
1453 iparg(20,ngroup) = 0
1454 IF (mln == 151) iparg(20,ngroup) = ipm(20, mid)
1455 iparg(23,ngroup)= jhbe
1456 iparg(24,ngroup)= jivf
1457 iparg(27,ngroup)= jpor
1458 iparg(28,ngroup)= iksnod0
1459 iparg(29,ngroup)= iplast
1460 iparg(34,ngroup)= nint(pm(10,mid))
1461C group/processor identification
1462 iparg(32,ngroup)= p-1
1463 iparg(33,ngroup)= jclos
1464 iparg(35,ngroup)= irep
1465 iparg(36,ngroup)= iint
1466 iparg(37,ngroup)= jcvt
1467 iparg(38,ngroup)= igt
1468 iparg(42,ngroup)= isorth
1469 iparg(40,ngroup)= israt
1470 iparg(43,ngroup)= ifail
1471 IF(mln == 68)THEN
1472 iparg(41,ngroup)=1
1473 ELSE
1474 iparg(41,ngroup)=itet4
1475 ENDIF
1476 IF(mln/=25.AND.mln<28)THEN
1477 iparg(44,ngroup)= istrain
1478 ELSEIF(mln>=28)THEN
1479 istrain=2
1480 iparg(44,ngroup)=istrain
1481 ENDIF
1482C
1483 iparg(45,ngroup ) = imatvis
1484C thermal material expansion
1485 IF(ipm(218,mid) > 0 .AND. mln /= 0 .AND. mln /= 13)
1486 . iparg(49,ngroup)= 1
1487 iparg(52,ngroup)= jsms
1488C
1489C - initial volume fraction -
1490C
1491 iparg(53,ngroup) = 0
1492 lfound=.false.
1493 IF(num_inivol > 0)THEN
1494 ! Warning : In same group you can have different PArts, A loop over elem in groups has to be introduced to check if INIVOL PART is there.
1495 mft = iparg(3,ngroup)
1496 DO iloc = 1 ,iparg(2,ngroup)
1497 DO jj=1,num_inivol
1498 IF(inivol(jj)%PART_ID == iparts(iloc+mft)) THEN
1499 iparg(53,ngroup) = 1
1500 lfound=.true.
1501 EXIT
1502 ENDIF
1503 ENDDO
1504 IF(lfound)EXIT
1505 END DO
1506 END IF
1507C equation of state
1508 iparg(55,ngroup)= ieos
1509C flag for vis stress
1510 iparg(60,ngroup)= isvis
1511 iparg(61,ngroup)= ivisc
1512 iparg(62,ngroup)= pid ! property number
1513 iparg(69,ngroup)= ipartsph
1514C flag for group of duplicated elements in multidomains
1515 IF (nsubdom>0) iparg(77,ngroup)= ipartr2r
1516C flag for bolt preloading
1517 iparg(72,ngroup)= iboltp
1518 IF (iboltp>0) THEN
1519 iparg(67,ngroup)= ipreload_fun(1,iboltp)
1520 iparg(68,ngroup)= ipreload_fun(2,iboltp)
1521 END IF
1522C
1523C Formulation level for the solid elements time step computation
1524 iparg(73,ngroup)=ipm(252,mid)
1525 iparg(74,ngroup)=itet10
1526c non-local variable regularization flag for failure models
1527 iparg(78,ngroup) = matparam%NLOC ! NLOC_FAIL
1528c id of damping frequency range apply to group
1529 iparg(93,ngroup) = idamp_freq_range
1530C------------------------------------------------------
1531C BUFFER LENGTH
1532C------------------------------------------------------
1533 IF (npg > 1) npg = npg + 1
1534 IF (npg == 1 .AND. jhbe == 15) npg = npg + 1
1535C
1536 nft = nft + ne1
1537 220 CONTINUE
1538 ngp(p)=ngroup-ngp(p)
1539 ENDIF
1540 ENDDO
1541C Dd_iad => nb groups per sub domain
1542 ngp(nspmd+1)=0
1543 DO p = 1, nspmd
1544 ngp(nspmd+1)=ngp(nspmd+1)+ngp(p)
1545 dd_iad(p,nspgroup+n)=ngp(p)
1546 END DO
1547 dd_iad(nspmd+1,nspgroup+n)=ngp(nspmd+1)
1548C
1549 300 CONTINUE
1550
1551 nspgroup = nspgroup + nd
1552C
1553C CFD treatment on negative MID on all solids if ineg=1
1554C
1555 IF (ineg == 1) THEN
1556 DO i = 1, numels
1557 ixs(1,i) = abs(ixs(1,i))
1558 ENDDO
1559 ENDIF
1560 IF(print_flag>6) WRITE(iout,1010)
1561c-----------
1562 DO n=ngr1,ngroup
1563 jhbe=iparg(23,n)
1564 npt =iparg(6,n)
1565 IF (jhbe==14 .OR. jhbe==16) THEN
1566 npts=npt/100*mod(npt/10,10)*mod(npt,10)
1567 IF (npts == zero) THEN
1568 npts=abs(npt)/100
1569 iint=iparg(36,n)
1570 IF (npts==0) npts=iint
1571 nptt=mod(abs(npt)/10,10)
1572 IF (nptt==0) nptt=iint
1573 nptr=mod(abs(npt),10)
1574 IF (nptr==0) nptr=iint
1575 npg = npts*nptt*nptr
1576 npts=npg
1577 ENDIF
1578 ELSE
1579 npts=npt
1580 ENDIF
1581 IF(print_flag>6) THEN
1582 WRITE(iout,1011)n,iparg(1,n),iparg(2,n),iparg(3,n)+1,
1583 + iparg(4,n),npts,iparg(7,n),iparg(11,n),
1584 + iparg(12,n),iparg(13,n),iparg(23,n),
1585 + iparg(24,n),iparg(18,n),iparg(27,n),
1586 + iparg(29,n)+1,
1587 + iparg(33,n),iparg(34,n),iparg(43,n),iparg(55,n)
1588 ENDIF
1589 ENDDO
1590 CALL ancmsg(msgid=758,
1591 . msgtype=msgwarning,
1592 . anmode=aninfo_blind_2,
1593 . prmod=msg_print)
1594 CALL ancmsg(msgid=1112,
1595 . msgtype=msgwarning,
1596 . anmode=aninfo_blind_2,
1597 . prmod=msg_print)
1598 CALL ancmsg(msgid=1160,
1599 . msgtype=msgwarning,
1600 . anmode=aninfo_blind_2,
1601 . prmod=msg_print)
1602 CALL ancmsg(msgid=1225,
1603 . msgtype=msgwarning,
1604 . anmode=aninfo_blind_2,
1605 . prmod=msg_print)
1606 CALL ancmsg(msgid=1905,
1607 . msgtype=msgwarning,
1608 . anmode=aninfo_blind_2,
1609 . prmod=msg_print)
1610 CALL ancmsg(msgid=1573,
1611 . msgtype=msgwarning,
1612 . anmode=aninfo_blind_2,
1613 . prmod=msg_print)
1614 CALL ancmsg(msgid=1574,
1615 . msgtype=msgwarning,
1616 . anmode=aninfo_blind_2,
1617 . prmod=msg_print)
1618 CALL ancmsg(msgid=1575,
1619 . msgtype=msginfo,
1620 . anmode=aninfo_blind_2,
1621 . prmod=msg_print)
1622 CALL ancmsg(msgid=1586,
1623 . msgtype=msgerror,
1624 . anmode=aninfo_blind_2,
1625 . prmod=msg_print)
1626 CALL ancmsg(msgid=1741,
1627 . msgtype=msginfo,
1628 . anmode=aninfo_blind_2,
1629 . prmod=msg_print)
1630 CALL ancmsg(msgid=1742,
1631 . msgtype=msginfo,
1632 . anmode=aninfo_blind_2,
1633 . prmod=msg_print)
1634 CALL ancmsg(msgid=1764,
1635 . msgtype=msginfo,
1636 . anmode=aninfo_blind_2,
1637 . prmod=msg_print)
1638C-----------
1639 CALL ancmsg(msgid=1775,
1640 . msgtype=msgwarning,
1641 . anmode=aninfo_blind_1,
1642 . prmod=msg_print)
1643 CALL ancmsg(msgid=2024,
1644 . msgtype=msgerror,
1645 . anmode=aninfo_blind_2,
1646 . prmod=msg_print)
1647 CALL ancmsg(msgid=2037,
1648 . msgtype=msgwarning,
1649 . anmode=aninfo_blind_2,
1650 . prmod=msg_print)
1651 CALL ancmsg(msgid=3012,
1652 . msgtype=msginfo,
1653 . anmode=aninfo_blind_2,
1654 . prmod=msg_print)
1655c-----
1656 DEALLOCATE(indexs2)
1657 IF (ALLOCATED(xnum_rnoise)) DEALLOCATE(xnum_rnoise)
1658c------------------------------------------------------------
1659 1010 FORMAT(//,
1660 + 7x,'8-NODE ELEMENT GROUPS'/
1661 + 7x,'---------------------'//
1662 +' GROUP MAT. ELEM. FIRST BUFFER GAUSS',
1663 +' A.L.E. EULER TURBU. THERM. HOUR- INTEG',
1664 +' VAR POROUS PLASTI. CLOS. CODV FAILURE',
1665 +' IEOS',/
1666 +' # LAW NUMBER ELEM. ADDRESS POINTS',
1667 +' FLAG FLAG FLAG FLAG GLASS FLAG',
1668 +' MID MEDIUM FLAG FLAG FLAG',
1669 +' TYPE' )
1670 1011 FORMAT(19(i10))
1671c-----------
1672 RETURN
cpp_reorder_elements
void cpp_reorder_elements(int *NEL, int *NSPMD, int *NODES_PER_ELT, int *OFFSET, int *LDA, int *domain, int *elt2Nodes, int *permutation)
Definition cpp_reorder_elements.cpp:318
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:153
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
cluster_mod
Definition cluster_mod.F:40
groupdef_mod
Definition groupdef_mod.F:668
inivol_def_mod
Definition inivol_mod.F:45
inivol_def_mod::inivol
type(inivol_struct_), dimension(:), allocatable inivol
Definition inivol_mod.F:84
inivol_def_mod::num_inivol
integer num_inivol
Definition inivol_mod.F:85
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
qa_out_mod
Definition qa_out_mod.F:78
qa_out_mod::doqa
integer doqa
Definition qa_out_mod.F:84
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tag_mat
integer, dimension(:), allocatable tag_mat
Definition r2r_mod.F:136
r2r_mod::tag_elsf
integer, dimension(:), allocatable tag_elsf
Definition r2r_mod.F:141
reorder_mod
Definition reorder_mod.F:45
reorder_mod::permutation
type(reorder_struct_) permutation
Definition reorder_mod.F:54
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:895
nl
character *2 function nl()
Definition message.F:2360
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
arret
subroutine arret(nn)
Definition arret.F:86
inivol_def_mod::inivol_struct_
Definition inivol_mod.F:70
zeroin
subroutine zeroin(n1, n2, ma)
Definition zeroin.F:47