check_nodal_state.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/.
!||====================================================================
!||    check_nodal_state   ../engine/source/interfaces/interf/check_nodal_state.f
!||--- called by ------------------------------------------------------
!||    resol               ../engine/source/engine/resol.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod       ../common_source/modules/interfaces/intbufdef_mod.F90
!||====================================================================
        SUBROUTINE check_nodal_state( ITASK,ITAG,NEWFRONT,INTBUF_TAB,SIZE_SEC_NODE,
     .                        SHIFT_S_NODE,INTER_SEC_NODE,SEC_NODE_ID)
!$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
        END SUBROUTINE check_nodal_state