44 . MS ,ITABM1 ,IGRNOD ,UNITAB ,IGRSURF,
45 . IPART ,IPMAS ,TOTADDMAS,FLAG ,IGRPART,
61#include "implicit_f.inc"
72 INTEGER ,
INTENT(IN) :: ITABM1(*),IPART(LIPART1,*),FLAG
73 my_real ,
INTENT(IN) :: X(3,*)
74 my_real ,
INTENT(INOUT) :: MS(*),TOTADDMAS
76 TYPE (UNIT_TYPE_),
INTENT(IN) :: UNITAB
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
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
92 CHARACTER(nchartitle) :: TITR,MESS
93 LOGICAL :: IS_AVAILABLE
95 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: ENTITY_MULTI,IFLAG_MULTI
96 my_real,
ALLOCATABLE,
DIMENSION(:) :: amas_multi
101 DATA MESS/
'ADDED MASS DEFINITION '/
124 is_available = .false.
146 . option_titr = titr)
148 CALL hm_get_intv(
'type' ,itype ,is_available,lsubmodel)
151 ipmas(i)%TITLE = titr
153 ipmas(i)%TYPE = itype
155 IF (itype == 0 .or. itype == 1)
THEN
161 CALL hm_get_floatv(
'masses' ,amas ,is_available ,lsubmodel ,unitab)
162 CALL hm_get_intv(
'grnd_ID' ,igr ,is_available ,lsubmodel)
166 . msgtype=msgwarning,
167 . anmode=aninfo_blind_1,
204 IF (igr == igrnod(j)%ID)
THEN
210 IF (j == ngrnod)
THEN
231 nnod = igrnod(igrs)%NENTITY
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))
237 amas = coeff_r2r*amas/
max(1,nnod)
241 DO j=1,igrnod(igrs)%NENTITY
242 nosys=igrnod(igrs)%ENTITY(j)
244 IF ((nsubdom > 0).AND.(ipid == 0))
THEN
245 IF (
tagno(npart+nosys) > 1)
GOTO 150
247 ms(nosys) = ms(nosys) + amas
248 totaddmas = totaddmas + amas
251 nnod = igrnod(igrs)%NENTITY
256 . c1=
'IN /ADMAS OPTION',
261 ELSEIF (itype == 2)
THEN
268 CALL hm_get_floatv(
'masses' ,amas ,is_available ,lsubmodel ,unitab)
269 CALL hm_get_intv(
'surf_ID' ,isu ,is_available ,lsubmodel)
271 IF (amas < zero)
THEN
273 . msgtype=msgwarning,
274 . anmode=aninfo_blind_1,
290 IF (isu == igrsurf(j)%ID)
THEN
292 nn = igrsurf(iss)%NSEG
297 IF (nsubdom > 0)
THEN
307 capt=capt+
tagno(npart+igrsurf(iss)%NODES(j,k))
309 IF (capt == 8)
GOTO 160
312 ity=igrsurf(iss)%ELTYP(j)
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
323 ibufn(4)=igrsurf(iss)%NODES(j,4)
326 CALL surfmas(ms,ibufn,ity,amas,x,igrsurf(iss)%ID,totaddmas,id,titr)
340 ELSEIF (itype == 3 .or. itype == 4)
THEN
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)
348 IF (amas < zero .and. flag == 0)
THEN
350 . msgtype=msgwarning,
351 . anmode=aninfo_blind_1,
357 IF (igrpa == 0 .and. flag == 0)
THEN
364 IF (iflag /= 0 .and. iflag /= 1) iflag = 0
365 ipmas(i)%WEIGHT_FLAG = iflag
369 IF (igrpa == igrpart(j)%ID)
THEN
377 nel = igrpart(igrs)%NENTITY
380 if (.not.
allocated(ipmas(i)%PART))
ALLOCATE(ipmas(i)%PART(nel))
381 if (.not.
allocated(ipmas(i)%PARTID))
ALLOCATE(ipmas(i)%PARTID(nel))
390 ELSEIF(flag == 1)
THEN
392 imasadd = imasadd + 1
394 nel = igrpart(igrs)%NENTITY
396 IF ((nsubdom > 0) .AND.(nel /= igrpart(igrs)%R2R_ALL).AND.(nel > 0))
THEN
403 idp=igrpart(igrs)%ENTITY(j)
404 ipmas(i)%PARTID(j) = idp
405 ipmas(i)%PART(j)%RPMAS = amas
410 ELSEIF (itype == 5)
THEN
415 CALL hm_get_intv(
'entityidsmax' ,entitymax ,is_available ,lsubmodel)
417 ALLOCATE(amas_multi(entitymax))
418 amas_multi(1:entitymax) = zero
419 ALLOCATE(entity_multi(entitymax))
420 entity_multi(1:entitymax) = 0
425 IF (amas_multi(j) < zero)
THEN
427 . msgtype=msgwarning,
428 . anmode=aninfo_blind_1,
434 IF (entity_multi(j) <= 0)
THEN
440 . i2=entity_multi(j))
442 nosys = usr2sys(entity_multi(j),itabm1,mess,id)
444 IF ((nsubdom > 0) .AND. (ipid == 0))
THEN
445 IF (
tagno(npart+nosys) > 1)
GOTO 170
447 ms(nosys) = ms(nosys) + amas_multi(j)
448 totaddmas = totaddmas + amas_multi(j)
451 IF (
ALLOCATED(amas_multi))
DEALLOCATE(amas_multi
452 IF (
ALLOCATED(entity_multi))
DEALLOCATE(entity_multi)
455 ELSEIF (itype == 6 .or. itype == 7)
THEN
459 CALL hm_get_intv(
'entityidsmax' ,entitymax ,is_available ,lsubmodel)
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
469 ipmas(i)%NPART = entitymax
471 if (.not.
allocated(ipmas(i)%PART))
ALLOCATE(ipmas(i)%PART(entitymax))
472 ifallocatedALLOCATE(ipmas(i)%PARTID(entitymax))
481 IF (amas_multi(j) < zero
THEN
483 . msgtype=msgwarning,
484 . anmode=aninfo_blind_1,
490 IF (entity_multi(j) == 0 .and. flag == 0)
THEN
497 IF (iflag_multi(j) /= 0 .and. iflag_multi(j) /= 1) iflag_multi(j) = 0
498 ipmas(i)%WEIGHT_FLAG = iflag_multi(j)
503 IF (entity_multi(j) == ipart(4,k))
THEN
510 IF (nsubdom > 0)
THEN
512 ipmas(i)%NPART = ipmas(i)%NPART -1
518 imasadd = imasadd + 1
520 ipmas(i)%PARTID(ims) = ip
521 ipmas(i)%PART(ims)%RPMAS = amas_multi(j)
528 . i2=entity_multi(j))
534 IF (
ALLOCATED(amas_multi))
DEALLOCATE(amas_multi)
535 IF (
ALLOCATED(entity_multi))
DEALLOCATE(entity_multi)
536 IF (
ALLOCATED(iflag_multi))
DEALLOCATE(iflag_multi)
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)