w_seatbelts.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	w_seatbelts (len_ia, len_am, p, nodlocal, n_anchor_remote_l, n_anchor_remote_send_l, anchor_remote_l, anchor_remote_send_l)

Function/Subroutine Documentation

w_seatbelts()

subroutine w_seatbelts	(	integer	len_ia,
		integer	len_am,
		integer	p,
		integer, dimension(*)	nodlocal,
		integer	n_anchor_remote_l,
		integer	n_anchor_remote_send_l,
		type(seatbelt_remote_nodes_struct)	anchor_remote_l,
		type(seatbelt_remote_nodes_struct)	anchor_remote_send_l )

Definition at line 33 of file w_seatbelts.F.

C---------------------------------------------     
      USE seatbelt_mod
C---------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "param_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER LEN_AM,LEN_IA,P,NODLOCAL(*),N_ANCHOR_REMOTE_L,N_ANCHOR_REMOTE_SEND_L
      TYPE(SEATBELT_REMOTE_NODES_STRUCT) ANCHOR_REMOTE_L,ANCHOR_REMOTE_SEND_L
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      INTEGER  NLOCAL
      EXTERNAL nlocal 
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,OPTIONAL_NODE,L_TABLE,NPT
C-----------------------------------------------
C
      DO i = 1, nslipring
C
        IF (nlocal(slipring(i)%FRAM(1)%NODE(2),p)==1) THEN
C
          CALL write_i_c(slipring(i)%ID, 1)
          CALL write_i_c(slipring(i)%IDG, 1)
          CALL write_i_c(slipring(i)%NFRAM, 1)
          CALL write_i_c(slipring(i)%IFUNC, 4)
          CALL write_i_c(slipring(i)%SENSID, 1)
          CALL write_i_c(slipring(i)%FL_FLAG, 1)
          CALL write_i_c(slipring(i)%RBODY, 1)
          len_ia = len_ia + 10
C
          CALL write_db(slipring(i)%DC, 1)
          CALL write_db(slipring(i)%A, 1)
          CALL write_db(slipring(i)%FRIC, 1)
          CALL write_db(slipring(i)%FAC_D, 3)
          CALL write_db(slipring(i)%FRICS, 1)
          CALL write_db(slipring(i)%FAC_S, 3)
          len_am = len_am + 10
C
          DO j=1,slipring(i)%NFRAM
C
            CALL write_i_c(slipring(i)%FRAM(j)%UPDATE, 1)
            CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%ANCHOR_NODE), 1)          
            CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%NODE(1)), 1)
            CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%NODE(2)), 1)
            CALL write_i_c(nodlocal(slipring(i)%FRAM(j)%NODE(3)), 1)
            CALL write_i_c(slipring(i)%FRAM(j)%NODE_NEXT, 3)
            CALL write_i_c(slipring(i)%FRAM(j)%NODE2_PREV, 1)
            CALL write_i_c(slipring(i)%FRAM(j)%N_REMOTE_PROC, 1)
C
            optional_node = 0
            IF (slipring(i)%FRAM(j)%ORIENTATION_NODE > 0) THEN
              optional_node = nodlocal(slipring(i)%FRAM(j)%ORIENTATION_NODE)
            ENDIF
            CALL write_i_c(optional_node, 1)
C
            CALL write_i_c(slipring(i)%FRAM(j)%STRAND_DIRECTION, 2)
            CALL write_i_c(slipring(i)%FRAM(j)%LOCKED, 1)
            len_ia = len_ia + 14
C
            CALL write_db(slipring(i)%FRAM(j)%VECTOR, 6)
            CALL write_db(slipring(i)%FRAM(j)%ORIENTATION_ANGLE, 1)
            CALL write_db(slipring(i)%FRAM(j)%MATERIAL_FLOW, 1)
            CALL write_db(slipring(i)%FRAM(j)%MATERIAL_FLOW_OLD, 1)
            CALL write_db(slipring(i)%FRAM(j)%DFS, 1)
            CALL write_db(slipring(i)%FRAM(j)%RESIDUAL_LENGTH, 2)
            CALL write_db(slipring(i)%FRAM(j)%CURRENT_LENGTH, 2)
            CALL write_db(slipring(i)%FRAM(j)%RINGSLIP, 1)
            CALL write_db(slipring(i)%FRAM(j)%BETA, 1)
            CALL write_db(slipring(i)%FRAM(j)%SLIP_FORCE, 3)
            CALL write_db(slipring(i)%FRAM(j)%PREV_REF_LENGTH, 1)
            CALL write_db(slipring(i)%FRAM(j)%INTVAR_STR1, 8)
            CALL write_db(slipring(i)%FRAM(j)%INTVAR_STR2, 8)
            len_am = len_am + 35
C
          ENDDO
C
        ENDIF
C
      ENDDO
C
      DO i = 1, nretractor
C
        IF (nlocal(retractor(i)%NODE(2),p)==1) THEN
          CALL write_i_c(retractor(i)%ID, 1)
          CALL write_i_c(retractor(i)%IDG, 1)
          CALL write_i_c(retractor(i)%UPDATE, 1)
          CALL write_i_c(nodlocal(retractor(i)%ANCHOR_NODE), 1)
          CALL write_i_c(nodlocal(retractor(i)%NODE(1)), 1)
          CALL write_i_c(nodlocal(retractor(i)%NODE(2)), 1)
          CALL write_i_c(retractor(i)%NODE_NEXT, 2)
          CALL write_i_c(retractor(i)%STRAND_DIRECTION, 1)
          CALL write_i_c(retractor(i)%IFUNC, 3)
          CALL write_i_c(retractor(i)%ISENS, 2)
          CALL write_i_c(retractor(i)%TENS_TYP, 1)
          CALL write_i_c(retractor(i)%LOCKED, 1)
          CALL write_i_c(retractor(i)%LOCKED_FREEZE, 1)
          CALL write_i_c(retractor(i)%PRETENS_ACTIV, 1)
          CALL write_i_c(retractor(i)%INACTI_NNOD, 1)
          CALL write_i_c(retractor(i)%INACTI_NNOD_MAX, 1)
          DO k=1,retractor(i)%INACTI_NNOD
            CALL write_i_c(nodlocal(retractor(i)%INACTI_NODE(k)), 1)
          ENDDO         
          CALL write_i_c(retractor(i)%N_REMOTE_PROC, 1)
          CALL write_i_c(retractor(i)%S_TABLE, 2)
          len_ia = len_ia + 23 + retractor(i)%INACTI_NNOD
          CALL write_db(retractor(i)%VECTOR, 3)
          CALL write_db(retractor(i)%ELEMENT_SIZE, 1)
          CALL write_db(retractor(i)%FORCE, 1)
          CALL write_db(retractor(i)%MATERIAL_FLOW, 1)
          CALL write_db(retractor(i)%RESIDUAL_LENGTH, 1)
          CALL write_db(retractor(i)%FAC, 4)
          CALL write_db(retractor(i)%PULLOUT, 1)
          CALL write_db(retractor(i)%UNLOCK_FORCE, 1)
          CALL write_db(retractor(i)%LOCK_OFFSET, 1)
          CALL write_db(retractor(i)%LOCK_PULL, 1)
          CALL write_db(retractor(i)%LOCK_PULL_SAV, 1)
          CALL write_db(retractor(i)%LOCK_YIELD_FORCE, 1)
          CALL write_db(retractor(i)%RINGSLIP, 1)
          CALL write_db(retractor(i)%PRETENS_TIME, 1)
          CALL write_db(retractor(i)%PRETENS_PULL, 1)
          CALL write_db(retractor(i)%PRETENS_PULLMAX, 1)
          CALL write_db(retractor(i)%RET_FORCE, 1)
          l_table = 0
          DO k=1,2
            IF (retractor(i)%S_TABLE(k) > 0) THEN
              npt = retractor(i)%S_TABLE(k)    
              l_table = l_table + 2*npt
              CALL write_db(retractor(i)%TABLE(k)%X(1)%VALUES(1:npt),npt)
              CALL write_db(retractor(i)%TABLE(k)%Y%VALUES(1:npt),npt)
            ENDIF  
          ENDDO
          len_am = len_am + 22 + l_table
        ENDIF
C
      ENDDO
C
      IF (n_anchor_remote_l > 0) THEN
        CALL write_i_c(anchor_remote_l%ADD_PROC, nspmd+1)
        CALL write_i_c(anchor_remote_l%NODE, n_anchor_remote_l)
        len_ia = len_ia + nspmd + 1 + n_anchor_remote_l     
      ENDIF
C
      IF (n_anchor_remote_send_l > 0) THEN
        CALL write_i_c(anchor_remote_send_l%ADD_PROC, nspmd+1)
        CALL write_i_c(anchor_remote_send_l%NODE, n_anchor_remote_send_l)
        len_ia = len_ia + nspmd + 1 + n_anchor_remote_send_l     
      ENDIF
C
      IF (p ==1) THEN
        CALL write_i_c(nseatbelt_th_proc, 1)
        len_ia = len_ia + 1
        IF ((nspmd > 1).AND.(nseatbelt_th_proc > 0)) THEN
          DO i=1,nseatbelt_th_proc
            CALL write_i_c(seatbelt_th_exch(i)%ID_PROC, 1)
            CALL write_i_c(seatbelt_th_exch(i)%ADD_PROC, 1)
            CALL write_i_c(seatbelt_th_exch(i)%NSLIPRING, 1)
            CALL write_i_c(seatbelt_th_exch(i)%NRETRACTOR, 1)
            len_ia = len_ia + 4
          ENDDO
        ENDIF
      ENDIF
C                
! --------------------------------------
      RETURN