hm_read_beam.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_beam (ixp, itab, itabm1, ipart, ipartp, ipm, igeo, lsubmodel, ibeam_vector, rbeam_vector)

Function/Subroutine Documentation

hm_read_beam()

subroutine hm_read_beam	(	integer, dimension(nixp,*), intent(out)	ixp,
		integer, dimension(*), intent(in)	itab,
		integer, dimension(*), intent(in)	itabm1,
		integer, dimension(lipart1,*), intent(in)	ipart,
		integer, dimension(*), intent(out)	ipartp,
		integer, dimension(npropmi,*), intent(in)	ipm,
		integer, dimension(npropgi,*), intent(in)	igeo,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel,
		integer, dimension(numelp), intent(out)	ibeam_vector,
		dimension(3,numelp), intent(out)	rbeam_vector )

Definition at line 37 of file hm_read_beam.F.

C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   READ /BEAM ELEMENTS USING HM_READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME            DESCRIPTION                         
C
C     IXP             /BEAM ARRAY : CONNECTIVITY, ID, PID
C     ITAB            USER ID OF NODES         
C     ITABM1          REVERSE TAB ITAB
C     IPART           PART ARRAY      
C     IPARTP          INTERNAL PART ID OF A GIVEN BEAM (INTERNAL ID) 
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 : submodel_data, nsubmod
      USE reader_old_mod , ONLY : line
      USE user_id_mod , ONLY : id_limit
      use element_mod , only : nixp
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)::IXP(NIXP,*)
      INTEGER,INTENT(OUT)::IPARTP(*)
      INTEGER,INTENT(OUT)::IBEAM_VECTOR(NUMELP) 
      my_real,INTENT(OUT)::rbeam_vector(3,numelp)
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,STAT
      INTEGER INDEX_PART
      CHARACTER MESS*40, MESS2*40
      my_real bid,norm
      INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_BEAM
      INTEGER N2,N3,N4
      real*8, DIMENSION(:), ALLOCATABLE :: vx,vy,vz
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS
      DATA mess /'3D BEAM ELEMENTS DEFINITION             '/
      DATA mess2/'3D BEAM ELEMENTS SELECTION FOR TH PLOT  '/
C=======================================================================
C--------------------------------------------------
C      ALLOCS & INITS
C--------------------------------------------------
      ALLOCATE (sub_beam(numelp),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='SUB_BEAM')
      sub_beam(1:numelp) = 0
      ALLOCATE (vx(numelp),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VX')
      vx(1:numelp) = zero
      ALLOCATE (vy(numelp),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VY')
      vy(1:numelp) = zero
      ALLOCATE (vz(numelp),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,msgtype=msgerror,c1='VZ')
      vz(1:numelp) = zero
      index_part = 1
C--------------------------------------------------
C      READING BEAM INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      CALL cpp_beam_read(ixp,nixp,ipartp,sub_beam,vx,vy,vz)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
      DO i=1,numelp 
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
        IF( ipart(4,index_part) /= ipartp(i) )THEN  
          DO j=1,npart                            
            IF(ipart(4,j)== ipartp(i) ) index_part = j            
          ENDDO  
        ENDIF
        IF(ipart(4,index_part) /= ipartp(i)) THEN
          CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1,c1="BEAM",i1=ipartp(i),i2=ipartp(i),prmod=msg_cumu)
        ENDIF             
        ipartp(i) = index_part
C--------------------------------------------------
        mt=ipart(1,index_part)                         
        ipid=ipart(2,index_part)  
        ixp(1,i)=mt                               
        ixp(5,i)=ipid 
        IF (ixp(6,i)>id_limit%GLOBAL) THEN
          CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,i1=ixp(6,i),c1=line,c2='/BEAM')
        ENDIF
C direction input by vector VX,VY,VZ
        norm = sqrt(vx(i)**2 + vy(i)**2 + vz(i)**2)
        IF (norm > em20) THEN
          ibeam_vector(i) = 1
          rbeam_vector(1,i) = vx(i) / norm
          rbeam_vector(2,i) = vy(i) / norm
          rbeam_vector(3,i) = vz(i) / norm
          ixp(4,i) = ixp(3,i)
        ELSE
          ibeam_vector(i) = 0
          rbeam_vector(1:3,i) = zero
        ENDIF    
C optional Node 3 
        IF ((ixp(4,i)==0 .OR. ixp(4,i)==ixp(2,i) .OR. ixp(4,i)==ixp(3,i)).
     .       and.(ibeam_vector(i)==0)) THEN
          CALL ancmsg(msgid=2093,msgtype=msginfo,anmode=aninfo_blind_1,i1=ipart(4,index_part),i2=ixp(6,i),prmod=msg_cumu)
          ixp(4,i) = ixp(3,i)                    
        ENDIF
        DO j=2,4                                            
          ixp(j,i)=usr2sys(ixp(j,i),itabm1,mess,ixp(6,i))  
        ENDDO
C Node 1 and 2 Must be connected to something (CHECK_BEAM)
C Node 3 is just a used node, to define directions (CHECK_USED)
        CALL anodset(ixp(2,i), check_beam)  
        CALL anodset(ixp(3,i), check_beam)  
        CALL anodset(ixp(4,i), check_used)
      ENDDO
      IF(ALLOCATED(sub_beam)) DEALLOCATE(sub_beam)
      IF(ALLOCATED(vx)) DEALLOCATE(vx)
      IF(ALLOCATED(vy)) DEALLOCATE(vy)
      IF(ALLOCATED(vz)) DEALLOCATE(vz)
C-----------
      CALL ancmsg(msgid=402,msgtype=msgerror,anmode=aninfo_blind_1, prmod=msg_print)
C     
      CALL ancmsg(msgid=2093,msgtype=msginfo,anmode=aninfo_blind_1,prmod=msg_print)
C-------------------------------------
C Search for double IDs
C-------------------------------------
      ids = 79
      i = 0
      j = 0
      CALL vdouble(ixp(nixp,1),nixp,numelp,mess,0,bid)
      ids = 28
      i1=1
      i2=min0(50,numelp)
C-------------------------------------
   90 WRITE (iout,300)
      DO i=i1,i2
        mid=ipm(1,ixp(1,i))   
        pid=igeo(1,ixp(5,i))  
        n2=ixp(2,i)
        n3=ixp(3,i)
        n4=ixp(4,i) 
        IF(n2>0)n2=itab(n2)
        IF(n3>0)n3=itab(n3)
        IF(n4>0)n4=itab(n4)
        IF (ibeam_vector(i) == 0) THEN              
          WRITE (iout,'(7(I10,1X))')i,ixp(6,i),mid,pid,n2,n3,n4
        ELSE
          WRITE (iout,'(6(I10,1X),3(1PG20.13,1X))')i,ixp(6,i),mid,pid,n2,n3,rbeam_vector(1,i),rbeam_vector(2,i),rbeam_vector(3,i)
        ENDIF    
C----------------------------------------------------------------------------------
      ENDDO
      IF(i2==numelp)GOTO 200
      i1=i1+50
      i2=min0(i2+50,numelp)
      GOTO 90
C-------------------------------------
 200  CONTINUE
      RETURN
 300  FORMAT(/' BEAM ELEMENTS'/
     +        ' -------------'/
     + '      LOC-EL     GLO-EL      MATER       GEOM      NODE1      NODE2      NODE3/VECTOR')