paraco.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE paraco
!                   *****************
!
     &(v1,v2,v3,npoin,icom,ian,nplan,nb_neighb,nb_neighb_pt,list_send,
     & nh_com,dimnhcom,buf_send,buf_recv,dimbuf)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    ASSEMBLES DATA SHARED BY SEVERAL PROCESSORS.
!
!history  P. VEZOLLE(IBM)
!+        18/07/08
!+        V5P9
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| BUF_RECV       |<->| BUFFER FOR RECEIVING DATA
!| BUF_SEND       |<->| BUFFER FOR SENDING DATA
!| DIMBUF         |-->| FIRST DIMENSION OF BUFFERS
!| DIMNHCOM       |---|
!| IAN            |-->| NUMBER OF VECTORS TO BE CONDIDERED (1, 2 OR 3)
!| ICOM           |-->| OPTION OF COMMUNICATION :
!|                |   | = 1 : VALUE WITH MAXIMUM ABSOLUTE VALUE
!|                |   | = 2 : CONTRIBUTIONS ADDED
!|                |   | = 3 : MAXIMUM CONTRIBUTION RETAINED
!|                |   | = 4 : MINIMUM CONTRIBUTION RETAINED
!| LIST_SEND      |-->| LIST OF PROCESSORS NUMBERS
!| NB_NEIGHB      |-->| NUMBER OF NEIGHBOURING SUB-DOMAINS
!| NB_NEIGHB_PT   |-->| NUMBER OF POINTS SHARED WITH A SUB-DOMAIN
!| NH_COM         |-->| NH_COM(I,IL) : GLOBAL NUMBER IN THIS
!|                |   | SUB-DOMAIN OF THE POINT NUMBER I IN THE LIST
!|                |   | OF POINTS SHARED WITH PROCESSOR NUMBER IL
!|                |   | WHOSE REAL NUMBER IS LIST_SEND(IL)
!| NPLAN          |-->| SECOND DIMENSION OF V1,V2,V3
!| NPOIN          |-->| FIRST DIMENSION OF V1,V2,V3
!| V1             |<->| VECTOR TO BE COMPLETED
!| V2             |<->| VECTOR TO BE COMPLETED
!| V3             |<->| VECTOR TO BE COMPLETED
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def
      USE declarations_telemac, ONLY : paraco_msg_tag
      USE declarations_parallel
      USE interface_parallel
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPOIN,ICOM,IAN,NPLAN,NB_NEIGHB
      INTEGER, INTENT(IN) :: DIMNHCOM,DIMBUF
      INTEGER, INTENT(IN) :: NB_NEIGHB_PT(nb_neighb)
      INTEGER, INTENT(IN) :: LIST_SEND(nb_neighb),NH_COM(dimnhcom,*)
!
      DOUBLE PRECISION, INTENT(INOUT) :: BUF_SEND(dimbuf,*)
      DOUBLE PRECISION, INTENT(INOUT) :: BUF_RECV(dimbuf,*)
      DOUBLE PRECISION, INTENT(INOUT) :: V1(npoin,nplan)
      DOUBLE PRECISION, INTENT(INOUT) :: V2(npoin,nplan)
      DOUBLE PRECISION, INTENT(INOUT) :: V3(npoin,nplan)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IKA,IL,II,I,J,K,IPA
!
      INTRINSIC abs
!
      INTEGER SEND_REQ(100),RECV_REQ(100)
!
!----------------------------------------------------------------------
!
      IF(ian.NE.1.AND.ian.NE.2.AND.ian.NE.3) THEN
        WRITE(lu,*) 'FALSCHE FREIWERTZAHL BEI KOMMUNIKATION',ian,
     &              ' AUF PROZESSOR',ipid
        CALL plante(1)
        stop
      ENDIF
!
!     MESSAGE TAG UPDATE
!
      IF(paraco_msg_tag.LT.1000000) THEN
        paraco_msg_tag = paraco_msg_tag + 1
      ELSE
        paraco_msg_tag = 5001
      ENDIF
!
!== RECEIVE STEP
!
      DO il=1,nb_neighb
        ika = nb_neighb_pt(il)
        ipa = list_send(il)
!       AD: DISTINGUISHING THE NUMBER OF ELEMENTS AND THEIR SIZE
        CALL p_read(buf_recv(1:dimbuf,il),ian*ika*nplan,8,
     &              ipa,paraco_msg_tag,recv_req(il))
      ENDDO
!
!== SEND STEP
!
      DO il=1,nb_neighb
        ika = nb_neighb_pt(il)
        ipa = list_send(il)
!
!** INITIALISES THE COMMUNICATION ARRAYS
!
        k = 1
        IF(ian.EQ.3) THEN
          DO j=1,nplan
            DO i=1,ika
              ii=nh_com(i,il)
              buf_send(k,il)  =v1(ii,j)
              buf_send(k+1,il)=v2(ii,j)
              buf_send(k+2,il)=v3(ii,j)
              k=k+3
            ENDDO
          ENDDO
        ELSEIF(ian.EQ.2) THEN
          DO j=1,nplan
            DO i=1,ika
              ii=nh_com(i,il)
              buf_send(k,il)  =v1(ii,j)
              buf_send(k+1,il)=v2(ii,j)
              k=k+2
            ENDDO
          ENDDO
        ELSEIF(ian.EQ.1) THEN
          DO j=1,nplan
            DO i=1,ika
              ii=nh_com(i,il)
              buf_send(k,il)  =v1(ii,j)
              k=k+1
            ENDDO
          ENDDO
        ENDIF
!
!       AD: DISTINGUISHING THE NUMBER OF ELEMENTS AND THEIR SIZE
        CALL p_write(buf_send(1:dimbuf,il),ian*ika*nplan,8,
     &               ipa,paraco_msg_tag,send_req(il))
!
      ENDDO
!
!== WAIT RECEIVED MESSAGES (POSSIBILITY OF COVERING)
!
      DO il=1,nb_neighb
        ika = nb_neighb_pt(il)
        ipa = list_send(il)
        CALL p_wait_paraco(recv_req(il),1)
!
        k=1
!
        IF(icom.EQ.1) THEN
          IF(ian.EQ.3) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(abs(buf_recv(k,il)).GT.abs(v1(ii,j)))
     &                          v1(ii,j)=buf_recv(k  ,il)
                IF(abs(buf_recv(k+1,il)).GT.abs(v2(ii,j)))
     &                          v2(ii,j)=buf_recv(k+1,il)
                IF(abs(buf_recv(k+2,il)).GT.abs(v3(ii,j)))
     &                          v3(ii,j)=buf_recv(k+2,il)
                k=k+3
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.2) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(abs(buf_recv(k,il)).GT.abs(v1(ii,j)))
     &                          v1(ii,j)=buf_recv(k  ,il)
                IF(abs(buf_recv(k+1,il)).GT.abs(v2(ii,j)))
     &                          v2(ii,j)=buf_recv(k+1,il)
                k=k+2
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.1) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(abs(buf_recv(k,il)).GT.abs(v1(ii,j)))
     &                          v1(ii,j)=buf_recv(k  ,il)
                k=k+1
              ENDDO
            ENDDO
          ENDIF
        ELSEIF(icom.EQ.2) THEN
          IF(ian.EQ.3) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                v1(ii,j)=v1(ii,j)+buf_recv(k  ,il)
                v2(ii,j)=v2(ii,j)+buf_recv(k+1,il)
                v3(ii,j)=v3(ii,j)+buf_recv(k+2,il)
                k=k+3
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.2) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                v1(ii,j)=v1(ii,j)+buf_recv(k  ,il)
                v2(ii,j)=v2(ii,j)+buf_recv(k+1,il)
                k=k+2
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.1) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                v1(ii,j)=v1(ii,j)+buf_recv(k  ,il)
                k=k+1
              ENDDO
            ENDDO
          ENDIF
        ELSEIF(icom.EQ.3) THEN
          IF(ian.EQ.3) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(buf_recv(k  ,il).GT.v1(ii,j))
     &            v1(ii,j)=buf_recv(k  ,il)
                IF(buf_recv(k+1,il).GT.v2(ii,j))
     &            v2(ii,j)=buf_recv(k+1,il)
                IF(buf_recv(k+2,il).GT.v3(ii,j))
     &            v3(ii,j)=buf_recv(k+2,il)
                k=k+3
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.2) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(buf_recv(k  ,il).GT.v1(ii,j))
     &            v1(ii,j)=buf_recv(k  ,il)
                IF(buf_recv(k+1,il).GT.v2(ii,j))
     &            v2(ii,j)=buf_recv(k+1,il)
                k=k+2
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.1) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(buf_recv(k  ,il).GT.v1(ii,j))
     &            v1(ii,j)=buf_recv(k  ,il)
                k=k+1
              ENDDO
            ENDDO
          ENDIF
        ELSEIF(icom.EQ.4) THEN
          IF(ian.EQ.3) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(buf_recv(k  ,il).LT.v1(ii,j))
     &            v1(ii,j)=buf_recv(k  ,il)
                IF(buf_recv(k+1,il).LT.v2(ii,j))
     &            v2(ii,j)=buf_recv(k+1,il)
                IF(buf_recv(k+2,il).LT.v3(ii,j))
     &            v3(ii,j)=buf_recv(k+2,il)
                k=k+3
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.2) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(buf_recv(k  ,il).LT.v1(ii,j))
     &            v1(ii,j)=buf_recv(k  ,il)
                IF(buf_recv(k+1,il).LT.v2(ii,j))
     &            v2(ii,j)=buf_recv(k+1,il)
                k=k+2
              ENDDO
            ENDDO
          ELSEIF(ian.EQ.1) THEN
            DO j=1,nplan
              DO i=1,ika
                ii=nh_com(i,il)
                IF(buf_recv(k  ,il).LT.v1(ii,j))
     &            v1(ii,j)=buf_recv(k  ,il)
                k=k+1
              ENDDO
            ENDDO
          ENDIF
        ENDIF
!
      ENDDO
!
!== WAIT SENT MESSAGES
!
      CALL p_wait_paraco(send_req,nb_neighb)
!
!-----------------------------------------------------------------------
!
      RETURN
      END