w_master_proc_weight.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	w_main_proc_weight (nodglob, numnod_l, nspmd, proc)

Function/Subroutine Documentation

w_main_proc_weight()

subroutine w_main_proc_weight	(	integer, dimension(*), intent(in)	nodglob,
		integer, intent(in)	numnod_l,
		integer, intent(in)	nspmd,
		integer, intent(in)	proc )

Definition at line 30 of file w_master_proc_weight.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------  
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(IN) :: NUMNOD_L,NSPMD,PROC
        INTEGER, DIMENSION(*), INTENT(IN) :: NODGLOB
!       -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
!       NUMNOD_L  : integer,
!                   number of local element
!       NSPMD     : integer,
!                   number of processor/domain
!       PROC      : integer,
!                   ID of the current processor
!       NODGLOB   : integer, dimension=NUMNOD_L
!                   gives the global ID of a local element
!                   NODGLOB( local_id) = global_id
!       -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
C-----------------------------------------------
C   F u n c t i o n
C-----------------------------------------------
        INTEGER  NLOCAL
        EXTERNAL nlocal    
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER I,N,P,G
        INTEGER, DIMENSION(:), ALLOCATABLE :: MAIN_PROC 
        INTEGER, DIMENSION(:), ALLOCATABLE :: WEIGHT
 
C-----------------------------------------------
!       allocate 1d array
        ALLOCATE( main_proc(numnod_l) )
        ALLOCATE( weight(numnod_l) )
! -----------------------------------
        main_proc(1:numnod_l) = 0
        weight(1:numnod_l) = 0
        DO i = 1,numnod_l
                n = nodglob(i)
                DO p = 1, nspmd 
                        IF(nlocal(n,p)==1) THEN
                                main_proc(i) = p 
                                GOTO 10
                        ENDIF
                ENDDO
 10             CONTINUE
        ENDDO
        
        DO i=1,numnod_l
                IF(main_proc(i)==proc) weight(i) = 1
        ENDDO        
 
        CALL write_i_c(main_proc,numnod_l)
        CALL write_i_c(weight,numnod_l)
! -----------------------------------
!       deallocate 1d array
        DEALLOCATE(main_proc )
        DEALLOCATE( weight )
! -----------------------------------
        RETURN