inter_sort.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "timeri_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	inter_sort (timers, itask, nb_inter_sorted, list_inter_sorted, retri, ipari, nsensor, isendto, irecvfrom, intbuf_tab, x, itab, renum, nsnfiold, multi_fvm, h3d_data, sensor_tab, inter_struct, sort_comm, renum_siz, glob_therm)

Function/Subroutine Documentation

inter_sort()

subroutine inter_sort	(	type(timer_), intent(inout)	timers,
		integer, intent(in)	itask,
		integer, intent(in)	nb_inter_sorted,
		integer, dimension(nb_inter_sorted), intent(in)	list_inter_sorted,
		integer, intent(inout)	retri,
		integer, dimension(npari,ninter), intent(inout)	ipari,
		integer, intent(in)	nsensor,
		integer, dimension(ninter+1,nspmd+1), intent(in)	isendto,
		integer, dimension(ninter+1,nspmd+1), intent(in)	irecvfrom,
		type(intbuf_struct_), dimension(ninter), intent(inout)	intbuf_tab,
		target	x,
		integer, dimension(numnod), intent(in)	itab,
		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 (sensor_str_), dimension(nsensor)	sensor_tab,
		type(inter_struct_type), dimension(ninter), intent(inout)	inter_struct,
		type(sorting_comm_type), dimension(ninter), intent(inout)	sort_comm,
		integer, intent(in)	renum_siz,
		type (glob_therm_), intent(in)	glob_therm )

Definition at line 43 of file inter_sort.F.

!$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