#include "implicit_f.inc"
#include "analyse_name.inc"
#include "scr17_c.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"
#include "sphcom.inc"
Functions/Subroutines
subroutine	hm_read_spring (ixr, itab, itabm1, ipart, ipartr, igeo, ixr_kj, lsubmodel, iskn, r_skew, ipm)
Function/Subroutine Documentation

◆ hm_read_spring()

subroutine hm_read_spring	(	integer, dimension(nixr,*), intent(out)	ixr,
		integer, dimension(*), intent(in)	itab,
		integer, dimension(*), intent(in)	itabm1,
		integer, dimension(lipart1,*), intent(in)	ipart,
		integer, dimension(*), intent(out)	ipartr,
		integer, dimension(npropgi,*), intent(in)	igeo,
		integer, dimension(5,*), intent(out)	ixr_kj,
		type(submodel_data), dimension(nsubmod), intent(in)	lsubmodel,
		integer, dimension(liskn,*), intent(in)	iskn,
		integer, dimension(*), intent(out)	r_skew,
		integer, dimension(npropmi,*), intent(in)	ipm )
Definition at line 37 of file hm_read_spring.F.
C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   READ /SPRING ELEMENTS USING HM_READER
C-----------------------------------------------
C   DUMMY ARGUMENTS DESCRIPTION:
C   ===================
C
C     NAME            DESCRIPTION                         
C
C     IXR             SPRING ELEM ARRAY : CONNECTIVITY, ID, PID
C     ITAB            USER ID OF NODES         
C     ITABM1          REVERSE TAB ITAB
C     IPART           PART ARRAY      
C     IPARTR          INTERNAL PART ID OF A GIVEN SPRING ELEMENT 
C     IGEO            PROP ARRAY (INTEGER)
C     IXR_KJ          KJOINT ADDITIONAL CONNECTIVITY 
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
      use element_mod , only : nixr
C----------------------------------------------------------
C     READING ELEMENT RESSORT
C     VERSION NUMEROTATION DES NODES LIBRE/MARS 90/DIM
C----------------------------------------------------------
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      "units_c.inc"
#include      "param_c.inc"
#include      "sphcom.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)::ISKN(LISKN,*)
      INTEGER,INTENT(IN)::IPM(NPROPMI,*)
      TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(NSUBMOD)
C OUTPUT ARGUMENTS
      INTEGER,INTENT(OUT)::IXR(NIXR,*)
      INTEGER,INTENT(OUT)::IXR_KJ(5,*)
      INTEGER,INTENT(OUT)::IPARTR(*)
      INTEGER,INTENT(OUT)::R_SKEW(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, I1, I2,PID,N,IDS,J,IPID,STAT,IMID,IGTYP,MID
      INTEGER FLAG_KJ(NUMELR),IKJ_TMP(3,NUMELR),NUMEL_KJ,CPT,
     .        INDEX_PART
      CHARACTER MESS*40, MESS2*40, CHAR_MAT*11, CHAR_SKEW*11
      my_real
     .   bid 
      INTEGER, DIMENSION(:), ALLOCATABLE :: SUB_SPRING,SKEWID
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 SPRING ELEMENTS DEFINITION           '/
      DATA mess2/'3D SPRING ELEMENTS SELECTION FOR TH PLOT'/
C=======================================================================
C--------------------------------------------------
C      ALLOCS & INITS
C--------------------------------------------------
      ALLOCATE (sub_spring(numelr),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                             msgtype=msgerror,
     .                             c1='SUB_SPRING') 
      sub_spring(1:numelr) = 0
      ALLOCATE (skewid(numelr),stat=stat)
      IF (stat /= 0) CALL ancmsg(msgid=268,anmode=aninfo,
     .                             msgtype=msgerror,
     .                             c1='SKEWID') 
      skewid(1:numelr) = 0
      index_part = 1
C--------------------------------------------------
C      READING SPRING INPUTS IN HM STRUCTURE
C-------------------------------------------------- 
      CALL cpp_spring_read(ixr,nixr,ixr_kj,5,ipartr,sub_spring,skewid)
C--------------------------------------------------
C      FILL OTHER STRUCTURES + CHECKS
C--------------------------------------------------
        i=0
          numel_kj = 0
C
        DO n=1,numelr
          i = i + 1
C--------------------------------------------------
C      INTERNAL PART ID
C--------------------------------------------------
          IF( ipart(4,index_part) /= ipartr(i) )THEN  
            DO j=1,npart                            
              IF(ipart(4,j)== ipartr(i) ) index_part = j 
            ENDDO  
          ENDIF
          IF( ipart(4,index_part) /= ipartr(i) ) THEN
            CALL ancmsg(msgid=402,
     .                  msgtype=msgerror,
     .                  anmode=aninfo_blind_1,
     .                  c1="SPRING",
     .                  i1=ipartr(i),
     .                  i2=ipartr(i),
     .                  prmod=msg_cumu)
          ENDIF   
          ipid=ipart(2,index_part)   
          imid=ipart(1,index_part)  
          igtyp=igeo(11,ipid)
          ixr(5,i)=0
C
          IF(igtyp == 23) ixr(5,i)=imid
          ipartr(i) = index_part
C-------------------------------------------------- 
c
          flag_kj(i) = 0
          DO j=1,3
            IF (ixr_kj(j,i)/=0) flag_kj(i) = flag_kj(i) + 1
          END DO   
c      
          IF (ixr(nixr,i)>id_limit%GLOBAL) THEN
            CALL ancmsg(msgid=509,anmode=aninfo,msgtype=msgerror,
     .                  i1=ixr(nixr,i),c1=line,c2='/SPRING')
          ENDIF
          ixr(1,i)=ipid   
          ixr(2,i)=usr2sys(ixr(2,i),itabm1,mess,ixr(nixr,i))
          ixr(3,i)=usr2sys(ixr(3,i),itabm1,mess,ixr(nixr,i))
          CALL anodset(ixr(2,i), check_spring)
          CALL anodset(ixr(3,i), check_spring)
          IF(ixr(4,i)/=0) THEN
             ixr(4,i)=usr2sys(ixr(4,i),itabm1,mess,ixr(nixr,i))
             CALL anodset(ixr(4,i), check_used)
          ENDIF
C         Additional nodes for joints
            IF (flag_kj(i)>0) THEN
            DO j=1,3
             IF(ixr_kj(j,i)/=0) THEN
                ixr_kj(j,i)=usr2sys(ixr_kj(j,i),itabm1,mess,ixr(nixr,i))
                CALL anodset(ixr_kj(j,i), check_used)
             ENDIF
            END DO      
          ENDIF
C         Skews per element - PROP type23 and mat law 108 or PROP type8 - only
          IF (skewid(i) > 0) THEN  
            DO j = 0,numskw+min(1,nspcond)*numsph+nsubmod
              IF (skewid(i) == iskn(4,j+1)) THEN
                r_skew(i) = j+1
                GO TO 500 
              ENDIF
            ENDDO
            CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
     .            c1='SPRING',
     .            c2='SPRING',
     .            i1=ixr(nixr,i),i2=skewid(i))
500         CONTINUE
          ENDIF
        ENDDO
C
      IF(ALLOCATED(sub_spring)) DEALLOCATE(sub_spring)
C-----------
      CALL ancmsg(msgid=402,                 
     .            msgtype=msgerror,         
     .            anmode=aninfo_blind_1,    
     .            prmod=msg_print) 
C-------------------------------------
C Search for double IDs
C-------------------------------------
      ids = 79
      i = 0
      j = 0
      CALL vdouble(ixr(nixr,1),nixr,numelr,mess,0,bid)
      ids = 35
C
      i1=1
      i2=min0(50,numelr)
C
   90 WRITE (iout,300)
      DO 100 i=i1,i2
        pid = igeo(1,ixr(1,i))
C
        IF (ixr(5,i) > 0) THEN
          mid = ipm(1,ixr(5,i))
          WRITE (char_mat,'(I10,1X)') mid
        ELSE
          char_mat=''
        ENDIF
C
        IF (skewid(i) > 0) THEN
          WRITE (char_skew,'(I10)') skewid(i)
        ELSE
          char_skew=''
        ENDIF
C
          IF (igeo(11,ixr(1,i))==45) numel_kj = numel_kj + 1
        IF(ixr(4,i)==0) THEN
          WRITE (iout,'(5(I10,1X),44X,A,A)') i,ixr(nixr,i),pid,
     .                  itab(ixr(2,i)),itab(ixr(3,i)),char_mat,char_skew
        ELSEIF (flag_kj(i)>0) THEN
          IF (flag_kj(i) == 1) THEN
            WRITE (iout,'(7(I10,1X),A,A)') i,ixr(nixr,i),pid,
     .                   itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),
     .                  (itab(ixr_kj(j,i)),j=1,flag_kj(i)),char_mat,char_skew  
          ELSEIF  (flag_kj(i) == 2) THEN
            WRITE (iout,'(8(I10,1X),A,A)') i,ixr(nixr,i),pid,
     .                   itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),
     .                  (itab(ixr_kj(j,i)),j=1,flag_kj(i)),char_mat,char_skew 
          ELSEIF  (flag_kj(i) == 3) THEN
            WRITE (iout,'(9(I10,1X),A,A)') i,ixr(nixr,i),pid,
     .                   itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),
     .                  (itab(ixr_kj(j,i)),j=1,flag_kj(i)),char_mat,char_skew 
          ENDIF
          ELSE
          WRITE (iout,'(6(I10,1X),33X,A,A)') i,ixr(nixr,i),pid,
     .           itab(ixr(2,i)),itab(ixr(3,i)),itab(ixr(4,i)),char_mat,char_skew
        ENDIF
C
  100 CONTINUE
      IF(i2==numelr)GOTO 200
      i1=i1+50
      i2=min0(i2+50,numelr)
      GOTO 90
C
C
 200  CONTINUE
C--------------------------------------------------
C Reorganization of the additional table for kjoints
C--------------------------------------------------
 
      IF (numel_kj>0) THEN
        DO i=1,numelr
            DO j=1,3
              ikj_tmp(j,i)=ixr_kj(j,i)
            END DO
          END DO
          cpt = 0
          ixr_kj(1,numelr+1)=numel_kj
        DO i=1,numelr
            IF (igeo(11,ixr(1,i))==45) THEN
              cpt = cpt+1
              DO j=1,3
                ixr_kj(j,cpt)=ikj_tmp(j,i)
              END DO
              ixr_kj(4,cpt)=ixr(nixr,i)
              ixr_kj(5,cpt)=i
            ENDIF  
          END DO         
      ENDIF
C
C----
      RETURN
  300 FORMAT(/' SPRING ELEMENTS'/
     +        ' ---------------'/
     + '    LOC-EL     GLO-EL       GEOM      NODE1      NODE2'
     + '    (NODE3)                                    (MAT_ID)     (SKEW)')
      RETURN
OpenRadioss 2025.1.11 OpenRadioss project
Functions/Subroutines

Function/Subroutine Documentation

◆ hm_read_spring()
