hm_read_cyljoint.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	hm_read_cyljoint (ljoint, itabm1, ikine, itab, igrnod, nom_opt, lsubmodel)

Function/Subroutine Documentation

hm_read_cyljoint()

subroutine hm_read_cyljoint	(	integer, dimension(*)	ljoint,
		integer, dimension(*)	itabm1,
		integer, dimension(*)	ikine,
		integer, dimension(*)	itab,
		type (group_), dimension(ngrnod)	igrnod,
		integer, dimension(lnopt1,*)	nom_opt,
		type(submodel_data), dimension(*)	lsubmodel )

Definition at line 46 of file hm_read_cyljoint.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE r2r_mod     
      USE message_mod
      USE groupdef_mod
      USE submodel_mod
      USE hm_option_read_mod 
      USE joint_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "units_c.inc"
#include      "com04_c.inc"
#include      "r2r_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LJOINT(*), ITABM1(*), IKINE(*), ITAB(*)
      INTEGER NOM_OPT(LNOPT1,*)
C-----------------------------------------------
      TYPE (GROUP_)  ,DIMENSION(NGRNOD)   :: IGRNOD
      TYPE(SUBMODEL_DATA) LSUBMODEL(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: K, I, NS, J, LJ, NU, IDIR,ID,N1,N2,IGU,IKINE1(3*NUMNOD),UID,NY,SUB_ID,IGS
      my_real :: bid
      CHARACTER MESS*40
      CHARACTER(LEN=NCHARTITLE) :: TITR
      LOGICAL :: IS_AVAILABLE
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER USR2SYS,NODGRNR5
      EXTERNAL usr2sys,nodgrnr5
C
      DATA mess/'CYLINDRICAL JOINTS DEFINITION           '/
C=======================================================================
C
      is_available = .false.
C
      k=1
      ny = 0
C
      DO i=1,3*numnod
        ikine1(i) = 0
      ENDDO
C      
      CALL hm_option_start('/CYL_JOINT')
C
      DO i=1,njoint
        ny=ny+1
C----------Multidomaines --> on ignore les cyljoint non tags----------
        IF(nsubdom>0)THEN
                  IF(tagcyl(ny)==0)CALL hm_sz_r2r(tagcyl,ny,lsubmodel)
        END IF
C----------------------------------------------------------------------
        CALL hm_option_read_key(lsubmodel,
     .                       option_id = id,
     .                       unit_id = uid,
     .                       submodel_id = sub_id,
     .                       option_titr = titr)
C
        nom_opt(1,i)=id 
        CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)       
C
        CALL hm_get_intv('independentnode',n1,is_available,lsubmodel)
        CALL hm_get_intv('dependentnodes',n2,is_available,lsubmodel)
        CALL hm_get_intv('dependentnodeset',igu,is_available,lsubmodel)
C                                           
        ns=2+nodgrnr5(igu,igs,ljoint(k+3),igrnod,itabm1,mess)  
C
        ljoint(k+1)=usr2sys(n1,itabm1,mess,id)                            
        ljoint(k+2)=usr2sys(n2,itabm1,mess,id)                  
        CALL anodset(ljoint(k+1), check_used)                          
        CALL anodset(ljoint(k+2), check_used)                         
        ljoint(k)=ns                                                   
        WRITE (iout,1000) id,ns                                        
        WRITE (iout,1100) (itab(ljoint(k+j)),j=1,ns)                   
 
        !   allocation of cyl_joint%secondary_node : ns = secondary node + main node
        ALLOCATE( cyl_join(i)%SECONDARY_NODE(ns) )
        DO lj=1,ns
            nu = itab(ljoint(k+lj))
            cyl_join(i)%SECONDARY_NODE(lj) = ljoint(k+lj)
                  IF(joint_sms) CALL ifrontplus(ljoint(k+lj),1)
            !   ----------------------
            DO idir=1,6
                CALL kinset(64,nu,ikine(ljoint(k+lj)),idir,0
     .                        ,ikine1(ljoint(k+lj)))
            ENDDO
            !   ----------------------
        ENDDO
        ! save the number of secondary nodes 
        cyl_join(i)%NB_SECONDARY_NODE = ns
        ! save the main nodes 
        ALLOCATE( cyl_join(i)%MAIN_NODE(2) )
        cyl_join(i)%MAIN_NODE(1:2) = ljoint(k+1:k+2)
        k=k+ns+1
 
      ENDDO
C-------------------------------------
C Recherche des ID doubles
C-------------------------------------
      CALL udouble(nom_opt,lnopt1,njoint,mess,0,bid)
C
 
 1000 FORMAT(/' CYLINDRICAL JOINT ',i10,       /
     +          ,' -------------------'/
     + '        ',i8,' NODES:')
 
 1100 FORMAT(7x,10i10)
      RETURN