inter_check_sort.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "com08_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	inter_check_sort (itask, need_to_sort, nbintc, intlist, ipari, nsensor, intbuf_tab, sensor_tab, nb_inter_sorted, list_inter_sorted, inter_struct)

Function/Subroutine Documentation

inter_check_sort()

subroutine inter_check_sort	(	integer, intent(in)	itask,
		integer, intent(inout)	need_to_sort,
		integer, intent(in)	nbintc,
		integer, dimension(nbintc), intent(in)	intlist,
		integer, dimension(npari,ninter), intent(in)	ipari,
		integer, intent(in)	nsensor,
		type(intbuf_struct_), dimension(ninter)	intbuf_tab,
		type (sensor_str_), dimension(nsensor)	sensor_tab,
		integer, intent(inout)	nb_inter_sorted,
		integer, dimension(nbintc), intent(inout)	list_inter_sorted,
		type(inter_struct_type), dimension(ninter), intent(inout)	inter_struct )

Definition at line 32 of file inter_check_sort.F.

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