update_weight_inter_type2.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	update_weight_inter_type2 (nelemint, interface_id, nsn, nrtm, ifiend, n2d, irect, nsv, irtl, inter_cand)

Function/Subroutine Documentation

update_weight_inter_type2()

subroutine update_weight_inter_type2	(	integer, intent(inout)	nelemint,
		integer, intent(in)	interface_id,
		integer, intent(in)	nsn,
		integer, intent(in)	nrtm,
		integer, intent(inout)	ifiend,
		integer, intent(in)	n2d,
		integer, dimension(4,nrtm), intent(in)	irect,
		integer, dimension(nsn), intent(in)	nsv,
		integer, dimension(nsn), intent(in)	irtl,
		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	???
[in]	n2d	flag for 2D/3D, 0-->3D, 1-->2D
[in]	irect	list of M nodes for the NRTM segments
[in]	nsv	list of S nodes

Definition at line 30 of file update_weight_inter_type2.F.

!$COMMENT
!       UPDATE_WEIGHT_INTER_TYPE2 description :
!       save the contact data for interface type 2 
!
!       UPDATE_WEIGHT_INTER_TYPE2 organization :
!           for each contact, save :
!            * 2 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   C o m m o n   B l o c k s
C-----------------------------------------------
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, INTENT(in) :: N2D !< flag for 2D/3D, 0-->3D, 1-->2D
        INTEGER, DIMENSION(NSN), INTENT(in) :: IRTL
        INTEGER, DIMENSION(4,NRTM), INTENT(in) :: IRECT !< list of M nodes for the NRTM segments
        INTEGER, DIMENSION(NSN), INTENT(in) :: NSV !< list of S nodes
        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 N,NIR,NN
        INTEGER :: S_NODE_ID
        INTEGER :: SEGMENT_ID
C-----------------------------------------------
        ! flush %ixint array to 0
        inter_cand%IXINT(1:inter_cand%S_IXINT_1,nelemint+1:nelemint+nsn) = 0
        inter_cand%ADDRESS(interface_id) = nelemint+1 ! save the adress of the first pair 
        nir=2
        IF(n2d==0)nir=4
        nn = 0            
        ! ---------------------------
        ! loop over the secondary node
        DO n = 1, nsn
          s_node_id = nsv(n)  ! S node id
          segment_id = irtl(n) ! segment id
          IF(segment_id/=0)THEN
            nn = nn + 1
            inter_cand%IXINT(1,nelemint+nn)=irect(1,segment_id)
            inter_cand%IXINT(2,nelemint+nn)=irect(2,segment_id)
            IF (nir==2) THEN
              inter_cand%IXINT(3,nelemint+nn)=irect(1,segment_id)
              inter_cand%IXINT(4,nelemint+nn)=irect(2,segment_id)
            ELSE
              inter_cand%IXINT(3,nelemint+nn)=irect(3,segment_id)
              inter_cand%IXINT(4,nelemint+nn)=irect(4,segment_id)                
            END IF
            inter_cand%IXINT(5,nelemint+nn)=s_node_id
            inter_cand%IXINT(6,nelemint+nn)=2
            inter_cand%IXINT(7,nelemint+nn)=segment_id
            inter_cand%IXINT(8,nelemint+nn)=interface_id
          END IF
        ENDDO
        ! ---------------------------
        nelemint = nelemint+nn
        ifiend   = ifiend + nn
        inter_cand%ADDRESS(interface_id+1) = nelemint ! save the adress of the last pair
        ! ---------------------------
        RETURN