inter_check_sort.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/.
!||====================================================================
!||    inter_check_sort   ../engine/source/interfaces/generic/inter_check_sort.F
!||--- called by ------------------------------------------------------
!||    inttri             ../engine/source/interfaces/intsort/inttri.F
!||--- uses       -----------------------------------------------------
!||    intbufdef_mod      ../common_source/modules/interfaces/intbufdef_mod.F90
!||    inter_struct_mod   ../engine/share/modules/inter_struct_mod.F
!||    sensor_mod         ../common_source/modules/sensor_mod.F90
!||====================================================================
        SUBROUTINE inter_check_sort( ITASK,NEED_TO_SORT,NBINTC,INTLIST,IPARI,NSENSOR,
     .                               INTBUF_TAB,SENSOR_TAB,NB_INTER_SORTED,
     .                               LIST_INTER_SORTED,INTER_STRUCT)
!$COMMENT
!       INTER_CHECK_SORT description
!       check if a interface must be sorted
!       
!       INTER_CHECK_SORT organization :
!       loop over the NBINTC interfaces and if
!           * dist < 0 & t_start < current time < t_stop --> must be sorted
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intbufdef_mod  
      USE inter_struct_mod
      USE sensor_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      "com04_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(in) :: ITASK    !   omp task id
        INTEGER, INTENT(inout) :: NEED_TO_SORT  !   1 if one or more interfaces must be sorted
        INTEGER, INTENT(in) :: NBINTC   ! number of interface which are not TYPE2
        INTEGER, INTENT(in) :: NSENSOR
        INTEGER, DIMENSION(NBINTC), INTENT(in) :: INTLIST   !   interface id 
        INTEGER, INTENT(inout) :: NB_INTER_SORTED        !   number of interfaces that need to be sorted
        INTEGER, DIMENSION(NBINTC), INTENT(inout) :: LIST_INTER_SORTED   !   list of interfaces that need to be sorted
        INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI    !   interface data
        TYPE(intbuf_struct_),DIMENSION(NINTER) :: INTBUF_TAB    ! interface data
        TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT   !   structure for interface
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: NTY,INACTI,ISENS
        my_real :: TS,STARTT,STOPT,DIST
        LOGICAL TYPE18
        LOGICAL :: IS_SORTING_NEEDED
        INTEGER :: KK,N
!   ----------------------------------------
        nb_inter_sorted = 0
        ! --------------------------
        ! loop over the interface
        DO kk=1,nbintc
            ! find the interface type
            n   = intlist(kk)
            nty = ipari(7,n)
            inacti = ipari(22,n)
            type18=.false.
            IF(nty==7 .AND. inacti==7)type18=.true.
 
            isens = 0
            IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)  
            IF (isens > 0) THEN    ! IF INTERFACE IS ACTIVATED BY SENSOR 
                ts = sensor_tab(isens)%TSTART
            ELSE
                ts = tt
            ENDIF
            is_sorting_needed=.false.
            ! ------------------------
            ! interface type 7
            IF( (nty == 7.AND.tt>=ts).AND.(.NOT.type18) )THEN
                ! check if the interface must be sorted (dist + t_start + t_stop)
                dist = intbuf_tab(n)%VARIABLES(distance_index)
                IF (dist<=zero) is_sorting_needed = .true.
                startt=intbuf_tab(n)%VARIABLES(t_start_index)
                stopt =intbuf_tab(n)%VARIABLES(t_stop_index)
 
                IF(is_sorting_needed) THEN
                    IF(startt>tt) is_sorting_needed = .false.
                ENDIF
 
                IF(is_sorting_needed) THEN
                    IF(tt>stopt) is_sorting_needed = .false.
                ENDIF
                ! the current interface must be sorted --> IS_SORTING_NEEDED=true
                IF (is_sorting_needed) THEN
                    IF(itask==0) need_to_sort = 1
                    nb_inter_sorted = nb_inter_sorted + 1
                    list_inter_sorted(nb_inter_sorted) = n
                    IF(itask==0) inter_struct(n)%CURV_MAX_MAX = zero
                ENDIF
            ENDIF
            ! ------------------------
        ENDDO
        ! --------------------------
        RETURN
        END SUBROUTINE inter_check_sort