OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
r2r_prelec.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!|| r2r_prelec ../starter/source/coupling/rad2rad/r2r_prelec.F
25!||--- called by ------------------------------------------------------
26!|| r2r_group ../starter/source/coupling/rad2rad/r2r_group.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
30!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
31!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_option_count ../starter/source/devtools/hm_reader/hm_option_count.F
34!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
35!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
36!|| modif_tag ../starter/source/coupling/rad2rad/routines_r2r.F
37!|| prelecsec ../starter/source/tools/sect/prelecsec.F
38!|| r2r_count ../starter/source/coupling/rad2rad/r2r_count.F
39!|| tag_elem_void_r2r ../starter/source/coupling/rad2rad/tagelem_r2r.F
40!|| tag_elem_void_r2r_lin ../starter/source/coupling/rad2rad/tagelem_r2r.F
41!|| tagint_r2r ../starter/source/coupling/rad2rad/tagint_r2r.F
42!|| usr2sys ../starter/source/system/sysfus.F
43!||--- uses -----------------------------------------------------
44!|| detonators_mod ../starter/share/modules1/detonators_mod.F
45!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
46!|| inivol_def_mod ../starter/share/modules1/inivol_mod.F
47!|| message_mod ../starter/share/message_module/message_mod.F
48!|| nod2el_mod ../starter/share/modules1/nod2el_mod.F
49!|| r2r_mod ../starter/share/modules1/r2r_mod.F
50!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
51!|| restmod ../starter/share/modules1/restart_mod.F
52!|| submodel_mod ../starter/share/modules1/submodel_mod.F
53!||====================================================================
54 SUBROUTINE r2r_prelec(IPARTS,
55 2 IPARTC,IPARTG,IPARTT,IPARTP,IPARTR,IPARTSP,COMPT_T2,
56 3 MODIF,PASSE,INOM_OPT,NSPCONDN,NSPHION,IPART_L,MEMTR,
57 4 PM_STACK ,IWORKSH ,IGRNOD ,IGRSURF ,IGRSLIN ,
58 5 IGRBRIC ,IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS,
59 6 IGRBEAM ,IGRSPRING ,NEW_NSLASH_INT,LSUBMODEL,NEW_HM_NINTER,
60 7 NEW_NINTSUB,NEW_NINIVOL,IXS10,IXS20,IXS16,
61 8 DETONATORS,NSENSOR,SEATBELT_SHELL_TO_SPRING,NB_SEATBELT_SHELLS)
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE restmod
66 USE r2r_mod
67 USE nod2el_mod
68 USE message_mod
69 USE groupdef_mod
70 USE submodel_mod
71 USE hm_option_read_mod
72 USE inivol_def_mod , ONLY : num_inivol
73 USE detonators_mod
74 USE names_and_titles_mod , ONLY : nchartitle, ncharkey, ncharfield
75 USE reader_old_mod , ONLY : kinter, kcur, line, nslash
76C-----------------------------------------------
77C I m p l i c i t T y p e s
78C-----------------------------------------------
79#include "implicit_f.inc"
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83#include "com04_c.inc"
84#include "units_c.inc"
85#include "scr17_c.inc"
86#include "param_c.inc"
87#include "r2r_c.inc"
88#include "lagmult.inc"
89#include "sphcom.inc"
90#include "sms_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94 INTEGER ,INTENT(IN) :: NSENSOR
95 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
96 INTEGER IPARTS(*),IPARTC(*),IPARTG(*),IPARTT(*),IPARTP(*),
97 . IPARTR(*),COMPT_T2,MODIF,PASSE,INOM_OPT(*),IPARTSP(*),NSPCONDN,
98 . NSPHION,IPART_L(LIPART1,*),MEMTR(*),IWORKSH(*),NEW_NSLASH_INT,NEW_HM_NINTER,NEW_NINTSUB,
99 . NEW_NINIVOL,IXS10(*), IXS16(*), IXS20(*)
100 INTEGER ,INTENT(IN) :: NB_SEATBELT_SHELLS
101 INTEGER ,INTENT(IN) :: SEATBELT_SHELL_TO_SPRING(NUMELC,2)
102 my_real
103 . pm_stack(*)
104C-----------------------------------------------
105 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
106 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
107 TYPE (SURF_) , DIMENSION(NSLIN) :: IGRSLIN
108 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
109 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
110 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
111 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
112 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
113 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
114 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
115 TYPE(detonators_struct_),TARGET,INTENT(IN) :: DETONATORS
116C-----------------------------------------------
117C E x t e r n a l F u n c t i o n s
118C-----------------------------------------------
119 INTEGER USR2SYS
120C-----------------------------------------------
121C L o c a l V a r i a b l e s
122C-----------------------------------------------
123 INTEGER I,J,L,NI,GRM,GRS,IGU,MAIN,NUL,NOD,ISK,NRB
124 INTEGER GR_ID,COMPT,TAG,IAD,CUR_ID,NB_RBY
125 INTEGER NB_KIN,NB_LAG,N1,N2,ID_RBY,DOMA,ISTER
126 INTEGER ID_CYL,CCPL,DIFF,D1,D2,G1,G2,GX,IP,JOE,JIE
127 INTEGER COMPT_M,COMPT_S,CUR_TYP,SUM,CONT,K,TYPE2
128 INTEGER NB_INT,ID_INTER,LNM,LNS,L1,L2,ISENS,VAL,WARN
129 INTEGER ID_RLINK,NUL50(50),ID_RBE3,ID_RBE2,ID_JOIN
130 INTEGER NU(4),NS(4),JREC,ID_MPC,ISUR,ISURS,ID_MON,FLG
131 INTEGER COMPT2,IGR9_TEMP,IGR8_TEMP,IGR2_TEMP,ID,ID_PART,IDS
132 INTEGER SPTFL,BID(LNOPT1),IUD,IGRPP_R2R(2,NGRNOD),FLAG_T24T25
133 INTEGER SUB_ID,IDTITL,IDINT,GR_BRIC,NUMC
134 INTEGER NTRANS,NNODE_TRANSFORM,NODE_TRANSFORM(6)
135 INTEGER GRNOD_T24T25
136 my_real f,nul_m
137 CHARACTER MESS*40,TSENS*40
138 CHARACTER(LEN=NCHARTITLE) :: TITR
139 CHARACTER(LEN=NCHARKEY) :: KEY,KEY2
140 CHARACTER(LEN=NCHARFIELD) :: STRING
141 INTEGER, DIMENSION(:), ALLOCATABLE :: BUF_TEMP
142 DATA mess/'MULTIDOMAIN PREREADING OF OPTIONS'/
143 LOGICAL :: IS_AVAILABLE
144C=======================================================================
145
146C--------------------------------------------------------------------C
147C---Counting of nodes / elts for groups and surfaces-----------------C
148C--------------------------------------------------------------------C
149
150 CALL r2r_count(passe,iparts,
151 . ipartc,ipartg,igrpp_r2r ,pm_stack , iworksh,
152 . igrnod,igrsurf,igrslin,igrbric,ixs10,
153 . ixs20,ixs16)
154
155C--------------------------------------------------------------------C
156C------Detection of incompatible options-----------------------------C
157C--------------------------------------------------------------------C
158
159 IF (passe==0) THEN
160
161C-----DAMPING--------------------------------------------------------
162
163 IF (ndamp>0) THEN
164 CALL ancmsg(msgid=837,
165 . msgtype=msgwarning,
166 . anmode=aninfo_blind_1,
167 . c1="/DAMP")
168 ndamp = 0
169 ENDIF
170
171C-----Flexible BODY---------------------------------------------------
172
173 IF (nfxbody>0) THEN
174 CALL ancmsg(msgid=837,
175 . msgtype=msgwarning,
176 . anmode=aninfo,
177 . c1="/FXBODY")
178 nfxbody = 0
179 ENDIF
180
181C-----AMS - temporarily incompatible----------------------------------
182 IF (isms>0) THEN
183 CALL ancmsg(msgid=835,
184 . msgtype=msgerror,
185 . anmode=aninfo,
186 . c1="/AMS")
187 ENDIF
188
189C--------------------------------------------------------------------C
190C------Prereading and tag of SECTIONS--------------------------------C
191C--------------------------------------------------------------------C
192
193 CALL prelecsec(
194 1 nul ,nul ,itabm1 ,1 ,nom_opt(lnopt1*inom_opt(8)+1),
195 2 igrbric ,igrquad ,igrsh4n ,igrsh3n ,igrtruss,
196 3 igrbeam ,igrspring ,igrnod, lsubmodel , seatbelt_shell_to_spring,
197 4 nb_seatbelt_shells)
198
199C--------------------------------------------------------------------C
200C------Prereading and tag of Accelerometers--------------------------C
201C--------------------------------------------------------------------C
202 CALL hm_option_start('/ACCEL')
203 DO i = 1, naccelm
204 CALL hm_option_read_key(lsubmodel, option_titr = titr, option_id = id)
205 CALL hm_get_intv('nodeid', nod, is_available, lsubmodel)
206 CALL hm_get_intv('skewid', isk, is_available, lsubmodel)
207 CALL hm_get_floatv('cutoff', f, is_available, lsubmodel, unitab)
208 nod = usr2sys(nod, itabm1, mess, id)
209 CALL modif_tag(tagno(npart + nod), 2, modif)
210 ENDDO
211C--------------------------------------------------------------------C
212C------Prereading and tag of Transformations-------------------------C
213C--------------------------------------------------------------------C
214 ntrans = 0
215 CALL hm_option_count('TRANSFORM',ntrans)
216 CALL hm_option_start('TRANSFORM')
217 DO i=1,ntrans
218 CALL hm_option_read_key(lsubmodel,
219 . option_id = id,
220 . option_titr = titr,
221 . keyword2 = key)
222C----
223 IF (key(1:3)/='MAT') THEN
224 CALL hm_get_intv('node1',N1,IS_AVAILABLE,LSUBMODEL)
225 CALL HM_GET_INTV('node2',N2,IS_AVAILABLE,LSUBMODEL)
226 IF (N1/=0) THEN
227 N1=USR2SYS(N1,ITABM1,MESS,NI)
228 IF (TAGNO(NPART+N1)==-1) CALL MODIF_TAG(TAGNO(NPART+N1),0,MODIF)
229 ENDIF
230 IF (N2/=0) THEN
231 N2=USR2SYS(N2,ITABM1,MESS,NI)
232 IF (TAGNO(NPART+N2)==-1) CALL MODIF_TAG(TAGNO(NPART+N2),0,MODIF)
233 ENDIF
234 ENDIF
235C----
236 ENDDO
237C--------------------------------------------------------------------C
238C------Prereading and tag of Sensors---------------------------------C
239C--------------------------------------------------------------------C
240
241 CALL HM_OPTION_START('/sensor')
242 DO I=1,NSENSOR
243 CALL HM_OPTION_READ_KEY(LSUBMODEL,
244 . OPTION_ID = ISENS, KEYWORD2 = KEY )
245 IF (KEY(1:4) == 'dist.OR.' KEY(1:5) == 'type2') THEN
246 CALL hm_get_intv ('Sensor1' ,n1 ,is_available,lsubmodel)
247 CALL hm_get_intv ('Sensor2' ,n2 ,is_available,lsubmodel)
248 n1 = usr2sys(n1,itabm1,mess,ni)
249 CALL modif_tag(tagno(npart+n1),2,modif)
250 n2 = usr2sys(n2,itabm1,mess,ni)
251 CALL modif_tag(tagno(npart+n2),2,modif)
252 ELSEIF (key(1:5) == 'INTER'.OR.key(1:5) == 'TYPE6') THEN
253 CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
254 . c1="/SENSOR/INTER")
255 ELSEIF (key(1:4) == 'RWAL'.OR.key(1:5) == 'TYPE7') THEN
256 CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
257 . c1="/SENSOR/RWALL")
258 ELSEIF (key(1:3) == 'VEL' .OR. key(1:5) == 'TYPE9') THEN
259c READ(IIN,REC=IREC,ERR=999,FMT=FMT_I_2F)N1,NUL,NUL
260c N1 = USR2SYS(N1,ITABM1,MESS,NI)
261c CALL MODIF_TAG(TAGNO(NPART+N1),2,MODIF)
262 ELSEIF (key(1:4) /='SENS'.AND.key(1:5)/='TYPE3'
263 . .AND.key(1:3)/='AND'.AND.key(1:5)/='TYPE4'
264 . .AND.key(1:2)/='OR'.AND.key(1:5)/='TYPE5'
265 . .AND.key(1:3)/='NOT'.AND.key(1:5)/='TYPE8'
266 . .AND.key(1:4)/='TIME'.AND.key(1:5)/='TYPE0'
267 . .AND.key(1:4)/='ACCE'.AND.key(1:5)/='TYPE1') THEN
268 tsens = '/SENSOR/'//key(1:5)
269 CALL ancmsg(msgid=835, msgtype=msgerror, anmode=aninfo,
270 . c1=tsens)
271 ENDIF
272 END DO
273C
274C----------------------------------------------------------------------------------C
275C------Prereading and tag of elements/nodes for GAUGES-----------------------------C
276C----------------------------------------------------------------------------------C
277
278 CALL hm_option_start('/GAUGE')
279
280 ALLOCATE(taggau(nbgauge))
281 taggau(:)=0
282
283 DO i=1,nbgauge
284 key=''
285 CALL hm_option_read_key(lsubmodel,
286 . option_id = id,
287 . keyword2 = key )
288
289 flg = 0
290 IF (key(1:3) == 'SPH') cycle
291
292 taggau(i) = id
293
294 CALL hm_get_intv ('NODE1' ,nod ,is_available,lsubmodel)
295 CALL hm_get_intv ('shell_ID' ,ids ,is_available,lsubmodel)
296 IF ((nod== 0).AND.(ids /= 0)) THEN
297 flg = 1
298 !gauges defined by element-------------------------------------
299 DO j=1,numelc
300 IF(ixc(nixc*j)==ids)THEN
301 ids = j
302 EXIT
303 ENDIF
304 ENDDO
305 IF (tag_elc(ids+npart) < 1) THEN
306 CALL modif_tag(tag_elc(ids+npart),1,modif)
307 ENDIF
308 ELSEIF ((nod/=0).AND.(ids==0)) THEN
309 !gauges defined by nodes---------------------------------------
310 nod=usr2sys(nod,itabm1,mess,id)
311 CALL modif_tag(tagno(npart+nod),2,modif)
312 ENDIF
313 END DO
314
315C-----Prereading and tag of elements/nodes for GAUGES and /GAUGE/SPH-------
316 CALL hm_option_start('/GAUGE')
317 DO i=1,nbgauge
318 key=''
319 CALL hm_option_read_key(lsubmodel,
320 . option_id = id,
321 . keyword2 = key )
322
323 flg = 0
324 IF (key(1:3) == 'SPH') THEN
325
326 taggau(i) = -id
327
328 CALL hm_get_intv ('NODE1' ,nod ,is_available,lsubmodel)
329 CALL hm_get_intv ('shell_id' ,IDS ,IS_AVAILABLE,LSUBMODEL)
330.AND. IF ((NOD== 0)(IDS /= 0)) THEN
331 FLG = 1
332 !gauges defined by element-------------------------------------
333 DO J=1,NUMELC
334 IF(IXC(NIXC*J)==IDS)THEN
335 IDS = J
336 EXIT
337 ENDIF
338 ENDDO
339 IF (TAG_ELC(IDS+NPART) < 1) THEN
340 CALL MODIF_TAG(TAG_ELC(IDS+NPART),1,MODIF)
341 ENDIF
342.AND. ELSEIF ((NOD/=0)(IDS==0)) THEN
343 !gauges defined by nodes---------------------------------------
344 NOD=USR2SYS(NOD,ITABM1,MESS,ID)
345 CALL MODIF_TAG(TAGNO(NPART+NOD),2,MODIF)
346 ENDIF
347 ENDIF
348 END DO
349C----------------------------------------------------------------------------------C
350C------Prereading and tag of MONVOL------------------------------------------------C
351C----------------------------------------------------------------------------------C
352
353 NI=0
354 ALLOCATE(TAGMON(NMONVOL + NVOLU))
355 TAGMON(:)=0
356
357C-------------------------------------------------------------------C
358C---------------------------- New Reader ---------------------------C
359C-------------------------------------------------------------------C
360
361 CALL HM_OPTION_START('/monvol')
362 COMPT = 0
363C
364 DO I=1,NMONVOL
365C
366 CALL HM_OPTION_READ_KEY(LSUBMODEL,
367 . OPTION_ID = ID_MON,
368 . KEYWORD2 = KEY)
369C
370 IF (KEY(1:7) == 'airbag1') THEN
371 CALL HM_GET_INTV('surf', ISUR, IS_AVAILABLE, LSUBMODEL)
372 ELSEIF ((KEY(1:4) == 'pres.OR.')(KEY(1:6) == 'airbag')) THEN
373 CALL HM_GET_INTV('entityiddisplayed', ISUR, IS_AVAILABLE, LSUBMODEL)
374 ENDIF
375C
376 ISURS = 0
377 DO J=1,NSURF
378 IF(ISUR==IGRSURF(J)%ID) ISURS=J
379 ENDDO
380C ---> error - tag for error in in reading of monvol <---
381 IF (ISURS==0) GOTO 139
382C
383 IF (IGRSURF(ISURS)%NSEG>0) THEN
384 IF (ISURF_R2R(3,ISURS)==IGRSURF(ISURS)%NSEG) THEN
385C ---> case normal <---
386 GOTO 139
387 ELSEIF (ISURF_R2R(3,ISURS)/=0) THEN
388C ---> case monvol between domains - not allowed <---
389 CALL ANCMSG(MSGID=836,
390 . MSGTYPE=MSGERROR,
391 . ANMODE=ANINFO,
392 . I1=ID_MON)
393 ENDIF
394 ENDIF
395C
396 GOTO 140
397139 TAGMON(I)=ID_MON
398 COMPT = COMPT+1
399140 CONTINUE
400C
401 END DO
402C
403 NEW_HM_NVOLU = COMPT
404 NEW_NVOLU = 0
405
406 ENDIF
407
408C--------------------------------------------------------------------C
409C------Prereading and tag of Cyl joints -> icompatible with interface-C
410C--------------------------------------------------------------------C
411
412 CALL HM_OPTION_START('/cyl_joint')
413 IF (PASSE==0) ALLOCATE(TAGCYL(NJOINT))
414 TAGCYL(:)=0
415 COMPT = 0
416
417 DO I=1,NJOINT
418 CALL HM_OPTION_READ_KEY(LSUBMODEL,
419 . OPTION_ID = ID_CYL)
420 CALL HM_GET_INTV('independentnode',N1,IS_AVAILABLE,LSUBMODEL)
421 CALL HM_GET_INTV('dependentnodes',N2,IS_AVAILABLE,LSUBMODEL)
422 CALL HM_GET_INTV('dependentnodeset',IGU,IS_AVAILABLE,LSUBMODEL)
423C---------------------------------------------------------------------
424 GR_ID = 0
425 DO J=1,NGRNOD
426 IF (IGRNOD(J)%ID==IGU) GR_ID = J
427 END DO
428 N1=USR2SYS(N1,ITABM1,MESS,ID_CYL)
429 N2=USR2SYS(N2,ITABM1,MESS,ID_CYL)
430C---------Tag of error situation--------------------------------------
431 IF (GR_ID==0) THEN
432 IGR2_TEMP = 0
433 IGR8_TEMP = 0
434 IGR9_TEMP = 0
435 ELSE
436 IGR2_TEMP = IGRNOD(GR_ID)%NENTITY
437 IGR8_TEMP = IGRNOD(GR_ID)%R2R_ALL
438 IGR9_TEMP = IGRNOD(GR_ID)%R2R_SHARE
439 ENDIF
440C--------- n1 et n2 must be taken into account in the interface-------
441 IF (TAGNO(N1+NPART)>1) IGR9_TEMP=IGR9_TEMP+1
442 IF (TAGNO(N2+NPART)>1) IGR9_TEMP=IGR9_TEMP+1
443 IF (TAGNO(N1+NPART)>0) IGR8_TEMP=IGR8_TEMP+1
444 IF (TAGNO(N2+NPART)>0) IGR8_TEMP=IGR8_TEMP+1
445 IF (TAGNO(N1+NPART)/=0) IGR2_TEMP=IGR2_TEMP+1
446 IF (TAGNO(N2+NPART)/=0) IGR2_TEMP=IGR2_TEMP+1
447C---------------------------------------------------------------------
448 IF (IGR8_TEMP>0) THEN
449 DIFF = IGR2_TEMP-IGR8_TEMP
450.OR. IF ((IGR9_TEMP>0)(DIFF/=0)) THEN
451C--------CYL_JOINTS on the interface----------------------------------
452 IF (GR_ID>0) THEN
453 DO J=1,IGRNOD(GR_ID)%NENTITY
454 CUR_ID = IGRNOD(GR_ID)%ENTITY(J)
455 IF (TAGNO(CUR_ID+NPART)<3) THEN
456 CALL MODIF_TAG(TAGNO(NPART+CUR_ID),5,MODIF)
457 ENDIF
458 END DO
459 ENDIF
460 IF (TAGNO(N1+NPART)<3) THEN
461 CALL MODIF_TAG(TAGNO(NPART+N1),5,MODIF)
462 ENDIF
463 IF (TAGNO(N2+NPART)<3) THEN
464 CALL MODIF_TAG(TAGNO(NPART+N2),5,MODIF)
465 ENDIF
466 ENDIF
467 COMPT = COMPT + 1
468C--------Tag of CYL_JOINT to keep it----------------------------------
469 TAGCYL(I)=ID_CYL
470 ENDIF
471
472350 CONTINUE
473 END DO
474
475 NEW_NJOINT = COMPT
476
477C--------------------------------------------------------------------C
478C------Prereading and tag of MPC -> icompatible with interface-------C
479C--------------------------------------------------------------------C
480
481 CALL HM_OPTION_START('/mpc')
482 IF (PASSE==0) ALLOCATE(TAGMPC(NUMMPC))
483 TAGMPC(:)=0
484 COMPT = 0
485
486 DO I=1,NUMMPC
487 COMPT_M = 0
488 COMPT_S = 0
489 CALL HM_OPTION_READ_KEY(LSUBMODEL,
490 . OPTION_ID = ID_MPC,
491 . OPTION_TITR = TITR)
492 CALL HM_GET_INTV('number_of_nodes',NUMC,IS_AVAILABLE,LSUBMODEL)
493 DO J=1,NUMC
494 CALL HM_GET_INT_ARRAY_INDEX('node_id',N1,J,IS_AVAILABLE,LSUBMODEL)
495 N2 = USR2SYS(N1,ITABM1,MESS,ID_MPC)
496 IF (TAGNO(N2+NPART)>=0) COMPT_M=COMPT_M+1
497 IF (TAGNO(N2+NPART)>1) COMPT_S=COMPT_S+1
498 IF (TAGNO(N2+NPART)<=0) COMPT_S=COMPT_S+1
499 END DO
500C-----check if MPC must be kept----------------------------------
501 IF (COMPT_M>0) THEN
502 IF (COMPT_S==0) THEN
503C-----MPC intern ->
504 TAGMPC(I) = ID_MPC
505 COMPT = COMPT + 1
506 ELSE
507C--------Temporarily MPC is not allowed on interface
508 CALL ANCMSG(MSGID=896,
509 . MSGTYPE=MSGERROR,
510 . ANMODE=ANINFO,
511 . C1="/MPC",
512 . I1=ID_MPC)
513 ENDIF
514 ENDIF
515 END DO
516
517 NEW_NUMMPC = COMPT
518
519C--------------------------------------------------------------------C
520C------Prereading and tag of GJOINTS -> icompatible with interface---C
521C--------------------------------------------------------------------C
522C
523 CALL HM_OPTION_START('/gjoint')
524 IF (PASSE==0) ALLOCATE(TAGJOIN(NGJOINT))
525 TAGJOIN(:)=0
526 COMPT = 0
527
528 DO I=1,NGJOINT
529 COMPT_M = 0
530 COMPT_S = 0
531C
532 CALL HM_OPTION_READ_KEY(LSUBMODEL,
533 . OPTION_ID = ID_JOIN,
534 . OPTION_TITR = TITR,
535 . KEYWORD2 = KEY2)
536C
537 CALL HM_GET_INTV('node_id0',NU(1),IS_AVAILABLE,LSUBMODEL)
538 CALL HM_GET_INTV('node_id1',NU(2),IS_AVAILABLE,LSUBMODEL)
539 CALL HM_GET_INTV('node_id2',NU(3),IS_AVAILABLE,LSUBMODEL)
540 CALL HM_GET_INTV('node_id3',NU(4),IS_AVAILABLE,LSUBMODEL)
541C
542 VAL = 3
543 IF(KEY2(1:4)=='diff') VAL = 4
544
545 DO J=1,VAL
546 NS(J) = USR2SYS(NU(J),ITABM1,MESS,ID_JOIN)
547 IF (TAGNO(NS(J)+NPART)>=0) COMPT_M=COMPT_M+1
548 IF (TAGNO(NS(J)+NPART)>1) COMPT_S=COMPT_S+1
549 IF (TAGNO(NS(J)+NPART)<=0) COMPT_S=COMPT_S+1
550 END DO
551
552C-----check if GJOINT must be kept----------------------------------
553 IF (COMPT_M>0) THEN
554 IF (COMPT_S==0) THEN
555C-----GJOINT intern ->
556 TAGJOIN(I) = ID_JOIN
557 COMPT = COMPT + 1
558 ELSE
559C--------Temporarily GJOINT is not allowed on interface
560 CALL ANCMSG(MSGID=896,
561 . MSGTYPE=MSGERROR,
562 . ANMODE=ANINFO,
563 . C1="/GJOINT",
564 . I1=ID_JOIN)
565 ENDIF
566 ENDIF
567 END DO
568
569 NEW_NGJOINT = COMPT
570
571C--------------------------------------------------------------------C
572C------Prereading and tag of RBE2 -> icompatible with interface------C
573C--------------------------------------------------------------------C
574
575 IF (PASSE==0) ALLOCATE(TAGRB2(NRBE2))
576 TAGRB2(:)=0
577 COMPT = 0
578
579 CALL HM_OPTION_START('/rbe2')
580 DO I=1,NRBE2
581
582 CALL HM_OPTION_READ_KEY(LSUBMODEL,
583 . OPTION_ID = ID_RBE2,
584 . OPTION_TITR = TITR)
585C
586 CALL HM_GET_INTV('independentnode',N1,IS_AVAILABLE,LSUBMODEL)
587 CALL HM_GET_INTV('dependentnodeset',igu,is_available,lsubmodel)
588C
589 n2 = usr2sys(n1,itabm1,mess,id_rbe2)
590 gr_id=0
591 DO j=1,ngrnod
592 IF (igrnod(j)%ID==igu) gr_id = j
593 END DO
594C---------tag of error situation--------------------------------------
595 IF (gr_id==0) THEN
596 compt = compt + 1
597 tagrb2(i)=id_rbe2
598 GOTO 360
599 ENDIF
600C---------------------------------------------------------------------
601 compt_m = igrnod(gr_id)%R2R_ALL
602 compt_s = igrnod(gr_id)%R2R_SHARE
603 IF (tagno(n2+npart)>=0) compt_m=compt_m+1
604 IF (tagno(n2+npart)>1) compt_s=compt_s+1
605 IF (tagno(n2+npart)<=0) compt_s=compt_s+1
606C-----check if RBE2 must be kept--------------------------------------
607 IF (compt_m>0) THEN
608 IF (compt_s==0) THEN
609C-----RBE2 intern ->
610 tagrb2(i) = id_rbe2
611 compt = compt + 1
612 ELSE
613C--------Temporarily RBE2 is not allowed on interface
614 CALL ancmsg(msgid=896,
615 . msgtype=msgerror,
616 . anmode=aninfo,
617 . c1="/RBE2",
618 . i1=id_rbe2)
619 ENDIF
620 ENDIF
621360 CONTINUE
622 END DO
623
624 new_nrbe2 = compt
625
626C--------------------------------------------------------------------C
627C------Prereading and tag of RBE. -> icompatible with interface------C
628C--------------------------------------------------------------------C
629
630 IF (passe==0) ALLOCATE(tagrb3(nrbe3))
631 tagrb3(:)=0
632 compt = 0
633 CALL hm_option_start('/RBE3')
634
635 DO i=1,nrbe3
636 compt_s = 0
637 compt_m = 0
638 CALL hm_option_read_key(lsubmodel,
639 . option_id = id_rbe3,
640 . option_titr = titr)
641 CALL hm_get_intv('dependentnode',n1,is_available,lsubmodel)
642 CALL hm_get_intv('nset',val,is_available,lsubmodel)
643
644 ALLOCATE(buf_temp(val))
645 n2 = usr2sys(n1,itabm1,mess,id_rbe3)
646C-----Reading of groups------------------------------------------
647 DO l=1,val
648 CALL hm_get_float_array_index('independentnodesetcoeffs',f,l,is_available,lsubmodel,unitab)
649 CALL hm_get_int_array_index('independentnodesets',igu,l,is_available,lsubmodel)
650 DO j=1,ngrnod
651 IF (igrnod(j)%ID==igu) gr_id = j
652 END DO
653 buf_temp(l)=gr_id
654 compt_m = compt_m + igrnod(gr_id)%R2R_ALL
655 compt_s = compt_s + igrnod(gr_id)%R2R_SHARE
656 END DO
657
658 IF (tagno(n2+npart)>=0) compt_m=compt_m+1
659 IF (tagno(n2+npart)>1) compt_s=compt_s+1
660 IF (tagno(n2+npart)<=0) compt_s=compt_s+1
661
662C-----check if RBE3 must be kept----------------------------------
663 IF (compt_m>0) THEN
664 IF (compt_s==0) THEN
665C-----RBE3 intern ->
666 tagrb3(i) = id_rbe3
667 compt = compt + 1
668 ELSE
669C-----RBE3 between domains -> all nodes on the interface
670 IF (tagno(npart+n2)/=-1) THEN
671C-----tag of rbe3 that can see secondary nodes
672 tagrb3(i) = id_rbe3
673 compt = compt +1
674 ENDIF
675 DO l=1,val
676 gr_id = buf_temp(l)
677 DO j=1,igrnod(gr_id)%NENTITY
678 cur_id = igrnod(gr_id)%ENTITY(j)
679 IF (tagno(cur_id+npart)<3) THEN
680 CALL modif_tag(tagno(npart+cur_id),4,modif)
681 ENDIF
682 END DO
683 END DO
684 ENDIF
685 ENDIF
686 DEALLOCATE(buf_temp)
687 END DO
688
689 new_nrbe3 = compt
690
691C--------------------------------------------------------------------C
692C------Prereading and tag of Rigid links -> icompatible with interface-C
693C--------------------------------------------------------------------C
694
695 IF (passe==0) ALLOCATE(taglnk(nlink))
696 taglnk(:)=0
697 compt = 0
698 CALL hm_option_start('/RLINK')
699
700 DO i=1,nlink
701 CALL hm_option_read_key(lsubmodel,
702 . option_id = id_rlink,
703 . option_titr = titr)
704 CALL hm_get_intv('dependentnodeset' ,igu ,is_available,lsubmodel)
705C---------------------------------------------------------------------
706 gr_id = 0
707 DO j=1,ngrnod
708 IF (igrnod(j)%ID==igu) gr_id = j
709 END DO
710C-----check if RBE3 must be kept-----------------------------------
711 tag = 0
712 nod=igrnod(gr_id)%R2R_ALL
713 IF (igrnod(gr_id)%R2R_SHARE==0) tag = 1
714C-----tag of rlink and of all nodes--------------------------------
715 IF (nod>0) THEN
716 compt = compt+1
717 taglnk(i)=id_rlink
718 IF(tag/=1) THEN
719C-----RLINK between domains -> all nodes on the interface
720 DO j=1,igrnod(gr_id)%NENTITY
721 cur_id = igrnod(gr_id)%ENTITY(j)
722 IF (tagno(cur_id+npart)<3) THEN
723 CALL modif_tag(tagno(npart+cur_id),5,modif)
724 ENDIF
725 END DO
726 ENDIF
727 ENDIF
728 END DO
729
730 new_nlink = compt
731C
732C-------------------------------------------------------------------C
733C------Prereading and tag of contact interfaces --------------------C
734C---- if contact between domains > pretag of needed elements-------C
735C-------------------------------------------------------------------C
736C
737 compt_t2 = 0
738 nb_int = 0
739 kcur = kinter
740C
741C--> for TYPE19 interfaces NSLASH(KCUR) > NINTER because of specific /card for TYPE19
742 IF (passe==0) ALLOCATE(tagint(hm_ninter+nslash(kcur)),tagint_warn(ninter+1))
743C
744C-- -> FOR TAGINT subinterfaces are stored with interfaces in order of the reader
745C-- -> TAGINT( --- INTER new reader + SUB interfaces --- INTER old reader -- )
746C
747 tagint(:)=0
748 tagint_warn(:)=0
749 flg_tied(:) = 0
750C
751C-------------------------------------------------------------------C
752C---------------------------- New Reader ---------------------------C
753C-------------------------------------------------------------------C
754C
755 CALL hm_option_start('/INTER')
756 ni = 0
757 compt = 0
758C
759 DO i=1,hm_ninter
760C
761 tag = 0
762 val = iddom
763 type2 = 0
764C
765 CALL hm_option_read_key(lsubmodel,
766 . option_id = id_inter,
767 . unit_id = nul,
768 . submodel_id = sub_id,
769 . option_titr = titr,
770 . keyword2 = key,
771 . keyword3 = key2)
772C
773 tag = 0
774 val = iddom
775 type2 = 0
776C
777 flg = 0
778 IF (key(6:6)=='/') flg = 1
779 IF ((len_trim(key))==5) flg = 1
780c
781 grnod_t24t25 = 0
782 flag_t24t25 = 0
783 IF ((key(1:6)=='TYPE24').OR.(key(1:6)=='TYPE25')) THEN
784 flag_t24t25 = 1
785 CALL hm_get_intv('secondaryentityids',grs,is_available,lsubmodel)
786 CALL hm_get_intv('GRNOD_ID',grnod_t24t25,is_available,lsubmodel)
787C if grs and grnod are defined grnod is ignored
788 IF ((grs > 0).AND.(grnod_t24t25 > 0)) grnod_t24t25 = 0
789 ENDIF
790C
791C ---------> case nodes/surfaces---------------------------------------
792 IF (((key(1:5)=='TYPE2').AND.(flg==1)).OR.
793 . (key(1:5)=='TYPE7').OR.(key(1:5)=='TYPE5').OR.(key(1:5)=='TYPE8').OR.
794 . (key(1:6)=='TYPE10').OR.(key(1:6)=='TYPE14').OR.
795 . ((key(1:6)=='TYPE24').AND.(grnod_t24t25 > 0)).OR.
796 . ((key(1:6)=='TYPE25').AND.(grnod_t24t25 > 0))) THEN
797 cont = 1
798 CALL hm_get_intv('secondaryentityids',GRS,IS_AVAILABLE,LSUBMODEL)
799 CALL HM_GET_INTV('mainentityids',GRM,IS_AVAILABLE,LSUBMODEL)
800C
801C-- TYPE24 and TYPE25 with slave side defined by grnod
802 IF (FLAG_T24T25 == 1) GRS = GRNOD_T24T25
803C
804C--> type2 interfaces with penality are treated like type7 <------C
805 IF ((KEY(1:5)=='type2.AND.')(FLG==1)) THEN
806 CALL HM_GET_INTV('wflag',SPTFL,IS_AVAILABLE,LSUBMODEL)
807.AND. IF ((SPTFL/=25)(SPTFL/=26)) THEN
808 CONT = 0
809 TYPE2 = 1
810 ENDIF
811 ENDIF
812
813C--> check if the contact is between domains and if it is asymmetric <------C
814 CALL TAGINT_R2R(G1,G2,GRS,GRM,ID_INTER,
815 . TYPE2,VAL,TAG,I,COMPT,PASSE,0,IGRPP_R2R,
816 . IGRNOD ,IGRSURF ,IGRSLIN, IGRBRIC)
817
818C--> for type 2 contact type5 r2r coupling is used to prevent null mass on nodes
819 IF (TYPE2==1) THEN
820 DO J=1,IGRNOD(G1)%NENTITY
821 CUR_ID = IGRNOD(G1)%ENTITY(J)
822 IF (TAGNO(CUR_ID+NPART)==2) FLG_TIED(4) = 1
823 IF (TAGNO(CUR_ID+NPART)==4) FLG_TIED(5) = 1
824 END DO
825 ENDIF
826C-->
827 IF (TAG>0) THEN
828 COMPT_T2 = COMPT_T2 + 1
829C--> pretag of elts on main side of contact to keep them with void material <---C
830.OR..OR. IF ((TAG==3)(TAG==1)(TAG==4)) THEN
831 CALL TAG_ELEM_VOID_R2R(IGRSURF(G2)%NSEG,IPARTS,
832 . IPARTC,IPARTG,IPARTSP,VAL,CONT,MODIF,MEMTR,0,0,EANI,
833 . IGRSURF(G2),IGRNOD,G2)
834 ENDIF
835C--> pretag of elts on second. side of contact to keep them with void material <---C
836.OR. IF ((TAG==2)(TAG==1)) THEN
837 CALL TAG_ELEM_VOID_R2R(IGRNOD(G1)%NENTITY,IPARTS,
838 . IPARTC,IPARTG,IPARTSP,VAL,CONT,MODIF,MEMTR,0,1,EANI,
839 . IGRSURF,IGRNOD,G1)
840 ENDIF
841 ENDIF
842C
843C ---------> case of TYPE18 contact interface---------------------------------------
844 ELSEIF (KEY(1:6) == 'type18') THEN
845 CONT = 1
846 CALL HM_GET_INTV('aleelemsentityids',GR_BRIC,IS_AVAILABLE,LSUBMODEL)
847 CALL HM_GET_INTV('alenodesentityids',GRS,IS_AVAILABLE,LSUBMODEL)
848 CALL HM_GET_INTV('mainentityids',GRM,IS_AVAILABLE,LSUBMODEL)
849
850C--> check if the contact is between domains and if it is asymmetric <------C
851 IF (GRS > 0) THEN
852 CALL TAGINT_R2R(G1,G2,GRS,GRM,ID_INTER,
853 . TYPE2,VAL,TAG,I,COMPT,PASSE,0,IGRPP_R2R,
854 . IGRNOD ,IGRSURF ,IGRSLIN, IGRBRIC)
855 ELSEIF (GR_BRIC > 0) THEN
856 CALL TAGINT_R2R(G1,G2,GR_BRIC,GRM,ID_INTER,
857 . TYPE2,VAL,TAG,I,COMPT,PASSE,3,IGRPP_R2R,
858 . IGRNOD ,IGRSURF ,IGRSLIN, IGRBRIC)
859 ENDIF
860C-->
861 IF (TAG > 0) THEN
862 COMPT_T2 = COMPT_T2 + 1
863C--> pretag of elts on main side of contact to keep them with void material <---C
864.OR..OR. IF ((TAG == 3) (TAG == 1) (TAG == 4)) THEN
865 CALL TAG_ELEM_VOID_R2R(IGRSURF(G2)%NSEG,IPARTS,
866 . IPARTC,IPARTG,IPARTSP,VAL,CONT,MODIF,MEMTR,0,0,EANI,
867 . IGRSURF(G2),IGRNOD,G2)
868 ENDIF
869C--> pretag of elts on second. side of contact to keep them with void material <---C
870.OR. IF ((TAG == 2) (TAG == 1)) THEN
871 IF (GRS > 0) THEN
872 CALL TAG_ELEM_VOID_R2R(IGRNOD(G1)%NENTITY,IPARTS,
873 . IPARTC,IPARTG,IPARTSP,VAL,CONT,MODIF,MEMTR,0,1,EANI,
874 . IGRSURF,IGRNOD,G1)
875 ELSEIF (GR_BRIC > 0) THEN
876 DO J=1,IGRBRIC(G1)%NENTITY
877 CUR_ID = IGRBRIC(G1)%ENTITY(J)
878C------------------------> Tag of solid elements of grbric <-------------C
879.AND. IF ((TAG_ELS(CUR_ID+NPART)<(1+CONT))(TAGNO(IPARTS(CUR_ID))/=VAL)) THEN
880 CALL MODIF_TAG(TAG_ELS(CUR_ID+NPART),1+CONT,MODIF)
881 ENDIF
882 ENDDO
883 ENDIF
884 ENDIF
885 ENDIF
886C
887 ELSEIF (KEY(1:6)=='type11') THEN
888 CONT = 1
889 WARN = 0
890 CALL HM_GET_INTV('secondaryentityids',GRS,IS_AVAILABLE,LSUBMODEL)
891 CALL HM_GET_INTV('mainentityids',GRM,IS_AVAILABLE,LSUBMODEL)
892C--> check if the contact is between domains and if it is asymmetric <------C
893 CALL TAGINT_R2R(G1,G2,GRS,GRM,ID_INTER,
894 . TYPE2,VAL,TAG,I,COMPT,PASSE,2,IGRPP_R2R,
895 . IGRNOD ,IGRSURF ,IGRSLIN, IGRBRIC)
896 IF (TAG>0) THEN
897 COMPT_T2 = COMPT_T2 + 1
898C--> pretag of elts of line1 to keep them with void material <---C
899.OR. IF ((TAG==2)(TAG==1)) THEN
900 CALL TAG_ELEM_VOID_R2R_LIN(IGRSLIN(G1)%NSEG,
901 . IPARTS,IPARTC,IPARTG,IPARTT,IPARTP,IPARTR,VAL,CONT,
902 . MODIF,WARN,IGRSLIN(G1))
903 ENDIF
904C--> pretag of elts of line2 to keep them with void material <---C
905.OR. IF ((TAG==3)(TAG==1)) THEN
906 CALL TAG_ELEM_VOID_R2R_LIN(IGRSLIN(G2)%NSEG,
907 . IPARTS,IPARTC,IPARTG,IPARTT,IPARTP,IPARTR,VAL,CONT,
908 . MODIF,WARN,IGRSLIN(G2))
909 ENDIF
910 ENDIF
911 IF (WARN==1) THEN
912 CALL ANCMSG(MSGID=892,
913 . MSGTYPE=MSGERROR,
914 . ANMODE=ANSTOP,
915 . I1=ID_INTER)
916 ENDIF
917 ELSEIF (KEY(1:6)=='type24.OR.'KEY(1:6)=='type21.OR.'KEY(1:5)=='type6.OR.'
918 . KEY(1:6)=='type23.OR.'KEY(1:6)=='type20.OR.'KEY(1:6)=='type15.OR.'
919 . KEY(1:6)=='type25.OR.'((KEY(1:5)=='type3.AND.')(FLG==1))) THEN
920 CONT = 1
921 CALL HM_GET_INTV('secondaryentityids',GRS,IS_AVAILABLE,LSUBMODEL)
922 CALL HM_GET_INTV('mainentityids',GRM,IS_AVAILABLE,LSUBMODEL)
923.AND. IF ((FLAG_T24T25 == 1)(GRM==0)) GRM = GRS
924C--> check if the contact is between domains and if it is asymmetric <------C
925 CALL TAGINT_R2R(G1,G2,GRS,GRM,ID_INTER,
926 . TYPE2,VAL,TAG,I,COMPT,PASSE,1,IGRPP_R2R,
927 . IGRNOD ,IGRSURF ,IGRSLIN, IGRBRIC)
928 IF (TAG>0) THEN
929 COMPT_T2 = COMPT_T2 + 1
930C--> pretag of elts of surface 1 to keep them with void material <---C
931.OR. IF ((TAG==2)(TAG==1)) THEN
932 CALL TAG_ELEM_VOID_R2R(IGRSURF(G1)%NSEG,IPARTS,
933 . IPARTC,IPARTG,IPARTSP,VAL,CONT,MODIF,MEMTR,0,0,EANI,
934 . IGRSURF(G1),IGRNOD,G1)
935 ENDIF
936C--> pretag of elts of surface 2 to keep them with void material <---C
937.OR. IF ((TAG==3)(TAG==1)) THEN
938 CALL TAG_ELEM_VOID_R2R(IGRSURF(G2)%NSEG,IPARTS,
939 . IPARTC,IPARTG,IPARTSP,VAL,CONT,MODIF,MEMTR,0,0,EANI,
940 . IGRSURF(G2),IGRNOD,G2)
941 ENDIF
942 ENDIF
943C
944C ---------> other contact interfaces not compatible with multidomains
945 ELSEIF (KEY(1:3)/='sub') THEN
946 CALL ANCMSG(MSGID=835,
947 . MSGTYPE=MSGERROR,
948 . ANMODE=ANINFO,
949 . I1=ID_INTER,
950 . C1=LINE(1:13))
951 ENDIF
952
953 END DO
954C
955 NEW_HM_NINTER = COMPT
956 NEW_NINTER = 0
957 NEW_NSLASH_INT = 0
958C
959C-------------------------------------------------------------------C
960C------Prereading and tag of ∕INTER/SUB ----------------------------C
961C-------------------------------------------------------------------C
962C
963 CALL HM_OPTION_START('/inter')
964C
965 COMPT = 0
966 DO I=1,HM_NINTER
967C
968 CALL HM_OPTION_READ_KEY(LSUBMODEL,
969 . OPTION_ID = ID_INTER,
970 . UNIT_ID = NUL,
971 . SUBMODEL_ID = SUB_ID,
972 . OPTION_TITR = TITR,
973 . KEYWORD2 = KEY,
974 . KEYWORD3 = KEY2)
975C
976 IF (KEY(1:3)=='sub') THEN
977 CALL HM_GET_INTV('interfaceid',IDINT,IS_AVAILABLE,LSUBMODEL)
978C
979 DO J=1,HM_NINTER+NSLASH(KCUR)
980 IF (TAGINT(J)==IDINT) THEN
981 TAGINT(I) = ID_INTER
982 COMPT = COMPT + 1
983 ENDIF
984 END DO
985
986 ENDIF
987C
988 END DO
989C
990 NEW_NINTSUB = COMPT
991 NEW_HM_NINTER = NEW_HM_NINTER + COMPT
992C
993C--------------------------------------------------------------------C
994C------Prereading and tag of rigid bodies ---------------------------C
995C--------------------------------------------------------------------C
996
997 NI=0
998 NB_RBY = 0
999 NB_KIN = 0
1000 NB_LAG = 0
1001 IF (PASSE==0) ALLOCATE(TAGRBY(NRBODY))
1002 TAGRBY(:)=0
1003 DOMA = 1
1004
1005C--------------------------------------------------
1006C START BROWSING MODEL RBODY
1007C--------------------------------------------------
1008 CALL HM_OPTION_START('/rbody')
1009 NRB = 0
1010 DO I=1,NRBODY
1011C--------------------------------------------------
1012C EXTRACT DATAS OF /RBODY/... LINE
1013C--------------------------------------------------
1014 KEY=''
1015 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1016 . OPTION_ID = ID_RBY,
1017 . KEYWORD2 = KEY,
1018 . OPTION_TITR = TITR)
1019C---------
1020 IF(KEY(1:6)=='lagmul') CYCLE
1021C---------
1022 NRB=NRB+1
1023C---------
1024 CALL HM_GET_INTV('node_id',MAIN,IS_AVAILABLE,LSUBMODEL)
1025 CALL HM_GET_INTV('sens_id',ISENS,IS_AVAILABLE,LSUBMODEL)
1026 CALL HM_GET_INTV('grnd_id',IGU,IS_AVAILABLE,LSUBMODEL)
1027C---------
1028 MAIN=USR2SYS(MAIN,ITABM1,MESS,ID_RBY)
1029 DO J=1,NGRNOD
1030 IF (IGRNOD(J)%ID==IGU) GR_ID = J
1031 END DO
1032C-----check if RBODY must be kept----------------------------------
1033 TAG = 0
1034 COMPT=IGRNOD(GR_ID)%R2R_ALL
1035 COMPT2=IGRNOD(GR_ID)%R2R_SHARE
1036C--> check of tag of the main node
1037 IF (TAGNO(MAIN+NPART)>1) COMPT = COMPT + 1
1038 IF (TAGNO(MAIN+NPART)>1) COMPT2 = COMPT2 + 1
1039 IF (COMPT2==0) TAG = 1
1040C-----tag of the main node-----------------------------------------
1041 IF (COMPT>0) THEN
1042 IF(TAG==1) THEN
1043C-----RGBODY intern ->
1044 CALL MODIF_TAG(TAGNO(NPART+MAIN),1,MODIF)
1045 ELSE
1046C-----RGBODY between domains -> all nodes one the r2r interface
1047 IF (TAGNO(MAIN+NPART)<3) THEN
1048 CALL MODIF_TAG(TAGNO(NPART+MAIN),3,MODIF)
1049 IF (ISENS/=0) THEN
1050 CALL ANCMSG(MSGID=976,
1051 . MSGTYPE=MSGERROR,
1052 . ANMODE=ANINFO,
1053 . C1="FOR RBODY ID=",
1054 . I1=ID_RBY,
1055 . C2="- RBODY WITH SENSOR")
1056 ENDIF
1057 ENDIF
1058 ENDIF
1059C-----tag of the RBODY to keep it
1060 TAGRBY(I)=ID_RBY
1061 NB_RBY = NB_RBY + 1
1062 NB_KIN = NB_KIN + 1
1063 ENDIF
1064 END DO
1065 NEW_NRBYKIN=NB_KIN
1066
1067C--------------------------------------------------
1068C START BROWSING MODEL /RBODY/LAGMUL
1069C--------------------------------------------------
1070 CALL HM_OPTION_START('/rbody')
1071 NRB = 0
1072 DO I=1,NRBODY
1073C--------------------------------------------------
1074C EXTRACT DATAS OF /RBODY/... LINE
1075C--------------------------------------------------
1076 KEY=''
1077 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1078 . OPTION_ID = ID_RBY,
1079 . KEYWORD2 = KEY,
1080 . OPTION_TITR = TITR)
1081C---------
1082 IF(KEY(1:6)=='lagmul') THEN
1083 NRB=NRB+1
1084C--------Temporarily RBY/LAGMUL are not allowed
1085 CALL ANCMSG(MSGID=835,
1086 . MSGTYPE=MSGERROR,
1087 . ANMODE=ANINFO,
1088 . C1=LINE(1:L+9))
1089C-----------------------------------------------------------------
1090 CALL HM_GET_INTV('node_id',MAIN,IS_AVAILABLE,LSUBMODEL)
1091 CALL HM_GET_INTV('grnd_id',IGU,IS_AVAILABLE,LSUBMODEL)
1092C--------Temporarily RBY/LAGMUL are not allowed
1093 MAIN=USR2SYS(MAIN,ITABM1,MESS,ID_RBY)
1094 DO J=1,NGRNOD
1095 IF (IGRNOD(J)%ID==IGU) GR_ID = J
1096 END DO
1097
1098C-----check if RBODY kas to be kept--------------------------------
1099
1100 TAG = 0
1101 COMPT=IGRNOD(GR_ID)%R2R_ALL
1102 COMPT2=IGRNOD(GR_ID)%R2R_SHARE
1103C--> check of tag of the main node
1104 IF (TAGNO(MAIN+NPART)>1) COMPT = COMPT + 1
1105 IF (TAGNO(MAIN+NPART)>1) COMPT2 = COMPT2 + 1
1106 IF (COMPT2==0) TAG = 1
1107
1108C-----Tag of the main node-----------------------------------------
1109
1110 IF (COMPT>0) THEN
1111 IF(TAG==1) THEN
1112C-----RGBODY intern ->
1113 CALL MODIF_TAG(TAGNO(NPART+MAIN),1,MODIF)
1114 ELSE
1115C-----RGBODY between domains -> all nodes one the r2r interface
1116 IF (TAGNO(MAIN+NPART)<3) THEN
1117 CALL MODIF_TAG(TAGNO(NPART+MAIN),3,MODIF)
1118 ENDIF
1119 ENDIF
1120C-----tag of the RBODY to keep it-----------------------------------
1121 TAGRBY(I)=ID_RBY
1122 NB_RBY = NB_RBY + 1
1123 NB_LAG = NB_LAG + 1
1124 ENDIF ! IF (COMPT>0) THEN
1125 END IF ! IF(KEY(1:6)=='lagmul') THEN
1126 END DO
1127
1128 NEW_NRBY = NB_RBY
1129 NRBYLAG = NB_LAG
1130
1131C--------------------------------------------------------------------C
1132C------Prereading and tag of /SPHBCS --------------------------------C
1133C--------------------------------------------------------------------C
1134
1135 NSPCONDN = 0
1136 CALL HM_OPTION_START('/sphbcs')
1137 IF (PASSE==0) ALLOCATE(TAGSPHBCS(NSPCOND))
1138 TAGSPHBCS(:) = 0
1139 DO I=1,NSPCOND
1140 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1141 . OPTION_ID = ID,
1142 . OPTION_TITR = TITR,
1143 . KEYWORD2 = KEY)
1144 CALL HM_GET_INTV('entityid',IGU,IS_AVAILABLE,LSUBMODEL)
1145C---------------------------------------------------------------------
1146 GR_ID = 0
1147 DO J=1,NGRNOD
1148 IF (IGRNOD(J)%ID==IGU) GR_ID = J
1149 END DO
1150C---------------------------------------------------------------------
1151 COMPT = 0
1152 DO L=1,IGRNOD(GR_ID)%NENTITY
1153 CUR_ID = NOD2SP(IGRNOD(GR_ID)%ENTITY(L))
1154 IF (TAGNO(IPARTSP(CUR_ID))/=0) THEN
1155 COMPT = COMPT + 1
1156 ENDIF
1157 ENDDO
1158C---------------------------------------------------------------------
1159 IF (COMPT>0) THEN
1160 NSPCONDN = NSPCONDN + 1
1161 TAGSPHBCS(I) = ID
1162 ENDIF
1163 END DO
1164
1165C--------------------------------------------------------------------C
1166C------Prereading and tag of inlets/outlets for SPH -----------------C
1167C--------------------------------------------------------------------C
1168
1169
1170 NSPHION = 0
1171 IF (PASSE == 0) ALLOCATE(TAGSPHIO(NSPHIO))
1172 TAGSPHIO(:) = 0
1173 CALL HM_OPTION_START('/sph/inout')
1174 DO I = 1,NSPHIO
1175 ! Title and ID
1176 TITR = ''
1177 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1178 . OPTION_ID = ID,
1179 . OPTION_TITR = TITR)
1180 CALL HM_GET_INTV('pid' ,ID_PART ,IS_AVAILABLE,LSUBMODEL)
1181 CALL HM_GET_INTV('surf_id' ,ISUR ,IS_AVAILABLE,LSUBMODEL)
1182C--------------------------------------------------------------------
1183 DO J=1,NPART
1184 IF (IPART_L(4,J) == ID_PART) IDS = J
1185 ENDDO
1186 DO J=1,NSURF
1187 IF (IGRSURF(J)%ID == ISUR) G2 = J
1188 END DO
1189C--------------------------------------------------------------------
1190 IF (TAGNO(IDS) /= 0) THEN
1191 CALL TAG_ELEM_VOID_R2R(IGRSURF(G2)%NSEG,IPARTS,
1192 . IPARTC,IPARTG,IPARTSP,1,0,MODIF,MEMTR,-2,0,EANI,
1193 . IGRSURF(G2),IGRNOD,G2)
1194 NSPHION = NSPHION + 1
1195 TAGSPHIO(I) = ID
1196 ENDIF
1197 END DO
1198
1199C--------------------------------------------------------------------C
1200C------Prereading of ALE/LINK----------------------------------------C
1201C--------------------------------------------------------------------C
1202
1203 CALL HM_OPTION_COUNT('/ale/link/vel', NALELK)
1204 IF (NALELK > 0) THEN
1205 CALL HM_OPTION_START('/ale/link/vel')
1206 DO I = 1, NALELK
1207 CALL HM_OPTION_READ_KEY(LSUBMODEL, OPTION_ID = ID, OPTION_TITR = TITR)
1208 CALL HM_GET_INTV('node_id1', N1, IS_AVAILABLE, LSUBMODEL)
1209 CALL HM_GET_INTV('node_id2', N2, IS_AVAILABLE, LSUBMODEL)
1210 CALL HM_GET_INTV('grnod_id', GR_ID, IS_AVAILABLE, LSUBMODEL)
1211 DO J = 1, NGRNOD
1212 IF (IGRNOD(J)%ID == GR_ID) THEN
1213 GR_ID = J
1214 EXIT
1215 ENDIF
1216 ENDDO
1217 N1 = USR2SYS(N1, ITABM1, MESS, ID)
1218 N2 = USR2SYS(N2, ITABM1, MESS, ID)
1219 IF (N1 > 0) THEN
1220.AND. IF ((IGRNOD(GR_ID)%R2R_ALL > 0) (TAGNO(NPART+N1) < 1)) THEN
1221 CALL MODIF_TAG(TAGNO(NPART + N1), 2, MODIF)
1222.AND. ELSEIF ((IGRNOD(GR_ID)%R2R_SHARE > 0) (TAGNO(NPART+N1) == 1)) THEN
1223 CALL MODIF_TAG(TAGNO(NPART+N1), 2, MODIF)
1224 ELSEIF (TAGNO(NPART+N1) == 0) THEN
1225 CALL MODIF_TAG(TAGNO(NPART+N1), 2, MODIF)
1226 ELSEIF (TAGNO(NPART+N1) == -1) THEN
1227 CALL MODIF_TAG(TAGNO(NPART+N1), 0, MODIF)
1228 ENDIF
1229 ENDIF
1230 IF (N2 > 0) THEN
1231.AND. IF ((IGRNOD(GR_ID)%R2R_ALL > 0) (TAGNO(NPART+N2) < 1)) THEN
1232 CALL MODIF_TAG(TAGNO(NPART+N2), 2, MODIF)
1233.AND. ELSEIF ((IGRNOD(GR_ID)%R2R_SHARE > 0) (TAGNO(NPART+N2) == 1)) THEN
1234 CALL MODIF_TAG(TAGNO(NPART+N2), 2, MODIF)
1235 ELSEIF (TAGNO(NPART+N2) == 0) THEN
1236 CALL MODIF_TAG(TAGNO(NPART+N2), 2, MODIF)
1237 ELSEIF (TAGNO(NPART+N2) == -1) THEN
1238 CALL MODIF_TAG(TAGNO(NPART+N2), 0, MODIF)
1239 ENDIF
1240 ENDIF
1241 ENDDO
1242 ENDIF
1243
1244C--------------------------------------------------------------------C
1245C------Prereading and tag of RWALL-----------------------------------C
1246C--------------------------------------------------------------------C
1247
1248 CALL HM_OPTION_START('/rwall')
1249C
1250 DO I=1,NRWALL
1251C
1252 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1253 . OPTION_ID = ID_MON,
1254 . KEYWORD2 = KEY)
1255C
1256 IF (KEY(1:7) == 'lagmul') THEN
1257C--------RWALL /LAGMUL not allowed with multidomains
1258 CALL ANCMSG(MSGID=835,
1259 . MSGTYPE=MSGERROR,
1260 . ANMODE=ANINFO,
1261 . C1=LINE(1:L+6))
1262 ELSE
1263 CALL HM_GET_INTV('node1',NOD,IS_AVAILABLE,LSUBMODEL)
1264 IF (NOD>0) THEN
1265 NOD=USR2SYS(NOD,ITABM1,MESS,ID)
1266 CALL MODIF_TAG(TAGNO(NPART+NOD),4,MODIF)
1267 ENDIF
1268 ENDIF
1269 ENDDO
1270
1271C--------------------------------------------------------------------C
1272C------Prereading and tag of INIVOL----------------------------------C
1273C--------------------------------------------------------------------C
1274
1275 NEW_NINIVOL = 0
1276 IF (PASSE==0) ALLOCATE(TAG_INIVOL(NUM_INIVOL))
1277 TAG_INIVOL(:) = 0
1278 CALL HM_OPTION_START('/inivol')
1279
1280 DO I=1,NUM_INIVOL
1281 CALL HM_OPTION_READ_KEY(LSUBMODEL, OPTION_ID=ID, OPTION_TITR=TITR)
1282 CALL HM_GET_INTV('secondarycomponentlist', ID_PART, IS_AVAILABLE, LSUBMODEL)
1283C
1284 DO J=1,NPART
1285 IF(IPART_L(4,J)==ID_PART) IDS=J
1286 ENDDO
1287C
1288 IF (TAGNO(IDS) > 0) THEN
1289 TAG_INIVOL(I) = ID
1290 NEW_NINIVOL = NEW_NINIVOL + 1
1291 ENDIF
1292 ENDDO
1293
1294C--------------------------------------------------------------------C
1295C------Prereading of /TRANSFORM--------------------------------------C
1296C--------------------------------------------------------------------C
1297C
1298 CALL HM_OPTION_COUNT('transform',NTRANS)
1299 CALL HM_OPTION_START('transform')
1300C
1301 DO I=1,NTRANS
1302C
1303 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1304 . OPTION_ID = ID,
1305 . KEYWORD2 = KEY)
1306C
1307 NNODE_TRANSFORM = 0
1308 NODE_TRANSFORM(1:6) = 0
1309C
1310 IF ((KEY(1:3)=='tra.OR.')(KEY(1:3)=='rot.OR.')(KEY(1:3)=='sym')) THEN
1311 NNODE_TRANSFORM = 2
1312 CALL HM_GET_INTV('node1',NODE_TRANSFORM(1),IS_AVAILABLE,LSUBMODEL)
1313 CALL HM_GET_INTV('node2',NODE_TRANSFORM(2),IS_AVAILABLE,LSUBMODEL)
1314 ELSEIF (KEY(1:3)=='sca') THEN
1315 NNODE_TRANSFORM = 1
1316 CALL HM_GET_INTV('node1',NODE_TRANSFORM(1),IS_AVAILABLE,LSUBMODEL)
1317 ELSEIF (KEY(1:3)=='pos') THEN
1318 NNODE_TRANSFORM = 6
1319 CALL HM_GET_INTV('node1',NODE_TRANSFORM(1),IS_AVAILABLE,LSUBMODEL)
1320 CALL HM_GET_INTV('node2',NODE_TRANSFORM(2),IS_AVAILABLE,LSUBMODEL)
1321 CALL HM_GET_INTV('node3',NODE_TRANSFORM(3),IS_AVAILABLE,LSUBMODEL)
1322 CALL HM_GET_INTV('node4',NODE_TRANSFORM(4),IS_AVAILABLE,LSUBMODEL)
1323 CALL HM_GET_INTV('node5',NODE_TRANSFORM(5),IS_AVAILABLE,LSUBMODEL)
1324 CALL HM_GET_INTV('node6',NODE_TRANSFORM(6),IS_AVAILABLE,LSUBMODEL)
1325 ENDIF
1326C
1327 DO J=1,NNODE_TRANSFORM
1328 IF (NODE_TRANSFORM(J) > 0) THEN
1329 NOD=USR2SYS(NODE_TRANSFORM(J),ITABM1,MESS,ID)
1330 IF (TAGNO(NPART+NOD) == -1) CALL MODIF_TAG(TAGNO(NPART+NOD),0,MODIF)
1331 ENDIF
1332 ENDDO
1333C
1334 ENDDO
1335C
1336C--------------------------------------------------------------------C
1337C------Prereading of detonation points-------------------------------C
1338C--------------------------------------------------------------------C
1339 CALL HM_OPTION_START('/dfs/detpoin')
1340 DO I=1,DETONATORS%N_DET_POINT
1341 CALL HM_OPTION_READ_KEY(LSUBMODEL,OPTION_ID = ID,KEYWORD2 = KEY)
1342 CALL HM_GET_INTV('rad_det_node1', NOD, IS_AVAILABLE, LSUBMODEL)
1343 IF (NOD>0) THEN
1344 NOD=USR2SYS(NOD,ITABM1,MESS,ID)
1345 IF (TAGNO(NPART+NOD) == -1) CALL MODIF_TAG(TAGNO(NPART+NOD),0,MODIF)
1346 ENDIF
1347 ENDDO
1348
1349C------------------------------------------------------------------
1350
1351 RETURN
1352
1353C------------------------------------------------------------------
1354 999 CALL FREERR(3)
1355 RETURN
1356
1357 END SUBROUTINE R2R_PRELEC
1358
1359!||====================================================================
1360!|| r2r_monvol ../starter/source/coupling/rad2rad/r2r_prelec.F
1361!||--- called by ------------------------------------------------------
1362!|| r2r_split ../starter/source/coupling/rad2rad/r2r_split.F
1363!||--- calls -----------------------------------------------------
1364!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
1365!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
1366!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
1367!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
1368!|| usr2sys ../starter/source/system/sysfus.F
1369!||--- uses -----------------------------------------------------
1370!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
1371!|| r2r_mod ../starter/share/modules1/r2r_mod.F
1372!|| restmod ../starter/share/modules1/restart_mod.F
1373!|| submodel_mod ../starter/share/modules1/submodel_mod.F
1374!||====================================================================
1375 SUBROUTINE R2R_MONVOL(TAGPART,TAGPRO,IGRSURF,LSUBMODEL)
1376C-----------------------------------------------
1377C M o d u l e s
1378C-----------------------------------------------
1379 USE RESTMOD
1380 USE R2R_MOD
1381 USE GROUPDEF_MOD
1382 USE SUBMODEL_MOD
1383 USE HM_OPTION_READ_MOD
1384 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE, NCHARKEY
1385C-----------------------------------------------
1386C I m p l i c i t T y p e s
1387C-----------------------------------------------
1388#include "implicit_f.inc"
1389C-----------------------------------------------
1390C C o m m o n B l o c k s
1391C-----------------------------------------------
1392#include "com04_c.inc"
1393#include "r2r_c.inc"
1394C-----------------------------------------------
1395C D u m m y A r g u m e n t s
1396C-----------------------------------------------
1397 INTEGER TAGPART(*),TAGPRO(*)
1398 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
1399 TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
1400C-----------------------------------------------
1401C E x t e r n a l F u n c t i o n s
1402C-----------------------------------------------
1403 INTEGER USR2SYS
1404C-----------------------------------------------
1405C L o c a l V a r i a b l e s
1406C-----------------------------------------------
1407 INTEGER I,NUL,COMPT,TYPE,J,ISUR,ISURS,FLAG,K,CCPL
1408 INTEGER CPT_NOD,CPT_SEG,CPT_CPL,CUR_ID,IAD,CPT_SEG2
1409 INTEGER MAT_ID,NJET,IJET,N1,N2,N3,WARN
1410 CHARACTER MESS*40
1411 CHARACTER(LEN=NCHARTITLE)::TITR
1412 CHARACTER(LEN=NCHARKEY)::KEY
1413 DATA MESS/'injectors '/
1414 LOGICAL :: IS_AVAILABLE
1415C=======================================================================
1416
1417C--------------------------------------------------------------------C
1418C------Prereading and tag of injectors (MONVOL)----------------------C
1419C--------------------------------------------------------------------C
1420
1421 CALL HM_OPTION_START('/monvol')
1422C
1423 DO I=1,NMONVOL
1424C
1425 CALL HM_OPTION_READ_KEY(LSUBMODEL,
1426 . KEYWORD2 = KEY)
1427C
1428 IF(KEY(1:7)=='airbag1')THEN
1429 TYPE = 1
1430 CALL HM_GET_INTV('surf', ISUR, IS_AVAILABLE, LSUBMODEL)
1431 ELSEIF(KEY(1:6)=='airbag')THEN
1432 TYPE = 2
1433 CALL HM_GET_INTV('entityiddisplayed', ISUR, IS_AVAILABLE, LSUBMODEL)
1434 ENDIF
1435
1436C----------------------------------------------------------
1437 DO J=1,NSURF
1438 IF (ISUR==IGRSURF(J)%ID) ISURS=J
1439 ENDDO
1440 CPT_SEG=0
1441 CCPL=0
1442 FLAG=0
1443 DO J=1,IGRSURF(ISURS)%NSEG
1444 CPT_NOD=0
1445 CPT_CPL=0
1446 DO K=1,4
1447 CUR_ID = IGRSURF(ISURS)%NODES(J,K)
1448C --> count of taged nodes <--
1449 IF (TAGNO(CUR_ID+NPART)>=0) THEN
1450 CPT_NOD=CPT_NOD+1
1451 IF (TAGNO(CUR_ID+NPART)==2) CPT_CPL=CPT_CPL+1
1452 ENDIF
1453 END DO
1454C --> if all the nodes of the segment are in the subdomain -it's validated <--
1455 IF (CPT_CPL/=0) WARN = 1
1456 IF (CPT_NOD==4) CPT_SEG=CPT_SEG+1
1457 END DO
1458C--------MONVOL not allowed on multidomains interface--------------------------
1459C IF (WARN>0) THEN
1460C CALL ANSTCKC(LEN_TRIM(LINE),LINE)
1461C CALL ANCWARN(843,ANINFO_BLIND_1)
1462C ENDIF
1463C-------Case AIRBAG1----------------------------------------
1464.AND. IF ((TYPE==1)(TAGMON(I)>0)) THEN
1465 CALL HM_GET_INTV('nb_jet', NJET, IS_AVAILABLE, LSUBMODEL)
1466C --> loop on injectors <--
1467 DO J=1,NJET
1468 CALL HM_GET_INT_ARRAY_INDEX('ijet', IJET, J, IS_AVAILABLE, LSUBMODEL)
1469 CALL HM_GET_INT_ARRAY_INDEX('node1', N1, J, IS_AVAILABLE, LSUBMODEL)
1470 CALL HM_GET_INT_ARRAY_INDEX('node2', N2, J, IS_AVAILABLE, LSUBMODEL)
1471 CALL HM_GET_INT_ARRAY_INDEX('node3', N3, J, IS_AVAILABLE, LSUBMODEL)
1472 IF (IJET==1) THEN
1473 IF (N1/=0) THEN
1474 N1=USR2SYS(N1,ITABM1,MESS,NUL)
1475 IF(TAGNO(N1+NPART)<2) TAGNO(N1+NPART) = 1
1476 ENDIF
1477 IF (N2/=0) THEN
1478 N2=USR2SYS(N2,ITABM1,MESS,NUL)
1479 IF(TAGNO(N2+NPART)<2) TAGNO(N2+NPART) = 1
1480 ENDIF
1481 IF (N3/=0) THEN
1482 N3=USR2SYS(N3,ITABM1,MESS,NUL)
1483 IF(TAGNO(N3+NPART)<2) TAGNO(N3+NPART) = 1
1484 ENDIF
1485 ENDIF
1486 END DO
1487 ENDIF
1488C-------Case AIRBAG----------------------------------------
1489.AND. IF ((TYPE==2)(TAGMON(I)>0)) THEN
1490 CALL HM_GET_INTV('abg_njet', NJET, IS_AVAILABLE, LSUBMODEL)
1491C --> loop on injectors <--
1492 DO J=1,NJET
1493 CALL HM_GET_INT_ARRAY_INDEX('abg_ijet', IJET, J,IS_AVAILABLE, LSUBMODEL)
1494 CALL HM_GET_INT_ARRAY_INDEX('abg_n1', N1, J,IS_AVAILABLE, LSUBMODEL)
1495 CALL HM_GET_INT_ARRAY_INDEX('abg_n2', N2, J,IS_AVAILABLE, LSUBMODEL)
1496 CALL HM_GET_INT_ARRAY_INDEX('abg_n3', N3, J,IS_AVAILABLE, LSUBMODEL)
1497C
1498 IF (IJET==1) THEN
1499 IF (N1/=0) THEN
1500 N1=USR2SYS(N1,ITABM1,MESS,NUL)
1501 IF(TAGNO(N1+NPART)<2) TAGNO(N1+NPART) = 1
1502 ENDIF
1503 IF (N2/=0) THEN
1504 N2=USR2SYS(N2,ITABM1,MESS,NUL)
1505 IF(TAGNO(N2+NPART)<2) TAGNO(N2+NPART) = 1
1506 ENDIF
1507 IF (N3/=0) THEN
1508 N3=USR2SYS(N3,ITABM1,MESS,NUL)
1509 IF(TAGNO(N3+NPART)<2) TAGNO(N3+NPART) = 1
1510 ENDIF
1511 ENDIF
1512 END DO
1513 ENDIF
1514C---------------------------------------------------------
1515 END DO
1516C
1517 NMONVOL = NEW_HM_NVOLU
1518 NVOLU = NEW_NVOLU
1519
1520C-----------
1521 RETURN
1522
1523C------------------------------------------------------------------
1524 999 CALL FREERR(3)
1525 RETURN
1526
1527 END SUBROUTINE R2R_MONVOL
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
detonators_mod
Definition detonators_mod.F:79
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
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: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
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
nod2el_mod
Definition nod2el_mod.F:36
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::tagrb2
integer, dimension(:), allocatable tagrb2
Definition r2r_mod.F:138
r2r_mod::tag_elc
integer, dimension(:), allocatable tag_elc
Definition r2r_mod.F:133
r2r_mod::tagrb3
integer, dimension(:), allocatable tagrb3
Definition r2r_mod.F:138
r2r_mod::tagint
integer, dimension(:), allocatable tagint
Definition r2r_mod.F:132
r2r_mod::taglnk
integer, dimension(:), allocatable taglnk
Definition r2r_mod.F:138
r2r_mod::taggau
integer, dimension(:), allocatable taggau
Definition r2r_mod.F:142
r2r_mod::tagint_warn
integer, dimension(:), allocatable tagint_warn
Definition r2r_mod.F:137
restmod::unitab
type(unit_type_) unitab
Definition restart_mod.F:211
restmod::monvol
integer, dimension(:), allocatable monvol
Definition restart_mod.F:60
restmod::itabm1
integer, dimension(:), allocatable, target itabm1
Definition restart_mod.F:60
restmod::nom_opt
integer, dimension(:), allocatable, target nom_opt
Definition restart_mod.F:60
restmod::ixc
integer, dimension(:), allocatable ixc
Definition restart_mod.F:60
submodel_mod
Definition submodel_mod.F:712
prelecsec
subroutine prelecsec(snstrf, ssecbuf, itabm1, flag_r2r, nom_opt, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrnod, lsubmodel, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition prelecsec.F:52
r2r_count
subroutine r2r_count(passe, iparts, ipartc, ipartg, igrpp_r2r, pm_stack, iworksh, igrnod, igrsurf, igrslin, igrbric, ixs10, ixs20, ixs16)
Definition r2r_count.F:39
r2r_prelec
subroutine r2r_prelec(iparts, ipartc, ipartg, ipartt, ipartp, ipartr, ipartsp, compt_t2, modif, passe, inom_opt, nspcondn, nsphion, ipart_l, memtr, pm_stack, iworksh, igrnod, igrsurf, igrslin, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, new_nslash_int, lsubmodel, new_hm_ninter, new_nintsub, new_ninivol, ixs10, ixs20, ixs16, detonators, nsensor, seatbelt_shell_to_spring, nb_seatbelt_shells)
Definition r2r_prelec.F:62
modif_tag
subroutine modif_tag(tag, new_tag, modif)
Definition routines_r2r.F:31
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
detonators_mod::detonators_struct_
Definition detonators_mod.F:154