check_nodal_state.F File Reference

#include "implicit_f.inc"
#include "task_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	check_nodal_state (itask, itag, newfront, intbuf_tab, size_sec_node, shift_s_node, inter_sec_node, sec_node_id)

Function/Subroutine Documentation

check_nodal_state()

subroutine check_nodal_state	(	integer, intent(in)	itask,
		integer, dimension(2*numnod), intent(in)	itag,
		integer, dimension(ninter), intent(inout)	newfront,
		type(intbuf_struct_), dimension(ninter), intent(inout)	intbuf_tab,
		integer, intent(in)	size_sec_node,
		integer, dimension(numnod+1), intent(in)	shift_s_node,
		integer, dimension(size_sec_node), intent(in)	inter_sec_node,
		integer, dimension(size_sec_node), intent(in)	sec_node_id )

Parameters

[in,out]

newfront

flag to force some exchanges related to S nodes between processor (if a S node becomes a shooting node - all interface) / force the collision detection algo if a new segment is activated for the (interface 25 + solid erosion)

Definition at line 30 of file check_nodal_state.F.

!$COMMENT
!       CHECK_NODAL_STATE description
!           deactivation of node from an interface
!       CHECK_NODAL_STATE organization
!$ENDCOMMENT
        USE intbufdef_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      "task_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(in) :: ITASK ! omp thread ID
        INTEGER, INTENT(in) :: SIZE_SEC_NODE    ! size of INTER_SEC_NODE & SEC_NODE_ID
        INTEGER, DIMENSION(2*NUMNOD), INTENT(in) :: ITAG    ! tag of node : 0 if secondary node is deactivated, 1 if secondary node is activated
        INTEGER, DIMENSION(NINTER), INTENT(inout) :: NEWFRONT   !< flag to force some exchanges related to S nodes between processor (if a S node becomes a shooting node - all interface) / force the collision detection algo if a new segment is activated for the (interface 25 + solid erosion)
        TYPE(INTBUF_STRUCT_), DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB    ! interface data
!   shift to point to INTER_SEC_NODE/SEC_NODE_ID arrays & number of interface per node:
!   SHIFT_S_NODE(i) = index to NTER_SEC_NODE/SEC_NODE_ID for node_id = i
!   SHIFT_S_NODE(i+1) - SHIFT_S_NODE(i) = number of interface per node
        INTEGER, DIMENSION(NUMNOD+1), INTENT(in) :: SHIFT_S_NODE
 
        INTEGER, DIMENSION(SIZE_SEC_NODE), INTENT(in) :: INTER_SEC_NODE,SEC_NODE_ID ! list of interface of the nodes & ID of secondary nodes in each interface
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: I,J,K
        INTEGER :: FIRST,LAST
        INTEGER :: LOCAL_COUNTER,SHIFT
        INTEGER :: NB_INTERFACE,NIN,NODE_ID
        INTEGER, DIMENSION(:), ALLOCATABLE :: LOCAL_INDEX_SECONDARY_NODE
C-----------------------------------------------
        local_counter = 0
        first = 1 + itask * (numnod / nthread)
        last = (itask + 1) * (numnod / nthread)
        IF(itask+1==nthread) last = numnod
        ALLOCATE( local_index_secondary_node( last-first+1 ) )
        ! --------------------------
        ! find the deactivated nodes 
        DO i=first,last
            IF(itag(i)==0) THEN
                local_counter = local_counter + 1
                local_index_secondary_node(local_counter) = i   ! save the node ID
            ENDIF
        ENDDO
        ! --------------------------
        ! loop over the interface of deactivated nodes to deactivate the secondary nodes
        DO i=1,local_counter
            k = local_index_secondary_node(i)  ! get the node ID
            nb_interface = shift_s_node(k+1) - shift_s_node(k)  ! get the number of interface where the node is defined
            shift = shift_s_node(k)             ! shift for the array "INTER_SEC_NODE"
            DO j=1,nb_interface
                nin = inter_sec_node(shift+j)   ! interface ID
                node_id = sec_node_id(shift+j)  ! secondary node ID of the interface NIN
 
                IF(intbuf_tab(nin)%STFNS(node_id)>zero) THEN    ! check the current state of the node
                    intbuf_tab(nin)%STFNS(node_id) = -intbuf_tab(nin)%STFNS(node_id) ! nodal state change
                    newfront(nin) = -1  ! force some exchanges for S node of the interface NIN for the next cycle
                ENDIF
            ENDDO        
        ENDDO
        ! --------------------------
        DEALLOCATE( local_index_secondary_node )
 
        RETURN