hm__tagpart_8F_source.html

Copyright>        OpenRadioss

Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.

Copyright>

Copyright>        This program is free software: you can redistribute it and/or modify

Copyright>        it under the terms of the GNU Affero General Public License as published by

Copyright>        the Free Software Foundation, either version 3 of the License, or

Copyright>        (at your option) any later version.

Copyright>

Copyright>        This program is distributed in the hope that it will be useful,

Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of

Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

Copyright>        GNU Affero General Public License for more details.

Copyright>

Copyright>        You should have received a copy of the GNU Affero General Public License

Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.

Copyright>

Copyright>

Copyright>        Commercial Alternative: Altair Radioss Software

Copyright>

Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss

Copyright>        software under a commercial license.  Contact Altair to discuss further if the

Copyright>        commercial version may interest you: https://www.altair.com/radioss/.

!||====================================================================

!||    hm_tagpart             ../starter/source/groups/hm_tagpart.F

!||--- called by ------------------------------------------------------

!||    hm_lecgre              ../starter/source/groups/hm_lecgre.F

!||    hm_lecgrn              ../starter/source/groups/hm_lecgrn.f

!||    hm_read_grpart         ../starter/source/groups/hm_read_grpart.F

!||--- calls      -----------------------------------------------------

!||    ancmsg                 ../starter/source/output/message/message.F

!||    groups_get_elem_list   ../starter/source/groups/groups_get_elem_list.F

!||--- uses       -----------------------------------------------------

!||    hm_option_read_mod     ../starter/share/modules1/hm_option_read_mod.F

!||    message_mod            ../starter/share/message_module/message_mod.F

!||    r2r_mod                ../starter/share/modules1/r2r_mod.F

!||    submodel_mod           ../starter/share/modules1/submodel_mod.F

!||====================================================================


      SUBROUTINE hm_tagpart(BUFFTMP,IPART  ,KEY   ,

     .                   ID     ,TITR   ,TITR1  ,FLAG   ,SUBSET,LSUBMODEL)

C old routine w/o index of BUFFTMP

C-----------------------------------------------

C   M o d u l e s

C-----------------------------------------------

      USE r2r_mod

      USE message_mod

      USE groupdef_mod

      USE hm_option_read_mod

      USE submodel_mod

      USE names_and_titles_mod , ONLY : nchartitle

C-----------------------------------------------

C   I m p l i c i t   T y p e s

C-----------------------------------------------

#include      "implicit_f.inc"

C-----------------------------------------------

C   C o m m o n   B l o c k s

C-----------------------------------------------

#include      "scr17_c.inc"

#include      "com04_c.inc"

#include      "r2r_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER BUFFTMP(*),IPART(LIPART1,*),ID,

     .        flag

      CHARACTER KEY*(*)

      TYPE(submodel_data) LSUBMODEL(NSUBMOD)

C-----------------------------------------------

      TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      LOGICAL IS_AVAILABLE, IS_ENCRYPTED

      INTEGER J,NSEG,J10(10),IGS,JREC,IADV,ISU,K,L,IPP,NUMA,KK,JJ,NENTITY

      CHARACTER MOT*4

      CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1

      INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ENTITY

C-----------------------------------------------

      INTERFACE

       SUBROUTINE groups_get_elem_list(arg1,arg2,arg3)

        USE submodel_mod

        INTEGER,DIMENSION(:),ALLOCATABLE       :: arg1

        INTEGER,INTENT(INOUT)                  :: arg2

        TYPE(submodel_data)                    :: arg3(NSUBMOD)

       END SUBROUTINE

      END INTERFACE

C=======================================================================

      nentity = 0

      IF (key(1:6) == 'SUBSET') THEN

C-------------------------

C groupes de SUBSETS

C-------------------------

           CALL groups_get_elem_list(list_entity, nentity, lsubmodel)

           DO kk=1,nentity

               jj=list_entity(kk)

               IF(jj /= 0)THEN

                 isu=0

                 DO k=1,nsubs

                   IF (jj == subset(k)%ID) THEN

                     isu=k

                     DO l=1,subset(isu)%NTPART

                       !tag les parts

                       bufftmp(subset(isu)%TPART(l)) = 1

                     ENDDO

                     EXIT

                   ELSEIF (jj == -subset(k)%ID) THEN

                     isu=k

                     DO l=1,subset(isu)%NTPART

                       !tag les parts

                       bufftmp(subset(isu)%TPART(l)) = -1

                     ENDDO

                     EXIT

                   ENDIF

                 ENDDO

                 IF (isu == 0 .AND. flag == 0) THEN

                   CALL ancmsg(msgid=194,

     .                         msgtype=msgwarning,

     .                         anmode=aninfo,

     .                         i1=id,

     .                         c1=titr1,

     .                         c2=titr,

     .                         c3='SUBSET',

     .                         i2=jj)

                 ENDIF

               ENDIF

           enddo! NEXT KK

           IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)


      ELSEIF (key(1:4) == 'PART' .OR. key(1:3) == 'MAT' .OR. key(1:4) == 'PROP') THEN

C-------------------------

C groupes de PART,MAT,PROP

C-------------------------

              IF(key(1:4) == 'PART')THEN

                mot='PART'

                ipp=4

              ELSEIF(key(1:3) == 'MAT')THEN

                mot='MAT'

                ipp=5

              ELSEIF(key(1:4) == 'PROP')THEN

                mot='PROP'

                ipp=6

              ENDIF


                  CALL groups_get_elem_list(list_entity, nentity, lsubmodel)

                  DO kk=1,nentity

                      jj=list_entity(kk)

                      IF(jj /= 0)THEN

                          isu=0

                          DO k=1,npart

                      numa = ipart(ipp,k)

                            IF (nsubdom>0) THEN

                         IF (ipp==5) numa = ipart_r2r(2,k)

                      ENDIF

C-------------------------------------------------------------------------------------------------------------

                            IF(jj == numa)THEN

                              isu=k

C                             !tag les parts

                              bufftmp(isu)=1

                            ELSEIF(-jj == numa)THEN

                              isu=k

C                             !tag les parts

                              bufftmp(isu)=-1

                            ENDIF

                          ENDDO

                          IF(isu == 0 .AND. flag == 0)THEN

                            IF(mot(1:4)/='PART')THEN

                              CALL ancmsg(msgid=195,

     .                             msgtype=msgwarning,

     .                             anmode=aninfo,

     .                             i1=id,

     .                             c1=titr1,

     .                             c2=titr1,

     .                             c3=titr,

     .                             c4=mot,

     .                             i2=jj)

                            ELSE

                               CALL ancmsg(msgid=194,

     .                         msgtype=msgwarning,

     .                         anmode=aninfo,

     .                         i1=id,

     .                         c1=titr1,

     .                         c2=titr1,

     .                         c3=titr,

     .                         c4='PART',

     .                         i2=jj)

                            ENDIF

                          ENDIF

                      ENDIF

                  enddo! NEXT KK

                  IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)


C-------------------------

      ENDIF

C-------------------------

      RETURN


      END

groups_get_elem_list
subroutine groups_get_elem_list(list_entity, nentity, lsubmodel)
Definition groups_get_elem_list.F:46

hm_lecgrn
subroutine hm_lecgrn(itab, itabm1, igrnod, isubmod, x, geo, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ipart, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartg, ipartsp, kxsp, flag, maxnnod, skew, iskn, unitab, ibox, ixs10, ixs20, ixs16, rtrans, lsubmodel, ixx, kxx, ipartx, iadboxmax, igrslin, subset, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrsurf, nsets)
Definition hm_lecgrn.F:66

hm_tagpart
subroutine hm_tagpart(bufftmp, ipart, key, id, titr, titr1, flag, subset, lsubmodel)
Definition hm_tagpart.F:40

groupdef_mod
Definition groupdef_mod.F:662

hm_option_read_mod
Definition hm_option_read_mod.F:408

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

r2r_mod
Definition r2r_mod.F:125

r2r_mod::ipart_r2r
integer, dimension(:,:), allocatable ipart_r2r
Definition r2r_mod.F:144

submodel_mod
Definition submodel_mod.F:712

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

starter
program starter
Definition starter.F:39

submodel_mod::submodel_data
Definition submodel_mod.F:723