inter_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_sort              ../engine/source/interfaces/generic/inter_sort.F
!||--- called by ------------------------------------------------------
!||    inttri                  ../engine/source/interfaces/intsort/inttri.F
!||--- calls      -----------------------------------------------------
!||    int_startime            ../engine/source/system/timer_interf.F
!||    int_stoptime            ../engine/source/system/timer_interf.F
!||    inter_sort_07           ../engine/source/interfaces/int07/inter_sort_07.F
!||--- uses       -----------------------------------------------------
!||    command_line_args_mod   ../engine/share/modules/command_line_args.F
!||    glob_therm_mod          ../common_source/modules/mat_elem/glob_therm_mod.F90
!||    h3d_mod                 ../engine/share/modules/h3d_mod.F
!||    intbufdef_mod           ../common_source/modules/interfaces/intbufdef_mod.F90
!||    inter_sorting_mod       ../engine/share/modules/inter_sorting_mod.F
!||    inter_struct_mod        ../engine/share/modules/inter_struct_mod.F
!||    metric_mod              ../common_source/modules/interfaces/metric_mod.F
!||    multi_fvm_mod           ../common_source/modules/ale/multi_fvm_mod.F90
!||    sensor_mod              ../common_source/modules/sensor_mod.F90
!||    timer_mod               ../engine/source/system/timer_mod.F90
!||====================================================================
        SUBROUTINE inter_sort( TIMERS,ITASK,NB_INTER_SORTED,LIST_INTER_SORTED,RETRI,IPARI,
     1                         NSENSOR,ISENDTO,IRECVFROM,INTBUF_TAB,X,ITAB,
     2                         RENUM,NSNFIOLD,MULTI_FVM,H3D_DATA,SENSOR_TAB,
     3                         INTER_STRUCT,SORT_COMM,RENUM_SIZ,GLOB_THERM )
!$COMMENT
!       INTER_SORT description
!       sort computation
!       INTER_SORT organization :
!       loop over the interfaces and sort computation
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE command_line_args_mod , ONLY : got_preview
      USE multi_fvm_mod
      USE h3d_mod
      USE metric_mod
      USE intbufdef_mod  
      USE inter_struct_mod
      USE inter_sorting_mod
      USE sensor_mod
      USE glob_therm_mod
      USE timer_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      "com01_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
#include      "timeri_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(timer_), INTENT(inout) :: TIMERS
      INTEGER, INTENT(in) :: ITASK    !   omp thread ID
      INTEGER, INTENT(in) :: NB_INTER_SORTED        !   number of interfaces that need to be sorted
      INTEGER, INTENT(in) :: NSENSOR
      INTEGER, DIMENSION(NB_INTER_SORTED), INTENT(in) :: LIST_INTER_SORTED   !   list of interfaces that need to be sorted
      INTEGER, INTENT(inout) :: RETRI
      INTEGER, DIMENSION(NPARI,NINTER), INTENT(inout) :: IPARI    !   interface data
      INTEGER, DIMENSION(NINTER+1,NSPMD+1), INTENT(in) :: ISENDTO,IRECVFROM 
      TYPE(intbuf_struct_),DIMENSION(NINTER), INTENT(inout) :: INTBUF_TAB    ! interface data
      my_real, DIMENSION(3,NUMNOD), INTENT(in), TARGET :: x            !   position
      INTEGER, DIMENSION(NUMNOD), INTENT(in) :: ITAB
      INTEGER, INTENT(in) :: RENUM_SIZ            !   size of RENUM
      INTEGER, DIMENSION(RENUM_SIZ), INTENT(inout) :: RENUM
      INTEGER, DIMENSION(NSPMD), INTENT(inout) :: NSNFIOLD
      TYPE(multi_fvm_struct), INTENT(INOUT), TARGET     :: MULTI_FVM
      TYPE(h3d_database) :: H3D_DATA
      TYPE(inter_struct_type), DIMENSION(NINTER), INTENT(inout) :: INTER_STRUCT   !   structure for interface
      TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM   ! structure for interface sorting comm
      TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
      type (glob_therm_) ,INTENT(IN) :: GLOB_THERM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: KK,N,ESHIFT
      INTEGER :: NTY,INACTI,ISENS
      INTEGER :: NRTM_T
      LOGICAL :: TYPE18
      my_real :: ts
!   ----------------------------------------
 
        DO kk=1,nb_inter_sorted
            n = list_inter_sorted(kk)
            nty = ipari(7,n)
            inacti = ipari(22,n)
            type18=.false.
            IF(nty==7.AND.inacti==7)type18=.true.
 
            ! ---------------------------
            ! timer of current interface N : start
            IF( imonm > 0 .AND. itask ==0 ) THEN
                intbuf_tab(n)%METRIC%NOINT   = ipari(15,n)
                intbuf_tab(n)%METRIC%NCONT   = ipari(18,n)
                intbuf_tab(n)%METRIC%MULTIMP = ipari(23,n)
                intbuf_tab(n)%METRIC%NSNR   = max(intbuf_tab(n)%METRIC%NSNR , ipari(24,n))
                intbuf_tab(n)%METRIC%NSN    = ipari(5,n) 
                CALL int_startime(intbuf_tab(n)%METRIC,i_main_tri)   
            ENDIF
            ! ---------------------------
 
            isens = 0
            IF(nty == 7.OR.nty == 11.OR.nty == 24.OR.nty == 25) isens = ipari(64,n)  
            ! ---------------------------
            ! interface activated by a a sensor 
            IF (isens > 0) THEN    
                ts = sensor_tab(isens)%TSTART
            ELSE
                ts = tt
            ENDIF
 
            ! -----------------------------------------------------
            ! type 7
            IF((nty==7.AND.tt>=ts).AND.(.NOT.type18))THEN
                IF(got_preview == 1) THEN
                   nrtm_t = ipari(4,n)
                   eshift = 0
                ELSE
                  nrtm_t = ipari(4,n)/nthread
                  eshift = itask*nrtm_t
                  IF(itask==nthread-1)nrtm_t=ipari(4,n)-(nthread-1)*nrtm_t
                ENDIF
                CALL inter_sort_07( timers,ipari,x,n,itask,isendto,
     1                              irecvfrom,retri,itab,nrtm_t,renum,renum_siz,
     2                              nsnfiold,eshift,multi_fvm,intbuf_tab(n),h3d_data,
     3                              inter_struct,sort_comm,glob_therm%INTHEAT, glob_therm%IDT_THERM, glob_therm%NODADT_THERM)
            ENDIF
            ! -----------------------------------------------------
 
            ! ---------------------------
            ! timer of current interface N : end
            IF(imonm > 0) THEN
              IF(itask==0) CALL int_stoptime(intbuf_tab(n)%METRIC,i_main_tri)   
            ENDIF
            ! ---------------------------
        ENDDO
 
        RETURN
        END SUBROUTINE inter_sort