hm__grogronod_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_grogronod           ../starter/source/groups/hm_grogronod.F

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

!||    lectur                 ../starter/source/starter/lectur.F

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

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

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

!||    hm_option_read_key     ../starter/source/devtools/hm_reader/hm_option_read_key.F

!||    hm_option_start        ../starter/source/devtools/hm_reader/hm_option_start.F

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

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

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

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

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


      SUBROUTINE hm_grogronod(IGRNOD  ,ICOUNT  ,FLAG    ,ITER  ,ELKEY,

     .                        LSUBMODEL)

!---

! group of groups of elements + parts

!---

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

C   M o d u l e s

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

      USE my_alloc_mod

      USE message_mod

      USE groupdef_mod

      USE submodel_mod

      USE hm_option_read_mod

      USE names_and_titles_mod , ONLY : nchartitle, ncharkey

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      "com04_c.inc"

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

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

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

      INTEGER  FLAG,ICOUNT,ITER

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

      TYPE (GROUP_)  , DIMENSION(NGRNOD) :: IGRNOD

      TYPE(submodel_data) LSUBMODEL(NSUBMOD)

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

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

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

      INTEGER I,J,K,L,ID,NEL,IGS,IGRS,JREC,ISU,NONTRI,JJ,KK,

     .        flag_fmt,flag_fmt_tmp,ifix_tmp,skipflag,uid,nn,nentity

      INTEGER J10(10)

      INTEGER,DIMENSION(:),ALLOCATABLE :: BUFTMP

      INTEGER,DIMENSION(:),ALLOCATABLE :: LIST_ENTITY

      CHARACTER(LEN=NCHARTITLE) :: TITR

      CHARACTER(LEN=NCHARKEY) :: KEY,KEY2

      CHARACTER ELKEY*4

      LOGICAL IS_AVAILABLE

      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=======================================================================

      CALL my_alloc(buftmp,numnod*2)

      is_available = .false.

      IF (flag == 0) icount=0

      igs =0

      CALL hm_option_start('/GRNOD')

C     loop over the groups

      DO i=1,ngrnod

        CALL hm_option_read_key(lsubmodel,

     .                          option_id   = id,

     .                          option_titr = titr  ,

     .                          unit_id     = uid,

     .                          keyword2    = key   ,

     .                          keyword3    = key2 )


        igs=igs+1

        IF (igrnod(igs)%GRPGRP == 2) THEN

          buftmp = 0

          nel=0

          nn = 0

          nontri = igrnod(igs)%SORTED

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

          IF (flag == 0 .AND. igrnod(igs)%NENTITY == -1) THEN

c

            skipflag = 0

            IF (skipflag == 0) THEN

              CALL groups_get_elem_list(list_entity, nentity, lsubmodel)

              DO kk = 1,nentity

                jj = list_entity(kk)

                IF (jj /= 0) THEN

                  igrs=0

                  DO k=1,ngrnod

                    IF (iabs(jj) == igrnod(k)%ID) THEN

                      igrs=k

                      EXIT

                    ENDIF

                  ENDDO

                  IF (igrs == 0) THEN

                    CALL ancmsg(msgid=174,

     .                          msgtype=msgwarning,

     .                          anmode=aninfo,

     .                          i1=igrnod(igs)%ID,c1=titr,

     .                          i2=iabs(jj))

                  ELSEIF (igrnod(igrs)%LEVEL == 0) THEN

C                       reference a un groupe non initialise

                    IF (iter > ngrnod) GOTO 900

                    igrnod(igs)%NENTITY=-1

                    igrnod(igs)%LEVEL=0

                    icount=1

                    skipflag = 1

                    nel = 0

                    cycle

                  ELSE

C                       Reference has an initialized group

                    IF (nontri == 0) THEN

C                         sorted group, tag the nodes

                      DO l=1,igrnod(igrs)%NENTITY

                        IF (jj < 0) THEN

C                             remove nodes from the group if j10 < 0

                          buftmp(igrnod(igrs)%ENTITY(l))=-1

                        ELSEIF (buftmp(igrnod(igrs)%ENTITY(l)) == 0) THEN

                          buftmp(igrnod(igrs)%ENTITY(l))=1

                        ENDIF

                      ENDDO

                    ELSE

c                         non sorted group

                      nel = nel + igrnod(igrs)%NENTITY

                    ENDIF

                  ENDIF ! IF (IGRS == 0)

                ENDIF ! IF (J10(J) /= 0)

              ENDDO ! DO J=1,10

              IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)

            ENDIF ! IF (SKIPFLAG == 0)

C-----

            IF (skipflag == 0) THEN

              IF (nontri == 0 ) THEN

C                  sorted group

                DO j=1,numnod

                  IF (buftmp(j) > 0) nel=nel+1

                ENDDO

              ENDIF

C

              igrnod(igs)%NENTITY = nel

              CALL my_alloc(igrnod(igs)%ENTITY,nel)

              igrnod(igs)%ENTITY = 0

            ENDIF ! IF (SKIPFLAG == 0)

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

          ELSEIF (flag == 1 .AND. igrnod(igs)%LEVEL == 0 .AND.

     .                            igrnod(igs)%NENTITY > -1) THEN

c

            CALL groups_get_elem_list(list_entity, nentity, lsubmodel)

            DO kk=1,nentity

              jj = list_entity(kk)

              IF (jj /= 0) THEN

                igrs=0

                DO k=1,ngrnod

                  IF (iabs(jj) == igrnod(k)%ID) THEN

                    igrs=k

                    EXIT

                  ENDIF

                ENDDO

                IF (igrs == 0) THEN

                ELSEIF (igrnod(igrs)%NENTITY == -1) THEN

                  cycle

                ELSE

                  IF (nontri == 0) THEN

C                       tag the nodes

                    DO l=1,igrnod(igrs)%NENTITY

                      IF (jj < 0) THEN

C                           remove nodes from the group if j10 < 0

                        buftmp(igrnod(igrs)%ENTITY(l))=-1

                      ELSEIF (buftmp(igrnod(igrs)%ENTITY(l)) == 0) THEN

                        buftmp(igrnod(igrs)%ENTITY(l))=1

                      ENDIF

                    ENDDO

                  ELSE

                    DO l=1,igrnod(igrs)%NENTITY

                      nn = nn + 1

                      igrnod(igs)%ENTITY(nn) = igrnod(igrs)%ENTITY(l)

                    ENDDO

                  ENDIF ! IF (NONTRI == 0)

                ENDIF ! IF (IGRS == 0)

              ENDIF ! IF (J10(J) /= 0)

            ENDDO ! DO J=1,10

            IF(ALLOCATED(list_entity))DEALLOCATE (list_entity)

C-----

            IF (nontri == 0) THEN

c               sorted group

              DO j=1,numnod

                IF (buftmp(j) > 0) THEN

                  nn = nn + 1

                  igrnod(igs)%ENTITY(nn)=j

                ENDIF

              ENDDO

            ENDIF ! IF (NONTRI == 0)

            igrnod(igs)%LEVEL = 1

C-----------  end_ flag = 1

          ENDIF ! IF (FLAG == 0 .AND. IGRNOD(IGS)%NENTITY == -1)

        ENDIF ! IF (IGRNOD(IGS)%GRPGRP == 2)

      ENDDO ! DO I=1,NLINE(KCUR)

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

      DEALLOCATE(buftmp)

      RETURN

 900  CALL ancmsg(msgid=176,

     .            msgtype=msgerror,

     .            anmode=aninfo,

     .            i1=id,

     .            c1=titr,

     .            i2=igrnod(igs)%ID,

     .            c2=elkey)

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

      RETURN


      END

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

hm_grogronod
subroutine hm_grogronod(igrnod, icount, flag, iter, elkey, lsubmodel)
Definition hm_grogronod.F:39

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

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

names_and_titles_mod
Definition names_and_titles_mod.F:1002

names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008

names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005

submodel_mod
Definition submodel_mod.F:717

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

submodel_mod::submodel_data
Definition submodel_mod.F:728