check_coarse_grid.F File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	check_coarse_grid (nin, main_coarse_grid, sort_comm, itied)

Function/Subroutine Documentation

check_coarse_grid()

subroutine check_coarse_grid	(	integer, intent(in)	nin,
		integer, dimension(nb_box_coarse_grid**3), intent(in)	main_coarse_grid,
		type(sorting_comm_type), dimension(ninter), intent(inout)	sort_comm,
		integer, intent(in)	itied )

Definition at line 30 of file check_coarse_grid.F.

!$COMMENT
!       check_coarse_grid description :
!       for a given interface, check if the correct processor needs to communicate with a remote processor
!
!       CHECK_COARSE_GRID organization :
!           loop over the processor P and :
!               * if p and the current processor ispmd colored a common cell --> ispmd and p need to communicate
!               * if P and the current processor ISPMD did not colored a common cell --> ISPMD and P don't need to communicate
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE inter_sorting_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(in) :: NIN
        INTEGER, INTENT(in) :: ITIED
        INTEGER, DIMENSION(NB_BOX_COARSE_GRID**3), INTENT(in) :: MAIN_COARSE_GRID
        TYPE(sorting_comm_type), DIMENSION(NINTER), INTENT(inout) :: SORT_COMM   ! structure for interface sorting comm
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------       
        LOGICAL :: KEEP_THIS_PROC,BREAK_
        INTEGER :: I,J,IJK
        INTEGER :: ID_PROC,DISPL        
!   ----------------------------------------
 
        !   allocatio of KEEP_PROC : true if need to send/rcv to proc P
        IF(.NOT.ALLOCATED(sort_comm(nin)%KEEP_PROC)) THEN
            ALLOCATE(sort_comm(nin)%KEEP_PROC(sort_comm(nin)%PROC_NUMBER) )
        ENDIF
        !   loop over the processor of the interface : keep P if at least 1 common cell between P and current proc
        DO i=1,sort_comm(nin)%PROC_NUMBER
            id_proc = sort_comm(nin)%PROC_LIST(i)
            displ = sort_comm(nin)%RCV_DISPLS_COARSE_CELL(i)
            sort_comm(nin)%KEEP_PROC(i) = .false.
            keep_this_proc = .false.
            break_ = .false.
            j = 1
            !   no cell from P --> keep = false
            IF(sort_comm(nin)%RCV_SIZE_COARSE_CELL(i)==0) break_ = .true.
 
            IF(.NOT.break_) THEN
                IF(sort_comm(nin)%GLOBAL_COARSE_CELL(displ+nb_box_coarse_grid**3+1)==0) break_ = .true.
            ENDIF
 
            IF(.NOT.break_) THEN
                ! loop voer the cell of P and check if 1 common cell
                DO j=1,sort_comm(nin)%GLOBAL_COARSE_CELL(displ+nb_box_coarse_grid**3+1)
                    ijk = sort_comm(nin)%GLOBAL_COARSE_CELL(displ+j)
                    IF(main_coarse_grid(ijk)==1) keep_this_proc = .true.
                ENDDO
            ENDIF
            IF(itied/=0) keep_this_proc=.true.
            IF(keep_this_proc) sort_comm(nin)%KEEP_PROC(i) = .true.
        ENDDO
        !   ------------------
        RETURN