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