create__seg__clause_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/.

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

!||    create_seg_clause           ../starter/source/model/sets/create_seg_clause.F

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

!||    hm_set                      ../starter/source/model/sets/hm_set.F

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

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

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

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

!||    set_usrtos                  ../starter/source/model/sets/ipartm1.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 create_seg_clause(CLAUSE,  ITABM1  ,JCLAUSE ,IS_AVAILABLE ,LSUBMODEL)

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

C   D e s c r i p t i o n

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

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

C   Create PART Clause from LIST

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

C   DUMMY ARGUMENTS DESCRIPTION:

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

C

C     NAME          DESCRIPTION

C

C     CLAUSE        (SET structure) Clause to be treated

C     IPARTM1       MAP Table UID -> LocalID

C     JCLAUSE       parameter with HM_READER (current clause read)

C     IS_AVAILABLE  Bool / Result of HM_interface

C     LSUBMODEL     SUBMODEL Structure.

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

C   M o d u l e s

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

      USE setdef_mod

      USE submodel_mod

      USE message_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 JCLAUSE

      LOGICAL :: IS_AVAILABLE

      INTEGER, INTENT(IN), DIMENSION(NUMNOD,2) :: ITABM1

      TYPE (SET_) ::  CLAUSE

      TYPE(SUBMODEL_DATA),INTENT(IN):: LSUBMODEL(NSUBMOD)

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

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

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

      INTEGER I,J,NINDX,SEG_MAX,NOD_1,NOD_2,NOD_3,NOD_4,NODSYS_1,NODSYS_2,NODSYS_3,NODSYS_4,SEG_ID,LINE_SEG

      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: BUFSURF

      INTEGER,EXTERNAL :: SET_USRTOS

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

C   S o u r c e  L i n e s

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

      line_seg = 0

      CALL hm_get_int_array_index('segmax' ,seg_max ,jclause,is_available,lsubmodel)

      ALLOCATE(bufsurf(4,seg_max))

      nindx = 0

!

      ! Read & convert Segs

      ! ---------------------

      DO i=1,seg_max  ! always = 1 for clause 'SEG'

        CALL hm_get_int_array_2indexes('segid',seg_id,jclause ,i,is_available,lsubmodel)

        CALL hm_get_int_array_2indexes('ids1' ,nod_1 ,jclause ,i,is_available,lsubmodel)

        CALL hm_get_int_array_2indexes('ids2' ,nod_2 ,jclause ,i,is_available,lsubmodel)

        CALL hm_get_int_array_2indexes('ids3' ,nod_3 ,jclause ,i,is_available,lsubmodel)

        CALL hm_get_int_array_2indexes('ids4' ,nod_4 ,jclause ,i,is_available,lsubmodel)

        nodsys_1 = set_usrtos(nod_1,itabm1,numnod)

        IF (nodsys_1 == 0) THEN

           ! Node was not found. Issue an error.

           CALL ancmsg(msgid=1903,anmode=aninfo,msgtype=msgerror,

     .                             i1 = clause%SET_ID,

     .                             i2=seg_id,

     .                             i3=nod_1,

     .                             c1=trim(clause%TITLE),

     .                             c2='NODE')

        ELSE

          nodsys_1 = itabm1(nodsys_1,2)

        ENDIF


        nodsys_2 = set_usrtos(nod_2,itabm1,numnod)

        IF (nodsys_2 == 0) THEN

          ! Node was not found. Issue an error.

           CALL ancmsg(msgid=1903,anmode=aninfo,msgtype=msgerror,

     .                             i1 = clause%SET_ID,

     .                             i2=seg_id,

     .                             i3=nod_2,

     .                             c1=trim(clause%TITLE),

     .                             c2='node')

        ELSE

          NODSYS_2 = ITABM1(NODSYS_2,2)

        ENDIF


        LINE_SEG = 0

.AND.        IF (NOD_3 == 0  NOD_4 == 0) THEN

          LINE_SEG = 1 ! Line SEG

          NODSYS_3 = 0

          NODSYS_4 = 0

        ELSE

          NODSYS_3 = SET_USRTOS(NOD_3,ITABM1,NUMNOD)

          NODSYS_4 = SET_USRTOS(NOD_4,ITABM1,NUMNOD)

        ENDIF


        IF (LINE_SEG == 0) THEN! Surf SEG --> continue Node check existence

          IF (NODSYS_3 == 0) THEN

            ! Node was not found. Issue an error.

            CALL ANCMSG(MSGID=1903,ANMODE=ANINFO,MSGTYPE=MSGERROR,

     .                             I1 = CLAUSE%SET_ID,

     .                             I2=SEG_ID,

     .                             I3=NOD_3,

     .                             C1=TRIM(CLAUSE%TITLE),

     .                             C2='node')

          ELSE

            ! Node found

            NODSYS_3 = ITABM1(NODSYS_3,2)

          ENDIF


          IF (NOD_4 == 0) THEN

            ! correction to allow for 3 noded surface (triangle)

              NODSYS_4 = NODSYS_3

          ELSE IF (NODSYS_4 == 0) THEN

            ! Node was not found. Issue an error.

            CALL ANCMSG(MSGID=1903,ANMODE=ANINFO,MSGTYPE=MSGERROR,

     .                             I1 = CLAUSE%SET_ID,

     .                             I2=SEG_ID,

     .                             I3=NOD_4,

     .                             C1=TRIM(CLAUSE%TITLE),

     .                             C2='node')

          ELSE IF (NODSYS_4 /= 0) THEN

            ! Node found

              NODSYS_4 =  ITABM1(NODSYS_4,2)

          ENDIF


        ENDIF ! IF (LINE_SEG == 0)


        NINDX = NINDX+1    !   nb of CLAUSE SEGs

        BUFSURF(1,NINDX) = NODSYS_1

        BUFSURF(2,NINDX) = NODSYS_2

        BUFSURF(3,NINDX) = NODSYS_3

        BUFSURF(4,NINDX) = NODSYS_4


      ENDDO ! DO I=1,SEG_MAX


      ! Copy in final SET

      ! ------------------


      !------------------------------------!

      !  create SURF clause or LINE clause !

      !------------------------------------!


      IF (LINE_SEG == 0) THEN


        ! SURF seg (4-node SEG)

        CLAUSE%NB_SURF_SEG = NINDX

        ALLOCATE(CLAUSE%SURF_NODES(NINDX,4))

        ALLOCATE(CLAUSE%SURF_ELTYP(NINDX))

        ALLOCATE(CLAUSE%SURF_ELEM(NINDX))


        DO I=1,NINDX

          CLAUSE%SURF_NODES(I,1) = BUFSURF(1,I) ! N1

          CLAUSE%SURF_NODES(I,2) = BUFSURF(2,I) ! N2

          CLAUSE%SURF_NODES(I,3) = BUFSURF(3,I) ! N3

          CLAUSE%SURF_NODES(I,4) = BUFSURF(4,I) ! N4

          CLAUSE%SURF_ELTYP(I)   = 0  ! ELTYP

          CLAUSE%SURF_ELEM(I)    = 0  ! ELEM

        ENDDO


      ELSE


        ! LINE seg (2-node SEG)

        CLAUSE%NB_LINE_SEG = NINDX

        ALLOCATE(CLAUSE%LINE_NODES(NINDX,2))

        ALLOCATE(CLAUSE%LINE_ELTYP(NINDX))

        ALLOCATE(CLAUSE%LINE_ELEM(NINDX))


        DO I=1,NINDX

          CLAUSE%LINE_NODES(I,1) = BUFSURF(1,I) ! N1

          CLAUSE%LINE_NODES(I,2) = BUFSURF(2,I) ! N2

          CLAUSE%LINE_ELTYP(I)   = 0  ! ELTYP

          CLAUSE%LINE_ELEM(I)    = 0  ! ELEM

        ENDDO


      ENDIF ! IF (LINE_SEG == 0)


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

      DEALLOCATE(BUFSURF)

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

      RETURN


      END

create_seg_clause
subroutine create_seg_clause(clause, itabm1, jclause, is_available, lsubmodel)
Definition create_seg_clause.F:38

hm_get_int_array_2indexes
subroutine hm_get_int_array_2indexes(name, ival, index1, index2, is_available, lsubmodel)
Definition hm_get_int_array_2indexes.F:57

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_option_read_mod
Definition hm_option_read_mod.F:408

message_mod
Definition message_mod.F:1249

setdef_mod
Definition setdef_mod.F:107

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