hm__read__truss_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_read_truss    ../starter/source/elements/reader/hm_read_truss.F

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

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

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

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

!||    anodset          ../starter/source/output/analyse/analyse_node.c

!||    usr2sys          ../starter/source/system/sysfus.F

!||    vdouble          ../starter/source/system/sysfus.F

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

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

!||    reader_old_mod   ../starter/share/modules1/reader_old_mod.F90

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

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


      SUBROUTINE hm_read_truss(IXT ,ITAB,ITABM1,IPART,IPARTT,

     .                  IPM    ,IGEO  ,LSUBMODEL)

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

C   ROUTINE DESCRIPTION :

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

C   READ /TRUSS ELEMENTS USING HM_READER

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

C   DUMMY ARGUMENTS DESCRIPTION:

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

C

C     NAME            DESCRIPTION

C

C     IXT             TRUSS ELEM ARRAY : CONNECTIVITY, ID, PID

C     ITAB            USER ID OF NODES

C     ITABM1          REVERSE TAB ITAB

C     IPART           PART ARRAY

C     IPARTT          INTERNAL PART ID OF A GIVEN TRUSS ELEMENT

C     IPM             MATERIAL ARRAY (INTEGER)

C     IGEO            PROP ARRAY (INTEGER)

C     LSUBMODEL       SUBMODEL STRUCTURE

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

C   M o d u l e s

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

      USE message_mod

      USE submodel_mod , ONLY : nsubmod, submodel_data

      USE reader_old_mod , ONLY : line

      USE user_id_mod , ONLY : id_limit

      use element_mod , only : nixt

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

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

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

#include      "implicit_f.inc"

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

C   A n a l y s e   M o d u l e

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

#include      "analyse_name.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      "param_c.inc"

#include      "units_c.inc"

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

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

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

C INPUT ARGUMENTS

      INTEGER,INTENT(IN)::ITAB(*)

      INTEGER,INTENT(IN)::ITABM1(*)

      INTEGER,INTENT(IN)::IPART(LIPART1,*)

      INTEGER,INTENT(IN)::IGEO(NPROPGI,*)

      INTEGER,INTENT(IN)::IPM(NPROPMI,*)

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

C OUTPUT ARGUMENTS

      INTEGER,INTENT(OUT)::IXT(NIXT,*)

      INTEGER,INTENT(OUT)::IPARTT(*)

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

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

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

      INTEGER I, I1, I2, MID, PID,MT,IPID,IDS,J,N,STAT

      INTEGER INDEX_PART

      CHARACTER MESS*40, MESS2*40

      my_real

     .   bid

      INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_TRUSS

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

C   E x t e r n a l   F u n c t i o n s

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

      INTEGER USR2SYS

C

      DATA mess/'3D TRUSS ELEMENTS DEFINITION            '/

      DATA mess2/'3D TRUSS ELEMENTS SELECTION FOR TH PLOT '/

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

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

C      ALLOCS & INITS

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

      ALLOCATE (sub_truss(numelt),stat=stat)

      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,

     .                             msgtype=msgerror,

     .                             c1='SUB_TRUSS')

      sub_truss(1:numelt) = 0

      index_part = 1

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

C      READING TRUSS INPUTS IN HM STRUCTURE

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

      CALL cpp_truss_read(ixt,nixt,ipartt,sub_truss)

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

C      FILL OTHER STRUCTURES + CHECKS

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

        i=0

        DO n=1,numelt

          i = i + 1

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

C      INTERNAL PART ID

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

          IF( ipart(4,index_part) /= ipartt(i) )THEN

            DO j=1,npart

              IF(ipart(4,j)== ipartt(i) ) index_part = j

            ENDDO

          ENDIF

          IF( ipart(4,index_part) /= ipartt(i) ) THEN

            CALL ancmsg(msgid=402,

     .                  msgtype=msgerror,

     .                  anmode=aninfo_blind_1,

     .                  c1="TRUSS",

     .                  i1=ipartt(i),

     .                  i2=ipartt(i),

     .                  prmod=msg_cumu)

          ENDIF

          ipartt(i) = index_part

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

          mt=ipart(1,index_part)

          ipid=ipart(2,index_part)

          ixt(1,i)=mt

          ixt(4,i)=ipid


          IF (ixt(5,i)>id_limit%GLOBAL) THEN

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

     .                  i1=ixt(5,i),c1=line,c2='/TRUSS')

          ENDIF


          DO j=2,3

            ixt(j,i)=usr2sys(ixt(j,i),itabm1,mess,ixt(5,i))

            CALL anodset(ixt(j,i), check_truss)

          ENDDO

        ENDDO

      IF(ALLOCATED(sub_truss)) DEALLOCATE(sub_truss)

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

      CALL ancmsg(msgid=402,

     .            msgtype=msgerror,

     .            anmode=aninfo_blind_1,

     .            prmod=msg_print)

C

      i1=1

      i2=min0(50,numelt)

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

C Search for double IDs

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

      ids = 79

      i = 0

      j = 0

c      CALL ANCNTS(IDS,I)

      CALL vdouble(ixt(nixt,1),nixt,numelt,mess,0,bid)

c      CALL ANCNTG(IDS,I,J)

      ids = 21

c      CALL ANCHECK(IDS)

C

   90 WRITE (iout,300)

      DO i=i1,i2

           mid=ipm(1,ixt(1,i))

           pid=igeo(1,ixt(4,i))

         WRITE (iout,'(6(I10,1X))') i,ixt(5,i),mid,pid,

     .                    itab(ixt(2,i)),itab(ixt(3,i))

      ENDDO

      IF(i2==numelt)GOTO 200

      i1=i1+50

      i2=min0(i2+50,numelt)

      GOTO 90

C

 200  CONTINUE

      RETURN

C----

 300  FORMAT(/' TRUSS ELEMENTS'            /

     +        ' --------------'            /

     + '  LOC-EL  GLO-EL   MATER    GEOM   NODE1   NODE2')

      RETURN


      END

anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321

my_real
#define my_real
Definition cppsort.cpp:32

hm_read_truss
subroutine hm_read_truss(ixt, itab, itabm1, ipart, ipartt, ipm, igeo, lsubmodel)
Definition hm_read_truss.F:39

message_mod
Definition message_mod.F:1257

submodel_mod
Definition submodel_mod.F:717

submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725

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

vdouble
subroutine vdouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:868

submodel_mod::submodel_data
Definition submodel_mod.F:728