hm_read_truss.F

Go to the documentation of this file.

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
!||    nintrn           ../starter/source/system/nintrn.F
!||    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
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,ID,IDS,J,N,JC,STAT
      INTEGER FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,CPT,
     .        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 NINTRN
      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 Recherche des ID doubles
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')
 310  FORMAT(' TRUSS ELEMENT TH SELECTION'/
     +       ' --------------------------'/)
      RETURN
      END