OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_admas.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "r2r_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_admas (ms, itabm1, igrnod, unitab, igrsurf, ipart, ipmas, totaddmas, flag, igrpart, x, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_admas()

subroutine hm_read_admas ( dimension(*), intent(inout) ms,
integer, dimension(*), intent(in) itabm1,
type (group_), dimension(ngrnod), intent(in) igrnod,
type (unit_type_), intent(in) unitab,
type (surf_), dimension(nsurf), intent(in) igrsurf,
integer, dimension(lipart1,*), intent(in) ipart,
type (admas_), dimension(nodmas), intent(inout) ipmas,
intent(inout) totaddmas,
integer, intent(in) flag,
type (group_), dimension(ngrpart), intent(in) igrpart,
dimension(3,*), intent(in) x,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 43 of file hm_read_admas.F.

47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE my_alloc_mod
51 USE unitab_mod
52 USE r2r_mod
53 USE message_mod
54 USE groupdef_mod
55 USE optiondef_mod
56 USE submodel_mod
57 USE hm_option_read_mod
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "scr17_c.inc"
68#include "r2r_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER ,INTENT(IN) :: ITABM1(*),IPART(LIPART1,*),FLAG
73 my_real ,INTENT(IN) :: x(3,*)
74 my_real ,INTENT(INOUT) :: ms(*),totaddmas
75 TYPE(SUBMODEL_DATA),DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
76 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
77C-----------------------------------------------
78 TYPE (GROUP_) , DIMENSION(NGRNOD) ,INTENT(IN) :: IGRNOD
79 TYPE (GROUP_) , DIMENSION(NGRPART) ,INTENT(IN) :: IGRPART
80 TYPE (SURF_) , DIMENSION(NSURF) ,INTENT(IN) :: IGRSURF
81 TYPE (ADMAS_) , DIMENSION(NODMAS) ,INTENT(INOUT):: IPMAS
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER I,J,K,ITYPE,ID,UID,IGR,IGRS,NOSYS,ISU,NNOD,
86 . ISS,NN,IBUFN(4),CAPT,ITY,IPA,IP,IGRPA,IDP,
87 . NEL,IFLAG,JCURR,CPT_LAST,IMS,ENTITYMAX
88 my_real
89 . amas,coeff_r2r
90 LOGICAL LOOP_2
91!
92 CHARACTER(nchartitle) :: TITR,MESS
93 LOGICAL :: IS_AVAILABLE
94!
95 INTEGER, ALLOCATABLE, DIMENSION(:) :: ENTITY_MULTI,IFLAG_MULTI
96 my_real, ALLOCATABLE, DIMENSION(:) :: amas_multi
97C-----------------------------------------------
98C E x t e r n a l F u n c t i o n s
99C-----------------------------------------------
100 INTEGER USR2SYS
101 DATA mess/'ADDED MASS DEFINITION '/
102C=======================================================================
103! IPMAS(IGM)%ID : ADMAS IDENTIFIER
104! IPMAS(IGM)%NPART : NUMBER of parts to get ADMAS
105! IPMAS(IGM)%TYPE : ! ADMAS type
106! = 0 ! Mass is added to each node of node group
107! = 1 ! Mass/N is added to each node of node group.
108! N being the total number of nodes in the node group
109! = 2 ! Mass/Area - additional surface mass applied on the shell area
110! = 3 ! Additional mass distributed on the part-group
111! = 4 ! Final mass distributed on the part-group
112! = 5 ! Mass is added to each single node
113! = 6 ! Additional mass distributed on each single part
114! = 7 ! Final mass distributed on each single part
115! IPMAS(IGM)%TITLE : ADMAS title
116! IPMAS(IGM)%WEIGHT_FLAG : Flag to switch between area weighted distribution and volume
117! weighted distribution of the added mass to parts)
118! = 0 ! Volume weighted distribution (shell and solid parts) (default)
119! = 1 ! Area weighted distribution (shell parts only)
120! IPMAS(IGM)%PARTID : PART_ID to get ADMAS
121! IPMAS(IGM)%PART(J)%RPMAS : ADMAS added to PARTS (or NODES)
122C=======================================================================
123!
124 is_available = .false.
125!
126C--------------------------------------------------
127C START BROWSING MODEL /ADMAS
128C--------------------------------------------------
129 CALL hm_option_start('/ADMAS')
130C--------------------------------------------------
131C BROWSING MODEL ADMAS 1-> NODMAS
132C--------------------------------------------------
133 imasadd = 0
134c for optimisation 1 (last group is memorised)
135 jcurr = 1
136!
137 DO i=1,nodmas
138 titr = ''
139 ims = 0
140C--------------------------------------------------
141C EXTRACT DATAS OF /ADMAS/... LINE
142C--------------------------------------------------
143 CALL hm_option_read_key(lsubmodel,
144 . option_id = id,
145 . unit_id = uid,
146 . option_titr = titr)
147!
148 CALL hm_get_intv('type' ,itype ,is_available,lsubmodel)
149
150!---
151 ipmas(i)%TITLE = titr
152 ipmas(i)%ID = id
153 ipmas(i)%TYPE = itype
154!------
155 IF (itype == 0 .or. itype == 1) THEN
156!------
157!---
158! added mass to nodes of grnod
159!---
160 IF (flag == 0) THEN
161 CALL hm_get_floatv('masses' ,amas ,is_available ,lsubmodel ,unitab)
162 CALL hm_get_intv('grnd_ID' ,igr ,is_available ,lsubmodel)
163!
164 IF(amas < zero)THEN
165 CALL ancmsg(msgid=476,
166 . msgtype=msgwarning,
167 . anmode=aninfo_blind_1,
168 . i1=id,
169 . c1=titr)
170 ENDIF
171!! AMAS = AMAS * FAC_M
172 IF(igr == 0)THEN
173 CALL ancmsg(msgid=668,
174 . msgtype=msgerror,
175 . anmode=aninfo,
176 . c1='/ADMAS',
177 . c2='/ADMAS',
178 . c3=titr,
179 . i1=id)
180 ENDIF
181!
182 igrs=0
183
184c original
185c DO J=1,NGRNOD
186c IF(IGR == IGROU(1,J))THEN
187c IGRS=J
188c GOTO 100
189c ENDIF
190c ENDDO
191c end original
192ccccccccccccccccccccccccc
193c OPTIMISATION1
194ccccccccccccccccccccccccc
195c optimisation to avoid quadratic loop
196c if group is found, next search start from this group
197c optimal in case of sorted list of GRNOD in ADMAS file
198c in case on non sorted file, a dichotomic search is more appropriate
199
200 cpt_last = ngrnod
201 loop_2 = .false.
202110 CONTINUE
203 DO j=jcurr,cpt_last
204 IF (igr == igrnod(j)%ID) THEN
205 igrs = j
206 jcurr = j
207c group found
208 GOTO 100
209 ENDIF
210 IF (j == ngrnod) THEN
211 IF(loop_2)THEN
212c second passage IGRS has not been found we output in error
213 GOTO 100
214 ELSE
215c first passage in loop, we will start a 2nd passage from 1 to jcurr
216 loop_2 = .true.
217 ENDIF
218 cpt_last = jcurr
219 jcurr = 1
220c begin again loop 1
221 GOTO 110
222 ENDIF
223 ENDDO ! DO J=JCURR,CPT_LAST
224ccccccccccccccccccccccccc
225c end OPTIMISATION1
226ccccccccccccccccccccccccc
227100 CONTINUE
228C---
229 IF (itype == 1) THEN
230 coeff_r2r = 1
231 nnod = igrnod(igrs)%NENTITY
232C-----------Multidomains: the total mass is corrected with the new number of nodes--------------
233 IF (nsubdom > 0) THEN
234 IF (ipid==0) nnod = nnod-igrnod(igrs)%R2R_SHARE
235 coeff_r2r=(1.00*nnod)/(1.00*max(1,igrnod(igrs)%R2R_ALL))
236 ENDIF
237 amas = coeff_r2r*amas/max(1,nnod)
238 ENDIF ! ! IF (ITYPE == 1)
239C
240 IF (igrs /= 0) THEN
241 DO j=1,igrnod(igrs)%NENTITY
242 nosys=igrnod(igrs)%ENTITY(j)
243C-----------Multidomains: common nodes are only processed on 1 domain--------------
244 IF ((nsubdom > 0).AND.(ipid == 0)) THEN
245 IF (tagno(npart+nosys) > 1) GOTO 150
246 ENDIF
247 ms(nosys) = ms(nosys) + amas
248 totaddmas = totaddmas + amas
249 150 CONTINUE
250 ENDDO
251 nnod = igrnod(igrs)%NENTITY
252 ELSE
253 CALL ancmsg(msgid=53,
254 . msgtype=msgerror,
255 . anmode=aninfo,
256 . c1='IN /ADMAS OPTION',
257 . i1=igr)
258 ENDIF ! IF (IGRS /= 0)
259 ENDIF ! IF (FLAG == 0)
260!------
261 ELSEIF (itype == 2) THEN
262!------
263!---
264! added mass per unit area for surfaces
265!---
266 IF (flag == 0) THEN
267 isu = 0
268 CALL hm_get_floatv('masses' ,amas ,is_available ,lsubmodel ,unitab)
269 CALL hm_get_intv('surf_ID' ,isu ,is_available ,lsubmodel)
270!
271 IF (amas < zero) THEN
272 CALL ancmsg(msgid=875,
273 . msgtype=msgwarning,
274 . anmode=aninfo_blind_1,
275 . i1=id,
276 . c1=titr,
277 . r1=amas)
278 ENDIF
279!! AMAS = AMAS * FAC_M
280 IF (isu == 0) THEN
281 CALL ancmsg(msgid=872,
282 . msgtype=msgerror,
283 . anmode=aninfo,
284 . i1=id,
285 . c1=titr)
286 ENDIF
287 iss=0
288 nn =0
289 DO j=1,nsurf
290 IF (isu == igrsurf(j)%ID) THEN
291 iss=j
292 nn = igrsurf(iss)%NSEG
293 EXIT
294 ENDIF
295 ENDDO
296C-----------Multidomains -> we count the common segments, we only count them once---
297 IF (nsubdom > 0) THEN
298 IF (iddom > 0) nn = nn-isurf_r2r(1,iss)
299 ENDIF
300C-----------
301 IF (iss /= 0) THEN
302 DO j=1,nn
303 IF (iddom > 0) THEN
304C-----------Multidomains -> we eliminate the common segments, we only process them once---
305 capt=0
306 DO k=1,4
307 capt=capt+tagno(npart+igrsurf(iss)%NODES(j,k))
308 ENDDO
309 IF (capt == 8) GOTO 160
310 ENDIF
311C
312 ity=igrsurf(iss)%ELTYP(j)
313C
314 ibufn(1)=igrsurf(iss)%NODES(j,1)
315 ibufn(2)=igrsurf(iss)%NODES(j,2)
316 ibufn(3)=igrsurf(iss)%NODES(j,3)
317 IF (igrsurf(iss)%NODES(j,3) ==
318 . igrsurf(iss)%NODES(j,4)) ity = 7
319 IF (ity == 7) THEN
320C true triangles (not segments built from 3 nodes) or degenerated
321 ibufn(4)=0
322 ELSE
323 ibufn(4)=igrsurf(iss)%NODES(j,4)
324 ENDIF
325C
326 CALL surfmas(ms,ibufn,ity,amas,x,igrsurf(iss)%ID,totaddmas,id,titr)
327C
328 160 CONTINUE
329 ENDDO ! DO J=1,NN
330 ELSE
331 CALL ancmsg(msgid=873,
332 . msgtype=msgerror,
333 . anmode=aninfo,
334 . i1=id,
335 . c1=titr,
336 . i2=isu)
337 ENDIF ! IF(ISS /= 0)
338 ENDIF ! IF (FLAG == 0)
339!------
340 ELSEIF (itype == 3 .or. itype == 4) THEN
341!------
342! added mass to a group of parts
343!---
344 CALL hm_get_floatv('masses' ,amas ,is_available ,lsubmodel ,unitab)
345 CALL hm_get_intv('grpart_ID' ,igrpa ,is_available ,lsubmodel)
346 CALL hm_get_intv('iflags' ,iflag ,is_available ,lsubmodel)
347!
348 IF (amas < zero .and. flag == 0) THEN
349 CALL ancmsg(msgid=875,
350 . msgtype=msgwarning,
351 . anmode=aninfo_blind_1,
352 . i1=id,
353 . c1=titr,
354 . r1=amas)
355 ENDIF
356!! AMAS = AMAS * FAC_M
357 IF (igrpa == 0 .and. flag == 0) THEN
358 CALL ancmsg(msgid=878,
359 . msgtype=msgerror,
360 . anmode=aninfo,
361 . i1=id,
362 . c1=titr)
363 ENDIF
364 IF (iflag /= 0 .and. iflag /= 1) iflag = 0
365 ipmas(i)%WEIGHT_FLAG = iflag
366 igrs = 0
367C
368 DO j=1,ngrpart
369 IF (igrpa == igrpart(j)%ID) THEN
370 igrs=j
371 EXIT
372 ENDIF
373 ENDDO
374C---
375 IF (flag == 0) THEN
376 IF (igrs /= 0) THEN
377 nel = igrpart(igrs)%NENTITY
378 ipmas(i)%NPART = nel
379! allocate only one time because of "IDDLEVEL"
380 if (.not.allocated(ipmas(i)%PART)) ALLOCATE(ipmas(i)%PART(nel))
381 if (.not.allocated(ipmas(i)%PARTID))ALLOCATE(ipmas(i)%PARTID(nel))
382 ELSE
383 CALL ancmsg(msgid=879,
384 . msgtype=msgerror,
385 . anmode=aninfo,
386 . i1=id,
387 . c1=titr,
388 . i2=igrpa)
389 ENDIF ! IF (IGRS /= 0)
390 ELSEIF(flag == 1)THEN
391 IF (igrs /= 0) THEN
392 imasadd = imasadd + 1
393C
394 nel = igrpart(igrs)%NENTITY
395C-----------Multidomains: we cannot split the mass in this case--------------
396 IF ((nsubdom > 0) .AND.(nel /= igrpart(igrs)%R2R_ALL).AND.(nel > 0)) THEN
397 CALL ancmsg(msgid=893,
398 . msgtype=msgerror,
399 . anmode=aninfo,
400 . i1=id)
401 ENDIF
402 DO j=1,nel
403 idp=igrpart(igrs)%ENTITY(j)
404 ipmas(i)%PARTID(j) = idp
405 ipmas(i)%PART(j)%RPMAS = amas
406 ENDDO
407 ENDIF ! IF (IGRS /= 0)
408 ENDIF ! IF (FLAG == 0)
409!------
410 ELSEIF (itype == 5) THEN
411!------
412! added mass to nodes
413!---
414 IF (flag == 0) THEN
415 CALL hm_get_intv('entityidsmax' ,entitymax ,is_available ,lsubmodel)
416!
417 ALLOCATE(amas_multi(entitymax))
418 amas_multi(1:entitymax) = zero
419 ALLOCATE(entity_multi(entitymax))
420 entity_multi(1:entitymax) = 0
421 DO j=1,entitymax
422 CALL hm_get_float_array_index('masses' ,amas_multi(j) ,j ,is_available, lsubmodel, unitab)
423 CALL hm_get_int_array_index('node_ID' ,entity_multi(j) ,j ,is_available, lsubmodel)
424!
425 IF (amas_multi(j) < zero) THEN
426 CALL ancmsg(msgid=875,
427 . msgtype=msgwarning,
428 . anmode=aninfo_blind_1,
429 . i1=id,
430 . c1=titr,
431 . r1=amas_multi(j))
432 ENDIF
433!! AMAS = AMAS * FAC_M
434 IF (entity_multi(j) <= 0)THEN
435 CALL ancmsg(msgid=871,
436 . msgtype=msgerror,
437 . anmode=aninfo,
438 . i1=id,
439 . c1=titr,
440 . i2=entity_multi(j))
441 ENDIF
442 nosys = usr2sys(entity_multi(j),itabm1,mess,id)
443C-----------multidomains: common nodes are only processed in one domain--------------
444 IF ((nsubdom > 0) .AND. (ipid == 0)) THEN
445 IF (tagno(npart+nosys) > 1) GOTO 170
446 ENDIF
447 ms(nosys) = ms(nosys) + amas_multi(j)
448 totaddmas = totaddmas + amas_multi(j)
449 170 CONTINUE
450 ENDDO ! DO J=1,ENTITYMAX
451 IF (ALLOCATED(amas_multi)) DEALLOCATE(amas_multi)
452 IF (ALLOCATED(entity_multi)) DEALLOCATE(entity_multi)
453 ENDIF ! IF (FLAG == 0)
454!------
455 ELSEIF (itype == 6 .or. itype == 7) THEN
456!------
457! added mass by part
458!---
459 CALL hm_get_intv('entityidsmax' ,entitymax ,is_available ,lsubmodel)
460!
461 ALLOCATE(amas_multi(entitymax))
462 amas_multi(1:entitymax) = zero
463 ALLOCATE(entity_multi(entitymax))
464 entity_multi(1:entitymax) = 0
465 ALLOCATE(iflag_multi(entitymax))
466 iflag_multi(1:entitymax) = 0
467!
468 IF (flag == 0) THEN
469 ipmas(i)%NPART = entitymax
470! allocate only one time because of "IDDLEVEL"
471 if (.not.allocated(ipmas(i)%PART)) ALLOCATE(ipmas(i)%PART(entitymax))
472 if (.not.allocated(ipmas(i)%PARTID))ALLOCATE(ipmas(i)%PARTID(entitymax))
473 ENDIF ! IF (FLAG == 0)
474!
475 ipa = 0
476 DO j=1,entitymax
477 CALL hm_get_float_array_index('masses' ,amas_multi(j) ,j ,is_available, lsubmodel, unitab)
478 CALL hm_get_int_array_index('part_ID' ,entity_multi(j) ,j ,is_available, lsubmodel)
479 CALL hm_get_int_array_index('iflags' ,iflag_multi(j) ,j ,is_available, lsubmodel)
480!
481 IF (amas_multi(j) < zero .and. flag == 0) THEN
482 CALL ancmsg(msgid=875,
483 . msgtype=msgwarning,
484 . anmode=aninfo_blind_1,
485 . i1=id,
486 . c1=titr,
487 . r1=amas_multi(j))
488 ENDIF
489!! AMAS = AMAS * FAC_M
490 IF (entity_multi(j) == 0 .and. flag == 0) THEN
491 CALL ancmsg(msgid=874,
492 . msgtype=msgerror,
493 . anmode=aninfo,
494 . i1=id,
495 . c1=titr)
496 ENDIF
497 IF (iflag_multi(j) /= 0 .and. iflag_multi(j) /= 1) iflag_multi(j) = 0
498 ipmas(i)%WEIGHT_FLAG = iflag_multi(j)
499!
500 ip = 0
501 IF (flag == 1) THEN
502 DO k=1,npart
503 IF (entity_multi(j) == ipart(4,k)) THEN
504 ip = k
505 EXIT
506 ENDIF
507 ENDDO
508!
509C-----------multidomains: parts that do not belong to the domain are ignored--------------
510 IF (nsubdom > 0) THEN
511 IF (tag_part(ip) == 0) THEN
512 ipmas(i)%NPART = ipmas(i)%NPART -1
513 GOTO 180
514 ENDIF
515 ENDIF
516
517 IF (ip > 0) THEN
518 imasadd = imasadd + 1
519 ims = ims + 1
520 ipmas(i)%PARTID(ims) = ip
521 ipmas(i)%PART(ims)%RPMAS = amas_multi(j)
522 ELSE
523 CALL ancmsg(msgid=876,
524 . msgtype=msgerror,
525 . anmode=aninfo,
526 . i1=id,
527 . c1=titr,
528 . i2=entity_multi(j))
529 ENDIF
530180 CONTINUE
531 ENDIF ! IF (FLAG == 1)
532
533 ENDDO ! DO J=1,ENTITYMAX
534 IF (ALLOCATED(amas_multi)) DEALLOCATE(amas_multi)
535 IF (ALLOCATED(entity_multi)) DEALLOCATE(entity_multi)
536 IF (ALLOCATED(iflag_multi)) DEALLOCATE(iflag_multi)
537!------
538 ENDIF ! IF (ITYPE == 0 .or. ITYPE == 1)
539!------
540 ENDDO ! DO I=1,NODMAS
541C---
542 RETURN
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:418
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:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
optiondef_mod
Definition optiondef_mod.F:90
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagno
integer, dimension(:), allocatable tagno
Definition r2r_mod.F:132
r2r_mod::tag_part
integer, dimension(:), allocatable tag_part
Definition r2r_mod.F:134
r2r_mod::isurf_r2r
integer, dimension(:,:), allocatable isurf_r2r
Definition r2r_mod.F:143
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146
surfmas
subroutine surfmas(ms, ibufn, ity, amasu, x, id, addmas, admid, titr)
Definition surfmas.F:33