write_joint.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	write_joint (ljoint, cep, cel, proc, nodlocal, ljoint_l, len_ia, numnod_l)

Function/Subroutine Documentation

write_joint()

subroutine write_joint	(	integer, dimension(*)	ljoint,
		integer, dimension(*)	cep,
		integer, dimension(*)	cel,
		integer	proc,
		integer, dimension(*)	nodlocal,
		integer	ljoint_l,
		integer	len_ia,
		integer	numnod_l )

Definition at line 31 of file write_joint.F.

!$COMMENT
!       WRITE_JOINT description
!       write the joint structure 
!       
!       WRITE_JOINT organization :
!$ENDCOMMENT
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------     
            USE joint_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      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER  PROC, LJOINT_L, LEN_IA, NODLOCAL(*),
     .          LJOINT(*), CEP(*), CEL(*),NUMNOD_L
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER N,NN,K,J,P,I,NUMBER_MAIN_NODE,IS_SMS_AVAILABLE
        INTEGER, DIMENSION(:), ALLOCATABLE :: BUF_W
        INTEGER, DIMENSION(NSPMD) :: NB_NODE_WEIGHT
        INTEGER, DIMENSION(2) :: MAIN_NODE
        INTEGER, DIMENSION(:), ALLOCATABLE :: SECONDARY_NODE
C
        p = proc + 1
        !   ----------------------
        !   count the number of data in order to allocate the buffer
        k = 0 
        DO n=1,njoint     
            IF(cyl_join(n)%NB_NODE(p)>0) THEN
                k = k + 4 + cyl_join(n)%NUMBER_PROC + 2*cyl_join(n)%NB_NODE(p) + nspmd
            ENDIF
        ENDDO
        k = k + njoint
        !   ----------------------
        !   buffer allocation
        ALLOCATE(buf_w(k))
 
        !   write for all processor the number of node per proc
        DO n=1,njoint            
            buf_w(n) = cyl_join(n)%NB_NODE(p)
        ENDDO
        CALL write_i_c(buf_w,njoint)
        len_ia = len_ia + njoint
        !   ----------------------
        !   loop over the CYL_JOINT
        DO n=1,njoint     
            nb_node_weight(1:nspmd) = 0
            !   ----------------------
            !   if 1 or several nodes are on the current processor, write all the stuff
            IF(cyl_join(n)%NB_NODE(p)>0) THEN
                !   main processor
                CALL write_i_c(cyl_join(n)%PROC_MAIN,1)
                !   number of processor for the current joint
                CALL write_i_c(cyl_join(n)%NUMBER_PROC,1)
                !   list of processor for the current joint
                CALL write_i_c(cyl_join(n)%LIST_PROC,cyl_join(n)%NUMBER_PROC)
 
                ALLOCATE( secondary_node(cyl_join(n)%NB_NODE(p)) )
                DO i=1,cyl_join(n)%NB_NODE(p)
                    secondary_node(i) = nodlocal(cyl_join(n)%PROC(p)%NODE(i))
                ENDDO
                !   number of node for the current processor and joint
                CALL write_i_c(secondary_node,cyl_join(n)%NB_NODE(p))
                !   weight array (0 or 1) for the current processor and joint
                CALL write_i_c(cyl_join(n)%PROC(p)%WEIGHT,cyl_join(n)%NB_NODE(p))
                DEALLOCATE( secondary_node )
            ENDIF
            !   ----------------------
            DO i=1,nspmd
                nb_node_weight(i) = cyl_join(n)%PROC(i)%NB_NODE_WEIGHT
            ENDDO
            !   number of node with weight = 1 (all processor) ; use for mpi comm
            CALL write_i_c(nb_node_weight,nspmd)
            main_node(1:2) = nodlocal(cyl_join(n)%MAIN_NODE(1:2))     
            !   main nodes (all processor)
            CALL write_i_c(main_node,2)
        ENDDO
 
        is_sms_available = 0
        IF(joint_sms) is_sms_available = 1
        CALL write_i_c(is_sms_available,1)
        
        len_ia = len_ia + k + 1
        DEALLOCATE(buf_w)
C
        RETURN