update_weight_inter_type7.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	update_weight_inter_type7 (nelemint, interface_id, nsn, nrtm, ifiend, irect, nsv, i_stok, cand_e, cand_n, igap, gap, gapmax, gapmin, dgapload, drad, gap_s, gap_s_l, gap_m, gap_m_l, numnod, x, inter_cand)

Function/Subroutine Documentation

update_weight_inter_type7()

subroutine update_weight_inter_type7	(	integer, intent(inout)	nelemint,
		integer, intent(in)	interface_id,
		integer, intent(in)	nsn,
		integer, intent(in)	nrtm,
		integer, intent(inout)	ifiend,
		integer, dimension(4,nrtm)	irect,
		integer, dimension(nsn)	nsv,
		integer, intent(in)	i_stok,
		integer, dimension(i_stok), intent(in)	cand_e,
		integer, dimension(i_stok), intent(in)	cand_n,
		integer, intent(in)	igap,
		intent(in)	gap,
		intent(in)	gapmax,
		intent(in)	gapmin,
		intent(in)	dgapload,
		intent(in)	drad,
		dimension(nsn)	gap_s,
		dimension(nsn)	gap_s_l,
		dimension(nrtm)	gap_m,
		dimension(nrtm)	gap_m_l,
		integer, intent(in)	numnod,
		intent(in)	x,
		type(inter_cand_), intent(inout)	inter_cand )

Parameters

[in]	interface_id	interface id
[in]	nsn	number of S node
[in]	nrtm	number of segment
[in,out]	ifiend	???
	irect	list of M nodes for the NRTM segments
	nsv	list of S nodes
[in]	i_stok	total number of pair of candidate
[in]	numnod	number of node
[in]	cand_e	segment id of the candidate I
[in]	cand_n	pointer to the S node id of the candidate I
[in]	igap	gap option for the current interface

Definition at line 31 of file update_weight_inter_type7.F.

!$COMMENT
!       UPDATE_WEIGHT_INTER_TYPE7 description :
!       save the contact data for interface type 7 
!
!       UPDATE_WEIGHT_INTER_TYPE7 organization :
!           for each contact, save :
!            * 4 main node IDs
!            * 1 secondary node ID
!            * 1 segment ID
!            * type of interface
!$ENDCOMMENT
        USE inter_cand_mod
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
C-----------------------------------------------
        INTEGER, INTENT(inout) :: NELEMINT
        INTEGER, INTENT(in) :: INTERFACE_ID !< interface id 
        INTEGER, INTENT(in) :: NSN !< number of S node
        INTEGER, INTENT(in) :: NRTM !< number of segment
        INTEGER, INTENT(inout) :: IFIEND !< ???
        INTEGER, DIMENSION(4,NRTM) :: IRECT !< list of M nodes for the NRTM segments
        INTEGER, DIMENSION(NSN) :: NSV !< list of S nodes
        INTEGER, INTENT(in) :: I_STOK !< total number of pair of candidate
        INTEGER, INTENT(in) :: NUMNOD !< number of node
        INTEGER, DIMENSION(I_STOK), INTENT(in) :: CAND_E !< segment id of the candidate I
        INTEGER, DIMENSION(I_STOK), INTENT(in) :: CAND_N !< pointer to the S node id of the candidate I
        INTEGER, INTENT(in) :: IGAP !< gap option for the current interface
        my_real, INTENT(in) :: gap,gapmax,gapmin !< gap value
        my_real, INTENT(IN) :: dgapload ,drad !< other kind of gap
        my_real, DIMENSION(NSN) :: gap_s,gap_s_l !< gap of S node
        my_real, DIMENSION(NRTM) :: gap_m,gap_m_l!< gap of segment
        my_real, DIMENSION(3,NUMNOD), INTENT(in) :: x
        TYPE(INTER_CAND_), INTENT(inout) :: INTER_CAND
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: S_NODE_ID
        INTEGER :: SEGMENT_ID
 
        INTEGER :: N,I
        INTEGER :: IX1,IX2,IX3,IX4
        my_real
     .   xmin,xmax,ymin,ymax,zmin,zmax,threshold,
     .   xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4
C-----------------------------------------------
        ifiend = ifiend + i_stok
        inter_cand%IXINT(1:inter_cand%S_IXINT_1,nelemint+1:nelemint+i_stok) = 0
        inter_cand%ADDRESS(interface_id) = nelemint ! save the adress of the first pair
        threshold = max(gap+dgapload,drad)
        ! ---------------------------
        ! loop over the S candidates
        DO i = 1, i_stok
          s_node_id = nsv(cand_n(i)) ! s node id
          segment_id  = cand_e(i) ! segment id
          ! find the 4 M node id
          ix1=irect(1,segment_id)
          ix2=irect(2,segment_id)
          ix3=irect(3,segment_id)
          ix4=irect(4,segment_id)
 
          inter_cand%IXINT(1,nelemint+i) = ix1
          inter_cand%IXINT(2,nelemint+i) = ix2
          inter_cand%IXINT(3,nelemint+i) = ix3
          inter_cand%IXINT(4,nelemint+i) = ix4
          inter_cand%IXINT(5,nelemint+i) = s_node_id
          inter_cand%IXINT(6,nelemint+i) = 7
          inter_cand%IXINT(7,nelemint+i) = segment_id
          inter_cand%IXINT(8,nelemint+i) = interface_id
 
          zi = x(3,s_node_id)
          z1=x(3,ix1)
          z2=x(3,ix2)
          z3=x(3,ix3)
          z4=x(3,ix4)
          IF(igap==0)THEN
            threshold = gap
          ELSE
            threshold=gap_s(cand_n(i))+gap_m(cand_e(i))
            IF(igap==3)
     .        threshold=min(threshold,
     .             gap_s_l(cand_n(i))+gap_m_l(cand_e(i)))
            threshold=min(threshold,gapmax)
            threshold=max(threshold,gapmin)
          ENDIF
          threshold = max(threshold+dgapload,drad)
 
          ! -------------
          ! check if the S node will be retain for the interface force computation for the 
          ! first cycle of the engine
          zmin = min(z1,z2,z3,z4)-threshold
          zmax = max(z1,z2,z3,z4)+threshold
          IF (zmin<=zi.AND.zmax>=zi) THEN
            yi = x(2,s_node_id)
            y1 = x(2,ix1)
            y2 = x(2,ix2)
            y3 = x(2,ix3)
            y4 = x(2,ix4)
            ymin = min(y1,y2,y3,y4)-threshold
            ymax = max(y1,y2,y3,y4)+threshold
            IF (ymin<=yi.AND.ymax>=yi) THEN
              xi = x(1,s_node_id)
              x1 = x(1,ix1)
              x2 = x(1,ix2)
              x3 = x(1,ix3)
              x4 = x(1,ix4)
              xmin = min(x1,x2,x3,x4)-threshold
              xmax = max(x1,x2,x3,x4)+threshold
              IF (xmin<=xi.AND.xmax>=xi) THEN
                inter_cand%IXINT(6,nelemint+i)=-7
              ENDIF
            ENDIF
          ENDIF
          ! -------------          
        ENDDO
        ! ---------------------------
        nelemint=nelemint+i_stok
        inter_cand%ADDRESS(interface_id+1) = nelemint ! save the adress of the last pair
        ! ---------------------------
 
        RETURN