uaccess.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    uaccess_dum   ../engine/source/user_interface/uaccess.F
!||--- called by ------------------------------------------------------
!||    radioss2      ../engine/source/engine/radioss2.F
!||====================================================================
      SUBROUTINE uaccess_dum(IERR)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
       INTEGER IERR
       ierr=0
      END
!||====================================================================
!||    get_u_cycle   ../engine/source/user_interface/uaccess.F
!||====================================================================
      INTEGER FUNCTION get_u_cycle()
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 "com01_c.inc"
C-----------------------------------------------
       get_u_cycle = ncycle
       RETURN
       END
#include "my_real.inc"
!||====================================================================
!||    get_u_time   ../engine/source/user_interface/uaccess.F
!||--- called by ------------------------------------------------------
!||    ruser46      ../engine/source/elements/spring/ruser46.F
!||====================================================================
      my_real FUNCTION get_u_time()
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 "com08_c.inc"
C-----------------------------------------------
       get_u_time = tt
       RETURN
       END
!||====================================================================
!||    get_u_accel         ../engine/source/user_interface/uaccess.F
!||--- calls      -----------------------------------------------------
!||    get_var_user_f      ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_f_sp   ../engine/source/user_interface/eng_callback_c.c
!||====================================================================
      INTEGER FUNCTION get_u_accel(NACC, AX,AY,AZ)
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 "scr05_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER nacc
      my_real ax,ay,az
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER i, k, l, iacc,d1,d2,D3
C-----------------------------------------------
      IF (nacc<=0) THEN
        ax = zero
        ay = zero
        az = zero
        get_u_accel = -1
      ELSE
        l = (nacc-1)*25
        d1 = l+20
        d2 = l+21
        d3 = l+22
        IF (iresp == 1) THEN
          CALL get_var_user_f_sp(12,d1,ax)
          CALL get_var_user_f_sp(12,d2,ay)
          CALL get_var_user_f_sp(12,d3,az)
        ELSE
          CALL get_var_user_f(12,d1,ax)
          CALL get_var_user_f(12,d2,ay)
          CALL get_var_user_f(12,d3,az)
        ENDIF
        get_u_accel = 0
      ENDIF
C
      RETURN
      END
!||====================================================================
!||    get_u_numacc     ../engine/source/user_interface/uaccess.F
!||--- calls      -----------------------------------------------------
!||    get_var_user_i   ../engine/source/user_interface/eng_callback_c.c
!||====================================================================
      INTEGER FUNCTION get_u_numacc(IDACC)
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: idacc
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------      
      INTEGER depla,j,id
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------  
      get_u_numacc = 0
      IF(idacc<=0)THEN
        RETURN
      ENDIF
C---
      DO j=1,naccelm
        depla = (j-1)*3+1
        CALL get_var_user_i(5,depla,id)
        IF(idacc==id)THEN
          get_u_numacc = j
          RETURN
        ENDIF
      ENDDO
C---
      RETURN
      END
!||====================================================================
!||    get_u_numnod     ../engine/source/user_interface/uaccess.F
!||--- calls      -----------------------------------------------------
!||    ancmsg           ../engine/source/output/message/message.F
!||    get_var_user_i   ../engine/source/user_interface/eng_callback_c.c
!||--- uses       -----------------------------------------------------
!||    message_mod      ../engine/share/message_module/message_mod.F
!||====================================================================
      INTEGER FUNCTION get_u_numnod(IU)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
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      "com01_c.inc"
#include      "com04_c.inc"
#include      "warn_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: iu
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER j, jinf, jsup, itab1, itab2
      CHARACTER mess*40
      DATA mess/'USER SENSOR                             '/
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      jinf=1
      jsup=numnod
      j=(jsup+jinf)/2
   10 CALL get_var_user_i(13,j,itab1)
      IF(jsup<=jinf.AND.(iu-itab1)/=0) THEN
       IF(nspmd==1) THEN
        CALL ancmsg(msgid=186,anmode=aninfo_blind,
     .                i1=iu,c1=mess)
        ierr=ierr+1
       END IF
C   en SPMD la valeur 0 n indique pas une erreur mais l absence du noeud sur le proc
       get_u_numnod=0
       RETURN
      ENDIF
      IF((iu-itab1)==0)THEN
C     >CAS IU=TABM FIN DE LA RECHERCHE
       CALL get_var_user_i(13,j+numnod,itab2)
         get_u_numnod=itab2
         RETURN
      ELSE IF (iu-itab1<0) THEN
C     >CAS IU<TABM
         jsup=j-1
      ELSE
C     >CAS IU>TABM
         jinf=j+1
      ENDIF
      j=(jsup+jinf)/2
      GO TO 10
C---
      RETURN
      END
C
!||====================================================================
!||    get_u_nod_x         ../engine/source/user_interface/uaccess.F
!||--- calls      -----------------------------------------------------
!||    get_var_user_f      ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_f_sp   ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_i      ../engine/source/user_interface/eng_callback_c.c
!||    spmd_glob_dsum      ../engine/source/mpi/interfaces/spmd_th.F
!||    spmd_rbcast         ../engine/source/mpi/generic/spmd_rbcast.F
!||====================================================================
      INTEGER FUNCTION get_u_nod_x(NOD, X,Y,Z)
C   En SPMD, tous les procs doivent appeler cette fonction
C   sinon blocage
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 "com01_c.inc"
#include "scr05_c.inc"
#include "userlib.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: nod
      my_real,INTENT(INOUT) :: x,y,z
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER l,d1,d2,d3, p
      my_real bufs(6)
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      IF (nod>0) THEN
       IF(nspmd>1) THEN
C   get_proc_user_f retourne 1 si weight(nod) = 1, , 0 sinon
C   weight : pointeur 18 (cf resol.F)
         CALL get_var_user_i(18,nod,p)
       ELSE
         p = 1
       ENDIF
       IF(p==1) THEN
        l=(nod-1)*3
        d1=l+1
        d2=l+2
        d3=l+3
        IF (iresp == 1) THEN
          CALL get_var_user_f_sp(14,d1,x)
          CALL get_var_user_f_sp(14,d2,y)
          CALL get_var_user_f_sp(14,d3,z)
        ELSE
          CALL get_var_user_f(14,d1,x)
          CALL get_var_user_f(14,d2,y)
          CALL get_var_user_f(14,d3,z)
        ENDIF
       ENDIF
C
C SPMD communication du resultat a ts les procs
C
       IF(nspmd>1.AND.getunod_nocom==0) THEN
         IF(p==1) THEN
           bufs(1) = x
           bufs(2) = y
           bufs(3) = z
         ELSE
           bufs(1) = zero
           bufs(2) = zero
           bufs(3) = zero
         ENDIF
         CALL spmd_glob_dsum(bufs,3,bufs(4))
         CALL spmd_rbcast(bufs,bufs,3,1,0,2)
         x = bufs(1)
         y = bufs(2)
         z = bufs(3)
       ENDIF
C
C Fin SPMD
C
       get_u_nod_x = 0
       RETURN
      ENDIF
      get_u_nod_x = -1
      x = zero
      y = zero
      z = zero
C
      RETURN
      END
!||====================================================================
!||    get_u_nod_d         ../engine/source/user_interface/uaccess.f
!||--- calls      -----------------------------------------------------
!||    get_var_user_f      ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_f_sp   ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_i      ../engine/source/user_interface/eng_callback_c.c
!||    spmd_glob_dsum      ../engine/source/mpi/interfaces/spmd_th.F
!||    spmd_rbcast         ../engine/source/mpi/generic/spmd_rbcast.F
!||====================================================================
      INTEGER FUNCTION get_u_nod_d(NOD, DX,DY,DZ)
C   En SPMD, tous les procs doivent appeler cette fonction
C   sinon blocage
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 "com01_c.inc"
#include "scr05_c.inc"
#include "userlib.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN) :: nod
      my_real,INTENT(INOUT) :: dx,dy,dz
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER l,d1,d2,d3, p
      my_real bufs(6)
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      IF (nod>0) THEN
       IF(nspmd>1) THEN
C   get_proc_user_f retourne 1 si weight(nod) = 1, , 0 sinon
C   weight : pointeur 18 (cf resol.F)
         CALL get_var_user_i(18,nod,p)
       ELSE
         p = 1
       ENDIF
       IF(p==1) THEN
        l=(nod-1)*3
        d1=l+1
        d2=l+2
        d3=l+3
        IF (iresp == 1) THEN
          CALL get_var_user_f_sp(15,d1,dx)
          CALL get_var_user_f_sp(15,d2,dy)
          CALL get_var_user_f_sp(15,d3,dz)
        ELSE
          CALL get_var_user_f(15,d1,dx)
          CALL get_var_user_f(15,d2,dy)
          CALL get_var_user_f(15,d3,dz)
        ENDIF
       ENDIF
C
C SPMD communication du resultat a ts les procs
C
       IF(nspmd>1.AND.getunod_nocom==0) THEN
         IF(p==1) THEN
           bufs(1) = dx
           bufs(2) = dy
           bufs(3) = dz
         ELSE
           bufs(1) = zero
           bufs(2) = zero
           bufs(3) = zero
         ENDIF
         CALL spmd_glob_dsum(bufs,3,bufs(4))
         CALL spmd_rbcast(bufs,bufs,3,1,0,2)
         dx = bufs(1)
         dy = bufs(2)
         dz = bufs(3)
       ENDIF
C
C Fin SPMD
C
       get_u_nod_d= 0
       RETURN
      ENDIF
      get_u_nod_d= -1
      dx = zero
      dy = zero
      dz = zero
C
      RETURN
      END
!||====================================================================
!||    get_u_nod_v         ../engine/source/user_interface/uaccess.F
!||--- calls      -----------------------------------------------------
!||    get_var_user_f      ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_f_sp   ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_i      ../engine/source/user_interface/eng_callback_c.c
!||    spmd_glob_dsum      ../engine/source/mpi/interfaces/spmd_th.F
!||    spmd_rbcast         ../engine/source/mpi/generic/spmd_rbcast.F
!||====================================================================
      INTEGER FUNCTION get_u_nod_v(NOD, VX,VY,VZ)
C   En SPMD, tous les procs doivent appeler cette fonction
C   sinon blocage
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 "com01_c.inc"
#include "scr05_c.inc"
#include "userlib.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER nod
      my_real
     .        vx,vy,vz
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER l,d1,d2,d3, p
      my_real
     .        bufs(6)
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      IF (nod>0) THEN
       IF(nspmd>1) THEN
C   get_proc_user_f retourne 1 si weight(nod) = 1, , 0 sinon
C   weight : pointeur 18 (cf resol.F)
         CALL get_var_user_i(18,nod,p)
       ELSE
         p = 1
       ENDIF
       IF(p==1) THEN
        l=(nod-1)*3
        d1=l+1
        d2=l+2
        d3=l+3
        IF (iresp == 1) THEN
          CALL get_var_user_f_sp(16,d1,vx)
          CALL get_var_user_f_sp(16,d2,vy)
          CALL get_var_user_f_sp(16,d3,vz)
        ELSE
          CALL get_var_user_f(16,d1,vx)
          CALL get_var_user_f(16,d2,vy)
          CALL get_var_user_f(16,d3,vz)
        ENDIF
C
C SPMD communication du resultat a ts les procs
C
       ENDIF
       IF(nspmd>1.AND.getunod_nocom==0) THEN
         IF(p==1) THEN
           bufs(1) = vx
           bufs(2) = vy
           bufs(3) = vz
         ELSE
           bufs(1) = zero
           bufs(2) = zero
           bufs(3) = zero
         ENDIF
         CALL spmd_glob_dsum(bufs,3,bufs(4))
         CALL spmd_rbcast(bufs,bufs,3,1,0,2)
         vx = bufs(1)
         vy = bufs(2)
         vz = bufs(3)
       ENDIF
C
C Fin SPMD
C
       get_u_nod_v= 0
       RETURN
      ENDIF
      get_u_nod_v= -1
      vx = zero
      vy = zero
      vz = zero
C
      RETURN
      END
!||====================================================================
!||    get_u_nod_a         ../engine/source/user_interface/uaccess.F
!||--- calls      -----------------------------------------------------
!||    get_var_user_f      ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_f_sp   ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_i      ../engine/source/user_interface/eng_callback_c.c
!||    spmd_glob_dsum      ../engine/source/mpi/interfaces/spmd_th.F
!||    spmd_rbcast         ../engine/source/mpi/generic/spmd_rbcast.F
!||====================================================================
      INTEGER FUNCTION get_u_nod_a(NOD, AX,AY,AZ)
C   En SPMD, tous les procs doivent appeler cette fonction
C   sinon blocage
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 "com01_c.inc"
#include "scr05_c.inc"
#include "userlib.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER nod
      my_real ax,ay,az
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER l,d1,d2,d3, p
      my_real bufs(6)
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      IF (nod>0) THEN
       IF(nspmd>1) THEN
C   get_proc_user_f retourne 1 si weight(nod) = 1, , 0 sinon
C   weight : pointeur 18 (cf resol.F)
         CALL get_var_user_i(18,nod,p)
       ELSE
         p = 1
       ENDIF
       IF(p==1) THEN
        l=(nod-1)*3
        d1=l+1
        d2=l+2
        d3=l+3
        IF (iresp == 1) THEN
          CALL get_var_user_f_sp(17,d1,ax)
          CALL get_var_user_f_sp(17,d2,ay)
          CALL get_var_user_f_sp(17,d3,az)
        ELSE
          CALL get_var_user_f(17,d1,ax)
          CALL get_var_user_f(17,d2,ay)
          CALL get_var_user_f(17,d3,az)
        ENDIF
       ENDIF
C
C SPMD communication du resultat a ts les procs
C
       IF(nspmd>1.AND.getunod_nocom==0) THEN
         IF(p==1) THEN
           bufs(1) = ax
           bufs(2) = ay
           bufs(3) = az
         ELSE
           bufs(1) = zero
           bufs(2) = zero
           bufs(3) = zero
         ENDIF
         CALL spmd_glob_dsum(bufs,3,bufs(4))
         CALL spmd_rbcast(bufs,bufs,3,1,0,2)
         ax = bufs(1)
         ay = bufs(2)
         az = bufs(3)
       ENDIF
C
C Fin SPMD
C
       get_u_nod_a= 0
       RETURN
      ENDIF
      get_u_nod_a= -1
      ax = zero
      ay = zero
      az = zero
C
      RETURN
      END
 
!||====================================================================
!||    get_u_skew            ../engine/source/user_interface/uaccess.F
!||--- called by ------------------------------------------------------
!||    rskew33               ../engine/source/elements/joint/rskew33.F
!||--- calls      -----------------------------------------------------
!||    get_array_user_f      ../engine/source/user_interface/eng_callback_c.c
!||    get_array_user_f_sp   ../engine/source/user_interface/eng_callback_c.c
!||    get_var_user_i        ../engine/source/user_interface/eng_callback_c.c
!||====================================================================
      INTEGER FUNCTION get_u_skew(IDSKW,N1,N2,N3,VECT)
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      "com04_c.inc"
#include      "scr05_c.inc"
#include      "r4r8_p.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real,INTENT(IN) :: vect(lskew)
      INTEGER,INTENT(IN) :: idskw,n1,n2,n3
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------      
      INTEGER i,id,depla
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------   
C
      get_u_skew = 0
C
      DO i=1,numskw
        depla = 4+i*liskn
        CALL get_var_user_i(9,depla,id)
C
        IF(id==idskw) THEN
          get_u_skew = i
C
          CALL get_var_user_i(9,i+1  ,n1)
          CALL get_var_user_i(9,i+2*2,n2)
          CALL get_var_user_i(9,i+3*3,n3)
C
          depla = i*lskew+1
          IF (iresp==1) THEN
            CALL get_array_user_f_sp (10,depla,vect,lskew)
          ELSE
            CALL get_array_user_f (10,depla,vect,lskew)
          ENDIF
          RETURN
C
        ENDIF
C
      ENDDO
      RETURN
      END
      my_real
     .   FUNCTION get_u_uvar(IEL,ILAYER,IVAR,NUVAR)
C---------+---------+---+---+--------------------------------------------
C This routine is called by SIGEPS29, SIGEPS30, SIGEPS31 ...
C Gives access to user variables for all layers of the element
C---------+---------+---+---+--------------------------------------------
C
C VAR     | SIZE    |TYP|   | DEFINITION
C---------+---------+---+---+--------------------------------------------
C IEL     |  1      | I |   | ELEMENT NUMBER
C ILAYER  |  1      | I |   | LAYER NUMBER
C IVAR    |  1      | I |   | USER VARIABLE NUMBER
C NUVAR   |  1      | I |   | NUMBER OF USER VARIABLES
C---------+---------+---+---+--------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "usrplas_c.inc"
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER iel,ilayer,ivar,nuvar
C-----------------------------------------------      
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER n
C-----------------------------------------------      
C   S o u r c e   L i n e s
C-----------------------------------------------
      n = (ilayer-1)*nuvar+ivar
      IF (n > 5000) THEN
        n = 5000
        WRITE(iout,*) 'USER VARIABLE ACCESS ERROR : BUFFER OVERFLOW'
      ENDIF
      get_u_uvar = uuvar(iel,n)
C
      RETURN
      END
!||====================================================================
!||    set_spring_elnum   ../engine/source/user_interface/uaccess.F
!||--- called by ------------------------------------------------------
!||    rforc3             ../engine/source/elements/spring/rforc3.F
!||====================================================================
      SUBROUTINE set_spring_elnum(JFT,JLT,IXR)
C---------+---------+---+---+--------------------------------------------
C Saves external spring number for local element group
C---------+---------+---+---+--------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vec_spring_num.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JFT,JLT
      INTEGER IXR(NIXR,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ID
C-----------------------------------------------      
C   S o u r c e   L i n e s
C-----------------------------------------------
       DO i=jft,jlt
         spr_num(i) = ixr(nixr,i)
       ENDDO
      RETURN
      END
      integer
     .   FUNCTION get_spring_elnum(IEL)
C---------+---------+---+---+--------------------------------------------
C This routine is called by SIGEPS29, SIGEPS30, SIGEPS31 ...
C Gives external element number
C---------+---------+---+---+--------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vec_spring_num.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER iel,num
C-----------------------------------------------      
C   S o u r c e   L i n e s
C-----------------------------------------------
      num = nint(spr_num(iel))
      get_spring_elnum = num
      RETURN
      END
!||====================================================================
!||    mat_solid_get_nod_x   ../engine/source/user_interface/uaccess.F
!||--- uses       -----------------------------------------------------
!||    restmod               ../engine/share/modules/restart_mod.F
!||    user_interface_mod    ../engine/source/modules/user_interface_mod.F90
!||====================================================================
      SUBROUTINE mat_solid_get_nod_x(USER_X)
C---------+---------+---+---+--------------------------------------------
      USE restmod 
      USE user_interface_mod
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      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real user_x(llt,8,3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ND1,ND2,ND3,ND4,ND5,ND6,ND7,ND8,ELEM,I
C-----------------------------------------------      
C   S o u r c e   L i n e s
C-----------------------------------------------
      DO i=1,llt
         elem=nft+i
         nd1=ixs(nixs*(elem-1)+2)
         nd2=ixs(nixs*(elem-1)+3)
         nd3=ixs(nixs*(elem-1)+4)
         nd4=ixs(nixs*(elem-1)+5)
         nd5=ixs(nixs*(elem-1)+6)
         nd6=ixs(nixs*(elem-1)+7)
         nd7=ixs(nixs*(elem-1)+8)
         nd8=ixs(nixs*(elem-1)+9)
C         
         IF(nd1 > 0)THEN 
            user_x(i,1,1)=user_interface_nodes%X(1,nd1)
            user_x(i,1,2)=user_interface_nodes%X(2,nd1)
            user_x(i,1,3)=user_interface_nodes%X(3,nd1)
         ELSE
            user_x(i,1,1)=zero
            user_x(i,1,2)=zero
            user_x(i,1,3)=zero
         ENDIF  
C
         IF(nd2 > 0)THEN 
            user_x(i,2,1)=user_interface_nodes%X(1,nd2)
            user_x(i,2,2)=user_interface_nodes%X(2,nd2)
            user_x(i,2,3)=user_interface_nodes%X(3,nd2)
         ELSE
            user_x(i,2,1)=zero
            user_x(i,2,2)=zero
            user_x(i,2,3)=zero
         ENDIF  
C
         IF(nd3 > 0)THEN 
            user_x(i,3,1)=user_interface_nodes%X(1,nd3)
            user_x(i,3,2)=user_interface_nodes%X(2,nd3)
            user_x(i,3,3)=user_interface_nodes%X(3,nd3)
         ELSE
            user_x(i,3,1)=zero
            user_x(i,3,2)=zero
            user_x(i,3,3)=zero
         ENDIF   
C
         IF(nd4 > 0)THEN 
            user_x(i,4,1)=user_interface_nodes%X(1,nd4)
            user_x(i,4,2)=user_interface_nodes%X(2,nd4)
            user_x(i,4,3)=user_interface_nodes%X(3,nd4)
         ELSE
            user_x(i,4,1)=zero
            user_x(i,4,2)=zero
            user_x(i,4,3)=zero
         ENDIF   
C
         IF(nd5 > 0)THEN 
            user_x(i,5,1)=user_interface_nodes%X(1,nd5)
            user_x(i,5,2)=user_interface_nodes%X(2,nd5)
            user_x(i,5,3)=user_interface_nodes%X(3,nd5)
         ELSE
            user_x(i,5,1)=zero
            user_x(i,5,2)=zero
            user_x(i,5,3)=zero
         ENDIF  
C
         IF(nd6 > 0)THEN 
            user_x(i,6,1)=user_interface_nodes%X(1,nd6)
            user_x(i,6,2)=user_interface_nodes%X(2,nd6)
            user_x(i,6,3)=user_interface_nodes%X(3,nd6)
         ELSE
            user_x(i,6,1)=zero
            user_x(i,6,2)=zero
            user_x(i,6,3)=zero
         ENDIF  
C
         IF(nd7 > 0)THEN 
            user_x(i,7,1)=user_interface_nodes%X(1,nd7)
            user_x(i,7,2)=user_interface_nodes%X(2,nd7)
            user_x(i,7,3)=user_interface_nodes%X(3,nd7)
         ELSE
            user_x(i,7,1)=zero
            user_x(i,7,2)=zero
            user_x(i,7,3)=zero
         ENDIF   
C
         IF(nd8 > 0)THEN 
            user_x(i,8,1)=user_interface_nodes%X(1,nd8)
            user_x(i,8,2)=user_interface_nodes%X(2,nd8)
            user_x(i,8,3)=user_interface_nodes%X(3,nd8)
         ELSE
            user_x(i,8,1)=zero
            user_x(i,8,2)=zero
            user_x(i,8,3)=zero
         ENDIF 
 
      ENDDO
C     
 
      END
C-----------------------------------------------
!||====================================================================
!||    mat_solid_get_nod_v   ../engine/source/user_interface/uaccess.F
!||--- uses       -----------------------------------------------------
!||    restmod               ../engine/share/modules/restart_mod.F
!||    user_interface_mod    ../engine/source/modules/user_interface_mod.F90
!||====================================================================
      SUBROUTINE mat_solid_get_nod_v(USER_V)
C---------+---------+---+---+--------------------------------------------
      USE restmod
      USE user_interface_mod
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      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real user_v(llt,8,3)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER ND1,ND2,ND3,ND4,ND5,ND6,ND7,ND8,ELEM,I
C-----------------------------------------------      
C   S o u r c e   L i n e s
C-----------------------------------------------
      DO i=1,llt
         elem=nft+i
         nd1=ixs(nixs*(elem-1)+2)
         nd2=ixs(nixs*(elem-1)+3)
         nd3=ixs(nixs*(elem-1)+4)
         nd4=ixs(nixs*(elem-1)+5)
         nd5=ixs(nixs*(elem-1)+6)
         nd6=ixs(nixs*(elem-1)+7)
         nd7=ixs(nixs*(elem-1)+8)
         nd8=ixs(nixs*(elem-1)+9)
C         
         IF(nd1 > 0)THEN 
            user_v(i,1,1)=user_interface_nodes%V(1,nd1)
            user_v(i,1,2)=user_interface_nodes%V(2,nd1)
            user_v(i,1,3)=user_interface_nodes%V(3,nd1)
         ELSE
            user_v(i,1,1)=zero
            user_v(i,1,2)=zero
            user_v(i,1,3)=zero
         ENDIF  
C
         IF(nd2 > 0)THEN 
            user_v(i,2,1)=user_interface_nodes%V(1,nd2)
            user_v(i,2,2)=user_interface_nodes%V(2,nd2)
            user_v(i,2,3)=user_interface_nodes%V(3,nd2)
         ELSE
            user_v(i,2,1)=zero
            user_v(i,2,2)=zero
            user_v(i,2,3)=zero
         ENDIF  
C
         IF(nd3 > 0)THEN 
            user_v(i,3,1)=user_interface_nodes%V(1,nd3)
            user_v(i,3,2)=user_interface_nodes%V(2,nd3)
            user_v(i,3,3)=user_interface_nodes%V(3,nd3)
         ELSE
            user_v(i,3,1)=zero
            user_v(i,3,2)=zero
            user_v(i,3,3)=zero
         ENDIF   
C
         IF(nd4 > 0)THEN 
            user_v(i,4,1)=user_interface_nodes%V(1,nd4)
            user_v(i,4,2)=user_interface_nodes%V(2,nd4)
            user_v(i,4,3)=user_interface_nodes%V(3,nd4)
         ELSE
            user_v(i,4,1)=zero
            user_v(i,4,2)=zero
            user_v(i,4,3)=zero
         ENDIF   
C
         IF(nd5 > 0)THEN 
            user_v(i,5,1)=user_interface_nodes%V(1,nd5)
            user_v(i,5,2)=user_interface_nodes%V(2,nd5)
            user_v(i,5,3)=user_interface_nodes%V(3,nd5)
         ELSE
            user_v(i,5,1)=zero
            user_v(i,5,2)=zero
            user_v(i,5,3)=zero
         ENDIF  
C
         IF(nd6 > 0)THEN 
            user_v(i,6,1)=user_interface_nodes%V(1,nd6)
            user_v(i,6,2)=user_interface_nodes%V(2,nd6)
            user_v(i,6,3)=user_interface_nodes%V(3,nd6)
         ELSE
            user_v(i,6,1)=zero
            user_v(i,6,2)=zero
            user_v(i,6,3)=zero
         ENDIF  
C
         IF(nd7 > 0)THEN 
            user_v(i,7,1)=user_interface_nodes%V(1,nd7)
            user_v(i,7,2)=user_interface_nodes%V(2,nd7)
            user_v(i,7,3)=user_interface_nodes%V(3,nd7)
         ELSE
            user_v(i,7,1)=zero
            user_v(i,7,2)=zero
            user_v(i,7,3)=zero
         ENDIF   
C
         IF(nd8 > 0)THEN 
            user_v(i,8,1)=user_interface_nodes%V(1,nd8)
            user_v(i,8,2)=user_interface_nodes%V(2,nd8)
            user_v(i,8,3)=user_interface_nodes%V(3,nd8)
         ELSE
            user_v(i,8,1)=zero
            user_v(i,8,2)=zero
            user_v(i,8,3)=zero
         ENDIF 
 
      ENDDO
 
      END
C-----------------------------------------------