47
48
49
50 USE my_alloc_mod
58
59
60
61#include "implicit_f.inc"
62
63
64
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "scr17_c.inc"
68#include "r2r_c.inc"
69
70
71
72 INTEGER ,INTENT(IN) :: ITABM1(*),IPART(LIPART1,*),FLAG
74 my_real ,
INTENT(INOUT) :: ms(*),totaddmas
75 TYPE(SUBMODEL_DATA),DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
76 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
77
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
82
83
84
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,FIRST,CPT_LAST,IMS,ENTITYMAX
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
97
98
99
100 INTEGER USR2SYS
101 DATA mess/'ADDED MASS DEFINITION '/
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124 is_available = .false.
125
126
127
128
130
131
132
133 imasadd = 0
134
135 jcurr = 1
136
137 DO i=1,nodmas
138 titr = ''
139 ims = 0
140
141
142
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
153 ipmas(i)%TYPE = itype
154
155 IF (itype == 0 .or. itype == 1) THEN
156
157
158
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
166 . msgtype=msgwarning,
167 . anmode=aninfo_blind_1,
169 . c1=titr)
170 ENDIF
171
172 IF(igr == 0)THEN
174 . msgtype=msgerror,
175 . anmode=aninfo,
176 . c1='/ADMAS',
177 . c2='/ADMAS',
178 . c3=titr,
180 ENDIF
181
182 igrs=0
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
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
207
208 GOTO 100
209 ENDIF
210 IF (j == ngrnod) THEN
211 IF(loop_2)THEN
212
213 GOTO 100
214 ELSE
215
216 loop_2 = .true.
217 ENDIF
218 cpt_last = jcurr
219 jcurr = 1
220
221 GOTO 110
222 ENDIF
223 ENDDO
224
225
226
227100 CONTINUE
228
229 IF (itype == 1) THEN
230 coeff_r2r = 1
231 nnod = igrnod(igrs)%NENTITY
232
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
239
240 IF (igrs /= 0) THEN
241 DO j=1,igrnod(igrs)%NENTITY
242 nosys=igrnod(igrs)%ENTITY(j)
243
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
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
296
297 IF (NSUBDOM > 0) THEN
298 IF (IDDOM > 0) NN = NN-ISURF_R2R(1,ISS)
299 ENDIF
300
301 IF (ISS /= 0) THEN
302 DO J=1,NN
303 IF (IDDOM > 0) THEN
304
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
311
312 ITY=IGRSURF(ISS)%ELTYP(J)
313
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
320
321 IBUFN(4)=0
322 ELSE
323 IBUFN(4)=IGRSURF(ISS)%NODES(J,4)
324 ENDIF
325
326 CALL SURFMAS(MS,IBUFN,ITY,AMAS,X,IGRSURF(ISS)%ID,TOTADDMAS,ID,TITR)
327
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.or. ELSEIF (ITYPE == 3 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.and. IF (AMAS < ZERO 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.and. IF (IGRPA == 0 FLAG == 0) THEN
358 CALL ANCMSG(MSGID=878,
359 . MSGTYPE=MSGERROR,
360 . ANMODE=ANINFO,
361 . I1=ID,
362 . C1=TITR)
363 ENDIF
364.and. IF (IFLAG /= 0 IFLAG /= 1) IFLAG = 0
365 IPMAS(I)%WEIGHT_FLAG = IFLAG
366 IGRS = 0
367
368 DO J=1,NGRPART
369 IF (IGRPA == IGRPART(J)%ID) THEN
370 IGRS=J
371 EXIT
372 ENDIF
373 ENDDO
374
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.not. if (allocated(IPMAS(I)%PART)) ALLOCATE(IPMAS(I)%PART(NEL))
381.not. if (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
393
394 NEL = IGRPART(IGRS)%NENTITY
395
396.AND..AND. IF ((NSUBDOM > 0) (NEL /= IGRPART(IGRS)%R2R_ALL)(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)
443
444.AND. IF ((NSUBDOM > 0) (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.or. ELSEIF (ITYPE == 6 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.not. if (allocated(IPMAS(I)%PART)) ALLOCATE(IPMAS(I)%PART(ENTITYMAX))
472.not. if (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.and. IF (AMAS_MULTI(J) < ZERO 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.and. IF (ENTITY_MULTI(J) == 0 FLAG == 0) THEN
491 CALL ANCMSG(MSGID=874,
492 . MSGTYPE=MSGERROR,
493 . ANMODE=ANINFO,
494 . I1=ID,
495 . C1=TITR)
496 ENDIF
497.and. IF (IFLAG_MULTI(J) /= 0 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!
509
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.or. ENDIF ! IF (ITYPE == 0 ITYPE == 1)
539!------
540 ENDDO ! DO I=1,NODMAS
541
542 RETURN
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_start(entity_type)
integer, dimension(:), allocatable tagno
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)