ruser35.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	ruser35 (nel, iout, iprop, uvar, nuvar, fx, fy, fz, xmom, ymom, zmom, e, off, stifm, stifr, viscm, viscr, mass, xiner, dt, xl, vx, ry1, rz1, rx, ry2, rz2, fr_wave)

Function/Subroutine Documentation

ruser35()

subroutine ruser35	(	integer	nel,
		integer	iout,
		integer	iprop,
			uvar,
		integer	nuvar,
			fx,
			fy,
			fz,
			xmom,
			ymom,
			zmom,
			e,
			off,
			stifm,
			stifr,
			viscm,
			viscr,
			mass,
			xiner,
			dt,
			xl,
			vx,
			ry1,
			rz1,
			rx,
			ry2,
			rz2,
			fr_wave )

Definition at line 34 of file ruser35.F.

C-------------------------------------------------------------------------
C     This subroutine compute springs forces and moments.
C-------------------------------------------------------------------------
C----------+---------+---+---+--------------------------------------------
C VAR      | SIZE    |TYP| RW| DEFINITION
C----------+---------+---+---+--------------------------------------------
C IOUT     |  1      | I | R | OUTPUT FILE UNIT (L00 file)
C IPROP    |  1      | I | R | PROPERTY NUMBER
C----------+---------+---+---+--------------------------------------------
C XL       |   NEL   | F | R | ELEMENT LENGTH
C----------+---------+---+---+--------------------------------------------
C UVAR     |NUVAR*NEL| F |R/W| USER ELEMENT VARIABLES
C NUVAR    |  1      | I | R | NUMBER OF USER ELEMENT VARIABLES
C----------+---------+---+---+--------------------------------------------
C The user routine does not need to return elements mass in vector MASS : 
C this vector is not used by RADIOSS since version 4.1E.
C The mass which is used by RADIOSS for time step (and output) is the 
C initial mass which was returned by user routine RINI29 into starter.
C utilisation de la version 4.1d ==> on recupere la masse
C-------------------------------------------------------------------------
C FUNCTION 
C-------------------------------------------------------------------------
C INTEGER II = GET_U_PNU(I,IP,KK)
C         IFUNCI = GET_U_PNU(I,IP,KFUNC)
C         IPROPI = GET_U_PNU(I,IP,KFUNC)
C         IMATI  = GET_U_PNU(I,IP,KMAT)
C         I     :     VARIABLE INDEX(1 for first variable,...)
C         IP    :     PROPERTY NUMBER
C         KK    :     PARAMETER KFUNC,KMAT,KPROP
C         THIS FUNCTION RETURN THE USER STORED FUNCTION(IF KK=KFUNC), 
C         MATERIAL(IF KK=KMAT) OR PROPERTY(IF KK=KPROP) NUMBER. 
C         SEE LECG29 FOR CORRESPONDING ID STORAGE.
C-------------------------------------------------------------------------
C INTEGER IFUNCI = GET_U_MNU(I,IM,KFUNC)
C         I     :     VARIABLE INDEX(1 for first function)
C         IM    :     MATERIAL NUMBER
C         KFUNC :     ONLY FUNCTION ARE YET AVAILABLE.
C         THIS FUNCTION RETURN THE USER STORED FUNCTION NUMBER(function 
C         referred by users materials).
C         SEE LECM29 FOR CORRESPONDING ID STORAGE.
C-------------------------------------------------------------------------
C my_real PARAMI = GET_U_GEO(I,IP)
C         I     :     PARAMETER INDEX(1 for first parameter,...)
C         IP    :     PROPERTY NUMBER
C         THIS FUNCTION RETURN THE USER GEOMETRY PARAMETERS 
C         NOTE: IF(IP==IPROP) UPARAG(I) == GET_U_GEO(I,IPROP)
C         see lecg30 for storage
C-------------------------------------------------------------------------
C my_real PARAMI = GET_U_MAT(I,IM)
C         I     :     PARAMETER INDEX(1 for first parameter,...)
C         IM    :     MATERIAL NUMBER
C         THIS FUNCTION RETURN THE USER MATERIAL PARAMETERS 
C         NOTE: GET_U_MAT(0,IMAT) RETURN THE DENSITY
C         see lecm29,30,31 for storage
C-------------------------------------------------------------------------
C INTEGER PID = GET_U_PID(IP)
C         IP    :     PROPERTY NUMBER
C         THIS FUNCTION RETURN THE USER PROPERTY ID CORRESPONDING TO
C         USER PROPERTY NUMBER IP. 
C-------------------------------------------------------------------------
C INTEGER MID = GET_U_MID(IM)
C         IM   :     MATERIAL NUMBER
C         THIS FUNCTION RETURN THE USER MATERIAL ID CORRESPONDING TO
C         USER MATERIAL NUMBER IM. 
C-------------------------------------------------------------------------
C my_real Y = GET_U_FUNC(IFUNC,X,DXDY)
C         IFUNC :     function number obtained by 
C                     IFUNC = GET_U_MNU(I,IM,KFUNC) or IFUNC = GET_U_PNU(I,IP,KFUNC)
C         X     :     X value
C         DXDY  :     slope dX/dY
C         THIS FUNCTION RETURN Y(X)
C-------------------------------------------------------------------------
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C----------------------------------------------------------
C   D u m m y   A r g u m e n t s   a n d   F u n c t i o n
C----------------------------------------------------------
      INTEGER IOUT,NEL,NUVAR,IPROP,
     .        GET_U_PNU,GET_U_PID,GET_U_MID,GET_U_MNU,
     .        KFUNC,KMAT,KPROP
      my_real
     .   uvar(nuvar,*),dt ,
     .   fx(*), fy(*), fz(*), e(*), vx(*),mass(*) ,xiner(*),
     .   ry1(*), rz1(*), off(*), xmom(*), ymom(*),
     .   zmom(*), rx(*), ry2(*), rz2(*),xl(*),
     .   stifm(*) ,stifr(*) , viscm(*) ,viscr(*) ,fr_wave(*) ,
     .   get_u_mat, get_u_geo, get_u_func
      EXTERNAL get_u_mnu,get_u_pnu,get_u_mid,get_u_pid,
     .         get_u_mat,get_u_geo, get_u_func
      parameter(kfunc=29)
      parameter(kmat=31)
      parameter(kprop=33)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IFUNC1,IFUNC2,IFUNC3,IFUNC4,ILOAD
      my_real 
     .        elastif,x,dxdy,xlim1,xlim2,fmx,fmn,dx,amas,d1,d2,fscal
C-----------------------------------------------
C
      amas   = get_u_geo(1,iprop)
      elastif= get_u_geo(2,iprop)
      xlim1  = get_u_geo(3,iprop)
      xlim2  = get_u_geo(4,iprop)
      d1     = get_u_geo(5,iprop)
      d2     = get_u_geo(6,iprop)
      fscal  = get_u_geo(8,iprop)
      iload  = nint(get_u_geo(7,iprop))
      ifunc1= get_u_pnu(1,iprop,kfunc) 
      ifunc2= get_u_pnu(2,iprop,kfunc) 
      ifunc3= get_u_pnu(3,iprop,kfunc) 
      ifunc4= get_u_pnu(4,iprop,kfunc) 
C
      DO i=1,nel
        mass(i) = amas
        dx = dt * vx(i) / xl(i)
        x = uvar(1,i) + dx
c
        IF (uvar(3,i) == zero) THEN
          fmx = fscal*get_u_func(ifunc1,x,dxdy)
          fmn = fscal*get_u_func(ifunc2,x,dxdy)
        ELSE            
          fmx = uvar(2,i)*fscal*get_u_func(ifunc3,x,dxdy)
          fmn = uvar(2,i)*fscal*get_u_func(ifunc4,x,dxdy)            
        ENDIF
c
        IF (uvar(3,i) >= one) THEN
          fr_wave(i)=one
c  UVAR(2,I) = endommagement sur fonction yield et stiffness 
c              par facteur 0 <= D1 < 1.              
          IF (iload == 0 .OR. dx > zero) uvar(2,i)=uvar(2,i)*(one-d1)
        ELSEIF (fr_wave(i) == one) THEN
          IF (iload == 0 .OR. dx > zero) uvar(3,i)=uvar(3,i)+d2    
c FR_WAVE est laisse a 1.
        ENDIF
C
        IF (x >= xlim1) THEN
          fr_wave(i)=one
          IF (uvar(3,i) >= one .AND. off(i) == one) THEN
C    change I to global indice
            WRITE(iout,*)'SPRING',i, 'REACHES LIMIT IN X : ',x
            off(i)=zero
          ENDIF
        ELSE
          fr_wave(i)=zero
        ENDIF
c
        uvar(1,i) = x 
        fx(i) = fx(i) + elastif * dx * uvar(2,i)
        fx(i) = min(fx(i),fmx)
        fx(i) = max(fx(i),fmn)
        fx(i) = fx(i) * off(i)
C----------------
C         TIME STEP
C----------------
        stifm(i) = elastif / xl(i)
        stifr(i) = zero
        viscm(i) = zero
        viscr(i) = zero
        xiner(i) = zero 
      ENDDO
C-------------------------------
      RETURN