hm__elngr_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_elngr                 ../starter/source/groups/hm_elngr.F

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

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

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

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

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

!||    hm_get_intv              ../starter/source/devtools/hm_reader/hm_get_intv.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_elngr(IX       ,NIX      ,NIX1     ,NIX2     ,NGRELE   ,

     .                    ELCHAR   ,ID       ,IGRELEM  ,TAGBUF   ,TITR     ,

     .                    FLAG     ,LSUBMODEL)

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

C   M o d u l e s

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

      USE message_mod

      USE groupdef_mod

      USE submodel_mod

      USE hm_option_read_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-----------------------------------------------

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

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

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

      INTEGER IX(NIX,*),TAGBUF(*)

      INTEGER NIX,NIX1,NIX2,NGRELE,ID,FLAG

      CHARACTER ELCHAR*(*)

      CHARACTER(LEN=NCHARTITLE) :: TITR

      TYPE(submodel_data) LSUBMODEL(*)

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

      TYPE (GROUP_)  , DIMENSION(NGRELE) :: IGRELEM

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

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

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

      INTEGER J,L,IE,IADV,JREC,K,ISU,KK,JJ,NEMAX

      LOGICAL IS_AVAILABLE

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

      is_available = .false.

      CALL hm_get_intv('idsmax' ,nemax,is_available,lsubmodel)

      DO kk = 1,nemax

        CALL hm_get_int_array_index ('ids',jj  ,kk,is_available,lsubmodel)

        IF (jj /= 0) THEN

          isu=0

          DO k=1,ngrele

            IF(jj == igrelem(k)%ID) isu=k

          ENDDO

          IF (isu /= 0) THEN

            DO l=1,igrelem(isu)%NENTITY

              ie=igrelem(isu)%ENTITY(l)

              DO k=nix1,nix2

C               tag les noeuds connectes a l'element

                tagbuf(ix(k,ie))=1

              ENDDO

            ENDDO

          ELSEIF(flag==0)THEN

            CALL ancmsg(msgid=172,

     .                  msgtype=msgwarning,

     .                  anmode=aninfo,

     .                  i1=id,c1=titr,

     .                  c2=elchar,

     .                  i2=jj)

          ENDIF

        ENDIF

      ENDDO

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

      RETURN


      END

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

!||    hm_elngrs                ../starter/source/groups/hm_elngr.F

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

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

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

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

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

!||    hm_get_intv              ../starter/source/devtools/hm_reader/hm_get_intv.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_elngrs(IXS      ,IXS10    ,IXS20    ,IXS16    ,NGRELE   ,

     .                     ELCHAR   ,ID       ,IGRELEM  ,TAGBUF   ,TITR     ,

     .                     FLAG     ,LSUBMODEL)

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

C   M o d u l e s

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

      USE message_mod

      USE groupdef_mod

      USE submodel_mod

      USE hm_option_read_mod

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 IXS(NIXS,*),IXS10(6,*),IXS20(12,*),IXS16(8,*),

     .        TAGBUF(*)

      INTEGER NGRELE,ID,FLAG

      CHARACTER ELCHAR*(*)

      CHARACTER(LEN=NCHARTITLE) :: TITR

      TYPE(SUBMODEL_DATA) LSUBMODEL(*)

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

      TYPE (GROUP_)  , DIMENSION(NGRELE) :: IGRELEM

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

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

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

      INTEGER I,J,L,IE,IADV,JREC,K,ISU,ITETRA10,JJ,NEMAX,KK

      LOGICAL IS_AVAILABLE

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

      ITETRA10=0

      CALL hm_get_intv('idsmax' ,nemax,is_available,lsubmodel)

      DO kk = 1,nemax

        CALL hm_get_int_array_index ('ids',jj  ,kk,is_available,lsubmodel)

        IF (jj /= 0) THEN

          isu = 0

          DO k = 1,ngrele

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

              isu = k

              EXIT

            ENDIF

          ENDDO

          IF (isu /= 0) THEN

            DO l=1,igrelem(isu)%NENTITY

              ie = igrelem(isu)%ENTITY(l)

              DO k=2,9

C               tag les noeuds connectes a l'element

                tagbuf(ixs(k,ie))=1

              ENDDO

              IF (ie > numels8 .AND. ie <= numels8+numels10) THEN

                itetra10=itetra10+1

                i = ie-numels8

                DO k=1,6

                  tagbuf(ixs10(k,i))=1

                ENDDO

              ELSEIF (ie > numels8+numels10 .AND.

     .                ie <= numels8+numels10+numels20) THEN

                i = ie-numels8-numels10

                DO k=1,12

                  tagbuf(ixs20(k,i))=1

                ENDDO

              ELSEIF (ie > numels8+numels10+numels20 .AND.

     .                ie <= numels8+numels10+numels20+numels16) THEN

                i = ie-numels8-numels10-numels20

                DO k=1,8

                  tagbuf(ixs16(k,i))=1

                ENDDO

              ENDIF

            ENDDO

          ELSEIF(flag==0)THEN

            CALL ancmsg(msgid=172,

     .                  msgtype=msgwarning,

     .                  anmode=aninfo,

     .                  i1=id,c1=titr,

     .                  c2=elchar,

     .                  i2=jj)

          ENDIF

        ENDIF

      ENDDO

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

      IF (itetra10 /= 0)THEN

        CALL ancmsg(msgid=500,

     .              msgtype=msgwarning,

     .              anmode=aninfo_blind_1,

     .              c1='GRNOD',

     .              i1=id,

     .              c2='GRNOD',

     .              c3=titr)

      ENDIF

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

      RETURN


      END

hm_elngr
subroutine hm_elngr(ix, nix, nix1, nix2, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngr.F:39

hm_elngrs
subroutine hm_elngrs(ixs, ixs10, ixs20, ixs16, ngrele, elchar, id, igrelem, tagbuf, titr, flag, lsubmodel)
Definition hm_elngr.F:116

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:523

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

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