hm_read_thpart.F File Reference

#include "implicit_f.inc"
#include "scr03_c.inc"
#include "scr17_c.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com10_c.inc"
#include "warn_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_thpart (ipart, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, lsubmodel)

Function/Subroutine Documentation

hm_read_thpart()

subroutine hm_read_thpart	(	integer, dimension(lipart1,*)	ipart,
		type (group_), dimension(ngrbric)	igrbric,
		type (group_), dimension(ngrquad)	igrquad,
		type (group_), dimension(ngrshel)	igrsh4n,
		type (group_), dimension(ngrsh3n)	igrsh3n,
		type (group_), dimension(ngrtrus)	igrtruss,
		type (group_), dimension(ngrbeam)	igrbeam,
		type (group_), dimension(ngrspri)	igrspring,
		type(submodel_data), dimension(nsubmod)	lsubmodel )

Definition at line 41 of file hm_read_thpart.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
      USE submodel_mod
      USE hm_option_read_mod
      USE names_and_titles_mod , ONLY : nchartitle, ncharkey
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      "scr03_c.inc"
#include      "scr17_c.inc"
#include      "units_c.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com10_c.inc"
#include      "warn_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPART(LIPART1,*)
      TYPE (GROUP_)  , DIMENSION(NGRBRIC) :: IGRBRIC
      TYPE (GROUP_)  , DIMENSION(NGRQUAD) :: IGRQUAD
      TYPE (GROUP_)  , DIMENSION(NGRSHEL) :: IGRSH4N
      TYPE (GROUP_)  , DIMENSION(NGRSH3N) :: IGRSH3N
      TYPE (GROUP_)  , DIMENSION(NGRTRUS) :: IGRTRUSS
      TYPE (GROUP_)  , DIMENSION(NGRBEAM) :: IGRBEAM
      TYPE (GROUP_)  , DIMENSION(NGRSPRI) :: IGRSPRING
      TYPE(SUBMODEL_DATA) LSUBMODEL(NSUBMOD)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ID, I, GR, IGR
      CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
      CHARACTER MESS*40,TYP*6
      INTEGER ITYP
      CHARACTER(LEN=NCHARKEY) :: KEY
      LOGICAL IS_ENCRYPTED,IS_AVAILABLE,IS_FOUND_SURF
      my_real bid
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER NINTRIGR
      DATA mess/' THPART DEFINITION                      '/
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      WRITE(iout,'(//A)')'     THPARTS' 
      WRITE(iout,'(A//)')'       -----' 
 
      is_encrypted = .false.
      is_available = .false.
      is_found_surf = .false.
 
      igrelem = 0
      IF(nthpart>0) igrelem = 1
      CALL hm_option_start('/THPART')
      
      DO i=1,nthpart
 
        titr = ''
        typ  = ''            
        CALL hm_option_read_key(lsubmodel,option_id = id,option_titr = titr ,keyword2 = key   )
        CALL hm_option_is_encrypted(is_encrypted)
 
        typ(1:6)=key(1:6)
        titr1=titr
        CALL fretitl(titr,ipart(lipart1-ltitr+1,npart+i),ltitr)
         CALL hm_get_intv('grelem_ID',  gr  ,is_available,lsubmodel)        
        
C ITYP : 1 BRIC, 
C        2 QUAD, 
C        3 SHELL, 
C        4 TRUSS, 
C        5 BEAM, 
C        6 SPRINGS,
C        7 SHELL_3N
 
        ityp = 0
        igr = 0
 
        IF (typ(1:6) == 'GRBRIC') THEN
          ityp = 1
          igr = nintrigr(gr,igrbric,ngrbric)
          IF (ityp == igrbric(igr)%GRTYPE) is_found_surf = .true.
 
        ELSEIF (typ(1:6) == 'GRQUAD') THEN
          ityp = 2
          igr = nintrigr(gr,igrquad,ngrquad)
          IF (ityp == igrquad(igr)%GRTYPE) is_found_surf = .true.
 
        ELSEIF (typ(1:6) == 'GRSHEL') THEN
          ityp = 3
          igr = nintrigr(gr,igrsh4n,ngrshel)
          IF (ityp == igrsh4n(igr)%GRTYPE) is_found_surf = .true.
          
        ELSEIF (typ(1:6) == 'GRTRUS') THEN
          ityp = 4
          igr = nintrigr(gr,igrtruss,ngrtrus)
          IF (ityp == igrtruss(igr)%GRTYPE) is_found_surf = .true.
          
        ELSEIF (typ(1:6) == 'GRBEAM') THEN
          ityp = 5
          igr = nintrigr(gr,igrbeam,ngrbeam)
          IF (ityp == igrbeam(igr)%GRTYPE) is_found_surf = .true.
          
        ELSEIF (typ(1:6) == 'GRSPRI') THEN
          ityp = 6
          igr = nintrigr(gr,igrspring,ngrspri)
          IF (ityp == igrspring(igr)%GRTYPE) is_found_surf = .true.
          
        ELSEIF (typ(1:6) == 'GRSH3N' .OR. typ(1:6) == 'GRTRIA') THEN
          ityp = 7
          igr = nintrigr(gr,igrsh3n,ngrsh3n)
          IF (ityp == igrsh3n(igr)%GRTYPE) is_found_surf = .true.
        ENDIF
        
        IF(.NOT. is_found_surf)THEN
            CALL ancmsg(msgid=763,msgtype=msgerror,anmode=aninfo,i1=id,c1=titr,i2=gr,c2=typ(1:6))
        ENDIF        
        
        WRITE(iout,'(/A,I10,2A)')'THPART:',id,',',trim(titr)
        WRITE(iout,'(A)')       '----'
        WRITE(iout,'(A,A)')'TYPE OF ELEMENT GROUP : ',typ(1:6)
        WRITE(iout,'(A,I10)')'ELEMENT GROUP ID : ',gr
 
        ipart(1,npart+i)=igr
        ipart(2,npart+i)=ityp
        ipart(4,npart+i)=id
 
        IF(ipart(4,npart+i) == 0) THEN
          CALL ancmsg(msgid=493,msgtype=msgerror,anmode=aninfo_blind_1,c1=titr1)
        ENDIF
        
      ENDDO
 
      !-------------------------------------
      ! Search for duplicate IDs
      !-------------------------------------
      CALL udouble(ipart(4,1),lipart1,npart+nthpart,mess,0,bid)
 
      RETURN
C