hm_read_truss.F File Reference

#include "implicit_f.inc"
#include "analyse_name.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_truss (ixt, itab, itabm1, ipart, ipartt, ipm, igeo, lsubmodel)

Function/Subroutine Documentation

hm_read_truss()

subroutine hm_read_truss	(	integer, dimension(nixt,*), intent(out)	ixt,
		integer, dimension(*), intent(in)	itab,
		integer, dimension(*), intent(in)	itabm1,
		integer, dimension(lipart1,*), intent(in)	ipart,
		integer, dimension(*), intent(out)	ipartt,
		integer, dimension(npropmi,*), intent(in)	ipm,
		integer, dimension(npropgi,*), intent(in)	igeo,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel )

Definition at line 38 of file hm_read_truss.F.

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